clips_core_source_630/0000755000175000017500000000000012512773655013313 5ustar jfsjfsclips_core_source_630/readme.txt0000644000175000017500000000175212504551126015302 0ustar jfsjfsCLIPS License Information Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. clips_core_source_630/makefiles/0000755000175000017500000000000013170666371015250 5ustar jfsjfsclips_core_source_630/makefiles/._makefile.g++0000755000175000017500000000041312504556504017535 0ustar jfsjfsMac OS X  2Ù TEXTATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/makefiles/._makefile.lib++0000644000175000017500000000110512504562722020050 0ustar jfsjfsMac OS X  2Ù :TEXTATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E667223522¨±L&ô2MWBB ðÿÿclips_core_source_630/makefiles/._makefile.lib0000644000175000017500000000041312504561275017725 0ustar jfsjfsMac OS X  2Ù TEXTATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/makefiles/makefile.lib0000644000175000017500000021545012504561275017521 0ustar jfsjfs# The GNU Make Manual # http://www.gnu.org/software/make/manual/make.html OBJS = agenda.o analysis.o argacces.o bload.o bmathfun.o bsave.o \ classcom.o classexm.o classfun.o classinf.o classini.o \ classpsr.o clsltpsr.o commline.o conscomp.o constrct.o \ constrnt.o crstrtgy.o cstrcbin.o cstrccom.o cstrcpsr.o \ cstrnbin.o cstrnchk.o cstrncmp.o cstrnops.o cstrnpsr.o \ cstrnutl.o default.o defins.o developr.o dffctbin.o dffctbsc.o \ dffctcmp.o dffctdef.o dffctpsr.o dffnxbin.o dffnxcmp.o \ dffnxexe.o dffnxfun.o dffnxpsr.o dfinsbin.o dfinscmp.o drive.o \ emathfun.o \ engine.o envrnmnt.o evaluatn.o expressn.o exprnbin.o exprnops.o \ exprnpsr.o extnfunc.o factbin.o factbld.o factcmp.o factcom.o \ factfun.o factgen.o facthsh.o factlhs.o factmch.o factmngr.o \ factprt.o factqpsr.o factqury.o factrete.o factrhs.o filecom.o filertr.o \ generate.o genrcbin.o genrccmp.o genrccom.o genrcexe.o genrcfun.o \ genrcpsr.o globlbin.o globlbsc.o globlcmp.o globlcom.o \ globldef.o globlpsr.o immthpsr.o incrrset.o inherpsr.o \ inscom.o insfile.o insfun.o insmngr.o insmoddp.o insmult.o \ inspsr.o insquery.o insqypsr.o iofun.o lgcldpnd.o \ memalloc.o miscfun.o modulbin.o modulbsc.o modulcmp.o moduldef.o \ modulpsr.o modulutl.o msgcom.o msgfun.o msgpass.o msgpsr.o \ multifld.o multifun.o objbin.o objcmp.o objrtbin.o objrtbld.o \ objrtcmp.o objrtfnx.o objrtgen.o objrtmch.o parsefun.o pattern.o \ pprint.o prccode.o prcdrfun.o prcdrpsr.o prdctfun.o prntutil.o \ proflfun.o reorder.o reteutil.o retract.o router.o rulebin.o \ rulebld.o rulebsc.o rulecmp.o rulecom.o rulecstr.o ruledef.o \ ruledlt.o rulelhs.o rulepsr.o scanner.o sortfun.o strngfun.o \ strngrtr.o symblbin.o symblcmp.o symbol.o sysdep.o textpro.o \ tmpltbin.o tmpltbsc.o tmpltcmp.o tmpltdef.o tmpltfun.o tmpltlhs.o \ tmpltpsr.o tmpltrhs.o tmpltutl.o userdata.o userfunctions.o utility.o watch.o .c.o : gcc -c -DALLOW_ENVIRONMENT_GLOBALS=0 \ -O3 -Wall -Wundef -Wpointer-arith -Wshadow -Wcast-qual \ -Winline -Wmissing-declarations -Wredundant-decls \ -Wmissing-prototypes -Wnested-externs \ -Wstrict-prototypes -Waggregate-return -Wno-implicit $< # Creating Unix Libraries # http://www.cs.duke.edu/~ola/courses/programming/libraries.html # Compiling CLIPS using the library # gcc -o clips main.c -L. -lm -lclips libclips.a : $(OBJS) rm -f $@ ar cq $@ $(OBJS) # man gcc # Dependencies generated using "gcc -MM *.c" agenda.o: agenda.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h memalloc.h modulutl.h reteutil.h \ router.h prntutil.h rulebsc.h strngrtr.h sysdep.h watch.h analysis.o: analysis.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h generate.h \ analysis.h router.h prntutil.h cstrnchk.h cstrnutl.h cstrnops.h \ rulecstr.h modulutl.h watch.h rulepsr.h globldef.h argacces.o: argacces.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnchk.h \ constrnt.h insfun.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h factmngr.h facthsh.h tmpltdef.h factbld.h \ sysdep.h argacces.h bload.o: bload.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bsave.h cstrnbin.h \ constrnt.h memalloc.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h bmathfun.o: bmathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ bmathfun.h bsave.o: bsave.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h cstrnbin.h constrnt.h memalloc.h router.h prntutil.h \ bsave.h classcom.o: classcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h argacces.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h classfun.h object.h constrnt.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h classini.h modulutl.h msgcom.h \ msgpass.h router.h prntutil.h classcom.h classexm.o: classexm.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classini.h insfun.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h classexm.h classfun.o: classfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classini.h cstrcpsr.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgfun.h msgpass.h router.h prntutil.h \ classfun.h classinf.o: classinf.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classexm.h classfun.h classini.h memalloc.h insfun.h \ msgcom.h msgpass.h msgfun.h prntutil.h classinf.h classini.o: classini.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classexm.h classfun.h classinf.h classpsr.h cstrcpsr.h inscom.h \ insfun.h memalloc.h modulutl.h msgcom.h msgpass.h watch.h defins.h \ insquery.h bload.h exprnbin.h sysdep.h symblbin.h objbin.h objcmp.h \ objrtbld.h objrtfnx.h objrtmch.h classini.h classpsr.o: classpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h clsltpsr.h cstrcpsr.h \ inherpsr.h memalloc.h modulutl.h msgpsr.h router.h prntutil.h \ classpsr.h clsltpsr.o: clsltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h cstrnpsr.h cstrnutl.h default.h insfun.h \ memalloc.h prntutil.h router.h clsltpsr.h commline.o: commline.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h filecom.h \ memalloc.h prcdrfun.h prcdrpsr.h constrnt.h router.h prntutil.h \ strngrtr.h sysdep.h commline.h conscomp.o: conscomp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h modulcmp.h \ network.h match.h pattern.h reorder.h ruledef.h agenda.h dffnxcmp.h \ dffnxfun.h tmpltcmp.h globlcmp.h genrccmp.h genrcfun.h object.h \ objcmp.h constrct.o: constrct.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ watch.h prcdrfun.h prcdrpsr.h constrnt.h argacces.h modulutl.h \ sysdep.h commline.h cstrcpsr.h ruledef.h cstrccom.h agenda.h match.h \ network.h pattern.h reorder.h constrnt.o: constrnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h constrnt.h crstrtgy.o: crstrtgy.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h pattern.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h reteutil.h argacces.h \ memalloc.h crstrtgy.h cstrcbin.o: cstrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h cstrcbin.h cstrccom.o: cstrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h argacces.h modulutl.h \ router.h prntutil.h commline.h sysdep.h bload.h exprnbin.h symblbin.h \ cstrcpsr.h cstrccom.h cstrcpsr.o: cstrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h watch.h \ prcdrpsr.h constrnt.h memalloc.h modulutl.h sysdep.h cstrcpsr.h cstrnbin.o: cstrnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h cstrnbin.h constrnt.h cstrnchk.o: cstrnchk.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnutl.h \ constrnt.h inscom.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h insfun.h classcom.h classexm.h cstrnchk.h cstrncmp.o: cstrncmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h memalloc.h router.h prntutil.h \ sysdep.h cstrncmp.h constrnt.h cstrnops.o: cstrnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h cstrnchk.h cstrnutl.h cstrnops.h cstrnpsr.o: cstrnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnutl.h constrnt.h cstrnchk.h sysdep.h cstrnpsr.h cstrnutl.o: cstrnutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrnutl.h constrnt.h default.o: default.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h inscom.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ insfun.h router.h prntutil.h factmngr.h facthsh.h tmpltdef.h factbld.h \ cstrnutl.h default.h defins.o: defins.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dfinsbin.h defins.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h dfinscmp.h argacces.h \ classcom.h classfun.h cstrcpsr.h insfun.h inspsr.h memalloc.h router.h \ prntutil.h developr.o: developr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h inscom.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h insfun.h modulutl.h router.h prntutil.h tmpltdef.h factbld.h \ factmngr.h facthsh.h classcom.h classfun.h objrtmch.h developr.h dffctbin.o: dffctbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h dffctbin.h modulbin.h \ cstrcbin.h dffctbsc.o: dffctbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h dffctpsr.h dffctdef.h dffctbin.h modulbin.h cstrcbin.h \ dffctcmp.h dffctbsc.h dffctcmp.o: dffctcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffctdef.h cstrccom.h dffctcmp.h dffctdef.o: dffctdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctpsr.h dffctbsc.h bload.h \ utility.h exprnbin.h sysdep.h symblbin.h dffctbin.h modulbin.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h cstrcbin.h \ dffctcmp.h dffctdef.h cstrccom.h dffctpsr.o: dffctpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrcpsr.h factrhs.h factmngr.h facthsh.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h \ factbld.h bload.h exprnbin.h sysdep.h symblbin.h dffctdef.h dffctbsc.h \ dffctpsr.h dffnxbin.o: dffnxbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h modulbin.h dffnxbin.h dffnxfun.h \ cstrccom.h dffnxcmp.o: dffnxcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffnxcmp.h dffnxfun.h cstrccom.h dffnxexe.o: dffnxexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h prcdrfun.h prccode.h proflfun.h \ router.h prntutil.h watch.h dffnxexe.h dffnxfun.h cstrccom.h dffnxfun.o: dffnxfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxbin.h dffnxfun.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h dffnxcmp.h cstrcpsr.h dffnxpsr.h \ dffnxexe.h watch.h argacces.h memalloc.h router.h prntutil.h dffnxpsr.o: dffnxpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h network.h match.h pattern.h reorder.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h \ agenda.h genrccom.h genrcfun.h object.h cstrcpsr.h dffnxfun.h \ memalloc.h prccode.h router.h prntutil.h dffnxpsr.h dfinsbin.o: dfinsbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ modulbin.h dfinsbin.h dfinscmp.o: dfinscmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ dfinscmp.h drive.o: drive.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ memalloc.h prntutil.h reteutil.h router.h incrrset.h drive.h emathfun.o: emathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ emathfun.h engine.o: engine.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h factmngr.h facthsh.h \ tmpltdef.h factbld.h inscom.h object.h insfun.h memalloc.h modulutl.h \ prccode.h prcdrfun.h proflfun.h reteutil.h retract.h router.h \ prntutil.h ruledlt.h sysdep.h watch.h engine.h lgcldpnd.h envrnmnt.o: envrnmnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h sysdep.h evaluatn.o: evaluatn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h prcdrfun.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h proflfun.h sysdep.h dffnxfun.h genrccom.h \ genrcfun.h object.h inscom.h insfun.h expressn.o: expressn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h memalloc.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h exprnbin.o: exprnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h agenda.h genrcbin.h \ genrcfun.h object.h dffnxbin.h dffnxfun.h tmpltbin.h cstrcbin.h \ modulbin.h tmpltdef.h factbld.h factmngr.h facthsh.h globlbin.h \ globldef.h objbin.h insfun.h inscom.h exprnops.o: exprnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnchk.h constrnt.h cstrnutl.h cstrnops.h exprnpsr.o: exprnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ memalloc.h argacces.h cstrnchk.h constrnt.h modulutl.h prcdrfun.h \ network.h match.h pattern.h reorder.h ruledef.h cstrccom.h agenda.h \ genrccom.h genrcfun.h object.h dffnxfun.h extnfunc.o: extnfunc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h factbin.o: factbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h tmpltdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h \ factbld.h pattern.h match.h network.h ruledef.h cstrccom.h agenda.h \ reorder.h factmngr.h facthsh.h bload.h exprnbin.h sysdep.h symblbin.h \ bsave.h reteutil.h rulebin.h modulbin.h cstrcbin.h factbin.h factbld.o: factbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reteutil.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h router.h \ prntutil.h factcmp.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factgen.h factlhs.h argacces.h modulutl.h factcmp.o: factcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h factcmp.h \ tmpltdef.h factmngr.h facthsh.h factcom.o: factcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h argacces.h router.h prntutil.h \ factrhs.h factmch.h tmpltpsr.h tmpltutl.h modulutl.h strngrtr.h \ tmpltfun.h sysdep.h bload.h exprnbin.h symblbin.h factcom.h factfun.o: factfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h tmpltutl.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h router.h sysdep.h \ factfun.h factgen.o: factgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ network.h match.h pattern.h reorder.h ruledef.h constrnt.h cstrccom.h \ agenda.h reteutil.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factrete.h factprt.h tmpltlhs.h factgen.h facthsh.o: facthsh.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h facthsh.h factmngr.h tmpltdef.h factbld.h factlhs.o: factlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrcpsr.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h router.h prntutil.h \ tmpltpsr.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltlhs.h \ tmpltutl.h modulutl.h factlhs.h factmch.o: factmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h factgen.h factrete.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h sysdep.h tmpltdef.h factbld.h factmngr.h facthsh.h \ factmch.h factmngr.o: factmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h strngrtr.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h factbld.h factqury.h \ factmngr.h facthsh.h tmpltdef.h reteutil.h retract.h factcmp.h \ filecom.h factfun.h factcom.h factrhs.h factmch.h watch.h factbin.h \ default.h commline.h sysdep.h engine.h lgcldpnd.h drive.h ruledlt.h \ tmpltbsc.h tmpltutl.h tmpltfun.h factprt.o: factprt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h factgen.h \ reorder.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h factprt.h factqpsr.o: factqpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factqury.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h modulutl.h prcdrpsr.h prntutil.h \ router.h strngrtr.h factqpsr.h factqury.o: factqury.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h modulutl.h \ tmpltutl.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h insfun.h \ object.h factqpsr.h prcdrfun.h router.h prntutil.h factqury.h factrete.o: factrete.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ incrrset.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h reteutil.h drive.h engine.h lgcldpnd.h retract.h \ factgen.h factmch.h factmngr.h facthsh.h tmpltdef.h factbld.h \ factrete.h factrhs.o: factrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h modulutl.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h prntutil.h \ cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltrhs.h tmpltutl.h \ strngrtr.h router.h factrhs.h filecom.o: filecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ memalloc.h prcdrfun.h router.h prntutil.h strngrtr.h sysdep.h \ filecom.h bsave.h bload.h exprnbin.h symblbin.h filertr.o: filertr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h filertr.h generate.o: generate.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h generate.h analysis.h globlpsr.h genrcbin.o: genrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h objbin.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h genrccom.h \ genrcfun.h modulbin.h genrcbin.h router.h prntutil.h genrccmp.o: genrccmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h genrccom.h genrcfun.h \ object.h objcmp.h genrccmp.h genrccom.o: genrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h bload.h exprnbin.h sysdep.h \ symblbin.h genrcbin.h genrcfun.h object.h genrccmp.h genrcpsr.h \ classcom.h inscom.h insfun.h watch.h argacces.h cstrcpsr.h genrcexe.h \ memalloc.h router.h prntutil.h genrccom.h genrcexe.o: genrcexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h insfun.h argacces.h genrccom.h genrcfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h genrcexe.h genrcfun.o: genrcfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h argacces.h cstrcpsr.h \ genrccom.h genrcfun.h genrcexe.h memalloc.h prccode.h router.h \ prntutil.h genrcpsr.o: genrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxfun.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h cstrccom.h classfun.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classcom.h memalloc.h \ cstrcpsr.h genrccom.h genrcfun.h immthpsr.h modulutl.h prcdrpsr.h \ prccode.h router.h prntutil.h genrcpsr.h globlbin.o: globlbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globldef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h globlbsc.h globlbin.h \ modulbin.h cstrcbin.h globlbsc.o: globlbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h watch.h globlcom.h globldef.h \ cstrccom.h globlbin.h modulbin.h cstrcbin.h globlcmp.h globlbsc.h globlcmp.o: globlcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h globldef.h cstrccom.h globlcmp.h globlcom.o: globlcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h router.h \ globldef.h cstrccom.h globlcom.h globldef.o: globldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h modulpsr.h moduldef.h \ conscomp.h constrct.h symblcmp.h utility.h router.h prntutil.h \ strngrtr.h modulutl.h globlbsc.h globlpsr.h globlcom.h commline.h \ bload.h exprnbin.h sysdep.h symblbin.h globlbin.h modulbin.h \ cstrcbin.h globldef.h cstrccom.h globlcmp.h globlpsr.o: globlpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ watch.h modulutl.h cstrcpsr.h globldef.h cstrccom.h globlbsc.h bload.h \ exprnbin.h sysdep.h symblbin.h globlpsr.h immthpsr.o: immthpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h cstrnutl.h genrcpsr.h genrcfun.h prccode.h \ immthpsr.h incrrset.o: incrrset.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h router.h prntutil.h reteutil.h incrrset.h inherpsr.o: inherpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h modulutl.h router.h prntutil.h inherpsr.h inscom.o: inscom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfile.h insfun.h insmngr.h \ insmoddp.h insmult.h inspsr.h lgcldpnd.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h commline.h inscom.h insfile.o: insfile.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h \ router.h prntutil.h strngrtr.h symblbin.h sysdep.h factmngr.h \ facthsh.h tmpltdef.h factbld.h insfile.h insfun.o: insfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h cstrnchk.h engine.h lgcldpnd.h retract.h inscom.h \ insfun.h insmngr.h memalloc.h modulutl.h msgcom.h msgpass.h msgfun.h \ prccode.h router.h prntutil.h drive.h objrtmch.h insmngr.o: insmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h drive.h objrtmch.h object.h \ lgcldpnd.h classcom.h classfun.h engine.h retract.h memalloc.h \ insfun.h modulutl.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h sysdep.h insmngr.h inscom.h watch.h insmoddp.o: insmoddp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h objrtmch.h object.h \ argacces.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h miscfun.h \ msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h insmoddp.h insmult.o: insmult.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h insfun.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h msgfun.h msgpass.h multifun.h router.h prntutil.h insmult.h inspsr.o: inspsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h prntutil.h router.h inspsr.h insquery.o: insquery.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h insmngr.h insqypsr.h \ prcdrfun.h router.h prntutil.h insquery.h insqypsr.o: insqypsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ insquery.h prcdrpsr.h prntutil.h router.h strngrtr.h insqypsr.h iofun.o: iofun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ filertr.h argacces.h memalloc.h commline.h sysdep.h iofun.h lgcldpnd.o: lgcldpnd.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h reteutil.h argacces.h \ factmngr.h facthsh.h tmpltdef.h factbld.h insfun.h object.h memalloc.o: memalloc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h miscfun.o: miscfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h sysdep.h dffnxfun.h cstrccom.h miscfun.h modulbin.o: modulbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h modulbin.h modulbsc.o: modulbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h modulbin.h prntutil.h modulcmp.h \ router.h argacces.h bload.h exprnbin.h sysdep.h symblbin.h modulbsc.h modulcmp.o: modulcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h sysdep.h modulcmp.h moduldef.o: moduldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h modulcmp.h modulbsc.h bload.h exprnbin.h sysdep.h \ symblbin.h modulbin.h modulpsr.o: modulpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrcpsr.h modulutl.h bload.h exprnbin.h sysdep.h \ symblbin.h modulutl.o: modulutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h modulutl.h msgcom.o: msgcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfun.h insmoddp.h msgfun.h msgpass.h \ memalloc.h prccode.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h msgpsr.h watch.h msgcom.h msgfun.o: msgfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h insfun.h msgcom.h msgpass.h prccode.h router.h \ prntutil.h msgfun.h msgpass.o: msgpass.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h msgcom.h msgpass.h msgfun.h \ prcdrfun.h prccode.h proflfun.h router.h prntutil.h strngfun.h \ commline.h inscom.h msgpsr.o: msgpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h memalloc.h cstrcpsr.h \ cstrnchk.h insfun.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h strngrtr.h msgpsr.h multifld.o: multifld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ strngrtr.h object.h constrnt.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h multifun.o: multifun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifun.h \ prcdrpsr.h constrnt.h prcdrfun.h router.h prntutil.h object.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objbin.o: objbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h classcom.h cstrccom.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classfun.h classini.h \ cstrcbin.h cstrnbin.h insfun.h memalloc.h modulbin.h msgcom.h \ msgpass.h msgfun.h prntutil.h router.h objbin.h objcmp.o: objcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h classcom.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classini.h cstrncmp.h objrtfnx.h objrtmch.h sysdep.h \ objcmp.h objrtbin.o: objrtbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h insfun.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ reteutil.h rulebin.h modulbin.h cstrcbin.h objrtbin.h objrtbld.o: objrtbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnutl.h cstrnchk.h cstrnops.h drive.h inscom.h insfun.h \ insmngr.h memalloc.h reteutil.h rulepsr.h objrtmch.h objrtgen.h \ objrtfnx.h router.h prntutil.h objrtcmp.h objrtbin.h objrtbld.h objrtcmp.o: objrtcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h objrtfnx.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ sysdep.h objrtcmp.h objrtfnx.o: objrtfnx.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h bload.h exprnbin.h sysdep.h symblbin.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h objrtmch.h reteutil.h router.h \ prntutil.h objrtfnx.h objrtgen.o: objrtgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtfnx.h objrtmch.h objrtgen.h objrtmch.o: objrtmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h drive.h engine.h lgcldpnd.h retract.h incrrset.h reteutil.h \ ruledlt.h router.h prntutil.h objrtfnx.h objrtmch.h insmngr.h parsefun.o: parsefun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h memalloc.h \ prcdrpsr.h constrnt.h router.h prntutil.h strngrtr.h parsefun.h pattern.o: pattern.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h cstrnutl.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h reteutil.h router.h prntutil.h rulecmp.h pprint.o: pprint.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h sysdep.h utility.h prccode.o: prccode.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globlpsr.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h prcdrpsr.h router.h prntutil.h prccode.h prcdrfun.o: prcdrfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h memalloc.h prcdrpsr.h router.h prntutil.h prcdrfun.h \ globldef.h cstrccom.h prcdrpsr.o: prcdrpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h cstrnutl.h memalloc.h modulutl.h router.h prntutil.h \ prcdrpsr.h globldef.h cstrccom.h globlpsr.h prdctfun.o: prdctfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ prdctfun.h prntutil.o: prntutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h utility.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h router.h prntutil.h \ multifun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h inscom.h object.h insfun.h insmngr.h memalloc.h sysdep.h proflfun.o: proflfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h dffnxfun.h genrccom.h genrcfun.h memalloc.h msgcom.h \ msgpass.h router.h prntutil.h sysdep.h proflfun.h reorder.o: reorder.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrnutl.h constrnt.h memalloc.h \ pattern.h match.h network.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h cstrccom.h agenda.h reorder.h \ prntutil.h router.h rulelhs.h reteutil.o: reteutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h incrrset.h memalloc.h router.h prntutil.h rulecom.h \ reteutil.h retract.o: retract.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h reteutil.h router.h prntutil.h router.o: router.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h filertr.h memalloc.h \ strngrtr.h sysdep.h router.h prntutil.h rulebin.o: rulebin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h reteutil.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ rulebsc.h rulebin.h modulbin.h cstrcbin.h rulebld.o: rulebld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h drive.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h incrrset.h \ memalloc.h reteutil.h router.h prntutil.h rulebld.h rulepsr.h watch.h rulebsc.o: rulebsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h watch.h \ ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h pattern.h \ reorder.h engine.h lgcldpnd.h retract.h drive.h reteutil.h rulebin.h \ modulbin.h cstrcbin.h rulecmp.h rulebsc.h rulecmp.o: rulecmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h reteutil.h \ rulecmp.h rulecom.o: rulecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h ruledlt.h sysdep.h watch.h rulebin.h modulbin.h \ cstrcbin.h rulecom.h rulecstr.o: rulecstr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrnchk.h \ cstrnops.h cstrnutl.h prcdrpsr.h router.h prntutil.h rulepsr.h \ rulecstr.h ruledef.o: ruledef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h drive.h engine.h lgcldpnd.h \ retract.h memalloc.h reteutil.h rulebsc.h rulecom.h rulepsr.h \ ruledlt.h bload.h exprnbin.h sysdep.h symblbin.h rulebin.h modulbin.h \ cstrcbin.h rulecmp.h ruledlt.o: ruledlt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h engine.h lgcldpnd.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h \ reorder.h retract.h reteutil.h drive.h bload.h exprnbin.h sysdep.h \ symblbin.h ruledlt.h rulelhs.o: rulelhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h cstrnchk.h memalloc.h \ router.h prntutil.h rulelhs.h rulepsr.o: rulepsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrcpsr.h \ cstrnchk.h cstrnops.h engine.h lgcldpnd.h retract.h incrrset.h \ memalloc.h prccode.h prcdrpsr.h router.h prntutil.h rulebld.h \ rulebsc.h rulecstr.h ruledlt.h rulelhs.h watch.h tmpltfun.h factmngr.h \ facthsh.h tmpltdef.h factbld.h bload.h exprnbin.h sysdep.h symblbin.h \ rulepsr.h scanner.o: scanner.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ sysdep.h sortfun.o: sortfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h dffnxfun.h cstrccom.h \ memalloc.h sysdep.h sortfun.h strngfun.o: strngfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h memalloc.h prcdrpsr.h router.h \ prntutil.h strngrtr.h sysdep.h drive.h strngfun.h strngrtr.o: strngrtr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h strngrtr.h symblbin.o: symblbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h \ prntutil.h symblcmp.o: symblcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h symbol.o: symbol.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h sysdep.h sysdep.o: sysdep.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bmathfun.h commline.h \ constrnt.h cstrcpsr.h emathfun.h filecom.h iofun.h memalloc.h \ miscfun.h multifun.h parsefun.h prccode.h prdctfun.h proflfun.h \ prcdrfun.h router.h prntutil.h sortfun.h strngfun.h textpro.h watch.h \ sysdep.h dffctdef.h cstrccom.h ruledef.h agenda.h match.h network.h \ pattern.h reorder.h genrccom.h genrcfun.h object.h dffnxfun.h \ globldef.h tmpltdef.h factbld.h factmngr.h facthsh.h classini.h textpro.o: textpro.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h sysdep.h textpro.h tmpltbin.o: tmpltbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h factbin.h factbld.h pattern.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h cstrnbin.h \ factmngr.h facthsh.h tmpltdef.h tmpltpsr.h tmpltutl.h tmpltbin.h \ cstrcbin.h modulbin.h tmpltbsc.o: tmpltbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h tmpltpsr.h tmpltbin.h cstrcbin.h modulbin.h tmpltcmp.h \ tmpltutl.h tmpltbsc.h tmpltcmp.o: tmpltcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h factcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h cstrncmp.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltcmp.h tmpltdef.o: tmpltdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h network.h \ match.h pattern.h reorder.h ruledef.h constrnt.h agenda.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h tmpltutl.h \ tmpltfun.h router.h prntutil.h modulutl.h cstrnchk.h bload.h \ exprnbin.h sysdep.h symblbin.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltcmp.h tmpltfun.o: tmpltfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h cstrnchk.h constrnt.h default.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h commline.h factrhs.h modulutl.h sysdep.h \ tmpltlhs.h tmpltutl.h tmpltrhs.h tmpltfun.h tmpltlhs.o: tmpltlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h reorder.h ruledef.h cstrccom.h agenda.h match.h network.h \ pattern.h factrhs.h factmngr.h facthsh.h tmpltdef.h factbld.h \ modulutl.h tmpltutl.h tmpltlhs.h tmpltpsr.o: tmpltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h cstrnchk.h \ cstrnpsr.h cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h default.h \ watch.h cstrnutl.h tmpltbsc.h tmpltpsr.h tmpltrhs.o: tmpltrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ tmpltfun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ factrhs.h modulutl.h default.h tmpltutl.h tmpltlhs.h tmpltrhs.h tmpltutl.o: tmpltutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ argacces.h cstrnchk.h constrnt.h tmpltfun.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h tmpltpsr.h modulutl.h watch.h sysdep.h tmpltbsc.h \ tmpltutl.h userdata.o: userdata.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h userfunctions.o: userfunctions.c clips.h setup.h envrnmnt.h symbol.h \ multifld.h evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h usrsetup.h argacces.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ memalloc.h cstrcpsr.h filecom.h strngfun.h commline.h router.h \ prntutil.h filertr.h strngrtr.h iofun.h sysdep.h bmathfun.h watch.h \ modulbsc.h bload.h exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h rulebsc.h \ engine.h lgcldpnd.h retract.h drive.h incrrset.h rulecom.h crstrtgy.h \ dffctdef.h dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h \ tmpltbsc.h tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h \ globlcom.h dffnxfun.h genrccom.h genrcfun.h object.h classcom.h \ classexm.h classinf.h classini.h classpsr.h defins.h inscom.h insfun.h \ insfile.h msgcom.h msgpass.h objrtmch.h utility.o: utility.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h commline.h facthsh.h factmngr.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h memalloc.h prntutil.h sysdep.h watch.o: watch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h watch.h clips_core_source_630/makefiles/makefile.g++0000755000175000017500000021656212504556504017336 0ustar jfsjfsOBJS = agenda.o analysis.o argacces.o bload.o bmathfun.o bsave.o \ classcom.o classexm.o classfun.o classinf.o classini.o \ classpsr.o clsltpsr.o commline.o conscomp.o constrct.o \ constrnt.o crstrtgy.o cstrcbin.o cstrccom.o cstrcpsr.o \ cstrnbin.o cstrnchk.o cstrncmp.o cstrnops.o cstrnpsr.o \ cstrnutl.o default.o defins.o developr.o dffctbin.o dffctbsc.o \ dffctcmp.o dffctdef.o dffctpsr.o dffnxbin.o dffnxcmp.o \ dffnxexe.o dffnxfun.o dffnxpsr.o dfinsbin.o dfinscmp.o drive.o \ emathfun.o \ engine.o envrnmnt.o evaluatn.o expressn.o exprnbin.o exprnops.o \ exprnpsr.o extnfunc.o factbin.o factbld.o factcmp.o factcom.o \ factfun.o factgen.o facthsh.o factlhs.o factmch.o factmngr.o \ factprt.o factqpsr.o factqury.o factrete.o factrhs.o filecom.o filertr.o \ generate.o genrcbin.o genrccmp.o genrccom.o genrcexe.o genrcfun.o \ genrcpsr.o globlbin.o globlbsc.o globlcmp.o globlcom.o \ globldef.o globlpsr.o immthpsr.o incrrset.o inherpsr.o \ inscom.o insfile.o insfun.o insmngr.o insmoddp.o insmult.o \ inspsr.o insquery.o insqypsr.o iofun.o lgcldpnd.o main.o \ memalloc.o miscfun.o modulbin.o modulbsc.o modulcmp.o moduldef.o \ modulpsr.o modulutl.o msgcom.o msgfun.o msgpass.o msgpsr.o \ multifld.o multifun.o objbin.o objcmp.o objrtbin.o objrtbld.o \ objrtcmp.o objrtfnx.o objrtgen.o objrtmch.o parsefun.o pattern.o \ pprint.o prccode.o prcdrfun.o prcdrpsr.o prdctfun.o prntutil.o \ proflfun.o reorder.o reteutil.o retract.o router.o rulebin.o \ rulebld.o rulebsc.o rulecmp.o rulecom.o rulecstr.o ruledef.o \ ruledlt.o rulelhs.o rulepsr.o scanner.o sortfun.o strngfun.o \ strngrtr.o symblbin.o symblcmp.o symbol.o sysdep.o textpro.o \ tmpltbin.o tmpltbsc.o tmpltcmp.o tmpltdef.o tmpltfun.o tmpltlhs.o \ tmpltpsr.o tmpltrhs.o tmpltutl.o userdata.o userfunctions.o utility.o watch.o .c.o : gcc -c -Wall -x c++ -O3 -fno-strict-aliasing -Wundef -Wpointer-arith -Wshadow -Wcast-qual \ -Winline -Wredundant-decls -Waggregate-return -Wno-implicit $< clips : $(OBJS) gcc -o clips $(OBJS) -lstdc++ # Dependencies generated using "gcc -MM *.c" agenda.o: agenda.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h memalloc.h modulutl.h reteutil.h \ router.h prntutil.h rulebsc.h strngrtr.h sysdep.h watch.h analysis.o: analysis.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h generate.h \ analysis.h router.h prntutil.h cstrnchk.h cstrnutl.h cstrnops.h \ rulecstr.h modulutl.h watch.h rulepsr.h globldef.h argacces.o: argacces.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnchk.h \ constrnt.h insfun.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h factmngr.h facthsh.h tmpltdef.h factbld.h \ sysdep.h argacces.h bload.o: bload.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bsave.h cstrnbin.h \ constrnt.h memalloc.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h bmathfun.o: bmathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ bmathfun.h bsave.o: bsave.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h cstrnbin.h constrnt.h memalloc.h router.h prntutil.h \ bsave.h classcom.o: classcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h argacces.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h classfun.h object.h constrnt.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h classini.h modulutl.h msgcom.h \ msgpass.h router.h prntutil.h classcom.h classexm.o: classexm.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classini.h insfun.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h classexm.h classfun.o: classfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classini.h cstrcpsr.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgfun.h msgpass.h router.h prntutil.h \ classfun.h classinf.o: classinf.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classexm.h classfun.h classini.h memalloc.h insfun.h \ msgcom.h msgpass.h msgfun.h prntutil.h classinf.h classini.o: classini.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classexm.h classfun.h classinf.h classpsr.h cstrcpsr.h inscom.h \ insfun.h memalloc.h modulutl.h msgcom.h msgpass.h watch.h defins.h \ insquery.h bload.h exprnbin.h sysdep.h symblbin.h objbin.h objcmp.h \ objrtbld.h objrtfnx.h objrtmch.h classini.h classpsr.o: classpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h clsltpsr.h cstrcpsr.h \ inherpsr.h memalloc.h modulutl.h msgpsr.h router.h prntutil.h \ classpsr.h clsltpsr.o: clsltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h cstrnpsr.h cstrnutl.h default.h insfun.h \ memalloc.h prntutil.h router.h clsltpsr.h commline.o: commline.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h filecom.h \ memalloc.h prcdrfun.h prcdrpsr.h constrnt.h router.h prntutil.h \ strngrtr.h sysdep.h commline.h conscomp.o: conscomp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h modulcmp.h \ network.h match.h pattern.h reorder.h ruledef.h agenda.h dffnxcmp.h \ dffnxfun.h tmpltcmp.h globlcmp.h genrccmp.h genrcfun.h object.h \ objcmp.h constrct.o: constrct.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ watch.h prcdrfun.h prcdrpsr.h constrnt.h argacces.h modulutl.h \ sysdep.h commline.h cstrcpsr.h ruledef.h cstrccom.h agenda.h match.h \ network.h pattern.h reorder.h constrnt.o: constrnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h constrnt.h crstrtgy.o: crstrtgy.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h pattern.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h reteutil.h argacces.h \ memalloc.h crstrtgy.h cstrcbin.o: cstrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h cstrcbin.h cstrccom.o: cstrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h argacces.h modulutl.h \ router.h prntutil.h commline.h sysdep.h bload.h exprnbin.h symblbin.h \ cstrcpsr.h cstrccom.h cstrcpsr.o: cstrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h watch.h \ prcdrpsr.h constrnt.h memalloc.h modulutl.h sysdep.h cstrcpsr.h cstrnbin.o: cstrnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h cstrnbin.h constrnt.h cstrnchk.o: cstrnchk.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnutl.h \ constrnt.h inscom.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h insfun.h classcom.h classexm.h cstrnchk.h cstrncmp.o: cstrncmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h memalloc.h router.h prntutil.h \ sysdep.h cstrncmp.h constrnt.h cstrnops.o: cstrnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h cstrnchk.h cstrnutl.h cstrnops.h cstrnpsr.o: cstrnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnutl.h constrnt.h cstrnchk.h sysdep.h cstrnpsr.h cstrnutl.o: cstrnutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrnutl.h constrnt.h default.o: default.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h inscom.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ insfun.h router.h prntutil.h factmngr.h facthsh.h tmpltdef.h factbld.h \ cstrnutl.h default.h defins.o: defins.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dfinsbin.h defins.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h dfinscmp.h argacces.h \ classcom.h classfun.h cstrcpsr.h insfun.h inspsr.h memalloc.h router.h \ prntutil.h developr.o: developr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h inscom.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h insfun.h modulutl.h router.h prntutil.h tmpltdef.h factbld.h \ factmngr.h facthsh.h classcom.h classfun.h objrtmch.h developr.h dffctbin.o: dffctbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h dffctbin.h modulbin.h \ cstrcbin.h dffctbsc.o: dffctbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h dffctpsr.h dffctdef.h dffctbin.h modulbin.h cstrcbin.h \ dffctcmp.h dffctbsc.h dffctcmp.o: dffctcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffctdef.h cstrccom.h dffctcmp.h dffctdef.o: dffctdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctpsr.h dffctbsc.h bload.h \ utility.h exprnbin.h sysdep.h symblbin.h dffctbin.h modulbin.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h cstrcbin.h \ dffctcmp.h dffctdef.h cstrccom.h dffctpsr.o: dffctpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrcpsr.h factrhs.h factmngr.h facthsh.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h \ factbld.h bload.h exprnbin.h sysdep.h symblbin.h dffctdef.h dffctbsc.h \ dffctpsr.h dffnxbin.o: dffnxbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h modulbin.h dffnxbin.h dffnxfun.h \ cstrccom.h dffnxcmp.o: dffnxcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffnxcmp.h dffnxfun.h cstrccom.h dffnxexe.o: dffnxexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h prcdrfun.h prccode.h proflfun.h \ router.h prntutil.h watch.h dffnxexe.h dffnxfun.h cstrccom.h dffnxfun.o: dffnxfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxbin.h dffnxfun.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h dffnxcmp.h cstrcpsr.h dffnxpsr.h \ dffnxexe.h watch.h argacces.h memalloc.h router.h prntutil.h dffnxpsr.o: dffnxpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h network.h match.h pattern.h reorder.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h \ agenda.h genrccom.h genrcfun.h object.h cstrcpsr.h dffnxfun.h \ memalloc.h prccode.h router.h prntutil.h dffnxpsr.h dfinsbin.o: dfinsbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ modulbin.h dfinsbin.h dfinscmp.o: dfinscmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ dfinscmp.h drive.o: drive.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ memalloc.h prntutil.h reteutil.h router.h incrrset.h drive.h emathfun.o: emathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ emathfun.h engine.o: engine.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h factmngr.h facthsh.h \ tmpltdef.h factbld.h inscom.h object.h insfun.h memalloc.h modulutl.h \ prccode.h prcdrfun.h proflfun.h reteutil.h retract.h router.h \ prntutil.h ruledlt.h sysdep.h watch.h engine.h lgcldpnd.h envrnmnt.o: envrnmnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h sysdep.h evaluatn.o: evaluatn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h prcdrfun.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h proflfun.h sysdep.h dffnxfun.h genrccom.h \ genrcfun.h object.h inscom.h insfun.h expressn.o: expressn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h memalloc.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h exprnbin.o: exprnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h agenda.h genrcbin.h \ genrcfun.h object.h dffnxbin.h dffnxfun.h tmpltbin.h cstrcbin.h \ modulbin.h tmpltdef.h factbld.h factmngr.h facthsh.h globlbin.h \ globldef.h objbin.h insfun.h inscom.h exprnops.o: exprnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnchk.h constrnt.h cstrnutl.h cstrnops.h exprnpsr.o: exprnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ memalloc.h argacces.h cstrnchk.h constrnt.h modulutl.h prcdrfun.h \ network.h match.h pattern.h reorder.h ruledef.h cstrccom.h agenda.h \ genrccom.h genrcfun.h object.h dffnxfun.h extnfunc.o: extnfunc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h factbin.o: factbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h tmpltdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h \ factbld.h pattern.h match.h network.h ruledef.h cstrccom.h agenda.h \ reorder.h factmngr.h facthsh.h bload.h exprnbin.h sysdep.h symblbin.h \ bsave.h reteutil.h rulebin.h modulbin.h cstrcbin.h factbin.h factbld.o: factbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reteutil.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h router.h \ prntutil.h factcmp.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factgen.h factlhs.h argacces.h modulutl.h factcmp.o: factcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h factcmp.h \ tmpltdef.h factmngr.h facthsh.h factcom.o: factcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h argacces.h router.h prntutil.h \ factrhs.h factmch.h tmpltpsr.h tmpltutl.h modulutl.h strngrtr.h \ tmpltfun.h sysdep.h bload.h exprnbin.h symblbin.h factcom.h factfun.o: factfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h tmpltutl.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h router.h sysdep.h \ factfun.h factgen.o: factgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ network.h match.h pattern.h reorder.h ruledef.h constrnt.h cstrccom.h \ agenda.h reteutil.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factrete.h factprt.h tmpltlhs.h factgen.h facthsh.o: facthsh.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h facthsh.h factmngr.h tmpltdef.h factbld.h factlhs.o: factlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrcpsr.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h router.h prntutil.h \ tmpltpsr.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltlhs.h \ tmpltutl.h modulutl.h factlhs.h factmch.o: factmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h factgen.h factrete.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h sysdep.h tmpltdef.h factbld.h factmngr.h facthsh.h \ factmch.h factmngr.o: factmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h strngrtr.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h factbld.h factqury.h \ factmngr.h facthsh.h tmpltdef.h reteutil.h retract.h factcmp.h \ filecom.h factfun.h factcom.h factrhs.h factmch.h watch.h factbin.h \ default.h commline.h sysdep.h engine.h lgcldpnd.h drive.h ruledlt.h \ tmpltbsc.h tmpltutl.h tmpltfun.h factprt.o: factprt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h factgen.h \ reorder.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h factprt.h factqpsr.o: factqpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factqury.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h modulutl.h prcdrpsr.h prntutil.h \ router.h strngrtr.h factqpsr.h factqury.o: factqury.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h modulutl.h \ tmpltutl.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h insfun.h \ object.h factqpsr.h prcdrfun.h router.h prntutil.h factqury.h factrete.o: factrete.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ incrrset.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h reteutil.h drive.h engine.h lgcldpnd.h retract.h \ factgen.h factmch.h factmngr.h facthsh.h tmpltdef.h factbld.h \ factrete.h factrhs.o: factrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h modulutl.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h prntutil.h \ cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltrhs.h tmpltutl.h \ strngrtr.h router.h factrhs.h filecom.o: filecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ memalloc.h prcdrfun.h router.h prntutil.h strngrtr.h sysdep.h \ filecom.h bsave.h bload.h exprnbin.h symblbin.h filertr.o: filertr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h filertr.h generate.o: generate.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h generate.h analysis.h globlpsr.h genrcbin.o: genrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h objbin.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h genrccom.h \ genrcfun.h modulbin.h genrcbin.h router.h prntutil.h genrccmp.o: genrccmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h genrccom.h genrcfun.h \ object.h objcmp.h genrccmp.h genrccom.o: genrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h bload.h exprnbin.h sysdep.h \ symblbin.h genrcbin.h genrcfun.h object.h genrccmp.h genrcpsr.h \ classcom.h inscom.h insfun.h watch.h argacces.h cstrcpsr.h genrcexe.h \ memalloc.h router.h prntutil.h genrccom.h genrcexe.o: genrcexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h insfun.h argacces.h genrccom.h genrcfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h genrcexe.h genrcfun.o: genrcfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h argacces.h cstrcpsr.h \ genrccom.h genrcfun.h genrcexe.h memalloc.h prccode.h router.h \ prntutil.h genrcpsr.o: genrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxfun.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h cstrccom.h classfun.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classcom.h memalloc.h \ cstrcpsr.h genrccom.h genrcfun.h immthpsr.h modulutl.h prcdrpsr.h \ prccode.h router.h prntutil.h genrcpsr.h globlbin.o: globlbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globldef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h globlbsc.h globlbin.h \ modulbin.h cstrcbin.h globlbsc.o: globlbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h watch.h globlcom.h globldef.h \ cstrccom.h globlbin.h modulbin.h cstrcbin.h globlcmp.h globlbsc.h globlcmp.o: globlcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h globldef.h cstrccom.h globlcmp.h globlcom.o: globlcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h router.h \ globldef.h cstrccom.h globlcom.h globldef.o: globldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h modulpsr.h moduldef.h \ conscomp.h constrct.h symblcmp.h utility.h router.h prntutil.h \ strngrtr.h modulutl.h globlbsc.h globlpsr.h globlcom.h commline.h \ bload.h exprnbin.h sysdep.h symblbin.h globlbin.h modulbin.h \ cstrcbin.h globldef.h cstrccom.h globlcmp.h globlpsr.o: globlpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ watch.h modulutl.h cstrcpsr.h globldef.h cstrccom.h globlbsc.h bload.h \ exprnbin.h sysdep.h symblbin.h globlpsr.h immthpsr.o: immthpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h cstrnutl.h genrcpsr.h genrcfun.h prccode.h \ immthpsr.h incrrset.o: incrrset.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h router.h prntutil.h reteutil.h incrrset.h inherpsr.o: inherpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h modulutl.h router.h prntutil.h inherpsr.h inscom.o: inscom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfile.h insfun.h insmngr.h \ insmoddp.h insmult.h inspsr.h lgcldpnd.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h commline.h inscom.h insfile.o: insfile.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h \ router.h prntutil.h strngrtr.h symblbin.h sysdep.h factmngr.h \ facthsh.h tmpltdef.h factbld.h insfile.h insfun.o: insfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h cstrnchk.h engine.h lgcldpnd.h retract.h inscom.h \ insfun.h insmngr.h memalloc.h modulutl.h msgcom.h msgpass.h msgfun.h \ prccode.h router.h prntutil.h drive.h objrtmch.h insmngr.o: insmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h drive.h objrtmch.h object.h \ lgcldpnd.h classcom.h classfun.h engine.h retract.h memalloc.h \ insfun.h modulutl.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h sysdep.h insmngr.h inscom.h watch.h insmoddp.o: insmoddp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h objrtmch.h object.h \ argacces.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h miscfun.h \ msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h insmoddp.h insmult.o: insmult.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h insfun.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h msgfun.h msgpass.h multifun.h router.h prntutil.h insmult.h inspsr.o: inspsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h prntutil.h router.h inspsr.h insquery.o: insquery.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h insmngr.h insqypsr.h \ prcdrfun.h router.h prntutil.h insquery.h insqypsr.o: insqypsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ insquery.h prcdrpsr.h prntutil.h router.h strngrtr.h insqypsr.h iofun.o: iofun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ filertr.h argacces.h memalloc.h commline.h sysdep.h iofun.h lgcldpnd.o: lgcldpnd.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h reteutil.h argacces.h \ factmngr.h facthsh.h tmpltdef.h factbld.h insfun.h object.h main.o: main.c clips.h setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h cstrcpsr.h \ filecom.h strngfun.h commline.h router.h prntutil.h filertr.h \ strngrtr.h iofun.h sysdep.h bmathfun.h watch.h modulbsc.h bload.h \ exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h cstrccom.h agenda.h \ match.h network.h pattern.h reorder.h rulebsc.h engine.h lgcldpnd.h \ retract.h drive.h incrrset.h rulecom.h crstrtgy.h dffctdef.h \ dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h \ tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h globlcom.h \ dffnxfun.h genrccom.h genrcfun.h object.h classcom.h classexm.h \ classinf.h classini.h classpsr.h defins.h inscom.h insfun.h insfile.h \ msgcom.h msgpass.h objrtmch.h memalloc.o: memalloc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h miscfun.o: miscfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h sysdep.h dffnxfun.h cstrccom.h miscfun.h modulbin.o: modulbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h modulbin.h modulbsc.o: modulbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h modulbin.h prntutil.h modulcmp.h \ router.h argacces.h bload.h exprnbin.h sysdep.h symblbin.h modulbsc.h modulcmp.o: modulcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h sysdep.h modulcmp.h moduldef.o: moduldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h modulcmp.h modulbsc.h bload.h exprnbin.h sysdep.h \ symblbin.h modulbin.h modulpsr.o: modulpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrcpsr.h modulutl.h bload.h exprnbin.h sysdep.h \ symblbin.h modulutl.o: modulutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h modulutl.h msgcom.o: msgcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfun.h insmoddp.h msgfun.h msgpass.h \ memalloc.h prccode.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h msgpsr.h watch.h msgcom.h msgfun.o: msgfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h insfun.h msgcom.h msgpass.h prccode.h router.h \ prntutil.h msgfun.h msgpass.o: msgpass.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h msgcom.h msgpass.h msgfun.h \ prcdrfun.h prccode.h proflfun.h router.h prntutil.h strngfun.h \ commline.h inscom.h msgpsr.o: msgpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h memalloc.h cstrcpsr.h \ cstrnchk.h insfun.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h strngrtr.h msgpsr.h multifld.o: multifld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ strngrtr.h object.h constrnt.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h multifun.o: multifun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifun.h \ prcdrpsr.h constrnt.h prcdrfun.h router.h prntutil.h object.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objbin.o: objbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h classcom.h cstrccom.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classfun.h classini.h \ cstrcbin.h cstrnbin.h insfun.h memalloc.h modulbin.h msgcom.h \ msgpass.h msgfun.h prntutil.h router.h objbin.h objcmp.o: objcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h classcom.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classini.h cstrncmp.h objrtfnx.h objrtmch.h sysdep.h \ objcmp.h objrtbin.o: objrtbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h insfun.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ reteutil.h rulebin.h modulbin.h cstrcbin.h objrtbin.h objrtbld.o: objrtbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnutl.h cstrnchk.h cstrnops.h drive.h inscom.h insfun.h \ insmngr.h memalloc.h reteutil.h rulepsr.h objrtmch.h objrtgen.h \ objrtfnx.h router.h prntutil.h objrtcmp.h objrtbin.h objrtbld.h objrtcmp.o: objrtcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h objrtfnx.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ sysdep.h objrtcmp.h objrtfnx.o: objrtfnx.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h bload.h exprnbin.h sysdep.h symblbin.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h objrtmch.h reteutil.h router.h \ prntutil.h objrtfnx.h objrtgen.o: objrtgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtfnx.h objrtmch.h objrtgen.h objrtmch.o: objrtmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h drive.h engine.h lgcldpnd.h retract.h incrrset.h reteutil.h \ ruledlt.h router.h prntutil.h objrtfnx.h objrtmch.h insmngr.h parsefun.o: parsefun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h memalloc.h \ prcdrpsr.h constrnt.h router.h prntutil.h strngrtr.h parsefun.h pattern.o: pattern.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h cstrnutl.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h reteutil.h router.h prntutil.h rulecmp.h pprint.o: pprint.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h sysdep.h utility.h prccode.o: prccode.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globlpsr.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h prcdrpsr.h router.h prntutil.h prccode.h prcdrfun.o: prcdrfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h memalloc.h prcdrpsr.h router.h prntutil.h prcdrfun.h \ globldef.h cstrccom.h prcdrpsr.o: prcdrpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h cstrnutl.h memalloc.h modulutl.h router.h prntutil.h \ prcdrpsr.h globldef.h cstrccom.h globlpsr.h prdctfun.o: prdctfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ prdctfun.h prntutil.o: prntutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h utility.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h router.h prntutil.h \ multifun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h inscom.h object.h insfun.h insmngr.h memalloc.h sysdep.h proflfun.o: proflfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h dffnxfun.h genrccom.h genrcfun.h memalloc.h msgcom.h \ msgpass.h router.h prntutil.h sysdep.h proflfun.h reorder.o: reorder.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrnutl.h constrnt.h memalloc.h \ pattern.h match.h network.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h cstrccom.h agenda.h reorder.h \ prntutil.h router.h rulelhs.h reteutil.o: reteutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h incrrset.h memalloc.h router.h prntutil.h rulecom.h \ reteutil.h retract.o: retract.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h reteutil.h router.h prntutil.h router.o: router.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h filertr.h memalloc.h \ strngrtr.h sysdep.h router.h prntutil.h rulebin.o: rulebin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h reteutil.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ rulebsc.h rulebin.h modulbin.h cstrcbin.h rulebld.o: rulebld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h drive.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h incrrset.h \ memalloc.h reteutil.h router.h prntutil.h rulebld.h rulepsr.h watch.h rulebsc.o: rulebsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h watch.h \ ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h pattern.h \ reorder.h engine.h lgcldpnd.h retract.h drive.h reteutil.h rulebin.h \ modulbin.h cstrcbin.h rulecmp.h rulebsc.h rulecmp.o: rulecmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h reteutil.h \ rulecmp.h rulecom.o: rulecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h ruledlt.h sysdep.h watch.h rulebin.h modulbin.h \ cstrcbin.h rulecom.h rulecstr.o: rulecstr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrnchk.h \ cstrnops.h cstrnutl.h prcdrpsr.h router.h prntutil.h rulepsr.h \ rulecstr.h ruledef.o: ruledef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h drive.h engine.h lgcldpnd.h \ retract.h memalloc.h reteutil.h rulebsc.h rulecom.h rulepsr.h \ ruledlt.h bload.h exprnbin.h sysdep.h symblbin.h rulebin.h modulbin.h \ cstrcbin.h rulecmp.h ruledlt.o: ruledlt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h engine.h lgcldpnd.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h \ reorder.h retract.h reteutil.h drive.h bload.h exprnbin.h sysdep.h \ symblbin.h ruledlt.h rulelhs.o: rulelhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h cstrnchk.h memalloc.h \ router.h prntutil.h rulelhs.h rulepsr.o: rulepsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrcpsr.h \ cstrnchk.h cstrnops.h engine.h lgcldpnd.h retract.h incrrset.h \ memalloc.h prccode.h prcdrpsr.h router.h prntutil.h rulebld.h \ rulebsc.h rulecstr.h ruledlt.h rulelhs.h watch.h tmpltfun.h factmngr.h \ facthsh.h tmpltdef.h factbld.h bload.h exprnbin.h sysdep.h symblbin.h \ rulepsr.h scanner.o: scanner.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ sysdep.h sortfun.o: sortfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h dffnxfun.h cstrccom.h \ memalloc.h sysdep.h sortfun.h strngfun.o: strngfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h memalloc.h prcdrpsr.h router.h \ prntutil.h strngrtr.h sysdep.h drive.h strngfun.h strngrtr.o: strngrtr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h strngrtr.h symblbin.o: symblbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h \ prntutil.h symblcmp.o: symblcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h symbol.o: symbol.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h sysdep.h sysdep.o: sysdep.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bmathfun.h commline.h \ constrnt.h cstrcpsr.h emathfun.h filecom.h iofun.h memalloc.h \ miscfun.h multifun.h parsefun.h prccode.h prdctfun.h proflfun.h \ prcdrfun.h router.h prntutil.h sortfun.h strngfun.h textpro.h watch.h \ sysdep.h dffctdef.h cstrccom.h ruledef.h agenda.h match.h network.h \ pattern.h reorder.h genrccom.h genrcfun.h object.h dffnxfun.h \ globldef.h tmpltdef.h factbld.h factmngr.h facthsh.h classini.h textpro.o: textpro.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h sysdep.h textpro.h tmpltbin.o: tmpltbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h factbin.h factbld.h pattern.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h cstrnbin.h \ factmngr.h facthsh.h tmpltdef.h tmpltpsr.h tmpltutl.h tmpltbin.h \ cstrcbin.h modulbin.h tmpltbsc.o: tmpltbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h tmpltpsr.h tmpltbin.h cstrcbin.h modulbin.h tmpltcmp.h \ tmpltutl.h tmpltbsc.h tmpltcmp.o: tmpltcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h factcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h cstrncmp.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltcmp.h tmpltdef.o: tmpltdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h network.h \ match.h pattern.h reorder.h ruledef.h constrnt.h agenda.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h tmpltutl.h \ tmpltfun.h router.h prntutil.h modulutl.h cstrnchk.h bload.h \ exprnbin.h sysdep.h symblbin.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltcmp.h tmpltfun.o: tmpltfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h cstrnchk.h constrnt.h default.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h commline.h factrhs.h modulutl.h sysdep.h \ tmpltlhs.h tmpltutl.h tmpltrhs.h tmpltfun.h tmpltlhs.o: tmpltlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h reorder.h ruledef.h cstrccom.h agenda.h match.h network.h \ pattern.h factrhs.h factmngr.h facthsh.h tmpltdef.h factbld.h \ modulutl.h tmpltutl.h tmpltlhs.h tmpltpsr.o: tmpltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h cstrnchk.h \ cstrnpsr.h cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h default.h \ watch.h cstrnutl.h tmpltbsc.h tmpltpsr.h tmpltrhs.o: tmpltrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ tmpltfun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ factrhs.h modulutl.h default.h tmpltutl.h tmpltlhs.h tmpltrhs.h tmpltutl.o: tmpltutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ argacces.h cstrnchk.h constrnt.h tmpltfun.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h tmpltpsr.h modulutl.h watch.h sysdep.h tmpltbsc.h \ tmpltutl.h userdata.o: userdata.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h userfunctions.o: userfunctions.c clips.h setup.h envrnmnt.h symbol.h \ multifld.h evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h usrsetup.h argacces.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ memalloc.h cstrcpsr.h filecom.h strngfun.h commline.h router.h \ prntutil.h filertr.h strngrtr.h iofun.h sysdep.h bmathfun.h watch.h \ modulbsc.h bload.h exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h rulebsc.h \ engine.h lgcldpnd.h retract.h drive.h incrrset.h rulecom.h crstrtgy.h \ dffctdef.h dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h \ tmpltbsc.h tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h \ globlcom.h dffnxfun.h genrccom.h genrcfun.h object.h classcom.h \ classexm.h classinf.h classini.h classpsr.h defins.h inscom.h insfun.h \ insfile.h msgcom.h msgpass.h objrtmch.h utility.o: utility.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h commline.h facthsh.h factmngr.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h memalloc.h prntutil.h sysdep.h watch.o: watch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h watch.h clips_core_source_630/makefiles/makefile.win0000644000175000017500000022241612504565277017556 0ustar jfsjfs# To setup Visual Studio for command line compilation, execute vcvarsall.bat: # c:\Program Files (x86)\Microsoft Visual Studio 12.0\VC>vcvarsall.bat # To run the makefile: # nmake -f makefile.win OBJS = agenda.obj analysis.obj argacces.obj bload.obj bmathfun.obj bsave.obj \ classcom.obj classexm.obj classfun.obj classinf.obj classini.obj \ classpsr.obj clsltpsr.obj commline.obj conscomp.obj constrct.obj \ constrnt.obj crstrtgy.obj cstrcbin.obj cstrccom.obj cstrcpsr.obj \ cstrnbin.obj cstrnchk.obj cstrncmp.obj cstrnops.obj cstrnpsr.obj \ cstrnutl.obj default.obj defins.obj developr.obj dffctbin.obj dffctbsc.obj \ dffctcmp.obj dffctdef.obj dffctpsr.obj dffnxbin.obj dffnxcmp.obj \ dffnxexe.obj dffnxfun.obj dffnxpsr.obj dfinsbin.obj dfinscmp.obj drive.obj \ emathfun.obj \ engine.obj envrnmnt.obj evaluatn.obj expressn.obj exprnbin.obj exprnops.obj \ exprnpsr.obj extnfunc.obj factbin.obj factbld.obj factcmp.obj factcom.obj \ factfun.obj factgen.obj facthsh.obj factlhs.obj factmch.obj factmngr.obj \ factprt.obj factqpsr.obj factqury.obj factrete.obj factrhs.obj filecom.obj \ filertr.obj generate.obj genrcbin.obj genrccmp.obj genrccom.obj genrcexe.obj \ genrcfun.obj genrcpsr.obj globlbin.obj globlbsc.obj globlcmp.obj globlcom.obj \ globldef.obj globlpsr.obj immthpsr.obj incrrset.obj inherpsr.obj \ inscom.obj insfile.obj insfun.obj insmngr.obj insmoddp.obj insmult.obj \ inspsr.obj insquery.obj insqypsr.obj iofun.obj lgcldpnd.obj main.obj\ memalloc.obj miscfun.obj modulbin.obj modulbsc.obj modulcmp.obj moduldef.obj \ modulpsr.obj modulutl.obj msgcom.obj msgfun.obj msgpass.obj msgpsr.obj \ multifld.obj multifun.obj objbin.obj objcmp.obj objrtbin.obj objrtbld.obj \ objrtcmp.obj objrtfnx.obj objrtgen.obj objrtmch.obj parsefun.obj pattern.obj \ pprint.obj prccode.obj prcdrfun.obj prcdrpsr.obj prdctfun.obj prntutil.obj \ proflfun.obj reorder.obj reteutil.obj retract.obj router.obj rulebin.obj \ rulebld.obj rulebsc.obj rulecmp.obj rulecom.obj rulecstr.obj ruledef.obj \ ruledlt.obj rulelhs.obj rulepsr.obj scanner.obj sortfun.obj strngfun.obj \ strngrtr.obj symblbin.obj symblcmp.obj symbol.obj sysdep.obj textpro.obj \ tmpltbin.obj tmpltbsc.obj tmpltcmp.obj tmpltdef.obj tmpltfun.obj tmpltlhs.obj \ tmpltpsr.obj tmpltrhs.obj tmpltutl.obj userdata.obj userfunctions.obj \ utility.obj watch.obj .c.obj : cl -c -DWIN_MVC $< clips : $(OBJS) cl /Fe"clips.exe" $(OBJS) agenda.obj: agenda.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h memalloc.h modulutl.h reteutil.h \ router.h prntutil.h rulebsc.h strngrtr.h sysdep.h watch.h analysis.obj: analysis.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h generate.h \ analysis.h router.h prntutil.h cstrnchk.h cstrnutl.h cstrnops.h \ rulecstr.h modulutl.h watch.h rulepsr.h globldef.h argacces.obj: argacces.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnchk.h \ constrnt.h insfun.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h factmngr.h facthsh.h tmpltdef.h factbld.h \ sysdep.h argacces.h bload.obj: bload.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bsave.h cstrnbin.h \ constrnt.h memalloc.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h bmathfun.obj: bmathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ bmathfun.h bsave.obj: bsave.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h cstrnbin.h constrnt.h memalloc.h router.h prntutil.h \ bsave.h classcom.obj: classcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h argacces.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h classfun.h object.h constrnt.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h classini.h modulutl.h msgcom.h \ msgpass.h router.h prntutil.h classcom.h classexm.obj: classexm.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classini.h insfun.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h classexm.h classfun.obj: classfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classini.h cstrcpsr.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgfun.h msgpass.h router.h prntutil.h \ classfun.h classinf.obj: classinf.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classexm.h classfun.h classini.h memalloc.h insfun.h \ msgcom.h msgpass.h msgfun.h prntutil.h classinf.h classini.obj: classini.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classexm.h classfun.h classinf.h classpsr.h cstrcpsr.h inscom.h \ insfun.h memalloc.h modulutl.h msgcom.h msgpass.h watch.h defins.h \ insquery.h bload.h exprnbin.h sysdep.h symblbin.h objbin.h objcmp.h \ objrtbld.h objrtfnx.h objrtmch.h classini.h classpsr.obj: classpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h clsltpsr.h cstrcpsr.h \ inherpsr.h memalloc.h modulutl.h msgpsr.h router.h prntutil.h \ classpsr.h clsltpsr.obj: clsltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h cstrnpsr.h cstrnutl.h default.h insfun.h \ memalloc.h prntutil.h router.h clsltpsr.h commline.obj: commline.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h filecom.h \ memalloc.h prcdrfun.h prcdrpsr.h constrnt.h router.h prntutil.h \ strngrtr.h sysdep.h commline.h conscomp.obj: conscomp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h modulcmp.h \ network.h match.h pattern.h reorder.h ruledef.h agenda.h dffnxcmp.h \ dffnxfun.h tmpltcmp.h globlcmp.h genrccmp.h genrcfun.h object.h \ objcmp.h constrct.obj: constrct.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ watch.h prcdrfun.h prcdrpsr.h constrnt.h argacces.h modulutl.h \ sysdep.h commline.h cstrcpsr.h ruledef.h cstrccom.h agenda.h match.h \ network.h pattern.h reorder.h constrnt.obj: constrnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h constrnt.h crstrtgy.obj: crstrtgy.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h pattern.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h reteutil.h argacces.h \ memalloc.h crstrtgy.h cstrcbin.obj: cstrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h cstrcbin.h cstrccom.obj: cstrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h argacces.h modulutl.h \ router.h prntutil.h commline.h sysdep.h bload.h exprnbin.h symblbin.h \ cstrcpsr.h cstrccom.h cstrcpsr.obj: cstrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h watch.h \ prcdrpsr.h constrnt.h memalloc.h modulutl.h sysdep.h cstrcpsr.h cstrnbin.obj: cstrnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h cstrnbin.h constrnt.h cstrnchk.obj: cstrnchk.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnutl.h \ constrnt.h inscom.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h insfun.h classcom.h classexm.h cstrnchk.h cstrncmp.obj: cstrncmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h memalloc.h router.h prntutil.h \ sysdep.h cstrncmp.h constrnt.h cstrnops.obj: cstrnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h cstrnchk.h cstrnutl.h cstrnops.h cstrnpsr.obj: cstrnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnutl.h constrnt.h cstrnchk.h sysdep.h cstrnpsr.h cstrnutl.obj: cstrnutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrnutl.h constrnt.h default.obj: default.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h inscom.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ insfun.h router.h prntutil.h factmngr.h facthsh.h tmpltdef.h factbld.h \ cstrnutl.h default.h defins.obj: defins.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dfinsbin.h defins.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h dfinscmp.h argacces.h \ classcom.h classfun.h cstrcpsr.h insfun.h inspsr.h memalloc.h router.h \ prntutil.h developr.obj: developr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h inscom.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h insfun.h modulutl.h router.h prntutil.h tmpltdef.h factbld.h \ factmngr.h facthsh.h classcom.h classfun.h objrtmch.h developr.h dffctbin.obj: dffctbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h dffctbin.h modulbin.h \ cstrcbin.h dffctbsc.obj: dffctbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h dffctpsr.h dffctdef.h dffctbin.h modulbin.h cstrcbin.h \ dffctcmp.h dffctbsc.h dffctcmp.obj: dffctcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffctdef.h cstrccom.h dffctcmp.h dffctdef.obj: dffctdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctpsr.h dffctbsc.h bload.h \ utility.h exprnbin.h sysdep.h symblbin.h dffctbin.h modulbin.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h cstrcbin.h \ dffctcmp.h dffctdef.h cstrccom.h dffctpsr.obj: dffctpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrcpsr.h factrhs.h factmngr.h facthsh.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h \ factbld.h bload.h exprnbin.h sysdep.h symblbin.h dffctdef.h dffctbsc.h \ dffctpsr.h dffnxbin.obj: dffnxbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h modulbin.h dffnxbin.h dffnxfun.h \ cstrccom.h dffnxcmp.obj: dffnxcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffnxcmp.h dffnxfun.h cstrccom.h dffnxexe.obj: dffnxexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h prcdrfun.h prccode.h proflfun.h \ router.h prntutil.h watch.h dffnxexe.h dffnxfun.h cstrccom.h dffnxfun.obj: dffnxfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxbin.h dffnxfun.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h dffnxcmp.h cstrcpsr.h dffnxpsr.h \ dffnxexe.h watch.h argacces.h memalloc.h router.h prntutil.h dffnxpsr.obj: dffnxpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h network.h match.h pattern.h reorder.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h \ agenda.h genrccom.h genrcfun.h object.h cstrcpsr.h dffnxfun.h \ memalloc.h prccode.h router.h prntutil.h dffnxpsr.h dfinsbin.obj: dfinsbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ modulbin.h dfinsbin.h dfinscmp.obj: dfinscmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ dfinscmp.h drive.obj: drive.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ memalloc.h prntutil.h reteutil.h router.h incrrset.h drive.h emathfun.obj: emathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ emathfun.h engine.obj: engine.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h factmngr.h facthsh.h \ tmpltdef.h factbld.h inscom.h object.h insfun.h memalloc.h modulutl.h \ prccode.h prcdrfun.h proflfun.h reteutil.h retract.h router.h \ prntutil.h ruledlt.h sysdep.h watch.h engine.h lgcldpnd.h envrnmnt.obj: envrnmnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h sysdep.h evaluatn.obj: evaluatn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h prcdrfun.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h proflfun.h sysdep.h dffnxfun.h genrccom.h \ genrcfun.h object.h inscom.h insfun.h expressn.obj: expressn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h memalloc.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h exprnbin.obj: exprnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h agenda.h genrcbin.h \ genrcfun.h object.h dffnxbin.h dffnxfun.h tmpltbin.h cstrcbin.h \ modulbin.h tmpltdef.h factbld.h factmngr.h facthsh.h globlbin.h \ globldef.h objbin.h insfun.h inscom.h exprnops.obj: exprnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnchk.h constrnt.h cstrnutl.h cstrnops.h exprnpsr.obj: exprnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ memalloc.h argacces.h cstrnchk.h constrnt.h modulutl.h prcdrfun.h \ network.h match.h pattern.h reorder.h ruledef.h cstrccom.h agenda.h \ genrccom.h genrcfun.h object.h dffnxfun.h extnfunc.obj: extnfunc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h factbin.obj: factbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h tmpltdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h \ factbld.h pattern.h match.h network.h ruledef.h cstrccom.h agenda.h \ reorder.h factmngr.h facthsh.h bload.h exprnbin.h sysdep.h symblbin.h \ bsave.h reteutil.h rulebin.h modulbin.h cstrcbin.h factbin.h factbld.obj: factbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reteutil.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h router.h \ prntutil.h factcmp.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factgen.h factlhs.h argacces.h modulutl.h factcmp.obj: factcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h factcmp.h \ tmpltdef.h factmngr.h facthsh.h factcom.obj: factcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h argacces.h router.h prntutil.h \ factrhs.h factmch.h tmpltpsr.h tmpltutl.h modulutl.h strngrtr.h \ tmpltfun.h sysdep.h bload.h exprnbin.h symblbin.h factcom.h factfun.obj: factfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h tmpltutl.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h router.h sysdep.h \ factfun.h factgen.obj: factgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ network.h match.h pattern.h reorder.h ruledef.h constrnt.h cstrccom.h \ agenda.h reteutil.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factrete.h factprt.h tmpltlhs.h factgen.h facthsh.obj: facthsh.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h facthsh.h factmngr.h tmpltdef.h factbld.h factlhs.obj: factlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrcpsr.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h router.h prntutil.h \ tmpltpsr.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltlhs.h \ tmpltutl.h modulutl.h factlhs.h factmch.obj: factmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h factgen.h factrete.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h sysdep.h tmpltdef.h factbld.h factmngr.h facthsh.h \ factmch.h factmngr.obj: factmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h strngrtr.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h factbld.h factqury.h \ factmngr.h facthsh.h tmpltdef.h reteutil.h retract.h factcmp.h \ filecom.h factfun.h factcom.h factrhs.h factmch.h watch.h factbin.h \ default.h commline.h sysdep.h engine.h lgcldpnd.h drive.h ruledlt.h \ tmpltbsc.h tmpltutl.h tmpltfun.h factprt.obj: factprt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h factgen.h \ reorder.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h factprt.h factqpsr.obj: factqpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factqury.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h modulutl.h prcdrpsr.h prntutil.h \ router.h strngrtr.h factqpsr.h factqury.obj: factqury.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h modulutl.h \ tmpltutl.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h insfun.h \ object.h factqpsr.h prcdrfun.h router.h prntutil.h factqury.h factrete.obj: factrete.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ incrrset.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h reteutil.h drive.h engine.h lgcldpnd.h retract.h \ factgen.h factmch.h factmngr.h facthsh.h tmpltdef.h factbld.h \ factrete.h factrhs.obj: factrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h modulutl.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h prntutil.h \ cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltrhs.h tmpltutl.h \ strngrtr.h router.h factrhs.h filecom.obj: filecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ memalloc.h prcdrfun.h router.h prntutil.h strngrtr.h sysdep.h \ filecom.h bsave.h bload.h exprnbin.h symblbin.h filertr.obj: filertr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h filertr.h generate.obj: generate.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h generate.h analysis.h globlpsr.h genrcbin.obj: genrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h objbin.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h genrccom.h \ genrcfun.h modulbin.h genrcbin.h router.h prntutil.h genrccmp.obj: genrccmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h genrccom.h genrcfun.h \ object.h objcmp.h genrccmp.h genrccom.obj: genrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h bload.h exprnbin.h sysdep.h \ symblbin.h genrcbin.h genrcfun.h object.h genrccmp.h genrcpsr.h \ classcom.h inscom.h insfun.h watch.h argacces.h cstrcpsr.h genrcexe.h \ memalloc.h router.h prntutil.h genrccom.h genrcexe.obj: genrcexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h insfun.h argacces.h genrccom.h genrcfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h genrcexe.h genrcfun.obj: genrcfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h argacces.h cstrcpsr.h \ genrccom.h genrcfun.h genrcexe.h memalloc.h prccode.h router.h \ prntutil.h genrcpsr.obj: genrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxfun.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h cstrccom.h classfun.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classcom.h memalloc.h \ cstrcpsr.h genrccom.h genrcfun.h immthpsr.h modulutl.h prcdrpsr.h \ prccode.h router.h prntutil.h genrcpsr.h globlbin.obj: globlbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globldef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h globlbsc.h globlbin.h \ modulbin.h cstrcbin.h globlbsc.obj: globlbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h watch.h globlcom.h globldef.h \ cstrccom.h globlbin.h modulbin.h cstrcbin.h globlcmp.h globlbsc.h globlcmp.obj: globlcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h globldef.h cstrccom.h globlcmp.h globlcom.obj: globlcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h router.h \ globldef.h cstrccom.h globlcom.h globldef.obj: globldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h modulpsr.h moduldef.h \ conscomp.h constrct.h symblcmp.h utility.h router.h prntutil.h \ strngrtr.h modulutl.h globlbsc.h globlpsr.h globlcom.h commline.h \ bload.h exprnbin.h sysdep.h symblbin.h globlbin.h modulbin.h \ cstrcbin.h globldef.h cstrccom.h globlcmp.h globlpsr.obj: globlpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ watch.h modulutl.h cstrcpsr.h globldef.h cstrccom.h globlbsc.h bload.h \ exprnbin.h sysdep.h symblbin.h globlpsr.h immthpsr.obj: immthpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h cstrnutl.h genrcpsr.h genrcfun.h prccode.h \ immthpsr.h incrrset.obj: incrrset.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h router.h prntutil.h reteutil.h incrrset.h inherpsr.obj: inherpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h modulutl.h router.h prntutil.h inherpsr.h inscom.obj: inscom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfile.h insfun.h insmngr.h \ insmoddp.h insmult.h inspsr.h lgcldpnd.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h commline.h inscom.h insfile.obj: insfile.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h \ router.h prntutil.h strngrtr.h symblbin.h sysdep.h factmngr.h \ facthsh.h tmpltdef.h factbld.h insfile.h insfun.obj: insfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h cstrnchk.h engine.h lgcldpnd.h retract.h inscom.h \ insfun.h insmngr.h memalloc.h modulutl.h msgcom.h msgpass.h msgfun.h \ prccode.h router.h prntutil.h drive.h objrtmch.h insmngr.obj: insmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h drive.h objrtmch.h object.h \ lgcldpnd.h classcom.h classfun.h engine.h retract.h memalloc.h \ insfun.h modulutl.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h sysdep.h insmngr.h inscom.h watch.h insmoddp.obj: insmoddp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h objrtmch.h object.h \ argacces.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h miscfun.h \ msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h insmoddp.h insmult.obj: insmult.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h insfun.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h msgfun.h msgpass.h multifun.h router.h prntutil.h insmult.h inspsr.obj: inspsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h prntutil.h router.h inspsr.h insquery.obj: insquery.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h insmngr.h insqypsr.h \ prcdrfun.h router.h prntutil.h insquery.h insqypsr.obj: insqypsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ insquery.h prcdrpsr.h prntutil.h router.h strngrtr.h insqypsr.h iofun.obj: iofun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ filertr.h argacces.h memalloc.h commline.h sysdep.h iofun.h lgcldpnd.obj: lgcldpnd.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h reteutil.h argacces.h \ factmngr.h facthsh.h tmpltdef.h factbld.h insfun.h object.h main.obj: main.c clips.h setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h cstrcpsr.h \ filecom.h strngfun.h commline.h router.h prntutil.h filertr.h \ strngrtr.h iofun.h sysdep.h bmathfun.h watch.h modulbsc.h bload.h \ exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h cstrccom.h agenda.h \ match.h network.h pattern.h reorder.h rulebsc.h engine.h lgcldpnd.h \ retract.h drive.h incrrset.h rulecom.h crstrtgy.h dffctdef.h \ dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h \ tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h globlcom.h \ dffnxfun.h genrccom.h genrcfun.h object.h classcom.h classexm.h \ classinf.h classini.h classpsr.h defins.h inscom.h insfun.h insfile.h \ msgcom.h msgpass.h objrtmch.h memalloc.obj: memalloc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h miscfun.obj: miscfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h sysdep.h dffnxfun.h cstrccom.h miscfun.h modulbin.obj: modulbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h modulbin.h modulbsc.obj: modulbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h modulbin.h prntutil.h modulcmp.h \ router.h argacces.h bload.h exprnbin.h sysdep.h symblbin.h modulbsc.h modulcmp.obj: modulcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h sysdep.h modulcmp.h moduldef.obj: moduldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h modulcmp.h modulbsc.h bload.h exprnbin.h sysdep.h \ symblbin.h modulbin.h modulpsr.obj: modulpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrcpsr.h modulutl.h bload.h exprnbin.h sysdep.h \ symblbin.h modulutl.obj: modulutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h modulutl.h msgcom.obj: msgcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfun.h insmoddp.h msgfun.h msgpass.h \ memalloc.h prccode.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h msgpsr.h watch.h msgcom.h msgfun.obj: msgfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h insfun.h msgcom.h msgpass.h prccode.h router.h \ prntutil.h msgfun.h msgpass.obj: msgpass.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h msgcom.h msgpass.h msgfun.h \ prcdrfun.h prccode.h proflfun.h router.h prntutil.h strngfun.h \ commline.h inscom.h msgpsr.obj: msgpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h memalloc.h cstrcpsr.h \ cstrnchk.h insfun.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h strngrtr.h msgpsr.h multifld.obj: multifld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ strngrtr.h object.h constrnt.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h multifun.obj: multifun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifun.h \ prcdrpsr.h constrnt.h prcdrfun.h router.h prntutil.h object.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objbin.obj: objbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h classcom.h cstrccom.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classfun.h classini.h \ cstrcbin.h cstrnbin.h insfun.h memalloc.h modulbin.h msgcom.h \ msgpass.h msgfun.h prntutil.h router.h objbin.h objcmp.obj: objcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h classcom.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classini.h cstrncmp.h objrtfnx.h objrtmch.h sysdep.h \ objcmp.h objrtbin.obj: objrtbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h insfun.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ reteutil.h rulebin.h modulbin.h cstrcbin.h objrtbin.h objrtbld.obj: objrtbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnutl.h cstrnchk.h cstrnops.h drive.h inscom.h insfun.h \ insmngr.h memalloc.h reteutil.h rulepsr.h objrtmch.h objrtgen.h \ objrtfnx.h router.h prntutil.h objrtcmp.h objrtbin.h objrtbld.h objrtcmp.obj: objrtcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h objrtfnx.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ sysdep.h objrtcmp.h objrtfnx.obj: objrtfnx.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h bload.h exprnbin.h sysdep.h symblbin.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h objrtmch.h reteutil.h router.h \ prntutil.h objrtfnx.h objrtgen.obj: objrtgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtfnx.h objrtmch.h objrtgen.h objrtmch.obj: objrtmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h drive.h engine.h lgcldpnd.h retract.h incrrset.h reteutil.h \ ruledlt.h router.h prntutil.h objrtfnx.h objrtmch.h insmngr.h parsefun.obj: parsefun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h memalloc.h \ prcdrpsr.h constrnt.h router.h prntutil.h strngrtr.h parsefun.h pattern.obj: pattern.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h cstrnutl.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h reteutil.h router.h prntutil.h rulecmp.h pprint.obj: pprint.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h sysdep.h utility.h prccode.obj: prccode.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globlpsr.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h prcdrpsr.h router.h prntutil.h prccode.h prcdrfun.obj: prcdrfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h memalloc.h prcdrpsr.h router.h prntutil.h prcdrfun.h \ globldef.h cstrccom.h prcdrpsr.obj: prcdrpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h cstrnutl.h memalloc.h modulutl.h router.h prntutil.h \ prcdrpsr.h globldef.h cstrccom.h globlpsr.h prdctfun.obj: prdctfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ prdctfun.h prntutil.obj: prntutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h utility.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h router.h prntutil.h \ multifun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h inscom.h object.h insfun.h insmngr.h memalloc.h sysdep.h proflfun.obj: proflfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h dffnxfun.h genrccom.h genrcfun.h memalloc.h msgcom.h \ msgpass.h router.h prntutil.h sysdep.h proflfun.h reorder.obj: reorder.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrnutl.h constrnt.h memalloc.h \ pattern.h match.h network.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h cstrccom.h agenda.h reorder.h \ prntutil.h router.h rulelhs.h reteutil.obj: reteutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h incrrset.h memalloc.h router.h prntutil.h rulecom.h \ reteutil.h retract.obj: retract.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h reteutil.h router.h prntutil.h router.obj: router.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h filertr.h memalloc.h \ strngrtr.h sysdep.h router.h prntutil.h rulebin.obj: rulebin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h reteutil.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ rulebsc.h rulebin.h modulbin.h cstrcbin.h rulebld.obj: rulebld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h drive.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h incrrset.h \ memalloc.h reteutil.h router.h prntutil.h rulebld.h rulepsr.h watch.h rulebsc.obj: rulebsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h watch.h \ ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h pattern.h \ reorder.h engine.h lgcldpnd.h retract.h drive.h reteutil.h rulebin.h \ modulbin.h cstrcbin.h rulecmp.h rulebsc.h rulecmp.obj: rulecmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h reteutil.h \ rulecmp.h rulecom.obj: rulecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h ruledlt.h sysdep.h watch.h rulebin.h modulbin.h \ cstrcbin.h rulecom.h rulecstr.obj: rulecstr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrnchk.h \ cstrnops.h cstrnutl.h prcdrpsr.h router.h prntutil.h rulepsr.h \ rulecstr.h ruledef.obj: ruledef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h drive.h engine.h lgcldpnd.h \ retract.h memalloc.h reteutil.h rulebsc.h rulecom.h rulepsr.h \ ruledlt.h bload.h exprnbin.h sysdep.h symblbin.h rulebin.h modulbin.h \ cstrcbin.h rulecmp.h ruledlt.obj: ruledlt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h engine.h lgcldpnd.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h \ reorder.h retract.h reteutil.h drive.h bload.h exprnbin.h sysdep.h \ symblbin.h ruledlt.h rulelhs.obj: rulelhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h cstrnchk.h memalloc.h \ router.h prntutil.h rulelhs.h rulepsr.obj: rulepsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrcpsr.h \ cstrnchk.h cstrnops.h engine.h lgcldpnd.h retract.h incrrset.h \ memalloc.h prccode.h prcdrpsr.h router.h prntutil.h rulebld.h \ rulebsc.h rulecstr.h ruledlt.h rulelhs.h watch.h tmpltfun.h factmngr.h \ facthsh.h tmpltdef.h factbld.h bload.h exprnbin.h sysdep.h symblbin.h \ rulepsr.h scanner.obj: scanner.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ sysdep.h sortfun.obj: sortfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h dffnxfun.h cstrccom.h \ memalloc.h sysdep.h sortfun.h strngfun.obj: strngfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h memalloc.h prcdrpsr.h router.h \ prntutil.h strngrtr.h sysdep.h drive.h strngfun.h strngrtr.obj: strngrtr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h strngrtr.h symblbin.obj: symblbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h \ prntutil.h symblcmp.obj: symblcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h symbol.obj: symbol.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h sysdep.h sysdep.obj: sysdep.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bmathfun.h commline.h \ constrnt.h cstrcpsr.h emathfun.h filecom.h iofun.h memalloc.h \ miscfun.h multifun.h parsefun.h prccode.h prdctfun.h proflfun.h \ prcdrfun.h router.h prntutil.h sortfun.h strngfun.h textpro.h watch.h \ sysdep.h dffctdef.h cstrccom.h ruledef.h agenda.h match.h network.h \ pattern.h reorder.h genrccom.h genrcfun.h object.h dffnxfun.h \ globldef.h tmpltdef.h factbld.h factmngr.h facthsh.h classini.h textpro.obj: textpro.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h sysdep.h textpro.h tmpltbin.obj: tmpltbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h factbin.h factbld.h pattern.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h cstrnbin.h \ factmngr.h facthsh.h tmpltdef.h tmpltpsr.h tmpltutl.h tmpltbin.h \ cstrcbin.h modulbin.h tmpltbsc.obj: tmpltbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h tmpltpsr.h tmpltbin.h cstrcbin.h modulbin.h tmpltcmp.h \ tmpltutl.h tmpltbsc.h tmpltcmp.obj: tmpltcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h factcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h cstrncmp.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltcmp.h tmpltdef.obj: tmpltdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h network.h \ match.h pattern.h reorder.h ruledef.h constrnt.h agenda.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h tmpltutl.h \ tmpltfun.h router.h prntutil.h modulutl.h cstrnchk.h bload.h \ exprnbin.h sysdep.h symblbin.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltcmp.h tmpltfun.obj: tmpltfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h cstrnchk.h constrnt.h default.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h commline.h factrhs.h modulutl.h sysdep.h \ tmpltlhs.h tmpltutl.h tmpltrhs.h tmpltfun.h tmpltlhs.obj: tmpltlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h reorder.h ruledef.h cstrccom.h agenda.h match.h network.h \ pattern.h factrhs.h factmngr.h facthsh.h tmpltdef.h factbld.h \ modulutl.h tmpltutl.h tmpltlhs.h tmpltpsr.obj: tmpltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h cstrnchk.h \ cstrnpsr.h cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h default.h \ watch.h cstrnutl.h tmpltbsc.h tmpltpsr.h tmpltrhs.obj: tmpltrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ tmpltfun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ factrhs.h modulutl.h default.h tmpltutl.h tmpltlhs.h tmpltrhs.h tmpltutl.obj: tmpltutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ argacces.h cstrnchk.h constrnt.h tmpltfun.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h tmpltpsr.h modulutl.h watch.h sysdep.h tmpltbsc.h \ tmpltutl.h userdata.obj: userdata.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h userfunctions.obj: userfunctions.c clips.h setup.h envrnmnt.h symbol.h \ multifld.h evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h usrsetup.h argacces.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ memalloc.h cstrcpsr.h filecom.h strngfun.h commline.h router.h \ prntutil.h filertr.h strngrtr.h iofun.h sysdep.h bmathfun.h watch.h \ modulbsc.h bload.h exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h rulebsc.h \ engine.h lgcldpnd.h retract.h drive.h incrrset.h rulecom.h crstrtgy.h \ dffctdef.h dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h \ tmpltbsc.h tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h \ globlcom.h dffnxfun.h genrccom.h genrcfun.h object.h classcom.h \ classexm.h classinf.h classini.h classpsr.h defins.h inscom.h insfun.h \ insfile.h msgcom.h msgpass.h objrtmch.h utility.obj: utility.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h commline.h facthsh.h factmngr.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h memalloc.h prntutil.h sysdep.h watch.obj: watch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h watch.h clips_core_source_630/makefiles/makefile.gcc0000755000175000017500000021665712504556217017524 0ustar jfsjfsOBJS = agenda.o analysis.o argacces.o bload.o bmathfun.o bsave.o \ classcom.o classexm.o classfun.o classinf.o classini.o \ classpsr.o clsltpsr.o commline.o conscomp.o constrct.o \ constrnt.o crstrtgy.o cstrcbin.o cstrccom.o cstrcpsr.o \ cstrnbin.o cstrnchk.o cstrncmp.o cstrnops.o cstrnpsr.o \ cstrnutl.o default.o defins.o developr.o dffctbin.o dffctbsc.o \ dffctcmp.o dffctdef.o dffctpsr.o dffnxbin.o dffnxcmp.o \ dffnxexe.o dffnxfun.o dffnxpsr.o dfinsbin.o dfinscmp.o drive.o \ emathfun.o \ engine.o envrnmnt.o evaluatn.o expressn.o exprnbin.o exprnops.o \ exprnpsr.o extnfunc.o factbin.o factbld.o factcmp.o factcom.o \ factfun.o factgen.o facthsh.o factlhs.o factmch.o factmngr.o \ factprt.o factqpsr.o factqury.o factrete.o factrhs.o filecom.o filertr.o \ generate.o genrcbin.o genrccmp.o genrccom.o genrcexe.o genrcfun.o \ genrcpsr.o globlbin.o globlbsc.o globlcmp.o globlcom.o \ globldef.o globlpsr.o immthpsr.o incrrset.o inherpsr.o \ inscom.o insfile.o insfun.o insmngr.o insmoddp.o insmult.o \ inspsr.o insquery.o insqypsr.o iofun.o lgcldpnd.o main.o \ memalloc.o miscfun.o modulbin.o modulbsc.o modulcmp.o moduldef.o \ modulpsr.o modulutl.o msgcom.o msgfun.o msgpass.o msgpsr.o \ multifld.o multifun.o objbin.o objcmp.o objrtbin.o objrtbld.o \ objrtcmp.o objrtfnx.o objrtgen.o objrtmch.o parsefun.o pattern.o \ pprint.o prccode.o prcdrfun.o prcdrpsr.o prdctfun.o prntutil.o \ proflfun.o reorder.o reteutil.o retract.o router.o rulebin.o \ rulebld.o rulebsc.o rulecmp.o rulecom.o rulecstr.o ruledef.o \ ruledlt.o rulelhs.o rulepsr.o scanner.o sortfun.o strngfun.o \ strngrtr.o symblbin.o symblcmp.o symbol.o sysdep.o textpro.o \ tmpltbin.o tmpltbsc.o tmpltcmp.o tmpltdef.o tmpltfun.o tmpltlhs.o \ tmpltpsr.o tmpltrhs.o tmpltutl.o userdata.o userfunctions.o utility.o watch.o .c.o : gcc -c -O3 -Wall -Wundef -Wpointer-arith -Wshadow -Wcast-qual \ -Winline -Wmissing-declarations -Wredundant-decls \ -Wmissing-prototypes -Wnested-externs \ -Wstrict-prototypes -Waggregate-return -Wno-implicit $< clips : $(OBJS) gcc -o clips $(OBJS) -lm # Dependencies generated using "gcc -MM *.c" agenda.o: agenda.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h memalloc.h modulutl.h reteutil.h \ router.h prntutil.h rulebsc.h strngrtr.h sysdep.h watch.h analysis.o: analysis.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h generate.h \ analysis.h router.h prntutil.h cstrnchk.h cstrnutl.h cstrnops.h \ rulecstr.h modulutl.h watch.h rulepsr.h globldef.h argacces.o: argacces.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnchk.h \ constrnt.h insfun.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h factmngr.h facthsh.h tmpltdef.h factbld.h \ sysdep.h argacces.h bload.o: bload.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bsave.h cstrnbin.h \ constrnt.h memalloc.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h bmathfun.o: bmathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ bmathfun.h bsave.o: bsave.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h cstrnbin.h constrnt.h memalloc.h router.h prntutil.h \ bsave.h classcom.o: classcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h argacces.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h classfun.h object.h constrnt.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h classini.h modulutl.h msgcom.h \ msgpass.h router.h prntutil.h classcom.h classexm.o: classexm.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classini.h insfun.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h classexm.h classfun.o: classfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classini.h cstrcpsr.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgfun.h msgpass.h router.h prntutil.h \ classfun.h classinf.o: classinf.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classexm.h classfun.h classini.h memalloc.h insfun.h \ msgcom.h msgpass.h msgfun.h prntutil.h classinf.h classini.o: classini.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classexm.h classfun.h classinf.h classpsr.h cstrcpsr.h inscom.h \ insfun.h memalloc.h modulutl.h msgcom.h msgpass.h watch.h defins.h \ insquery.h bload.h exprnbin.h sysdep.h symblbin.h objbin.h objcmp.h \ objrtbld.h objrtfnx.h objrtmch.h classini.h classpsr.o: classpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h clsltpsr.h cstrcpsr.h \ inherpsr.h memalloc.h modulutl.h msgpsr.h router.h prntutil.h \ classpsr.h clsltpsr.o: clsltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h cstrnpsr.h cstrnutl.h default.h insfun.h \ memalloc.h prntutil.h router.h clsltpsr.h commline.o: commline.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h filecom.h \ memalloc.h prcdrfun.h prcdrpsr.h constrnt.h router.h prntutil.h \ strngrtr.h sysdep.h commline.h conscomp.o: conscomp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h modulcmp.h \ network.h match.h pattern.h reorder.h ruledef.h agenda.h dffnxcmp.h \ dffnxfun.h tmpltcmp.h globlcmp.h genrccmp.h genrcfun.h object.h \ objcmp.h constrct.o: constrct.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ watch.h prcdrfun.h prcdrpsr.h constrnt.h argacces.h modulutl.h \ sysdep.h commline.h cstrcpsr.h ruledef.h cstrccom.h agenda.h match.h \ network.h pattern.h reorder.h constrnt.o: constrnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h constrnt.h crstrtgy.o: crstrtgy.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h pattern.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h reteutil.h argacces.h \ memalloc.h crstrtgy.h cstrcbin.o: cstrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h cstrcbin.h cstrccom.o: cstrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h argacces.h modulutl.h \ router.h prntutil.h commline.h sysdep.h bload.h exprnbin.h symblbin.h \ cstrcpsr.h cstrccom.h cstrcpsr.o: cstrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h watch.h \ prcdrpsr.h constrnt.h memalloc.h modulutl.h sysdep.h cstrcpsr.h cstrnbin.o: cstrnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h cstrnbin.h constrnt.h cstrnchk.o: cstrnchk.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnutl.h \ constrnt.h inscom.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h insfun.h classcom.h classexm.h cstrnchk.h cstrncmp.o: cstrncmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h memalloc.h router.h prntutil.h \ sysdep.h cstrncmp.h constrnt.h cstrnops.o: cstrnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h cstrnchk.h cstrnutl.h cstrnops.h cstrnpsr.o: cstrnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnutl.h constrnt.h cstrnchk.h sysdep.h cstrnpsr.h cstrnutl.o: cstrnutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrnutl.h constrnt.h default.o: default.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h inscom.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ insfun.h router.h prntutil.h factmngr.h facthsh.h tmpltdef.h factbld.h \ cstrnutl.h default.h defins.o: defins.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dfinsbin.h defins.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h dfinscmp.h argacces.h \ classcom.h classfun.h cstrcpsr.h insfun.h inspsr.h memalloc.h router.h \ prntutil.h developr.o: developr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h inscom.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h insfun.h modulutl.h router.h prntutil.h tmpltdef.h factbld.h \ factmngr.h facthsh.h classcom.h classfun.h objrtmch.h developr.h dffctbin.o: dffctbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h dffctbin.h modulbin.h \ cstrcbin.h dffctbsc.o: dffctbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h dffctpsr.h dffctdef.h dffctbin.h modulbin.h cstrcbin.h \ dffctcmp.h dffctbsc.h dffctcmp.o: dffctcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffctdef.h cstrccom.h dffctcmp.h dffctdef.o: dffctdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctpsr.h dffctbsc.h bload.h \ utility.h exprnbin.h sysdep.h symblbin.h dffctbin.h modulbin.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h cstrcbin.h \ dffctcmp.h dffctdef.h cstrccom.h dffctpsr.o: dffctpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrcpsr.h factrhs.h factmngr.h facthsh.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h \ factbld.h bload.h exprnbin.h sysdep.h symblbin.h dffctdef.h dffctbsc.h \ dffctpsr.h dffnxbin.o: dffnxbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h modulbin.h dffnxbin.h dffnxfun.h \ cstrccom.h dffnxcmp.o: dffnxcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffnxcmp.h dffnxfun.h cstrccom.h dffnxexe.o: dffnxexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h prcdrfun.h prccode.h proflfun.h \ router.h prntutil.h watch.h dffnxexe.h dffnxfun.h cstrccom.h dffnxfun.o: dffnxfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxbin.h dffnxfun.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h dffnxcmp.h cstrcpsr.h dffnxpsr.h \ dffnxexe.h watch.h argacces.h memalloc.h router.h prntutil.h dffnxpsr.o: dffnxpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h network.h match.h pattern.h reorder.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h \ agenda.h genrccom.h genrcfun.h object.h cstrcpsr.h dffnxfun.h \ memalloc.h prccode.h router.h prntutil.h dffnxpsr.h dfinsbin.o: dfinsbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ modulbin.h dfinsbin.h dfinscmp.o: dfinscmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ dfinscmp.h drive.o: drive.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ memalloc.h prntutil.h reteutil.h router.h incrrset.h drive.h emathfun.o: emathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ emathfun.h engine.o: engine.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h factmngr.h facthsh.h \ tmpltdef.h factbld.h inscom.h object.h insfun.h memalloc.h modulutl.h \ prccode.h prcdrfun.h proflfun.h reteutil.h retract.h router.h \ prntutil.h ruledlt.h sysdep.h watch.h engine.h lgcldpnd.h envrnmnt.o: envrnmnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h sysdep.h evaluatn.o: evaluatn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h prcdrfun.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h proflfun.h sysdep.h dffnxfun.h genrccom.h \ genrcfun.h object.h inscom.h insfun.h expressn.o: expressn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h memalloc.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h exprnbin.o: exprnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h agenda.h genrcbin.h \ genrcfun.h object.h dffnxbin.h dffnxfun.h tmpltbin.h cstrcbin.h \ modulbin.h tmpltdef.h factbld.h factmngr.h facthsh.h globlbin.h \ globldef.h objbin.h insfun.h inscom.h exprnops.o: exprnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnchk.h constrnt.h cstrnutl.h cstrnops.h exprnpsr.o: exprnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ memalloc.h argacces.h cstrnchk.h constrnt.h modulutl.h prcdrfun.h \ network.h match.h pattern.h reorder.h ruledef.h cstrccom.h agenda.h \ genrccom.h genrcfun.h object.h dffnxfun.h extnfunc.o: extnfunc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h factbin.o: factbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h tmpltdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h \ factbld.h pattern.h match.h network.h ruledef.h cstrccom.h agenda.h \ reorder.h factmngr.h facthsh.h bload.h exprnbin.h sysdep.h symblbin.h \ bsave.h reteutil.h rulebin.h modulbin.h cstrcbin.h factbin.h factbld.o: factbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reteutil.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h router.h \ prntutil.h factcmp.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factgen.h factlhs.h argacces.h modulutl.h factcmp.o: factcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h factcmp.h \ tmpltdef.h factmngr.h facthsh.h factcom.o: factcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h argacces.h router.h prntutil.h \ factrhs.h factmch.h tmpltpsr.h tmpltutl.h modulutl.h strngrtr.h \ tmpltfun.h sysdep.h bload.h exprnbin.h symblbin.h factcom.h factfun.o: factfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h tmpltutl.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h router.h sysdep.h \ factfun.h factgen.o: factgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ network.h match.h pattern.h reorder.h ruledef.h constrnt.h cstrccom.h \ agenda.h reteutil.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factrete.h factprt.h tmpltlhs.h factgen.h facthsh.o: facthsh.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h facthsh.h factmngr.h tmpltdef.h factbld.h factlhs.o: factlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrcpsr.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h router.h prntutil.h \ tmpltpsr.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltlhs.h \ tmpltutl.h modulutl.h factlhs.h factmch.o: factmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h factgen.h factrete.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h sysdep.h tmpltdef.h factbld.h factmngr.h facthsh.h \ factmch.h factmngr.o: factmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h strngrtr.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h factbld.h factqury.h \ factmngr.h facthsh.h tmpltdef.h reteutil.h retract.h factcmp.h \ filecom.h factfun.h factcom.h factrhs.h factmch.h watch.h factbin.h \ default.h commline.h sysdep.h engine.h lgcldpnd.h drive.h ruledlt.h \ tmpltbsc.h tmpltutl.h tmpltfun.h factprt.o: factprt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h factgen.h \ reorder.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h factprt.h factqpsr.o: factqpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factqury.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h modulutl.h prcdrpsr.h prntutil.h \ router.h strngrtr.h factqpsr.h factqury.o: factqury.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h modulutl.h \ tmpltutl.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h insfun.h \ object.h factqpsr.h prcdrfun.h router.h prntutil.h factqury.h factrete.o: factrete.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ incrrset.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h reteutil.h drive.h engine.h lgcldpnd.h retract.h \ factgen.h factmch.h factmngr.h facthsh.h tmpltdef.h factbld.h \ factrete.h factrhs.o: factrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h modulutl.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h prntutil.h \ cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltrhs.h tmpltutl.h \ strngrtr.h router.h factrhs.h filecom.o: filecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ memalloc.h prcdrfun.h router.h prntutil.h strngrtr.h sysdep.h \ filecom.h bsave.h bload.h exprnbin.h symblbin.h filertr.o: filertr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h filertr.h generate.o: generate.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h generate.h analysis.h globlpsr.h genrcbin.o: genrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h objbin.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h genrccom.h \ genrcfun.h modulbin.h genrcbin.h router.h prntutil.h genrccmp.o: genrccmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h genrccom.h genrcfun.h \ object.h objcmp.h genrccmp.h genrccom.o: genrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h bload.h exprnbin.h sysdep.h \ symblbin.h genrcbin.h genrcfun.h object.h genrccmp.h genrcpsr.h \ classcom.h inscom.h insfun.h watch.h argacces.h cstrcpsr.h genrcexe.h \ memalloc.h router.h prntutil.h genrccom.h genrcexe.o: genrcexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h insfun.h argacces.h genrccom.h genrcfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h genrcexe.h genrcfun.o: genrcfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h argacces.h cstrcpsr.h \ genrccom.h genrcfun.h genrcexe.h memalloc.h prccode.h router.h \ prntutil.h genrcpsr.o: genrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxfun.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h cstrccom.h classfun.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classcom.h memalloc.h \ cstrcpsr.h genrccom.h genrcfun.h immthpsr.h modulutl.h prcdrpsr.h \ prccode.h router.h prntutil.h genrcpsr.h globlbin.o: globlbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globldef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h globlbsc.h globlbin.h \ modulbin.h cstrcbin.h globlbsc.o: globlbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h watch.h globlcom.h globldef.h \ cstrccom.h globlbin.h modulbin.h cstrcbin.h globlcmp.h globlbsc.h globlcmp.o: globlcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h globldef.h cstrccom.h globlcmp.h globlcom.o: globlcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h router.h \ globldef.h cstrccom.h globlcom.h globldef.o: globldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h modulpsr.h moduldef.h \ conscomp.h constrct.h symblcmp.h utility.h router.h prntutil.h \ strngrtr.h modulutl.h globlbsc.h globlpsr.h globlcom.h commline.h \ bload.h exprnbin.h sysdep.h symblbin.h globlbin.h modulbin.h \ cstrcbin.h globldef.h cstrccom.h globlcmp.h globlpsr.o: globlpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ watch.h modulutl.h cstrcpsr.h globldef.h cstrccom.h globlbsc.h bload.h \ exprnbin.h sysdep.h symblbin.h globlpsr.h immthpsr.o: immthpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h cstrnutl.h genrcpsr.h genrcfun.h prccode.h \ immthpsr.h incrrset.o: incrrset.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h router.h prntutil.h reteutil.h incrrset.h inherpsr.o: inherpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h modulutl.h router.h prntutil.h inherpsr.h inscom.o: inscom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfile.h insfun.h insmngr.h \ insmoddp.h insmult.h inspsr.h lgcldpnd.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h commline.h inscom.h insfile.o: insfile.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h \ router.h prntutil.h strngrtr.h symblbin.h sysdep.h factmngr.h \ facthsh.h tmpltdef.h factbld.h insfile.h insfun.o: insfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h cstrnchk.h engine.h lgcldpnd.h retract.h inscom.h \ insfun.h insmngr.h memalloc.h modulutl.h msgcom.h msgpass.h msgfun.h \ prccode.h router.h prntutil.h drive.h objrtmch.h insmngr.o: insmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h drive.h objrtmch.h object.h \ lgcldpnd.h classcom.h classfun.h engine.h retract.h memalloc.h \ insfun.h modulutl.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h sysdep.h insmngr.h inscom.h watch.h insmoddp.o: insmoddp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h objrtmch.h object.h \ argacces.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h miscfun.h \ msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h insmoddp.h insmult.o: insmult.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h insfun.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h msgfun.h msgpass.h multifun.h router.h prntutil.h insmult.h inspsr.o: inspsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h prntutil.h router.h inspsr.h insquery.o: insquery.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h insmngr.h insqypsr.h \ prcdrfun.h router.h prntutil.h insquery.h insqypsr.o: insqypsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ insquery.h prcdrpsr.h prntutil.h router.h strngrtr.h insqypsr.h iofun.o: iofun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ filertr.h argacces.h memalloc.h commline.h sysdep.h iofun.h lgcldpnd.o: lgcldpnd.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h reteutil.h argacces.h \ factmngr.h facthsh.h tmpltdef.h factbld.h insfun.h object.h main.o: main.c clips.h setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h cstrcpsr.h \ filecom.h strngfun.h commline.h router.h prntutil.h filertr.h \ strngrtr.h iofun.h sysdep.h bmathfun.h watch.h modulbsc.h bload.h \ exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h cstrccom.h agenda.h \ match.h network.h pattern.h reorder.h rulebsc.h engine.h lgcldpnd.h \ retract.h drive.h incrrset.h rulecom.h crstrtgy.h dffctdef.h \ dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h \ tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h globlcom.h \ dffnxfun.h genrccom.h genrcfun.h object.h classcom.h classexm.h \ classinf.h classini.h classpsr.h defins.h inscom.h insfun.h insfile.h \ msgcom.h msgpass.h objrtmch.h memalloc.o: memalloc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h miscfun.o: miscfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h sysdep.h dffnxfun.h cstrccom.h miscfun.h modulbin.o: modulbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h modulbin.h modulbsc.o: modulbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h modulbin.h prntutil.h modulcmp.h \ router.h argacces.h bload.h exprnbin.h sysdep.h symblbin.h modulbsc.h modulcmp.o: modulcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h sysdep.h modulcmp.h moduldef.o: moduldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h modulcmp.h modulbsc.h bload.h exprnbin.h sysdep.h \ symblbin.h modulbin.h modulpsr.o: modulpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrcpsr.h modulutl.h bload.h exprnbin.h sysdep.h \ symblbin.h modulutl.o: modulutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h modulutl.h msgcom.o: msgcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfun.h insmoddp.h msgfun.h msgpass.h \ memalloc.h prccode.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h msgpsr.h watch.h msgcom.h msgfun.o: msgfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h insfun.h msgcom.h msgpass.h prccode.h router.h \ prntutil.h msgfun.h msgpass.o: msgpass.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h msgcom.h msgpass.h msgfun.h \ prcdrfun.h prccode.h proflfun.h router.h prntutil.h strngfun.h \ commline.h inscom.h msgpsr.o: msgpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h memalloc.h cstrcpsr.h \ cstrnchk.h insfun.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h strngrtr.h msgpsr.h multifld.o: multifld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ strngrtr.h object.h constrnt.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h multifun.o: multifun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifun.h \ prcdrpsr.h constrnt.h prcdrfun.h router.h prntutil.h object.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objbin.o: objbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h classcom.h cstrccom.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classfun.h classini.h \ cstrcbin.h cstrnbin.h insfun.h memalloc.h modulbin.h msgcom.h \ msgpass.h msgfun.h prntutil.h router.h objbin.h objcmp.o: objcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h classcom.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classini.h cstrncmp.h objrtfnx.h objrtmch.h sysdep.h \ objcmp.h objrtbin.o: objrtbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h insfun.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ reteutil.h rulebin.h modulbin.h cstrcbin.h objrtbin.h objrtbld.o: objrtbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnutl.h cstrnchk.h cstrnops.h drive.h inscom.h insfun.h \ insmngr.h memalloc.h reteutil.h rulepsr.h objrtmch.h objrtgen.h \ objrtfnx.h router.h prntutil.h objrtcmp.h objrtbin.h objrtbld.h objrtcmp.o: objrtcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h objrtfnx.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ sysdep.h objrtcmp.h objrtfnx.o: objrtfnx.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h bload.h exprnbin.h sysdep.h symblbin.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h objrtmch.h reteutil.h router.h \ prntutil.h objrtfnx.h objrtgen.o: objrtgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtfnx.h objrtmch.h objrtgen.h objrtmch.o: objrtmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h drive.h engine.h lgcldpnd.h retract.h incrrset.h reteutil.h \ ruledlt.h router.h prntutil.h objrtfnx.h objrtmch.h insmngr.h parsefun.o: parsefun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h memalloc.h \ prcdrpsr.h constrnt.h router.h prntutil.h strngrtr.h parsefun.h pattern.o: pattern.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h cstrnutl.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h reteutil.h router.h prntutil.h rulecmp.h pprint.o: pprint.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h sysdep.h utility.h prccode.o: prccode.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globlpsr.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h prcdrpsr.h router.h prntutil.h prccode.h prcdrfun.o: prcdrfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h memalloc.h prcdrpsr.h router.h prntutil.h prcdrfun.h \ globldef.h cstrccom.h prcdrpsr.o: prcdrpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h cstrnutl.h memalloc.h modulutl.h router.h prntutil.h \ prcdrpsr.h globldef.h cstrccom.h globlpsr.h prdctfun.o: prdctfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ prdctfun.h prntutil.o: prntutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h utility.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h router.h prntutil.h \ multifun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h inscom.h object.h insfun.h insmngr.h memalloc.h sysdep.h proflfun.o: proflfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h dffnxfun.h genrccom.h genrcfun.h memalloc.h msgcom.h \ msgpass.h router.h prntutil.h sysdep.h proflfun.h reorder.o: reorder.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrnutl.h constrnt.h memalloc.h \ pattern.h match.h network.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h cstrccom.h agenda.h reorder.h \ prntutil.h router.h rulelhs.h reteutil.o: reteutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h incrrset.h memalloc.h router.h prntutil.h rulecom.h \ reteutil.h retract.o: retract.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h reteutil.h router.h prntutil.h router.o: router.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h filertr.h memalloc.h \ strngrtr.h sysdep.h router.h prntutil.h rulebin.o: rulebin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h reteutil.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ rulebsc.h rulebin.h modulbin.h cstrcbin.h rulebld.o: rulebld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h drive.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h incrrset.h \ memalloc.h reteutil.h router.h prntutil.h rulebld.h rulepsr.h watch.h rulebsc.o: rulebsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h watch.h \ ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h pattern.h \ reorder.h engine.h lgcldpnd.h retract.h drive.h reteutil.h rulebin.h \ modulbin.h cstrcbin.h rulecmp.h rulebsc.h rulecmp.o: rulecmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h reteutil.h \ rulecmp.h rulecom.o: rulecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h ruledlt.h sysdep.h watch.h rulebin.h modulbin.h \ cstrcbin.h rulecom.h rulecstr.o: rulecstr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrnchk.h \ cstrnops.h cstrnutl.h prcdrpsr.h router.h prntutil.h rulepsr.h \ rulecstr.h ruledef.o: ruledef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h drive.h engine.h lgcldpnd.h \ retract.h memalloc.h reteutil.h rulebsc.h rulecom.h rulepsr.h \ ruledlt.h bload.h exprnbin.h sysdep.h symblbin.h rulebin.h modulbin.h \ cstrcbin.h rulecmp.h ruledlt.o: ruledlt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h engine.h lgcldpnd.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h \ reorder.h retract.h reteutil.h drive.h bload.h exprnbin.h sysdep.h \ symblbin.h ruledlt.h rulelhs.o: rulelhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h cstrnchk.h memalloc.h \ router.h prntutil.h rulelhs.h rulepsr.o: rulepsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrcpsr.h \ cstrnchk.h cstrnops.h engine.h lgcldpnd.h retract.h incrrset.h \ memalloc.h prccode.h prcdrpsr.h router.h prntutil.h rulebld.h \ rulebsc.h rulecstr.h ruledlt.h rulelhs.h watch.h tmpltfun.h factmngr.h \ facthsh.h tmpltdef.h factbld.h bload.h exprnbin.h sysdep.h symblbin.h \ rulepsr.h scanner.o: scanner.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ sysdep.h sortfun.o: sortfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h dffnxfun.h cstrccom.h \ memalloc.h sysdep.h sortfun.h strngfun.o: strngfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h memalloc.h prcdrpsr.h router.h \ prntutil.h strngrtr.h sysdep.h drive.h strngfun.h strngrtr.o: strngrtr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h strngrtr.h symblbin.o: symblbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h \ prntutil.h symblcmp.o: symblcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h symbol.o: symbol.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h sysdep.h sysdep.o: sysdep.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bmathfun.h commline.h \ constrnt.h cstrcpsr.h emathfun.h filecom.h iofun.h memalloc.h \ miscfun.h multifun.h parsefun.h prccode.h prdctfun.h proflfun.h \ prcdrfun.h router.h prntutil.h sortfun.h strngfun.h textpro.h watch.h \ sysdep.h dffctdef.h cstrccom.h ruledef.h agenda.h match.h network.h \ pattern.h reorder.h genrccom.h genrcfun.h object.h dffnxfun.h \ globldef.h tmpltdef.h factbld.h factmngr.h facthsh.h classini.h textpro.o: textpro.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h sysdep.h textpro.h tmpltbin.o: tmpltbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h factbin.h factbld.h pattern.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h cstrnbin.h \ factmngr.h facthsh.h tmpltdef.h tmpltpsr.h tmpltutl.h tmpltbin.h \ cstrcbin.h modulbin.h tmpltbsc.o: tmpltbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h tmpltpsr.h tmpltbin.h cstrcbin.h modulbin.h tmpltcmp.h \ tmpltutl.h tmpltbsc.h tmpltcmp.o: tmpltcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h factcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h cstrncmp.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltcmp.h tmpltdef.o: tmpltdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h network.h \ match.h pattern.h reorder.h ruledef.h constrnt.h agenda.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h tmpltutl.h \ tmpltfun.h router.h prntutil.h modulutl.h cstrnchk.h bload.h \ exprnbin.h sysdep.h symblbin.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltcmp.h tmpltfun.o: tmpltfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h cstrnchk.h constrnt.h default.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h commline.h factrhs.h modulutl.h sysdep.h \ tmpltlhs.h tmpltutl.h tmpltrhs.h tmpltfun.h tmpltlhs.o: tmpltlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h reorder.h ruledef.h cstrccom.h agenda.h match.h network.h \ pattern.h factrhs.h factmngr.h facthsh.h tmpltdef.h factbld.h \ modulutl.h tmpltutl.h tmpltlhs.h tmpltpsr.o: tmpltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h cstrnchk.h \ cstrnpsr.h cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h default.h \ watch.h cstrnutl.h tmpltbsc.h tmpltpsr.h tmpltrhs.o: tmpltrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ tmpltfun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ factrhs.h modulutl.h default.h tmpltutl.h tmpltlhs.h tmpltrhs.h tmpltutl.o: tmpltutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ argacces.h cstrnchk.h constrnt.h tmpltfun.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h tmpltpsr.h modulutl.h watch.h sysdep.h tmpltbsc.h \ tmpltutl.h userdata.o: userdata.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h userfunctions.o: userfunctions.c clips.h setup.h envrnmnt.h symbol.h \ multifld.h evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h usrsetup.h argacces.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ memalloc.h cstrcpsr.h filecom.h strngfun.h commline.h router.h \ prntutil.h filertr.h strngrtr.h iofun.h sysdep.h bmathfun.h watch.h \ modulbsc.h bload.h exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h rulebsc.h \ engine.h lgcldpnd.h retract.h drive.h incrrset.h rulecom.h crstrtgy.h \ dffctdef.h dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h \ tmpltbsc.h tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h \ globlcom.h dffnxfun.h genrccom.h genrcfun.h object.h classcom.h \ classexm.h classinf.h classini.h classpsr.h defins.h inscom.h insfun.h \ insfile.h msgcom.h msgpass.h objrtmch.h utility.o: utility.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h commline.h facthsh.h factmngr.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h memalloc.h prntutil.h sysdep.h watch.o: watch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h watch.h clips_core_source_630/makefiles/._makefile.win0000644000175000017500000000033012504565277017760 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/makefiles/makefile.lib++0000644000175000017500000021547712504562722017656 0ustar jfsjfs# The GNU Make Manual # http://www.gnu.org/software/make/manual/make.html OBJS = agenda.o analysis.o argacces.o bload.o bmathfun.o bsave.o \ classcom.o classexm.o classfun.o classinf.o classini.o \ classpsr.o clsltpsr.o commline.o conscomp.o constrct.o \ constrnt.o crstrtgy.o cstrcbin.o cstrccom.o cstrcpsr.o \ cstrnbin.o cstrnchk.o cstrncmp.o cstrnops.o cstrnpsr.o \ cstrnutl.o default.o defins.o developr.o dffctbin.o dffctbsc.o \ dffctcmp.o dffctdef.o dffctpsr.o dffnxbin.o dffnxcmp.o \ dffnxexe.o dffnxfun.o dffnxpsr.o dfinsbin.o dfinscmp.o drive.o \ emathfun.o \ engine.o envrnmnt.o evaluatn.o expressn.o exprnbin.o exprnops.o \ exprnpsr.o extnfunc.o factbin.o factbld.o factcmp.o factcom.o \ factfun.o factgen.o facthsh.o factlhs.o factmch.o factmngr.o \ factprt.o factqpsr.o factqury.o factrete.o factrhs.o filecom.o filertr.o \ generate.o genrcbin.o genrccmp.o genrccom.o genrcexe.o genrcfun.o \ genrcpsr.o globlbin.o globlbsc.o globlcmp.o globlcom.o \ globldef.o globlpsr.o immthpsr.o incrrset.o inherpsr.o \ inscom.o insfile.o insfun.o insmngr.o insmoddp.o insmult.o \ inspsr.o insquery.o insqypsr.o iofun.o lgcldpnd.o \ memalloc.o miscfun.o modulbin.o modulbsc.o modulcmp.o moduldef.o \ modulpsr.o modulutl.o msgcom.o msgfun.o msgpass.o msgpsr.o \ multifld.o multifun.o objbin.o objcmp.o objrtbin.o objrtbld.o \ objrtcmp.o objrtfnx.o objrtgen.o objrtmch.o parsefun.o pattern.o \ pprint.o prccode.o prcdrfun.o prcdrpsr.o prdctfun.o prntutil.o \ proflfun.o reorder.o reteutil.o retract.o router.o rulebin.o \ rulebld.o rulebsc.o rulecmp.o rulecom.o rulecstr.o ruledef.o \ ruledlt.o rulelhs.o rulepsr.o scanner.o sortfun.o strngfun.o \ strngrtr.o symblbin.o symblcmp.o symbol.o sysdep.o textpro.o \ tmpltbin.o tmpltbsc.o tmpltcmp.o tmpltdef.o tmpltfun.o tmpltlhs.o \ tmpltpsr.o tmpltrhs.o tmpltutl.o userdata.o userfunctions.o utility.o watch.o .c.o : gcc -c -x c++ -DALLOW_ENVIRONMENT_GLOBALS=0 \ -O3 -Wall -Wundef -Wpointer-arith -Wshadow -Wcast-qual \ -Winline -Wmissing-declarations -Wredundant-decls \ -Wmissing-prototypes -Wnested-externs \ -Wstrict-prototypes -Waggregate-return -Wno-implicit $< # Creating Unix Libraries # http://www.cs.duke.edu/~ola/courses/programming/libraries.html # Compiling CLIPS using the library # gcc -o clips -x c++ main.c -L. -lstdc++ -lclips++ libclips++.a : $(OBJS) rm -f $@ ar cq $@ $(OBJS) # man gcc # Dependencies generated using "gcc -MM *.c" agenda.o: agenda.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h memalloc.h modulutl.h reteutil.h \ router.h prntutil.h rulebsc.h strngrtr.h sysdep.h watch.h analysis.o: analysis.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h generate.h \ analysis.h router.h prntutil.h cstrnchk.h cstrnutl.h cstrnops.h \ rulecstr.h modulutl.h watch.h rulepsr.h globldef.h argacces.o: argacces.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnchk.h \ constrnt.h insfun.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h factmngr.h facthsh.h tmpltdef.h factbld.h \ sysdep.h argacces.h bload.o: bload.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bsave.h cstrnbin.h \ constrnt.h memalloc.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h bmathfun.o: bmathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ bmathfun.h bsave.o: bsave.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h cstrnbin.h constrnt.h memalloc.h router.h prntutil.h \ bsave.h classcom.o: classcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h argacces.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h classfun.h object.h constrnt.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h classini.h modulutl.h msgcom.h \ msgpass.h router.h prntutil.h classcom.h classexm.o: classexm.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classini.h insfun.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h classexm.h classfun.o: classfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classini.h cstrcpsr.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgfun.h msgpass.h router.h prntutil.h \ classfun.h classinf.o: classinf.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classexm.h classfun.h classini.h memalloc.h insfun.h \ msgcom.h msgpass.h msgfun.h prntutil.h classinf.h classini.o: classini.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classexm.h classfun.h classinf.h classpsr.h cstrcpsr.h inscom.h \ insfun.h memalloc.h modulutl.h msgcom.h msgpass.h watch.h defins.h \ insquery.h bload.h exprnbin.h sysdep.h symblbin.h objbin.h objcmp.h \ objrtbld.h objrtfnx.h objrtmch.h classini.h classpsr.o: classpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h clsltpsr.h cstrcpsr.h \ inherpsr.h memalloc.h modulutl.h msgpsr.h router.h prntutil.h \ classpsr.h clsltpsr.o: clsltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h cstrnpsr.h cstrnutl.h default.h insfun.h \ memalloc.h prntutil.h router.h clsltpsr.h commline.o: commline.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h filecom.h \ memalloc.h prcdrfun.h prcdrpsr.h constrnt.h router.h prntutil.h \ strngrtr.h sysdep.h commline.h conscomp.o: conscomp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h modulcmp.h \ network.h match.h pattern.h reorder.h ruledef.h agenda.h dffnxcmp.h \ dffnxfun.h tmpltcmp.h globlcmp.h genrccmp.h genrcfun.h object.h \ objcmp.h constrct.o: constrct.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ watch.h prcdrfun.h prcdrpsr.h constrnt.h argacces.h modulutl.h \ sysdep.h commline.h cstrcpsr.h ruledef.h cstrccom.h agenda.h match.h \ network.h pattern.h reorder.h constrnt.o: constrnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h constrnt.h crstrtgy.o: crstrtgy.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h pattern.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h reteutil.h argacces.h \ memalloc.h crstrtgy.h cstrcbin.o: cstrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h cstrcbin.h cstrccom.o: cstrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h argacces.h modulutl.h \ router.h prntutil.h commline.h sysdep.h bload.h exprnbin.h symblbin.h \ cstrcpsr.h cstrccom.h cstrcpsr.o: cstrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h watch.h \ prcdrpsr.h constrnt.h memalloc.h modulutl.h sysdep.h cstrcpsr.h cstrnbin.o: cstrnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h cstrnbin.h constrnt.h cstrnchk.o: cstrnchk.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h cstrnutl.h \ constrnt.h inscom.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h insfun.h classcom.h classexm.h cstrnchk.h cstrncmp.o: cstrncmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h memalloc.h router.h prntutil.h \ sysdep.h cstrncmp.h constrnt.h cstrnops.o: cstrnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h cstrnchk.h cstrnutl.h cstrnops.h cstrnpsr.o: cstrnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnutl.h constrnt.h cstrnchk.h sysdep.h cstrnpsr.h cstrnutl.o: cstrnutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrnutl.h constrnt.h default.o: default.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h inscom.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ insfun.h router.h prntutil.h factmngr.h facthsh.h tmpltdef.h factbld.h \ cstrnutl.h default.h defins.o: defins.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dfinsbin.h defins.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h dfinscmp.h argacces.h \ classcom.h classfun.h cstrcpsr.h insfun.h inspsr.h memalloc.h router.h \ prntutil.h developr.o: developr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h inscom.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h insfun.h modulutl.h router.h prntutil.h tmpltdef.h factbld.h \ factmngr.h facthsh.h classcom.h classfun.h objrtmch.h developr.h dffctbin.o: dffctbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h dffctbin.h modulbin.h \ cstrcbin.h dffctbsc.o: dffctbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h dffctpsr.h dffctdef.h dffctbin.h modulbin.h cstrcbin.h \ dffctcmp.h dffctbsc.h dffctcmp.o: dffctcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffctdef.h cstrccom.h dffctcmp.h dffctdef.o: dffctdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctpsr.h dffctbsc.h bload.h \ utility.h exprnbin.h sysdep.h symblbin.h dffctbin.h modulbin.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h cstrcbin.h \ dffctcmp.h dffctdef.h cstrccom.h dffctpsr.o: dffctpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrcpsr.h factrhs.h factmngr.h facthsh.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h \ factbld.h bload.h exprnbin.h sysdep.h symblbin.h dffctdef.h dffctbsc.h \ dffctpsr.h dffnxbin.o: dffnxbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h modulbin.h dffnxbin.h dffnxfun.h \ cstrccom.h dffnxcmp.o: dffnxcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h dffnxcmp.h dffnxfun.h cstrccom.h dffnxexe.o: dffnxexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h prcdrfun.h prccode.h proflfun.h \ router.h prntutil.h watch.h dffnxexe.h dffnxfun.h cstrccom.h dffnxfun.o: dffnxfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxbin.h dffnxfun.h conscomp.h constrct.h moduldef.h \ modulpsr.h symblcmp.h cstrccom.h dffnxcmp.h cstrcpsr.h dffnxpsr.h \ dffnxexe.h watch.h argacces.h memalloc.h router.h prntutil.h dffnxpsr.o: dffnxpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h network.h match.h pattern.h reorder.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h \ agenda.h genrccom.h genrcfun.h object.h cstrcpsr.h dffnxfun.h \ memalloc.h prccode.h router.h prntutil.h dffnxpsr.h dfinsbin.o: dfinsbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ modulbin.h dfinsbin.h dfinscmp.o: dfinscmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h defins.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ dfinscmp.h drive.o: drive.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ memalloc.h prntutil.h reteutil.h router.h incrrset.h drive.h emathfun.o: emathfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ emathfun.h engine.o: engine.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h factmngr.h facthsh.h \ tmpltdef.h factbld.h inscom.h object.h insfun.h memalloc.h modulutl.h \ prccode.h prcdrfun.h proflfun.h reteutil.h retract.h router.h \ prntutil.h ruledlt.h sysdep.h watch.h engine.h lgcldpnd.h envrnmnt.o: envrnmnt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h sysdep.h evaluatn.o: evaluatn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h prcdrfun.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h proflfun.h sysdep.h dffnxfun.h genrccom.h \ genrcfun.h object.h inscom.h insfun.h expressn.o: expressn.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h memalloc.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h exprnbin.o: exprnbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h dffctdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h agenda.h genrcbin.h \ genrcfun.h object.h dffnxbin.h dffnxfun.h tmpltbin.h cstrcbin.h \ modulbin.h tmpltdef.h factbld.h factmngr.h facthsh.h globlbin.h \ globldef.h objbin.h insfun.h inscom.h exprnops.o: exprnops.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ cstrnchk.h constrnt.h cstrnutl.h cstrnops.h exprnpsr.o: exprnpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ memalloc.h argacces.h cstrnchk.h constrnt.h modulutl.h prcdrfun.h \ network.h match.h pattern.h reorder.h ruledef.h cstrccom.h agenda.h \ genrccom.h genrcfun.h object.h dffnxfun.h extnfunc.o: extnfunc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h factbin.o: factbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h tmpltdef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h \ factbld.h pattern.h match.h network.h ruledef.h cstrccom.h agenda.h \ reorder.h factmngr.h facthsh.h bload.h exprnbin.h sysdep.h symblbin.h \ bsave.h reteutil.h rulebin.h modulbin.h cstrcbin.h factbin.h factbld.o: factbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h reteutil.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h router.h \ prntutil.h factcmp.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factgen.h factlhs.h argacces.h modulutl.h factcmp.o: factcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h factcmp.h \ tmpltdef.h factmngr.h facthsh.h factcom.o: factcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h argacces.h router.h prntutil.h \ factrhs.h factmch.h tmpltpsr.h tmpltutl.h modulutl.h strngrtr.h \ tmpltfun.h sysdep.h bload.h exprnbin.h symblbin.h factcom.h factfun.o: factfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h tmpltutl.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h router.h sysdep.h \ factfun.h factgen.o: factgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ network.h match.h pattern.h reorder.h ruledef.h constrnt.h cstrccom.h \ agenda.h reteutil.h factmch.h factmngr.h facthsh.h tmpltdef.h \ factbld.h factrete.h factprt.h tmpltlhs.h factgen.h facthsh.o: facthsh.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h facthsh.h factmngr.h tmpltdef.h factbld.h factlhs.o: factlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrcpsr.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h router.h prntutil.h \ tmpltpsr.h tmpltdef.h factbld.h factmngr.h facthsh.h tmpltlhs.h \ tmpltutl.h modulutl.h factlhs.h factmch.o: factmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h factgen.h factrete.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h sysdep.h tmpltdef.h factbld.h factmngr.h facthsh.h \ factmch.h factmngr.o: factmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h strngrtr.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h factbld.h factqury.h \ factmngr.h facthsh.h tmpltdef.h reteutil.h retract.h factcmp.h \ filecom.h factfun.h factcom.h factrhs.h factmch.h watch.h factbin.h \ default.h commline.h sysdep.h engine.h lgcldpnd.h drive.h ruledlt.h \ tmpltbsc.h tmpltutl.h tmpltfun.h factprt.o: factprt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h factgen.h \ reorder.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h factprt.h factqpsr.o: factqpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factqury.h factmngr.h facthsh.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h modulutl.h prcdrpsr.h prntutil.h \ router.h strngrtr.h factqpsr.h factqury.o: factqury.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h modulutl.h \ tmpltutl.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h insfun.h \ object.h factqpsr.h prcdrfun.h router.h prntutil.h factqury.h factrete.o: factrete.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ incrrset.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h reteutil.h drive.h engine.h lgcldpnd.h retract.h \ factgen.h factmch.h factmngr.h facthsh.h tmpltdef.h factbld.h \ factrete.h factrhs.o: factrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h modulutl.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h prntutil.h \ cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltrhs.h tmpltutl.h \ strngrtr.h router.h factrhs.h filecom.o: filecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ memalloc.h prcdrfun.h router.h prntutil.h strngrtr.h sysdep.h \ filecom.h bsave.h bload.h exprnbin.h symblbin.h filertr.o: filertr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h filertr.h generate.o: generate.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h generate.h analysis.h globlpsr.h genrcbin.o: genrcbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h cstrcbin.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h objbin.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h genrccom.h \ genrcfun.h modulbin.h genrcbin.h router.h prntutil.h genrccmp.o: genrccmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h genrccom.h genrcfun.h \ object.h objcmp.h genrccmp.h genrccom.o: genrccom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h bload.h exprnbin.h sysdep.h \ symblbin.h genrcbin.h genrcfun.h object.h genrccmp.h genrcpsr.h \ classcom.h inscom.h insfun.h watch.h argacces.h cstrcpsr.h genrcexe.h \ memalloc.h router.h prntutil.h genrccom.h genrcexe.o: genrcexe.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h insfun.h argacces.h genrccom.h genrcfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h genrcexe.h genrcfun.o: genrcfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h argacces.h cstrcpsr.h \ genrccom.h genrcfun.h genrcexe.h memalloc.h prccode.h router.h \ prntutil.h genrcpsr.o: genrcpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h dffnxfun.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h cstrccom.h classfun.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classcom.h memalloc.h \ cstrcpsr.h genrccom.h genrcfun.h immthpsr.h modulutl.h prcdrpsr.h \ prccode.h router.h prntutil.h genrcpsr.h globlbin.o: globlbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globldef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h cstrccom.h \ bload.h exprnbin.h sysdep.h symblbin.h bsave.h globlbsc.h globlbin.h \ modulbin.h cstrcbin.h globlbsc.o: globlbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h watch.h globlcom.h globldef.h \ cstrccom.h globlbin.h modulbin.h cstrcbin.h globlcmp.h globlbsc.h globlcmp.o: globlcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h globldef.h cstrccom.h globlcmp.h globlcom.o: globlcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h prntutil.h router.h \ globldef.h cstrccom.h globlcom.h globldef.o: globldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h modulpsr.h moduldef.h \ conscomp.h constrct.h symblcmp.h utility.h router.h prntutil.h \ strngrtr.h modulutl.h globlbsc.h globlpsr.h globlcom.h commline.h \ bload.h exprnbin.h sysdep.h symblbin.h globlbin.h modulbin.h \ cstrcbin.h globldef.h cstrccom.h globlcmp.h globlpsr.o: globlpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ watch.h modulutl.h cstrcpsr.h globldef.h cstrccom.h globlbsc.h bload.h \ exprnbin.h sysdep.h symblbin.h globlpsr.h immthpsr.o: immthpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h cstrnutl.h genrcpsr.h genrcfun.h prccode.h \ immthpsr.h incrrset.o: incrrset.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h router.h prntutil.h reteutil.h incrrset.h inherpsr.o: inherpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h modulutl.h router.h prntutil.h inherpsr.h inscom.o: inscom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfile.h insfun.h insmngr.h \ insmoddp.h insmult.h inspsr.h lgcldpnd.h memalloc.h msgcom.h msgpass.h \ msgfun.h router.h prntutil.h strngrtr.h sysdep.h commline.h inscom.h insfile.o: insfile.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h \ router.h prntutil.h strngrtr.h symblbin.h sysdep.h factmngr.h \ facthsh.h tmpltdef.h factbld.h insfile.h insfun.o: insfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h cstrnchk.h engine.h lgcldpnd.h retract.h inscom.h \ insfun.h insmngr.h memalloc.h modulutl.h msgcom.h msgpass.h msgfun.h \ prccode.h router.h prntutil.h drive.h objrtmch.h insmngr.o: insmngr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h drive.h objrtmch.h object.h \ lgcldpnd.h classcom.h classfun.h engine.h retract.h memalloc.h \ insfun.h modulutl.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h sysdep.h insmngr.h inscom.h watch.h insmoddp.o: insmoddp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h network.h match.h pattern.h reorder.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h objrtmch.h object.h \ argacces.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h miscfun.h \ msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h insmoddp.h insmult.o: insmult.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h insfun.h object.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h msgfun.h msgpass.h multifun.h router.h prntutil.h insmult.h inspsr.o: inspsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h prntutil.h router.h inspsr.h insquery.o: insquery.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h insmngr.h insqypsr.h \ prcdrfun.h router.h prntutil.h insquery.h insqypsr.o: insqypsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ insquery.h prcdrpsr.h prntutil.h router.h strngrtr.h insqypsr.h iofun.o: iofun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ filertr.h argacces.h memalloc.h commline.h sysdep.h iofun.h lgcldpnd.o: lgcldpnd.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h reteutil.h argacces.h \ factmngr.h facthsh.h tmpltdef.h factbld.h insfun.h object.h memalloc.o: memalloc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h miscfun.o: miscfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h sysdep.h dffnxfun.h cstrccom.h miscfun.h modulbin.o: modulbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h modulbin.h modulbsc.o: modulbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h modulbin.h prntutil.h modulcmp.h \ router.h argacces.h bload.h exprnbin.h sysdep.h symblbin.h modulbsc.h modulcmp.o: modulcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h sysdep.h modulcmp.h moduldef.o: moduldef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h modulcmp.h modulbsc.h bload.h exprnbin.h sysdep.h \ symblbin.h modulbin.h modulpsr.o: modulpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrcpsr.h modulutl.h bload.h exprnbin.h sysdep.h \ symblbin.h modulutl.o: modulutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h modulutl.h msgcom.o: msgcom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h classinf.h insfun.h insmoddp.h msgfun.h msgpass.h \ memalloc.h prccode.h router.h prntutil.h bload.h exprnbin.h sysdep.h \ symblbin.h msgpsr.h watch.h msgcom.h msgfun.o: msgfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h insfun.h msgcom.h msgpass.h prccode.h router.h \ prntutil.h msgfun.h msgpass.o: msgpass.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h classfun.h memalloc.h insfun.h msgcom.h msgpass.h msgfun.h \ prcdrfun.h prccode.h proflfun.h router.h prntutil.h strngfun.h \ commline.h inscom.h msgpsr.o: msgpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h classcom.h cstrccom.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h object.h constrnt.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h memalloc.h cstrcpsr.h \ cstrnchk.h insfun.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h strngrtr.h msgpsr.h multifld.o: multifld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ strngrtr.h object.h constrnt.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h multifun.o: multifun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifun.h \ prcdrpsr.h constrnt.h prcdrfun.h router.h prntutil.h object.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objbin.o: objbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h classcom.h cstrccom.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classfun.h classini.h \ cstrcbin.h cstrnbin.h insfun.h memalloc.h modulbin.h msgcom.h \ msgpass.h msgfun.h prntutil.h router.h objbin.h objcmp.o: objcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h classcom.h cstrccom.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classini.h cstrncmp.h objrtfnx.h objrtmch.h sysdep.h \ objcmp.h objrtbin.o: objrtbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h bload.h utility.h exprnbin.h sysdep.h \ symblbin.h bsave.h memalloc.h insfun.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h object.h constrnt.h match.h network.h \ ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ reteutil.h rulebin.h modulbin.h cstrcbin.h objrtbin.h objrtbld.o: objrtbld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnutl.h cstrnchk.h cstrnops.h drive.h inscom.h insfun.h \ insmngr.h memalloc.h reteutil.h rulepsr.h objrtmch.h objrtgen.h \ objrtfnx.h router.h prntutil.h objrtcmp.h objrtbin.h objrtbld.h objrtcmp.o: objrtcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h objrtfnx.h object.h constrnt.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h objrtmch.h \ sysdep.h objrtcmp.h objrtfnx.o: objrtfnx.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classcom.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h object.h \ constrnt.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h bload.h exprnbin.h sysdep.h symblbin.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h objrtmch.h reteutil.h router.h \ prntutil.h objrtfnx.h objrtgen.o: objrtgen.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtfnx.h objrtmch.h objrtgen.h objrtmch.o: objrtmch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h classfun.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h drive.h engine.h lgcldpnd.h retract.h incrrset.h reteutil.h \ ruledlt.h router.h prntutil.h objrtfnx.h objrtmch.h insmngr.h parsefun.o: parsefun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h memalloc.h \ prcdrpsr.h constrnt.h router.h prntutil.h strngrtr.h parsefun.h pattern.o: pattern.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrnt.h cstrnchk.h cstrnutl.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h reteutil.h router.h prntutil.h rulecmp.h pprint.o: pprint.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h sysdep.h utility.h prccode.o: prccode.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h globlpsr.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ constrnt.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h prcdrpsr.h router.h prntutil.h prccode.h prcdrfun.o: prcdrfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h memalloc.h prcdrpsr.h router.h prntutil.h prcdrfun.h \ globldef.h cstrccom.h prcdrpsr.o: prcdrpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h cstrnutl.h memalloc.h modulutl.h router.h prntutil.h \ prcdrpsr.h globldef.h cstrccom.h globlpsr.h prdctfun.o: prdctfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ prdctfun.h prntutil.o: prntutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h utility.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h router.h prntutil.h \ multifun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h inscom.h object.h insfun.h insmngr.h memalloc.h sysdep.h proflfun.o: proflfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h match.h network.h ruledef.h agenda.h pattern.h \ reorder.h dffnxfun.h genrccom.h genrcfun.h memalloc.h msgcom.h \ msgpass.h router.h prntutil.h sysdep.h proflfun.h reorder.o: reorder.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h cstrnutl.h constrnt.h memalloc.h \ pattern.h match.h network.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h cstrccom.h agenda.h reorder.h \ prntutil.h router.h rulelhs.h reteutil.o: reteutil.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h drive.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h incrrset.h memalloc.h router.h prntutil.h rulecom.h \ reteutil.h retract.o: retract.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h reteutil.h router.h prntutil.h router.o: router.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h filertr.h memalloc.h \ strngrtr.h sysdep.h router.h prntutil.h rulebin.o: rulebin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h reteutil.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h \ rulebsc.h rulebin.h modulbin.h cstrcbin.h rulebld.o: rulebld.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h drive.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h incrrset.h \ memalloc.h reteutil.h router.h prntutil.h rulebld.h rulepsr.h watch.h rulebsc.o: rulebsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h watch.h \ ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h pattern.h \ reorder.h engine.h lgcldpnd.h retract.h drive.h reteutil.h rulebin.h \ modulbin.h cstrcbin.h rulecmp.h rulebsc.h rulecmp.o: rulecmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h factbld.h pattern.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h reteutil.h \ rulecmp.h rulecom.o: rulecom.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h crstrtgy.h agenda.h \ ruledef.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ engine.h lgcldpnd.h retract.h incrrset.h memalloc.h reteutil.h \ router.h prntutil.h ruledlt.h sysdep.h watch.h rulebin.h modulbin.h \ cstrcbin.h rulecom.h rulecstr.o: rulecstr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrnchk.h \ cstrnops.h cstrnutl.h prcdrpsr.h router.h prntutil.h rulepsr.h \ rulecstr.h ruledef.o: ruledef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h drive.h engine.h lgcldpnd.h \ retract.h memalloc.h reteutil.h rulebsc.h rulecom.h rulepsr.h \ ruledlt.h bload.h exprnbin.h sysdep.h symblbin.h rulebin.h modulbin.h \ cstrcbin.h rulecmp.h ruledlt.o: ruledlt.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h engine.h lgcldpnd.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h \ reorder.h retract.h reteutil.h drive.h bload.h exprnbin.h sysdep.h \ symblbin.h ruledlt.h rulelhs.o: rulelhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ network.h match.h pattern.h reorder.h argacces.h cstrnchk.h memalloc.h \ router.h prntutil.h rulelhs.h rulepsr.o: rulepsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h analysis.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h cstrcpsr.h \ cstrnchk.h cstrnops.h engine.h lgcldpnd.h retract.h incrrset.h \ memalloc.h prccode.h prcdrpsr.h router.h prntutil.h rulebld.h \ rulebsc.h rulecstr.h ruledlt.h rulelhs.h watch.h tmpltfun.h factmngr.h \ facthsh.h tmpltdef.h factbld.h bload.h exprnbin.h sysdep.h symblbin.h \ rulepsr.h scanner.o: scanner.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h memalloc.h \ sysdep.h sortfun.o: sortfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h dffnxfun.h cstrccom.h \ memalloc.h sysdep.h sortfun.h strngfun.o: strngfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h cstrcpsr.h \ engine.h lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h retract.h memalloc.h prcdrpsr.h router.h \ prntutil.h strngrtr.h sysdep.h drive.h strngfun.h strngrtr.o: strngrtr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ sysdep.h strngrtr.h symblbin.o: symblbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h \ prntutil.h symblcmp.o: symblcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h argacces.h \ cstrncmp.h constrnt.h router.h prntutil.h sysdep.h symbol.o: symbol.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h sysdep.h sysdep.o: sysdep.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bmathfun.h commline.h \ constrnt.h cstrcpsr.h emathfun.h filecom.h iofun.h memalloc.h \ miscfun.h multifun.h parsefun.h prccode.h prdctfun.h proflfun.h \ prcdrfun.h router.h prntutil.h sortfun.h strngfun.h textpro.h watch.h \ sysdep.h dffctdef.h cstrccom.h ruledef.h agenda.h match.h network.h \ pattern.h reorder.h genrccom.h genrcfun.h object.h dffnxfun.h \ globldef.h tmpltdef.h factbld.h factmngr.h facthsh.h classini.h textpro.o: textpro.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h commline.h memalloc.h \ router.h prntutil.h sysdep.h textpro.h tmpltbin.o: tmpltbin.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h bload.h utility.h exprnbin.h \ sysdep.h symblbin.h bsave.h factbin.h factbld.h pattern.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ symblcmp.h constrnt.h cstrccom.h agenda.h reorder.h cstrnbin.h \ factmngr.h facthsh.h tmpltdef.h tmpltpsr.h tmpltutl.h tmpltbin.h \ cstrcbin.h modulbin.h tmpltbsc.o: tmpltbsc.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h tmpltdef.h factbld.h \ cstrcpsr.h tmpltpsr.h tmpltbin.h cstrcbin.h modulbin.h tmpltcmp.h \ tmpltutl.h tmpltbsc.h tmpltcmp.o: tmpltcmp.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h conscomp.h constrct.h moduldef.h \ modulpsr.h utility.h symblcmp.h factcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h cstrncmp.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltcmp.h tmpltdef.o: tmpltdef.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h cstrccom.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h network.h \ match.h pattern.h reorder.h ruledef.h constrnt.h agenda.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h tmpltbsc.h tmpltutl.h \ tmpltfun.h router.h prntutil.h modulutl.h cstrnchk.h bload.h \ exprnbin.h sysdep.h symblbin.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltcmp.h tmpltfun.o: tmpltfun.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h argacces.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h cstrnchk.h constrnt.h default.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h commline.h factrhs.h modulutl.h sysdep.h \ tmpltlhs.h tmpltutl.h tmpltrhs.h tmpltfun.h tmpltlhs.o: tmpltlhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ constrnt.h reorder.h ruledef.h cstrccom.h agenda.h match.h network.h \ pattern.h factrhs.h factmngr.h facthsh.h tmpltdef.h factbld.h \ modulutl.h tmpltutl.h tmpltlhs.h tmpltpsr.o: tmpltpsr.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h cstrnchk.h \ cstrnpsr.h cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h default.h \ watch.h cstrnutl.h tmpltbsc.h tmpltpsr.h tmpltrhs.o: tmpltrhs.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ tmpltfun.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h factbld.h \ factrhs.h modulutl.h default.h tmpltutl.h tmpltlhs.h tmpltrhs.h tmpltutl.o: tmpltutl.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h constrct.h moduldef.h \ conscomp.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ argacces.h cstrnchk.h constrnt.h tmpltfun.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h cstrccom.h agenda.h reorder.h \ tmpltdef.h factbld.h tmpltpsr.h modulutl.h watch.h sysdep.h tmpltbsc.h \ tmpltutl.h userdata.o: userdata.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h userfunctions.o: userfunctions.c clips.h setup.h envrnmnt.h symbol.h \ multifld.h evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h usrsetup.h argacces.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ memalloc.h cstrcpsr.h filecom.h strngfun.h commline.h router.h \ prntutil.h filertr.h strngrtr.h iofun.h sysdep.h bmathfun.h watch.h \ modulbsc.h bload.h exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h rulebsc.h \ engine.h lgcldpnd.h retract.h drive.h incrrset.h rulecom.h crstrtgy.h \ dffctdef.h dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h \ tmpltbsc.h tmpltfun.h factcom.h factfun.h globldef.h globlbsc.h \ globlcom.h dffnxfun.h genrccom.h genrcfun.h object.h classcom.h \ classexm.h classinf.h classini.h classpsr.h defins.h inscom.h insfun.h \ insfile.h msgcom.h msgpass.h objrtmch.h utility.o: utility.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h commline.h facthsh.h factmngr.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h tmpltdef.h factbld.h memalloc.h prntutil.h sysdep.h watch.o: watch.c setup.h envrnmnt.h symbol.h multifld.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h usrsetup.h memalloc.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ argacces.h watch.h clips_core_source_630/makefiles/._makefile.gcc0000755000175000017500000000110512504556217017715 0ustar jfsjfsMac OS X  2Ù :TEXTATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E667223522¨±L&ò2MWBB ðÿÿclips_core_source_630/core/0000755000175000017500000000000013170666374014243 5ustar jfsjfsclips_core_source_630/core/._classexm.h0000755000175000017500000000040712373714264016450 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxfun.c0000755000175000017500000011662712464742046016241 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* DEFFUNCTION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added missing initializer for ENTITY_RECORD. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "dffnxbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dffnxcmp.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "constrct.h" #include "cstrcpsr.h" #include "dffnxpsr.h" #include "modulpsr.h" #endif #include "envrnmnt.h" #if (! RUN_TIME) #include "extnfunc.h" #endif #include "dffnxexe.h" #if DEBUGGING_FUNCTIONS #include "watch.h" #endif #include "argacces.h" #include "memalloc.h" #include "cstrccom.h" #include "router.h" #define _DFFNXFUN_SOURCE_ #include "dffnxfun.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PrintDeffunctionCall(void *,const char *,void *); static intBool EvaluateDeffunctionCall(void *,void *,DATA_OBJECT *); static void DecrementDeffunctionBusyCount(void *,void *); static void IncrementDeffunctionBusyCount(void *,void *); static void DeallocateDeffunctionData(void *); #if ! RUN_TIME static void DestroyDeffunctionAction(void *,struct constructHeader *,void *); static void *AllocateModule(void *); static void ReturnModule(void *,void *); static intBool ClearDeffunctionsReady(void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) static intBool RemoveAllDeffunctions(void *); static void DeffunctionDeleteError(void *,const char *); static void SaveDeffunctionHeaders(void *,void *,const char *); static void SaveDeffunctionHeader(void *,struct constructHeader *,void *); static void SaveDeffunctions(void *,void *,const char *); #endif #if DEBUGGING_FUNCTIONS static unsigned DeffunctionWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DeffunctionWatchPrint(void *,const char *,int,EXPRESSION *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDeffunctions DESCRIPTION : Initializes parsers and access functions for deffunctions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Deffunction environment initialized NOTES : None ***************************************************/ globle void SetupDeffunctions( void *theEnv) { ENTITY_RECORD deffunctionEntityRecord = { "PCALL", PCALL,0,0,1, PrintDeffunctionCall,PrintDeffunctionCall, NULL,EvaluateDeffunctionCall,NULL, DecrementDeffunctionBusyCount,IncrementDeffunctionBusyCount, NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFFUNCTION_DATA,sizeof(struct deffunctionData),DeallocateDeffunctionData); memcpy(&DeffunctionData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&DeffunctionData(theEnv)->DeffunctionEntityRecord,PCALL); DeffunctionData(theEnv)->DeffunctionModuleIndex = RegisterModuleItem(theEnv,"deffunction", #if (! RUN_TIME) AllocateModule,ReturnModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDeffunctionModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeffunctionCModuleReference, #else NULL, #endif EnvFindDeffunctionInModule); DeffunctionData(theEnv)->DeffunctionConstruct = AddConstruct(theEnv,"deffunction","deffunctions", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDeffunction, #else NULL, #endif EnvFindDeffunction, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDeffunction, SetNextConstruct,EnvIsDeffunctionDeletable, EnvUndeffunction, #if (! BLOAD_ONLY) && (! RUN_TIME) RemoveDeffunction #else NULL #endif ); #if ! RUN_TIME AddClearReadyFunction(theEnv,"deffunction",ClearDeffunctionsReady,0); #if ! BLOAD_ONLY #if DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"deffunction",SYMBOL); #endif AddSaveFunction(theEnv,"deffunction-headers",SaveDeffunctionHeaders,1000); AddSaveFunction(theEnv,"deffunctions",SaveDeffunctions,0); EnvDefineFunction2(theEnv,"undeffunction",'v',PTIEF UndeffunctionCommand,"UndeffunctionCommand","11w"); #endif #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-deffunctions",'v',PTIEF ListDeffunctionsCommand,"ListDeffunctionsCommand","01"); EnvDefineFunction2(theEnv,"ppdeffunction",'v',PTIEF PPDeffunctionCommand,"PPDeffunctionCommand","11w"); #endif EnvDefineFunction2(theEnv,"get-deffunction-list",'m',PTIEF GetDeffunctionListFunction, "GetDeffunctionListFunction","01"); EnvDefineFunction2(theEnv,"deffunction-module",'w',PTIEF GetDeffunctionModuleCommand, "GetDeffunctionModuleCommand","11w"); #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupDeffunctionsBload(theEnv); #endif #if CONSTRUCT_COMPILER SetupDeffunctionCompiler(theEnv); #endif #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"deffunctions",0,&DeffunctionData(theEnv)->WatchDeffunctions,32, DeffunctionWatchAccess,DeffunctionWatchPrint); #endif } /******************************************************/ /* DeallocateDeffunctionData: Deallocates environment */ /* data for the deffunction construct. */ /******************************************************/ static void DeallocateDeffunctionData( void *theEnv) { #if ! RUN_TIME struct deffunctionModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDeffunctionAction,DeffunctionData(theEnv)->DeffunctionModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct deffunctionModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DeffunctionData(theEnv)->DeffunctionModuleIndex); rtn_struct(theEnv,deffunctionModule,theModuleItem); } #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /*****************************************************/ /* DestroyDeffunctionAction: Action used to remove */ /* deffunctions as a result of DestroyEnvironment. */ /*****************************************************/ static void DestroyDeffunctionAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffunctionStruct *theDeffunction = (struct deffunctionStruct *) theConstruct; if (theDeffunction == NULL) return; ReturnPackedExpression(theEnv,theDeffunction->code); DestroyConstructHeader(theEnv,&theDeffunction->header); rtn_struct(theEnv,deffunctionStruct,theDeffunction); #else #if MAC_XCD #pragma unused(theConstruct,theEnv) #endif #endif } #endif /*************************************************** NAME : EnvFindDeffunction DESCRIPTION : Searches for a deffunction INPUTS : The name of the deffunction (possibly including a module name) RETURNS : Pointer to the deffunction if found, otherwise NULL SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDeffunction( void *theEnv, const char *dfnxModuleAndName) { return(FindNamedConstructInModuleOrImports(theEnv,dfnxModuleAndName,DeffunctionData(theEnv)->DeffunctionConstruct)); } /*************************************************** NAME : EnvFindDeffunctionInModule DESCRIPTION : Searches for a deffunction INPUTS : The name of the deffunction (possibly including a module name) RETURNS : Pointer to the deffunction if found, otherwise NULL SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDeffunctionInModule( void *theEnv, const char *dfnxModuleAndName) { return(FindNamedConstructInModule(theEnv,dfnxModuleAndName,DeffunctionData(theEnv)->DeffunctionConstruct)); } /*************************************************** NAME : LookupDeffunctionByMdlOrScope DESCRIPTION : Finds a deffunction anywhere (if module is specified) or in current or imported modules INPUTS : The deffunction name RETURNS : The deffunction (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFFUNCTION *LookupDeffunctionByMdlOrScope( void *theEnv, const char *deffunctionName) { return((DEFFUNCTION *) LookupConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,deffunctionName,TRUE)); } /*************************************************** NAME : LookupDeffunctionInScope DESCRIPTION : Finds a deffunction in current or imported modules (module specifier is not allowed) INPUTS : The deffunction name RETURNS : The deffunction (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFFUNCTION *LookupDeffunctionInScope( void *theEnv, const char *deffunctionName) { return((DEFFUNCTION *) LookupConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,deffunctionName,FALSE)); } /*************************************************** NAME : EnvUndeffunction DESCRIPTION : External interface routine for removing a deffunction INPUTS : Deffunction pointer RETURNS : FALSE if unsuccessful, TRUE otherwise SIDE EFFECTS : Deffunction deleted, if possible NOTES : None ***************************************************/ globle intBool EnvUndeffunction( void *theEnv, void *vptr) { #if BLOAD_ONLY || RUN_TIME return(FALSE); #else #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif if (vptr == NULL) return(RemoveAllDeffunctions(theEnv)); if (EnvIsDeffunctionDeletable(theEnv,vptr) == FALSE) return(FALSE); RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr); RemoveDeffunction(theEnv,vptr); return(TRUE); #endif } /**************************************************** NAME : EnvGetNextDeffunction DESCRIPTION : Accesses list of deffunctions INPUTS : Deffunction pointer RETURNS : The next deffunction, or the first deffunction (if input is NULL) SIDE EFFECTS : None NOTES : None ****************************************************/ globle void *EnvGetNextDeffunction( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DeffunctionData(theEnv)->DeffunctionModuleIndex)); } /*************************************************** NAME : EnvIsDeffunctionDeletable DESCRIPTION : Determines if a deffunction is executing or referenced by another expression INPUTS : Deffunction pointer RETURNS : TRUE if the deffunction can be deleted, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDeffunctionDeletable( void *theEnv, void *ptr) { DEFFUNCTION *dptr; if (! ConstructsDeletable(theEnv)) { return FALSE; } dptr = (DEFFUNCTION *) ptr; return(((dptr->busy == 0) && (dptr->executing == 0)) ? TRUE : FALSE); } #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : RemoveDeffunction DESCRIPTION : Removes a deffunction INPUTS : Deffunction pointer RETURNS : Nothing useful SIDE EFFECTS : Deffunction deallocated NOTES : Assumes deffunction is not in use!! ***************************************************/ globle void RemoveDeffunction( void *theEnv, void *vdptr) { DEFFUNCTION *dptr = (DEFFUNCTION *) vdptr; if (dptr == NULL) return; DecrementSymbolCount(theEnv,EnvGetDeffunctionNamePointer(theEnv,(void *) dptr)); ExpressionDeinstall(theEnv,dptr->code); ReturnPackedExpression(theEnv,dptr->code); EnvSetDeffunctionPPForm(theEnv,(void *) dptr,NULL); ClearUserDataList(theEnv,dptr->header.usrData); rtn_struct(theEnv,deffunctionStruct,dptr); } #endif /******************************************************** NAME : UndeffunctionCommand DESCRIPTION : Deletes the named deffunction(s) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Deffunction(s) removed NOTES : H/L Syntax: (undeffunction | *) ********************************************************/ globle void UndeffunctionCommand( void *theEnv) { UndefconstructCommand(theEnv,"undeffunction",DeffunctionData(theEnv)->DeffunctionConstruct); } /**************************************************************** NAME : GetDeffunctionModuleCommand DESCRIPTION : Determines to which module a deffunction belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (deffunction-module ) ****************************************************************/ globle void *GetDeffunctionModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"deffunction-module",DeffunctionData(theEnv)->DeffunctionConstruct)); } #if DEBUGGING_FUNCTIONS /**************************************************** NAME : PPDeffunctionCommand DESCRIPTION : Displays the pretty-print form of a deffunction INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pretty-print form displayed to WDISPLAY logical name NOTES : H/L Syntax: (ppdeffunction ) ****************************************************/ globle void PPDeffunctionCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdeffunction",DeffunctionData(theEnv)->DeffunctionConstruct); } /*************************************************** NAME : ListDeffunctionsCommand DESCRIPTION : Displays all deffunction names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Deffunction name sprinted NOTES : H/L Interface ***************************************************/ globle void ListDeffunctionsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-deffunctions",DeffunctionData(theEnv)->DeffunctionConstruct); } /*************************************************** NAME : EnvListDeffunctions DESCRIPTION : Displays all deffunction names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Deffunction name sprinted NOTES : C Interface ***************************************************/ globle void EnvListDeffunctions( void *theEnv, const char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,logicalName,theModule); } #endif /*************************************************************** NAME : GetDeffunctionListFunction DESCRIPTION : Groups all deffunction names into a multifield list INPUTS : A data object buffer to hold the multifield result RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : H/L Syntax: (get-deffunction-list []) ***************************************************************/ globle void GetDeffunctionListFunction( void *theEnv, DATA_OBJECT *returnValue) { GetConstructListFunction(theEnv,"get-deffunction-list",returnValue,DeffunctionData(theEnv)->DeffunctionConstruct); } /*************************************************************** NAME : EnvGetDeffunctionList DESCRIPTION : Groups all deffunction names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain deffunctions RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDeffunctionList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DeffunctionData(theEnv)->DeffunctionConstruct,theModule); } /******************************************************* NAME : CheckDeffunctionCall DESCRIPTION : Checks the number of arguments passed to a deffunction INPUTS : 1) Deffunction pointer 2) The number of arguments RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Message printed on errors NOTES : None *******************************************************/ globle int CheckDeffunctionCall( void *theEnv, void *vdptr, int args) { DEFFUNCTION *dptr; if (vdptr == NULL) return(FALSE); dptr = (DEFFUNCTION *) vdptr; if (args < dptr->minNumberOfParameters) { if (dptr->maxNumberOfParameters == -1) ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), AT_LEAST,dptr->minNumberOfParameters); else ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), EXACTLY,dptr->minNumberOfParameters); return(FALSE); } else if ((args > dptr->minNumberOfParameters) && (dptr->maxNumberOfParameters != -1)) { ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), EXACTLY,dptr->minNumberOfParameters); return(FALSE); } return(TRUE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : PrintDeffunctionCall DESCRIPTION : PrintExpression() support function for deffunction calls INPUTS : 1) The output logical name 2) The deffunction RETURNS : Nothing useful SIDE EFFECTS : Call expression printed NOTES : None ***************************************************/ static void PrintDeffunctionCall( void *theEnv, const char *logName, void *value) { #if DEVELOPER EnvPrintRouter(theEnv,logName,"("); EnvPrintRouter(theEnv,logName,EnvGetDeffunctionName(theEnv,value)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logName," "); PrintExpression(theEnv,logName,GetFirstArgument()); } EnvPrintRouter(theEnv,logName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logName) #pragma unused(value) #endif #endif } /******************************************************* NAME : EvaluateDeffunctionCall DESCRIPTION : Primitive support function for calling a deffunction INPUTS : 1) The deffunction 2) A data object buffer to hold the evaluation result RETURNS : FALSE if the deffunction returns the symbol FALSE, TRUE otherwise SIDE EFFECTS : Data obejct buffer set and any side-effects of calling the deffunction NOTES : None *******************************************************/ static intBool EvaluateDeffunctionCall( void *theEnv, void *value, DATA_OBJECT *result) { CallDeffunction(theEnv,(DEFFUNCTION *) value,GetFirstArgument(),result); if ((GetpType(result) == SYMBOL) && (GetpValue(result) == EnvFalseSymbol(theEnv))) return(FALSE); return(TRUE); } /*************************************************** NAME : DecrementDeffunctionBusyCount DESCRIPTION : Lowers the busy count of a deffunction construct INPUTS : The deffunction RETURNS : Nothing useful SIDE EFFECTS : Busy count decremented if a clear is not in progress (see comment) NOTES : None ***************************************************/ static void DecrementDeffunctionBusyCount( void *theEnv, void *value) { /* ============================================== The deffunctions to which expressions in other constructs may refer may already have been deleted - thus, it is important not to modify the busy flag during a clear. ============================================== */ if (! ConstructData(theEnv)->ClearInProgress) ((DEFFUNCTION *) value)->busy--; } /*************************************************** NAME : IncrementDeffunctionBusyCount DESCRIPTION : Raises the busy count of a deffunction construct INPUTS : The deffunction RETURNS : Nothing useful SIDE EFFECTS : Busy count incremented NOTES : None ***************************************************/ static void IncrementDeffunctionBusyCount( void *theEnv, void *value) { #if MAC_XCD #pragma unused(theEnv) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif ((DEFFUNCTION *) value)->busy++; } #if ! RUN_TIME /***************************************************** NAME : AllocateModule DESCRIPTION : Creates and initializes a list of deffunctions for a new module INPUTS : None RETURNS : The new deffunction module SIDE EFFECTS : Deffunction module created NOTES : None *****************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,deffunctionModule)); } /*************************************************** NAME : ReturnModule DESCRIPTION : Removes a deffunction module and all associated deffunctions INPUTS : The deffunction module RETURNS : Nothing useful SIDE EFFECTS : Module and deffunctions deleted NOTES : None ***************************************************/ static void ReturnModule( void *theEnv, void *theItem) { #if (! BLOAD_ONLY) FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeffunctionData(theEnv)->DeffunctionConstruct); #endif rtn_struct(theEnv,deffunctionModule,theItem); } /*************************************************** NAME : ClearDeffunctionsReady DESCRIPTION : Determines if it is safe to remove all deffunctions Assumes *all* constructs will be deleted - only checks to see if any deffunctions are currently executing INPUTS : None RETURNS : TRUE if no deffunctions are executing, FALSE otherwise SIDE EFFECTS : None NOTES : Used by (clear) and (bload) ***************************************************/ static intBool ClearDeffunctionsReady( void *theEnv) { return((DeffunctionData(theEnv)->ExecutingDeffunction != NULL) ? FALSE : TRUE); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : RemoveAllDeffunctions DESCRIPTION : Removes all deffunctions INPUTS : None RETURNS : TRUE if all deffunctions removed, FALSE otherwise SIDE EFFECTS : Deffunctions removed NOTES : None ***************************************************/ static intBool RemoveAllDeffunctions( void *theEnv) { DEFFUNCTION *dptr,*dtmp; unsigned oldbusy; intBool success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); while (dptr != NULL) { if (dptr->executing > 0) { DeffunctionDeleteError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr)); success = FALSE; } else { oldbusy = dptr->busy; ExpressionDeinstall(theEnv,dptr->code); dptr->busy = oldbusy; ReturnPackedExpression(theEnv,dptr->code); dptr->code = NULL; } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(void *) dptr); } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); while (dptr != NULL) { dtmp = dptr; dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(void *) dptr); if (dtmp->executing == 0) { if (dtmp->busy > 0) { PrintWarningID(theEnv,"DFFNXFUN",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Deffunction "); EnvPrintRouter(theEnv,WWARNING,EnvGetDeffunctionName(theEnv,(void *) dtmp)); EnvPrintRouter(theEnv,WWARNING," only partially deleted due to usage by other constructs.\n"); EnvSetDeffunctionPPForm(theEnv,(void *) dtmp,NULL); success = FALSE; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) dtmp); RemoveDeffunction(theEnv,dtmp); } } } return(success); } /**************************************************** NAME : DeffunctionDeleteError DESCRIPTION : Prints out an error message when a deffunction deletion attempt fails INPUTS : The deffunction name RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ****************************************************/ static void DeffunctionDeleteError( void *theEnv, const char *dfnxName) { CantDeleteItemErrorMessage(theEnv,"deffunction",dfnxName); } /*************************************************** NAME : SaveDeffunctionHeaders DESCRIPTION : Writes out deffunction forward declarations for (save) command INPUTS : The logical output name RETURNS : Nothing useful SIDE EFFECTS : Writes out deffunctions with no body of actions NOTES : Used for deffunctions which are mutually recursive with other constructs ***************************************************/ static void SaveDeffunctionHeaders( void *theEnv, void *theModule, const char *logicalName) { DoForAllConstructsInModule(theEnv,theModule,SaveDeffunctionHeader, DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,(void *) logicalName); } /*************************************************** NAME : SaveDeffunctionHeader DESCRIPTION : Writes a deffunction forward declaration to the save file INPUTS : 1) The deffunction 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Defffunction header written NOTES : None ***************************************************/ static void SaveDeffunctionHeader( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { DEFFUNCTION *dfnxPtr = (DEFFUNCTION *) theDeffunction; const char *logicalName = (const char *) userBuffer; register int i; if (EnvGetDeffunctionPPForm(theEnv,(void *) dfnxPtr) != NULL) { EnvPrintRouter(theEnv,logicalName,"(deffunction "); EnvPrintRouter(theEnv,logicalName,EnvDeffunctionModule(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName,"::"); EnvPrintRouter(theEnv,logicalName,EnvGetDeffunctionName(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName," ("); for (i = 0 ; i < dfnxPtr->minNumberOfParameters ; i++) { EnvPrintRouter(theEnv,logicalName,"?p"); PrintLongInteger(theEnv,logicalName,(long long) i); if (i != dfnxPtr->minNumberOfParameters-1) EnvPrintRouter(theEnv,logicalName," "); } if (dfnxPtr->maxNumberOfParameters == -1) { if (dfnxPtr->minNumberOfParameters != 0) EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,"$?wildargs))\n\n"); } else EnvPrintRouter(theEnv,logicalName,"))\n\n"); } } /*************************************************** NAME : SaveDeffunctions DESCRIPTION : Writes out deffunctions for (save) command INPUTS : The logical output name RETURNS : Nothing useful SIDE EFFECTS : Writes out deffunctions NOTES : None ***************************************************/ static void SaveDeffunctions( void *theEnv, void *theModule, const char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DeffunctionData(theEnv)->DeffunctionConstruct); } #endif #if DEBUGGING_FUNCTIONS /****************************************************************** NAME : DeffunctionWatchAccess DESCRIPTION : Parses a list of deffunction names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set Ignored 2) The value to which to set the trace flags 3) A list of expressions containing the names of the deffunctions for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified deffunctions NOTES : Accessory function for AddWatchItem() ******************************************************************/ static unsigned DeffunctionWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,newState,argExprs, EnvGetDeffunctionWatch,EnvSetDeffunctionWatch)); } /*********************************************************************** NAME : DeffunctionWatchPrint DESCRIPTION : Parses a list of deffunction names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined Ignored 3) A list of expressions containing the names of the deffunctions for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified deffunctions NOTES : Accessory function for AddWatchItem() ***********************************************************************/ static unsigned DeffunctionWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,logName,argExprs, EnvGetDeffunctionWatch,EnvSetDeffunctionWatch)); } /********************************************************* NAME : EnvSetDeffunctionWatch DESCRIPTION : Sets the trace to ON/OFF for the deffunction INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the deffunction RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the deffunction set NOTES : None *********************************************************/ globle void EnvSetDeffunctionWatch( void *theEnv, unsigned newState, void *dptr) { #if MAC_XCD #pragma unused(theEnv) #endif ((DEFFUNCTION *) dptr)->trace = (unsigned short) newState; } /********************************************************* NAME : EnvGetDeffunctionWatch DESCRIPTION : Determines if trace messages are gnerated when executing deffunction INPUTS : A pointer to the deffunction RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle unsigned EnvGetDeffunctionWatch( void *theEnv, void *dptr) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFFUNCTION *) dptr)->trace); } #endif /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvDeffunctionModule( void *theEnv, void *theDeffunction) { return GetConstructModuleName((struct constructHeader *) theDeffunction); } globle const char *EnvGetDeffunctionName( void *theEnv, void *theDeffunction) { return GetConstructNameString((struct constructHeader *) theDeffunction); } globle const char *EnvGetDeffunctionPPForm( void *theEnv, void *theDeffunction) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDeffunction); } globle SYMBOL_HN *EnvGetDeffunctionNamePointer( void *theEnv, void *theDeffunction) { return GetConstructNamePointer((struct constructHeader *) theDeffunction); } globle void EnvSetDeffunctionPPForm( void *theEnv, void *theDeffunction, const char *thePPForm) { SetConstructPPForm(theEnv,(struct constructHeader *) theDeffunction,thePPForm); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle const char *DeffunctionModule( void *theDeffunction) { return EnvDeffunctionModule(GetCurrentEnvironment(),theDeffunction); } globle void *FindDeffunction( const char *deffunctionName) { return EnvFindDeffunction(GetCurrentEnvironment(),deffunctionName); } globle void *GetNextDeffunction( void *deffunctionPtr) { return EnvGetNextDeffunction(GetCurrentEnvironment(),deffunctionPtr); } globle intBool IsDeffunctionDeletable( void *ptr) { return EnvIsDeffunctionDeletable(GetCurrentEnvironment(),ptr); } globle const char *GetDeffunctionName( void *theDeffunction) { return EnvGetDeffunctionName(GetCurrentEnvironment(),theDeffunction); } globle const char *GetDeffunctionPPForm( void *theDeffunction) { return EnvGetDeffunctionPPForm(GetCurrentEnvironment(),theDeffunction); } globle intBool Undeffunction( void *vptr) { return EnvUndeffunction(GetCurrentEnvironment(),vptr); } globle void GetDeffunctionList( DATA_OBJECT *returnValue, struct defmodule *theModule) { EnvGetDeffunctionList(GetCurrentEnvironment(),returnValue,theModule); } #if DEBUGGING_FUNCTIONS globle void ListDeffunctions( const char *logicalName, struct defmodule *theModule) { EnvListDeffunctions(GetCurrentEnvironment(),logicalName,theModule); } globle unsigned GetDeffunctionWatch( void *dptr) { return EnvGetDeffunctionWatch(GetCurrentEnvironment(),dptr); } globle void SetDeffunctionWatch( unsigned newState, void *dptr) { EnvSetDeffunctionWatch(GetCurrentEnvironment(),newState,dptr); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif clips_core_source_630/core/msgpass.h0000755000175000017500000001047112374017650016067 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Message-passing support functions */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: The return value of DirectMessage indicates */ /* whether an execution error has occurred. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_msgpass #define _H_msgpass #define GetActiveInstance(theEnv) ((INSTANCE_TYPE *) GetNthMessageArgument(theEnv,0)->value) #ifndef _H_object #include "object.h" #endif typedef struct messageHandlerLink { HANDLER *hnd; struct messageHandlerLink *nxt; struct messageHandlerLink *nxtInStack; } HANDLER_LINK; #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGPASS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool DirectMessage(void *,SYMBOL_HN *,INSTANCE_TYPE *, DATA_OBJECT *,EXPRESSION *); LOCALE void EnvSend(void *,DATA_OBJECT *,const char *,const char *,DATA_OBJECT *); LOCALE void DestroyHandlerLinks(void *,HANDLER_LINK *); LOCALE void SendCommand(void *,DATA_OBJECT *); LOCALE DATA_OBJECT *GetNthMessageArgument(void *,int); LOCALE int NextHandlerAvailable(void *); LOCALE void CallNextHandler(void *,DATA_OBJECT *); LOCALE void FindApplicableOfName(void *,DEFCLASS *,HANDLER_LINK *[], HANDLER_LINK *[],SYMBOL_HN *); LOCALE HANDLER_LINK *JoinHandlerLinks(void *,HANDLER_LINK *[],HANDLER_LINK *[],SYMBOL_HN *); LOCALE void PrintHandlerSlotGetFunction(void *,const char *,void *); LOCALE intBool HandlerSlotGetFunction(void *,void *,DATA_OBJECT *); LOCALE void PrintHandlerSlotPutFunction(void *,const char *,void *); LOCALE intBool HandlerSlotPutFunction(void *,void *,DATA_OBJECT *); LOCALE void DynamicHandlerGetSlot(void *,DATA_OBJECT *); LOCALE void DynamicHandlerPutSlot(void *,DATA_OBJECT *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void Send(DATA_OBJECT *,const char *,const char *,DATA_OBJECT *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_object */ clips_core_source_630/core/dffctcmp.c0000755000175000017500000002423612373721213016173 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFFACTS CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* deffacts construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _DFFCTCMP_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "dffctdef.h" #include "envrnmnt.h" #include "dffctcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void DeffactsToCode(void *,FILE *,struct deffacts *, int,int,int); static void DeffactsModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void CloseDeffactsFiles(void *,FILE *,FILE *,int); static void BeforeDeffactsToCode(void *); /*************************************************************/ /* DeffactsCompilerSetup: Initializes the deffacts construct */ /* for use with the constructs-to-c command. */ /*************************************************************/ globle void DeffactsCompilerSetup( void *theEnv) { DeffactsData(theEnv)->DeffactsCodeItem = AddCodeGeneratorItem(theEnv,"deffacts",0,BeforeDeffactsToCode, NULL,ConstructToCode,2); } /*************************************************************/ /* BeforeDeffactsToCode: Assigns each deffacts a unique ID */ /* which will be used for pointer references when the data */ /* structures are written to a file as C code */ /*************************************************************/ static void BeforeDeffactsToCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DeffactsData(theEnv)->DeffactsModuleIndex); } /**********************************************************/ /* ConstructToCode: Produces deffacts code for a run-time */ /* module created using the constructs-to-c function. */ /**********************************************************/ static int ConstructToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct deffacts *theDeffacts; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int deffactsArrayCount = 0, deffactsArrayVersion = 1; FILE *moduleFile = NULL, *deffactsFile = NULL; /*===============================================*/ /* Include the appropriate deffacts header file. */ /*===============================================*/ fprintf(headerFP,"#include \"dffctdef.h\"\n"); /*=================================================================*/ /* Loop through all the modules and all the deffacts writing their */ /* C code representation to the file as they are traversed. */ /*=================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct deffactsModule",ModulePrefix(DeffactsData(theEnv)->DeffactsCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDeffactsFiles(theEnv,moduleFile,deffactsFile,maxIndices); return(0); } DeffactsModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); /*===================================================*/ /* Loop through each of the deffacts in this module. */ /*===================================================*/ for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { deffactsFile = OpenFileIfNeeded(theEnv,deffactsFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, deffactsArrayVersion,headerFP, "struct deffacts",ConstructPrefix(DeffactsData(theEnv)->DeffactsCodeItem), FALSE,NULL); if (deffactsFile == NULL) { CloseDeffactsFiles(theEnv,moduleFile,deffactsFile,maxIndices); return(0); } DeffactsToCode(theEnv,deffactsFile,theDeffacts,imageID,maxIndices,moduleCount); deffactsArrayCount++; deffactsFile = CloseFileIfNeeded(theEnv,deffactsFile,&deffactsArrayCount, &deffactsArrayVersion,maxIndices,NULL,NULL); } moduleCount++; moduleArrayCount++; } CloseDeffactsFiles(theEnv,moduleFile,deffactsFile,maxIndices); return(1); } /*********************************************************/ /* CloseDeffactsFiles: Closes all of the C files created */ /* for deffacts. Called when an error occurs or when */ /* the deffacts have all been written to the files. */ /*********************************************************/ static void CloseDeffactsFiles( void *theEnv, FILE *moduleFile, FILE *deffactsFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (deffactsFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,deffactsFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /**********************************************************/ /* DeffactsModuleToCode: Writes the C code representation */ /* of a single deffacts module to the specified file. */ /**********************************************************/ static void DeffactsModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DeffactsData(theEnv)->DeffactsModuleIndex, ConstructPrefix(DeffactsData(theEnv)->DeffactsCodeItem)); fprintf(theFile,"}"); } /*********************************************************/ /* DeffactsToCode: Writes the C code representation of a */ /* single deffacts construct to the specified file. */ /*********************************************************/ static void DeffactsToCode( void *theEnv, FILE *theFile, struct deffacts *theDeffacts, int imageID, int maxIndices, int moduleCount) { /*=================*/ /* Deffacts Header */ /*=================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDeffacts->header,imageID,maxIndices, moduleCount,ModulePrefix(DeffactsData(theEnv)->DeffactsCodeItem), ConstructPrefix(DeffactsData(theEnv)->DeffactsCodeItem)); fprintf(theFile,","); /*=============*/ /* Assert List */ /*=============*/ ExpressionToCode(theEnv,theFile,theDeffacts->assertList); fprintf(theFile,"}"); } /**************************************************************/ /* DeffactsCModuleReference: Writes the C code representation */ /* of a reference to a deffacts module data structure. */ /**************************************************************/ globle void DeffactsCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DeffactsData(theEnv)->DeffactsCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } #endif /* DEFFACTS_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/._usrsetup.h0000755000175000017500000000033012365012262016504 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/commline.c0000755000175000017500000011257512461762345016225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* COMMAND LINE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of routines for processing */ /* commands entered at the top level prompt. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Refactored several functions and added */ /* additional functions for use by an interface */ /* layered on top of CLIPS. */ /* */ /* 6.30: Local variables set with the bind function */ /* persist until a reset/clear command is issued. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Changed integer type/precision. */ /* */ /* Metrowerks CodeWarrior (MAC_MCW, IBM_MCW) is */ /* no longer supported. */ /* */ /* UTF-8 support. */ /* */ /* Command history and editing support */ /* */ /* Used genstrcpy instead of strcpy. */ /* */ /* Added before command execution callback */ /* function. */ /* */ /* Fixed RouteCommand return value. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ #define _COMMLINE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "argacces.h" #include "constrct.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "filecom.h" #include "memalloc.h" #include "multifld.h" #include "prcdrfun.h" #include "prcdrpsr.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #include "symbol.h" #include "sysdep.h" #include "utility.h" #include "commline.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if ! RUN_TIME static int DoString(const char *,int,int *); static int DoComment(const char *,int); static int DoWhiteSpace(const char *,int); static int DefaultGetNextEvent(void *); #endif static void DeallocateCommandLineData(void *); /****************************************************/ /* InitializeCommandLineData: Allocates environment */ /* data for command line functionality. */ /****************************************************/ globle void InitializeCommandLineData( void *theEnv) { AllocateEnvironmentData(theEnv,COMMANDLINE_DATA,sizeof(struct commandLineData),DeallocateCommandLineData); #if ! RUN_TIME CommandLineData(theEnv)->BannerString = BANNER_STRING; CommandLineData(theEnv)->EventFunction = DefaultGetNextEvent; #endif } /*******************************************************/ /* DeallocateCommandLineData: Deallocates environment */ /* data for the command line functionality. */ /******************************************************/ static void DeallocateCommandLineData( void *theEnv) { #if ! RUN_TIME if (CommandLineData(theEnv)->CommandString != NULL) { rm(theEnv,CommandLineData(theEnv)->CommandString,CommandLineData(theEnv)->MaximumCharacters); } if (CommandLineData(theEnv)->CurrentCommand != NULL) { ReturnExpression(theEnv,CommandLineData(theEnv)->CurrentCommand); } #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /***************************************************/ /* ExpandCommandString: Appends a character to the */ /* command string. Returns TRUE if the command */ /* string was successfully expanded, otherwise */ /* FALSE. Expanding the string also includes */ /* adding a backspace character which reduces */ /* string's length. */ /***************************************************/ globle int ExpandCommandString( void *theEnv, int inchar) { size_t k; k = RouterData(theEnv)->CommandBufferInputCount; CommandLineData(theEnv)->CommandString = ExpandStringWithChar(theEnv,inchar,CommandLineData(theEnv)->CommandString,&RouterData(theEnv)->CommandBufferInputCount, &CommandLineData(theEnv)->MaximumCharacters,CommandLineData(theEnv)->MaximumCharacters+80); return((RouterData(theEnv)->CommandBufferInputCount != k) ? TRUE : FALSE); } /******************************************************************/ /* FlushCommandString: Empties the contents of the CommandString. */ /******************************************************************/ globle void FlushCommandString( void *theEnv) { if (CommandLineData(theEnv)->CommandString != NULL) rm(theEnv,CommandLineData(theEnv)->CommandString,CommandLineData(theEnv)->MaximumCharacters); CommandLineData(theEnv)->CommandString = NULL; CommandLineData(theEnv)->MaximumCharacters = 0; RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; } /*********************************************************************************/ /* SetCommandString: Sets the contents of the CommandString to a specific value. */ /*********************************************************************************/ globle void SetCommandString( void *theEnv, const char *str) { size_t length; FlushCommandString(theEnv); length = strlen(str); CommandLineData(theEnv)->CommandString = (char *) genrealloc(theEnv,CommandLineData(theEnv)->CommandString,(unsigned) CommandLineData(theEnv)->MaximumCharacters, (unsigned) CommandLineData(theEnv)->MaximumCharacters + length + 1); genstrcpy(CommandLineData(theEnv)->CommandString,str); CommandLineData(theEnv)->MaximumCharacters += (length + 1); RouterData(theEnv)->CommandBufferInputCount += (int) length; } /*************************************************************/ /* SetNCommandString: Sets the contents of the CommandString */ /* to a specific value up to N characters. */ /*************************************************************/ globle void SetNCommandString( void *theEnv, const char *str, unsigned length) { FlushCommandString(theEnv); CommandLineData(theEnv)->CommandString = (char *) genrealloc(theEnv,CommandLineData(theEnv)->CommandString,(unsigned) CommandLineData(theEnv)->MaximumCharacters, (unsigned) CommandLineData(theEnv)->MaximumCharacters + length + 1); genstrncpy(CommandLineData(theEnv)->CommandString,str,length); CommandLineData(theEnv)->CommandString[CommandLineData(theEnv)->MaximumCharacters + length] = 0; CommandLineData(theEnv)->MaximumCharacters += (length + 1); RouterData(theEnv)->CommandBufferInputCount += (int) length; } /******************************************************************************/ /* AppendCommandString: Appends a value to the contents of the CommandString. */ /******************************************************************************/ globle void AppendCommandString( void *theEnv, const char *str) { CommandLineData(theEnv)->CommandString = AppendToString(theEnv,str,CommandLineData(theEnv)->CommandString,&RouterData(theEnv)->CommandBufferInputCount,&CommandLineData(theEnv)->MaximumCharacters); } /******************************************************************************/ /* InsertCommandString: Inserts a value in the contents of the CommandString. */ /******************************************************************************/ globle void InsertCommandString( void *theEnv, const char *str, unsigned int position) { CommandLineData(theEnv)->CommandString = InsertInString(theEnv,str,position,CommandLineData(theEnv)->CommandString, &RouterData(theEnv)->CommandBufferInputCount,&CommandLineData(theEnv)->MaximumCharacters); } /************************************************************/ /* AppendNCommandString: Appends a value up to N characters */ /* to the contents of the CommandString. */ /************************************************************/ globle void AppendNCommandString( void *theEnv, const char *str, unsigned length) { CommandLineData(theEnv)->CommandString = AppendNToString(theEnv,str,CommandLineData(theEnv)->CommandString,length,&RouterData(theEnv)->CommandBufferInputCount,&CommandLineData(theEnv)->MaximumCharacters); } /*****************************************************************************/ /* GetCommandString: Returns a pointer to the contents of the CommandString. */ /*****************************************************************************/ globle char *GetCommandString( void *theEnv) { return(CommandLineData(theEnv)->CommandString); } /**************************************************************************/ /* CompleteCommand: Determines whether a string forms a complete command. */ /* A complete command is either a constant, a variable, or a function */ /* call which is followed (at some point) by a carriage return. Once a */ /* complete command is found (not including the parenthesis), */ /* extraneous parenthesis and other tokens are ignored. If a complete */ /* command exists, then 1 is returned. 0 is returned if the command was */ /* not complete and without errors. -1 is returned if the command */ /* contains an error. */ /**************************************************************************/ globle int CompleteCommand( const char *mstring) { int i; char inchar; int depth = 0; int moreThanZero = 0; int complete; int error = 0; if (mstring == NULL) return(0); /*===================================================*/ /* Loop through each character of the command string */ /* to determine if there is a complete command. */ /*===================================================*/ i = 0; while ((inchar = mstring[i++]) != EOS) { switch(inchar) { /*======================================================*/ /* If a carriage return or line feed is found, there is */ /* at least one completed token in the command buffer, */ /* and parentheses are balanced, then a complete */ /* command has been found. Otherwise, remove all white */ /* space beginning with the current character. */ /*======================================================*/ case '\n' : case '\r' : if (error) return(-1); if (moreThanZero && (depth == 0)) return(1); i = DoWhiteSpace(mstring,i); break; /*=====================*/ /* Remove white space. */ /*=====================*/ case ' ' : case '\f' : case '\t' : i = DoWhiteSpace(mstring,i); break; /*======================================================*/ /* If the opening quotation of a string is encountered, */ /* determine if the closing quotation of the string is */ /* in the command buffer. Until the closing quotation */ /* is found, a complete command can not be made. */ /*======================================================*/ case '"' : i = DoString(mstring,i,&complete); if ((depth == 0) && complete) moreThanZero = TRUE; break; /*====================*/ /* Process a comment. */ /*====================*/ case ';' : i = DoComment(mstring,i); if (moreThanZero && (depth == 0) && (mstring[i] != EOS)) { if (error) return(-1); else return(1); } else if (mstring[i] != EOS) i++; break; /*====================================================*/ /* A left parenthesis increases the nesting depth of */ /* the current command by 1. Don't bother to increase */ /* the depth if the first token encountered was not */ /* a parenthesis (e.g. for the command string */ /* "red (+ 3 4", the symbol red already forms a */ /* complete command, so the next carriage return will */ /* cause evaluation of red--the closing parenthesis */ /* for "(+ 3 4" does not have to be found). */ /*====================================================*/ case '(' : if ((depth > 0) || (moreThanZero == FALSE)) { depth++; moreThanZero = TRUE; } break; /*====================================================*/ /* A right parenthesis decreases the nesting depth of */ /* the current command by 1. If the parenthesis is */ /* the first token of the command, then an error is */ /* generated. */ /*====================================================*/ case ')' : if (depth > 0) depth--; else if (moreThanZero == FALSE) error = TRUE; break; /*=====================================================*/ /* If the command begins with any other character and */ /* an opening parenthesis hasn't yet been found, then */ /* skip all characters on the same line. If a carriage */ /* return or line feed is found, then a complete */ /* command exists. */ /*=====================================================*/ default: if (depth == 0) { if (isprint(inchar) || IsUTF8MultiByteStart(inchar)) { while ((inchar = mstring[i++]) != EOS) { if ((inchar == '\n') || (inchar == '\r')) { if (error) return(-1); else return(1); } } return(0); } } break; } } /*====================================================*/ /* Return 0 because a complete command was not found. */ /*====================================================*/ return(0); } /***********************************************************/ /* DoString: Skips over a string contained within a string */ /* until the closing quotation mark is encountered. */ /***********************************************************/ static int DoString( const char *str, int pos, int *complete) { int inchar; /*=================================================*/ /* Process the string character by character until */ /* the closing quotation mark is found. */ /*=================================================*/ inchar = str[pos]; while (inchar != '"') { /*=====================================================*/ /* If a \ is found, then the next character is ignored */ /* even if it is a closing quotation mark. */ /*=====================================================*/ if (inchar == '\\') { pos++; inchar = str[pos]; } /*===================================================*/ /* If the end of input is reached before the closing */ /* quotation mark is found, the return the last */ /* position that was reached and indicate that a */ /* complete string was not found. */ /*===================================================*/ if (inchar == EOS) { *complete = FALSE; return(pos); } /*================================*/ /* Move on to the next character. */ /*================================*/ pos++; inchar = str[pos]; } /*======================================================*/ /* Indicate that a complete string was found and return */ /* the position of the closing quotation mark. */ /*======================================================*/ pos++; *complete = TRUE; return(pos); } /*************************************************************/ /* DoComment: Skips over a comment contained within a string */ /* until a line feed or carriage return is encountered. */ /*************************************************************/ static int DoComment( const char *str, int pos) { int inchar; inchar = str[pos]; while ((inchar != '\n') && (inchar != '\r')) { if (inchar == EOS) { return(pos); } pos++; inchar = str[pos]; } return(pos); } /**************************************************************/ /* DoWhiteSpace: Skips over white space consisting of spaces, */ /* tabs, and form feeds that is contained within a string. */ /**************************************************************/ static int DoWhiteSpace( const char *str, int pos) { int inchar; inchar = str[pos]; while ((inchar == ' ') || (inchar == '\f') || (inchar == '\t')) { pos++; inchar = str[pos]; } return(pos); } /********************************************************************/ /* CommandLoop: Endless loop which waits for user commands and then */ /* executes them. The command loop will bypass the EventFunction */ /* if there is an active batch file. */ /********************************************************************/ globle void CommandLoop( void *theEnv) { int inchar; EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; while (TRUE) { /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == TRUE) { inchar = LLGetcBatch(theEnv,STDIN,TRUE); if (inchar == EOF) { (*CommandLineData(theEnv)->EventFunction)(theEnv); } else { ExpandCommandString(theEnv,(char) inchar); } } else { (*CommandLineData(theEnv)->EventFunction)(theEnv); } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (GetHaltExecution(theEnv) == TRUE) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } } /***********************************************************/ /* CommandLoopBatch: Loop which waits for commands from a */ /* batch file and then executes them. Returns when there */ /* are no longer any active batch files. */ /***********************************************************/ globle void CommandLoopBatch( void *theEnv) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; CommandLoopBatchDriver(theEnv); } /************************************************************/ /* CommandLoopOnceThenBatch: Loop which waits for commands */ /* from a batch file and then executes them. Returns when */ /* there are no longer any active batch files. */ /************************************************************/ globle void CommandLoopOnceThenBatch( void *theEnv) { if (! ExecuteIfCommandComplete(theEnv)) return; CommandLoopBatchDriver(theEnv); } /*********************************************************/ /* CommandLoopBatchDriver: Loop which waits for commands */ /* from a batch file and then executes them. Returns */ /* when there are no longer any active batch files. */ /*********************************************************/ globle void CommandLoopBatchDriver( void *theEnv) { int inchar; while (TRUE) { if (GetHaltCommandLoopBatch(theEnv) == TRUE) { CloseAllBatchSources(theEnv); SetHaltCommandLoopBatch(theEnv,FALSE); } /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == TRUE) { inchar = LLGetcBatch(theEnv,STDIN,TRUE); if (inchar == EOF) { return; } else { ExpandCommandString(theEnv,(char) inchar); } } else { return; } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (GetHaltExecution(theEnv) == TRUE) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } } /**********************************************************/ /* ExecuteIfCommandComplete: Checks to determine if there */ /* is a completed command and if so executes it. */ /**********************************************************/ globle intBool ExecuteIfCommandComplete( void *theEnv) { if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || (RouterData(theEnv)->CommandBufferInputCount == 0) || (RouterData(theEnv)->AwaitingInput == FALSE)) { return FALSE; } if (CommandLineData(theEnv)->BeforeCommandExecutionFunction != NULL) { if (! (*CommandLineData(theEnv)->BeforeCommandExecutionFunction)(theEnv)) { return FALSE; } } FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,OFF); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = FALSE; RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,TRUE); FlushPPBuffer(theEnv); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); PrintPrompt(theEnv); return TRUE; } /*******************************************/ /* CommandCompleteAndNotEmpty: */ /*******************************************/ globle intBool CommandCompleteAndNotEmpty( void *theEnv) { if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || (RouterData(theEnv)->CommandBufferInputCount == 0) || (RouterData(theEnv)->AwaitingInput == FALSE)) { return FALSE; } return TRUE; } /*******************************************/ /* PrintPrompt: Prints the command prompt. */ /*******************************************/ globle void PrintPrompt( void *theEnv) { EnvPrintRouter(theEnv,WPROMPT,COMMAND_PROMPT); if (CommandLineData(theEnv)->AfterPromptFunction != NULL) { (*CommandLineData(theEnv)->AfterPromptFunction)(theEnv); } } /*****************************************/ /* PrintBanner: Prints the CLIPS banner. */ /*****************************************/ globle void PrintBanner( void *theEnv) { EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString); } /************************************************/ /* SetAfterPromptFunction: Replaces the current */ /* value of AfterPromptFunction. */ /************************************************/ globle void SetAfterPromptFunction( void *theEnv, int (*funptr)(void *)) { CommandLineData(theEnv)->AfterPromptFunction = funptr; } /***********************************************************/ /* SetBeforeCommandExecutionFunction: Replaces the current */ /* value of BeforeCommandExecutionFunction. */ /***********************************************************/ globle void SetBeforeCommandExecutionFunction( void *theEnv, int (*funptr)(void *)) { CommandLineData(theEnv)->BeforeCommandExecutionFunction = funptr; } /********************************************************/ /* RouteCommand: Processes a completed command. Returns */ /* 1 if a command could be parsed, otherwise 0. */ /********************************************************/ globle intBool RouteCommand( void *theEnv, const char *command, int printResult) { DATA_OBJECT result; struct expr *top; const char *commandName; struct token theToken; int danglingConstructs; if (command == NULL) { return(0); } /*========================================*/ /* Open a string input source and get the */ /* first token from that source. */ /*========================================*/ OpenStringSource(theEnv,"command",command,0); GetToken(theEnv,"command",&theToken); /*=====================*/ /* Evaluate constants. */ /*=====================*/ if ((theToken.type == SYMBOL) || (theToken.type == STRING) || (theToken.type == FLOAT) || (theToken.type == INTEGER) || (theToken.type == INSTANCE_NAME)) { CloseStringSource(theEnv,"command"); if (printResult) { PrintAtom(theEnv,STDOUT,theToken.type,theToken.value); EnvPrintRouter(theEnv,STDOUT,"\n"); } return(1); } /*=====================*/ /* Evaluate variables. */ /*=====================*/ if ((theToken.type == GBL_VARIABLE) || (theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE)) { CloseStringSource(theEnv,"command"); top = GenConstant(theEnv,theToken.type,theToken.value); EvaluateExpression(theEnv,top,&result); rtn_struct(theEnv,expr,top); if (printResult) { PrintDataObject(theEnv,STDOUT,&result); EnvPrintRouter(theEnv,STDOUT,"\n"); } return(1); } /*========================================================*/ /* If the next token isn't the beginning left parenthesis */ /* of a command or construct, then whatever was entered */ /* cannot be evaluated at the command prompt. */ /*========================================================*/ if (theToken.type != LPAREN) { PrintErrorID(theEnv,"COMMLINE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or variable\n"); CloseStringSource(theEnv,"command"); return(0); } /*===========================================================*/ /* The next token must be a function name or construct type. */ /*===========================================================*/ GetToken(theEnv,"command",&theToken); if (theToken.type != SYMBOL) { PrintErrorID(theEnv,"COMMLINE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a command.\n"); CloseStringSource(theEnv,"command"); return(0); } commandName = ValueToString(theToken.value); /*======================*/ /* Evaluate constructs. */ /*======================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) { int errorFlag; errorFlag = ParseConstruct(theEnv,commandName,"command"); if (errorFlag != -1) { CloseStringSource(theEnv,"command"); if (errorFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); if (errorFlag) return 0; else return 1; } } #endif /*========================*/ /* Parse a function call. */ /*========================*/ danglingConstructs = ConstructData(theEnv)->DanglingConstructs; CommandLineData(theEnv)->ParsingTopLevelCommand = TRUE; top = Function2Parse(theEnv,"command",commandName); CommandLineData(theEnv)->ParsingTopLevelCommand = FALSE; ClearParsedBindNames(theEnv); /*================================*/ /* Close the string input source. */ /*================================*/ CloseStringSource(theEnv,"command"); /*=========================*/ /* Evaluate function call. */ /*=========================*/ if (top == NULL) { ConstructData(theEnv)->DanglingConstructs = danglingConstructs; return(0); } ExpressionInstall(theEnv,top); CommandLineData(theEnv)->EvaluatingTopLevelCommand = TRUE; CommandLineData(theEnv)->CurrentCommand = top; EvaluateExpression(theEnv,top,&result); CommandLineData(theEnv)->CurrentCommand = NULL; CommandLineData(theEnv)->EvaluatingTopLevelCommand = FALSE; ExpressionDeinstall(theEnv,top); ReturnExpression(theEnv,top); ConstructData(theEnv)->DanglingConstructs = danglingConstructs; /*=================================================*/ /* Print the return value of the function/command. */ /*=================================================*/ if ((result.type != RVOID) && printResult) { PrintDataObject(theEnv,STDOUT,&result); EnvPrintRouter(theEnv,STDOUT,"\n"); } return(1); } /*****************************************************************/ /* DefaultGetNextEvent: Default event-handling function. Handles */ /* only keyboard events by first calling GetcRouter to get a */ /* character and then calling ExpandCommandString to add the */ /* character to the CommandString. */ /*****************************************************************/ static int DefaultGetNextEvent( void *theEnv) { int inchar; inchar = EnvGetcRouter(theEnv,STDIN); if (inchar == EOF) inchar = '\n'; ExpandCommandString(theEnv,(char) inchar); return 0; } /*************************************/ /* SetEventFunction: Replaces the */ /* current value of EventFunction. */ /*************************************/ globle int (*SetEventFunction(void *theEnv,int (*theFunction)(void *)))(void *) { int (*tmp_ptr)(void *); tmp_ptr = CommandLineData(theEnv)->EventFunction; CommandLineData(theEnv)->EventFunction = theFunction; return(tmp_ptr); } /****************************************/ /* TopLevelCommand: Indicates whether a */ /* top-level command is being parsed. */ /****************************************/ globle intBool TopLevelCommand( void *theEnv) { return(CommandLineData(theEnv)->ParsingTopLevelCommand); } /***********************************************************/ /* GetCommandCompletionString: Returns the last token in a */ /* string if it is a valid token for command completion. */ /***********************************************************/ globle const char *GetCommandCompletionString( void *theEnv, const char *theString, size_t maxPosition) { struct token lastToken; struct token theToken; char lastChar; const char *rs; size_t length; /*=========================*/ /* Get the command string. */ /*=========================*/ if (theString == NULL) return(""); /*=========================================================================*/ /* If the last character in the command string is a space, character */ /* return, or quotation mark, then the command completion can be anything. */ /*=========================================================================*/ lastChar = theString[maxPosition - 1]; if ((lastChar == ' ') || (lastChar == '"') || (lastChar == '\t') || (lastChar == '\f') || (lastChar == '\n') || (lastChar == '\r')) { return(""); } /*============================================*/ /* Find the last token in the command string. */ /*============================================*/ OpenTextSource(theEnv,"CommandCompletion",theString,0,maxPosition); ScannerData(theEnv)->IgnoreCompletionErrors = TRUE; GetToken(theEnv,"CommandCompletion",&theToken); CopyToken(&lastToken,&theToken); while (theToken.type != STOP) { CopyToken(&lastToken,&theToken); GetToken(theEnv,"CommandCompletion",&theToken); } CloseStringSource(theEnv,"CommandCompletion"); ScannerData(theEnv)->IgnoreCompletionErrors = FALSE; /*===============================================*/ /* Determine if the last token can be completed. */ /*===============================================*/ if (lastToken.type == SYMBOL) { rs = ValueToString(lastToken.value); if (rs[0] == '[') return (&rs[1]); return(ValueToString(lastToken.value)); } else if (lastToken.type == SF_VARIABLE) { return(ValueToString(lastToken.value)); } else if (lastToken.type == MF_VARIABLE) { return(ValueToString(lastToken.value)); } else if ((lastToken.type == GBL_VARIABLE) || (lastToken.type == MF_GBL_VARIABLE) || (lastToken.type == INSTANCE_NAME)) { return(NULL); } else if (lastToken.type == STRING) { length = strlen(ValueToString(lastToken.value)); return(GetCommandCompletionString(theEnv,ValueToString(lastToken.value),length)); } else if ((lastToken.type == FLOAT) || (lastToken.type == INTEGER)) { return(NULL); } return(""); } /****************************************************************/ /* SetHaltCommandLoopBatch: Sets the HaltCommandLoopBatch flag. */ /****************************************************************/ globle void SetHaltCommandLoopBatch( void *theEnv, int value) { CommandLineData(theEnv)->HaltCommandLoopBatch = value; } /*******************************************************************/ /* GetHaltCommandLoopBatch: Returns the HaltCommandLoopBatch flag. */ /*******************************************************************/ globle int GetHaltCommandLoopBatch( void *theEnv) { return(CommandLineData(theEnv)->HaltCommandLoopBatch); } #endif clips_core_source_630/core/pprint.c0000755000175000017500000002541012373743667015735 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PRETTY PRINT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for processing the pretty print */ /* representation of constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Chris Culbert */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Corrected code generating compilation */ /* warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Used genstrcpy instead of strcpy. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _PPRINT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "sysdep.h" #include "utility.h" #include "pprint.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocatePrettyPrintData(void *); /****************************************************/ /* InitializePrettyPrintData: Allocates environment */ /* data for pretty print routines. */ /****************************************************/ globle void InitializePrettyPrintData( void *theEnv) { AllocateEnvironmentData(theEnv,PRETTY_PRINT_DATA,sizeof(struct prettyPrintData),DeallocatePrettyPrintData); PrettyPrintData(theEnv)->PPBufferEnabled = TRUE; } /******************************************************/ /* DeallocatePrettyPrintData: Deallocates environment */ /* data for the pretty print routines. */ /******************************************************/ static void DeallocatePrettyPrintData( void *theEnv) { if (PrettyPrintData(theEnv)->PrettyPrintBuffer != NULL) { rm(theEnv,PrettyPrintData(theEnv)->PrettyPrintBuffer,PrettyPrintData(theEnv)->PPBufferMax); } } /*******************************************************/ /* FlushPPBuffer: Resets the pretty print save buffer. */ /*******************************************************/ globle void FlushPPBuffer( void *theEnv) { if (PrettyPrintData(theEnv)->PrettyPrintBuffer == NULL) return; PrettyPrintData(theEnv)->PPBackupOnce = 0; PrettyPrintData(theEnv)->PPBackupTwice = 0; PrettyPrintData(theEnv)->PPBufferPos = 0; PrettyPrintData(theEnv)->PrettyPrintBuffer[0] = EOS; return; } /*********************************************************************/ /* DestroyPPBuffer: Resets and removes the pretty print save buffer. */ /*********************************************************************/ globle void DestroyPPBuffer(void *theEnv) { PrettyPrintData(theEnv)->PPBackupOnce = 0; PrettyPrintData(theEnv)->PPBackupTwice = 0; PrettyPrintData(theEnv)->PPBufferPos = 0; if (PrettyPrintData(theEnv)->PrettyPrintBuffer != NULL) rm(theEnv,PrettyPrintData(theEnv)->PrettyPrintBuffer,PrettyPrintData(theEnv)->PPBufferMax); PrettyPrintData(theEnv)->PrettyPrintBuffer = NULL; PrettyPrintData(theEnv)->PPBufferMax = 0; } /*********************************************/ /* SavePPBuffer: Appends a string to the end */ /* of the pretty print save buffer. */ /*********************************************/ globle void SavePPBuffer( void *theEnv, const char *str) { size_t increment; /*==========================================*/ /* If the pretty print buffer isn't needed, */ /* then don't bother writing to it. */ /*==========================================*/ if ((PrettyPrintData(theEnv)->PPBufferStatus == OFF) || (! PrettyPrintData(theEnv)->PPBufferEnabled)) { return; } /*===============================*/ /* Determine the increment size. */ /*===============================*/ increment = 512; if (PrettyPrintData(theEnv)->PPBufferPos > increment) { increment = PrettyPrintData(theEnv)->PPBufferPos * 3; } /*================================================*/ /* If the pretty print buffer isn't big enough to */ /* contain the string, then increase its size. */ /*================================================*/ if (strlen(str) + PrettyPrintData(theEnv)->PPBufferPos + 1 >= PrettyPrintData(theEnv)->PPBufferMax) { PrettyPrintData(theEnv)->PrettyPrintBuffer = (char *) genrealloc(theEnv,PrettyPrintData(theEnv)->PrettyPrintBuffer, PrettyPrintData(theEnv)->PPBufferMax, PrettyPrintData(theEnv)->PPBufferMax + increment); PrettyPrintData(theEnv)->PPBufferMax += increment; } /*==================================================*/ /* Remember the previous tokens saved to the pretty */ /* print buffer in case it is necessary to back up. */ /*==================================================*/ PrettyPrintData(theEnv)->PPBackupTwice = PrettyPrintData(theEnv)->PPBackupOnce; PrettyPrintData(theEnv)->PPBackupOnce = PrettyPrintData(theEnv)->PPBufferPos; /*=============================================*/ /* Save the string to the pretty print buffer. */ /*=============================================*/ PrettyPrintData(theEnv)->PrettyPrintBuffer = AppendToString(theEnv,str,PrettyPrintData(theEnv)->PrettyPrintBuffer,&PrettyPrintData(theEnv)->PPBufferPos,&PrettyPrintData(theEnv)->PPBufferMax); } /***************************************************/ /* PPBackup: Removes the last string added to the */ /* pretty print save buffer. Only capable of */ /* backing up for the two most recent additions. */ /***************************************************/ globle void PPBackup( void *theEnv) { if ((PrettyPrintData(theEnv)->PPBufferStatus == OFF) || (PrettyPrintData(theEnv)->PrettyPrintBuffer == NULL) || (! PrettyPrintData(theEnv)->PPBufferEnabled)) { return; } PrettyPrintData(theEnv)->PPBufferPos = PrettyPrintData(theEnv)->PPBackupOnce; PrettyPrintData(theEnv)->PPBackupOnce = PrettyPrintData(theEnv)->PPBackupTwice; PrettyPrintData(theEnv)->PrettyPrintBuffer[PrettyPrintData(theEnv)->PPBufferPos] = EOS; } /**************************************************/ /* CopyPPBuffer: Makes a copy of the pretty print */ /* save buffer. */ /**************************************************/ globle char *CopyPPBuffer( void *theEnv) { size_t length; char *newString; length = (1 + strlen(PrettyPrintData(theEnv)->PrettyPrintBuffer)) * (int) sizeof (char); newString = (char *) gm2(theEnv,length); genstrcpy(newString,PrettyPrintData(theEnv)->PrettyPrintBuffer); return(newString); } /************************************************************/ /* GetPPBuffer: Returns a pointer to the PrettyPrintBuffer. */ /************************************************************/ globle char *GetPPBuffer( void *theEnv) { return(PrettyPrintData(theEnv)->PrettyPrintBuffer); } /*******************************************/ /* PPCRAndIndent: Prints white spaces into */ /* the pretty print buffer. */ /*******************************************/ globle void PPCRAndIndent( void *theEnv) { int i; char buffer[120]; if ((PrettyPrintData(theEnv)->PPBufferStatus == OFF) || (! PrettyPrintData(theEnv)->PPBufferEnabled)) { return; } buffer[0] = '\n'; for (i = 1 ; i <= PrettyPrintData(theEnv)->IndentationDepth ; i++) { buffer[i] = ' '; } buffer[i] = EOS; SavePPBuffer(theEnv,buffer); } /************************************************/ /* IncrementIndentDepth: Increments indentation */ /* depth for pretty printing. */ /************************************************/ globle void IncrementIndentDepth( void *theEnv, int value) { PrettyPrintData(theEnv)->IndentationDepth += value; } /************************************************/ /* DecrementIndentDepth: Decrements indentation */ /* depth for pretty printing. */ /************************************************/ globle void DecrementIndentDepth( void *theEnv, int value) { PrettyPrintData(theEnv)->IndentationDepth -= value; } /************************************/ /* SetIndentDepth: Sets indentation */ /* depth for pretty printing. */ /************************************/ globle void SetIndentDepth( void *theEnv, int value) { PrettyPrintData(theEnv)->IndentationDepth = value; } /******************************************/ /* SetPPBufferStatus: Sets PPBufferStatus */ /* flag to boolean value of ON or OFF. */ /******************************************/ globle void SetPPBufferStatus( void *theEnv, int value) { PrettyPrintData(theEnv)->PPBufferStatus = value; } /************************************/ /* GetPPBufferStatus: Returns value */ /* of the PPBufferStatus flag. */ /************************************/ globle int GetPPBufferStatus( void *theEnv) { return(PrettyPrintData(theEnv)->PPBufferStatus); } /******************************************/ /* SetPPBufferEnabled: */ /******************************************/ globle int SetPPBufferEnabled( void *theEnv, int value) { int oldValue; oldValue = PrettyPrintData(theEnv)->PPBufferEnabled; PrettyPrintData(theEnv)->PPBufferEnabled = value; return(oldValue); } /************************************/ /* GetPPBufferEnabled: */ /************************************/ globle int GetPPBufferEnabled( void *theEnv) { return(PrettyPrintData(theEnv)->PPBufferEnabled); } clips_core_source_630/core/._multifun.h0000755000175000017500000000040712374017640016467 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrcexe.c0000755000175000017500000000040712373753405016424 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objrtfnx.c0000755000175000017500000014063612374023166016247 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INFERENCE ENGINE OBJECT ACCESS ROUTINES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: RETE Network Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #include #define _STDIO_INCLUDED_ #include #include "classcom.h" #include "classfun.h" #if DEVELOPER #include "exprnops.h" #endif #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "constant.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "multifld.h" #include "objrtmch.h" #include "reteutil.h" #include "router.h" #define _OBJRTFNX_SOURCE_ #include "objrtfnx.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define GetInsSlot(ins,si) ins->slotAddresses[ins->cls->slotNameMap[si]-1] /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PrintObjectGetVarJN1(void *,const char *,void *); static intBool ObjectGetVarJNFunction1(void *,void *,DATA_OBJECT *); static void PrintObjectGetVarJN2(void *,const char *,void *); static intBool ObjectGetVarJNFunction2(void *,void *,DATA_OBJECT *); static void PrintObjectGetVarPN1(void *,const char *,void *); static intBool ObjectGetVarPNFunction1(void *,void *,DATA_OBJECT *); static void PrintObjectGetVarPN2(void *,const char *,void *); static intBool ObjectGetVarPNFunction2(void *,void *,DATA_OBJECT *); static void PrintObjectCmpConstant(void *,const char *,void *); static void PrintSlotLengthTest(void *,const char *,void *); static intBool SlotLengthTestFunction(void *,void *,DATA_OBJECT *); static void PrintPNSimpleCompareFunction1(void *,const char *,void *); static intBool PNSimpleCompareFunction1(void *,void *,DATA_OBJECT *); static void PrintPNSimpleCompareFunction2(void *,const char *,void *); static intBool PNSimpleCompareFunction2(void *,void *,DATA_OBJECT *); static void PrintPNSimpleCompareFunction3(void *,const char *,void *); static intBool PNSimpleCompareFunction3(void *,void *,DATA_OBJECT *); static void PrintJNSimpleCompareFunction1(void *,const char *,void *); static intBool JNSimpleCompareFunction1(void *,void *,DATA_OBJECT *); static void PrintJNSimpleCompareFunction2(void *,const char *,void *); static intBool JNSimpleCompareFunction2(void *,void *,DATA_OBJECT *); static void PrintJNSimpleCompareFunction3(void *,const char *,void *); static intBool JNSimpleCompareFunction3(void *,void *,DATA_OBJECT *); static void GetPatternObjectAndMarks(void *,int,int,int,INSTANCE_TYPE **,struct multifieldMarker **); static void GetObjectValueGeneral(void *,DATA_OBJECT *,INSTANCE_TYPE *, struct multifieldMarker *,struct ObjectMatchVar1 *); static void GetObjectValueSimple(void *,DATA_OBJECT *,INSTANCE_TYPE *,struct ObjectMatchVar2 *); static long CalculateSlotField(struct multifieldMarker *,INSTANCE_SLOT *,long,long *); /* 6.04 Bug Fix */ static void GetInsMultiSlotField(FIELD *,INSTANCE_TYPE *,unsigned,unsigned,unsigned); static void DeallocateObjectReteData(void *); static void DestroyObjectPatternNetwork(void *,OBJECT_PATTERN_NODE *); static void DestroyObjectAlphaNodes(void *,OBJECT_ALPHA_NODE *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : InstallObjectPrimitives DESCRIPTION : Installs all the entity records associated with object pattern matching operations INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Primitive operations installed NOTES : None ***************************************************/ globle void InstallObjectPrimitives( void *theEnv) { struct entityRecord objectGVInfo1 = { "OBJ_GET_SLOT_JNVAR1", OBJ_GET_SLOT_JNVAR1,0,1,0, PrintObjectGetVarJN1, PrintObjectGetVarJN1,NULL, ObjectGetVarJNFunction1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectGVInfo2 = { "OBJ_GET_SLOT_JNVAR2", OBJ_GET_SLOT_JNVAR2,0,1,0, PrintObjectGetVarJN2, PrintObjectGetVarJN2,NULL, ObjectGetVarJNFunction2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectGVPNInfo1 = { "OBJ_GET_SLOT_PNVAR1", OBJ_GET_SLOT_PNVAR1,0,1,0, PrintObjectGetVarPN1, PrintObjectGetVarPN1,NULL, ObjectGetVarPNFunction1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectGVPNInfo2 = { "OBJ_GET_SLOT_PNVAR2", OBJ_GET_SLOT_PNVAR2,0,1,0, PrintObjectGetVarPN2, PrintObjectGetVarPN2,NULL, ObjectGetVarPNFunction2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectCmpConstantInfo = { "OBJ_PN_CONSTANT", OBJ_PN_CONSTANT,0,1,1, PrintObjectCmpConstant, PrintObjectCmpConstant,NULL, ObjectCmpConstantFunction, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord lengthTestInfo = { "OBJ_SLOT_LENGTH", OBJ_SLOT_LENGTH,0,1,0, PrintSlotLengthTest, PrintSlotLengthTest,NULL, SlotLengthTestFunction, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord pNSimpleCompareInfo1 = { "OBJ_PN_CMP1", OBJ_PN_CMP1,0,1,1, PrintPNSimpleCompareFunction1, PrintPNSimpleCompareFunction1,NULL, PNSimpleCompareFunction1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord pNSimpleCompareInfo2 = { "OBJ_PN_CMP2", OBJ_PN_CMP2,0,1,1, PrintPNSimpleCompareFunction2, PrintPNSimpleCompareFunction2,NULL, PNSimpleCompareFunction2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord pNSimpleCompareInfo3 = { "OBJ_PN_CMP3", OBJ_PN_CMP3,0,1,1, PrintPNSimpleCompareFunction3, PrintPNSimpleCompareFunction3,NULL, PNSimpleCompareFunction3, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord jNSimpleCompareInfo1 = { "OBJ_JN_CMP1", OBJ_JN_CMP1,0,1,1, PrintJNSimpleCompareFunction1, PrintJNSimpleCompareFunction1,NULL, JNSimpleCompareFunction1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord jNSimpleCompareInfo2 = { "OBJ_JN_CMP2", OBJ_JN_CMP2,0,1,1, PrintJNSimpleCompareFunction2, PrintJNSimpleCompareFunction2,NULL, JNSimpleCompareFunction2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord jNSimpleCompareInfo3 = { "OBJ_JN_CMP3", OBJ_JN_CMP3,0,1,1, PrintJNSimpleCompareFunction3, PrintJNSimpleCompareFunction3,NULL, JNSimpleCompareFunction3, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,OBJECT_RETE_DATA,sizeof(struct objectReteData),DeallocateObjectReteData); ObjectReteData(theEnv)->CurrentObjectSlotLength = 1; memcpy(&ObjectReteData(theEnv)->ObjectGVInfo1,&objectGVInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectGVInfo2,&objectGVInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectGVPNInfo1,&objectGVPNInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectGVPNInfo2,&objectGVPNInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectCmpConstantInfo,&objectCmpConstantInfo,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->LengthTestInfo,&lengthTestInfo,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo1,&pNSimpleCompareInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo2,&pNSimpleCompareInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo3,&pNSimpleCompareInfo3,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo1,&jNSimpleCompareInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo2,&jNSimpleCompareInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo3,&jNSimpleCompareInfo3,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVInfo1,OBJ_GET_SLOT_JNVAR1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVInfo2,OBJ_GET_SLOT_JNVAR2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVPNInfo1,OBJ_GET_SLOT_PNVAR1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVPNInfo2,OBJ_GET_SLOT_PNVAR2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectCmpConstantInfo,OBJ_PN_CONSTANT); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->LengthTestInfo,OBJ_SLOT_LENGTH); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo1,OBJ_PN_CMP1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo2,OBJ_PN_CMP2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo3,OBJ_PN_CMP3); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo1,OBJ_JN_CMP1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo2,OBJ_JN_CMP2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo3,OBJ_JN_CMP3); } /*****************************************************/ /* DeallocateObjectReteData: Deallocates environment */ /* data for the object rete network. */ /*****************************************************/ static void DeallocateObjectReteData( void *theEnv) { OBJECT_PATTERN_NODE *theNetwork; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif theNetwork = ObjectReteData(theEnv)->ObjectPatternNetworkPointer; DestroyObjectPatternNetwork(theEnv,theNetwork); } /****************************************************************/ /* DestroyObjectPatternNetwork: Deallocates the data structures */ /* associated with the object pattern network. */ /****************************************************************/ static void DestroyObjectPatternNetwork( void *theEnv, OBJECT_PATTERN_NODE *thePattern) { OBJECT_PATTERN_NODE *patternPtr; if (thePattern == NULL) return; while (thePattern != NULL) { patternPtr = thePattern->rightNode; DestroyObjectPatternNetwork(theEnv,thePattern->nextLevel); DestroyObjectAlphaNodes(theEnv,thePattern->alphaNode); #if ! RUN_TIME rtn_struct(theEnv,objectPatternNode,thePattern); #endif thePattern = patternPtr; } } /************************************************************/ /* DestroyObjectAlphaNodes: Deallocates the data structures */ /* associated with the object alpha nodes. */ /************************************************************/ static void DestroyObjectAlphaNodes( void *theEnv, OBJECT_ALPHA_NODE *theNode) { OBJECT_ALPHA_NODE *nodePtr; if (theNode == NULL) return; while (theNode != NULL) { nodePtr = theNode->nxtInGroup; DestroyAlphaMemory(theEnv,&theNode->header,FALSE); #if ! RUN_TIME rtn_struct(theEnv,objectAlphaNode,theNode); #endif theNode = nodePtr; } } /***************************************************** NAME : ObjectCmpConstantFunction DESCRIPTION : Used to compare object slot values against a constant INPUTS : 1) The constant test bitmap 2) Data object buffer to hold result RETURNS : TRUE if test successful, FALSE otherwise SIDE EFFECTS : Buffer set to symbol TRUE if test successful, FALSE otherwise NOTES : Called directly by EvaluatePatternExpression() *****************************************************/ globle intBool ObjectCmpConstantFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNConstant *hack; DATA_OBJECT theVar; EXPRESSION *constantExp; int rv; SEGMENT *theSegment; hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue); if (hack->general) { EvaluateExpression(theEnv,GetFirstArgument(),&theVar); constantExp = GetFirstArgument()->nextArg; } else { constantExp = GetFirstArgument(); if (ObjectReteData(theEnv)->CurrentPatternObjectSlot->type == MULTIFIELD) { theSegment = (struct multifield *) ObjectReteData(theEnv)->CurrentPatternObjectSlot->value; if (hack->fromBeginning) { theVar.type = theSegment->theFields[hack->offset].type; theVar.value = theSegment->theFields[hack->offset].value; } else { theVar.type = theSegment->theFields[theSegment->multifieldLength - (hack->offset + 1)].type; theVar.value = theSegment->theFields[theSegment->multifieldLength - (hack->offset + 1)].value; } } else { theVar.type = (unsigned short) ObjectReteData(theEnv)->CurrentPatternObjectSlot->type; theVar.value = ObjectReteData(theEnv)->CurrentPatternObjectSlot->value; } } if (theVar.type != constantExp->type) rv = hack->fail; else if (theVar.value != constantExp->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ static void PrintObjectGetVarJN1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); if (hack->objectAddress) { EnvPrintRouter(theEnv,logicalName,"(obj-ptr "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); } else if (hack->allFields) { EnvPrintRouter(theEnv,logicalName,"(obj-slot-contents "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); } else { EnvPrintRouter(theEnv,logicalName,"(obj-slot-var "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichField); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarJNFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar1 *hack; INSTANCE_TYPE *theInstance; struct multifieldMarker *theMarks; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->whichPattern),hack->lhs,hack->rhs,&theInstance,&theMarks); GetObjectValueGeneral(theEnv,theResult,theInstance,theMarks,hack); return(TRUE); } static void PrintObjectGetVarJN2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar2 *hack; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(obj-slot-quick-var "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); if (hack->fromBeginning) { EnvPrintRouter(theEnv,logicalName," B"); PrintLongInteger(theEnv,logicalName,(long long) (hack->beginningOffset + 1)); } if (hack->fromEnd) { EnvPrintRouter(theEnv,logicalName," E"); PrintLongInteger(theEnv,logicalName,(long long) (hack->endOffset + 1)); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarJNFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar2 *hack; INSTANCE_TYPE *theInstance; struct multifieldMarker *theMarks; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->whichPattern),hack->lhs,hack->rhs,&theInstance,&theMarks); GetObjectValueSimple(theEnv,theResult,theInstance,hack); return(TRUE); } static void PrintObjectGetVarPN1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); if (hack->objectAddress) EnvPrintRouter(theEnv,logicalName,"(ptn-obj-ptr "); else if (hack->allFields) { EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-contents "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); } else { EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-var "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichField); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarPNFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); GetObjectValueGeneral(theEnv,theResult,ObjectReteData(theEnv)->CurrentPatternObject,ObjectReteData(theEnv)->CurrentPatternObjectMarks,hack); return(TRUE); } static void PrintObjectGetVarPN2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar2 *hack; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-quick-var "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); if (hack->fromBeginning) { EnvPrintRouter(theEnv,logicalName," B"); PrintLongInteger(theEnv,logicalName,(long long) (hack->beginningOffset + 1)); } if (hack->fromEnd) { EnvPrintRouter(theEnv,logicalName," E"); PrintLongInteger(theEnv,logicalName,(long long) (hack->endOffset + 1)); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarPNFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar2 *hack; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); GetObjectValueSimple(theEnv,theResult,ObjectReteData(theEnv)->CurrentPatternObject,hack); return(TRUE); } static void PrintObjectCmpConstant( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNConstant *hack; hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(obj-const "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); if (hack->general) PrintExpression(theEnv,logicalName,GetFirstArgument()); else { EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? "B" : "E"); PrintLongInteger(theEnv,logicalName,(long long) hack->offset); EnvPrintRouter(theEnv,logicalName," "); PrintExpression(theEnv,logicalName,GetFirstArgument()); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static void PrintSlotLengthTest( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchLength *hack; hack = (struct ObjectMatchLength *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(obj-slot-len "); if (hack->exactly) EnvPrintRouter(theEnv,logicalName,"= "); else EnvPrintRouter(theEnv,logicalName,">= "); PrintLongInteger(theEnv,logicalName,(long long) hack->minLength); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool SlotLengthTestFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchLength *hack; theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); hack = (struct ObjectMatchLength *) ValueToBitMap(theValue); if (ObjectReteData(theEnv)->CurrentObjectSlotLength < hack->minLength) return(FALSE); if (hack->exactly && (ObjectReteData(theEnv)->CurrentObjectSlotLength > hack->minLength)) return(FALSE); theResult->value = EnvTrueSymbol(theEnv); return(TRUE); } static void PrintPNSimpleCompareFunction1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNSingleSlotVars1 *hack; hack = (struct ObjectCmpPNSingleSlotVars1 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(pslot-cmp1 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool PNSimpleCompareFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNSingleSlotVars1 *hack; INSTANCE_SLOT *is1,*is2; int rv; hack = (struct ObjectCmpPNSingleSlotVars1 *) ValueToBitMap(theValue); is1 = GetInsSlot(ObjectReteData(theEnv)->CurrentPatternObject,hack->firstSlot); is2 = GetInsSlot(ObjectReteData(theEnv)->CurrentPatternObject,hack->secondSlot); if (is1->type != is2->type) rv = hack->fail; else if (is1->value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } static void PrintPNSimpleCompareFunction2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNSingleSlotVars2 *hack; hack = (struct ObjectCmpPNSingleSlotVars2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(pslot-cmp2 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long long) hack->offset); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool PNSimpleCompareFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNSingleSlotVars2 *hack; int rv; FIELD f1; INSTANCE_SLOT *is2; hack = (struct ObjectCmpPNSingleSlotVars2 *) ValueToBitMap(theValue); GetInsMultiSlotField(&f1,ObjectReteData(theEnv)->CurrentPatternObject,(unsigned) hack->firstSlot, (unsigned) hack->fromBeginning,(unsigned) hack->offset); is2 = GetInsSlot(ObjectReteData(theEnv)->CurrentPatternObject,hack->secondSlot); if (f1.type != is2->type) rv = hack->fail; else if (f1.value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } static void PrintPNSimpleCompareFunction3( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNSingleSlotVars3 *hack; hack = (struct ObjectCmpPNSingleSlotVars3 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(pslot-cmp3 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->firstFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long long) hack->firstOffset); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,hack->secondFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long long) hack->secondOffset); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool PNSimpleCompareFunction3( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNSingleSlotVars3 *hack; int rv; FIELD f1,f2; hack = (struct ObjectCmpPNSingleSlotVars3 *) ValueToBitMap(theValue); GetInsMultiSlotField(&f1,ObjectReteData(theEnv)->CurrentPatternObject,(unsigned) hack->firstSlot, (unsigned) hack->firstFromBeginning,(unsigned) hack->firstOffset); GetInsMultiSlotField(&f2,ObjectReteData(theEnv)->CurrentPatternObject,(unsigned) hack->secondSlot, (unsigned) hack->secondFromBeginning,(unsigned) hack->secondOffset); if (f1.type != f2.type) rv = hack->fail; else if (f1.value != f2.value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } static void PrintJNSimpleCompareFunction1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpJoinSingleSlotVars1 *hack; hack = (struct ObjectCmpJoinSingleSlotVars1 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(jslot-cmp1 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); PrintLongInteger(theEnv,logicalName,(long long) hack->firstPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->secondPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool JNSimpleCompareFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { INSTANCE_TYPE *ins1,*ins2; struct multifieldMarker *theMarks; struct ObjectCmpJoinSingleSlotVars1 *hack; int rv; INSTANCE_SLOT *is1,*is2; hack = (struct ObjectCmpJoinSingleSlotVars1 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern),hack->firstPatternLHS,hack->firstPatternRHS,&ins1,&theMarks); is1 = GetInsSlot(ins1,hack->firstSlot); GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern),hack->secondPatternLHS,hack->secondPatternRHS,&ins2,&theMarks); is2 = GetInsSlot(ins2,hack->secondSlot); if (is1->type != is2->type) rv = hack->fail; else if (is1->value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } static void PrintJNSimpleCompareFunction2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpJoinSingleSlotVars2 *hack; hack = (struct ObjectCmpJoinSingleSlotVars2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(jslot-cmp2 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); PrintLongInteger(theEnv,logicalName,(long long) hack->firstPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long long) hack->offset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->secondPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool JNSimpleCompareFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { INSTANCE_TYPE *ins1,*ins2; struct multifieldMarker *theMarks; struct ObjectCmpJoinSingleSlotVars2 *hack; int rv; FIELD f1; INSTANCE_SLOT *is2; hack = (struct ObjectCmpJoinSingleSlotVars2 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern),hack->firstPatternLHS,hack->firstPatternRHS,&ins1,&theMarks); GetInsMultiSlotField(&f1,ins1,(unsigned) hack->firstSlot, (unsigned) hack->fromBeginning,(unsigned) hack->offset); GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern),hack->secondPatternLHS,hack->secondPatternRHS,&ins2,&theMarks); is2 = GetInsSlot(ins2,hack->secondSlot); if (f1.type != is2->type) rv = hack->fail; else if (f1.value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } static void PrintJNSimpleCompareFunction3( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpJoinSingleSlotVars3 *hack; hack = (struct ObjectCmpJoinSingleSlotVars3 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(jslot-cmp3 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); PrintLongInteger(theEnv,logicalName,(long long) hack->firstPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->firstFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long long) hack->firstOffset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->secondPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,hack->secondFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long long) hack->secondOffset); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool JNSimpleCompareFunction3( void *theEnv, void *theValue, DATA_OBJECT *theResult) { INSTANCE_TYPE *ins1,*ins2; struct multifieldMarker *theMarks; struct ObjectCmpJoinSingleSlotVars3 *hack; int rv; FIELD f1,f2; hack = (struct ObjectCmpJoinSingleSlotVars3 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern),hack->firstPatternLHS,hack->firstPatternRHS,&ins1,&theMarks); GetInsMultiSlotField(&f1,ins1,(unsigned) hack->firstSlot, (unsigned) hack->firstFromBeginning, (unsigned) hack->firstOffset); GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern),hack->secondPatternLHS,hack->secondPatternRHS,&ins2,&theMarks); GetInsMultiSlotField(&f2,ins2,(unsigned) hack->secondSlot, (unsigned) hack->secondFromBeginning, (unsigned) hack->secondOffset); if (f1.type != f2.type) rv = hack->fail; else if (f1.value != f2.value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } /**************************************************** NAME : GetPatternObjectAndMarks DESCRIPTION : Finds the instance and multfiield markers corresponding to a specified pattern in the join network INPUTS : 1) The index of the desired pattern 2) A buffer to hold the instance address 3) A buffer to hold the list of multifield markers RETURNS : Nothing useful SIDE EFFECTS : Buffers set NOTES : None ****************************************************/ static void GetPatternObjectAndMarks( void *theEnv, int pattern, int lhs, int rhs, INSTANCE_TYPE **theInstance, struct multifieldMarker **theMarkers) { if (lhs) { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->markers; } else if (rhs) { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,pattern)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,pattern)->markers; } else if (EngineData(theEnv)->GlobalRHSBinds == NULL) { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->markers; } else if ((((int) EngineData(theEnv)->GlobalJoin->depth) - 1) == pattern) { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->markers; } else { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->markers; } } /*************************************************** NAME : GetObjectValueGeneral DESCRIPTION : Access function for getting pattern variable values within the object pattern and join networks INPUTS : 1) The result data object buffer 2) The instance to access 3) The list of multifield markers for the pattern 4) Data for variable reference RETURNS : Nothing useful SIDE EFFECTS : Data object is filled with the values of the pattern variable NOTES : None ***************************************************/ static void GetObjectValueGeneral( void *theEnv, DATA_OBJECT *result, INSTANCE_TYPE *theInstance, struct multifieldMarker *theMarks, struct ObjectMatchVar1 *matchVar) { long field, extent; /* 6.04 Bug Fix */ INSTANCE_SLOT **insSlot,*basisSlot; if (matchVar->objectAddress) { result->type = INSTANCE_ADDRESS; result->value = (void *) theInstance; return; } if (matchVar->whichSlot == ISA_ID) { result->type = SYMBOL; result->value = (void *) GetDefclassNamePointer((void *) theInstance->cls); return; } if (matchVar->whichSlot == NAME_ID) { result->type = INSTANCE_NAME; result->value = (void *) theInstance->name; return; } insSlot = &theInstance->slotAddresses [theInstance->cls->slotNameMap[matchVar->whichSlot] - 1]; /* ========================================= We need to reference the basis slots if the slot of this object has changed while the RHS was executing However, if the reference is being done by the LHS of a rule (as a consequence of an RHS action), give the pattern matcher the real value of the slot ========================================= */ if ((theInstance->basisSlots != NULL) && (! EngineData(theEnv)->JoinOperationInProgress)) { basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses); if (basisSlot->value != NULL) insSlot = &basisSlot; } /* ================================================== If we know we are accessing the entire slot, the don't bother with searching multifield markers or calculating offsets ================================================== */ if (matchVar->allFields) { result->type = (unsigned short) (*insSlot)->type; result->value = (*insSlot)->value; if (result->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetMFLength((*insSlot)->value)); } return; } /* ============================================= Access a general field in a slot pattern with two or more multifield variables ============================================= */ field = CalculateSlotField(theMarks,*insSlot,matchVar->whichField,&extent); if (extent == -1) { if ((*insSlot)->desc->multiple) { result->type = GetMFType((*insSlot)->value,field); result->value = GetMFValue((*insSlot)->value,field); } else { result->type = (unsigned short) (*insSlot)->type; result->value = (*insSlot)->value; } } else { result->type = MULTIFIELD; result->value = (*insSlot)->value; result->begin = field - 1; result->end = field + extent - 2; } } /*************************************************** NAME : GetObjectValueSimple DESCRIPTION : Access function for getting pattern variable values within the object pattern and join networks INPUTS : 1) The result data object buffer 2) The instance to access 3) Data for variable reference RETURNS : Nothing useful SIDE EFFECTS : Data object is filled with the values of the pattern variable NOTES : None ***************************************************/ static void GetObjectValueSimple( void *theEnv, DATA_OBJECT *result, INSTANCE_TYPE *theInstance, struct ObjectMatchVar2 *matchVar) { INSTANCE_SLOT **insSlot,*basisSlot; SEGMENT *segmentPtr; FIELD *fieldPtr; insSlot = &theInstance->slotAddresses [theInstance->cls->slotNameMap[matchVar->whichSlot] - 1]; /* ========================================= We need to reference the basis slots if the slot of this object has changed while the RHS was executing However, if the reference is being done by the LHS of a rule (as a consequence of an RHS action), give the pattern matcher the real value of the slot ========================================= */ if ((theInstance->basisSlots != NULL) && (! EngineData(theEnv)->JoinOperationInProgress)) { basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses); if (basisSlot->value != NULL) insSlot = &basisSlot; } if ((*insSlot)->desc->multiple) { segmentPtr = (SEGMENT *) (*insSlot)->value; if (matchVar->fromBeginning) { if (matchVar->fromEnd) { result->type = MULTIFIELD; result->value = (void *) segmentPtr; result->begin = matchVar->beginningOffset; SetpDOEnd(result,GetMFLength(segmentPtr) - matchVar->endOffset); } else { fieldPtr = &segmentPtr->theFields[matchVar->beginningOffset]; result->type = fieldPtr->type; result->value = fieldPtr->value; } } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (matchVar->endOffset + 1)]; result->type = fieldPtr->type; result->value = fieldPtr->value; } } else { result->type = (unsigned short) (*insSlot)->type; result->value = (*insSlot)->value; } } /**************************************************** NAME : CalculateSlotField DESCRIPTION : Determines the actual index into the an object slot for a given pattern variable INPUTS : 1) The list of markers to examine 2) The instance slot (can be NULL) 3) The pattern index of the variable 4) A buffer in which to store the extent of the pattern variable (-1 for single-field vars) RETURNS : The actual index SIDE EFFECTS : None NOTES : None ****************************************************/ static long CalculateSlotField( struct multifieldMarker *theMarkers, INSTANCE_SLOT *theSlot, long theIndex, long *extent) { register long actualIndex; void *theSlotName; actualIndex = theIndex; *extent = -1; if (theSlot == NULL) return(actualIndex); theSlotName = (void *) theSlot->desc->slotName->name; while (theMarkers != NULL) { if (theMarkers->where.whichSlot == theSlotName) break; theMarkers = theMarkers->next; } while ((theMarkers != NULL) ? (theMarkers->where.whichSlot == theSlotName) : FALSE) { if (theMarkers->whichField == theIndex) { *extent = theMarkers->endPosition - theMarkers->startPosition + 1; return(actualIndex); } if (theMarkers->whichField > theIndex) return(actualIndex); actualIndex += theMarkers->endPosition - theMarkers->startPosition; theMarkers = theMarkers->next; } return(actualIndex); } /**************************************************** NAME : GetInsMultiSlotField DESCRIPTION : Gets the values of simple single field references in multifield slots for Rete comparisons INPUTS : 1) A multifield field structure to store the type and value in 2) The instance 3) The id of the slot 4) A flag indicating if offset is from beginning or end of multifield slot 5) The offset RETURNS : The multifield field SIDE EFFECTS : None NOTES : Should only be used to access single-field reference in multifield slots for pattern and join network comparisons ****************************************************/ static void GetInsMultiSlotField( FIELD *theField, INSTANCE_TYPE *theInstance, unsigned theSlotID, unsigned fromBeginning, unsigned offset) { register INSTANCE_SLOT * insSlot; register SEGMENT *theSegment; register FIELD *tmpField; insSlot = theInstance->slotAddresses [theInstance->cls->slotNameMap[theSlotID] - 1]; /* Bug fix for 6.05 */ if (insSlot->desc->multiple) { theSegment = (SEGMENT *) insSlot->value; if (fromBeginning) tmpField = &theSegment->theFields[offset]; else tmpField = &theSegment->theFields[theSegment->multifieldLength - offset - 1]; theField->type = tmpField->type; theField->value = tmpField->value; } else { theField->type = (unsigned short) insSlot->type; theField->value = insSlot->value; } } #endif clips_core_source_630/core/watch.c0000755000175000017500000005142212375756702015525 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* WATCH MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Support functions for the watch and unwatch */ /* commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvSetWatchItem function. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _WATCH_SOURCE_ #include "setup.h" #if DEBUGGING_FUNCTIONS #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "argacces.h" #include "extnfunc.h" #include "watch.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct watchItem *ValidWatchItem(void *,const char *,int *); static intBool RecognizeWatchRouters(void *,const char *); static int CaptureWatchPrints(void *,const char *,const char *); static void DeallocateWatchData(void *); /**********************************************/ /* InitializeWatchData: Allocates environment */ /* data for watch items. */ /**********************************************/ globle void InitializeWatchData( void *theEnv) { AllocateEnvironmentData(theEnv,WATCH_DATA,sizeof(struct watchData),DeallocateWatchData); } /************************************************/ /* DeallocateWatchData: Deallocates environment */ /* data for watch items. */ /************************************************/ static void DeallocateWatchData( void *theEnv) { struct watchItem *tmpPtr, *nextPtr; tmpPtr = WatchData(theEnv)->ListOfWatchItems; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,watchItem,tmpPtr); tmpPtr = nextPtr; } } /*************************************************************/ /* AddWatchItem: Adds an item to the list of watchable items */ /* that can be set using the watch and unwatch commands. */ /* Returns FALSE if the item is already in the list, */ /* otherwise returns TRUE. */ /*************************************************************/ globle intBool AddWatchItem( void *theEnv, const char *name, int code, unsigned *flag, int priority, unsigned (*accessFunc)(void *,int,unsigned,struct expr *), unsigned (*printFunc)(void *,const char *,int,struct expr *)) { struct watchItem *newPtr, *currentPtr, *lastPtr; /*================================================================*/ /* Find the insertion point in the watchable items list to place */ /* the new item. If the item is already in the list return FALSE. */ /*================================================================*/ for (currentPtr = WatchData(theEnv)->ListOfWatchItems, lastPtr = NULL; currentPtr != NULL; currentPtr = currentPtr->next) { if (strcmp(currentPtr->name,name) == 0) return(FALSE); if (priority < currentPtr->priority) lastPtr = currentPtr; } /*============================*/ /* Create the new watch item. */ /*============================*/ newPtr = get_struct(theEnv,watchItem); newPtr->name = name; newPtr->flag = flag; newPtr->code = code; newPtr->priority = priority; newPtr->accessFunc = accessFunc; newPtr->printFunc = printFunc; /*=================================================*/ /* Insert the new item in the list of watch items. */ /*=================================================*/ if (lastPtr == NULL) { newPtr->next = WatchData(theEnv)->ListOfWatchItems; WatchData(theEnv)->ListOfWatchItems = newPtr; } else { newPtr->next = lastPtr->next; lastPtr->next = newPtr; } /*==================================================*/ /* Return TRUE to indicate the item has been added. */ /*==================================================*/ return(TRUE); } /*****************************************************/ /* EnvWatch: C access routine for the watch command. */ /*****************************************************/ globle intBool EnvWatch( void *theEnv, const char *itemName) { return(EnvSetWatchItem(theEnv,itemName,ON,NULL)); } /*********************************************************/ /* EnvUnwatch: C access routine for the unwatch command. */ /*********************************************************/ globle intBool EnvUnwatch( void *theEnv, const char *itemName) { return(EnvSetWatchItem(theEnv,itemName,OFF,NULL)); } /***********************************************************************/ /* EnvSetWatchItem: Sets the state of a specified watch item to either */ /* on or off. Returns TRUE if the item was set, otherwise FALSE. */ /***********************************************************************/ globle int EnvSetWatchItem( void *theEnv, const char *itemName, unsigned newState, struct expr *argExprs) { struct watchItem *wPtr; /*======================================================*/ /* If the new state isn't on or off, then return FALSE. */ /*======================================================*/ if ((newState != ON) && (newState != OFF)) return(FALSE); /*===================================================*/ /* If the name of the watch item to set is all, then */ /* all watch items are set to the new state and TRUE */ /* is returned. */ /*===================================================*/ if (strcmp(itemName,"all") == 0) { for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { /*==============================================*/ /* If no specific arguments are specified, then */ /* set the global flag for the watch item. */ /*==============================================*/ if (argExprs == NULL) *(wPtr->flag) = newState; /*=======================================*/ /* Set flags for individual watch items. */ /*=======================================*/ if ((wPtr->accessFunc == NULL) ? FALSE : ((*wPtr->accessFunc)(theEnv,wPtr->code,newState,argExprs) == FALSE)) { SetEvaluationError(theEnv,TRUE); return(FALSE); } } return(TRUE); } /*=================================================*/ /* Search for the watch item to be set in the list */ /* of watch items. If found, set the watch item to */ /* its new state and return TRUE. */ /*=================================================*/ for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { if (strcmp(itemName,wPtr->name) == 0) { /*==============================================*/ /* If no specific arguments are specified, then */ /* set the global flag for the watch item. */ /*==============================================*/ if (argExprs == NULL) *(wPtr->flag) = newState; /*=======================================*/ /* Set flags for individual watch items. */ /*=======================================*/ if ((wPtr->accessFunc == NULL) ? FALSE : ((*wPtr->accessFunc)(theEnv,wPtr->code,newState,argExprs) == FALSE)) { SetEvaluationError(theEnv,TRUE); return(FALSE); } return(TRUE); } } /*=================================================*/ /* If the specified item was not found in the list */ /* of watchable items then return FALSE. */ /*=================================================*/ return(FALSE); } /******************************************************************/ /* EnvGetWatchItem: Gets the current state of the specified watch */ /* item. Returns the state of the watch item (0 for off and 1 */ /* for on) if the watch item is found in the list of watch */ /* items, otherwise -1 is returned. */ /******************************************************************/ globle int EnvGetWatchItem( void *theEnv, const char *itemName) { struct watchItem *wPtr; for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { if (strcmp(itemName,wPtr->name) == 0) { return((int) *(wPtr->flag)); } } return(-1); } /****************************************************************/ /* ValidWatchItem: Returns TRUE if the specified name is found */ /* in the list of watch items, otherwise returns FALSE. */ /****************************************************************/ static struct watchItem *ValidWatchItem( void *theEnv, const char *itemName, int *recognized) { struct watchItem *wPtr; *recognized = TRUE; if (strcmp(itemName,"all") == 0) return(NULL); for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { if (strcmp(itemName,wPtr->name) == 0) return(wPtr); } *recognized = FALSE; return(NULL); } /*************************************************************/ /* GetNthWatchName: Returns the name associated with the nth */ /* item in the list of watchable items. If the nth item */ /* does not exist, then NULL is returned. */ /*************************************************************/ globle const char *GetNthWatchName( void *theEnv, int whichItem) { int i; struct watchItem *wPtr; for (wPtr = WatchData(theEnv)->ListOfWatchItems, i = 1; wPtr != NULL; wPtr = wPtr->next, i++) { if (i == whichItem) return(wPtr->name); } return(NULL); } /***************************************************************/ /* GetNthWatchValue: Returns the current state associated with */ /* the nth item in the list of watchable items. If the nth */ /* item does not exist, then -1 is returned. */ /***************************************************************/ globle int GetNthWatchValue( void *theEnv, int whichItem) { int i; struct watchItem *wPtr; for (wPtr = WatchData(theEnv)->ListOfWatchItems, i = 1; wPtr != NULL; wPtr = wPtr->next, i++) { if (i == whichItem) return((int) *(wPtr->flag)); } return(-1); } /**************************************/ /* WatchCommand: H/L access routine */ /* for the watch command. */ /**************************************/ globle void WatchCommand( void *theEnv) { DATA_OBJECT theValue; const char *argument; int recognized; struct watchItem *wPtr; /*========================================*/ /* Determine which item is to be watched. */ /*========================================*/ if (EnvArgTypeCheck(theEnv,"watch",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); wPtr = ValidWatchItem(theEnv,argument,&recognized); if (recognized == FALSE) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"watch",1,"watchable symbol"); return; } /*=================================================*/ /* Check to make sure extra arguments are allowed. */ /*=================================================*/ if (GetNextArgument(GetFirstArgument()) != NULL) { if ((wPtr == NULL) ? TRUE : (wPtr->accessFunc == NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedCountError(theEnv,"watch",EXACTLY,1); return; } } /*=====================*/ /* Set the watch item. */ /*=====================*/ EnvSetWatchItem(theEnv,argument,ON,GetNextArgument(GetFirstArgument())); } /****************************************/ /* UnwatchCommand: H/L access routine */ /* for the unwatch command. */ /****************************************/ globle void UnwatchCommand( void *theEnv) { DATA_OBJECT theValue; const char *argument; int recognized; struct watchItem *wPtr; /*==========================================*/ /* Determine which item is to be unwatched. */ /*==========================================*/ if (EnvArgTypeCheck(theEnv,"unwatch",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); wPtr = ValidWatchItem(theEnv,argument,&recognized); if (recognized == FALSE) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"unwatch",1,"watchable symbol"); return; } /*=================================================*/ /* Check to make sure extra arguments are allowed. */ /*=================================================*/ if (GetNextArgument(GetFirstArgument()) != NULL) { if ((wPtr == NULL) ? TRUE : (wPtr->accessFunc == NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedCountError(theEnv,"unwatch",EXACTLY,1); return; } } /*=====================*/ /* Set the watch item. */ /*=====================*/ EnvSetWatchItem(theEnv,argument,OFF,GetNextArgument(GetFirstArgument())); } /************************************************/ /* ListWatchItemsCommand: H/L access routines */ /* for the list-watch-items command. */ /************************************************/ globle void ListWatchItemsCommand( void *theEnv) { struct watchItem *wPtr; DATA_OBJECT theValue; int recognized; /*=======================*/ /* List the watch items. */ /*=======================*/ if (GetFirstArgument() == NULL) { for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { EnvPrintRouter(theEnv,WDISPLAY,wPtr->name); if (*(wPtr->flag)) EnvPrintRouter(theEnv,WDISPLAY," = on\n"); else EnvPrintRouter(theEnv,WDISPLAY," = off\n"); } return; } /*=======================================*/ /* Determine which item is to be listed. */ /*=======================================*/ if (EnvArgTypeCheck(theEnv,"list-watch-items",1,SYMBOL,&theValue) == FALSE) return; wPtr = ValidWatchItem(theEnv,DOToString(theValue),&recognized); if ((recognized == FALSE) || (wPtr == NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"list-watch-items",1,"watchable symbol"); return; } /*=================================================*/ /* Check to make sure extra arguments are allowed. */ /*=================================================*/ if ((wPtr->printFunc == NULL) && (GetNextArgument(GetFirstArgument()) != NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedCountError(theEnv,"list-watch-items",EXACTLY,1); return; } /*====================================*/ /* List the status of the watch item. */ /*====================================*/ EnvPrintRouter(theEnv,WDISPLAY,wPtr->name); if (*(wPtr->flag)) EnvPrintRouter(theEnv,WDISPLAY," = on\n"); else EnvPrintRouter(theEnv,WDISPLAY," = off\n"); /*============================================*/ /* List the status of individual watch items. */ /*============================================*/ if (wPtr->printFunc != NULL) { if ((*wPtr->printFunc)(theEnv,WDISPLAY,wPtr->code, GetNextArgument(GetFirstArgument())) == FALSE) { SetEvaluationError(theEnv,TRUE); } } } /*******************************************/ /* GetWatchItemCommand: H/L access routine */ /* for the get-watch-item command. */ /*******************************************/ globle int GetWatchItemCommand( void *theEnv) { DATA_OBJECT theValue; const char *argument; int recognized; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"get-watch-item",EXACTLY,1) == -1) { return(FALSE); } /*========================================*/ /* Determine which item is to be watched. */ /*========================================*/ if (EnvArgTypeCheck(theEnv,"get-watch-item",1,SYMBOL,&theValue) == FALSE) { return(FALSE); } argument = DOToString(theValue); ValidWatchItem(theEnv,argument,&recognized); if (recognized == FALSE) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"get-watch-item",1,"watchable symbol"); return(FALSE); } /*===========================*/ /* Get the watch item value. */ /*===========================*/ if (EnvGetWatchItem(theEnv,argument) == 1) { return(TRUE); } return(FALSE); } /*************************************************************/ /* WatchFunctionDefinitions: Initializes the watch commands. */ /*************************************************************/ globle void WatchFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"watch", 'v', PTIEF WatchCommand, "WatchCommand", "1**w"); EnvDefineFunction2(theEnv,"unwatch", 'v', PTIEF UnwatchCommand, "UnwatchCommand", "1**w"); EnvDefineFunction2(theEnv,"get-watch-item", 'b', PTIEF GetWatchItemCommand, "GetWatchItemCommand", "11w"); EnvDefineFunction2(theEnv,"list-watch-items", 'v', PTIEF ListWatchItemsCommand, "ListWatchItemsCommand", "0**w"); #endif EnvAddRouter(theEnv,WTRACE,1000,RecognizeWatchRouters,CaptureWatchPrints,NULL,NULL,NULL); EnvDeactivateRouter(theEnv,WTRACE); } /**************************************************/ /* RecognizeWatchRouters: Looks for WTRACE prints */ /**************************************************/ static intBool RecognizeWatchRouters( void *theEnv, const char *logName) { #if MAC_XCD #pragma unused(theEnv) #endif if (strcmp(logName,WTRACE) == 0) return(TRUE); return(FALSE); } /**************************************************/ /* CaptureWatchPrints: Suppresses WTRACE messages */ /**************************************************/ static int CaptureWatchPrints( void *theEnv, const char *logName, const char *str) { #if MAC_XCD #pragma unused(logName) #pragma unused(str) #pragma unused(theEnv) #endif return(1); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool Watch( const char *itemName) { return(EnvWatch(GetCurrentEnvironment(),itemName)); } globle intBool Unwatch( const char *itemName) { return(EnvUnwatch(GetCurrentEnvironment(),itemName)); } globle int GetWatchItem( const char *itemName) { return EnvGetWatchItem(GetCurrentEnvironment(),itemName); } globle int SetWatchItem( const char *itemName, unsigned newState, struct expr *argExprs) { return EnvSetWatchItem(GetCurrentEnvironment(),itemName,newState,argExprs); } #endif #endif /* DEBUGGING_FUNCTIONS */ clips_core_source_630/core/._analysis.h0000755000175000017500000000040712373714503016450 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltcmp.c0000755000175000017500000003771212373754232016257 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* deftemplate construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for deftemplate slot facets. */ /* */ /* Added code for deftemplate run time */ /* initialization of hashed comparisons to */ /* constants. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _TMPLTCMP_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #define SlotPrefix() ArbitraryPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem,2) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "factcmp.h" #include "cstrncmp.h" #include "tmpltdef.h" #include "envrnmnt.h" #include "tmpltcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void SlotToCode(void *,FILE *,struct templateSlot *,int,int,int); static void DeftemplateModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void DeftemplateToCode(void *,FILE *,struct deftemplate *, int,int,int,int); static void CloseDeftemplateFiles(void *,FILE *,FILE *,FILE *,int); static void InitDeftemplateCode(void *,FILE *,int,int); /*********************************************************/ /* DeftemplateCompilerSetup: Initializes the deftemplate */ /* construct for use with the constructs-to-c command. */ /*********************************************************/ globle void DeftemplateCompilerSetup( void *theEnv) { DeftemplateData(theEnv)->DeftemplateCodeItem = AddCodeGeneratorItem(theEnv,"deftemplate",0,NULL,InitDeftemplateCode,ConstructToCode,3); } /*************************************************************/ /* ConstructToCode: Produces deftemplate code for a run-time */ /* module created using the constructs-to-c function. */ /*************************************************************/ static int ConstructToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct deftemplate *theTemplate; struct templateSlot *slotPtr; int slotCount = 0, slotArrayCount = 0, slotArrayVersion = 1; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int templateArrayCount = 0, templateArrayVersion = 1; FILE *slotFile = NULL, *moduleFile = NULL, *templateFile = NULL; /*==================================================*/ /* Include the appropriate deftemplate header file. */ /*==================================================*/ fprintf(headerFP,"#include \"tmpltdef.h\"\n"); /*=============================================================*/ /* Loop through all the modules, all the deftemplates, and all */ /* the deftemplate slots writing their C code representation */ /* to the file as they are traversed. */ /*=============================================================*/ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct deftemplateModule",ModulePrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(0); } DeftemplateModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); /*=======================================================*/ /* Loop through each of the deftemplates in this module. */ /*=======================================================*/ theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); while (theTemplate != NULL) { templateFile = OpenFileIfNeeded(theEnv,templateFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, templateArrayVersion,headerFP, "struct deftemplate",ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), FALSE,NULL); if (templateFile == NULL) { CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(0); } DeftemplateToCode(theEnv,templateFile,theTemplate,imageID,maxIndices, moduleCount,slotCount); templateArrayCount++; templateFile = CloseFileIfNeeded(theEnv,templateFile,&templateArrayCount,&templateArrayVersion, maxIndices,NULL,NULL); /*======================================================*/ /* Loop through each of the slots for this deftemplate. */ /*======================================================*/ slotPtr = theTemplate->slotList; while (slotPtr != NULL) { slotFile = OpenFileIfNeeded(theEnv,slotFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, slotArrayVersion,headerFP, "struct templateSlot",SlotPrefix(),FALSE,NULL); if (slotFile == NULL) { CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(0); } SlotToCode(theEnv,slotFile,slotPtr,imageID,maxIndices,slotCount); slotCount++; slotArrayCount++; slotFile = CloseFileIfNeeded(theEnv,slotFile,&slotArrayCount,&slotArrayVersion, maxIndices,NULL,NULL); slotPtr = slotPtr->next; } theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theTemplate); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; moduleArrayCount++; } CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(1); } /************************************************************/ /* CloseDeftemplateFiles: Closes all of the C files created */ /* for deftemplates. Called when an error occurs or when */ /* the deftemplates have all been written to the files. */ /************************************************************/ static void CloseDeftemplateFiles( void *theEnv, FILE *moduleFile, FILE *templateFile, FILE *slotFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (slotFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,slotFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (templateFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,templateFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*************************************************************/ /* DeftemplateModuleToCode: Writes the C code representation */ /* of a single deftemplate module to the specified file. */ /*************************************************************/ static void DeftemplateModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DeftemplateData(theEnv)->DeftemplateModuleIndex,ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem)); fprintf(theFile,"}"); } /************************************************************/ /* DeftemplateToCode: Writes the C code representation of a */ /* single deftemplate construct to the specified file. */ /************************************************************/ static void DeftemplateToCode( void *theEnv, FILE *theFile, struct deftemplate *theTemplate, int imageID, int maxIndices, int moduleCount, int slotCount) { /*====================*/ /* Deftemplate Header */ /*====================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theTemplate->header,imageID,maxIndices, moduleCount,ModulePrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem)); fprintf(theFile,","); /*===========*/ /* Slot List */ /*===========*/ if (theTemplate->slotList == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%d[%d],",SlotPrefix(), imageID, (slotCount / maxIndices) + 1, slotCount % maxIndices); } /*==========================================*/ /* Implied Flag, Watch Flag, In Scope Flag, */ /* Number of Slots, and Busy Count. */ /*==========================================*/ fprintf(theFile,"%d,0,0,%d,%ld,",theTemplate->implied,theTemplate->numberOfSlots,theTemplate->busyCount); /*=================*/ /* Pattern Network */ /*=================*/ if (theTemplate->patternNetwork == NULL) { fprintf(theFile,"NULL"); } else { FactPatternNodeReference(theEnv,theTemplate->patternNetwork,theFile,imageID,maxIndices); } /*============================================*/ /* Print the factList and lastFact references */ /* and close the structure. */ /*============================================*/ fprintf(theFile,",NULL,NULL}"); } /*****************************************************/ /* SlotToCode: Writes the C code representation of a */ /* single deftemplate slot to the specified file. */ /*****************************************************/ static void SlotToCode( void *theEnv, FILE *theFile, struct templateSlot *theSlot, int imageID, int maxIndices, int slotCount) { /*===========*/ /* Slot Name */ /*===========*/ fprintf(theFile,"{"); PrintSymbolReference(theEnv,theFile,theSlot->slotName); /*=============================*/ /* Multislot and Default Flags */ /*=============================*/ fprintf(theFile,",%d,%d,%d,%d,",theSlot->multislot,theSlot->noDefault, theSlot->defaultPresent,theSlot->defaultDynamic); /*=============*/ /* Constraints */ /*=============*/ PrintConstraintReference(theEnv,theFile,theSlot->constraints,imageID,maxIndices); /*===============*/ /* Default Value */ /*===============*/ fprintf(theFile,","); PrintHashedExpressionReference(theEnv,theFile,theSlot->defaultList,imageID,maxIndices); /*============*/ /* Facet List */ /*============*/ fprintf(theFile,","); PrintHashedExpressionReference(theEnv,theFile,theSlot->facetList,imageID,maxIndices); fprintf(theFile,","); /*===========*/ /* Next Slot */ /*===========*/ if (theSlot->next == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"&%s%d_%d[%d]}",SlotPrefix(),imageID, ((slotCount+1) / maxIndices) + 1, (slotCount+1) % maxIndices); } } /*****************************************************************/ /* DeftemplateCModuleReference: Writes the C code representation */ /* of a reference to a deftemplate module data structure. */ /*****************************************************************/ globle void DeftemplateCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]",ModulePrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /********************************************************************/ /* DeftemplateCConstructReference: Writes the C code representation */ /* of a reference to a deftemplate data structure. */ /********************************************************************/ globle void DeftemplateCConstructReference( void *theEnv, FILE *theFile, void *vTheTemplate, int imageID, int maxIndices) { struct deftemplate *theTemplate = (struct deftemplate *) vTheTemplate; if (theTemplate == NULL) { fprintf(theFile,"NULL"); } else { fprintf(theFile,"&%s%d_%ld[%ld]",ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), imageID, (theTemplate->header.bsaveID / maxIndices) + 1, theTemplate->header.bsaveID % maxIndices); } } /*******************************************/ /* InitDeftemplateCode: Writes out runtime */ /* initialization code for deftemplates. */ /*******************************************/ static void InitDeftemplateCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_XCD #pragma unused(theEnv) #pragma unused(imageID) #pragma unused(maxIndices) #endif fprintf(initFP," DeftemplateRunTimeInitialize(theEnv);\n"); } #endif /* DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/._constrct.c0000755000175000017500000000040712461254362016457 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._modulpsr.c0000755000175000017500000000040712374017700016461 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltrhs.h0000755000175000017500000000040712373754175016513 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globldef.c0000755000175000017500000010252312461252236016161 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFGLOBAL MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for the creation and */ /* maintenance of the defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _GLOBLDEF_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "modulpsr.h" #include "multifld.h" #include "router.h" #include "strngrtr.h" #include "modulutl.h" #include "globlbsc.h" #include "globlpsr.h" #include "globlcom.h" #include "utility.h" #include "commline.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "globlbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "globlcmp.h" #endif #include "globldef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void ReturnDefglobal(void *,void *); static void InitializeDefglobalModules(void *); static intBool GetDefglobalValue2(void *,void *,DATA_OBJECT_PTR); static void IncrementDefglobalBusyCount(void *,void *); static void DecrementDefglobalBusyCount(void *,void *); static void DeallocateDefglobalData(void *); static void DestroyDefglobalAction(void *,struct constructHeader *,void *); #if (! BLOAD_ONLY) static void DestroyDefglobal(void *,void *); #endif /**************************************************************/ /* InitializeDefglobals: Initializes the defglobal construct. */ /**************************************************************/ globle void InitializeDefglobals( void *theEnv) { struct entityRecord globalInfo = { "GBL_VARIABLE", GBL_VARIABLE,0,0,0, NULL, NULL, NULL, GetDefglobalValue2, NULL,NULL, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord defglobalPtrRecord = { "DEFGLOBAL_PTR", DEFGLOBAL_PTR,0,0,0, NULL,NULL,NULL, QGetDefglobalValue, NULL, DecrementDefglobalBusyCount, IncrementDefglobalBusyCount, NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFGLOBAL_DATA,sizeof(struct defglobalData),DeallocateDefglobalData); memcpy(&DefglobalData(theEnv)->GlobalInfo,&globalInfo,sizeof(struct entityRecord)); memcpy(&DefglobalData(theEnv)->DefglobalPtrRecord,&defglobalPtrRecord,sizeof(struct entityRecord)); DefglobalData(theEnv)->ResetGlobals = TRUE; DefglobalData(theEnv)->LastModuleIndex = -1; InstallPrimitive(theEnv,&DefglobalData(theEnv)->GlobalInfo,GBL_VARIABLE); InstallPrimitive(theEnv,&DefglobalData(theEnv)->DefglobalPtrRecord,DEFGLOBAL_PTR); InitializeDefglobalModules(theEnv); DefglobalBasicCommands(theEnv); DefglobalCommandDefinitions(theEnv); DefglobalData(theEnv)->DefglobalConstruct = AddConstruct(theEnv,"defglobal","defglobals",ParseDefglobal,EnvFindDefglobal, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefglobal,SetNextConstruct, EnvIsDefglobalDeletable,EnvUndefglobal,ReturnDefglobal); } /****************************************************/ /* DeallocateDefglobalData: Deallocates environment */ /* data for the defglobal construct. */ /****************************************************/ static void DeallocateDefglobalData( void *theEnv) { #if ! RUN_TIME struct defglobalModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defglobalModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefglobalData(theEnv)->DefglobalModuleIndex); rtn_struct(theEnv,defglobalModule,theModuleItem); } #else DoForAllConstructs(theEnv,DestroyDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,FALSE,NULL); #endif } /***************************************************/ /* DestroyDefglobalAction: Action used to remove */ /* defglobals as a result of DestroyEnvironment. */ /***************************************************/ static void DestroyDefglobalAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) struct defglobal *theDefglobal = (struct defglobal *) theConstruct; if (theDefglobal == NULL) return; DestroyDefglobal(theEnv,theDefglobal); #else #if MAC_XCD #pragma unused(theEnv,theConstruct) #endif #endif } /*********************************************************/ /* InitializeDefglobalModules: Initializes the defglobal */ /* construct for use with the defmodule construct. */ /*********************************************************/ static void InitializeDefglobalModules( void *theEnv) { DefglobalData(theEnv)->DefglobalModuleIndex = RegisterModuleItem(theEnv,"defglobal", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefglobalModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefglobalCModuleReference, #else NULL, #endif EnvFindDefglobalInModule); #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"defglobal",SYMBOL); #endif } /*************************************************/ /* AllocateModule: Allocates a defglobal module. */ /*************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,defglobalModule)); } /***********************************************/ /* ReturnModule: Deallocates a defglobal module. */ /***********************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefglobalData(theEnv)->DefglobalConstruct); rtn_struct(theEnv,defglobalModule,theItem); } /**************************************************************/ /* GetDefglobalModuleItem: Returns a pointer to the defmodule */ /* item for the specified defglobal or defmodule. */ /**************************************************************/ globle struct defglobalModule *GetDefglobalModuleItem( void *theEnv, struct defmodule *theModule) { return((struct defglobalModule *) GetConstructModuleItemByIndex(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex)); } /*****************************************************/ /* EnvFindDefglobal: Searches for a defglobal in the */ /* list of defglobals. Returns a pointer to the */ /* defglobal if found, otherwise NULL. */ /*****************************************************/ globle void *EnvFindDefglobal( void *theEnv, const char *defglobalName) { return(FindNamedConstructInModuleOrImports(theEnv,defglobalName,DefglobalData(theEnv)->DefglobalConstruct)); } /*****************************************************/ /* EnvFindDefglobalInModule: Searches for a defglobal in the */ /* list of defglobals. Returns a pointer to the */ /* defglobal if found, otherwise NULL. */ /*****************************************************/ globle void *EnvFindDefglobalInModule( void *theEnv, const char *defglobalName) { return(FindNamedConstructInModule(theEnv,defglobalName,DefglobalData(theEnv)->DefglobalConstruct)); } /********************************************************************/ /* EnvGetNextDefglobal: If passed a NULL pointer, returns the first */ /* defglobal in the defglobal list. Otherwise returns the next */ /* defglobal following the defglobal passed as an argument. */ /********************************************************************/ globle void *EnvGetNextDefglobal( void *theEnv, void *defglobalPtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) defglobalPtr,DefglobalData(theEnv)->DefglobalModuleIndex)); } /*********************************************************/ /* EnvIsDefglobalDeletable: Returns TRUE if a particular */ /* defglobal can be deleted, otherwise returns FALSE. */ /*********************************************************/ globle intBool EnvIsDefglobalDeletable( void *theEnv, void *ptr) { if (! ConstructsDeletable(theEnv)) { return FALSE; } if (((struct defglobal *) ptr)->busyCount) return(FALSE); return(TRUE); } /************************************************************/ /* ReturnDefglobal: Returns the data structures associated */ /* with a defglobal construct to the pool of free memory. */ /************************************************************/ static void ReturnDefglobal( void *theEnv, void *vTheDefglobal) { #if (! BLOAD_ONLY) && (! RUN_TIME) struct defglobal *theDefglobal = (struct defglobal *) vTheDefglobal; if (theDefglobal == NULL) return; /*====================================*/ /* Return the global's current value. */ /*====================================*/ ValueDeinstall(theEnv,&theDefglobal->current); if (theDefglobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theDefglobal->current.value); } /*================================================*/ /* Return the expression representing the initial */ /* value of the defglobal when it was defined. */ /*================================================*/ RemoveHashedExpression(theEnv,theDefglobal->initial); /*===============================*/ /* Release items stored in the */ /* defglobal's construct header. */ /*===============================*/ DeinstallConstructHeader(theEnv,&theDefglobal->header); /*======================================*/ /* Return the defglobal data structure. */ /*======================================*/ rtn_struct(theEnv,defglobal,theDefglobal); /*===========================================*/ /* Set the variable indicating that a change */ /* has been made to a global variable. */ /*===========================================*/ DefglobalData(theEnv)->ChangeToGlobals = TRUE; #endif } /************************************************************/ /* DestroyDefglobal: Returns the data structures associated */ /* with a defglobal construct to the pool of free memory. */ /************************************************************/ #if (! BLOAD_ONLY) static void DestroyDefglobal( void *theEnv, void *vTheDefglobal) { struct defglobal *theDefglobal = (struct defglobal *) vTheDefglobal; if (theDefglobal == NULL) return; /*====================================*/ /* Return the global's current value. */ /*====================================*/ if (theDefglobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theDefglobal->current.value); } #if (! RUN_TIME) /*===============================*/ /* Release items stored in the */ /* defglobal's construct header. */ /*===============================*/ DeinstallConstructHeader(theEnv,&theDefglobal->header); /*======================================*/ /* Return the defglobal data structure. */ /*======================================*/ rtn_struct(theEnv,defglobal,theDefglobal); #endif } #endif /************************************************/ /* QSetDefglobalValue: Lowest level routine for */ /* setting a defglobal's value. */ /************************************************/ globle void QSetDefglobalValue( void *theEnv, struct defglobal *theGlobal, DATA_OBJECT_PTR vPtr, int resetVar) { /*====================================================*/ /* If the new value passed for the defglobal is NULL, */ /* then reset the defglobal to the initial value it */ /* had when it was defined. */ /*====================================================*/ if (resetVar) { EvaluateExpression(theEnv,theGlobal->initial,vPtr); if (EvaluationData(theEnv)->EvaluationError) { vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); } } /*==========================================*/ /* If globals are being watch, then display */ /* the change to the global variable. */ /*==========================================*/ #if DEBUGGING_FUNCTIONS if (theGlobal->watch) { EnvPrintRouter(theEnv,WTRACE,":== ?*"); EnvPrintRouter(theEnv,WTRACE,ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,WTRACE,"* ==> "); PrintDataObject(theEnv,WTRACE,vPtr); EnvPrintRouter(theEnv,WTRACE," <== "); PrintDataObject(theEnv,WTRACE,&theGlobal->current); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==============================================*/ /* Remove the old value of the global variable. */ /*==============================================*/ ValueDeinstall(theEnv,&theGlobal->current); if (theGlobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theGlobal->current.value); } /*===========================================*/ /* Set the new value of the global variable. */ /*===========================================*/ theGlobal->current.type = vPtr->type; if (vPtr->type != MULTIFIELD) theGlobal->current.value = vPtr->value; else DuplicateMultifield(theEnv,&theGlobal->current,vPtr); ValueInstall(theEnv,&theGlobal->current); /*===========================================*/ /* Set the variable indicating that a change */ /* has been made to a global variable. */ /*===========================================*/ DefglobalData(theEnv)->ChangeToGlobals = TRUE; if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } } /**************************************************************/ /* QFindDefglobal: Searches for a defglobal in the list of */ /* defglobals. Returns a pointer to the defglobal if found, */ /* otherwise NULL. */ /**************************************************************/ globle struct defglobal *QFindDefglobal( void *theEnv, SYMBOL_HN *defglobalName) { struct defglobal *theDefglobal; for (theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); theDefglobal != NULL; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { if (defglobalName == theDefglobal->header.name) return (theDefglobal); } return(NULL); } /*********************************************************************/ /* EnvGetDefglobalValueForm: Returns the pretty print representation */ /* of the current value of the specified defglobal. For example, */ /* if the current value of ?*x* is 5, the string "?*x* = 5" would */ /* be returned. */ /*********************************************************************/ globle void EnvGetDefglobalValueForm( void *theEnv, char *buffer, size_t bufferLength, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; OpenStringDestination(theEnv,"GlobalValueForm",buffer,bufferLength); EnvPrintRouter(theEnv,"GlobalValueForm","?*"); EnvPrintRouter(theEnv,"GlobalValueForm",ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,"GlobalValueForm","* = "); PrintDataObject(theEnv,"GlobalValueForm",&theGlobal->current); CloseStringDestination(theEnv,"GlobalValueForm"); } /************************************************************/ /* EnvGetGlobalsChanged: Returns the defglobal change flag. */ /************************************************************/ globle int EnvGetGlobalsChanged( void *theEnv) { return(DefglobalData(theEnv)->ChangeToGlobals); } /*********************************************************/ /* EnvSetGlobalsChanged: Sets the defglobal change flag. */ /*********************************************************/ globle void EnvSetGlobalsChanged( void *theEnv, int value) { DefglobalData(theEnv)->ChangeToGlobals = value; } /**********************************************************/ /* GetDefglobalValue2: Returns the value of the specified */ /* global variable in the supplied DATA_OBJECT. */ /**********************************************************/ static intBool GetDefglobalValue2( void *theEnv, void *theValue, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal; int count; /*===========================================*/ /* Search for the specified defglobal in the */ /* modules visible to the current module. */ /*===========================================*/ theGlobal = (struct defglobal *) FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(theValue), &count,TRUE,NULL); /*=============================================*/ /* If it wasn't found, print an error message. */ /*=============================================*/ if (theGlobal == NULL) { PrintErrorID(theEnv,"GLOBLDEF",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Global variable ?*"); EnvPrintRouter(theEnv,WERROR,ValueToString(theValue)); EnvPrintRouter(theEnv,WERROR,"* is unbound.\n"); vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*========================================================*/ /* The current implementation of the defmodules shouldn't */ /* allow a construct to be defined which would cause an */ /* ambiguous reference, but we'll check for it anyway. */ /*========================================================*/ if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"defglobal",ValueToString(theValue)); vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*=================================*/ /* Get the value of the defglobal. */ /*=================================*/ QGetDefglobalValue(theEnv,theGlobal,vPtr); return(TRUE); } /***************************************************************/ /* QGetDefglobalValue: Returns the value of a global variable. */ /***************************************************************/ globle int QGetDefglobalValue( void *theEnv, void *vTheGlobal, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; /*===============================================*/ /* Transfer values which can be copied directly. */ /*===============================================*/ vPtr->type = theGlobal->current.type; vPtr->value = theGlobal->current.value; vPtr->begin = theGlobal->current.begin; vPtr->end = theGlobal->current.end; /*===========================================================*/ /* If the global contains a multifield value, return a copy */ /* of the value so that routines which use this value are */ /* not affected if the value of the global is later changed. */ /*===========================================================*/ if (vPtr->type == MULTIFIELD) { vPtr->value = EnvCreateMultifield(theEnv,(unsigned long) (vPtr->end + 1)); GenCopyMemory(struct field,vPtr->end + 1, &((struct multifield *) vPtr->value)->theFields[0], &((struct multifield *) theGlobal->current.value)->theFields[theGlobal->current.begin]); } return(TRUE); } /************************************************************/ /* EnvGetDefglobalValue: Returns the value of the specified */ /* global variable in the supplied DATA_OBJECT. */ /************************************************************/ globle intBool EnvGetDefglobalValue( void *theEnv, const char *variableName, DATA_OBJECT_PTR vPtr) { struct defglobal *theDefglobal; if ((theDefglobal = (struct defglobal *) EnvFindDefglobal(theEnv,variableName)) == NULL) { return(FALSE); } QGetDefglobalValue(theEnv,theDefglobal,vPtr); return(TRUE); } /****************************************************************/ /* EnvSetDefglobalValue: Sets the value of the specified global */ /* variable to the value stored in the supplied DATA_OBJECT. */ /****************************************************************/ globle intBool EnvSetDefglobalValue( void *theEnv, const char *variableName, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal; if ((theGlobal = QFindDefglobal(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,variableName))) == NULL) { return(FALSE); } QSetDefglobalValue(theEnv,theGlobal,vPtr,FALSE); return(TRUE); } /**********************************************************/ /* DecrementDefglobalBusyCount: Decrements the busy count */ /* of a defglobal data structure. */ /**********************************************************/ static void DecrementDefglobalBusyCount( void *theEnv, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; if (! ConstructData(theEnv)->ClearInProgress) theGlobal->busyCount--; } /**********************************************************/ /* IncrementDefglobalBusyCount: Increments the busy count */ /* of a defglobal data structure. */ /**********************************************************/ static void IncrementDefglobalBusyCount( void *theEnv, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; #if MAC_XCD #pragma unused(theEnv) #endif theGlobal->busyCount++; } /***********************************************************************/ /* UpdateDefglobalScope: Updates the scope flag of all the defglobals. */ /***********************************************************************/ globle void UpdateDefglobalScope( void *theEnv) { struct defglobal *theDefglobal; int moduleCount; struct defmodule *theModule; struct defmoduleItemHeader *theItem; /*============================*/ /* Loop through every module. */ /*============================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*============================================================*/ /* Loop through every defglobal in the module being examined. */ /*============================================================*/ theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex); for (theDefglobal = (struct defglobal *) theItem->firstItem; theDefglobal != NULL ; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { /*====================================================*/ /* If the defglobal is visible to the current module, */ /* then mark it as being in scope, otherwise mark it */ /* as being out of scope. */ /*====================================================*/ if (FindImportedConstruct(theEnv,"defglobal",theModule, ValueToString(theDefglobal->header.name), &moduleCount,TRUE,NULL) != NULL) { theDefglobal->inScope = TRUE; } else { theDefglobal->inScope = FALSE; } } } } /*******************************************************/ /* GetNextDefglobalInScope: Returns the next defglobal */ /* that is scope of the current module. Works in a */ /* similar fashion to GetNextDefglobal, but skips */ /* defglobals that are out of scope. */ /*******************************************************/ globle void *GetNextDefglobalInScope( void *theEnv, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; struct defmoduleItemHeader *theItem; /*=======================================*/ /* If we're beginning the search for the */ /* first defglobal in scope, then ... */ /*=======================================*/ if (theGlobal == NULL) { /*==============================================*/ /* If the current module has been changed since */ /* the last time the scopes were computed, then */ /* recompute the scopes. */ /*==============================================*/ if (DefglobalData(theEnv)->LastModuleIndex != DefmoduleData(theEnv)->ModuleChangeIndex) { UpdateDefglobalScope(theEnv); DefglobalData(theEnv)->LastModuleIndex = DefmoduleData(theEnv)->ModuleChangeIndex; } /*==========================================*/ /* Get the first module and first defglobal */ /* to start the search with. */ /*==========================================*/ DefglobalData(theEnv)->TheDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,DefglobalData(theEnv)->TheDefmodule,DefglobalData(theEnv)->DefglobalModuleIndex); theGlobal = (struct defglobal *) theItem->firstItem; } /*==================================================*/ /* Otherwise, see if the last defglobal returned by */ /* this function has a defglobal following it. */ /*==================================================*/ else { theGlobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theGlobal); } /*======================================*/ /* Continue looping through the modules */ /* until a defglobal in scope is found. */ /*======================================*/ while (DefglobalData(theEnv)->TheDefmodule != NULL) { /*=====================================================*/ /* Loop through the defglobals in the module currently */ /* being examined to see if one is in scope. */ /*=====================================================*/ for (; theGlobal != NULL; theGlobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theGlobal)) { if (theGlobal->inScope) return((void *) theGlobal); } /*================================================*/ /* If a global in scope couldn't be found in this */ /* module, then move on to the next module. */ /*================================================*/ DefglobalData(theEnv)->TheDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,DefglobalData(theEnv)->TheDefmodule); theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,DefglobalData(theEnv)->TheDefmodule,DefglobalData(theEnv)->DefglobalModuleIndex); theGlobal = (struct defglobal *) theItem->firstItem; } /*====================================*/ /* All the globals in scope have been */ /* traversed and there are none left. */ /*====================================*/ return(NULL); } /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvDefglobalModule( void *theEnv, void *theDefglobal) { return GetConstructModuleName((struct constructHeader *) theDefglobal); } globle const char *EnvGetDefglobalName( void *theEnv, void *theDefglobal) { return GetConstructNameString((struct constructHeader *) theDefglobal); } globle const char *EnvGetDefglobalPPForm( void *theEnv, void *theDefglobal) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDefglobal); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle const char *DefglobalModule( void *theDefglobal) { return EnvDefglobalModule(GetCurrentEnvironment(),theDefglobal); } globle void *FindDefglobal( const char *defglobalName) { return EnvFindDefglobal(GetCurrentEnvironment(),defglobalName); } globle const char *GetDefglobalName( void *theDefglobal) { return EnvGetDefglobalName(GetCurrentEnvironment(),theDefglobal); } globle const char *GetDefglobalPPForm( void *theDefglobal) { return EnvGetDefglobalPPForm(GetCurrentEnvironment(),theDefglobal); } globle intBool GetDefglobalValue( const char *variableName, DATA_OBJECT_PTR vPtr) { return EnvGetDefglobalValue(GetCurrentEnvironment(),variableName,vPtr); } globle void GetDefglobalValueForm( char *buffer, unsigned bufferLength, void *vTheGlobal) { EnvGetDefglobalValueForm(GetCurrentEnvironment(),buffer,bufferLength,vTheGlobal); } globle int GetGlobalsChanged() { return EnvGetGlobalsChanged(GetCurrentEnvironment()); } globle void *GetNextDefglobal( void *defglobalPtr) { return EnvGetNextDefglobal(GetCurrentEnvironment(),defglobalPtr); } globle intBool IsDefglobalDeletable( void *ptr) { return EnvIsDefglobalDeletable(GetCurrentEnvironment(),ptr); } globle intBool SetDefglobalValue( const char *variableName, DATA_OBJECT_PTR vPtr) { return EnvSetDefglobalValue(GetCurrentEnvironment(),variableName,vPtr); } globle void SetGlobalsChanged( int value) { EnvSetGlobalsChanged(GetCurrentEnvironment(),value); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFGLOBAL_CONSTRUCT */ clips_core_source_630/core/._ruledef.c0000755000175000017500000000040712461251526016245 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._network.h0000755000175000017500000000040712374017636016322 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._expressn.h0000755000175000017500000000040712373740005016470 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/miscfun.h0000755000175000017500000001334212373755050016060 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* MISCELLANEOUS FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* LOGICAL_DEPENDENCIES, IMPERATIVE_METHODS */ /* INSTANCE_PATTERN_MATCHING, */ /* IMPERATIVE_MESSAGE_HANDLERS, and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems. */ /* */ /* Renamed EX_MATH compiler flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Combined BASIC_IO and EXT_IO compilation */ /* flags into the IO_FUNCTIONS compilation flag. */ /* */ /* Removed code associated with HELP_FUNCTIONS */ /* and EMACS_EDITOR compiler flags. */ /* */ /* Added operating-system function. */ /* */ /* Added new function (for future use). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_miscfun #define _H_miscfun #ifdef LOCALE #undef LOCALE #endif #ifdef _MISCFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void MiscFunctionDefinitions(void *); LOCALE void CreateFunction(void *,DATA_OBJECT_PTR); LOCALE long long SetgenFunction(void *); LOCALE void *GensymFunction(void *); LOCALE void *GensymStarFunction(void *); LOCALE long long RandomFunction(void *); LOCALE void SeedFunction(void *); LOCALE long long LengthFunction(void *); LOCALE void ConserveMemCommand(void *); LOCALE long long ReleaseMemCommand(void *); LOCALE long long MemUsedCommand(void *); LOCALE long long MemRequestsCommand(void *); LOCALE void OptionsCommand(void *); LOCALE void *OperatingSystemFunction(void *); LOCALE void ExpandFuncCall(void *,DATA_OBJECT *); LOCALE void DummyExpandFuncMultifield(void *,DATA_OBJECT *); LOCALE void *CauseEvaluationError(void *); LOCALE intBool SetSORCommand(void *); LOCALE void *GetFunctionRestrictions(void *); LOCALE void AproposCommand(void *); LOCALE void *GensymStar(void *); LOCALE void GetFunctionListFunction(void *,DATA_OBJECT *); LOCALE void FuncallFunction(void *,DATA_OBJECT *); LOCALE void NewFunction(void *,DATA_OBJECT *); LOCALE void CallFunction(void *,DATA_OBJECT *); LOCALE double TimerFunction(void *); LOCALE double TimeFunction(void *); #endif /* _H_miscfun */ clips_core_source_630/core/._objbin.c0000755000175000017500000000040712374023220016051 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._reorder.h0000755000175000017500000000040712374023501016257 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factlhs.h0000755000175000017500000000040712373742652016257 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._ruledlt.c0000755000175000017500000000040712424473376016302 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/userdata.h0000755000175000017500000000464712373740572016237 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* USER DATA HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for attaching user data to constructs, */ /* facts, instances, user functions, etc. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_userdata #define _H_userdata #ifdef LOCALE #undef LOCALE #endif #ifdef _USERDATA_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct userData { unsigned char dataID; struct userData *next; }; typedef struct userData USER_DATA; typedef struct userData * USER_DATA_PTR; struct userDataRecord { unsigned char dataID; void *(*createUserData)(void *); void (*deleteUserData)(void *,void *); }; typedef struct userDataRecord USER_DATA_RECORD; typedef struct userDataRecord * USER_DATA_RECORD_PTR; #define MAXIMUM_USER_DATA_RECORDS 100 #define USER_DATA_DATA 56 struct userDataData { struct userDataRecord *UserDataRecordArray[MAXIMUM_USER_DATA_RECORDS]; unsigned char UserDataRecordCount; }; #define UserDataData(theEnv) ((struct userDataData *) GetEnvironmentData(theEnv,USER_DATA_DATA)) LOCALE void InitializeUserDataData(void *); LOCALE unsigned char InstallUserDataRecord(void *,struct userDataRecord *); LOCALE struct userData *FetchUserData(void *,unsigned char,struct userData **); LOCALE struct userData *TestUserData(unsigned char,struct userData *); LOCALE void ClearUserDataList(void *,struct userData *); LOCALE struct userData *DeleteUserData(void *,unsigned char,struct userData *); #endif clips_core_source_630/core/setup.h0000755000175000017500000004160112502204704015540 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* SETUP HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: This file is the general header file included by */ /* all of the .c source files. It contains global */ /* definitions and the compiler flags which must be edited */ /* to create a version for a specific machine, operating */ /* system, or feature set. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Default locale modification. */ /* */ /* Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* LOGICAL_DEPENDENCIES, IMPERATIVE_METHODS, */ /* INSTANCE_PATTERN_MATCHING, and */ /* IMPERATIVE_MESSAGE_HANDLERS, and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Removed the SHORT_LINK_NAMES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, IBM_ICB, IBM_TBC, IBM_ZTC, and */ /* IBM_SC). */ /* */ /* Renamed IBM_MSC and WIN_MVC compiler flags */ /* and IBM_GCC to WIN_GCC. */ /* */ /* Added LINUX and DARWIN compiler flags. */ /* */ /* Removed HELP_FUNCTIONS compilation flag and */ /* associated functionality. */ /* */ /* Removed EMACS_EDITOR compilation flag and */ /* associated functionality. */ /* */ /* Combined BASIC_IO and EXT_IO compilation */ /* flags into the single IO_FUNCTIONS flag. */ /* */ /* Used #ifndef for preprocessor definitions so */ /* they can be set at the project or makefile */ /* level. */ /* */ /* Removed ENVIRONMENT_API_ONLY compilation flag. */ /* */ /* Combined BASIC_IO and EXT_IO compilation */ /* flags into the IO_FUNCTIONS compilation flag. */ /* */ /* Changed the EX_MATH compilation flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Removed VOID definition because of conflict */ /* with Windows.h header file. */ /* */ /* Removed deprecated definitions. */ /* */ /* The ALLOW_ENVIRONMENT_GLOBALS flag now */ /* defaults to 0. The use of functions enabled */ /* by this flag is deprecated. */ /* */ /* Removed support for BLOCK_MEMORY. */ /* */ /*************************************************************/ #ifndef _H_setup #define _H_setup /****************************************************************/ /* -------------------- COMPILER FLAGS ------------------------ */ /****************************************************************/ /*********************************************************************/ /* Flag denoting the environment in which the executable is to run. */ /* Only one of these flags should be turned on (set to 1) at a time. */ /*********************************************************************/ #ifndef UNIX_V #define UNIX_V 0 /* UNIX System V, 4.2bsd, or HP Unix, presumably with gcc */ #endif #ifndef UNIX_7 #define UNIX_7 0 /* UNIX System III Version 7 or Sun Unix, presumably with gcc */ #endif #ifndef LINUX #define LINUX 0 /* Untested, presumably with gcc */ #endif #ifndef DARWIN #define DARWIN 0 /* Darwin Mac OS 10.10.2, presumably with gcc or Xcode 6.2 with Console */ #endif #ifndef MAC_XCD #define MAC_XCD 0 /* MacOS 10.10.2, with Xcode 6.2 and Cocoa GUI */ #endif #ifndef WIN_MVC #define WIN_MVC 0 /* Windows 7, with Visual Studio 2013 */ #endif /* The following are unsupported: */ #ifndef WIN_GCC #define WIN_GCC 0 /* Windows XP, with DJGPP 3.21 */ #endif #ifndef VAX_VMS #define VAX_VMS 0 /* VAX VMS */ #endif /* Use GENERIC if nothing else is used. */ #ifndef GENERIC #if (! UNIX_V) && (! LINUX) && (! UNIX_7) && \ (! MAC_XCD) && (! DARWIN) && \ (! WIN_MVC) && (! WIN_GCC) && \ (! VAX_VMS) #define GENERIC 1 /* Generic (any machine) */ #else #define GENERIC 0 /* Generic (any machine) */ #endif #endif #if WIN_MVC #define IBM 1 #else #define IBM 0 #endif /***********************************************/ /* Some definitions for use with declarations. */ /***********************************************/ #define VOID_ARG void #define STD_SIZE size_t #define intBool int #define globle /*******************************************/ /* RUN_TIME: Specifies whether a run-time */ /* module is being created. */ /*******************************************/ #ifndef RUN_TIME #define RUN_TIME 0 #endif /*************************************************/ /* DEFRULE_CONSTRUCT: Determines whether defrule */ /* construct is included. */ /*************************************************/ #ifndef DEFRULE_CONSTRUCT #define DEFRULE_CONSTRUCT 1 #endif /************************************************/ /* DEFMODULE_CONSTRUCT: Determines whether the */ /* defmodule construct is included. */ /************************************************/ #ifndef DEFMODULE_CONSTRUCT #define DEFMODULE_CONSTRUCT 1 #endif /****************************************************/ /* DEFTEMPLATE_CONSTRUCT: Determines whether facts */ /* and the deftemplate construct are included. */ /****************************************************/ #ifndef DEFTEMPLATE_CONSTRUCT #define DEFTEMPLATE_CONSTRUCT 1 #endif #if ! DEFRULE_CONSTRUCT #undef DEFTEMPLATE_CONSTRUCT #define DEFTEMPLATE_CONSTRUCT 0 #endif /************************************************************/ /* FACT_SET_QUERIES: Determines if fact-set query functions */ /* such as any-factp and do-for-all-facts are included. */ /************************************************************/ #ifndef FACT_SET_QUERIES #define FACT_SET_QUERIES 1 #endif #if ! DEFTEMPLATE_CONSTRUCT #undef FACT_SET_QUERIES #define FACT_SET_QUERIES 0 #endif /****************************************************/ /* DEFFACTS_CONSTRUCT: Determines whether deffacts */ /* construct is included. */ /****************************************************/ #ifndef DEFFACTS_CONSTRUCT #define DEFFACTS_CONSTRUCT 1 #endif #if ! DEFTEMPLATE_CONSTRUCT #undef DEFFACTS_CONSTRUCT #define DEFFACTS_CONSTRUCT 0 #endif /************************************************/ /* DEFGLOBAL_CONSTRUCT: Determines whether the */ /* defglobal construct is included. */ /************************************************/ #ifndef DEFGLOBAL_CONSTRUCT #define DEFGLOBAL_CONSTRUCT 1 #endif /**********************************************/ /* DEFFUNCTION_CONSTRUCT: Determines whether */ /* deffunction construct is included. */ /**********************************************/ #ifndef DEFFUNCTION_CONSTRUCT #define DEFFUNCTION_CONSTRUCT 1 #endif /*********************************************/ /* DEFGENERIC_CONSTRUCT: Determines whether */ /* generic functions are included. */ /*********************************************/ #ifndef DEFGENERIC_CONSTRUCT #define DEFGENERIC_CONSTRUCT 1 #endif /*****************************************************************/ /* OBJECT_SYSTEM: Determines whether object system is included. */ /* The MULTIFIELD_FUNCTIONS flag should also be on if you want */ /* to be able to manipulate multi-field slots. */ /*****************************************************************/ #ifndef OBJECT_SYSTEM #define OBJECT_SYSTEM 1 #endif /*****************************************************************/ /* DEFINSTANCES_CONSTRUCT: Determines whether the definstances */ /* construct is enabled. */ /*****************************************************************/ #ifndef DEFINSTANCES_CONSTRUCT #define DEFINSTANCES_CONSTRUCT 1 #endif #if ! OBJECT_SYSTEM #undef DEFINSTANCES_CONSTRUCT #define DEFINSTANCES_CONSTRUCT 0 #endif /********************************************************************/ /* INSTANCE_SET_QUERIES: Determines if instance-set query functions */ /* such as any-instancep and do-for-all-instances are included. */ /********************************************************************/ #ifndef INSTANCE_SET_QUERIES #define INSTANCE_SET_QUERIES 1 #endif #if ! OBJECT_SYSTEM #undef INSTANCE_SET_QUERIES #define INSTANCE_SET_QUERIES 0 #endif /******************************************************************/ /* Check for consistencies associated with the defrule construct. */ /******************************************************************/ #if (! DEFTEMPLATE_CONSTRUCT) && (! OBJECT_SYSTEM) #undef DEFRULE_CONSTRUCT #define DEFRULE_CONSTRUCT 0 #endif /*******************************************************************/ /* BLOAD/BSAVE_INSTANCES: Determines if the save/restore-instances */ /* functions can be enhanced to perform more quickly by using */ /* binary files */ /*******************************************************************/ #ifndef BLOAD_INSTANCES #define BLOAD_INSTANCES 1 #endif #ifndef BSAVE_INSTANCES #define BSAVE_INSTANCES 1 #endif #if ! OBJECT_SYSTEM #undef BLOAD_INSTANCES #undef BSAVE_INSTANCES #define BLOAD_INSTANCES 0 #define BSAVE_INSTANCES 0 #endif /****************************************************************/ /* EXTENDED MATH PACKAGE FLAG: If this is on, then the extended */ /* math package functions will be available for use, (normal */ /* default). If this flag is off, then the extended math */ /* functions will not be available, and the 30K or so of space */ /* they require will be free. Usually a concern only on PC type */ /* machines. */ /****************************************************************/ #ifndef EXTENDED_MATH_FUNCTIONS #define EXTENDED_MATH_FUNCTIONS 1 #endif /****************************************************************/ /* TEXT PROCESSING : Turn on this flag for support of the */ /* hierarchical lookup system. */ /****************************************************************/ #ifndef TEXTPRO_FUNCTIONS #define TEXTPRO_FUNCTIONS 1 #endif /*************************************************************************/ /* BLOAD_ONLY: Enables bload command and disables the load command. */ /* BLOAD: Enables bload command. */ /* BLOAD_AND_BSAVE: Enables bload, and bsave commands. */ /*************************************************************************/ #ifndef BLOAD_ONLY #define BLOAD_ONLY 0 #endif #ifndef BLOAD #define BLOAD 0 #endif #ifndef BLOAD_AND_BSAVE #define BLOAD_AND_BSAVE 1 #endif #if RUN_TIME #undef BLOAD_ONLY #define BLOAD_ONLY 0 #undef BLOAD #define BLOAD 0 #undef BLOAD_AND_BSAVE #define BLOAD_AND_BSAVE 0 #endif /********************************************************************/ /* CONSTRUCT COMPILER: If this flag is turned on, you can generate */ /* C code representing the constructs in the current environment. */ /* With the RUN_TIME flag set, this code can be compiled and */ /* linked to create a stand-alone run-time executable. */ /********************************************************************/ #ifndef CONSTRUCT_COMPILER #define CONSTRUCT_COMPILER 1 #endif #if CONSTRUCT_COMPILER #define API_HEADER "clips.h" #endif /************************************************/ /* IO_FUNCTIONS: Includes printout, read, open, */ /* close, format, and readline functions. */ /************************************************/ #ifndef IO_FUNCTIONS #define IO_FUNCTIONS 1 #endif /************************************************/ /* STRING_FUNCTIONS: Includes string functions: */ /* str-length, str-compare, upcase, lowcase, */ /* sub-string, str-index, and eval. */ /************************************************/ #ifndef STRING_FUNCTIONS #define STRING_FUNCTIONS 1 #endif /*********************************************/ /* MULTIFIELD_FUNCTIONS: Includes multifield */ /* functions: mv-subseq, mv-delete, */ /* mv-append, str-explode, str-implode. */ /*********************************************/ #ifndef MULTIFIELD_FUNCTIONS #define MULTIFIELD_FUNCTIONS 1 #endif /****************************************************/ /* DEBUGGING_FUNCTIONS: Includes functions such as */ /* rules, facts, matches, ppdefrule, etc. */ /****************************************************/ #ifndef DEBUGGING_FUNCTIONS #define DEBUGGING_FUNCTIONS 1 #endif /***************************************************/ /* PROFILING_FUNCTIONS: Enables code for profiling */ /* constructs and user functions. */ /***************************************************/ #ifndef PROFILING_FUNCTIONS #define PROFILING_FUNCTIONS 1 #endif /*******************************************************************/ /* WINDOW_INTERFACE : Set this flag if you are recompiling any of */ /* the machine specific GUI interfaces. Currently, when enabled, */ /* this flag disables the more processing used by the help */ /* system. This flag also prevents any input or output being */ /* directly sent to stdin or stdout. */ /*******************************************************************/ #ifndef WINDOW_INTERFACE #define WINDOW_INTERFACE 0 #endif /*************************************************************/ /* ALLOW_ENVIRONMENT_GLOBALS: If enabled, tracks the current */ /* environment and allows environments to be referred to */ /* by index. If disabled, CLIPS makes no use of global */ /* variables. */ /*************************************************************/ #ifndef ALLOW_ENVIRONMENT_GLOBALS #define ALLOW_ENVIRONMENT_GLOBALS 0 #endif /********************************************/ /* DEVELOPER: Enables code for debugging a */ /* development version of the executable. */ /********************************************/ #ifndef DEVELOPER #define DEVELOPER 0 #endif #if DEVELOPER #include #define Bogus(x) assert(! (x)) #else #define Bogus(x) #endif /***************************/ /* Environment Definitions */ /***************************/ #include "envrnmnt.h" /*************************************************/ /* Any user defined global setup information can */ /* be included in the file usrsetup.h which is */ /* an empty file in the baseline version. */ /*************************************************/ #include "usrsetup.h" #endif /* _H_setup */ clips_core_source_630/core/memalloc.c0000755000175000017500000003703412512771563016206 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* MEMORY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Memory allocation routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed HaltExecution check from the */ /* EnvReleaseMem function. DR0863 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed genlongalloc/genlongfree functions. */ /* */ /* Added get_mem and rtn_mem macros. */ /* */ /* Converted API macros to function calls. */ /* */ /* Removed deallocating message parameter from */ /* EnvReleaseMem. */ /* */ /* Removed support for BLOCK_MEMORY. */ /* */ /*************************************************************/ #define _MEMORY_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "utility.h" #include #if WIN_MVC #include #endif #define STRICT_ALIGN_SIZE sizeof(double) #define SpecialMalloc(sz) malloc((STD_SIZE) sz) #define SpecialFree(ptr) free(ptr) /********************************************/ /* InitializeMemory: Sets up memory tables. */ /********************************************/ globle void InitializeMemory( void *theEnv) { AllocateEnvironmentData(theEnv,MEMORY_DATA,sizeof(struct memoryData),NULL); MemoryData(theEnv)->OutOfMemoryFunction = DefaultOutOfMemoryFunction; #if (MEM_TABLE_SIZE > 0) MemoryData(theEnv)->MemoryTable = (struct memoryPtr **) malloc((STD_SIZE) (sizeof(struct memoryPtr *) * MEM_TABLE_SIZE)); if (MemoryData(theEnv)->MemoryTable == NULL) { PrintErrorID(theEnv,"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); } else { int i; for (i = 0; i < MEM_TABLE_SIZE; i++) MemoryData(theEnv)->MemoryTable[i] = NULL; } #else // MEM_TABLE_SIZE == 0 MemoryData(theEnv)->MemoryTable = NULL; #endif } /***************************************************/ /* genalloc: A generic memory allocation function. */ /***************************************************/ globle void *genalloc( void *theEnv, size_t size) { char *memPtr; memPtr = (char *) malloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,(long) ((size * 5 > 4096) ? size * 5 : 4096)); memPtr = (char *) malloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,-1L); memPtr = (char *) malloc(size); while (memPtr == NULL) { if ((*MemoryData(theEnv)->OutOfMemoryFunction)(theEnv,size)) return(NULL); memPtr = (char *) malloc(size); } } } MemoryData(theEnv)->MemoryAmount += (long) size; MemoryData(theEnv)->MemoryCalls++; return((void *) memPtr); } /***********************************************/ /* DefaultOutOfMemoryFunction: Function called */ /* when the KB runs out of memory. */ /***********************************************/ globle int DefaultOutOfMemoryFunction( void *theEnv, size_t size) { #if MAC_XCD #pragma unused(size) #endif PrintErrorID(theEnv,"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); return(TRUE); } /***********************************************************/ /* EnvSetOutOfMemoryFunction: Allows the function which is */ /* called when the KB runs out of memory to be changed. */ /***********************************************************/ globle int (*EnvSetOutOfMemoryFunction(void *theEnv,int (*functionPtr)(void *,size_t)))(void *,size_t) { int (*tmpPtr)(void *,size_t); tmpPtr = MemoryData(theEnv)->OutOfMemoryFunction; MemoryData(theEnv)->OutOfMemoryFunction = functionPtr; return(tmpPtr); } /****************************************************/ /* genfree: A generic memory deallocation function. */ /****************************************************/ globle int genfree( void *theEnv, void *waste, size_t size) { free(waste); MemoryData(theEnv)->MemoryAmount -= (long) size; MemoryData(theEnv)->MemoryCalls--; return(0); } /******************************************************/ /* genrealloc: Simple (i.e. dumb) version of realloc. */ /******************************************************/ globle void *genrealloc( void *theEnv, void *oldaddr, size_t oldsz, size_t newsz) { char *newaddr; unsigned i; size_t limit; newaddr = ((newsz != 0) ? (char *) gm2(theEnv,newsz) : NULL); if (oldaddr != NULL) { limit = (oldsz < newsz) ? oldsz : newsz; for (i = 0 ; i < limit ; i++) { newaddr[i] = ((char *) oldaddr)[i]; } for ( ; i < newsz; i++) { newaddr[i] = '\0'; } rm(theEnv,(void *) oldaddr,oldsz); } return((void *) newaddr); } /********************************/ /* EnvMemUsed: C access routine */ /* for the mem-used command. */ /********************************/ globle long int EnvMemUsed( void *theEnv) { return(MemoryData(theEnv)->MemoryAmount); } /************************************/ /* EnvMemRequests: C access routine */ /* for the mem-requests command. */ /************************************/ globle long int EnvMemRequests( void *theEnv) { return(MemoryData(theEnv)->MemoryCalls); } /***************************************/ /* UpdateMemoryUsed: Allows the amount */ /* of memory used to be updated. */ /***************************************/ globle long int UpdateMemoryUsed( void *theEnv, long int value) { MemoryData(theEnv)->MemoryAmount += value; return(MemoryData(theEnv)->MemoryAmount); } /*******************************************/ /* UpdateMemoryRequests: Allows the number */ /* of memory requests to be updated. */ /*******************************************/ globle long int UpdateMemoryRequests( void *theEnv, long int value) { MemoryData(theEnv)->MemoryCalls += value; return(MemoryData(theEnv)->MemoryCalls); } /***********************************/ /* EnvReleaseMem: C access routine */ /* for the release-mem command. */ /***********************************/ globle long int EnvReleaseMem( void *theEnv, long int maximum) { struct memoryPtr *tmpPtr, *memPtr; int i; long int returns = 0; long int amount = 0; for (i = (MEM_TABLE_SIZE - 1) ; i >= (int) sizeof(char *) ; i--) { YieldTime(theEnv); memPtr = MemoryData(theEnv)->MemoryTable[i]; while (memPtr != NULL) { tmpPtr = memPtr->next; genfree(theEnv,(void *) memPtr,(unsigned) i); memPtr = tmpPtr; amount += i; returns++; if ((returns % 100) == 0) { YieldTime(theEnv); } } MemoryData(theEnv)->MemoryTable[i] = NULL; if ((amount > maximum) && (maximum > 0)) { return(amount); } } return(amount); } /*****************************************************/ /* gm1: Allocates memory and sets all bytes to zero. */ /*****************************************************/ globle void *gm1( void *theEnv, size_t size) { struct memoryPtr *memPtr; char *tmpPtr; size_t i; if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) { tmpPtr = (char *) genalloc(theEnv,(unsigned) size); for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return((void *) tmpPtr); } memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[size]; if (memPtr == NULL) { tmpPtr = (char *) genalloc(theEnv,(unsigned) size); for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return((void *) tmpPtr); } MemoryData(theEnv)->MemoryTable[size] = memPtr->next; tmpPtr = (char *) memPtr; for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return ((void *) tmpPtr); } /*****************************************************/ /* gm2: Allocates memory and does not initialize it. */ /*****************************************************/ globle void *gm2( void *theEnv, size_t size) { #if (MEM_TABLE_SIZE > 0) struct memoryPtr *memPtr; #endif if (size < sizeof(char *)) size = sizeof(char *); #if (MEM_TABLE_SIZE > 0) if (size >= MEM_TABLE_SIZE) return(genalloc(theEnv,(unsigned) size)); memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[size]; if (memPtr == NULL) { return(genalloc(theEnv,size)); } MemoryData(theEnv)->MemoryTable[size] = memPtr->next; return ((void *) memPtr); #else return(genalloc(theEnv,size)); #endif } /*****************************************************/ /* gm3: Allocates memory and does not initialize it. */ /*****************************************************/ globle void *gm3( void *theEnv, size_t size) { #if (MEM_TABLE_SIZE > 0) struct memoryPtr *memPtr; #endif if (size < (long) sizeof(char *)) size = sizeof(char *); #if (MEM_TABLE_SIZE > 0) if (size >= MEM_TABLE_SIZE) return(genalloc(theEnv,size)); memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[(int) size]; if (memPtr == NULL) { return(genalloc(theEnv,size)); } MemoryData(theEnv)->MemoryTable[(int) size] = memPtr->next; return ((void *) memPtr); #else return(genalloc(theEnv,size)); #endif } /****************************************/ /* rm: Returns a block of memory to the */ /* maintained pool of free memory. */ /****************************************/ globle int rm( void *theEnv, void *str, size_t size) { #if (MEM_TABLE_SIZE > 0) struct memoryPtr *memPtr; #endif if (size == 0) { SystemError(theEnv,"MEMORY",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (size < sizeof(char *)) size = sizeof(char *); #if (MEM_TABLE_SIZE > 0) if (size >= MEM_TABLE_SIZE) return(genfree(theEnv,(void *) str,size)); memPtr = (struct memoryPtr *) str; memPtr->next = MemoryData(theEnv)->MemoryTable[size]; MemoryData(theEnv)->MemoryTable[size] = memPtr; #else return(genfree(theEnv,(void *) str,size)); #endif return(1); } /********************************************/ /* rm3: Returns a block of memory to the */ /* maintained pool of free memory that's */ /* size is indicated with a long integer. */ /********************************************/ globle int rm3( void *theEnv, void *str, size_t size) { #if (MEM_TABLE_SIZE > 0) struct memoryPtr *memPtr; #endif if (size == 0) { SystemError(theEnv,"MEMORY",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (size < (long) sizeof(char *)) size = sizeof(char *); #if (MEM_TABLE_SIZE > 0) if (size >= MEM_TABLE_SIZE) return(genfree(theEnv,(void *) str,size)); memPtr = (struct memoryPtr *) str; memPtr->next = MemoryData(theEnv)->MemoryTable[(int) size]; MemoryData(theEnv)->MemoryTable[(int) size] = memPtr; #else return(genfree(theEnv,(void *) str,size)); #endif return(1); } /***************************************************/ /* PoolSize: Returns number of bytes in free pool. */ /***************************************************/ globle unsigned long PoolSize( void *theEnv) { unsigned long cnt = 0; #if (MEM_TABLE_SIZE > 0) register int i; struct memoryPtr *memPtr; for (i = sizeof(char *) ; i < MEM_TABLE_SIZE ; i++) { memPtr = MemoryData(theEnv)->MemoryTable[i]; while (memPtr != NULL) { cnt += (unsigned long) i; memPtr = memPtr->next; } } #endif return(cnt); } /***************************************************************/ /* ActualPoolSize : Returns number of bytes DOS requires to */ /* store the free pool. This routine is functionally */ /* equivalent to pool_size on anything other than the IBM-PC */ /***************************************************************/ globle unsigned long ActualPoolSize( void *theEnv) { return(PoolSize(theEnv)); } /********************************************/ /* EnvSetConserveMemory: Allows the setting */ /* of the memory conservation flag. */ /********************************************/ globle intBool EnvSetConserveMemory( void *theEnv, intBool value) { int ov; ov = MemoryData(theEnv)->ConserveMemory; MemoryData(theEnv)->ConserveMemory = value; return(ov); } /*******************************************/ /* EnvGetConserveMemory: Returns the value */ /* of the memory conservation flag. */ /*******************************************/ globle intBool EnvGetConserveMemory( void *theEnv) { return(MemoryData(theEnv)->ConserveMemory); } /**************************/ /* genmemcpy: */ /**************************/ globle void genmemcpy( char *dst, char *src, unsigned long size) { unsigned long i; for (i = 0L ; i < size ; i++) dst[i] = src[i]; } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool GetConserveMemory() { return EnvGetConserveMemory(GetCurrentEnvironment()); } globle long int MemRequests() { return EnvMemRequests(GetCurrentEnvironment()); } globle long int MemUsed() { return EnvMemUsed(GetCurrentEnvironment()); } globle long int ReleaseMem( long int maximum) { return EnvReleaseMem(GetCurrentEnvironment(),maximum); } globle intBool SetConserveMemory( intBool value) { return EnvSetConserveMemory(GetCurrentEnvironment(),value); } globle int (*SetOutOfMemoryFunction(int (*functionPtr)(void *,size_t)))(void *,size_t) { return EnvSetOutOfMemoryFunction(GetCurrentEnvironment(),functionPtr); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/textpro.c0000755000175000017500000015202712461762345016123 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* TEXT PROCESSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Modified error messages so that they were */ /* directly printed rather than storing them in */ /* a string buffer which might not be large */ /* enough to contain the entire message. DR0855 */ /* Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added get-region function. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* 6.30: Removed HELP_FUNCTIONS compilation flag and */ /* associated functionality. */ /* */ /* Used genstrcpy and genstrncpy instead of */ /* strcpy and strncpy. */ /* */ /* Support for long long integers. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ /**************************************************************************/ /**************************************************************************/ /* LOOKUP TABLE FUNCTIONS */ /* */ /* The functions contained in this file set up and access a hierarchical */ /* lookup system for multiple files. */ /* */ /* For usage see external documentation. */ /**************************************************************************/ /**************************************************************************/ #define _TEXTPRO_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include "argacces.h" #include "commline.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "textpro.h" #if TEXTPRO_FUNCTIONS #define NAMESIZE 80 #define NULLCHAR '\0' #define BLANK (' ') #define TAB ('\t') #define LNFEED ('\n') /*=========================================================*/ /*Status returns for the file loading and lookup functions */ /*=========================================================*/ #define NORMAL 0 /*Entry information found in file */ #define NO_FILE -10 /*File not found for reference */ #define NEW_FILE -15 /*File loaded onto internal lookup table*/ #define OLD_FILE -20 /*File was already on the lookup table */ #define NO_TOPIC -25 /*No entry information was found in file*/ #define EXIT -30 /*Branch-up from root; exit lookup table*/ #define BRANCH_UP -35 /*Move up from subtopic entry to parent */ #define BRANCH_DOWN -40 /*Move down from main topic to subtopic */ /*=================*/ /*Entry data types */ /*=================*/ #define MENU -45 /*Entry has subtopics*/ #define INFO -50 /*Entry is a leaf; contains only information*/ /*==========================================*/ /*Entry node type for internal lookup table */ /*==========================================*/ struct entries { int level; /*Level of entry node in the lookup tree */ int type; /*Entry node data type : menu or info */ char name[NAMESIZE]; /*Entry node name */ long int offset; /*Location of entry info in the file */ struct entries *child; /*Address of list of subtopic entries */ struct entries *parent; /*Address of parent topic entry */ struct entries *next; /*Address of next entry at the same level */ }; /*=========================================*/ /*File node type for internal lookup table */ /*=========================================*/ struct lists { char file[NAMESIZE]; /*File name */ struct entries *topics; /*Address of list of entry topics for file */ struct entries *curr_menu; /*Address of current main topic in file */ struct lists *next; /*Address of next file in the table */ }; /*==================================================*/ /*Delimeter strings for marking entries in the file */ /*==================================================*/ #define BDELIM "BEGIN-ENTRY-" #define BDLEN 12 #define EDELIM "END-ENTRY" #define EDLEN 9 #define BFORMAT "%d%1s%12s%s" /*Format string for sscanf*/ #define LIT_DELIM ('$') #define OPEN_READ "r" #define TEXTPRO_DATA 8 struct textProcessingData { struct lists *headings; struct entries *parent; }; #define TextProcessingData(theEnv) ((struct textProcessingData *) GetEnvironmentData(theEnv,TEXTPRO_DATA)) int TextLookupFetch(void *,const char *); int TextLookupToss(void *,const char *); static FILE *GetEntries(void *,const char *,char **,char *,int *); static FILE *GetCurrentMenu(void *,const char *,int *); static char *grab_string(void *,FILE *,char *,int); static int findstr(const char *,const char *); static void upper(char *); static struct lists *NewFetchFile(void *,const char *); static struct entries *AllocateEntryNode(void *,FILE *,const char *,const char *,int); static int AttachLeaf(void *,struct lists *,struct entries *,FILE *,const char *,int); static long LookupEntry(void *,const char *,char **,char *,int *); static void TossFunction(void *,struct entries *); static void DeallocateTextProcessingData(void *); /******************************************************************************/ /*============================================================================*/ /* INTERNAL ROUTINES */ /*============================================================================*/ /******************************************************************************/ /****************************************************************************/ /*LOAD FUNCTION : */ /* Input : 1) name of file to be loaded into the lookup table */ /* 2) caller-allocated buffer to contain an error message (if any) */ /* 3) size of error message buffer */ /* Output : */ /* This function attempts to load the file's topic information into the */ /* lookup table according to the format below : */ /* */ /* BEGIN-ENTRY- */ /* . */ /* . */ /* Entry information in the form in which */ /* it is to be displayed when referenced. */ /* . */ /* . */ /* END-ENTRY */ /* */ /* The function returns the number of entries loaded if the entire file was */ /* was correctly formatted, else it returns -1. */ /****************************************************************************/ globle int TextLookupFetch( void *theEnv, const char *file) { FILE *fp; /*Pointer into stream of input file */ char str[256]; /*Buffer for storing input file lines */ int INFO_BEGIN, INFO_END; /*Flags used to check proper syntax */ struct lists *lnode; /*Used to store file node in list */ struct entries *enode; /*Used to store entry node in topic list */ int line_ct; /*Line count - used for error messages */ int entries_ct; /*Number of entries successfully loaded. */ fp = GenOpen(theEnv,file,OPEN_READ); if (fp == NULL) { PrintErrorID(theEnv,"TEXTPRO",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Could not open file \""); EnvPrintRouter(theEnv,WERROR,file); EnvPrintRouter(theEnv,WERROR,"\".\n"); return(-1); } if ((lnode = NewFetchFile(theEnv,file)) == NULL) { GenClose(theEnv,fp); PrintErrorID(theEnv,"TEXTPRO",2,FALSE); EnvPrintRouter(theEnv,WERROR,"File \""); EnvPrintRouter(theEnv,WERROR,file); EnvPrintRouter(theEnv,WERROR,"\" already loaded.\n"); return(-1); } /*===========================*/ /*Store the file entry topics*/ /*===========================*/ line_ct = 0; entries_ct = 0; INFO_BEGIN = FALSE; INFO_END = TRUE; while (fgets(str,256,fp) != NULL) { line_ct++; /*=============================================================*/ /*Forces the load function to ignore lines beginning with `$$' */ /*=============================================================*/ if ((str[0] != LIT_DELIM) || (str[1] != LIT_DELIM)) { if (findstr(str,EDELIM) >= 0) { if (INFO_BEGIN == TRUE) { INFO_BEGIN = FALSE; INFO_END = TRUE; entries_ct++; } else { GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Unmatched end marker.\n"); return(-1); } } else if (findstr(str,BDELIM) >= 0) { if (INFO_END == TRUE) { INFO_END = FALSE; INFO_BEGIN = TRUE; } else { GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Previous entry not closed.\n"); return(-1); } if ((enode=AllocateEntryNode(theEnv,fp,file,str,line_ct))==NULL) return(-1); /*=================================*/ /*Store new entry node in the tree */ /*=================================*/ if (AttachLeaf(theEnv,lnode,enode,fp,file,line_ct) == FALSE) return(-1); } } } GenClose(theEnv,fp); if (INFO_END == FALSE) { TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Previous entry not closed.\n"); return(-1); } if (entries_ct == 0) TextLookupToss(theEnv,file); return(entries_ct); } /******************************************************************************/ /*FUNCTION UNLOAD : */ /* Input : 1) name of file to be taken off the lookup table */ /* Output : This functions deletes a file and all entry-topics associated with*/ /* it from the lookup table and returns a boolean flag indicating */ /* failure or success. */ /******************************************************************************/ globle int TextLookupToss( void *theEnv, const char *file) { struct lists *plptr, *clptr; int l_flag; clptr = TextProcessingData(theEnv)->headings; plptr = clptr; if (clptr != NULL) if (strcmp(clptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; while (l_flag > 0) { plptr = clptr; clptr = clptr->next; if (clptr != NULL) if (strcmp(clptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; } if (clptr == NULL) return(FALSE); TossFunction(theEnv,clptr->topics); if (plptr == clptr) TextProcessingData(theEnv)->headings = clptr->next; else plptr->next = clptr->next; rm(theEnv,(void *) clptr,(int) sizeof(struct lists)); return(TRUE); } /******************************************************************************/ /*FUNCTION GET_ENTRIES : */ /* Input : 1) name of file to be accessed for lookup of entry */ /* 2) caller allocated buffer for main topic name */ /* 3) name of the entry to be accessed in the file */ /* 4) caller allocated buffer for a status code (see LOOKUP). */ /* Output : 1) returns a pointer into the stream of the lookup file which */ /* indicates the starting position of the lookup information */ /* (NULL if the topic was not found) */ /* This function passes its input directly to LOOKUP. See its description */ /* for further detail. */ /* */ /******************************************************************************/ static FILE *GetEntries( void *theEnv, const char *file, char **menu, char *name, int *code) { FILE *fp; /*Lookup file stream*/ long int offset; /*Offset from beginning of file to beginning of topic*/ offset = LookupEntry(theEnv,file,menu,name,code); if (offset < 0) return(NULL); fp = GenOpen(theEnv,file,OPEN_READ); if (fp == NULL) { *code = NO_FILE; return(NULL); } if (fseek(fp,offset,0) < 0) { GenClose(theEnv,fp); *code = NO_FILE; return(NULL); } return(fp); } /******************************************************************************/ /*FUNCTION GET_CURR_MENU : */ /* Input : 1) name of file to be accessed */ /* 2) caller allocated buffer for the current menu name */ /* 3) caller allocated buffer for status code : NO_FILE, NO_TOPIC, or */ /* NORMAL. */ /* Output : 1) returns a pointer into the file stream indicating the beginning*/ /* of the description of the current menu for the named file */ /* (returns NULL if there is no current menu) */ /******************************************************************************/ static FILE *GetCurrentMenu( void *theEnv, const char *file, int *status) { struct lists *lptr; /*Used in searching the file list*/ FILE *fp; /*File stream*/ int l_flag; /*Used in looping through the file list*/ /*=====================================*/ /*Find the named file in the file list */ /*=====================================*/ lptr = TextProcessingData(theEnv)->headings; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; while (l_flag > 0) { lptr = lptr->next; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; } if (lptr == NULL) { *status = NO_FILE; return(NULL); } /*============================================================*/ /*Position the pointer in the file stream to the current menu */ /*============================================================*/ if (lptr->curr_menu == NULL) { *status = NO_TOPIC; return(NULL); } if ((fp = GenOpen(theEnv,file,OPEN_READ)) == NULL) { *status = NO_FILE; return(NULL); } if (fseek(fp,lptr->curr_menu->offset,0) < 0) { GenClose(theEnv,fp); *status = NO_FILE; return(NULL); } *status = NORMAL; return(fp); } /******************************************************************************/ /*FUNCTION GRAB_STRING : */ /* Input : 1) file stream pointer */ /* 2) caller allocated buffer for storage of read string */ /* 3) size of caller's buffer */ /* Output : This function grabs a line of text from the currently opened */ /* lookup file at the given file position in the stream. If it */ /* encounters EOF or the closing topic delimeter, it closes the file */ /* and returns NULL. Otherwise, the return value is simply the */ /* address of the caller's buffer. */ /* */ /* Notes : 1) This function expects a file pointer into a stream of a file */ /* already opened!! */ /* 2) The caller must close the file himself if he wishes to */ /* prematurely abort the complete reading of an entry. */ /******************************************************************************/ static char *grab_string( void *theEnv, FILE *fp, char *buf, int bufsize) { if (fgets(buf,bufsize,fp) == NULL) { GenClose(theEnv,fp); return(NULL); } if ((buf[0] == LIT_DELIM) && (buf[1] == LIT_DELIM)) { buf[0] = BLANK; buf[1] = BLANK; } else if (findstr(buf,EDELIM) >= 0) { buf = NULL; GenClose(theEnv,fp); } return(buf); } /**************************************************************************/ /*FINDSTR FUNCTION : */ /* Input : 1) string to be searched */ /* 2) string to be found */ /* Output : 1) returns index of string-1 where string-2 started, if found */ /* 2) returns -1, if not found */ /**************************************************************************/ static int findstr( const char *s, const char *t) { int i,j,k; for (i = 0; s[i] != '\0'; i++) { for (j = i, k = 0; t[k] != '\0' && s[j] == t[k]; j++, k++) ; if ((t[k] == '\0') && (k != 0)) return(i); } return(-1); } /**********************************************************************/ /*UPPER FUNCTION : */ /* Input : 1) alphanumeric string */ /* Output : 1) all alphabetic characters of string are capitalized */ /**********************************************************************/ static void upper( char *str) { int theIndex; for (theIndex = 0 ; str[theIndex] != NULLCHAR; theIndex++) if (islower(str[theIndex])) str[theIndex] = (char) toupper(str[theIndex]); } /******************************************************************************/ /*FILE_NODE FUNCTION : */ /* Input : 1) name of a file */ /* Output : 1) returns address of an initalized NewFetchFile, if the file was */ /* not already on the lookup table */ /* 2) returns the null address, if the file was already present */ /******************************************************************************/ static struct lists *NewFetchFile( void *theEnv, const char *file) { struct lists *lptr = NULL, *lnode; if (TextProcessingData(theEnv)->headings != NULL) { lptr = TextProcessingData(theEnv)->headings; while (lptr->next != NULL) { if (strcmp(lptr->file,file) == 0) return(NULL); lptr = lptr->next; } if (strcmp(lptr->file,file) == 0) return(NULL); } lnode = (struct lists *) gm2(theEnv,(int) sizeof(struct lists)); genstrcpy(lnode->file,file); lnode->topics = NULL; lnode->curr_menu = NULL; lnode->next = NULL; if (TextProcessingData(theEnv)->headings == NULL) TextProcessingData(theEnv)->headings = lnode; else lptr->next = lnode; return(lnode); } /******************************************************************************/ /*ENTRIES_NODE FUNCTION : */ /* Input : 1) file pointer */ /* 2) file name */ /* 3) input string from the file */ /* 4) buffer for error messages */ /* 5) size of the error message buffer */ /* 6) line count in the file */ /* Output : */ /*This function scans the input string for the appropriate topic entry */ /*delimeter and, if it finds this to be correct, allocates a new entry node, */ /*and initializes it, and returns the address to the calling routine. If an */ /*error is detected, the function writes an appropriate message to the */ /*caller's buffer, deallocates the node, deletes all previous nodes from the */ /*current file from the lookup table, closes the file, and returns the null */ /*address. */ /******************************************************************************/ static struct entries *AllocateEntryNode( void *theEnv, FILE *fp, const char *file, const char *str, int line_ct) { struct entries *enode; char bmarker[BDLEN+1], /*Entry topic delimiting strings */ t_code[2]; /*Type of entry flag : menu or info */ /*================================================================*/ /*Allocate a new node and scan the delimeter string for tree info */ /*================================================================*/ enode = (struct entries *) gm2(theEnv,(int) sizeof(struct entries)); if (sscanf(str,BFORMAT, &enode->level,t_code,bmarker,enode->name) != 4) { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Invalid delimeter string.\n"); return(NULL); } if (t_code[0] == 'M') enode->type = MENU; else if (t_code[0] == 'I') enode->type = INFO; else { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Invalid entry type.\n"); return(NULL); } if (strcmp(bmarker,BDELIM) != 0) { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Invalid delimeter string.\n"); return(NULL); } /*===============================================================*/ /* For systems which have record file systems (such as VMS), */ /* the following statement is necessary to move the file pointer */ /* to the beginning of the next record. */ /*===============================================================*/ ungetc(getc(fp),fp); enode->offset = ftell(fp); enode->parent = NULL; enode->child = NULL; enode->next = NULL; upper(enode->name); return(enode); } /******************************************************************************/ /*FUNCTION ATTACH_LEAF : */ /* Input : 1) address of current NewFetchFile */ /* 2) address of current topic entry-node */ /* 3) file pointer */ /* 4) name of file */ /* 5) error message buffer */ /* 6) size of error message buffer */ /* 7) line count in the file */ /* Output : */ /*This function attaches the entry-node to its proper place in the tree of the*/ /*current file. The function returns a boolean flag indicating the success */ /*(or lack thereof) of this connection. In the case of an error, an error */ /*message is written to the caller's buffer, the file is closed, and the */ /*previous file entries are deleted from the lookup table. */ /******************************************************************************/ static int AttachLeaf( void *theEnv, struct lists *lnode, struct entries *enode, FILE *fp, const char *file, int line_ct) { int p_flag; /*Used in searching the tree for a parent*/ /*====================*/ /*First topic for file*/ /*====================*/ if (lnode->topics == NULL) lnode->topics = enode; /*================================*/ /*Subtopic - branch down the tree */ /*================================*/ else if (enode->level > TextProcessingData(theEnv)->parent->level) if (TextProcessingData(theEnv)->parent->type == MENU) { enode->parent = TextProcessingData(theEnv)->parent; TextProcessingData(theEnv)->parent->child = enode; } else { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Non-menu entries cannot have subtopics.\n"); return(FALSE); } /*====================================*/ /*Brother-topic -- same level in tree */ /*====================================*/ else if (enode->level == TextProcessingData(theEnv)->parent->level) { enode->parent = TextProcessingData(theEnv)->parent->parent; enode->next = TextProcessingData(theEnv)->parent->next; TextProcessingData(theEnv)->parent->next = enode; } /*==========================================================*/ /*Topic is unrelated to previous topic - branch up the tree */ /*==========================================================*/ else { if (TextProcessingData(theEnv)->parent != NULL) p_flag = 1; else p_flag = 0; while (p_flag > 0) { TextProcessingData(theEnv)->parent = TextProcessingData(theEnv)->parent->parent; if (TextProcessingData(theEnv)->parent != NULL) if (enode->level < TextProcessingData(theEnv)->parent->level) p_flag = 1; else p_flag = 0; else p_flag = 0; } if (TextProcessingData(theEnv)->parent != NULL) /*========*/ /*Subtopic*/ /*========*/ if (TextProcessingData(theEnv)->parent->level < enode->level) { enode->parent = TextProcessingData(theEnv)->parent; enode->next = TextProcessingData(theEnv)->parent->child; TextProcessingData(theEnv)->parent->child = enode; } /*=============*/ /*Brother-topic*/ /*=============*/ else { enode->parent = TextProcessingData(theEnv)->parent->parent; enode->next = TextProcessingData(theEnv)->parent->next; TextProcessingData(theEnv)->parent->next = enode; } /*=========*/ /*Root Node*/ /*=========*/ else { enode->parent = NULL; enode->next = lnode->topics; lnode->topics = enode; } } TextProcessingData(theEnv)->parent = enode; return(TRUE); } /******************************************************************************/ /*FUNCTION LOOKUP : */ /* Input : 1) name of entry-topic file to be used for reference */ /* 2) caller allocated buffer to contain the main topic name */ /* 3) name of the entry-topic to be found */ /* 4) caller allocated buffer to store the return status */ /* Output : 1) offset from the beginning of the entry-topic file stream to the*/ /* beginning of the requested topic (-1 if the topic not found) */ /* 2) status code stored in caller's buffer indicating the result of */ /* the lookup : NO_FILE, NO_TOPIC, BRANCH_UP, BRANCH_DOWN, EXIT, */ /* or NORMAL. */ /* */ /* Notes : 1) If NULL is given as an entry-topic, the lookup routine branches */ /* up one level in the tree (status BRANCH_UP). If the current */ /* level of the tree is already the root, all paths are set to NULL*/ /* (status EXIT). */ /* 2) If an entry-topic is not found, the file position of the current*/ /* main topic (or menu) is returned (status NO_TOPIC). */ /******************************************************************************/ static long int LookupEntry( void *theEnv, const char *file, char **menu, char *name, int *code) { struct lists *lptr; /*Local pointers used to move through the tree*/ struct entries *eptr; int l_flag, e_flag; /*Flags used in looping to find entry-topics*/ /*===============================*/ /*Find named file in lookup list */ /*===============================*/ lptr = TextProcessingData(theEnv)->headings; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; while (l_flag > 0) { lptr = lptr->next; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; } if (lptr == NULL) { *code = NO_FILE; return(-1); } /*==================================================================*/ /*If entry-topic was NULL, branch up one-level in the tree, or exit */ /*the tree if already at the root. */ /*==================================================================*/ if (name == NULL) { if (lptr->curr_menu == NULL) { *code = EXIT; return(-1); } else { if (lptr->curr_menu->parent == NULL) { *code = EXIT; lptr->curr_menu = NULL; *menu = NULL; return(-1); } lptr->curr_menu = lptr->curr_menu->parent; *code = BRANCH_UP; *menu = lptr->curr_menu->name; return(lptr->curr_menu->offset); } } /*========================================*/ /*Find the topic in the file's topic tree */ /*========================================*/ upper(name); if (lptr->curr_menu != NULL) eptr = lptr->curr_menu->child; else eptr = lptr->topics; if (eptr != NULL) if (findstr(eptr->name,name) == 0) e_flag = 0; else e_flag = 1; else e_flag = 0; while (e_flag > 0) { eptr = eptr->next; if (eptr != NULL) if (findstr(eptr->name,name) == 0) e_flag = 0; else e_flag = 1; else e_flag = 0; } /*===================================================================*/ /*If the topic was not found, return the position of the current menu*/ /*===================================================================*/ if (eptr == NULL) { *code = NO_TOPIC; if (lptr->curr_menu != NULL) { *menu = lptr->curr_menu->name; return(lptr->curr_menu->offset); } return(-1); } /*===============================================================*/ /*If the requested topic has children, branch down to its level. */ /*===============================================================*/ if (eptr->type == MENU) { *code = BRANCH_DOWN; lptr->curr_menu = eptr; } else *code = NORMAL; if (lptr->curr_menu != NULL) *menu = lptr->curr_menu->name; return(eptr->offset); } /******************************************************************************/ /*FUNCTION TOSS : */ /* Input : 1) entry-topic address */ /* Output : This function recursively deletes a node and all child nodes */ /******************************************************************************/ static void TossFunction( void *theEnv, struct entries *eptr) { struct entries *prev; while (eptr != NULL) { if (eptr->child != NULL) TossFunction(theEnv,eptr->child); prev = eptr; eptr = eptr->next; rm(theEnv,(void *) prev,(int) sizeof(struct entries)); } } /****************************************************************************/ /****************************************************************************/ /* TEXT PROCESSING FUNCTIONS */ /* */ /* The functions contained in this file can be called to handle */ /* external file referencing and accessing. FetchCommand() loads a file */ /* onto an internal run-time lookup table, TossCommand() removes the file, */ /* PrintRegionCommand accesses the loaded file to display a requested */ /* entry, and HelpFunction() provides an on-line help facility */ /* using the external help data file specified in the header file setup.h. */ /* For information on the format of the data file(s) required, see the */ /* internal documentation in LOOKUP.C and the external documentation. */ /* */ /* For usage of these functions, see the external documentation. */ /****************************************************************************/ /****************************************************************************/ #define SCREEN_LN 22 /*Typical terminal screen length -- 22 lines*/ /*Used for scrolling in the help facility */ /*==========================================*/ /*Topic node for help facility's query list */ /*==========================================*/ struct topics { char name[NAMESIZE]; /*Name of the node */ struct topics *end_list; /*Pointer to end of query list */ struct topics *next; /*Pointer to next topic in the list*/ }; /******************************************************************************/ /*============================================================================*/ /* FUNCTION DECLARATIONS */ /*============================================================================*/ /******************************************************************************/ static struct topics *GetCommandLineTopics(void *); static FILE *FindTopicInEntries(void *,const char *,struct topics *,char **,int *); /******************************************************************************/ /*============================================================================*/ /* EXTERNAL ACCESS FUNCTIONS */ /*============================================================================*/ /******************************************************************************/ #if TEXTPRO_FUNCTIONS /***************************************************************************/ /*FUNCTION FetchCommand : (H/L function fetch) */ /* Input : Name of the file to be stored in the lookup table - passed via */ /* the argument "stack" and result buffer */ /* Output : This function loads a file into the internal lookup table and */ /* returns a (float) boolean flag indicating failure or success. */ /***************************************************************************/ globle void FetchCommand( void *theEnv, DATA_OBJECT *result) { int load_ct; /*Number of entries loaded */ DATA_OBJECT arg_ptr; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"fetch",1,SYMBOL_OR_STRING,&arg_ptr) == FALSE) return; load_ct = TextLookupFetch(theEnv,DOToString(arg_ptr)); if (load_ct <= 0) { if (load_ct == 0) { PrintErrorID(theEnv,"TEXTPRO",3,FALSE); EnvPrintRouter(theEnv,WERROR,"No entries found.\n"); } return; } result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,(long long) load_ct); } /******************************************************************************/ /*FUNCTION PrintRegionCommand : (H/L function print-region) */ /* Input : Via the argument "stack", logical name for the output, the name of the */ /* file to be accessed, and the name of the topic(s) to be looked up. */ /* Output : This function accesses a previously loaded file and prints the */ /* information of the topic entry requested to the screen. The tree */ /* structure must currently be at the correct level in order for the */ /* topic to be accessed. To branch down the tree, each topic in the */ /* path to the one desired must be named. Multiple arguments are */ /* allowed as in the help facility (see the external documentation.) */ /* To branch up the tree, the special topic character `^' must be */ /* specified for each upwards branch. Giving no topic name will */ /* cause a single branch-up in the tree. The `?' character given at */ /* the end of a path will return the current main topic menu. */ /* */ /* For usage, see the external documentation. */ /******************************************************************************/ globle int PrintRegionCommand( void *theEnv) { struct topics *params, /*Lookup file and list of topic requests */ *tptr; /*Used in deallocating the parameter list */ char buf[256]; /*Buffer for the topic entry strings */ FILE *fp; /*Stream for the input file */ char *menu[1]; /*Buffer for the current menu name */ int status, /*Lookup status return code */ com_code; /*Completion flag */ params = GetCommandLineTopics(theEnv); fp = FindTopicInEntries(theEnv,params->next->name,params->next->next,menu,&status); if ((status != NO_FILE) && (status != NO_TOPIC) && (status != EXIT)) { if (strcmp(params->name,"t") == 0) genstrcpy(params->name,STDOUT); EnvPrintRouter(theEnv,params->name,"\n"); while (grab_string(theEnv,fp,buf,256) != NULL) EnvPrintRouter(theEnv,params->name,buf); com_code = TRUE; } else { /* ================================================================== On NO_TOPIC results, the file is left open to point to the current menu. This used as a check by the Help System. In the case of print-region, however, we need to always make sure the file is closed. ================================================================== */ if (fp != NULL) GenClose(theEnv,fp); com_code = FALSE; } /* ======================================================= Release any space used by the user's topic request list ======================================================= */ while (params != NULL) { tptr = params; params = params->next; rm(theEnv,(void *) tptr,(int) sizeof(struct topics)); } return(com_code); } /******************************************************************************/ /*FUNCTION GetRegionCommand : (H/L functionget-region) */ /******************************************************************************/ globle void *GetRegionCommand( void *theEnv) { struct topics *params, /*Lookup file and list of topic requests */ *tptr; /*Used in deallocating the parameter list */ char buf[256]; /*Buffer for the topic entry strings */ FILE *fp; /*Stream for the input file */ char *menu[1]; /*Buffer for the current menu name */ int status; /*Lookup status return code */ char *theString = NULL; void *theResult; size_t oldPos = 0; size_t oldMax = 0; size_t sLength; params = GetCommandLineTopics(theEnv); fp = FindTopicInEntries(theEnv,params->name,params->next,menu,&status); if ((status != NO_FILE) && (status != NO_TOPIC) && (status != EXIT)) { while (grab_string(theEnv,fp,buf,256) != NULL) theString = AppendToString(theEnv,buf,theString,&oldPos,&oldMax); } else { /* ================================================================== On NO_TOPIC results, the file is left open to point to the current menu. This used as a check by the Help System. In the case of print-region, however, we need to always make sure the file is closed. ================================================================== */ if (fp != NULL) GenClose(theEnv,fp); } /* ======================================================= Release any space used by the user's topic request list ======================================================= */ while (params != NULL) { tptr = params; params = params->next; rm(theEnv,(void *) tptr,(int) sizeof(struct topics)); } if (theString == NULL) { theResult = EnvAddSymbol(theEnv,""); } else { sLength = strlen(theString); if ((sLength > 0) && (((theString[sLength-1] == '\r') && (theString[sLength-2] == '\n')) || ((theString[sLength-1] == '\n') && (theString[sLength-2] == '\r')))) { theString[sLength-2] = 0; } theResult = EnvAddSymbol(theEnv,theString); } if (theString != NULL) { genfree(theEnv,theString,oldMax); } return(theResult); } /***************************************************************************/ /*FUNCTION TossCommand : (H/L function toss) */ /* Input : Name of the file to be deleted from the lookup table (passed via*/ /* the argument "stack") */ /* Output : This function deletes the named file from the lookup table and */ /* returns a (float) boolean flag indicating failure or success. */ /***************************************************************************/ globle int TossCommand( void *theEnv) { const char *file; /*Name of the file */ DATA_OBJECT arg_ptr; if (EnvArgTypeCheck(theEnv,"toss",1,SYMBOL_OR_STRING,&arg_ptr) == FALSE) return (FALSE); file = DOToString(arg_ptr); return(TextLookupToss(theEnv,file)); } #endif /******************************************************************************/ /*============================================================================*/ /* INTERNAL ROUTINES */ /*============================================================================*/ /******************************************************************************/ /******************************************************************************/ /*FUNCTION CMD_LINE_TOPICS : */ /* Input : None */ /* Output : This function builds a linked list of topics requested by the */ /* user at the H/L level using the argument "stack" routines, */ /* num_args() and rstring(). It returns the address of the top of */ /* the list or NULL if there were no command line topics. */ /******************************************************************************/ static struct topics *GetCommandLineTopics( void *theEnv) { int topic_num, /*Number of topics specified by the user */ theIndex; /*Used to loop through the topic list */ struct topics *head, /*Address of the top of the topic list */ *tnode, /*Address of new topic node */ *tptr; /*Used to attach new node to the list */ DATA_OBJECT val; /*Unknown-type H/L data structure */ head = NULL; topic_num = EnvRtnArgCount(theEnv); for (theIndex = 1; theIndex <= topic_num; theIndex++) { tnode = (struct topics *) gm2(theEnv,(int) sizeof(struct topics)); EnvRtnUnknown(theEnv,theIndex,&val); if ((GetType(val) == SYMBOL) || (GetType(val) == STRING)) genstrncpy(tnode->name,DOToString(val),NAMESIZE-1); else if (GetType(val) == FLOAT) genstrncpy(tnode->name,FloatToString(theEnv,DOToDouble(val)),NAMESIZE-1); else if (GetType(val) == INTEGER) genstrncpy(tnode->name,LongIntegerToString(theEnv,DOToLong(val)),NAMESIZE-1); else genstrncpy(tnode->name,"***ERROR***",NAMESIZE-1); tnode->next = NULL; tnode->end_list = NULL; if (head == NULL) head = tnode; else { tptr = head; while (tptr->next != NULL) tptr = tptr->next; tptr->next = tnode; } } return(head); } /******************************************************************************/ /*FUNCTION FIND_TOPIC : */ /* Input : 1) File to be searched for topic request */ /* 2) Address of topic request list */ /* 3) Buffer for current menu name */ /* 4) Lookup status return code */ /* Output : This function flows through the user topic request path by */ /* calling the lookup routines. When it reaches the last element, */ /* it returns a pointer into the stream of the lookup file */ /* indicating the beginning of the topic entry. If any topic in the */ /* path is not found, the function aborts and returns the address of */ /* of the current menu in the lookup tree for the file. The exact */ /* nature of the final lookup is indicated in the status buffer. */ /******************************************************************************/ static FILE *FindTopicInEntries( void *theEnv, const char *file, struct topics *main_topic, char **menu, int *status) { FILE *fp = NULL; /*Input file stream */ struct topics *tptr, /*Used to loop through the topic list */ *end_list; /*Address of the end of the topic list */ if (main_topic != NULL) end_list = main_topic->end_list; else end_list = NULL; tptr = main_topic; if (tptr != end_list) do { if (fp != NULL) GenClose(theEnv,fp); /*======================*/ /*Branch up in the tree */ /*======================*/ if (strcmp(tptr->name,"^") == 0) fp = GetEntries(theEnv,file,menu,NULL,status); /*=======================================================*/ /*Return the current main topic menu of the lookup table */ /*=======================================================*/ else if ((strcmp(tptr->name,"?") == 0) && (tptr->next == end_list)) fp = GetCurrentMenu(theEnv,file,status); /*=====================*/ /*Lookup topic request */ /*=====================*/ else fp = GetEntries(theEnv,file,menu,tptr->name,status); if ((*status == NO_FILE) || (*status == NO_TOPIC)) break; tptr = tptr->next; } while (tptr != end_list); else /*==================================================================*/ /*An empty topic request list causes a single branch-up in the tree */ /*==================================================================*/ fp = GetEntries(theEnv,file,menu,NULL,status); return(fp); } /*******************************************/ /* HelpFunctionDefinitions: */ /*******************************************/ globle void HelpFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,TEXTPRO_DATA,sizeof(struct textProcessingData),DeallocateTextProcessingData); #if ! RUN_TIME #if TEXTPRO_FUNCTIONS EnvDefineFunction2(theEnv,"fetch",'u', PTIEF FetchCommand,"FetchCommand","11k"); EnvDefineFunction2(theEnv,"toss",'b', PTIEF TossCommand,"TossCommand","11k"); EnvDefineFunction2(theEnv,"print-region",'b', PTIEF PrintRegionCommand,"PrintRegionCommand","2**wk"); EnvDefineFunction2(theEnv,"get-region",'s', PTIEF GetRegionCommand,"GetRegionCommand","1**k"); #endif #endif } /*********************************************************/ /* DeallocateTextProcessingData: Deallocates environment */ /* data for text processing routines. */ /*********************************************************/ static void DeallocateTextProcessingData( void *theEnv) { struct lists *nextptr, *clptr; clptr = TextProcessingData(theEnv)->headings; while (clptr != NULL) { nextptr = clptr->next; TossFunction(theEnv,clptr->topics); rm(theEnv,(void *) clptr,(int) sizeof(struct lists)); clptr = nextptr; } } #endif clips_core_source_630/core/factqpsr.c0000644000175000017500000006324312464742046016236 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* FACT-SET QUERIES PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Fact_set Queries Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Added fact-set queries. */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Fixed memory leaks when error occurred. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if FACT_SET_QUERIES && (! RUN_TIME) #include #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "factqury.h" #include "modulutl.h" #include "prcdrpsr.h" #include "prntutil.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #define _FACTQPSR_SOURCE_ #include "factqpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define FACT_SLOT_REF ':' /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static EXPRESSION *ParseQueryRestrictions(void *,EXPRESSION *,const char *,struct token *); static intBool ReplaceTemplateNameWithReference(void *,EXPRESSION *); static int ParseQueryTestExpression(void *,EXPRESSION *,const char *); static int ParseQueryActionExpression(void *,EXPRESSION *,const char *,EXPRESSION *,struct token *); static void ReplaceFactVariables(void *,EXPRESSION *,EXPRESSION *,int,int); static void ReplaceSlotReference(void *,EXPRESSION *,EXPRESSION *, struct FunctionDefinition *,int); static int IsQueryFunction(EXPRESSION *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************** NAME : FactParseQueryNoAction DESCRIPTION : Parses the following functions : (any-factp) (find-first-fact) (find-all-facts) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *FactParseQueryNoAction( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *factQuerySetVars; struct token queryInputToken; factQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (factQuerySetVars == NULL) { return(NULL); } IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); GetToken(theEnv,readSource,&queryInputToken); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } ReplaceFactVariables(theEnv,factQuerySetVars,top->argList,TRUE,0); ReturnExpression(theEnv,factQuerySetVars); return(top); } /*********************************************************************** NAME : FactParseQueryAction DESCRIPTION : Parses the following functions : (do-for-fact) (do-for-all-facts) (delayed-do-for-all-facts) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *FactParseQueryAction( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *factQuerySetVars; struct token queryInputToken; factQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (factQuerySetVars == NULL) { return(NULL); } IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } PPCRAndIndent(theEnv); if (ParseQueryActionExpression(theEnv,top,readSource,factQuerySetVars,&queryInputToken) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } ReplaceFactVariables(theEnv,factQuerySetVars,top->argList,TRUE,0); ReplaceFactVariables(theEnv,factQuerySetVars,top->argList->nextArg,FALSE,0); ReturnExpression(theEnv,factQuerySetVars); return(top); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************** NAME : ParseQueryRestrictions DESCRIPTION : Parses the template restrictions for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) Caller's token buffer RETURNS : The fact-variable expressions SIDE EFFECTS : Entire query expression deleted on errors Nodes allocated for restrictions and fact variable expressions Template restrictions attached to query-expression as arguments NOTES : Expects top != NULL ***************************************************************/ static EXPRESSION *ParseQueryRestrictions( void *theEnv, EXPRESSION *top, const char *readSource, struct token *queryInputToken) { EXPRESSION *factQuerySetVars = NULL,*lastFactQuerySetVars = NULL, *templateExp = NULL,*lastTemplateExp, *tmp,*lastOne = NULL; int error = FALSE; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) { goto ParseQueryRestrictionsError1; } GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) { goto ParseQueryRestrictionsError1; } while (queryInputToken->type == LPAREN) { GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != SF_VARIABLE) { goto ParseQueryRestrictionsError1; } tmp = factQuerySetVars; while (tmp != NULL) { if (tmp->value == queryInputToken->value) { PrintErrorID(theEnv,"FACTQPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate fact member variable name in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); goto ParseQueryRestrictionsError2; } tmp = tmp->nextArg; } tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value); if (factQuerySetVars == NULL) { factQuerySetVars = tmp; } else { lastFactQuerySetVars->nextArg = tmp; } lastFactQuerySetVars = tmp; SavePPBuffer(theEnv," "); templateExp = ArgumentParse(theEnv,readSource,&error); if (error) { goto ParseQueryRestrictionsError2; } if (templateExp == NULL) { goto ParseQueryRestrictionsError1; } if (ReplaceTemplateNameWithReference(theEnv,templateExp) == FALSE) { goto ParseQueryRestrictionsError2; } lastTemplateExp = templateExp; SavePPBuffer(theEnv," "); while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL) { if (ReplaceTemplateNameWithReference(theEnv,tmp) == FALSE) goto ParseQueryRestrictionsError2; lastTemplateExp->nextArg = tmp; lastTemplateExp = tmp; SavePPBuffer(theEnv," "); } if (error) { goto ParseQueryRestrictionsError2; } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); tmp = GenConstant(theEnv,SYMBOL,(void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); lastTemplateExp->nextArg = tmp; lastTemplateExp = tmp; if (top->argList == NULL) { top->argList = templateExp; } else { lastOne->nextArg = templateExp; } lastOne = lastTemplateExp; templateExp = NULL; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); } if (queryInputToken->type != RPAREN) { goto ParseQueryRestrictionsError1; } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(factQuerySetVars); ParseQueryRestrictionsError1: SyntaxErrorMessage(theEnv,"fact-set query function"); ParseQueryRestrictionsError2: ReturnExpression(theEnv,templateExp); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } /*************************************************** NAME : ReplaceTemplateNameWithReference DESCRIPTION : In parsing an fact-set query, this function replaces a constant template name with an actual pointer to the template INPUTS : The expression RETURNS : TRUE if all OK, FALSE if template cannot be found SIDE EFFECTS : The expression type and value are modified if template is found NOTES : Searches current and imported modules for reference ***************************************************/ static intBool ReplaceTemplateNameWithReference( void *theEnv, EXPRESSION *theExp) { const char *theTemplateName; void *theDeftemplate; int count; if (theExp->type == SYMBOL) { theTemplateName = ValueToString(theExp->value); theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,theTemplateName, &count,TRUE,NULL); if (theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } theExp->type = DEFTEMPLATE_PTR; theExp->value = theDeftemplate; #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif } return(TRUE); } /************************************************************* NAME : ParseQueryTestExpression DESCRIPTION : Parses the test-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Test shoved in front of class-restrictions on query argument list NOTES : Expects top != NULL *************************************************************/ static int ParseQueryTestExpression( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *qtest; int error; struct BindInfo *oldBindList; error = FALSE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); qtest = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(FALSE); } if (qtest == NULL) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qtest->nextArg = top->argList; top->argList = qtest; if (ParsedBindNamesEmpty(theEnv) == FALSE) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"FACTQPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in fact-set query in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } SetParsedBindNames(theEnv,oldBindList); return(TRUE); } /************************************************************* NAME : ParseQueryActionExpression DESCRIPTION : Parses the action-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) List of query parameters RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Action shoved in front of template-restrictions and in back of test-expression on query argument list NOTES : Expects top != NULL && top->argList != NULL *************************************************************/ static int ParseQueryActionExpression( void *theEnv, EXPRESSION *top, const char *readSource, EXPRESSION *factQuerySetVars, struct token *queryInputToken) { EXPRESSION *qaction,*tmpFactSetVars; struct BindInfo *oldBindList,*newBindList,*prev; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,queryInputToken->printForm); ExpressionData(theEnv)->BreakContext = FALSE; if (qaction == NULL) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qaction->nextArg = top->argList->nextArg; top->argList->nextArg = qaction; newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { tmpFactSetVars = factQuerySetVars; while (tmpFactSetVars != NULL) { if (tmpFactSetVars->value == (void *) newBindList->name) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"FACTQPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind fact-set member variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(tmpFactSetVars->value)); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } tmpFactSetVars = tmpFactSetVars->nextArg; } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) { SetParsedBindNames(theEnv,oldBindList); } else { prev->next = oldBindList; } return(TRUE); } /*********************************************************************************** NAME : ReplaceFactVariables DESCRIPTION : Replaces all references to fact-variables within an fact query-function with function calls to query-fact (which references the fact array at run-time) INPUTS : 1) The fact-variable list 2) A boolean expression containing variable references 3) A flag indicating whether to allow slot references of the type : for direct slot access or not 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If a SF_VARIABLE node is found and is on the list of fact variables, it is replaced with a query-fact function call. NOTES : Other SF_VARIABLE(S) are left alone for replacement by other parsers. This implies that a user may use defgeneric, defrule, and defmessage-handler variables within a query-function where they do not conflict with fact-variable names. ***********************************************************************************/ static void ReplaceFactVariables( void *theEnv, EXPRESSION *vlist, EXPRESSION *bexp, int sdirect, int ndepth) { EXPRESSION *eptr; struct FunctionDefinition *rindx_func,*rslot_func; int posn; rindx_func = FindFunction(theEnv,"(query-fact)"); rslot_func = FindFunction(theEnv,"(query-fact-slot)"); while (bexp != NULL) { if (bexp->type == SF_VARIABLE) { eptr = vlist; posn = 0; while ((eptr != NULL) ? (eptr->value != bexp->value) : FALSE) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { bexp->type = FCALL; bexp->value = (void *) rindx_func; eptr = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) ndepth)); eptr->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) posn)); bexp->argList = eptr; } else if (sdirect == TRUE) { ReplaceSlotReference(theEnv,vlist,bexp,rslot_func,ndepth); } } if (bexp->argList != NULL) { if (IsQueryFunction(bexp)) { ReplaceFactVariables(theEnv,vlist,bexp->argList,sdirect,ndepth+1); } else { ReplaceFactVariables(theEnv,vlist,bexp->argList,sdirect,ndepth); } } bexp = bexp->nextArg; } } /************************************************************************* NAME : ReplaceSlotReference DESCRIPTION : Replaces fact-set query function variable references of the form: : with function calls to get these fact-slots at run time INPUTS : 1) The fact-set variable list 2) The expression containing the variable 3) The address of the fact slot access function 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If the variable is a slot reference, then it is replaced with the appropriate function-call. NOTES : None *************************************************************************/ static void ReplaceSlotReference( void *theEnv, EXPRESSION *vlist, EXPRESSION *theExp, struct FunctionDefinition *func, int ndepth) { size_t len; int posn,oldpp; size_t i; const char *str; EXPRESSION *eptr; struct token itkn; str = ValueToString(theExp->value); len = strlen(str); if (len < 3) return; for (i = len-2 ; i >= 1 ; i--) { if ((str[i] == FACT_SLOT_REF) ? (i >= 1) : FALSE) { eptr = vlist; posn = 0; while (eptr && ((i != strlen(ValueToString(eptr->value))) || strncmp(ValueToString(eptr->value),str, (STD_SIZE) i))) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { OpenStringSource(theEnv,"query-var",str+i+1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"query-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"query-var"); theExp->type = FCALL; theExp->value = (void *) func; theExp->argList = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) ndepth)); theExp->argList->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) posn)); theExp->argList->nextArg->nextArg = GenConstant(theEnv,itkn.type,itkn.value); break; } } } } /******************************************************************** NAME : IsQueryFunction DESCRIPTION : Determines if an expression is a query function call INPUTS : The expression RETURNS : TRUE if query function call, FALSE otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ static int IsQueryFunction( EXPRESSION *theExp) { int (*fptr)(void); if (theExp->type != FCALL) return(FALSE); fptr = (int (*)(void)) ExpressionFunctionPointer(theExp); if (fptr == (int (*)(void)) AnyFacts) return(TRUE); if (fptr == (int (*)(void)) QueryFindFact) return(TRUE); if (fptr == (int (*)(void)) QueryFindAllFacts) return(TRUE); if (fptr == (int (*)(void)) QueryDoForFact) return(TRUE); if (fptr == (int (*)(void)) QueryDoForAllFacts) return(TRUE); if (fptr == (int (*)(void)) DelayedQueryDoForAllFacts) return(TRUE); return(FALSE); } #endif clips_core_source_630/core/envrnmnt.c0000755000175000017500000005664412500720752016263 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* ENVIRONMENT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for supporting multiple environments. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.24: Added code to CreateEnvironment to free */ /* already allocated data if one of the malloc */ /* calls fail. */ /* */ /* Modified AllocateEnvironmentData to print a */ /* message if it was unable to allocate memory. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added CreateRuntimeEnvironment function. */ /* */ /* Added support for context information when an */ /* environment is created (i.e a pointer from the */ /* CLIPS environment to its parent environment). */ /* */ /* 6.30: Added support for passing context information */ /* to user defined functions and callback */ /* functions. */ /* */ /* Support for hashing EXTERNAL_ADDRESS data */ /* type. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Removed deallocating message parameter from */ /* EnvReleaseMem. */ /* */ /* Removed support for BLOCK_MEMORY. */ /* */ /*************************************************************/ #define _ENVRNMNT_SOURCE_ #include #include #include #include "setup.h" #include "memalloc.h" #include "prntutil.h" #include "router.h" #include "engine.h" #include "sysdep.h" #include "utility.h" #include "envrnmnt.h" #define SIZE_ENVIRONMENT_HASH 131 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if ALLOW_ENVIRONMENT_GLOBALS static void AddHashedEnvironment(struct environmentData *); static struct environmentData *FindEnvironment(unsigned long); static intBool RemoveHashedEnvironment(struct environmentData *); static void InitializeEnvironmentHashTable(void); #endif static void RemoveEnvironmentCleanupFunctions(struct environmentData *); static void *CreateEnvironmentDriver(struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **, struct externalAddressHashNode **); /***************************************/ /* LOCAL INTERNAL VARIABLE DEFINITIONS */ /***************************************/ #if ALLOW_ENVIRONMENT_GLOBALS static unsigned long NextEnvironmentIndex = 0; static struct environmentData **EnvironmentHashTable = NULL; static struct environmentData *CurrentEnvironment = NULL; #endif /*******************************************************/ /* AllocateEnvironmentData: Allocates environment data */ /* for the specified environment data record. */ /*******************************************************/ globle intBool AllocateEnvironmentData( void *vtheEnvironment, unsigned int position, unsigned long size, void (*cleanupFunction)(void *)) { struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment; /*===========================================*/ /* Environment data can't be of length zero. */ /*===========================================*/ if (size <= 0) { printf("\n[ENVRNMNT1] Environment data position %d allocated with size of 0 or less.\n",position); return(FALSE); } /*================================================================*/ /* Check to see if the data position exceeds the maximum allowed. */ /*================================================================*/ if (position >= MAXIMUM_ENVIRONMENT_POSITIONS) { printf("\n[ENVRNMNT2] Environment data position %d exceeds the maximum allowed.\n",position); return(FALSE); } /*============================================================*/ /* Check if the environment data has already been registered. */ /*============================================================*/ if (theEnvironment->theData[position] != NULL) { printf("\n[ENVRNMNT3] Environment data position %d already allocated.\n",position); return(FALSE); } /*====================*/ /* Allocate the data. */ /*====================*/ theEnvironment->theData[position] = malloc(size); if (theEnvironment->theData[position] == NULL) { printf("\n[ENVRNMNT4] Environment data position %d could not be allocated.\n",position); return(FALSE); } memset(theEnvironment->theData[position],0,size); /*=============================*/ /* Store the cleanup function. */ /*=============================*/ theEnvironment->cleanupFunctions[position] = cleanupFunction; /*===============================*/ /* Data successfully registered. */ /*===============================*/ return(TRUE); } /***************************************************************/ /* DeallocateEnvironmentData: Deallocates all environments */ /* stored in the environment hash table and then deallocates */ /* the environment hash table. */ /***************************************************************/ globle intBool DeallocateEnvironmentData() { #if ALLOW_ENVIRONMENT_GLOBALS struct environmentData *theEnvironment, *nextEnvironment; int i, rv = TRUE; for (i = 0; i < SIZE_ENVIRONMENT_HASH; i++) { for (theEnvironment = EnvironmentHashTable[i]; theEnvironment != NULL; ) { nextEnvironment = theEnvironment->next; if (! DestroyEnvironment(theEnvironment)) { rv = FALSE; } theEnvironment = nextEnvironment; } } free(EnvironmentHashTable); return(rv); #else return(FALSE); #endif } #if ALLOW_ENVIRONMENT_GLOBALS /*********************************************************/ /* InitializeEnvironmentHashTable: Initializes the table */ /* entries in the environment hash table to NULL. */ /*********************************************************/ static void InitializeEnvironmentHashTable() { int i; if (EnvironmentHashTable != NULL) { return; } EnvironmentHashTable = (struct environmentData **) malloc(sizeof (struct environmentData *) * SIZE_ENVIRONMENT_HASH); if (EnvironmentHashTable == NULL) { printf("\n[ENVRNMNT4] Unable to initialize environment hash table.\n"); return; } for (i = 0; i < SIZE_ENVIRONMENT_HASH; i++) EnvironmentHashTable[i] = NULL; } /*********************************************/ /* AddHashedEnvironment: Adds an environment */ /* entry to the environment hash table. */ /*********************************************/ static void AddHashedEnvironment( struct environmentData *theEnvironment) { struct environmentData *temp; unsigned long hashValue; if (EnvironmentHashTable == NULL) { InitializeEnvironmentHashTable(); } hashValue = theEnvironment->environmentIndex % SIZE_ENVIRONMENT_HASH; temp = EnvironmentHashTable[hashValue]; EnvironmentHashTable[hashValue] = theEnvironment; theEnvironment->next = temp; } /***************************************************/ /* RemoveHashedEnvironment: Removes an environment */ /* entry from the environment hash table. */ /***************************************************/ static intBool RemoveHashedEnvironment( struct environmentData *theEnvironment) { unsigned long hashValue; struct environmentData *hptr, *prev; hashValue = theEnvironment->environmentIndex % SIZE_ENVIRONMENT_HASH; for (hptr = EnvironmentHashTable[hashValue], prev = NULL; hptr != NULL; hptr = hptr->next) { if (hptr == theEnvironment) { if (prev == NULL) { EnvironmentHashTable[hashValue] = hptr->next; return(TRUE); } else { prev->next = hptr->next; return(TRUE); } } prev = hptr; } return(FALSE); } /**********************************************************/ /* FindEnvironment: Determines if a specified environment */ /* index has an entry in the environment hash table. */ /**********************************************************/ static struct environmentData *FindEnvironment( unsigned long environmentIndex) { struct environmentData *theEnvironment; unsigned long hashValue; hashValue = environmentIndex % SIZE_ENVIRONMENT_HASH; for (theEnvironment = EnvironmentHashTable[hashValue]; theEnvironment != NULL; theEnvironment = theEnvironment->next) { if (theEnvironment->environmentIndex == environmentIndex) { return(theEnvironment); } } return(NULL); } #endif /************************************************************/ /* CreateEnvironment: Creates an environment data structure */ /* and initializes its content to zero/null. */ /************************************************************/ globle void *CreateEnvironment() { return CreateEnvironmentDriver(NULL,NULL,NULL,NULL,NULL); } /**********************************************************/ /* CreateRuntimeEnvironment: Creates an environment data */ /* structure and initializes its content to zero/null. */ /**********************************************************/ globle void *CreateRuntimeEnvironment( struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable) { return CreateEnvironmentDriver(symbolTable,floatTable,integerTable,bitmapTable,NULL); } /*********************************************************/ /* CreateEnvironmentDriver: Creates an environment data */ /* structure and initializes its content to zero/null. */ /*********************************************************/ globle void *CreateEnvironmentDriver( struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable, struct externalAddressHashNode **externalAddressTable) { struct environmentData *theEnvironment; void *theData; theEnvironment = (struct environmentData *) malloc(sizeof(struct environmentData)); if (theEnvironment == NULL) { printf("\n[ENVRNMNT5] Unable to create new environment.\n"); return(NULL); } theData = malloc(sizeof(void *) * MAXIMUM_ENVIRONMENT_POSITIONS); if (theData == NULL) { free(theEnvironment); printf("\n[ENVRNMNT6] Unable to create environment data.\n"); return(NULL); } memset(theData,0,sizeof(void *) * MAXIMUM_ENVIRONMENT_POSITIONS); theEnvironment->initialized = FALSE; theEnvironment->theData = (void **) theData; theEnvironment->next = NULL; theEnvironment->listOfCleanupEnvironmentFunctions = NULL; #if ALLOW_ENVIRONMENT_GLOBALS theEnvironment->environmentIndex = NextEnvironmentIndex++; #else theEnvironment->environmentIndex = 0; #endif theEnvironment->context = NULL; theEnvironment->routerContext = NULL; theEnvironment->functionContext = NULL; theEnvironment->callbackContext = NULL; /*=============================================*/ /* Allocate storage for the cleanup functions. */ /*=============================================*/ theData = malloc(sizeof(void (*)(struct environmentData *)) * MAXIMUM_ENVIRONMENT_POSITIONS); if (theData == NULL) { free(theEnvironment->theData); free(theEnvironment); printf("\n[ENVRNMNT7] Unable to create environment data.\n"); return(NULL); } memset(theData,0,sizeof(void (*)(struct environmentData *)) * MAXIMUM_ENVIRONMENT_POSITIONS); theEnvironment->cleanupFunctions = (void (**)(void *))theData; #if ALLOW_ENVIRONMENT_GLOBALS AddHashedEnvironment(theEnvironment); CurrentEnvironment = theEnvironment; #endif EnvInitializeEnvironment(theEnvironment,symbolTable,floatTable,integerTable,bitmapTable,externalAddressTable); return(theEnvironment); } #if ALLOW_ENVIRONMENT_GLOBALS /*******************************************/ /* SetCurrentEnvironment: Sets the current */ /* environment to the one specified. */ /*******************************************/ globle void SetCurrentEnvironment( void *theEnvironment) { CurrentEnvironment = (struct environmentData *) theEnvironment; } /**************************************************/ /* SetCurrentEnvironmentByIndex: Sets the current */ /* environment to the one having the specified */ /* environment index. */ /**************************************************/ globle intBool SetCurrentEnvironmentByIndex( unsigned long environmentIndex) { struct environmentData *theEnvironment; theEnvironment = FindEnvironment(environmentIndex); if (theEnvironment == NULL) { return(FALSE); } SetCurrentEnvironment(theEnvironment); return(TRUE); } /**************************************************/ /* GetEnvironmentByIndex: Returns the environment */ /* having the specified environment index. */ /**************************************************/ globle void *GetEnvironmentByIndex( unsigned long environmentIndex) { struct environmentData *theEnvironment; theEnvironment = FindEnvironment(environmentIndex); return(theEnvironment); } /********************************************/ /* GetCurrentEnvironment: Returns a pointer */ /* to the current environment. */ /********************************************/ globle void *GetCurrentEnvironment() { return(CurrentEnvironment); } /******************************************/ /* GetEnvironmentIndex: Returns the index */ /* of the specified environment. */ /******************************************/ globle unsigned long GetEnvironmentIndex( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->environmentIndex); } #endif /**********************************************/ /* GetEnvironmentContext: Returns the context */ /* of the specified environment. */ /**********************************************/ globle void *GetEnvironmentContext( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->context); } /*******************************************/ /* SetEnvironmentContext: Sets the context */ /* of the specified environment. */ /*******************************************/ globle void *SetEnvironmentContext( void *theEnvironment, void *theContext) { void *oldContext; oldContext = ((struct environmentData *) theEnvironment)->context; ((struct environmentData *) theEnvironment)->context = theContext; return oldContext; } /***************************************************/ /* GetEnvironmentRouterContext: Returns the router */ /* context of the specified environment. */ /***************************************************/ globle void *GetEnvironmentRouterContext( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->routerContext); } /************************************************/ /* SetEnvironmentRouterContext: Sets the router */ /* context of the specified environment. */ /************************************************/ globle void *SetEnvironmentRouterContext( void *theEnvironment, void *theRouterContext) { void *oldRouterContext; oldRouterContext = ((struct environmentData *) theEnvironment)->routerContext; ((struct environmentData *) theEnvironment)->routerContext = theRouterContext; return oldRouterContext; } /*******************************************************/ /* GetEnvironmentFunctionContext: Returns the function */ /* context of the specified environment. */ /*******************************************************/ globle void *GetEnvironmentFunctionContext( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->functionContext); } /**************************************************/ /* SetEnvironmentFunctionContext: Sets the router */ /* context of the specified environment. */ /**************************************************/ globle void *SetEnvironmentFunctionContext( void *theEnvironment, void *theFunctionContext) { void *oldFunctionContext; oldFunctionContext = ((struct environmentData *) theEnvironment)->functionContext; ((struct environmentData *) theEnvironment)->functionContext = theFunctionContext; return oldFunctionContext; } /*******************************************************/ /* GetEnvironmentCallbackContext: Returns the callback */ /* context of the specified environment. */ /*******************************************************/ globle void *GetEnvironmentCallbackContext( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->callbackContext); } /****************************************************/ /* SetEnvironmentCallbackContext: Sets the callback */ /* context of the specified environment. */ /****************************************************/ globle void *SetEnvironmentCallbackContext( void *theEnvironment, void *theCallbackContext) { void *oldCallbackContext; oldCallbackContext = ((struct environmentData *) theEnvironment)->callbackContext; ((struct environmentData *) theEnvironment)->callbackContext = theCallbackContext; return oldCallbackContext; } /**********************************************/ /* DestroyEnvironment: Destroys the specified */ /* environment returning all of its memory. */ /**********************************************/ globle intBool DestroyEnvironment( void *vtheEnvironment) { struct environmentCleanupFunction *cleanupPtr; int i; struct memoryData *theMemData; intBool rv = TRUE; struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment; /* if (EvaluationData(theEnvironment)->CurrentExpression != NULL) { return(FALSE); } #if DEFRULE_CONSTRUCT if (EngineData(theEnvironment)->ExecutingRule != NULL) { return(FALSE); } #endif */ theMemData = MemoryData(theEnvironment); EnvReleaseMem(theEnvironment,-1); for (i = 0; i < MAXIMUM_ENVIRONMENT_POSITIONS; i++) { if (theEnvironment->cleanupFunctions[i] != NULL) { (*theEnvironment->cleanupFunctions[i])(theEnvironment); } } free(theEnvironment->cleanupFunctions); for (cleanupPtr = theEnvironment->listOfCleanupEnvironmentFunctions; cleanupPtr != NULL; cleanupPtr = cleanupPtr->next) { (*cleanupPtr->func)(theEnvironment); } RemoveEnvironmentCleanupFunctions(theEnvironment); EnvReleaseMem(theEnvironment,-1); #if ALLOW_ENVIRONMENT_GLOBALS RemoveHashedEnvironment(theEnvironment); #endif if ((theMemData->MemoryAmount != 0) || (theMemData->MemoryCalls != 0)) { printf("\n[ENVRNMNT8] Environment data not fully deallocated.\n"); printf("\n[ENVRNMNT8] MemoryAmount = %ld.\n",(long) theMemData->MemoryAmount); printf("\n[ENVRNMNT8] MemoryCalls = %ld.\n",(long) theMemData->MemoryCalls); rv = FALSE; } #if (MEM_TABLE_SIZE > 0) free(theMemData->MemoryTable); #endif for (i = 0; i < MAXIMUM_ENVIRONMENT_POSITIONS; i++) { if (theEnvironment->theData[i] != NULL) { free(theEnvironment->theData[i]); theEnvironment->theData[i] = NULL; } } free(theEnvironment->theData); #if ALLOW_ENVIRONMENT_GLOBALS if (CurrentEnvironment == theEnvironment) { CurrentEnvironment = NULL; } #endif free(theEnvironment); return(rv); } /**************************************************/ /* AddEnvironmentCleanupFunction: Adds a function */ /* to the ListOfCleanupEnvironmentFunctions. */ /**************************************************/ globle intBool AddEnvironmentCleanupFunction( void *vtheEnv, const char *name, void (*functionPtr)(void *), int priority) { struct environmentCleanupFunction *newPtr, *currentPtr, *lastPtr = NULL; struct environmentData *theEnv = (struct environmentData *) vtheEnv; newPtr = (struct environmentCleanupFunction *) malloc(sizeof(struct environmentCleanupFunction)); if (newPtr == NULL) { return(FALSE); } newPtr->name = name; newPtr->func = functionPtr; newPtr->priority = priority; if (theEnv->listOfCleanupEnvironmentFunctions == NULL) { newPtr->next = NULL; theEnv->listOfCleanupEnvironmentFunctions = newPtr; return(TRUE); } currentPtr = theEnv->listOfCleanupEnvironmentFunctions; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = theEnv->listOfCleanupEnvironmentFunctions; theEnv->listOfCleanupEnvironmentFunctions = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(TRUE); } /**************************************************/ /* RemoveEnvironmentCleanupFunctions: Removes the */ /* list of environment cleanup functions. */ /**************************************************/ static void RemoveEnvironmentCleanupFunctions( struct environmentData *theEnv) { struct environmentCleanupFunction *nextPtr; while (theEnv->listOfCleanupEnvironmentFunctions != NULL) { nextPtr = theEnv->listOfCleanupEnvironmentFunctions->next; free(theEnv->listOfCleanupEnvironmentFunctions); theEnv->listOfCleanupEnvironmentFunctions = nextPtr; } } clips_core_source_630/core/defins.c0000755000175000017500000010722012464554105015655 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* DEFINSTANCES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Kernel definstances interface commands */ /* and routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFINSTANCES_CONSTRUCT #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "dfinsbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dfinscmp.h" #endif #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "cstrccom.h" #include "cstrcpsr.h" #include "constant.h" #include "constrct.h" #include "envrnmnt.h" #include "evaluatn.h" #include "extnfunc.h" #include "insfun.h" #include "inspsr.h" #include "memalloc.h" #include "modulpsr.h" #include "router.h" #include "scanner.h" #include "symbol.h" #include "utility.h" #define _DEFINS_SOURCE_ #include "defins.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define ACTIVE_RLN "active" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) static int ParseDefinstances(void *,const char *); static SYMBOL_HN *ParseDefinstancesName(void *,const char *,int *); static void RemoveDefinstances(void *,void *); static void SaveDefinstances(void *,void *,const char *); static intBool RemoveAllDefinstances(void *); static void DefinstancesDeleteError(void *,const char *); #if DEFRULE_CONSTRUCT static void CreateInitialDefinstances(void *); #endif #endif #if ! RUN_TIME static void *AllocateModule(void *); static void ReturnModule(void *,void *); static intBool ClearDefinstancesReady(void *); static void CheckDefinstancesBusy(void *,struct constructHeader *,void *); static void DestroyDefinstancesAction(void *,struct constructHeader *,void *); #endif static void ResetDefinstances(void *); static void ResetDefinstancesAction(void *,struct constructHeader *,void *); static void DeallocateDefinstancesData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDefinstances DESCRIPTION : Adds the definstance support routines to the Kernel INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Appropriate function lists modified NOTES : None ***************************************************/ globle void SetupDefinstances( void *theEnv) { AllocateEnvironmentData(theEnv,DEFINSTANCES_DATA,sizeof(struct definstancesData),DeallocateDefinstancesData); DefinstancesData(theEnv)->DefinstancesModuleIndex = RegisterModuleItem(theEnv,"definstances", #if (! RUN_TIME) AllocateModule,ReturnModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefinstancesModuleRef, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefinstancesCModuleReference, #else NULL, #endif EnvFindDefinstancesInModule); DefinstancesData(theEnv)->DefinstancesConstruct = AddConstruct(theEnv,"definstances","definstances", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDefinstances, #else NULL, #endif EnvFindDefinstances, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefinstances,SetNextConstruct, EnvIsDefinstancesDeletable,EnvUndefinstances, #if (! BLOAD_ONLY) && (! RUN_TIME) RemoveDefinstances #else NULL #endif ); #if ! RUN_TIME AddClearReadyFunction(theEnv,"definstances",ClearDefinstancesReady,0); #if ! BLOAD_ONLY EnvDefineFunction2(theEnv,"undefinstances",'v',PTIEF UndefinstancesCommand,"UndefinstancesCommand","11w"); AddSaveFunction(theEnv,"definstances",SaveDefinstances,0); #if DEFRULE_CONSTRUCT EnvAddClearFunction(theEnv,"definstances",CreateInitialDefinstances,-1000); #endif #endif #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"ppdefinstances",'v',PTIEF PPDefinstancesCommand ,"PPDefinstancesCommand","11w"); EnvDefineFunction2(theEnv,"list-definstances",'v',PTIEF ListDefinstancesCommand,"ListDefinstancesCommand","01"); #endif EnvDefineFunction2(theEnv,"get-definstances-list",'m',PTIEF GetDefinstancesListFunction, "GetDefinstancesListFunction","01"); EnvDefineFunction2(theEnv,"definstances-module",'w',PTIEF GetDefinstancesModuleCommand, "GetDefinstancesModuleCommand","11w"); #endif EnvAddResetFunction(theEnv,"definstances",(void (*)(void *)) ResetDefinstances,0); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE SetupDefinstancesBload(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) SetupDefinstancesCompiler(theEnv); #endif } /*******************************************************/ /* DeallocateDefinstancesData: Deallocates environment */ /* data for the definstances construct. */ /*******************************************************/ static void DeallocateDefinstancesData( void *theEnv) { #if ! RUN_TIME struct definstancesModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct definstancesModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefinstancesData(theEnv)->DefinstancesModuleIndex); rtn_struct(theEnv,definstancesModule,theModuleItem); } #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /*****************************************************/ /* DestroyDefinstancesAction: Action used to remove */ /* definstances as a result of DestroyEnvironment. */ /*****************************************************/ static void DestroyDefinstancesAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct definstances *theDefinstances = (struct definstances *) theConstruct; if (theDefinstances == NULL) return; ReturnPackedExpression(theEnv,theDefinstances->mkinstance); DestroyConstructHeader(theEnv,&theDefinstances->header); rtn_struct(theEnv,definstances,theDefinstances); #else #if MAC_XCD #pragma unused(theConstruct,theEnv) #endif #endif } #endif /*********************************************************** NAME : EnvGetNextDefinstances DESCRIPTION : Finds first or next definstances INPUTS : The address of the current definstances RETURNS : The address of the next definstances (NULL if none) SIDE EFFECTS : None NOTES : If ptr == NULL, the first definstances is returned. ***********************************************************/ globle void *EnvGetNextDefinstances( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr, DefinstancesData(theEnv)->DefinstancesModuleIndex)); } /*************************************************** NAME : EnvFindDefinstances DESCRIPTION : Looks up a definstance construct by name-string INPUTS : The symbolic name RETURNS : The definstance address, or NULL if not found SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDefinstances( void *theEnv, const char *name) { return(FindNamedConstructInModuleOrImports(theEnv,name,DefinstancesData(theEnv)->DefinstancesConstruct)); } /*************************************************** NAME : EnvFindDefinstancesInModule DESCRIPTION : Looks up a definstance construct by name-string INPUTS : The symbolic name RETURNS : The definstance address, or NULL if not found SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDefinstancesInModule( void *theEnv, const char *name) { return(FindNamedConstructInModule(theEnv,name,DefinstancesData(theEnv)->DefinstancesConstruct)); } /*************************************************** NAME : EnvIsDefinstancesDeletable DESCRIPTION : Determines if a definstances can be deleted INPUTS : Address of the definstances RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefinstancesDeletable( void *theEnv, void *ptr) { if (! ConstructsDeletable(theEnv)) { return FALSE; } return((((DEFINSTANCES *) ptr)->busy == 0) ? TRUE : FALSE); } /*********************************************************** NAME : UndefinstancesCommand DESCRIPTION : Removes a definstance INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Definstance deallocated NOTES : H/L Syntax : (undefinstances | *) ***********************************************************/ globle void UndefinstancesCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefinstances",DefinstancesData(theEnv)->DefinstancesConstruct); } /***************************************************************** NAME : GetDefinstancesModuleCommand DESCRIPTION : Determines to which module a definstances belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (definstances-module ) *****************************************************************/ globle void *GetDefinstancesModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"definstances-module",DefinstancesData(theEnv)->DefinstancesConstruct)); } /*********************************************************** NAME : EnvUndefinstances DESCRIPTION : Removes a definstance INPUTS : Address of definstances to remove RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Definstance deallocated NOTES : None ***********************************************************/ globle intBool EnvUndefinstances( void *theEnv, void *vptr) { #if RUN_TIME || BLOAD_ONLY #if MAC_XCD #pragma unused(theEnv,vptr) #endif return(FALSE); #else DEFINSTANCES *dptr; dptr = (DEFINSTANCES *) vptr; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif if (dptr == NULL) return(RemoveAllDefinstances(theEnv)); if (EnvIsDefinstancesDeletable(theEnv,vptr) == FALSE) return(FALSE); RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr); RemoveDefinstances(theEnv,(void *) dptr); return(TRUE); #endif } #if DEBUGGING_FUNCTIONS /*************************************************************** NAME : PPDefinstancesCommand DESCRIPTION : Prints out the pretty-print form of a definstance INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (ppdefinstances ) ***************************************************************/ globle void PPDefinstancesCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefinstances",DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************** NAME : ListDefinstancesCommand DESCRIPTION : Displays all definstances names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Definstances name sprinted NOTES : H/L Interface ***************************************************/ globle void ListDefinstancesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-definstances",DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************** NAME : EnvListDefinstances DESCRIPTION : Displays all definstances names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Definstances names printed NOTES : C Interface ***************************************************/ globle void EnvListDefinstances( void *theEnv, const char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DefinstancesData(theEnv)->DefinstancesConstruct,logicalName,theModule); } #endif /**************************************************************** NAME : GetDefinstancesListFunction DESCRIPTION : Groups all definstances names into a multifield list INPUTS : A data object buffer to hold the multifield result RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : H/L Syntax: (get-definstances-list []) ****************************************************************/ globle void GetDefinstancesListFunction( void *theEnv, DATA_OBJECT*returnValue) { GetConstructListFunction(theEnv,"get-definstances-list",returnValue,DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************************** NAME : EnvGetDefinstancesList DESCRIPTION : Groups all definstances names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain definstances RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDefinstancesList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DefinstancesData(theEnv)->DefinstancesConstruct,theModule); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) /********************************************************************* NAME : ParseDefinstances DESCRIPTION : Parses and allocates a definstances construct INPUTS : The logical name of the input source RETURNS : FALSE if no errors, TRUE otherwise SIDE EFFECTS : Definstances parsed and created NOTES : H/L Syntax : (definstances [active] [] +) ::= ( of *) ::= ( *) *********************************************************************/ static int ParseDefinstances( void *theEnv, const char *readSource) { SYMBOL_HN *dname; void *mkinsfcall; EXPRESSION *mkinstance,*mkbot = NULL; DEFINSTANCES *dobj; int active; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(definstances "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"definstances"); return(TRUE); } #endif dname = ParseDefinstancesName(theEnv,readSource,&active); if (dname == NULL) return(TRUE); dobj = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) dobj,dname); dobj->busy = 0; dobj->mkinstance = NULL; #if DEFRULE_CONSTRUCT if (active) mkinsfcall = (void *) FindFunction(theEnv,"active-make-instance"); else mkinsfcall = (void *) FindFunction(theEnv,"make-instance"); #else mkinsfcall = (void *) FindFunction(theEnv,"make-instance"); #endif while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall); mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource); if (mkinstance == NULL) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(TRUE); } if (ExpressionContainsVariables(mkinstance,FALSE) == TRUE) { LocalVariableErrorMessage(theEnv,"definstances"); ReturnExpression(theEnv,mkinstance); ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(TRUE); } if (mkbot == NULL) dobj->mkinstance = mkinstance; else GetNextArgument(mkbot) = mkinstance; mkbot = mkinstance; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); SyntaxErrorMessage(theEnv,"definstances"); return(TRUE); } else { if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(FALSE); } #if DEBUGGING_FUNCTIONS if (EnvGetConserveMemory(theEnv) == FALSE) { if (dobj->mkinstance != NULL) PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")\n"); EnvSetDefinstancesPPForm(theEnv,(void *) dobj,CopyPPBuffer(theEnv)); } #endif mkinstance = dobj->mkinstance; dobj->mkinstance = PackExpression(theEnv,mkinstance); ReturnExpression(theEnv,mkinstance); IncrementSymbolCount(EnvGetDefinstancesNamePointer(theEnv,(void *) dobj)); ExpressionInstall(theEnv,dobj->mkinstance); } AddConstructToModule((struct constructHeader *) dobj); return(FALSE); } /************************************************************* NAME : ParseDefinstancesName DESCRIPTION : Parses definstance name and optional comment and optional "active" keyword INPUTS : 1) The logical name of the input source 2) Buffer to hold flag indicating if definstances should cause pattern-matching to occur during slot-overrides RETURNS : Address of name symbol, or NULL if there was an error SIDE EFFECTS : Token after name or comment is scanned NOTES : Assumes "(definstances" has already been scanned. *************************************************************/ static SYMBOL_HN *ParseDefinstancesName( void *theEnv, const char *readSource, int *active) { SYMBOL_HN *dname; *active = FALSE; dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"definstances", EnvFindDefinstancesInModule,EnvUndefinstances,"@", TRUE,FALSE,TRUE,FALSE); if (dname == NULL) return(NULL); #if DEFRULE_CONSTRUCT if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE : (strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); *active = TRUE; } #endif if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } return(dname); } /************************************************************** NAME : RemoveDefinstances DESCRIPTION : Deallocates and removes a definstance construct INPUTS : The definstance address RETURNS : Nothing useful SIDE EFFECTS : Existing definstance construct deleted NOTES : Assumes busy count of definstance is 0 **************************************************************/ static void RemoveDefinstances( void *theEnv, void *vdptr) { DEFINSTANCES *dptr = (DEFINSTANCES *) vdptr; DecrementSymbolCount(theEnv,EnvGetDefinstancesNamePointer(theEnv,(void *) dptr)); ExpressionDeinstall(theEnv,dptr->mkinstance); ReturnPackedExpression(theEnv,dptr->mkinstance); EnvSetDefinstancesPPForm(theEnv,(void *) dptr,NULL); ClearUserDataList(theEnv,dptr->header.usrData); rtn_struct(theEnv,definstances,dptr); } /*************************************************** NAME : SaveDefinstances DESCRIPTION : Prints pretty print form of definstances to specified output INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void SaveDefinstances( void *theEnv, void *theModule, const char *logName) { SaveConstruct(theEnv,theModule,logName,DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************** NAME : RemoveAllDefinstances DESCRIPTION : Removes all definstances constructs INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : All definstances deallocated NOTES : None ***************************************************/ static intBool RemoveAllDefinstances( void *theEnv) { DEFINSTANCES *dptr,*dhead; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL); while (dhead != NULL) { dptr = dhead; dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,(void *) dhead); if (EnvIsDefinstancesDeletable(theEnv,(void *) dptr)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDefinstances(theEnv,(void *) dptr); } else { DefinstancesDeleteError(theEnv,EnvGetDefinstancesName(theEnv,(void *) dptr)); success = FALSE; } } return(success); } /*************************************************** NAME : DefinstancesDeleteError DESCRIPTION : Prints an error message for unsuccessful definstances deletion attempts INPUTS : The name of the definstances RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ static void DefinstancesDeleteError( void *theEnv, const char *dname) { CantDeleteItemErrorMessage(theEnv,"definstances",dname); } #if DEFRULE_CONSTRUCT /******************************************************** NAME : CreateInitialDefinstances DESCRIPTION : Makes the initial-object definstances structure for creating an initial-object which will match default object patterns in defrules INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : initial-object definstances created NOTES : None ********************************************************/ static void CreateInitialDefinstances( void *theEnv) { EXPRESSION *tmp; DEFINSTANCES *theDefinstances; theDefinstances = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) theDefinstances, DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); theDefinstances->busy = 0; tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); tmp->argList->nextArg = GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)); theDefinstances->mkinstance = PackExpression(theEnv,tmp); ReturnExpression(theEnv,tmp); IncrementSymbolCount(EnvGetDefinstancesNamePointer(theEnv,(void *) theDefinstances)); ExpressionInstall(theEnv,theDefinstances->mkinstance); AddConstructToModule((struct constructHeader *) theDefinstances); } #endif #endif #if ! RUN_TIME /***************************************************** NAME : AllocateModule DESCRIPTION : Creates and initializes a list of definstances for a new module INPUTS : None RETURNS : The new definstances module SIDE EFFECTS : Definstances module created NOTES : None *****************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,definstancesModule)); } /*************************************************** NAME : ReturnModule DESCRIPTION : Removes a definstances module and all associated definstances INPUTS : The definstances module RETURNS : Nothing useful SIDE EFFECTS : Module and definstances deleted NOTES : None ***************************************************/ static void ReturnModule( void *theEnv, void *theItem) { #if (! BLOAD_ONLY) FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefinstancesData(theEnv)->DefinstancesConstruct); #endif rtn_struct(theEnv,definstancesModule,theItem); } /*************************************************** NAME : ClearDefinstancesReady DESCRIPTION : Determines if it is safe to remove all definstances Assumes *all* constructs will be deleted INPUTS : None RETURNS : TRUE if all definstances can be deleted, FALSE otherwise SIDE EFFECTS : None NOTES : Used by (clear) and (bload) ***************************************************/ static intBool ClearDefinstancesReady( void *theEnv) { int flagBuffer = TRUE; DoForAllConstructs(theEnv,CheckDefinstancesBusy,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,(void *) &flagBuffer); return(flagBuffer); } /*************************************************** NAME : CheckDefinstancesBusy DESCRIPTION : Determines if a definstances is in use or not INPUTS : 1) The definstances 2) A buffer to set to 0 if the the definstances is busy RETURNS : Nothing useful SIDE EFFECTS : Buffer set to 0 if definstances busy NOTES : The flag buffer is not modified if definstances is not busy (assumed to be initialized to 1) ***************************************************/ static void CheckDefinstancesBusy( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { #if MAC_XCD #pragma unused(theEnv) #endif if (((DEFINSTANCES *) theDefinstances)->busy > 0) * (int *) userBuffer = FALSE; } #endif /*************************************************** NAME : ResetDefinstances DESCRIPTION : Calls EvaluateExpression for each of the make-instance calls in all of the definstances constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : All instances in the definstances are evaluated (and created if there are no errors) Any previously existing instances are deleted first. NOTES : None ***************************************************/ static void ResetDefinstances( void *theEnv) { DoForAllConstructs(theEnv,ResetDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,TRUE,NULL); } /*************************************************** NAME : ResetDefinstancesAction DESCRIPTION : Performs all the make-instance calls in a definstances INPUTS : 1) The definstances 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Instances created NOTES : None ***************************************************/ static void ResetDefinstancesAction( void *theEnv, struct constructHeader *vDefinstances, void *userBuffer) { #if MAC_XCD #pragma unused(userBuffer) #endif DEFINSTANCES *theDefinstances = (DEFINSTANCES *) vDefinstances; EXPRESSION *theExp; DATA_OBJECT temp; SaveCurrentModule(theEnv); EnvSetCurrentModule(theEnv,(void *) vDefinstances->whichModule->theModule); theDefinstances->busy++; for (theExp = theDefinstances->mkinstance ; theExp != NULL ; theExp = GetNextArgument(theExp)) { EvaluateExpression(theEnv,theExp,&temp); if (EvaluationData(theEnv)->HaltExecution || ((GetType(temp) == SYMBOL) && (GetValue(temp) == EnvFalseSymbol(theEnv)))) { RestoreCurrentModule(theEnv); theDefinstances->busy--; return; } } theDefinstances->busy--; RestoreCurrentModule(theEnv); } /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvGetDefinstancesName( void *theEnv, void *theDefinstances) { return GetConstructNameString((struct constructHeader *) theDefinstances); } globle const char *EnvGetDefinstancesPPForm( void *theEnv, void *theDefinstances) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDefinstances); } globle void EnvSetDefinstancesPPForm( void *theEnv, void *theDefinstances, const char *thePPForm) { SetConstructPPForm(theEnv,(struct constructHeader *) theDefinstances,thePPForm); } globle const char *EnvDefinstancesModule( void *theEnv, void *theDefinstances) { return GetConstructModuleName((struct constructHeader *) theDefinstances); } globle SYMBOL_HN *EnvGetDefinstancesNamePointer( void *theEnv, void *theDefinstances) { return GetConstructNamePointer((struct constructHeader *) theDefinstances); } globle const char *EnvDefinstancesModuleName( void *theEnv, void *theDefinstances) { return GetConstructModuleName((struct constructHeader *) theDefinstances); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle const char *DefinstancesModule( void *theDefinstances) { return EnvDefinstancesModule(GetCurrentEnvironment(),theDefinstances); } globle void *FindDefinstances( const char *name) { return EnvFindDefinstances(GetCurrentEnvironment(),name); } globle void GetDefinstancesList( DATA_OBJECT *returnValue, struct defmodule *theModule) { EnvGetDefinstancesList(GetCurrentEnvironment(),returnValue,theModule); } globle const char *GetDefinstancesName( void *theDefinstances) { return EnvGetDefinstancesName(GetCurrentEnvironment(),theDefinstances); } globle const char *GetDefinstancesPPForm( void *theDefinstances) { return EnvGetDefinstancesPPForm(GetCurrentEnvironment(),theDefinstances); } globle void *GetNextDefinstances( void *ptr) { return EnvGetNextDefinstances(GetCurrentEnvironment(),ptr); } globle int IsDefinstancesDeletable( void *ptr) { return EnvIsDefinstancesDeletable(GetCurrentEnvironment(),ptr); } globle intBool Undefinstances( void *vptr) { return EnvUndefinstances(GetCurrentEnvironment(),vptr); } #if DEBUGGING_FUNCTIONS globle void ListDefinstances( const char *logicalName, struct defmodule *theModule) { EnvListDefinstances(GetCurrentEnvironment(),logicalName,theModule); } #endif #endif #endif clips_core_source_630/core/extnfunc.h0000755000175000017500000001422112373737770016254 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXTERNAL FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for adding new user or system defined */ /* functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for passing context information */ /* to user defined functions. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Replaced ALLOW_ENVIRONMENT_GLOBALS macros */ /* with functions. */ /* */ /*************************************************************/ #ifndef _H_extnfunc #define _H_extnfunc #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #include "userdata.h" struct FunctionDefinition { struct symbolHashNode *callFunctionName; const char *actualFunctionName; char returnValueType; int (*functionPointer)(void); struct expr *(*parser)(void *,struct expr *,const char *); const char *restrictions; short int overloadable; short int sequenceuseok; short int environmentAware; short int bsaveIndex; struct FunctionDefinition *next; struct userData *usrData; void *context; }; #define ValueFunctionType(target) (((struct FunctionDefinition *) target)->returnValueType) #define ExpressionFunctionType(target) (((struct FunctionDefinition *) ((target)->value))->returnValueType) #define ExpressionFunctionPointer(target) (((struct FunctionDefinition *) ((target)->value))->functionPointer) #define ExpressionFunctionCallName(target) (((struct FunctionDefinition *) ((target)->value))->callFunctionName) #define ExpressionFunctionRealName(target) (((struct FunctionDefinition *) ((target)->value))->actualFunctionName) #define PTIF (int (*)(void)) #define PTIEF (int (*)(void *)) /*==================*/ /* ENVIRONMENT DATA */ /*==================*/ #define EXTERNAL_FUNCTION_DATA 50 struct externalFunctionData { struct FunctionDefinition *ListOfFunctions; struct FunctionHash **FunctionHashtable; }; #define ExternalFunctionData(theEnv) ((struct externalFunctionData *) GetEnvironmentData(theEnv,EXTERNAL_FUNCTION_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _EXTNFUNC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifdef LOCALE struct FunctionHash { struct FunctionDefinition *fdPtr; struct FunctionHash *next; }; #define SIZE_FUNCTION_HASH 517 #endif LOCALE void InitializeExternalFunctionData(void *); LOCALE int EnvDefineFunction(void *,const char *,int, int (*)(void *),const char *); LOCALE int EnvDefineFunction2(void *,const char *,int, int (*)(void *),const char *,const char *); LOCALE int EnvDefineFunctionWithContext(void *,const char *,int, int (*)(void *),const char *,void *); LOCALE int EnvDefineFunction2WithContext(void *,const char *,int, int (*)(void *),const char *,const char *,void *); LOCALE int DefineFunction3(void *,const char *,int, int (*)(void *),const char *,const char *,intBool,void *); LOCALE int AddFunctionParser(void *,const char *, struct expr *(*)( void *,struct expr *,const char *)); LOCALE int RemoveFunctionParser(void *,const char *); LOCALE int FuncSeqOvlFlags(void *,const char *,int,int); LOCALE struct FunctionDefinition *GetFunctionList(void *); LOCALE void InstallFunctionList(void *,struct FunctionDefinition *); LOCALE struct FunctionDefinition *FindFunction(void *,const char *); LOCALE int GetNthRestriction(struct FunctionDefinition *,int); LOCALE const char *GetArgumentTypeName(int); LOCALE int UndefineFunction(void *,const char *); LOCALE int GetMinimumArgs(struct FunctionDefinition *); LOCALE int GetMaximumArgs(struct FunctionDefinition *); #if ALLOW_ENVIRONMENT_GLOBALS #if (! RUN_TIME) LOCALE int DefineFunction(const char *,int,int (*)(void),const char *); LOCALE int DefineFunction2(const char *,int,int (*)(void),const char *,const char *); #endif /* (! RUN_TIME) */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_extnfunc */ clips_core_source_630/core/classfun.c0000755000175000017500000012542712500721260016221 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CLASS FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Internal class manipulation routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Used genstrcpy and genstrcat instead of strcpy */ /* and strcat. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_AND_SAVE */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "classcom.h" #include "classini.h" #include "constant.h" #include "constrct.h" #include "cstrccom.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "evaluatn.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "memalloc.h" #include "modulutl.h" #include "msgfun.h" #include "router.h" #include "scanner.h" #include "sysdep.h" #include "utility.h" #define _CLASSFUN_SOURCE_ #include "classfun.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BIG_PRIME 11329 #define CLASS_ID_MAP_CHUNK 30 #define PUT_PREFIX "put-" #define PUT_PREFIX_LENGTH 4 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static unsigned HashSlotName(SYMBOL_HN *); #if (! RUN_TIME) static int NewSlotNameID(void *); static void DeassignClassID(void *,unsigned); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : IncrementDefclassBusyCount DESCRIPTION : Increments use count of defclass INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Busy count incremented NOTES : None ***************************************************/ globle void IncrementDefclassBusyCount( void *theEnv, void *theDefclass) { #if MAC_XCD #pragma unused(theEnv) #endif ((DEFCLASS *) theDefclass)->busy++; } /*************************************************** NAME : DecrementDefclassBusyCount DESCRIPTION : Decrements use count of defclass INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Busy count decremented NOTES : Since use counts are ignored on a clear and defclasses might be deleted already anyway, this is a no-op on a clear ***************************************************/ globle void DecrementDefclassBusyCount( void *theEnv, void *theDefclass) { if (! ConstructData(theEnv)->ClearInProgress) ((DEFCLASS *) theDefclass)->busy--; } /**************************************************** NAME : InstancesPurge DESCRIPTION : Removes all instances INPUTS : None RETURNS : TRUE if all instances deleted, FALSE otherwise SIDE EFFECTS : The instance hash table is cleared NOTES : None ****************************************************/ globle intBool InstancesPurge( void *theEnv) { DestroyAllInstances(theEnv); CleanupInstances(theEnv); return((InstanceData(theEnv)->InstanceList != NULL) ? FALSE : TRUE); } #if ! RUN_TIME /*************************************************** NAME : InitializeClasses DESCRIPTION : Allocates class hash table Initializes class hash table to all NULL addresses Creates system classes INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Hash table initialized NOTES : None ***************************************************/ globle void InitializeClasses( void *theEnv) { register int i; DefclassData(theEnv)->ClassTable = (DEFCLASS **) gm2(theEnv,(int) (sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE)); for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) DefclassData(theEnv)->ClassTable[i] = NULL; DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) gm2(theEnv,(int) (sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE)); for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) DefclassData(theEnv)->SlotNameTable[i] = NULL; } #endif /******************************************************** NAME : FindClassSlot DESCRIPTION : Searches for a named slot in a class INPUTS : 1) The class address 2) The symbolic slot name RETURNS : Address of slot if found, NULL otherwise SIDE EFFECTS : None NOTES : Only looks in class defn, does not examine inheritance paths ********************************************************/ globle SLOT_DESC *FindClassSlot( DEFCLASS *cls, SYMBOL_HN *sname) { long i; for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].slotName->name == sname) return(&cls->slots[i]); } return(NULL); } /*************************************************************** NAME : ClassExistError DESCRIPTION : Prints out error message for non-existent class INPUTS : 1) Name of function having the error 2) The name of the non-existent class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************************/ globle void ClassExistError( void *theEnv, const char *func, const char *cname) { PrintErrorID(theEnv,"CLASSFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find class "); EnvPrintRouter(theEnv,WERROR,cname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /********************************************* NAME : DeleteClassLinks DESCRIPTION : Deallocates a class link list INPUTS : The address of the list RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *********************************************/ globle void DeleteClassLinks( void *theEnv, CLASS_LINK *clink) { CLASS_LINK *ctmp; for (ctmp = clink ; ctmp != NULL ; ctmp = clink) { clink = clink->nxt; rtn_struct(theEnv,classLink,ctmp); } } /****************************************************** NAME : PrintClassName DESCRIPTION : Displays a class's name INPUTS : 1) Logical name of output 2) The class 3) Flag indicating whether to print carriage-return at end RETURNS : Nothing useful SIDE EFFECTS : Class name printed (and module name too if class is not in current module) NOTES : None ******************************************************/ globle void PrintClassName( void *theEnv, const char *logicalName, DEFCLASS *theDefclass, intBool linefeedFlag) { if ((theDefclass->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) && (theDefclass->system == 0)) { EnvPrintRouter(theEnv,logicalName, EnvGetDefmoduleName(theEnv,theDefclass->header.whichModule->theModule)); EnvPrintRouter(theEnv,logicalName,"::"); } EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name)); if (linefeedFlag) EnvPrintRouter(theEnv,logicalName,"\n"); } #if DEBUGGING_FUNCTIONS || ((! BLOAD_ONLY) && (! RUN_TIME)) /*************************************************** NAME : PrintPackedClassLinks DESCRIPTION : Displays the names of classes in a list with a title INPUTS : 1) The logical name of the output 2) Title string 3) List of class links RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void PrintPackedClassLinks( void *theEnv, const char *logicalName, const char *title, PACKED_CLASS_LINKS *plinks) { long i; EnvPrintRouter(theEnv,logicalName,title); for (i = 0 ; i < plinks->classCount ; i++) { EnvPrintRouter(theEnv,logicalName," "); PrintClassName(theEnv,logicalName,plinks->classArray[i],FALSE); } EnvPrintRouter(theEnv,logicalName,"\n"); } #endif #if ! RUN_TIME /******************************************************* NAME : PutClassInTable DESCRIPTION : Inserts a class in the class hash table INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Class inserted NOTES : None *******************************************************/ globle void PutClassInTable( void *theEnv, DEFCLASS *cls) { cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls)); cls->nxtHash = DefclassData(theEnv)->ClassTable[cls->hashTableIndex]; DefclassData(theEnv)->ClassTable[cls->hashTableIndex] = cls; } /********************************************************* NAME : RemoveClassFromTable DESCRIPTION : Removes a class from the class hash table INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Class removed NOTES : None *********************************************************/ globle void RemoveClassFromTable( void *theEnv, DEFCLASS *cls) { DEFCLASS *prvhsh,*hshptr; prvhsh = NULL; hshptr = DefclassData(theEnv)->ClassTable[cls->hashTableIndex]; while (hshptr != cls) { prvhsh = hshptr; hshptr = hshptr->nxtHash; } if (prvhsh == NULL) DefclassData(theEnv)->ClassTable[cls->hashTableIndex] = cls->nxtHash; else prvhsh->nxtHash = cls->nxtHash; } /*************************************************** NAME : AddClassLink DESCRIPTION : Adds a class link from one class to another INPUTS : 1) The packed links in which to insert the new class 2) The subclass pointer 3) Index of where to place the class (-1 to append) RETURNS : Nothing useful SIDE EFFECTS : Link created and attached NOTES : Assumes the pack structure belongs to a class and does not need to be deallocated ***************************************************/ globle void AddClassLink( void *theEnv, PACKED_CLASS_LINKS *src, DEFCLASS *cls, int posn) { PACKED_CLASS_LINKS dst; dst.classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * (src->classCount + 1))); if (posn == -1) { GenCopyMemory(DEFCLASS *,src->classCount,dst.classArray,src->classArray); dst.classArray[src->classCount] = cls; } else { if (posn != 0) GenCopyMemory(DEFCLASS *,posn,dst.classArray,src->classArray); GenCopyMemory(DEFCLASS *,src->classCount - posn, dst.classArray + posn + 1,src->classArray + posn); dst.classArray[posn] = cls; } dst.classCount = (unsigned short) (src->classCount + 1); DeletePackedClassLinks(theEnv,src,FALSE); src->classCount = dst.classCount; src->classArray = dst.classArray; } /*************************************************** NAME : DeleteSubclassLink DESCRIPTION : Removes a class from another class's subclass list INPUTS : 1) The superclass whose subclass list is to be modified 2) The subclass to be removed RETURNS : Nothing useful SIDE EFFECTS : The subclass list is changed NOTES : None ***************************************************/ globle void DeleteSubclassLink( void *theEnv, DEFCLASS *sclass, DEFCLASS *cls) { long deletedIndex; PACKED_CLASS_LINKS *src,dst; src = &sclass->directSubclasses; for (deletedIndex = 0 ; deletedIndex < src->classCount ; deletedIndex++) if (src->classArray[deletedIndex] == cls) break; if (deletedIndex == src->classCount) return; if (src->classCount > 1) { dst.classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * (src->classCount - 1))); if (deletedIndex != 0) GenCopyMemory(DEFCLASS *,deletedIndex,dst.classArray,src->classArray); GenCopyMemory(DEFCLASS *,src->classCount - deletedIndex - 1, dst.classArray + deletedIndex,src->classArray + deletedIndex + 1); } else dst.classArray = NULL; dst.classCount = (unsigned short) (src->classCount - 1); DeletePackedClassLinks(theEnv,src,FALSE); src->classCount = dst.classCount; src->classArray = dst.classArray; } /*************************************************** NAME : DeleteSuperclassLink DESCRIPTION : Removes a class from another class's superclass list INPUTS : 1) The subclass whose superclass list is to be modified 2) The superclass to be removed RETURNS : Nothing useful SIDE EFFECTS : The subclass list is changed NOTES : None ***************************************************/ globle void DeleteSuperclassLink( void *theEnv, DEFCLASS *sclass, DEFCLASS *cls) { long deletedIndex; PACKED_CLASS_LINKS *src,dst; src = &sclass->directSuperclasses; for (deletedIndex = 0 ; deletedIndex < src->classCount ; deletedIndex++) if (src->classArray[deletedIndex] == cls) break; if (deletedIndex == src->classCount) return; if (src->classCount > 1) { dst.classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * (src->classCount - 1))); if (deletedIndex != 0) GenCopyMemory(DEFCLASS *,deletedIndex,dst.classArray,src->classArray); GenCopyMemory(DEFCLASS *,src->classCount - deletedIndex - 1, dst.classArray + deletedIndex,src->classArray + deletedIndex + 1); } else dst.classArray = NULL; dst.classCount = (unsigned short) (src->classCount - 1); DeletePackedClassLinks(theEnv,src,FALSE); src->classCount = dst.classCount; src->classArray = dst.classArray; } /************************************************************** NAME : NewClass DESCRIPTION : Allocates and initalizes a new class structure INPUTS : The symbolic name of the new class RETURNS : The address of the new class SIDE EFFECTS : None NOTES : None **************************************************************/ globle DEFCLASS *NewClass( void *theEnv, SYMBOL_HN *className) { register DEFCLASS *cls; cls = get_struct(theEnv,defclass); InitializeConstructHeader(theEnv,"defclass",(struct constructHeader *) cls,className); cls->id = 0; cls->installed = 0; cls->busy = 0; cls->system = 0; cls->abstract = 0; cls->reactive = 1; #if DEBUGGING_FUNCTIONS cls->traceInstances = DefclassData(theEnv)->WatchInstances; cls->traceSlots = DefclassData(theEnv)->WatchSlots; #endif cls->hashTableIndex = 0; cls->directSuperclasses.classCount = 0; cls->directSuperclasses.classArray = NULL; cls->directSubclasses.classCount = 0; cls->directSubclasses.classArray = NULL; cls->allSuperclasses.classCount = 0; cls->allSuperclasses.classArray = NULL; cls->slots = NULL; cls->instanceTemplate = NULL; cls->slotNameMap = NULL; cls->instanceSlotCount = 0; cls->localInstanceSlotCount = 0; cls->slotCount = 0; cls->maxSlotNameID = 0; cls->handlers = NULL; cls->handlerOrderMap = NULL; cls->handlerCount = 0; cls->instanceList = NULL; cls->instanceListBottom = NULL; cls->nxtHash = NULL; cls->scopeMap = NULL; ClearBitString(cls->traversalRecord,TRAVERSAL_BYTES); return(cls); } /*************************************************** NAME : DeletePackedClassLinks DESCRIPTION : Dealloacates a contiguous array holding class links INPUTS : 1) The class link segment 2) A flag indicating whether to delete the top pack structure RETURNS : Nothing useful SIDE EFFECTS : Class links deallocated NOTES : None ***************************************************/ globle void DeletePackedClassLinks( void *theEnv, PACKED_CLASS_LINKS *plp, int deleteTop) { if (plp->classCount > 0) { rm(theEnv,(void *) plp->classArray,(sizeof(DEFCLASS *) * plp->classCount)); plp->classCount = 0; plp->classArray = NULL; } if (deleteTop) rtn_struct(theEnv,packedClassLinks,plp); } /*************************************************** NAME : AssignClassID DESCRIPTION : Assigns a unique id to a class and puts its address in the id map INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Class id assigned and map set NOTES : None ***************************************************/ globle void AssignClassID( void *theEnv, DEFCLASS *cls) { register unsigned i; if ((DefclassData(theEnv)->MaxClassID % CLASS_ID_MAP_CHUNK) == 0) { DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) genrealloc(theEnv,(void *) DefclassData(theEnv)->ClassIDMap, (unsigned) (DefclassData(theEnv)->MaxClassID * sizeof(DEFCLASS *)), (unsigned) ((DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK) * sizeof(DEFCLASS *))); DefclassData(theEnv)->AvailClassID += (unsigned short) CLASS_ID_MAP_CHUNK; for (i = DefclassData(theEnv)->MaxClassID ; i < (unsigned) (DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK) ; i++) DefclassData(theEnv)->ClassIDMap[i] = NULL; } DefclassData(theEnv)->ClassIDMap[DefclassData(theEnv)->MaxClassID] = cls; cls->id = DefclassData(theEnv)->MaxClassID++; } /********************************************************* NAME : AddSlotName DESCRIPTION : Adds a new slot entry (or increments the use count of an existing node). INPUTS : 1) The slot name 2) The new canonical id for the slot name 3) A flag indicating whether the given id must be used or not RETURNS : The id of the (old) node SIDE EFFECTS : Slot name entry added or use count incremented NOTES : None *********************************************************/ globle SLOT_NAME *AddSlotName( void *theEnv, SYMBOL_HN *slotName, int newid, int usenewid) { SLOT_NAME *snp; unsigned hashTableIndex; char *buf; size_t bufsz; hashTableIndex = HashSlotName(slotName); snp = DefclassData(theEnv)->SlotNameTable[hashTableIndex]; while ((snp != NULL) ? (snp->name != slotName) : FALSE) snp = snp->nxt; if (snp != NULL) { if (usenewid && (newid != snp->id)) { SystemError(theEnv,"CLASSFUN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } snp->use++; } else { snp = get_struct(theEnv,slotName); snp->name = slotName; snp->hashTableIndex = hashTableIndex; snp->use = 1; snp->id = (short) (usenewid ? newid : NewSlotNameID(theEnv)); snp->nxt = DefclassData(theEnv)->SlotNameTable[hashTableIndex]; DefclassData(theEnv)->SlotNameTable[hashTableIndex] = snp; IncrementSymbolCount(slotName); bufsz = (sizeof(char) * (PUT_PREFIX_LENGTH + strlen(ValueToString(slotName)) + 1)); buf = (char *) gm2(theEnv,bufsz); genstrcpy(buf,PUT_PREFIX); genstrcat(buf,ValueToString(slotName)); snp->putHandlerName = (SYMBOL_HN *) EnvAddSymbol(theEnv,buf); IncrementSymbolCount(snp->putHandlerName); rm(theEnv,(void *) buf,bufsz); snp->bsaveIndex = 0L; } return(snp); } /*************************************************** NAME : DeleteSlotName DESCRIPTION : Removes a slot name entry from the table of all slot names if no longer in use INPUTS : The slot name hash node RETURNS : Nothing useful SIDE EFFECTS : Slot name entry deleted or use count decremented NOTES : None ***************************************************/ globle void DeleteSlotName( void *theEnv, SLOT_NAME *slotName) { SLOT_NAME *snp,*prv; if (slotName == NULL) return; prv = NULL; snp = DefclassData(theEnv)->SlotNameTable[slotName->hashTableIndex]; while (snp != slotName) { prv = snp; snp = snp->nxt; } snp->use--; if (snp->use != 0) return; if (prv == NULL) DefclassData(theEnv)->SlotNameTable[snp->hashTableIndex] = snp->nxt; else prv->nxt = snp->nxt; DecrementSymbolCount(theEnv,snp->name); DecrementSymbolCount(theEnv,snp->putHandlerName); rtn_struct(theEnv,slotName,snp); } /******************************************************************* NAME : RemoveDefclass DESCRIPTION : Deallocates a class structure and all its fields - returns all symbols in use by the class back to the symbol manager for ephemeral removal INPUTS : The address of the class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Assumes class has no subclasses IMPORTANT WARNING!! : Assumes class busy count and all instances' busy counts are 0 and all handlers' busy counts are 0! *******************************************************************/ LOCALE void RemoveDefclass( void *theEnv, void *vcls) { DEFCLASS *cls = (DEFCLASS *) vcls; HANDLER *hnd; long i; /* ==================================================== Remove all of this class's superclasses' links to it ==================================================== */ for (i = 0 ; i < cls->directSuperclasses.classCount ; i++) DeleteSubclassLink(theEnv,cls->directSuperclasses.classArray[i],cls); /* ==================================================== Remove all of this class's subclasses' links to it ==================================================== */ for (i = 0 ; i < cls->directSubclasses.classCount ; i++) DeleteSuperclassLink(theEnv,cls->directSubclasses.classArray[i],cls); RemoveClassFromTable(theEnv,cls); InstallClass(theEnv,cls,FALSE); DeletePackedClassLinks(theEnv,&cls->directSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->allSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->directSubclasses,FALSE); for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].defaultValue != NULL) { if (cls->slots[i].dynamicDefault) ReturnPackedExpression(theEnv,(EXPRESSION *) cls->slots[i].defaultValue); else rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); } DeleteSlotName(theEnv,cls->slots[i].slotName); RemoveConstraint(theEnv,cls->slots[i].constraint); } if (cls->instanceSlotCount != 0) { rm(theEnv,(void *) cls->instanceTemplate, (sizeof(SLOT_DESC *) * cls->instanceSlotCount)); rm(theEnv,(void *) cls->slotNameMap, (sizeof(unsigned) * (cls->maxSlotNameID + 1))); } if (cls->slotCount != 0) rm(theEnv,(void *) cls->slots,(sizeof(SLOT_DESC) * cls->slotCount)); for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->actions != NULL) ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm,(sizeof(char) * (strlen(hnd->ppForm)+1))); if (hnd->usrData != NULL) { ClearUserDataList(theEnv,hnd->usrData); } } if (cls->handlerCount != 0) { rm(theEnv,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); } EnvSetDefclassPPForm(theEnv,(void *) cls,NULL); DeassignClassID(theEnv,(unsigned) cls->id); rtn_struct(theEnv,defclass,cls); } #endif /******************************************************************* NAME : DestroyDefclass DESCRIPTION : Deallocates a class structure and all its fields. INPUTS : The address of the class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : *******************************************************************/ LOCALE void DestroyDefclass( void *theEnv, void *vcls) { DEFCLASS *cls = (DEFCLASS *) vcls; long i; #if ! RUN_TIME HANDLER *hnd; DeletePackedClassLinks(theEnv,&cls->directSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->allSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->directSubclasses,FALSE); #endif for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].defaultValue != NULL) { #if ! RUN_TIME if (cls->slots[i].dynamicDefault) ReturnPackedExpression(theEnv,(EXPRESSION *) cls->slots[i].defaultValue); else rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); #else if (cls->slots[i].dynamicDefault == 0) rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); #endif } } #if ! RUN_TIME if (cls->instanceSlotCount != 0) { rm(theEnv,(void *) cls->instanceTemplate, (sizeof(SLOT_DESC *) * cls->instanceSlotCount)); rm(theEnv,(void *) cls->slotNameMap, (sizeof(unsigned) * (cls->maxSlotNameID + 1))); } if (cls->slotCount != 0) rm(theEnv,(void *) cls->slots,(sizeof(SLOT_DESC) * cls->slotCount)); for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->actions != NULL) ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm,(sizeof(char) * (strlen(hnd->ppForm)+1))); if (hnd->usrData != NULL) { ClearUserDataList(theEnv,hnd->usrData); } } if (cls->handlerCount != 0) { rm(theEnv,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); } DestroyConstructHeader(theEnv,&cls->header); rtn_struct(theEnv,defclass,cls); #else #if MAC_XCD #pragma unused(hnd) #endif #endif } #if ! RUN_TIME /*************************************************** NAME : InstallClass DESCRIPTION : In(De)crements all symbol counts for for symbols in use by class Disallows (allows) symbols to become ephemeral. INPUTS : 1) The class address 2) 1 - install, 0 - deinstall RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void InstallClass( void *theEnv, DEFCLASS *cls, int set) { SLOT_DESC *slot; HANDLER *hnd; long i; if ((set && cls->installed) || ((set == FALSE) && (cls->installed == 0))) return; /* ================================================================== Handler installation is handled when message-handlers are defined: see ParseDefmessageHandler() in MSGCOM.C Slot installation is handled by ParseSlot() in CLASSPSR.C Scope map installation is handled by CreateClassScopeMap() ================================================================== */ if (set == FALSE) { cls->installed = 0; DecrementSymbolCount(theEnv,cls->header.name); #if DEFMODULE_CONSTRUCT DecrementBitMapCount(theEnv,cls->scopeMap); #endif ClearUserDataList(theEnv,cls->header.usrData); for (i = 0 ; i < cls->slotCount ; i++) { slot = &cls->slots[i]; DecrementSymbolCount(theEnv,slot->overrideMessage); if (slot->defaultValue != NULL) { if (slot->dynamicDefault) ExpressionDeinstall(theEnv,(EXPRESSION *) slot->defaultValue); else ValueDeinstall(theEnv,(DATA_OBJECT *) slot->defaultValue); } } for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; DecrementSymbolCount(theEnv,hnd->name); if (hnd->actions != NULL) ExpressionDeinstall(theEnv,hnd->actions); } } else { cls->installed = 1; IncrementSymbolCount(cls->header.name); } } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : IsClassBeingUsed DESCRIPTION : Checks the busy flag of a class and ALL classes that inherit from it to make sure that it is not in use before deletion INPUTS : The class RETURNS : TRUE if in use, FALSE otherwise SIDE EFFECTS : None NOTES : Recursively examines all subclasses ***************************************************/ globle int IsClassBeingUsed( DEFCLASS *cls) { long i; if (cls->busy > 0) return(TRUE); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) if (IsClassBeingUsed(cls->directSubclasses.classArray[i])) return(TRUE); return(FALSE); } /*************************************************** NAME : RemoveAllUserClasses DESCRIPTION : Removes all classes INPUTS : None RETURNS : TRUE if succesful, FALSE otherwise SIDE EFFECTS : The class hash table is cleared NOTES : None ***************************************************/ globle int RemoveAllUserClasses( void *theEnv) { void *userClasses,*ctmp; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif /* ==================================================== Don't delete built-in system classes at head of list ==================================================== */ userClasses = EnvGetNextDefclass(theEnv,NULL); while (userClasses != NULL) { if (((DEFCLASS *) userClasses)->system == 0) break; userClasses = EnvGetNextDefclass(theEnv,userClasses); } while (userClasses != NULL) { ctmp = userClasses; userClasses = EnvGetNextDefclass(theEnv,userClasses); if (EnvIsDefclassDeletable(theEnv,ctmp)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) ctmp); RemoveDefclass(theEnv,ctmp); } else { success = FALSE; CantDeleteItemErrorMessage(theEnv,"defclass",EnvGetDefclassName(theEnv,ctmp)); } } return(success); } /**************************************************** NAME : DeleteClassUAG DESCRIPTION : Deallocates a class and all its subclasses INPUTS : The address of the class RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Removes the class from each of its superclasses' subclass lists NOTES : None ****************************************************/ globle int DeleteClassUAG( void *theEnv, DEFCLASS *cls) { long subCount; while (cls->directSubclasses.classCount != 0) { subCount = cls->directSubclasses.classCount; DeleteClassUAG(theEnv,cls->directSubclasses.classArray[0]); if (cls->directSubclasses.classCount == subCount) return(FALSE); } if (EnvIsDefclassDeletable(theEnv,(void *) cls)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) cls); RemoveDefclass(theEnv,(void *) cls); return(TRUE); } return(FALSE); } /********************************************************* NAME : MarkBitMapSubclasses DESCRIPTION : Recursively marks the ids of a class and all its subclasses in a bitmap INPUTS : 1) The bitmap 2) The class 3) A code indicating whether to set or clear the bits of the map corresponding to the class ids RETURNS : Nothing useful SIDE EFFECTS : BitMap marked NOTES : IMPORTANT!!!! Assumes the bitmap is large enough to hold all ids encountered! *********************************************************/ globle void MarkBitMapSubclasses( char *map, DEFCLASS *cls, int set) { long i; if (set) SetBitMap(map,cls->id); else ClearBitMap(map,cls->id); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) MarkBitMapSubclasses(map,cls->directSubclasses.classArray[i],set); } #endif /*************************************************** NAME : FindSlotNameID DESCRIPTION : Finds the id of a slot name INPUTS : The slot name RETURNS : The slot name id (-1 if not found) SIDE EFFECTS : None NOTES : A slot name always has the same id regardless of what class uses it. In this way, a slot can be referred to by index independent of class. Each class stores a map showing which slot name indices go to which slot. This provides for immediate lookup of slots given the index (object pattern matching uses this). ***************************************************/ globle short FindSlotNameID( void *theEnv, SYMBOL_HN *slotName) { SLOT_NAME *snp; snp = DefclassData(theEnv)->SlotNameTable[HashSlotName(slotName)]; while ((snp != NULL) ? (snp->name != slotName) : FALSE) snp = snp->nxt; return((snp != NULL) ? (short) snp->id : (short) -1); } /*************************************************** NAME : FindIDSlotName DESCRIPTION : Finds the slot anme for an id INPUTS : The id RETURNS : The slot name (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle SYMBOL_HN *FindIDSlotName( void *theEnv, int id) { SLOT_NAME *snp; snp = FindIDSlotNameHash(theEnv,id); return((snp != NULL) ? snp->name : NULL); } /*************************************************** NAME : FindIDSlotNameHash DESCRIPTION : Finds the slot anme for an id INPUTS : The id RETURNS : The slot name (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle SLOT_NAME *FindIDSlotNameHash( void *theEnv, int id) { register int i; SLOT_NAME *snp; for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) { snp = DefclassData(theEnv)->SlotNameTable[i]; while (snp != NULL) { if (snp->id == id) return(snp); snp = snp->nxt; } } return(NULL); } /*************************************************** NAME : GetTraversalID DESCRIPTION : Returns a unique integer ID for a traversal into the class hierarchy INPUTS : None RETURNS : The id, or -1 if none available SIDE EFFECTS : EvaluationError set when no ids available NOTES : Used for recursive traversals of class hierarchy to assure that a class is only visited once ***************************************************/ globle int GetTraversalID( void *theEnv) { register unsigned i; register DEFCLASS *cls; if (DefclassData(theEnv)->CTID >= MAX_TRAVERSALS) { PrintErrorID(theEnv,"CLASSFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Maximum number of simultaneous class hierarchy\n traversals exceeded "); PrintLongInteger(theEnv,WERROR,(long) MAX_TRAVERSALS); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(-1); } for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) for (cls = DefclassData(theEnv)->ClassTable[i] ; cls != NULL ; cls = cls->nxtHash) ClearTraversalID(cls->traversalRecord,DefclassData(theEnv)->CTID); return(DefclassData(theEnv)->CTID++); } /*************************************************** NAME : ReleaseTraversalID DESCRIPTION : Releases an ID for future use Also clears id from all classes INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Old ID released for later reuse NOTES : Releases ID returned by most recent call to GetTraversalID() ***************************************************/ globle void ReleaseTraversalID( void *theEnv) { DefclassData(theEnv)->CTID--; } /******************************************************* NAME : HashClass DESCRIPTION : Generates a hash index for a given class name INPUTS : The address of the class name SYMBOL_HN RETURNS : The hash index value SIDE EFFECTS : None NOTES : Counts on the fact that the symbol has already been hashed into the symbol table - uses that hash value multiplied by a prime for a new hash *******************************************************/ globle unsigned HashClass( SYMBOL_HN *cname) { unsigned long tally; tally = ((unsigned long) cname->bucket) * BIG_PRIME; return((unsigned) (tally % CLASS_TABLE_HASH_SIZE)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : HashSlotName DESCRIPTION : Generates a hash index for a given slot name INPUTS : The address of the slot name SYMBOL_HN RETURNS : The hash index value SIDE EFFECTS : None NOTES : Counts on the fact that the symbol has already been hashed into the symbol table - uses that hash value multiplied by a prime for a new hash *******************************************************/ static unsigned HashSlotName( SYMBOL_HN *sname) { unsigned long tally; tally = ((unsigned long) sname->bucket) * BIG_PRIME; return((unsigned) (tally % SLOT_NAME_TABLE_HASH_SIZE)); } #if (! RUN_TIME) /*********************************************** NAME : NewSlotNameID DESCRIPTION : Returns an unused slot name id as close to 1 as possible INPUTS : None RETURNS : The new unused id SIDE EFFECTS : None NOTES : None ***********************************************/ static int NewSlotNameID( void *theEnv) { int newid = 0; register unsigned i; SLOT_NAME *snp; while (TRUE) { for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) { snp = DefclassData(theEnv)->SlotNameTable[i]; while ((snp != NULL) ? (snp->id != newid) : FALSE) snp = snp->nxt; if (snp != NULL) break; } if (i < SLOT_NAME_TABLE_HASH_SIZE) newid++; else break; } return(newid); } /*************************************************** NAME : DeassignClassID DESCRIPTION : Reduces id map and MaxClassID if no ids in use above the one being released. INPUTS : The id RETURNS : Nothing useful SIDE EFFECTS : ID map and MaxClassID possibly reduced NOTES : None ***************************************************/ static void DeassignClassID( void *theEnv, unsigned id) { int i; int reallocReqd; unsigned short oldChunk = 0,newChunk = 0; DefclassData(theEnv)->ClassIDMap[id] = NULL; for (i = id + 1 ; i < DefclassData(theEnv)->MaxClassID ; i++) if (DefclassData(theEnv)->ClassIDMap[i] != NULL) return; reallocReqd = FALSE; while (DefclassData(theEnv)->ClassIDMap[id] == NULL) { DefclassData(theEnv)->MaxClassID = (unsigned short) id; if ((DefclassData(theEnv)->MaxClassID % CLASS_ID_MAP_CHUNK) == 0) { newChunk = DefclassData(theEnv)->MaxClassID; if (reallocReqd == FALSE) { oldChunk = (unsigned short) (DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK); reallocReqd = TRUE; } } if (id == 0) break; id--; } if (reallocReqd) { DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) genrealloc(theEnv,(void *) DefclassData(theEnv)->ClassIDMap, (unsigned) (oldChunk * sizeof(DEFCLASS *)), (unsigned) (newChunk * sizeof(DEFCLASS *))); DefclassData(theEnv)->AvailClassID = newChunk; } } #endif #endif clips_core_source_630/core/._factprt.c0000755000175000017500000000040712373742646016274 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._inscom.c0000755000175000017500000000040712500146515016102 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dfinsbin.h0000755000175000017500000000466712373731173016222 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_dfinsbin #define _H_dfinsbin #if DEFINSTANCES_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #ifndef _H_defins #include "defins.h" #endif #define DFINSBIN_DATA 25 struct definstancesBinaryData { DEFINSTANCES *DefinstancesArray; long DefinstancesCount; long ModuleCount; DEFINSTANCES_MODULE *ModuleArray; }; #define DefinstancesBinaryData(theEnv) ((struct definstancesBinaryData *) GetEnvironmentData(theEnv,DFINSBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFINSBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDefinstancesBload(void *); LOCALE void *BloadDefinstancesModuleRef(void *,int); #endif /* DEFINSTANCES_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) */ #endif /* _H_dfinsbin */ clips_core_source_630/core/factqpsr.h0000644000175000017500000000515312374022553016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Added fact-set queries. */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Fixed memory leaks when error occurred. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_factqpsr #define _H_factqpsr #if FACT_SET_QUERIES && (! RUN_TIME) #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTQPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE EXPRESSION *FactParseQueryNoAction(void *,EXPRESSION *,const char *); LOCALE EXPRESSION *FactParseQueryAction(void *,EXPRESSION *,const char *); #endif /* FACT_SET_QUERIES && (! RUN_TIME) */ #endif /* _H_factqpsr */ clips_core_source_630/core/cstrncmp.c0000755000175000017500000002007012373714216016233 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Added environment parameter to GenClose. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _CSTRNCMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "constant.h" #include "conscomp.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "cstrncmp.h" /***********************************************/ /* ConstraintsToCode: Produces the constraint */ /* record code for a run-time module created */ /* using the constructs-to-c function. */ /***********************************************/ globle int ConstraintsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int i, j, count; int newHeader = TRUE; FILE *fp; int version = 1; int arrayVersion = 1; unsigned short numberOfConstraints = 0; CONSTRAINT_RECORD *tmpPtr; /*===============================================*/ /* Count the total number of constraint records. */ /*===============================================*/ for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { tmpPtr->bsaveIndex = numberOfConstraints++; } } /*=====================================================*/ /* If dynamic constraint checking is disabled, then */ /* contraints won't be saved. If there are constraints */ /* which could be saved, then issue a warning message. */ /*=====================================================*/ if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfConstraints != 0)) { numberOfConstraints = 0; PrintWarningID(theEnv,"CSTRNCMP",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a constructs-to-c image\n"); EnvPrintRouter(theEnv,WWARNING," when dynamic constraint checking is disabled.\n"); } if (numberOfConstraints == 0) return(-1); /*=================================================*/ /* Print the extern definition in the header file. */ /*=================================================*/ for (i = 1; i <= (numberOfConstraints / maxIndices) + 1 ; i++) { fprintf(headerFP,"extern CONSTRAINT_RECORD C%d_%d[];\n",imageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,fileID,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; count = 0; for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { if (newHeader) { fprintf(fp,"CONSTRAINT_RECORD C%d_%d[] = {\n",imageID,arrayVersion); newHeader = FALSE; } fprintf(fp,"{%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d", tmpPtr->anyAllowed, tmpPtr->symbolsAllowed, tmpPtr->stringsAllowed, tmpPtr->floatsAllowed, tmpPtr->integersAllowed, tmpPtr->instanceNamesAllowed, tmpPtr->instanceAddressesAllowed, tmpPtr->externalAddressesAllowed, tmpPtr->factAddressesAllowed, 0, /* void allowed */ tmpPtr->anyRestriction, tmpPtr->symbolRestriction, tmpPtr->stringRestriction, tmpPtr->floatRestriction, tmpPtr->integerRestriction, tmpPtr->classRestriction, tmpPtr->instanceNameRestriction, tmpPtr->multifieldsAllowed, tmpPtr->singlefieldsAllowed); fprintf(fp,",0,"); /* bsaveIndex */ PrintHashedExpressionReference(theEnv,fp,tmpPtr->classList,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->restrictionList,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->minValue,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxValue,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->minFields,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxFields,imageID,maxIndices); /* multifield slot */ fprintf(fp,",NULL"); /* next slot */ if (tmpPtr->next == NULL) { fprintf(fp,",NULL,"); } else { if ((j + 1) >= maxIndices) { fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion + 1,0); } else { fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion,j + 1); } } fprintf(fp,"%d,%d",tmpPtr->bucket,tmpPtr->count + 1); count++; j++; if ((count == numberOfConstraints) || (j >= maxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; version++; arrayVersion++; if (count < numberOfConstraints) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /**********************************************************/ /* PrintConstraintReference: Prints C code representation */ /* of a constraint record data structure reference. */ /**********************************************************/ globle void PrintConstraintReference( void *theEnv, FILE *fp, CONSTRAINT_RECORD *cPtr, int imageID, int maxIndices) { if ((cPtr == NULL) || (! EnvGetDynamicConstraintChecking(theEnv))) { fprintf(fp,"NULL"); } else fprintf(fp,"&C%d_%d[%d]",imageID, (int) (cPtr->bsaveIndex / maxIndices) + 1, (int) cPtr->bsaveIndex % maxIndices); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/._conscomp.h0000755000175000017500000000040712373714242016446 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrnutl.h0000755000175000017500000000040712373714037016505 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulelhs.c0000755000175000017500000000033012365012263016264 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltbsc.c0000755000175000017500000003156712373754241016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE BASIC COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deftemplate */ /* construct such as clear, reset, save, undeftemplate, */ /* ppdeftemplate, list-deftemplates, and */ /* get-deftemplate-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings */ /* when ENVIRONMENT_API_ONLY flag is set. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _TMPLTBSC_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "argacces.h" #include "memalloc.h" #include "scanner.h" #include "router.h" #include "extnfunc.h" #include "constrct.h" #include "cstrccom.h" #include "factrhs.h" #include "cstrcpsr.h" #include "tmpltpsr.h" #include "tmpltdef.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "tmpltbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "tmpltcmp.h" #endif #include "tmpltutl.h" #include "envrnmnt.h" #include "tmpltbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if ! DEFFACTS_CONSTRUCT static void ResetDeftemplates(void *); #endif static void ClearDeftemplates(void *); static void SaveDeftemplates(void *,void *,const char *); /*********************************************************************/ /* DeftemplateBasicCommands: Initializes basic deftemplate commands. */ /*********************************************************************/ globle void DeftemplateBasicCommands( void *theEnv) { #if ! DEFFACTS_CONSTRUCT EnvAddResetFunction(theEnv,"deftemplate",ResetDeftemplates,0); #endif EnvAddClearFunction(theEnv,"deftemplate",ClearDeftemplates,0); AddSaveFunction(theEnv,"deftemplate",SaveDeftemplates,10); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-deftemplate-list",'m',PTIEF GetDeftemplateListFunction,"GetDeftemplateListFunction","01w"); EnvDefineFunction2(theEnv,"undeftemplate",'v',PTIEF UndeftemplateCommand,"UndeftemplateCommand","11w"); EnvDefineFunction2(theEnv,"deftemplate-module",'w',PTIEF DeftemplateModuleFunction,"DeftemplateModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-deftemplates",'v', PTIEF ListDeftemplatesCommand,"ListDeftemplatesCommand","01w"); EnvDefineFunction2(theEnv,"ppdeftemplate",'v',PTIEF PPDeftemplateCommand,"PPDeftemplateCommand","11w"); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DeftemplateBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeftemplateCompilerSetup(theEnv); #endif #endif } /*************************************************************/ /* ResetDeftemplates: Deftemplate reset routine for use with */ /* the reset command. Asserts the initial-fact fact when */ /* the deffacts construct has been disabled. */ /*************************************************************/ #if ! DEFFACTS_CONSTRUCT static void ResetDeftemplates( void *theEnv) { struct fact *factPtr; factPtr = StringToFact(theEnv,"(initial-fact)"); if (factPtr == NULL) return; EnvAssert(theEnv,(void *) factPtr); } #endif /*****************************************************************/ /* ClearDeftemplates: Deftemplate clear routine for use with the */ /* clear command. Creates the initial-facts deftemplate. */ /*****************************************************************/ static void ClearDeftemplates( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /**********************************************/ /* SaveDeftemplates: Deftemplate save routine */ /* for use with the save command. */ /**********************************************/ static void SaveDeftemplates( void *theEnv, void *theModule, const char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DeftemplateData(theEnv)->DeftemplateConstruct); } /**********************************************/ /* UndeftemplateCommand: H/L access routine */ /* for the undeftemplate command. */ /**********************************************/ globle void UndeftemplateCommand( void *theEnv) { UndefconstructCommand(theEnv,"undeftemplate",DeftemplateData(theEnv)->DeftemplateConstruct); } /**************************************/ /* EnvUndeftemplate: C access routine */ /* for the undeftemplate command. */ /**************************************/ globle intBool EnvUndeftemplate( void *theEnv, void *theDeftemplate) { return(Undefconstruct(theEnv,theDeftemplate,DeftemplateData(theEnv)->DeftemplateConstruct)); } /****************************************************/ /* GetDeftemplateListFunction: H/L access routine */ /* for the get-deftemplate-list function. */ /****************************************************/ globle void GetDeftemplateListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-deftemplate-list",returnValue,DeftemplateData(theEnv)->DeftemplateConstruct); } /***********************************************/ /* EnvGetDeftemplateList: C access routine for */ /* the get-deftemplate-list function. */ /***********************************************/ globle void EnvGetDeftemplateList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DeftemplateData(theEnv)->DeftemplateConstruct,(struct defmodule *) theModule); } /***************************************************/ /* DeftemplateModuleFunction: H/L access routine */ /* for the deftemplate-module function. */ /***************************************************/ globle void *DeftemplateModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"deftemplate-module",DeftemplateData(theEnv)->DeftemplateConstruct)); } #if DEBUGGING_FUNCTIONS /**********************************************/ /* PPDeftemplateCommand: H/L access routine */ /* for the ppdeftemplate command. */ /**********************************************/ globle void PPDeftemplateCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdeftemplate",DeftemplateData(theEnv)->DeftemplateConstruct); } /***************************************/ /* PPDeftemplate: C access routine for */ /* the ppdeftemplate command. */ /***************************************/ globle int PPDeftemplate( void *theEnv, const char *deftemplateName, const char *logicalName) { return(PPConstruct(theEnv,deftemplateName,logicalName,DeftemplateData(theEnv)->DeftemplateConstruct)); } /*************************************************/ /* ListDeftemplatesCommand: H/L access routine */ /* for the list-deftemplates command. */ /*************************************************/ globle void ListDeftemplatesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-deftemplates",DeftemplateData(theEnv)->DeftemplateConstruct); } /*****************************************/ /* EnvListDeftemplates: C access routine */ /* for the list-deftemplates command. */ /*****************************************/ globle void EnvListDeftemplates( void *theEnv, const char *logicalName, void *theModule) { ListConstruct(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,logicalName,(struct defmodule *) theModule); } /***********************************************************/ /* EnvGetDeftemplateWatch: C access routine for retrieving */ /* the current watch value of a deftemplate. */ /***********************************************************/ globle unsigned EnvGetDeftemplateWatch( void *theEnv, void *theTemplate) { #if MAC_XCD #pragma unused(theEnv) #endif return(((struct deftemplate *) theTemplate)->watch); } /*********************************************************/ /* EnvSetDeftemplateWatch: C access routine for setting */ /* the current watch value of a deftemplate. */ /*********************************************************/ globle void EnvSetDeftemplateWatch( void *theEnv, unsigned newState, void *theTemplate) { #if MAC_XCD #pragma unused(theEnv) #endif ((struct deftemplate *) theTemplate)->watch = newState; } /**********************************************************/ /* DeftemplateWatchAccess: Access routine for setting the */ /* watch flag of a deftemplate via the watch command. */ /**********************************************************/ globle unsigned DeftemplateWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,newState,argExprs, EnvGetDeftemplateWatch,EnvSetDeftemplateWatch)); } /*************************************************************************/ /* DeftemplateWatchPrint: Access routine for printing which deftemplates */ /* have their watch flag set via the list-watch-items command. */ /*************************************************************************/ globle unsigned DeftemplateWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,logName,argExprs, EnvGetDeftemplateWatch,EnvSetDeftemplateWatch)); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void GetDeftemplateList( DATA_OBJECT_PTR returnValue, void *theModule) { EnvGetDeftemplateList(GetCurrentEnvironment(),returnValue,theModule); } #if DEBUGGING_FUNCTIONS globle unsigned GetDeftemplateWatch( void *theTemplate) { return EnvGetDeftemplateWatch(GetCurrentEnvironment(),theTemplate); } globle void ListDeftemplates( const char *logicalName, void *theModule) { EnvListDeftemplates(GetCurrentEnvironment(),logicalName,theModule); } globle void SetDeftemplateWatch( unsigned newState, void *theTemplate) { EnvSetDeftemplateWatch(GetCurrentEnvironment(),newState,theTemplate); } #endif /* DEBUGGING_FUNCTIONS */ globle intBool Undeftemplate( void *theDeftemplate) { return EnvUndeftemplate(GetCurrentEnvironment(),theDeftemplate); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/globlbin.h0000755000175000017500000000461512373753374016216 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL BINARY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Moved WatchGlobals global to defglobalData. */ /* */ /*************************************************************/ #ifndef _H_globlbin #define _H_globlbin #include "modulbin.h" #include "cstrcbin.h" #include "globldef.h" struct bsaveDefglobal { struct bsaveConstructHeader header; long initial; }; struct bsaveDefglobalModule { struct bsaveDefmoduleItemHeader header; }; #define GLOBLBIN_DATA 60 struct defglobalBinaryData { struct defglobal *DefglobalArray; long NumberOfDefglobals; struct defglobalModule *ModuleArray; long NumberOfDefglobalModules; }; #define DefglobalBinaryData(theEnv) ((struct defglobalBinaryData *) GetEnvironmentData(theEnv,GLOBLBIN_DATA)) #define DefglobalPointer(i) ((struct defglobal *) (&DefglobalBinaryData(theEnv)->DefglobalArray[i])) #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefglobalBinarySetup(void *); LOCALE void *BloadDefglobalModuleReference(void *,int); #endif /* _H_globlbin */ clips_core_source_630/core/._scanner.h0000755000175000017500000000040712373755544016270 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrccom.h0000755000175000017500000000040712461252076016422 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._classfun.h0000755000175000017500000000040712500721260016431 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnchk.c0000755000175000017500000007270712462771770016246 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* CONSTRAINT CHECKING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for constraint checking of */ /* data types. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Dynamic constraint checking for the */ /* allowed-classes constraint now searches */ /* imported modules. */ /* */ /*************************************************************/ #define _CSTRNCHK_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "router.h" #include "multifld.h" #include "envrnmnt.h" #include "extnfunc.h" #include "cstrnutl.h" #if OBJECT_SYSTEM #include "inscom.h" #include "insfun.h" #include "classcom.h" #include "classexm.h" #endif #include "cstrnchk.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool CheckRangeAgainstCardinalityConstraint(void *,int,int,CONSTRAINT_RECORD *); static int CheckFunctionReturnType(int,CONSTRAINT_RECORD *); static intBool CheckTypeConstraint(int,CONSTRAINT_RECORD *); static intBool CheckRangeConstraint(void *,int,void *,CONSTRAINT_RECORD *); static void PrintRange(void *,const char *,CONSTRAINT_RECORD *); /******************************************************/ /* CheckFunctionReturnType: Checks a functions return */ /* type against a set of permissable return values. */ /* Returns TRUE if the return type is included */ /* among the permissible values, otherwise FALSE. */ /******************************************************/ static int CheckFunctionReturnType( int functionReturnType, CONSTRAINT_RECORD *constraints) { if (constraints == NULL) return(TRUE); if (constraints->anyAllowed) return(TRUE); switch(functionReturnType) { case 'c': case 'w': case 'b': if (constraints->symbolsAllowed) return(TRUE); else return(FALSE); case 's': if (constraints->stringsAllowed) return(TRUE); else return(FALSE); case 'j': if ((constraints->symbolsAllowed) || (constraints->stringsAllowed) || (constraints->instanceNamesAllowed)) return(TRUE); else return(FALSE); case 'k': if ((constraints->symbolsAllowed) || (constraints->stringsAllowed)) return(TRUE); else return(FALSE); case 'd': case 'f': if (constraints->floatsAllowed) return(TRUE); else return(FALSE); case 'i': case 'l': if (constraints->integersAllowed) return(TRUE); else return(FALSE); case 'n': if ((constraints->integersAllowed) || (constraints->floatsAllowed)) return(TRUE); else return(FALSE); case 'm': if (constraints->multifieldsAllowed) return(TRUE); else return(FALSE); case 'a': if (constraints->externalAddressesAllowed) return(TRUE); else return(FALSE); case 'x': if (constraints->instanceAddressesAllowed) return(TRUE); else return(FALSE); case 'y': if (constraints->factAddressesAllowed) return(TRUE); else return(FALSE); case 'o': if (constraints->instanceNamesAllowed) return(TRUE); else return(FALSE); case 'u': return(TRUE); case 'v': if (constraints->voidAllowed) return(TRUE); } return(TRUE); } /****************************************************/ /* CheckTypeConstraint: Determines if a primitive */ /* data type satisfies the type constraint fields */ /* of aconstraint record. */ /****************************************************/ static intBool CheckTypeConstraint( int type, CONSTRAINT_RECORD *constraints) { if (type == RVOID) return(FALSE); if (constraints == NULL) return(TRUE); if (constraints->anyAllowed == TRUE) return(TRUE); if ((type == SYMBOL) && (constraints->symbolsAllowed != TRUE)) { return(FALSE); } if ((type == STRING) && (constraints->stringsAllowed != TRUE)) { return(FALSE); } if ((type == FLOAT) && (constraints->floatsAllowed != TRUE)) { return(FALSE); } if ((type == INTEGER) && (constraints->integersAllowed != TRUE)) { return(FALSE); } #if OBJECT_SYSTEM if ((type == INSTANCE_NAME) && (constraints->instanceNamesAllowed != TRUE)) { return(FALSE); } if ((type == INSTANCE_ADDRESS) && (constraints->instanceAddressesAllowed != TRUE)) { return(FALSE); } #endif if ((type == EXTERNAL_ADDRESS) && (constraints->externalAddressesAllowed != TRUE)) { return(FALSE); } if ((type == RVOID) && (constraints->voidAllowed != TRUE)) { return(FALSE); } if ((type == FACT_ADDRESS) && (constraints->factAddressesAllowed != TRUE)) { return(FALSE); } return(TRUE); } /********************************************************/ /* CheckCardinalityConstraint: Determines if an integer */ /* falls within the range of allowed cardinalities */ /* for a constraint record. */ /********************************************************/ globle intBool CheckCardinalityConstraint( void *theEnv, long number, CONSTRAINT_RECORD *constraints) { /*=========================================*/ /* If the constraint record is NULL, there */ /* are no cardinality restrictions. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*==================================*/ /* Determine if the integer is less */ /* than the minimum cardinality. */ /*==================================*/ if (constraints->minFields != NULL) { if (constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity) { if (number < ValueToLong(constraints->minFields->value)) { return(FALSE); } } } /*=====================================*/ /* Determine if the integer is greater */ /* than the maximum cardinality. */ /*=====================================*/ if (constraints->maxFields != NULL) { if (constraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity) { if (number > ValueToLong(constraints->maxFields->value)) { return(FALSE); } } } /*=========================================================*/ /* The integer falls within the allowed cardinality range. */ /*=========================================================*/ return(TRUE); } /*****************************************************************/ /* CheckRangeAgainstCardinalityConstraint: Determines if a range */ /* of numbers could possibly fall within the range of allowed */ /* cardinalities for a constraint record. Returns TRUE if at */ /* least one of the numbers in the range is within the allowed */ /* cardinality, otherwise FALSE is returned. */ /*****************************************************************/ static intBool CheckRangeAgainstCardinalityConstraint( void *theEnv, int min, int max, CONSTRAINT_RECORD *constraints) { /*=========================================*/ /* If the constraint record is NULL, there */ /* are no cardinality restrictions. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*===============================================================*/ /* If the minimum value of the range is greater than the maximum */ /* value of the cardinality, then there are no numbers in the */ /* range which could fall within the cardinality range, and so */ /* FALSE is returned. */ /*===============================================================*/ if (constraints->maxFields != NULL) { if (constraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity) { if (min > ValueToLong(constraints->maxFields->value)) { return(FALSE); } } } /*===============================================================*/ /* If the maximum value of the range is less than the minimum */ /* value of the cardinality, then there are no numbers in the */ /* range which could fall within the cardinality range, and so */ /* FALSE is returned. A maximum range value of -1 indicates that */ /* the maximum possible value of the range is positive infinity. */ /*===============================================================*/ if ((constraints->minFields != NULL) && (max != -1)) { if (constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity) { if (max < ValueToLong(constraints->minFields->value)) { return(FALSE); } } } /*=============================================*/ /* At least one number in the specified range */ /* falls within the allowed cardinality range. */ /*=============================================*/ return(TRUE); } /**********************************************************************/ /* CheckAllowedValuesConstraint: Determines if a primitive data type */ /* satisfies the allowed-... constraint fields of a constraint */ /* record. Returns TRUE if the constraints are satisfied, otherwise */ /* FALSE is returned. */ /**********************************************************************/ globle intBool CheckAllowedValuesConstraint( int type, void *vPtr, CONSTRAINT_RECORD *constraints) { struct expr *tmpPtr; /*=========================================*/ /* If the constraint record is NULL, there */ /* are no allowed-... restrictions. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*=====================================================*/ /* Determine if there are any allowed-... restrictions */ /* for the type of the value being checked. */ /*=====================================================*/ switch (type) { case SYMBOL: if ((constraints->symbolRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; #if OBJECT_SYSTEM case INSTANCE_NAME: if ((constraints->instanceNameRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; #endif case STRING: if ((constraints->stringRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; case INTEGER: if ((constraints->integerRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; case FLOAT: if ((constraints->floatRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; default: return(TRUE); } /*=========================================================*/ /* Search through the restriction list to see if the value */ /* matches one of the allowed values in the list. */ /*=========================================================*/ for (tmpPtr = constraints->restrictionList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { if ((tmpPtr->type == type) && (tmpPtr->value == vPtr)) return(TRUE); } /*====================================================*/ /* If the value wasn't found in the list, then return */ /* FALSE because the constraint has been violated. */ /*====================================================*/ return(FALSE); } /**********************************************************************/ /* CheckAllowedClassesConstraint: Determines if a primitive data type */ /* satisfies the allowed-classes constraint fields of a constraint */ /* record. Returns TRUE if the constraints are satisfied, otherwise */ /* FALSE is returned. */ /**********************************************************************/ globle intBool CheckAllowedClassesConstraint( void *theEnv, int type, void *vPtr, CONSTRAINT_RECORD *constraints) { #if OBJECT_SYSTEM struct expr *tmpPtr; INSTANCE_TYPE *ins; DEFCLASS *insClass, *cmpClass; /*=========================================*/ /* If the constraint record is NULL, there */ /* is no allowed-classes restriction. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*======================================*/ /* The constraint is satisfied if there */ /* aren't any class restrictions. */ /*======================================*/ if (constraints->classList == NULL) { return(TRUE); } /*==================================*/ /* Class restrictions only apply to */ /* instances and instance names. */ /*==================================*/ if ((type != INSTANCE_ADDRESS) && (type != INSTANCE_NAME)) { return(TRUE); } /*=============================================*/ /* If an instance name is specified, determine */ /* whether the instance exists. */ /*=============================================*/ if (type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) vPtr; } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) vPtr); } if (ins == NULL) { return(FALSE); } /*======================================================*/ /* Search through the class list to see if the instance */ /* belongs to one of the allowed classes in the list. */ /*======================================================*/ insClass = (DEFCLASS *) EnvGetInstanceClass(theEnv,ins); for (tmpPtr = constraints->classList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { //cmpClass = (DEFCLASS *) EnvFindDefclass(theEnv,ValueToString(tmpPtr->value)); cmpClass = (DEFCLASS *) LookupDefclassByMdlOrScope(theEnv,ValueToString(tmpPtr->value)); if (cmpClass == NULL) continue; if (cmpClass == insClass) return(TRUE); if (EnvSubclassP(theEnv,insClass,cmpClass)) return(TRUE); } /*=========================================================*/ /* If a parent class wasn't found in the list, then return */ /* FALSE because the constraint has been violated. */ /*=========================================================*/ return(FALSE); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(type) #pragma unused(vPtr) #pragma unused(constraints) #endif return(TRUE); #endif } /*************************************************************/ /* CheckRangeConstraint: Determines if a primitive data type */ /* satisfies the range constraint of a constraint record. */ /*************************************************************/ static intBool CheckRangeConstraint( void *theEnv, int type, void *vPtr, CONSTRAINT_RECORD *constraints) { struct expr *minList, *maxList; /*===================================*/ /* If the constraint record is NULL, */ /* there are no range restrictions. */ /*===================================*/ if (constraints == NULL) return(TRUE); /*============================================*/ /* If the value being checked isn't a number, */ /* then the range restrictions don't apply. */ /*============================================*/ if ((type != INTEGER) && (type != FLOAT)) return(TRUE); /*=====================================================*/ /* Check each of the range restrictions to see if the */ /* number falls within at least one of the allowed */ /* ranges. If it falls within one of the ranges, then */ /* return TRUE since the constraint is satisifed. */ /*=====================================================*/ minList = constraints->minValue; maxList = constraints->maxValue; while (minList != NULL) { if (CompareNumbers(theEnv,type,vPtr,minList->type,minList->value) == LESS_THAN) { minList = minList->nextArg; maxList = maxList->nextArg; } else if (CompareNumbers(theEnv,type,vPtr,maxList->type,maxList->value) == GREATER_THAN) { minList = minList->nextArg; maxList = maxList->nextArg; } else { return(TRUE); } } /*===========================================*/ /* Return FALSE since the number didn't fall */ /* within one of the allowed numeric ranges. */ /*===========================================*/ return(FALSE); } /************************************************/ /* ConstraintViolationErrorMessage: Generalized */ /* error message for constraint violations. */ /************************************************/ globle void ConstraintViolationErrorMessage( void *theEnv, const char *theWhat, const char *thePlace, int command, int thePattern, struct symbolHashNode *theSlot, int theField, int violationType, CONSTRAINT_RECORD *theConstraint, int printPrelude) { /*======================================================*/ /* Don't print anything other than the tail explanation */ /* of the error unless asked to do so. */ /*======================================================*/ if (printPrelude) { /*===================================*/ /* Print the name of the thing which */ /* caused the constraint violation. */ /*===================================*/ if (violationType == FUNCTION_RETURN_TYPE_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The function return value "); } else if (theWhat != NULL) { PrintErrorID(theEnv,"CSTRNCHK",1,TRUE); EnvPrintRouter(theEnv,WERROR,theWhat); EnvPrintRouter(theEnv,WERROR," "); } /*=======================================*/ /* Print the location of the thing which */ /* caused the constraint violation. */ /*=======================================*/ if (thePlace != NULL) { EnvPrintRouter(theEnv,WERROR,"found in "); if (command) EnvPrintRouter(theEnv,WERROR,"the "); EnvPrintRouter(theEnv,WERROR,thePlace); if (command) EnvPrintRouter(theEnv,WERROR," command"); } /*================================================*/ /* If the violation occured in the LHS of a rule, */ /* indicate which pattern was at fault. */ /*================================================*/ if (thePattern > 0) { EnvPrintRouter(theEnv,WERROR,"found in CE #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } } /*===============================================================*/ /* Indicate the type of constraint violation (type, range, etc). */ /*===============================================================*/ if ((violationType == TYPE_VIOLATION) || (violationType == FUNCTION_RETURN_TYPE_VIOLATION)) { EnvPrintRouter(theEnv,WERROR,"\ndoes not match the allowed types"); } else if (violationType == RANGE_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not fall in the allowed range "); PrintRange(theEnv,WERROR,theConstraint); } else if (violationType == ALLOWED_VALUES_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not match the allowed values"); } else if (violationType == CARDINALITY_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not satisfy the cardinality restrictions"); } else if (violationType == ALLOWED_CLASSES_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not match the allowed classes"); } /*==============================================*/ /* Print either the slot name or field position */ /* where the constraint violation occured. */ /*==============================================*/ if (theSlot != NULL) { EnvPrintRouter(theEnv,WERROR," for slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theSlot)); } else if (theField > 0) { EnvPrintRouter(theEnv,WERROR," for field #"); PrintLongInteger(theEnv,WERROR,(long long) theField); } EnvPrintRouter(theEnv,WERROR,".\n"); } /********************************************************************/ /* PrintRange: Prints the range restriction of a constraint record. */ /* For example, 8 to +00 (eight to positive infinity). */ /********************************************************************/ static void PrintRange( void *theEnv, const char *logicalName, CONSTRAINT_RECORD *theConstraint) { if (theConstraint->minValue->value == SymbolData(theEnv)->NegativeInfinity) { EnvPrintRouter(theEnv,logicalName,ValueToString(SymbolData(theEnv)->NegativeInfinity)); } else PrintExpression(theEnv,logicalName,theConstraint->minValue); EnvPrintRouter(theEnv,logicalName," to "); if (theConstraint->maxValue->value == SymbolData(theEnv)->PositiveInfinity) { EnvPrintRouter(theEnv,logicalName,ValueToString(SymbolData(theEnv)->PositiveInfinity)); } else PrintExpression(theEnv,logicalName,theConstraint->maxValue); } /*************************************************************/ /* ConstraintCheckDataObject: Given a value stored in a data */ /* object structure and a constraint record, determines if */ /* the data object satisfies the constraint record. */ /*************************************************************/ globle int ConstraintCheckDataObject( void *theEnv, DATA_OBJECT *theData, CONSTRAINT_RECORD *theConstraints) { long i; /* 6.04 Bug Fix */ int rv; struct field *theMultifield; if (theConstraints == NULL) return(NO_VIOLATION); if (theData->type == MULTIFIELD) { if (CheckCardinalityConstraint(theEnv,(theData->end - theData->begin) + 1, theConstraints) == FALSE) { return(CARDINALITY_VIOLATION); } theMultifield = ((struct multifield *) theData->value)->theFields; for (i = theData->begin; i <= theData->end; i++) { if ((rv = ConstraintCheckValue(theEnv,theMultifield[i].type, theMultifield[i].value, theConstraints)) != NO_VIOLATION) { return(rv); } } return(NO_VIOLATION); } if (CheckCardinalityConstraint(theEnv,1L,theConstraints) == FALSE) { return(CARDINALITY_VIOLATION); } return(ConstraintCheckValue(theEnv,theData->type,theData->value,theConstraints)); } /****************************************************************/ /* ConstraintCheckValue: Given a value and a constraint record, */ /* determines if the value satisfies the constraint record. */ /****************************************************************/ globle int ConstraintCheckValue( void *theEnv, int theType, void *theValue, CONSTRAINT_RECORD *theConstraints) { if (CheckTypeConstraint(theType,theConstraints) == FALSE) { return(TYPE_VIOLATION); } else if (CheckAllowedValuesConstraint(theType,theValue,theConstraints) == FALSE) { return(ALLOWED_VALUES_VIOLATION); } else if (CheckAllowedClassesConstraint(theEnv,theType,theValue,theConstraints) == FALSE) { return(ALLOWED_CLASSES_VIOLATION); } else if (CheckRangeConstraint(theEnv,theType,theValue,theConstraints) == FALSE) { return(RANGE_VIOLATION); } else if (theType == FCALL) { if (CheckFunctionReturnType((int) ValueFunctionType(theValue),theConstraints) == FALSE) { return(FUNCTION_RETURN_TYPE_VIOLATION); } } return(NO_VIOLATION); } /********************************************************************/ /* ConstraintCheckExpressionChain: Checks an expression and nextArg */ /* links for constraint conflicts (argList is not followed). */ /********************************************************************/ globle int ConstraintCheckExpressionChain( void *theEnv, struct expr *theExpression, CONSTRAINT_RECORD *theConstraints) { struct expr *theExp; int min = 0, max = 0, vCode; /*===========================================================*/ /* Determine the minimum and maximum number of value which */ /* can be derived from the expression chain (max of -1 means */ /* positive infinity). */ /*===========================================================*/ for (theExp = theExpression ; theExp != NULL ; theExp = theExp->nextArg) { if (ConstantType(theExp->type)) min++; else if (theExp->type == FCALL) { if ((ExpressionFunctionType(theExp) != 'm') && (ExpressionFunctionType(theExp) != 'u')) min++; else max = -1; } else max = -1; } /*====================================*/ /* Check for a cardinality violation. */ /*====================================*/ if (max == 0) max = min; if (CheckRangeAgainstCardinalityConstraint(theEnv,min,max,theConstraints) == FALSE) { return(CARDINALITY_VIOLATION); } /*========================================*/ /* Check for other constraint violations. */ /*========================================*/ for (theExp = theExpression ; theExp != NULL ; theExp = theExp->nextArg) { vCode = ConstraintCheckValue(theEnv,theExp->type,theExp->value,theConstraints); if (vCode != NO_VIOLATION) return(vCode); } return(NO_VIOLATION); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************/ /* ConstraintCheckExpression: Checks an expression */ /* for constraint conflicts. Returns TRUE if */ /* conflicts are found, otherwise FALSE. */ /***************************************************/ globle int ConstraintCheckExpression( void *theEnv, struct expr *theExpression, CONSTRAINT_RECORD *theConstraints) { int rv = NO_VIOLATION; if (theConstraints == NULL) return(rv); while (theExpression != NULL) { rv = ConstraintCheckValue(theEnv,theExpression->type, theExpression->value, theConstraints); if (rv != NO_VIOLATION) return(rv); rv = ConstraintCheckExpression(theEnv,theExpression->argList,theConstraints); if (rv != NO_VIOLATION) return(rv); theExpression = theExpression->nextArg; } return(rv); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #if (! RUN_TIME) /*****************************************************/ /* UnmatchableConstraint: Determines if a constraint */ /* record can still be satisfied by some value. */ /*****************************************************/ globle intBool UnmatchableConstraint( CONSTRAINT_RECORD *theConstraint) { if (theConstraint == NULL) return(FALSE); if ((! theConstraint->anyAllowed) && (! theConstraint->symbolsAllowed) && (! theConstraint->stringsAllowed) && (! theConstraint->floatsAllowed) && (! theConstraint->integersAllowed) && (! theConstraint->instanceNamesAllowed) && (! theConstraint->instanceAddressesAllowed) && (! theConstraint->multifieldsAllowed) && (! theConstraint->externalAddressesAllowed) && (! theConstraint->voidAllowed) && (! theConstraint->factAddressesAllowed)) { return(TRUE); } return(FALSE); } #endif /* (! RUN_TIME) */ clips_core_source_630/core/._cstrcpsr.h0000755000175000017500000000040712373714225016471 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxbin.h0000755000175000017500000000463012373731204016205 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_dffnxbin #define _H_dffnxbin #if DEFFUNCTION_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "dffnxfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDeffunctionsBload(void *); LOCALE void *BloadDeffunctionModuleReference(void *,int); #define DFFNXBIN_DATA 24 struct deffunctionBinaryData { DEFFUNCTION *DeffunctionArray; long DeffunctionCount; long ModuleCount; DEFFUNCTION_MODULE *ModuleArray; }; #define DeffunctionBinaryData(theEnv) ((struct deffunctionBinaryData *) GetEnvironmentData(theEnv,DFFNXBIN_DATA)) #define DeffunctionPointer(i) (((i) == -1L) ? NULL : (DEFFUNCTION *) &DeffunctionBinaryData(theEnv)->DeffunctionArray[i]) #endif /* DEFFUNCTION_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) */ #endif /* _H_dffnxbin */ clips_core_source_630/core/._prcdrpsr.c0000755000175000017500000000040712373743660016465 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factfun.c0000755000175000017500000000041312461762345016250 0ustar jfsjfsMac OS X  2Ù ATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._classexm.c0000755000175000017500000000040712373714265016444 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._multifun.c0000755000175000017500000000040712433455671016470 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/scanner.c0000755000175000017500000007307712373755546016065 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SCANNER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for scanning lexical tokens from an */ /* input source. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Chris Culbert */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Added SetLineCount function. */ /* */ /* Added UTF-8 support. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _SCANNER_SOURCE_ #include #include #define _STDIO_INCLUDED_ #include #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "router.h" #include "symbol.h" #include "utility.h" #include "memalloc.h" #include "sysdep.h" #include "scanner.h" #include /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *ScanSymbol(void *,const char *,int,unsigned short *); static void *ScanString(void *,const char *); static void ScanNumber(void *,const char *,struct token *); static void DeallocateScannerData(void *); /************************************************/ /* InitializeScannerData: Allocates environment */ /* data for scanner routines. */ /************************************************/ globle void InitializeScannerData( void *theEnv) { AllocateEnvironmentData(theEnv,SCANNER_DATA,sizeof(struct scannerData),DeallocateScannerData); } /**************************************************/ /* DeallocateScannerData: Deallocates environment */ /* data for scanner routines. */ /**************************************************/ static void DeallocateScannerData( void *theEnv) { if (ScannerData(theEnv)->GlobalMax != 0) { genfree(theEnv,ScannerData(theEnv)->GlobalString,ScannerData(theEnv)->GlobalMax); } } /***********************************************************************/ /* GetToken: Reads next token from the input stream. The pointer to */ /* the token data structure passed as an argument is set to contain */ /* the type of token (e.g., symbol, string, integer, etc.), the data */ /* value for the token (i.e., a symbol table location if it is a */ /* symbol or string, an integer table location if it is an integer), */ /* and the pretty print representation. */ /***********************************************************************/ globle void GetToken( void *theEnv, const char *logicalName, struct token *theToken) { int inchar; unsigned short type; /*=======================================*/ /* Set Unknown default values for token. */ /*=======================================*/ theToken->type = UNKNOWN_VALUE; theToken->value = NULL; theToken->printForm = "unknown"; ScannerData(theEnv)->GlobalPos = 0; ScannerData(theEnv)->GlobalMax = 0; /*==============================================*/ /* Remove all white space before processing the */ /* GetToken() request. */ /*==============================================*/ inchar = EnvGetcRouter(theEnv,logicalName); while ((inchar == ' ') || (inchar == '\n') || (inchar == '\f') || (inchar == '\r') || (inchar == ';') || (inchar == '\t')) { /*=======================*/ /* Remove comment lines. */ /*=======================*/ if (inchar == ';') { inchar = EnvGetcRouter(theEnv,logicalName); while ((inchar != '\n') && (inchar != '\r') && (inchar != EOF) ) { inchar = EnvGetcRouter(theEnv,logicalName); } } inchar = EnvGetcRouter(theEnv,logicalName); } /*==========================*/ /* Process Symbolic Tokens. */ /*==========================*/ if (isalpha(inchar) || IsUTF8MultiByteStart(inchar)) { theToken->type = SYMBOL; EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->printForm = ValueToString(theToken->value); } /*===============================================*/ /* Process Number Tokens beginning with a digit. */ /*===============================================*/ else if (isdigit(inchar)) { EnvUngetcRouter(theEnv,inchar,logicalName); ScanNumber(theEnv,logicalName,theToken); } else switch (inchar) { /*========================*/ /* Process String Tokens. */ /*========================*/ case '"': theToken->value = (void *) ScanString(theEnv,logicalName); theToken->type = STRING; theToken->printForm = StringPrintForm(theEnv,ValueToString(theToken->value)); break; /*=======================================*/ /* Process Tokens that might be numbers. */ /*=======================================*/ case '-': case '.': case '+': EnvUngetcRouter(theEnv,inchar,logicalName); ScanNumber(theEnv,logicalName,theToken); break; /*===================================*/ /* Process ? and ? Tokens. */ /*===================================*/ case '?': inchar = EnvGetcRouter(theEnv,logicalName); if (isalpha(inchar) || IsUTF8MultiByteStart(inchar) #if DEFGLOBAL_CONSTRUCT || (inchar == '*')) #else ) #endif { EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->type = SF_VARIABLE; #if DEFGLOBAL_CONSTRUCT if ((ValueToString(theToken->value)[0] == '*') && (((int) strlen(ValueToString(theToken->value))) > 1) && (ValueToString(theToken->value)[strlen(ValueToString(theToken->value)) - 1] == '*')) { size_t count; theToken->type = GBL_VARIABLE; theToken->printForm = AppendStrings(theEnv,"?",ValueToString(theToken->value)); count = strlen(ScannerData(theEnv)->GlobalString); ScannerData(theEnv)->GlobalString[count-1] = EOS; theToken->value = EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString+1); ScannerData(theEnv)->GlobalString[count-1] = (char) inchar; } else #endif theToken->printForm = AppendStrings(theEnv,"?",ValueToString(theToken->value)); } else { theToken->type = SF_WILDCARD; theToken->value = (void *) EnvAddSymbol(theEnv,"?"); EnvUngetcRouter(theEnv,inchar,logicalName); theToken->printForm = "?"; } break; /*=====================================*/ /* Process $? and $? Tokens. */ /*=====================================*/ case '$': if ((inchar = EnvGetcRouter(theEnv,logicalName)) == '?') { inchar = EnvGetcRouter(theEnv,logicalName); if (isalpha(inchar) || IsUTF8MultiByteStart(inchar) #if DEFGLOBAL_CONSTRUCT || (inchar == '*')) #else ) #endif { EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->type = MF_VARIABLE; #if DEFGLOBAL_CONSTRUCT if ((ValueToString(theToken->value)[0] == '*') && ((int) (strlen(ValueToString(theToken->value))) > 1) && (ValueToString(theToken->value)[strlen(ValueToString(theToken->value)) - 1] == '*')) { size_t count; theToken->type = MF_GBL_VARIABLE; theToken->printForm = AppendStrings(theEnv,"$?",ValueToString(theToken->value)); count = strlen(ScannerData(theEnv)->GlobalString); ScannerData(theEnv)->GlobalString[count-1] = EOS; theToken->value = EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString+1); ScannerData(theEnv)->GlobalString[count-1] = (char) inchar; } else #endif theToken->printForm = AppendStrings(theEnv,"$?",ValueToString(theToken->value)); } else { theToken->type = MF_WILDCARD; theToken->value = (void *) EnvAddSymbol(theEnv,"$?"); theToken->printForm = "$?"; EnvUngetcRouter(theEnv,inchar,logicalName); } } else { theToken->type = SYMBOL; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,'$',ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,1,&type); theToken->printForm = ValueToString(theToken->value); } break; /*============================*/ /* Symbols beginning with '<' */ /*============================*/ case '<': theToken->type = SYMBOL; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,'<',ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); theToken->value = (void *) ScanSymbol(theEnv,logicalName,1,&type); theToken->printForm = ValueToString(theToken->value); break; /*=============================================*/ /* Process "(", ")", "~", "|", and "&" Tokens. */ /*=============================================*/ case '(': theToken->type = LPAREN; theToken->value = (void *) EnvAddSymbol(theEnv,"("); theToken->printForm = "("; break; case ')': theToken->type= RPAREN; theToken->value = (void *) EnvAddSymbol(theEnv,")"); theToken->printForm = ")"; break; case '~': theToken->type = NOT_CONSTRAINT; theToken->value = (void *) EnvAddSymbol(theEnv,"~"); theToken->printForm = "~"; break; case '|': theToken->type = OR_CONSTRAINT; theToken->value = (void *) EnvAddSymbol(theEnv,"|"); theToken->printForm = "|"; break; case '&': theToken->type = AND_CONSTRAINT; theToken->value = (void *) EnvAddSymbol(theEnv,"&"); theToken->printForm = "&"; break; /*============================*/ /* Process End-of-File Token. */ /*============================*/ case EOF: case 0: case 3: theToken->type = STOP; theToken->value = (void *) EnvAddSymbol(theEnv,"stop"); theToken->printForm = ""; break; /*=======================*/ /* Process Other Tokens. */ /*=======================*/ default: if (isprint(inchar)) { EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->type = type; theToken->printForm = ValueToString(theToken->value); } else { theToken->printForm = "<<>>"; } break; } /*===============================================*/ /* Put the new token in the pretty print buffer. */ /*===============================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) if (theToken->type == INSTANCE_NAME) { SavePPBuffer(theEnv,"["); SavePPBuffer(theEnv,theToken->printForm); SavePPBuffer(theEnv,"]"); } else { SavePPBuffer(theEnv,theToken->printForm); } #endif /*=========================================================*/ /* Return the temporary memory used in scanning the token. */ /*=========================================================*/ if (ScannerData(theEnv)->GlobalString != NULL) { rm(theEnv,ScannerData(theEnv)->GlobalString,ScannerData(theEnv)->GlobalMax); ScannerData(theEnv)->GlobalString = NULL; ScannerData(theEnv)->GlobalMax = 0; ScannerData(theEnv)->GlobalPos = 0; } return; } /*************************************/ /* ScanSymbol: Scans a symbol token. */ /*************************************/ static void *ScanSymbol( void *theEnv, const char *logicalName, int count, unsigned short *type) { int inchar; #if OBJECT_SYSTEM void *symbol; #endif /*=====================================*/ /* Scan characters and add them to the */ /* symbol until a delimiter is found. */ /*=====================================*/ inchar = EnvGetcRouter(theEnv,logicalName); while ( (inchar != '<') && (inchar != '"') && (inchar != '(') && (inchar != ')') && (inchar != '&') && (inchar != '|') && (inchar != '~') && (inchar != ' ') && (inchar != ';') && (isprint(inchar) || IsUTF8MultiByteStart(inchar) || IsUTF8MultiByteContinuation(inchar))) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; inchar = EnvGetcRouter(theEnv,logicalName); } /*===================================================*/ /* Return the last character scanned (the delimiter) */ /* to the input stream so it will be scanned as part */ /* of the next token. */ /*===================================================*/ EnvUngetcRouter(theEnv,inchar,logicalName); /*====================================================*/ /* Add the symbol to the symbol table and return the */ /* symbol table address of the symbol. Symbols of the */ /* form [] are instance names, so the type */ /* returned is INSTANCE_NAME rather than SYMBOL. */ /*====================================================*/ #if OBJECT_SYSTEM if (count > 2) { if ((ScannerData(theEnv)->GlobalString[0] == '[') ? (ScannerData(theEnv)->GlobalString[count-1] == ']') : FALSE) { *type = INSTANCE_NAME; inchar = ']'; } else { *type = SYMBOL; return(EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString)); } ScannerData(theEnv)->GlobalString[count-1] = EOS; symbol = EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString+1); ScannerData(theEnv)->GlobalString[count-1] = (char) inchar; return(symbol); } else { *type = SYMBOL; return(EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString)); } #else *type = SYMBOL; return(EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString)); #endif } /*************************************/ /* ScanString: Scans a string token. */ /*************************************/ static void *ScanString( void *theEnv, const char *logicalName) { int inchar; size_t pos = 0; size_t max = 0; char *theString = NULL; void *thePtr; /*============================================*/ /* Scan characters and add them to the string */ /* until the " delimiter is found. */ /*============================================*/ inchar = EnvGetcRouter(theEnv,logicalName); while ((inchar != '"') && (inchar != EOF)) { if (inchar == '\\') { inchar = EnvGetcRouter(theEnv,logicalName); } theString = ExpandStringWithChar(theEnv,inchar,theString,&pos,&max,max+80); inchar = EnvGetcRouter(theEnv,logicalName); } if ((inchar == EOF) && (ScannerData(theEnv)->IgnoreCompletionErrors == FALSE)) { PrintErrorID(theEnv,"SCANNER",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Encountered End-Of-File while scanning a string\n"); } /*===============================================*/ /* Add the string to the symbol table and return */ /* the symbol table address of the string. */ /*===============================================*/ if (theString == NULL) { thePtr = EnvAddSymbol(theEnv,""); } else { thePtr = EnvAddSymbol(theEnv,theString); rm(theEnv,theString,max); } return(thePtr); } /**************************************/ /* ScanNumber: Scans a numeric token. */ /**************************************/ static void ScanNumber( void *theEnv, const char *logicalName, struct token *theToken) { int count = 0; int inchar, phase; int digitFound = FALSE; int processFloat = FALSE; double fvalue; long long lvalue; unsigned short type; /* Phases: */ /* -1 = sign */ /* 0 = integral */ /* 1 = decimal */ /* 2 = exponent-begin */ /* 3 = exponent-value */ /* 5 = done */ /* 9 = error */ inchar = EnvGetcRouter(theEnv,logicalName); phase = -1; while ((phase != 5) && (phase != 9)) { if (phase == -1) { if (isdigit(inchar)) { phase = 0; digitFound = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if ((inchar == '+') || (inchar == '-')) { phase = 0; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if (inchar == '.') { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 1; } else if ((inchar == 'E') || (inchar == 'e')) { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 2; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || (isprint(inchar) == 0) ) { phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 0) { if (isdigit(inchar)) { digitFound = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if (inchar == '.') { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 1; } else if ((inchar == 'E') || (inchar == 'e')) { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 2; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || ((isprint(inchar) == 0) && (! IsUTF8MultiByteStart(inchar))) ) { phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 1) { if (isdigit(inchar)) { digitFound = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if ((inchar == 'E') || (inchar == 'e')) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 2; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || ((isprint(inchar) == 0) && (! IsUTF8MultiByteStart(inchar))) ) { phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 2) { if (isdigit(inchar)) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 3; } else if ((inchar == '+') || (inchar == '-')) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 3; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || ((isprint(inchar) == 0) && (! IsUTF8MultiByteStart(inchar))) ) { digitFound = FALSE; phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 3) { if (isdigit(inchar)) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || ((isprint(inchar) == 0) && (! IsUTF8MultiByteStart(inchar))) ) { if ((ScannerData(theEnv)->GlobalString[count-1] == '+') || (ScannerData(theEnv)->GlobalString[count-1] == '-')) { digitFound = FALSE; } phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } if ((phase != 5) && (phase != 9)) { inchar = EnvGetcRouter(theEnv,logicalName); } } if (phase == 9) { theToken->value = (void *) ScanSymbol(theEnv,logicalName,count,&type); theToken->type = type; theToken->printForm = ValueToString(theToken->value); return; } /*=======================================*/ /* Stuff last character back into buffer */ /* and return the number. */ /*=======================================*/ EnvUngetcRouter(theEnv,inchar,logicalName); if (! digitFound) { theToken->type = SYMBOL; theToken->value = (void *) EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString); theToken->printForm = ValueToString(theToken->value); return; } if (processFloat) { fvalue = atof(ScannerData(theEnv)->GlobalString); theToken->type = FLOAT; theToken->value = (void *) EnvAddDouble(theEnv,fvalue); theToken->printForm = FloatToString(theEnv,ValueToDouble(theToken->value)); } else { errno = 0; #if WIN_MVC lvalue = _strtoi64(ScannerData(theEnv)->GlobalString,NULL,10); #else lvalue = strtoll(ScannerData(theEnv)->GlobalString,NULL,10); #endif if (errno) { PrintWarningID(theEnv,"SCANNER",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Over or underflow of long long integer.\n"); } theToken->type = INTEGER; theToken->value = (void *) EnvAddLong(theEnv,lvalue); theToken->printForm = LongIntegerToString(theEnv,ValueToLong(theToken->value)); } return; } /***********************************************************/ /* CopyToken: Copies values of one token to another token. */ /***********************************************************/ globle void CopyToken( struct token *destination, struct token *source) { destination->type = source->type; destination->value = source->value; destination->printForm = source->printForm; } /****************************************/ /* ResetLineCount: Resets the scanner's */ /* line count to zero. */ /****************************************/ globle void ResetLineCount( void *theEnv) { ScannerData(theEnv)->LineCount = 0; } /***************************************************/ /* GetLineCount: Returns the scanner's line count. */ /***************************************************/ globle long GetLineCount( void *theEnv) { return(ScannerData(theEnv)->LineCount); } /***********************************************/ /* SetLineCount: Sets the scanner's line count */ /* and returns the previous value. */ /***********************************************/ globle long SetLineCount( void *theEnv, long value) { long oldValue; oldValue = ScannerData(theEnv)->LineCount; ScannerData(theEnv)->LineCount = value; return(oldValue); } /**********************************/ /* IncrementLineCount: Increments */ /* the scanner's line count. */ /**********************************/ globle void IncrementLineCount( void *theEnv) { ScannerData(theEnv)->LineCount++; } /**********************************/ /* DecrementLineCount: Decrements */ /* the scanner's line count. */ /**********************************/ globle void DecrementLineCount( void *theEnv) { ScannerData(theEnv)->LineCount--; } clips_core_source_630/core/._rulebld.h0000755000175000017500000000040712374024065016254 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factmngr.h0000755000175000017500000002562012500146515016207 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* FACTS MANAGER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* AssignFactSlotDefaults function does not */ /* properly handle defaults for multifield slots. */ /* DR0869 */ /* */ /* Support for ppfact command. */ /* */ /* 6.30: Callback function support for assertion, */ /* retraction, and modification of facts. */ /* */ /* Updates to fact pattern entity record. */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Removed unused global variables. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* JoinOperationInProgress mechanism. */ /* */ /*************************************************************/ #ifndef _H_factmngr #define _H_factmngr struct fact; #ifndef _H_facthsh #include "facthsh.h" #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #include "multifld.h" #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif struct fact { struct patternEntity factHeader; struct deftemplate *whichDeftemplate; void *list; long long factIndex; unsigned long hashValue; unsigned int garbage : 1; struct fact *previousFact; struct fact *nextFact; struct fact *previousTemplateFact; struct fact *nextTemplateFact; struct multifield theProposition; }; #define FACTS_DATA 3 struct factsData { int ChangeToFactList; #if DEBUGGING_FUNCTIONS unsigned WatchFacts; #endif struct fact DummyFact; struct fact *GarbageFacts; struct fact *LastFact; struct fact *FactList; long long NextFactIndex; unsigned long NumberOfFacts; struct callFunctionItemWithArg *ListOfAssertFunctions; struct callFunctionItemWithArg *ListOfRetractFunctions; struct callFunctionItemWithArg *ListOfModifyFunctions; struct patternEntityRecord FactInfo; #if (! RUN_TIME) && (! BLOAD_ONLY) struct deftemplate *CurrentDeftemplate; #endif #if DEFRULE_CONSTRUCT && (! RUN_TIME) && DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER struct CodeGeneratorItem *FactCodeItem; #endif struct factHashEntry **FactHashTable; unsigned long FactHashTableSize; intBool FactDuplication; #if DEFRULE_CONSTRUCT struct fact *CurrentPatternFact; struct multifieldMarker *CurrentPatternMarks; #endif long LastModuleIndex; }; #define FactData(theEnv) ((struct factsData *) GetEnvironmentData(theEnv,FACTS_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTMNGR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void *EnvAssert(void *,void *); LOCALE void *EnvAssertString(void *,const char *); LOCALE struct fact *EnvCreateFact(void *,void *); LOCALE void EnvDecrementFactCount(void *,void *); LOCALE long long EnvFactIndex(void *,void *); LOCALE intBool EnvGetFactSlot(void *,void *,const char *,DATA_OBJECT *); LOCALE void PrintFactWithIdentifier(void *,const char *,struct fact *); LOCALE void PrintFact(void *,const char *,struct fact *,int,int); LOCALE void PrintFactIdentifierInLongForm(void *,const char *,void *); LOCALE intBool EnvRetract(void *,void *); LOCALE void RemoveAllFacts(void *); LOCALE struct fact *CreateFactBySize(void *,unsigned); LOCALE void FactInstall(void *,struct fact *); LOCALE void FactDeinstall(void *,struct fact *); LOCALE void *EnvGetNextFact(void *,void *); LOCALE void *GetNextFactInScope(void *theEnv,void *); LOCALE void EnvGetFactPPForm(void *,char *,size_t,void *); LOCALE int EnvGetFactListChanged(void *); LOCALE void EnvSetFactListChanged(void *,int); LOCALE unsigned long GetNumberOfFacts(void *); LOCALE void InitializeFacts(void *); LOCALE struct fact *FindIndexedFact(void *,long long); LOCALE void EnvIncrementFactCount(void *,void *); LOCALE void PrintFactIdentifier(void *,const char *,void *); LOCALE void DecrementFactBasisCount(void *,void *); LOCALE void IncrementFactBasisCount(void *,void *); LOCALE intBool FactIsDeleted(void *,void *); LOCALE void ReturnFact(void *,struct fact *); LOCALE void MatchFactFunction(void *,void *); LOCALE intBool EnvPutFactSlot(void *,void *,const char *,DATA_OBJECT *); LOCALE intBool EnvAssignFactSlotDefaults(void *,void *); LOCALE intBool CopyFactSlotValues(void *,void *,void *); LOCALE intBool DeftemplateSlotDefault(void *,struct deftemplate *, struct templateSlot *,DATA_OBJECT *,int); LOCALE intBool EnvAddAssertFunction(void *,const char *, void (*)(void *,void *),int); LOCALE intBool EnvAddAssertFunctionWithContext(void *,const char *, void (*)(void *,void *),int,void *); LOCALE intBool EnvRemoveAssertFunction(void *,const char *); LOCALE intBool EnvAddRetractFunction(void *,const char *, void (*)(void *,void *),int); LOCALE intBool EnvAddRetractFunctionWithContext(void *,const char *, void (*)(void *,void *),int,void *); LOCALE intBool EnvRemoveRetractFunction(void *,const char *); LOCALE intBool EnvAddModifyFunction(void *,const char *, void (*)(void *,void *,void *),int); LOCALE intBool EnvAddModifyFunctionWithContext(void *,const char *, void (*)(void *,void *,void *),int,void *); LOCALE intBool EnvRemoveModifyFunction(void *,const char *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool AddAssertFunction(const char *,void (*)(void *,void *),int); LOCALE intBool AddModifyFunction(const char *,void (*)(void *,void *,void *),int); LOCALE intBool AddRetractFunction(const char *,void (*)(void *,void *),int); LOCALE void *Assert(void *); LOCALE void *AssertString(const char *); LOCALE intBool AssignFactSlotDefaults(void *); LOCALE struct fact *CreateFact(void *); LOCALE void DecrementFactCount(void *); LOCALE long long FactIndex(void *); LOCALE int GetFactListChanged(void); LOCALE void GetFactPPForm(char *,unsigned,void *); LOCALE intBool GetFactSlot(void *,const char *,DATA_OBJECT *); LOCALE void *GetNextFact(void *); LOCALE void IncrementFactCount(void *); LOCALE intBool PutFactSlot(void *,const char *,DATA_OBJECT *); LOCALE intBool RemoveAssertFunction(const char *); LOCALE intBool RemoveModifyFunction(const char *); LOCALE intBool RemoveRetractFunction(const char *); LOCALE intBool Retract(void *); LOCALE void SetFactListChanged(int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_factmngr */ clips_core_source_630/core/._rulepsr.c0000755000175000017500000000040712461253173016313 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._globlbin.h0000755000175000017500000000040712373753374016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/ruledef.c0000755000175000017500000005125612461251526016040 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFRULE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defrule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defrule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for hashed memories. */ /* */ /* Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /* Added EnvGetDisjunctCount and */ /* EnvGetNthDisjunct functions. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _RULEDEF_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "agenda.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "pattern.h" #include "retract.h" #include "reteutil.h" #include "rulebsc.h" #include "rulecom.h" #include "rulepsr.h" #include "ruledlt.h" #if BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY #include "bload.h" #include "rulebin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "rulecmp.h" #endif #include "ruledef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void InitializeDefruleModules(void *); static void DeallocateDefruleData(void *); static void DestroyDefruleAction(void *,struct constructHeader *,void *); #if RUN_TIME static void AddBetaMemoriesToRule(void *,struct joinNode *); #endif /**********************************************************/ /* InitializeDefrules: Initializes the defrule construct. */ /**********************************************************/ globle void InitializeDefrules( void *theEnv) { unsigned long i; AllocateEnvironmentData(theEnv,DEFRULE_DATA,sizeof(struct defruleData),DeallocateDefruleData); InitializeEngine(theEnv); InitializeAgenda(theEnv); InitializePatterns(theEnv); InitializeDefruleModules(theEnv); AddReservedPatternSymbol(theEnv,"and",NULL); AddReservedPatternSymbol(theEnv,"not",NULL); AddReservedPatternSymbol(theEnv,"or",NULL); AddReservedPatternSymbol(theEnv,"test",NULL); AddReservedPatternSymbol(theEnv,"logical",NULL); AddReservedPatternSymbol(theEnv,"exists",NULL); AddReservedPatternSymbol(theEnv,"forall",NULL); DefruleBasicCommands(theEnv); DefruleCommands(theEnv); DefruleData(theEnv)->DefruleConstruct = AddConstruct(theEnv,"defrule","defrules", ParseDefrule,EnvFindDefrule, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefrule,SetNextConstruct, EnvIsDefruleDeletable,EnvUndefrule,ReturnDefrule); DefruleData(theEnv)->AlphaMemoryTable = (ALPHA_MEMORY_HASH **) gm3(theEnv,sizeof (ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE); for (i = 0; i < ALPHA_MEMORY_HASH_SIZE; i++) DefruleData(theEnv)->AlphaMemoryTable[i] = NULL; DefruleData(theEnv)->BetaMemoryResizingFlag = TRUE; DefruleData(theEnv)->RightPrimeJoins = NULL; DefruleData(theEnv)->LeftPrimeJoins = NULL; } /**************************************************/ /* DeallocateDefruleData: Deallocates environment */ /* data for the defrule construct. */ /**************************************************/ static void DeallocateDefruleData( void *theEnv) { struct defruleModule *theModuleItem; void *theModule; struct activation *theActivation, *tmpActivation; struct salienceGroup *theGroup, *tmpGroup; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) { return; } #endif DoForAllConstructs(theEnv,DestroyDefruleAction,DefruleData(theEnv)->DefruleModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefruleData(theEnv)->DefruleModuleIndex); theActivation = theModuleItem->agenda; while (theActivation != NULL) { tmpActivation = theActivation->next; rtn_struct(theEnv,activation,theActivation); theActivation = tmpActivation; } theGroup = theModuleItem->groupings; while (theGroup != NULL) { tmpGroup = theGroup->next; rtn_struct(theEnv,salienceGroup,theGroup); theGroup = tmpGroup; } #if ! RUN_TIME rtn_struct(theEnv,defruleModule,theModuleItem); #endif } rm3(theEnv,DefruleData(theEnv)->AlphaMemoryTable,sizeof (ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE); } /********************************************************/ /* DestroyDefruleAction: Action used to remove defrules */ /* as a result of DestroyEnvironment. */ /********************************************************/ static void DestroyDefruleAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct defrule *theDefrule = (struct defrule *) theConstruct; DestroyDefrule(theEnv,theDefrule); } /*****************************************************/ /* InitializeDefruleModules: Initializes the defrule */ /* construct for use with the defmodule construct. */ /*****************************************************/ static void InitializeDefruleModules( void *theEnv) { DefruleData(theEnv)->DefruleModuleIndex = RegisterModuleItem(theEnv,"defrule", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefruleModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefruleCModuleReference, #else NULL, #endif EnvFindDefruleInModule); } /***********************************************/ /* AllocateModule: Allocates a defrule module. */ /***********************************************/ static void *AllocateModule( void *theEnv) { struct defruleModule *theItem; theItem = get_struct(theEnv,defruleModule); theItem->agenda = NULL; theItem->groupings = NULL; return((void *) theItem); } /*********************************************/ /* ReturnModule: Deallocates a defrule module. */ /*********************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefruleData(theEnv)->DefruleConstruct); rtn_struct(theEnv,defruleModule,theItem); } /************************************************************/ /* GetDefruleModuleItem: Returns a pointer to the defmodule */ /* item for the specified defrule or defmodule. */ /************************************************************/ globle struct defruleModule *GetDefruleModuleItem( void *theEnv, struct defmodule *theModule) { return((struct defruleModule *) GetConstructModuleItemByIndex(theEnv,theModule,DefruleData(theEnv)->DefruleModuleIndex)); } /*******************************************************************/ /* EnvFindDefrule: Searches for a defrule in the list of defrules. */ /* Returns a pointer to the defrule if found, otherwise NULL. */ /*******************************************************************/ globle void *EnvFindDefrule( void *theEnv, const char *defruleName) { return(FindNamedConstructInModuleOrImports(theEnv,defruleName,DefruleData(theEnv)->DefruleConstruct)); } /*******************************************************************/ /* EnvFindDefruleInModule: Searches for a defrule in the list of defrules. */ /* Returns a pointer to the defrule if found, otherwise NULL. */ /*******************************************************************/ globle void *EnvFindDefruleInModule( void *theEnv, const char *defruleName) { return(FindNamedConstructInModule(theEnv,defruleName,DefruleData(theEnv)->DefruleConstruct)); } /************************************************************/ /* EnvGetNextDefrule: If passed a NULL pointer, returns the */ /* first defrule in the ListOfDefrules. Otherwise returns */ /* the next defrule following the defrule passed as an */ /* argument. */ /************************************************************/ globle void *EnvGetNextDefrule( void *theEnv, void *defrulePtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) defrulePtr,DefruleData(theEnv)->DefruleModuleIndex)); } /*******************************************************/ /* EnvIsDefruleDeletable: Returns TRUE if a particular */ /* defrule can be deleted, otherwise returns FALSE. */ /*******************************************************/ globle intBool EnvIsDefruleDeletable( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule; if (! ConstructsDeletable(theEnv)) { return FALSE; } for (theDefrule = (struct defrule *) vTheDefrule; theDefrule != NULL; theDefrule = theDefrule->disjunct) { if (theDefrule->executing) return(FALSE); } if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE); return(TRUE); } /***********************************************************/ /* EnvGetDisjunctCount: Returns the number of disjuncts of */ /* a rule (permutations caused by the use of or CEs). */ /***********************************************************/ globle long EnvGetDisjunctCount( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule; long count = 0; for (theDefrule = (struct defrule *) vTheDefrule; theDefrule != NULL; theDefrule = theDefrule->disjunct) { count++; } return(count); } /**********************************************************/ /* EnvGetNthDisjunct: Returns the nth disjunct of a rule. */ /* The disjunct indices run from 1 to N rather than 0 */ /* to N - 1. */ /**********************************************************/ globle void *EnvGetNthDisjunct( void *theEnv, void *vTheDefrule, long index) { struct defrule *theDefrule; long count = 0; for (theDefrule = (struct defrule *) vTheDefrule; theDefrule != NULL; theDefrule = theDefrule->disjunct) { count++; if (count == index) { return theDefrule; } } return(NULL); } #if RUN_TIME /******************************************/ /* DefruleRunTimeInitialize: Initializes */ /* defrule in a run-time module. */ /******************************************/ globle void DefruleRunTimeInitialize( void *theEnv, struct joinLink *rightPrime, struct joinLink *leftPrime) { struct defmodule *theModule; struct defrule *theRule, *theDisjunct; DefruleData(theEnv)->RightPrimeJoins = rightPrime; DefruleData(theEnv)->LeftPrimeJoins = leftPrime; SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theRule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theRule != NULL; theRule = (struct defrule *) EnvGetNextDefrule(theEnv,theRule)) { for (theDisjunct = theRule; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct) { AddBetaMemoriesToRule(theEnv,theDisjunct->lastJoin); } } } RestoreCurrentModule(theEnv); } /******************************************/ /* AddBetaMemoriesToRule: */ /******************************************/ static void AddBetaMemoriesToRule( void *theEnv, struct joinNode *theNode) { AddBetaMemoriesToJoin(theEnv,theNode); if (theNode->lastLevel != NULL) { AddBetaMemoriesToRule(theEnv,theNode->lastLevel); } if (theNode->joinFromTheRight) { AddBetaMemoriesToRule(theEnv,(struct joinNode *) theNode->rightSideEntryStructure); } } #endif /* RUN_TIME */ #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE /**************************/ /* AddBetaMemoriesToJoin: */ /**************************/ globle void AddBetaMemoriesToJoin( void *theEnv, struct joinNode *theNode) { if ((theNode->leftMemory != NULL) || (theNode->rightMemory != NULL)) { return; } if ((! theNode->firstJoin) || theNode->patternIsExists || theNode-> patternIsNegated || theNode->joinFromTheRight) { if (theNode->leftHash == NULL) { theNode->leftMemory = get_struct(theEnv,betaMemory); theNode->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->leftMemory->beta[0] = NULL; theNode->leftMemory->size = 1; theNode->leftMemory->count = 0; theNode->leftMemory->last = NULL; } else { theNode->leftMemory = get_struct(theEnv,betaMemory); theNode->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(theNode->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); theNode->leftMemory->size = INITIAL_BETA_HASH_SIZE; theNode->leftMemory->count = 0; theNode->leftMemory->last = NULL; } if (theNode->firstJoin && (theNode->patternIsExists || theNode-> patternIsNegated || theNode->joinFromTheRight)) { theNode->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv); theNode->leftMemory->beta[0]->owner = theNode; } } else { theNode->leftMemory = NULL; } if (theNode->joinFromTheRight) { if (theNode->leftHash == NULL) { theNode->rightMemory = get_struct(theEnv,betaMemory); theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->beta[0] = NULL; theNode->rightMemory->last[0] = NULL; theNode->rightMemory->size = 1; theNode->rightMemory->count = 0; } else { theNode->rightMemory = get_struct(theEnv,betaMemory); theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(theNode->rightMemory->beta,0,sizeof(struct partialMatch **) * INITIAL_BETA_HASH_SIZE); memset(theNode->rightMemory->last,0,sizeof(struct partialMatch **) * INITIAL_BETA_HASH_SIZE); theNode->rightMemory->size = INITIAL_BETA_HASH_SIZE; theNode->rightMemory->count = 0; } } else if (theNode->rightSideEntryStructure == NULL) { theNode->rightMemory = get_struct(theEnv,betaMemory); theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv); theNode->rightMemory->beta[0]->owner = theNode; theNode->rightMemory->beta[0]->rhsMemory = TRUE; theNode->rightMemory->last[0] = theNode->rightMemory->beta[0]; theNode->rightMemory->size = 1; theNode->rightMemory->count = 1; } else { theNode->rightMemory = NULL; } } #endif /* RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE */ /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvDefruleModule( void *theEnv, void *theDefrule) { return GetConstructModuleName((struct constructHeader *) theDefrule); } globle const char *EnvGetDefruleName( void *theEnv, void *theDefrule) { return GetConstructNameString((struct constructHeader *) theDefrule); } globle const char *EnvGetDefrulePPForm( void *theEnv, void *theDefrule) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDefrule); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle const char *DefruleModule( void *theDefrule) { return EnvDefruleModule(GetCurrentEnvironment(),theDefrule); } globle void *FindDefrule( const char *defruleName) { return EnvFindDefrule(GetCurrentEnvironment(),defruleName); } globle const char *GetDefruleName( void *theDefrule) { return EnvGetDefruleName(GetCurrentEnvironment(),theDefrule); } globle const char *GetDefrulePPForm( void *theDefrule) { return EnvGetDefrulePPForm(GetCurrentEnvironment(),theDefrule); } globle void *GetNextDefrule( void *defrulePtr) { return EnvGetNextDefrule(GetCurrentEnvironment(),defrulePtr); } globle intBool IsDefruleDeletable( void *vTheDefrule) { return EnvIsDefruleDeletable(GetCurrentEnvironment(),vTheDefrule); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/._insqypsr.c0000755000175000017500000000040712464742046016514 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffctbin.c0000755000175000017500000004600712373721210016161 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFFACTS BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* deffacts construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #define _DFFCTBIN_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "dffctdef.h" #include "moduldef.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "dffctbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveExpressions(void *,FILE *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDeffactsModule(void *,void *,long); static void UpdateDeffacts(void *,void *,long); static void ClearBload(void *); static void DeallocateDeffactsBloadData(void *); /********************************************/ /* DeffactsBinarySetup: Installs the binary */ /* save/load feature for deffacts. */ /********************************************/ globle void DeffactsBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,DFFCTBIN_DATA,sizeof(struct deffactsBinaryData),DeallocateDeffactsBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"deffacts",0,BsaveFind,BsaveExpressions, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"deffacts",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /********************************************************/ /* DeallocateDeffactsBloadData: Deallocates environment */ /* data for the deffacts bsave functionality. */ /********************************************************/ static void DeallocateDeffactsBloadData( void *theEnv) { size_t space; space = DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts); if (space != 0) genfree(theEnv,(void *) DeffactsBinaryData(theEnv)->DeffactsArray,space); space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); if (space != 0) genfree(theEnv,(void *) DeffactsBinaryData(theEnv)->ModuleArray,space); } #if BLOAD_AND_BSAVE /*********************************************************/ /* BsaveFind: Counts the number of data structures which */ /* must be saved in the binary image for the deffacts */ /* in the current environment. */ /*********************************************************/ static void BsaveFind( void *theEnv) { struct deffacts *theDeffacts; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffactsModules); SaveBloadCount(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffacts); /*========================================*/ /* Set the count of deffacts and deffacts */ /* module data structures to zero. */ /*========================================*/ DeffactsBinaryData(theEnv)->NumberOfDeffacts = 0; DeffactsBinaryData(theEnv)->NumberOfDeffactsModules = 0; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*===============================================*/ /* Set the current module to the module being */ /* examined and increment the number of deffacts */ /* modules encountered. */ /*===============================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); DeffactsBinaryData(theEnv)->NumberOfDeffactsModules++; /*===================================================*/ /* Loop through each deffacts in the current module. */ /*===================================================*/ for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { /*======================================================*/ /* Initialize the construct header for the binary save. */ /*======================================================*/ MarkConstructHeaderNeededItems(&theDeffacts->header,DeffactsBinaryData(theEnv)->NumberOfDeffacts++); /*============================================================*/ /* Count the number of expressions contained in the deffacts' */ /* assertion list and mark any atomic values contained there */ /* as in use. */ /*============================================================*/ ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDeffacts->assertList); MarkNeededItems(theEnv,theDeffacts->assertList); } } } /************************************************/ /* BsaveExpressions: Saves the expressions used */ /* by deffacts to the binary save file. */ /************************************************/ static void BsaveExpressions( void *theEnv, FILE *fp) { struct deffacts *theDeffacts; struct defmodule *theModule; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==================================================*/ /* Loop through each deffacts in the current module */ /* and save the assertion list expression. */ /*==================================================*/ for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { BsaveExpression(theEnv,theDeffacts->assertList,fp); } } } /******************************************************/ /* BsaveStorage: Writes out the storage requirements */ /* for all deffacts structures to the binary file. */ /******************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { size_t space; /*=================================================================*/ /* Only two data structures are saved as part of a deffacts binary */ /* image: the deffacts data structure and the deffactsModule data */ /* structure. The assertion list expressions are not save with the */ /* deffacts portion of the binary image. */ /*=================================================================*/ space = sizeof(long) * 2; GenWrite(&space,sizeof(size_t),fp); GenWrite(&DeffactsBinaryData(theEnv)->NumberOfDeffacts,sizeof(long int),fp); GenWrite(&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules,sizeof(long int),fp); } /********************************************/ /* BsaveBinaryItem: Writes out all deffacts */ /* structures to the binary file. */ /********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { size_t space; struct deffacts *theDeffacts; struct bsaveDeffacts newDeffacts; struct defmodule *theModule; struct bsaveDeffactsModule tempDeffactsModule; struct deffactsModule *theModuleItem; /*=========================================================*/ /* Write out the amount of space taken up by the deffacts */ /* and deffactsModule data structures in the binary image. */ /*=========================================================*/ space = DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct bsaveDeffacts) + (DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct bsaveDeffactsModule)); GenWrite(&space,sizeof(size_t),fp); /*================================================*/ /* Write out each deffacts module data structure. */ /*================================================*/ DeffactsBinaryData(theEnv)->NumberOfDeffacts = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct deffactsModule *) GetModuleItem(theEnv,NULL,DeffactsData(theEnv)->DeffactsModuleIndex); AssignBsaveDefmdlItemHdrVals(&tempDeffactsModule.header,&theModuleItem->header); GenWrite(&tempDeffactsModule,(unsigned long) sizeof(struct bsaveDeffactsModule),fp); } /*==========================*/ /* Write out each deffacts. */ /*==========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { AssignBsaveConstructHeaderVals(&newDeffacts.header,&theDeffacts->header); if (theDeffacts->assertList != NULL) { newDeffacts.assertList = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDeffacts->assertList); } else { newDeffacts.assertList = -1L; } GenWrite(&newDeffacts,(unsigned long) sizeof(struct bsaveDeffacts),fp); } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of deffacts and deffacts modules in the binary image (these */ /* were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules); RestoreBloadCount(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffacts); } #endif /* BLOAD_AND_BSAVE */ /****************************************************/ /* BloadStorage: Allocates storage requirements for */ /* the deffacts used by this binary image. */ /****************************************************/ static void BloadStorage( void *theEnv) { size_t space; /*=====================================================*/ /* Determine the number of deffacts and deffactsModule */ /* data structures to be read. */ /*=====================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffacts,sizeof(long int)); GenReadBinary(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* deffactsModule data structures. */ /*===================================*/ if (DeffactsBinaryData(theEnv)->NumberOfDeffactsModules == 0) { DeffactsBinaryData(theEnv)->DeffactsArray = NULL; DeffactsBinaryData(theEnv)->ModuleArray = NULL; return; } space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); DeffactsBinaryData(theEnv)->ModuleArray = (struct deffactsModule *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* deffacts data structures. */ /*===================================*/ if (DeffactsBinaryData(theEnv)->NumberOfDeffacts == 0) { DeffactsBinaryData(theEnv)->DeffactsArray = NULL; return; } space = (DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts)); DeffactsBinaryData(theEnv)->DeffactsArray = (struct deffacts *) genalloc(theEnv,space); } /*****************************************************/ /* BloadBinaryItem: Loads and refreshes the deffacts */ /* constructs used by this binary image. */ /*****************************************************/ static void BloadBinaryItem( void *theEnv) { size_t space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); /*============================================*/ /* Read in the deffactsModule data structures */ /* and refresh the pointers. */ /*============================================*/ BloadandRefresh(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffactsModules, sizeof(struct bsaveDeffactsModule),UpdateDeffactsModule); /*======================================*/ /* Read in the deffacts data structures */ /* and refresh the pointers. */ /*======================================*/ BloadandRefresh(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffacts, sizeof(struct bsaveDeffacts),UpdateDeffacts); } /***************************************************/ /* UpdateDeffactsModule: Bload refresh routine for */ /* deffacts module data structures. */ /***************************************************/ static void UpdateDeffactsModule( void *theEnv, void *buf, long obji) { struct bsaveDeffactsModule *bdmPtr; bdmPtr = (struct bsaveDeffactsModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DeffactsBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct deffacts),(void *) DeffactsBinaryData(theEnv)->DeffactsArray); } /*********************************************/ /* UpdateDeffacts: Bload refresh routine for */ /* deffacts data structures. */ /*********************************************/ static void UpdateDeffacts( void *theEnv, void *buf, long obji) { struct bsaveDeffacts *bdp; bdp = (struct bsaveDeffacts *) buf; UpdateConstructHeader(theEnv,&bdp->header,&DeffactsBinaryData(theEnv)->DeffactsArray[obji].header, (int) sizeof(struct deffactsModule),(void *) DeffactsBinaryData(theEnv)->ModuleArray, (int) sizeof(struct deffacts),(void *) DeffactsBinaryData(theEnv)->DeffactsArray); DeffactsBinaryData(theEnv)->DeffactsArray[obji].assertList = ExpressionPointer(bdp->assertList); } /**************************************/ /* ClearBload: Deffacts clear routine */ /* when a binary load is in effect. */ /**************************************/ static void ClearBload( void *theEnv) { long i; size_t space; /*=============================================*/ /* Decrement in use counters for atomic values */ /* contained in the construct headers. */ /*=============================================*/ for (i = 0; i < DeffactsBinaryData(theEnv)->NumberOfDeffacts; i++) { UnmarkConstructHeader(theEnv,&DeffactsBinaryData(theEnv)->DeffactsArray[i].header); } /*=============================================================*/ /* Deallocate the space used for the deffacts data structures. */ /*=============================================================*/ space = DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts); if (space != 0) genfree(theEnv,(void *) DeffactsBinaryData(theEnv)->DeffactsArray,space); DeffactsBinaryData(theEnv)->NumberOfDeffacts = 0; /*====================================================================*/ /* Deallocate the space used for the deffacts module data structures. */ /*====================================================================*/ space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); if (space != 0) genfree(theEnv,(void *) DeffactsBinaryData(theEnv)->ModuleArray,space); DeffactsBinaryData(theEnv)->NumberOfDeffactsModules = 0; } /******************************************************/ /* BloadDeffactsModuleReference: Returns the deffacts */ /* module pointer for use with the bload function. */ /******************************************************/ globle void *BloadDeffactsModuleReference( void *theEnv, int theIndex) { return ((void *) &DeffactsBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFFACTS_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips_core_source_630/core/._miscfun.h0000755000175000017500000000040712373755050016273 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factrete.c0000755000175000017500000010362112373742637016213 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT RETE ACCESS FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Rete access functions for fact pattern matching. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for hashing optimizations. */ /* */ /*************************************************************/ #define _FACTRETE_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "memalloc.h" #include "extnfunc.h" #include "router.h" #include "incrrset.h" #include "reteutil.h" #include "drive.h" #include "engine.h" #include "factgen.h" #include "factmch.h" #include "envrnmnt.h" #include "factrete.h" /***************************************************************/ /* FactPNGetVar1: Fact pattern network function for extracting */ /* a variable's value. This is the most generalized routine. */ /***************************************************************/ globle intBool FactPNGetVar1( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { unsigned short theField, theSlot; struct fact *factPtr; struct field *fieldPtr; struct multifieldMarker *marks; struct multifield *segmentPtr; int extent; struct factGetVarPN1Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarPN1Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ factPtr = FactData(theEnv)->CurrentPatternFact; marks = FactData(theEnv)->CurrentPatternMarks; /*==========================================================*/ /* Determine if we want to retrieve the fact address of the */ /* fact, rather than retrieving a field from the fact. */ /*==========================================================*/ if (hack->factAddress) { returnValue->type = FACT_ADDRESS; returnValue->value = (void *) factPtr; return(TRUE); } /*=========================================================*/ /* Determine if we want to retrieve the entire slot value. */ /*=========================================================*/ if (hack->allFields) { theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; if (returnValue->type == MULTIFIELD) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,((struct multifield *) fieldPtr->value)->multifieldLength); } return(TRUE); } /*====================================================*/ /* If the slot being accessed is a single field slot, */ /* then just return the single value found in that */ /* slot. The multifieldMarker data structures do not */ /* have to be considered since access to a single */ /* field slot is not affected by variable bindings */ /* from multifield slots. */ /*====================================================*/ theField = hack->whichField; theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; /*==========================================================*/ /* Retrieve a value from a multifield slot. First determine */ /* the range of fields for the variable being retrieved. */ /*==========================================================*/ extent = -1; theField = AdjustFieldPosition(theEnv,marks,theField,theSlot,&extent); /*=============================================================*/ /* If a range of values are being retrieved (i.e. a multifield */ /* variable), then return the values as a multifield. */ /*=============================================================*/ if (extent != -1) { returnValue->type = MULTIFIELD; returnValue->value = (void *) fieldPtr->value; returnValue->begin = theField; returnValue->end = theField + extent - 1; return(TRUE); } /*========================================================*/ /* Otherwise a single field value is being retrieved from */ /* a multifield slot. Just return the type and value. */ /*========================================================*/ segmentPtr = (struct multifield *) fieldPtr->value; fieldPtr = &segmentPtr->theFields[theField]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /**************************************************/ /* FactPNGetVar2: Fact pattern network function */ /* for extracting a variable's value. The value */ /* extracted is from a single field slot. */ /**************************************************/ globle intBool FactPNGetVar2( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct factGetVarPN2Call *hack; struct field *fieldPtr; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarPN2Call *) ValueToBitMap(theValue); /*==============================*/ /* Get the pointer to the fact. */ /*==============================*/ factPtr = FactData(theEnv)->CurrentPatternFact; /*============================================*/ /* Extract the value from the specified slot. */ /*============================================*/ fieldPtr = &factPtr->theProposition.theFields[hack->whichSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /*****************************************************************/ /* FactPNGetVar3: Fact pattern network function for extracting a */ /* variable's value. The value extracted is from a multifield */ /* slot that contains at most one multifield variable. */ /*****************************************************************/ globle intBool FactPNGetVar3( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct multifield *segmentPtr; struct field *fieldPtr; struct factGetVarPN3Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue); /*==============================*/ /* Get the pointer to the fact. */ /*==============================*/ factPtr = FactData(theEnv)->CurrentPatternFact; /*============================================================*/ /* Get the multifield value from which the data is retrieved. */ /*============================================================*/ segmentPtr = (struct multifield *) factPtr->theProposition.theFields[hack->whichSlot].value; /*=========================================*/ /* If the beginning and end flags are set, */ /* then retrieve a multifield value. */ /*=========================================*/ if (hack->fromBeginning && hack->fromEnd) { returnValue->type = MULTIFIELD; returnValue->value = (void *) segmentPtr; returnValue->begin = (long) hack->beginOffset; returnValue->end = (long) (segmentPtr->multifieldLength - (hack->endOffset + 1)); return(TRUE); } /*=====================================================*/ /* Return a single field value from a multifield slot. */ /*=====================================================*/ if (hack->fromBeginning) { fieldPtr = &segmentPtr->theFields[hack->beginOffset]; } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->endOffset + 1)]; } returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /******************************************************/ /* FactPNConstant1: Fact pattern network function for */ /* comparing a value stored in a single field slot */ /* to a constant for either equality or inequality. */ /******************************************************/ globle intBool FactPNConstant1( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { #if MAC_XCD #pragma unused(returnValue) #endif struct factConstantPN1Call *hack; struct field *fieldPtr; struct expr *theConstant; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factConstantPN1Call *) ValueToBitMap(theValue); /*============================================*/ /* Extract the value from the specified slot. */ /*============================================*/ fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot]; /*====================================*/ /* Compare the value to the constant. */ /*====================================*/ theConstant = GetFirstArgument(); if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality); if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality); return(hack->testForEquality); } /****************************************************************/ /* FactPNConstant2: Fact pattern network function for comparing */ /* a value stored in a slot to a constant for either equality */ /* or inequality. The value being retrieved from the slot has */ /* no multifields to its right (thus it can be retrieved */ /* relative to the beginning). */ /****************************************************************/ globle intBool FactPNConstant2( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { #if MAC_XCD #pragma unused(returnValue) #endif struct factConstantPN2Call *hack; struct field *fieldPtr; struct expr *theConstant; struct multifield *segmentPtr; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factConstantPN2Call *) ValueToBitMap(theValue); /*==========================================================*/ /* Extract the value from the specified slot. Note that the */ /* test to determine the slot's type (multifield) should be */ /* unnecessary since this routine should only be used for */ /* multifield slots. */ /*==========================================================*/ fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot]; if (fieldPtr->type == MULTIFIELD) { segmentPtr = (struct multifield *) fieldPtr->value; if (hack->fromBeginning) { fieldPtr = &segmentPtr->theFields[hack->offset]; } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->offset + 1)]; } } /*====================================*/ /* Compare the value to the constant. */ /*====================================*/ theConstant = GetFirstArgument(); if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality); if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality); return(hack->testForEquality); } /**************************************************************/ /* FactJNGetVar1: Fact join network function for extracting a */ /* variable's value. This is the most generalized routine. */ /**************************************************************/ globle intBool FactJNGetVar1( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { unsigned short theField, theSlot; struct fact *factPtr; struct field *fieldPtr; struct multifieldMarker *marks; struct multifield *segmentPtr; int extent; struct factGetVarJN1Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarJN1Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ if (hack->lhs) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->markers; } else if (hack->rhs) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,hack->whichPattern)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,hack->whichPattern)->markers; } else if (EngineData(theEnv)->GlobalRHSBinds == NULL) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->markers; } else if ((((unsigned short) (EngineData(theEnv)->GlobalJoin->depth - 1))) == hack->whichPattern) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->markers; } else { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->markers; } /*==========================================================*/ /* Determine if we want to retrieve the fact address of the */ /* fact, rather than retrieving a field from the fact. */ /*==========================================================*/ if (hack->factAddress) { returnValue->type = FACT_ADDRESS; returnValue->value = (void *) factPtr; return(TRUE); } /*=========================================================*/ /* Determine if we want to retrieve the entire slot value. */ /*=========================================================*/ if (hack->allFields) { theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; if (returnValue->type == MULTIFIELD) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,((struct multifield *) fieldPtr->value)->multifieldLength); } return(TRUE); } /*====================================================*/ /* If the slot being accessed is a single field slot, */ /* then just return the single value found in that */ /* slot. The multifieldMarker data structures do not */ /* have to be considered since access to a single */ /* field slot is not affected by variable bindings */ /* from multifield slots. */ /*====================================================*/ theField = hack->whichField; theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; if (fieldPtr->type != MULTIFIELD) { returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /*==========================================================*/ /* Retrieve a value from a multifield slot. First determine */ /* the range of fields for the variable being retrieved. */ /*==========================================================*/ extent = -1; theField = AdjustFieldPosition(theEnv,marks,theField,theSlot,&extent); /*=============================================================*/ /* If a range of values are being retrieved (i.e. a multifield */ /* variable), then return the values as a multifield. */ /*=============================================================*/ if (extent != -1) { returnValue->type = MULTIFIELD; returnValue->value = (void *) fieldPtr->value; returnValue->begin = theField; returnValue->end = theField + extent - 1; return(TRUE); } /*========================================================*/ /* Otherwise a single field value is being retrieved from */ /* a multifield slot. Just return the type and value. */ /*========================================================*/ segmentPtr = (struct multifield *) factPtr->theProposition.theFields[theSlot].value; fieldPtr = &segmentPtr->theFields[theField]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /*************************************************/ /* FactJNGetVar2: Fact join network function for */ /* extracting a variable's value. The value */ /* extracted is from a single field slot. */ /*************************************************/ globle intBool FactJNGetVar2( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct factGetVarJN2Call *hack; struct field *fieldPtr; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarJN2Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ if (hack->lhs) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } else if (hack->rhs) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,hack->whichPattern)->matchingItem; } else if (EngineData(theEnv)->GlobalRHSBinds == NULL) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } else if (((unsigned short) (EngineData(theEnv)->GlobalJoin->depth - 1)) == hack->whichPattern) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; } else { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } /*============================================*/ /* Extract the value from the specified slot. */ /*============================================*/ fieldPtr = &factPtr->theProposition.theFields[hack->whichSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /****************************************************************/ /* FactJNGetVar3: Fact join network function for extracting a */ /* variable's value. The value extracted is from a multifield */ /* slot that contains at most one multifield variable. */ /****************************************************************/ globle intBool FactJNGetVar3( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct multifield *segmentPtr; struct field *fieldPtr; struct factGetVarJN3Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarJN3Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ if (hack->lhs) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } else if (hack->rhs) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,hack->whichPattern)->matchingItem; } else if (EngineData(theEnv)->GlobalRHSBinds == NULL) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } else if (((unsigned short) (EngineData(theEnv)->GlobalJoin->depth - 1)) == hack->whichPattern) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; } else { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } /*============================================================*/ /* Get the multifield value from which the data is retrieved. */ /*============================================================*/ segmentPtr = (struct multifield *) factPtr->theProposition.theFields[hack->whichSlot].value; /*=========================================*/ /* If the beginning and end flags are set, */ /* then retrieve a multifield value. */ /*=========================================*/ if (hack->fromBeginning && hack->fromEnd) { returnValue->type = MULTIFIELD; returnValue->value = (void *) segmentPtr; returnValue->begin = hack->beginOffset; returnValue->end = (long) (segmentPtr->multifieldLength - (hack->endOffset + 1)); return(TRUE); } /*=====================================================*/ /* Return a single field value from a multifield slot. */ /*=====================================================*/ if (hack->fromBeginning) { fieldPtr = &segmentPtr->theFields[hack->beginOffset]; } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->endOffset + 1)]; } returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /****************************************************/ /* FactSlotLength: Determines if the length of a */ /* multifield slot falls within a specified range. */ /****************************************************/ globle intBool FactSlotLength( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct factCheckLengthPNCall *hack; struct multifield *segmentPtr; long extraOffset = 0; struct multifieldMarker *tempMark; returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue); for (tempMark = FactData(theEnv)->CurrentPatternMarks; tempMark != NULL; tempMark = tempMark->next) { if (tempMark->where.whichSlotNumber != hack->whichSlot) continue; extraOffset += ((tempMark->endPosition - tempMark->startPosition) + 1); } segmentPtr = (struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot].value; if (segmentPtr->multifieldLength < (hack->minLength + extraOffset)) { return(FALSE); } if (hack->exactly && (segmentPtr->multifieldLength > (hack->minLength + extraOffset))) { return(FALSE); } returnValue->value = EnvTrueSymbol(theEnv); return(TRUE); } /************************************************************/ /* FactJNCompVars1: Fact join network routine for comparing */ /* the values of two single field slots. */ /************************************************************/ globle int FactJNCompVars1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_XCD #pragma unused(theResult) #endif int p1, e1, p2, e2; struct fact *fact1, *fact2; struct factCompVarsJN1Call *hack; /*=========================================*/ /* Retrieve the arguments to the function. */ /*=========================================*/ hack = (struct factCompVarsJN1Call *) ValueToBitMap(theValue); /*=================================================*/ /* Extract the fact pointers for the two patterns. */ /*=================================================*/ p1 = (int) hack->pattern1; p2 = (int) hack->pattern2; fact1 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p1].gm.theMatch->matchingItem; if (hack->p2rhs) { fact2 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p2].gm.theMatch->matchingItem; } else { fact2 = (struct fact *) EngineData(theEnv)->GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; } /*=====================*/ /* Compare the values. */ /*=====================*/ e1 = (int) hack->slot1; e2 = (int) hack->slot2; if (fact1->theProposition.theFields[e1].type != fact2->theProposition.theFields[e2].type) { return((int) hack->fail); } if (fact1->theProposition.theFields[e1].value != fact2->theProposition.theFields[e2].value) { return((int) hack->fail); } return((int) hack->pass); } /*****************************************************************/ /* FactJNCompVars2: Fact join network routine for comparing the */ /* two single field value that are found in the first slot */ /* (which must also be a multifield slot) of a deftemplate. */ /* This function is provided so that variable comparisons of */ /* implied deftemplates will be faster. */ /*****************************************************************/ globle int FactJNCompVars2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_XCD #pragma unused(theResult) #endif int p1, s1, p2, s2; struct fact *fact1, *fact2; struct factCompVarsJN2Call *hack; struct multifield *segment; struct field *fieldPtr1, *fieldPtr2; /*=========================================*/ /* Retrieve the arguments to the function. */ /*=========================================*/ hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue); /*=================================================*/ /* Extract the fact pointers for the two patterns. */ /*=================================================*/ p1 = (int) hack->pattern1; p2 = (int) hack->pattern2; s1 = (int) hack->slot1; s2 = (int) hack->slot2; fact1 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p1].gm.theMatch->matchingItem; if (hack->p2rhs) { fact2 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p2].gm.theMatch->matchingItem; } else { fact2 = (struct fact *) EngineData(theEnv)->GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; } /*======================*/ /* Retrieve the values. */ /*======================*/ if (fact1->theProposition.theFields[s1].type != MULTIFIELD) { fieldPtr1 = &fact1->theProposition.theFields[s1]; } else { segment = (struct multifield *) fact1->theProposition.theFields[s1].value; if (hack->fromBeginning1) { fieldPtr1 = &segment->theFields[hack->offset1]; } else { fieldPtr1 = &segment->theFields[segment->multifieldLength - (hack->offset1 + 1)]; } } if (fact2->theProposition.theFields[s2].type != MULTIFIELD) { fieldPtr2 = &fact2->theProposition.theFields[s2]; } else { segment = (struct multifield *) fact2->theProposition.theFields[s2].value; if (hack->fromBeginning2) { fieldPtr2 = &segment->theFields[hack->offset2]; } else { fieldPtr2 = &segment->theFields[segment->multifieldLength - (hack->offset2 + 1)]; } } /*=====================*/ /* Compare the values. */ /*=====================*/ if (fieldPtr1->type != fieldPtr2->type) { return((int) hack->fail); } if (fieldPtr1->value != fieldPtr2->value) { return((int) hack->fail); } return((int) hack->pass); } /*****************************************************/ /* FactPNCompVars1: Fact pattern network routine for */ /* comparing the values of two single field slots. */ /*****************************************************/ globle int FactPNCompVars1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { int rv; struct field *fieldPtr1, *fieldPtr2; struct factCompVarsPN1Call *hack; /*========================================*/ /* Extract the arguments to the function. */ /*========================================*/ hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue); fieldPtr1 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field1]; fieldPtr2 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field2]; /*=====================*/ /* Compare the values. */ /*=====================*/ if (fieldPtr1->type != fieldPtr2->type) rv = (int) hack->fail; else if (fieldPtr1->value != fieldPtr2->value) rv = (int) hack->fail; else rv = (int) hack->pass; theResult->type = SYMBOL; if (rv) theResult->value = EnvTrueSymbol(theEnv); else theResult->value = EnvFalseSymbol(theEnv); return(rv); } /*************************************************************************/ /* AdjustFieldPosition: Given a list of multifield markers and the index */ /* to a variable in a slot, this function computes the index to the */ /* field in the slot where the variable begins. In the case of */ /* multifield variables, it also computes the extent (or length) of */ /* the multifield. Note that the extent should be given a default */ /* value of either -1 or 1 for variables other than multifield */ /* variables before calling this routine. An extent of -1 for these */ /* variables will distinguish their extent as being different when it */ /* is necessary to note their difference from a multifield variable */ /* with an extent of 1. For example, given the slot pattern */ /* (data $?x c $?y ?z) and the slot value (data a b c d e f x), the */ /* actual index in the fact for the 5th item in the pattern (the */ /* variable ?z) would be 8 since $?x binds to 2 fields and $?y binds */ /* to 3 fields. */ /*************************************************************************/ globle unsigned short AdjustFieldPosition( void *theEnv, struct multifieldMarker *markList, unsigned short whichField, unsigned short whichSlot, int *extent) { unsigned short actualIndex; #if MAC_XCD #pragma unused(theEnv) #endif actualIndex = whichField; for (; markList != NULL; markList = markList->next) { /*===============================================*/ /* Skip over multifield markers for other slots. */ /*===============================================*/ if (markList->where.whichSlotNumber != whichSlot) continue; /*=========================================================*/ /* If the multifield marker occurs exactly at the field in */ /* question, then the actual index needs to be adjusted */ /* and the extent needs to be computed since the value is */ /* a multifield value. */ /*=========================================================*/ if (markList->whichField == whichField) { *extent = (markList->endPosition - markList->startPosition) + 1; return(actualIndex); } /*=====================================================*/ /* Otherwise if the multifield marker occurs after the */ /* field in question, then the actual index has been */ /* completely computed and can be returned. */ /*=====================================================*/ else if (markList->whichField > whichField) { return(actualIndex); } /*==========================================================*/ /* Adjust the actual index to the field based on the number */ /* of fields taken up by the preceding multifield variable. */ /*==========================================================*/ actualIndex += (unsigned short) (markList->endPosition - markList->startPosition); } /*=======================================*/ /* Return the actual index to the field. */ /*=======================================*/ return(actualIndex); } /*****************************************************/ /* FactStoreMultifield: This primitive is used by a */ /* number of multifield functions for grouping a */ /* series of valuesinto a single multifield value. */ /*****************************************************/ globle int FactStoreMultifield( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_XCD #pragma unused(theValue) #endif StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE); return(TRUE); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips_core_source_630/core/._symblbin.h0000755000175000017500000000040712373755530016451 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffctdef.c0000755000175000017500000000040712461251756016371 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/watch.h0000755000175000017500000001057412373740561015527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* WATCH HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Support functions for the watch and unwatch */ /* commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvSetWatchItem function. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_watch #define _H_watch #ifndef _H_expressn #include "expressn.h" #endif #define WATCH_DATA 54 struct watchItem { const char *name; unsigned *flag; int code,priority; unsigned (*accessFunc)(void *,int,unsigned,struct expr *); unsigned (*printFunc)(void *,const char *,int,struct expr *); struct watchItem *next; }; struct watchData { struct watchItem *ListOfWatchItems; }; #define WatchData(theEnv) ((struct watchData *) GetEnvironmentData(theEnv,WATCH_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _WATCH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool EnvWatch(void *,const char *); LOCALE intBool EnvUnwatch(void *,const char *); LOCALE void InitializeWatchData(void *); LOCALE int EnvSetWatchItem(void *,const char *,unsigned,struct expr *); LOCALE int EnvGetWatchItem(void *,const char *); LOCALE intBool AddWatchItem(void *,const char *,int,unsigned *,int, unsigned (*)(void *,int,unsigned,struct expr *), unsigned (*)(void *,const char *,int,struct expr *)); LOCALE const char *GetNthWatchName(void *,int); LOCALE int GetNthWatchValue(void *,int); LOCALE void WatchCommand(void *); LOCALE void UnwatchCommand(void *); LOCALE void ListWatchItemsCommand(void *); LOCALE void WatchFunctionDefinitions(void *); LOCALE int GetWatchItemCommand(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool Watch(const char *); LOCALE intBool Unwatch(const char *); LOCALE int GetWatchItem(const char *); LOCALE int SetWatchItem(const char *,unsigned,struct expr *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_watch */ clips_core_source_630/core/._rulebsc.h0000755000175000017500000000040712464554105016265 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/genrcbin.h0000755000175000017500000000457712373753414016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_genrcbin #define _H_genrcbin #include "genrcfun.h" #define GENRCBIN_DATA 28 struct defgenericBinaryData { DEFGENERIC *DefgenericArray; long ModuleCount; long GenericCount; long MethodCount; long RestrictionCount; long TypeCount; DEFGENERIC_MODULE *ModuleArray; DEFMETHOD *MethodArray; RESTRICTION *RestrictionArray; void **TypeArray; }; #define DefgenericBinaryData(theEnv) ((struct defgenericBinaryData *) GetEnvironmentData(theEnv,GENRCBIN_DATA)) #define GenericPointer(i) (((i) == -1L) ? NULL : (DEFGENERIC *) &DefgenericBinaryData(theEnv)->DefgenericArray[i]) #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupGenericsBload(void *); LOCALE void *BloadDefgenericModuleReference(void *,int); #endif /* _H_genrcbin */ clips_core_source_630/core/prcdrfun.h0000755000175000017500000000724612373743661016252 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PROCEDURAL FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Local variables set with the bind function */ /* persist until a reset/clear command is issued. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Support for long long integers. */ /* */ /*************************************************************/ #ifndef _H_prcdrfun #define _H_prcdrfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _PRCDRFUN_SOURCE #define LOCALE #else #define LOCALE extern #endif typedef struct loopCounterStack { long long loopCounter; struct loopCounterStack *nxt; } LOOP_COUNTER_STACK; #define PRCDRFUN_DATA 13 struct procedureFunctionData { int ReturnFlag; int BreakFlag; LOOP_COUNTER_STACK *LoopCounterStack; struct dataObject *BindList; }; #define ProcedureFunctionData(theEnv) ((struct procedureFunctionData *) GetEnvironmentData(theEnv,PRCDRFUN_DATA)) LOCALE void ProceduralFunctionDefinitions(void *); LOCALE void WhileFunction(void *,DATA_OBJECT_PTR); LOCALE void LoopForCountFunction(void *,DATA_OBJECT_PTR); LOCALE long long GetLoopCount(void *); LOCALE void IfFunction(void *,DATA_OBJECT_PTR); LOCALE void BindFunction(void *,DATA_OBJECT_PTR); LOCALE void PrognFunction(void *,DATA_OBJECT_PTR); LOCALE void ReturnFunction(void *,DATA_OBJECT_PTR); LOCALE void BreakFunction(void *); LOCALE void SwitchFunction(void *,DATA_OBJECT_PTR); LOCALE intBool GetBoundVariable(void *,struct dataObject *,struct symbolHashNode *); LOCALE void FlushBindList(void *); #endif /* _H_prcdrfun */ clips_core_source_630/core/router.c0000755000175000017500000006147112424475506015737 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* I/O ROUTER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a centralized mechanism for handling */ /* input and output requests. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed conversion of '\r' to '\n' from the */ /* EnvGetcRouter function. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added support for passing context information */ /* to the router functions. */ /* */ /* 6.30: Fixed issues with passing context to routers. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _ROUTER_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "argacces.h" #include "constant.h" #include "envrnmnt.h" #include "extnfunc.h" #include "filertr.h" #include "memalloc.h" #include "strngrtr.h" #include "sysdep.h" #include "router.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int QueryRouter(void *,const char *,struct router *); static void DeallocateRouterData(void *); /*********************************************************/ /* InitializeDefaultRouters: Initializes output streams. */ /*********************************************************/ globle void InitializeDefaultRouters( void *theEnv) { AllocateEnvironmentData(theEnv,ROUTER_DATA,sizeof(struct routerData),DeallocateRouterData); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; #if (! RUN_TIME) EnvDefineFunction2(theEnv,"exit", 'v', PTIEF ExitCommand, "ExitCommand", "*1i"); #endif InitializeFileRouter(theEnv); InitializeStringRouter(theEnv); } /*************************************************/ /* DeallocateRouterData: Deallocates environment */ /* data for I/O routers. */ /*************************************************/ static void DeallocateRouterData( void *theEnv) { struct router *tmpPtr, *nextPtr; tmpPtr = RouterData(theEnv)->ListOfRouters; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; genfree(theEnv,(void *) tmpPtr->name,strlen(tmpPtr->name) + 1); rtn_struct(theEnv,router,tmpPtr); tmpPtr = nextPtr; } } /*******************************************/ /* EnvPrintRouter: Generic print function. */ /*******************************************/ globle int EnvPrintRouter( void *theEnv, const char *logicalName, const char *str) { struct router *currentPtr; /*===================================================*/ /* If the "fast save" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* fprintf can be called directly to bypass querying */ /* all of the routers. */ /*===================================================*/ if (((char *) RouterData(theEnv)->FastSaveFilePtr) == logicalName) { fprintf(RouterData(theEnv)->FastSaveFilePtr,"%s",str); return(2); } /*==============================================*/ /* Search through the list of routers until one */ /* is found that will handle the print request. */ /*==============================================*/ currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if ((currentPtr->printer != NULL) ? QueryRouter(theEnv,logicalName,currentPtr) : FALSE) { SetEnvironmentRouterContext(theEnv,currentPtr->context); if (currentPtr->environmentAware) { (*currentPtr->printer)(theEnv,logicalName,str); } else { ((int (*)(const char *,const char *)) (*currentPtr->printer))(logicalName,str); } return(1); } currentPtr = currentPtr->next; } /*=====================================================*/ /* The logical name was not recognized by any routers. */ /*=====================================================*/ if (strcmp(WERROR,logicalName) != 0) UnrecognizedRouterMessage(theEnv,logicalName); return(0); } /**************************************************/ /* EnvGetcRouter: Generic get character function. */ /**************************************************/ globle int EnvGetcRouter( void *theEnv, const char *logicalName) { struct router *currentPtr; int inchar; /*===================================================*/ /* If the "fast load" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* getc can be called directly to bypass querying */ /* all of the routers. */ /*===================================================*/ if (((char *) RouterData(theEnv)->FastLoadFilePtr) == logicalName) { inchar = getc(RouterData(theEnv)->FastLoadFilePtr); if ((inchar == '\r') || (inchar == '\n')) { if (((char *) RouterData(theEnv)->FastLoadFilePtr) == RouterData(theEnv)->LineCountRouter) { IncrementLineCount(theEnv); } } /* if (inchar == '\r') return('\n'); */ return(inchar); } /*===============================================*/ /* If the "fast string get" option is being used */ /* for the specified logical name, then bypass */ /* the router system and extract the character */ /* directly from the fast get string. */ /*===============================================*/ if (RouterData(theEnv)->FastCharGetRouter == logicalName) { inchar = (unsigned char) RouterData(theEnv)->FastCharGetString[RouterData(theEnv)->FastCharGetIndex]; RouterData(theEnv)->FastCharGetIndex++; if (inchar == '\0') return(EOF); if ((inchar == '\r') || (inchar == '\n')) { if (RouterData(theEnv)->FastCharGetRouter == RouterData(theEnv)->LineCountRouter) { IncrementLineCount(theEnv); } } return(inchar); } /*==============================================*/ /* Search through the list of routers until one */ /* is found that will handle the getc request. */ /*==============================================*/ currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if ((currentPtr->charget != NULL) ? QueryRouter(theEnv,logicalName,currentPtr) : FALSE) { SetEnvironmentRouterContext(theEnv,currentPtr->context); if (currentPtr->environmentAware) { inchar = (*currentPtr->charget)(theEnv,logicalName); } else { inchar = ((int (*)(const char *)) (*currentPtr->charget))(logicalName); } if ((inchar == '\r') || (inchar == '\n')) { if ((RouterData(theEnv)->LineCountRouter != NULL) && (strcmp(logicalName,RouterData(theEnv)->LineCountRouter) == 0)) { IncrementLineCount(theEnv); } } return(inchar); } currentPtr = currentPtr->next; } /*=====================================================*/ /* The logical name was not recognized by any routers. */ /*=====================================================*/ UnrecognizedRouterMessage(theEnv,logicalName); return(-1); } /******************************************************/ /* EnvUngetcRouter: Generic unget character function. */ /******************************************************/ globle int EnvUngetcRouter( void *theEnv, int ch, const char *logicalName) { struct router *currentPtr; /*===================================================*/ /* If the "fast load" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* ungetc can be called directly to bypass querying */ /* all of the routers. */ /*===================================================*/ if (((char *) RouterData(theEnv)->FastLoadFilePtr) == logicalName) { if ((ch == '\r') || (ch == '\n')) { if (((char *) RouterData(theEnv)->FastLoadFilePtr) == RouterData(theEnv)->LineCountRouter) { DecrementLineCount(theEnv); } } return(ungetc(ch,RouterData(theEnv)->FastLoadFilePtr)); } /*===============================================*/ /* If the "fast string get" option is being used */ /* for the specified logical name, then bypass */ /* the router system and unget the character */ /* directly from the fast get string. */ /*===============================================*/ if (RouterData(theEnv)->FastCharGetRouter == logicalName) { if ((ch == '\r') || (ch == '\n')) { if (RouterData(theEnv)->FastCharGetRouter == RouterData(theEnv)->LineCountRouter) { DecrementLineCount(theEnv); } } if (RouterData(theEnv)->FastCharGetIndex > 0) RouterData(theEnv)->FastCharGetIndex--; return(ch); } /*===============================================*/ /* Search through the list of routers until one */ /* is found that will handle the ungetc request. */ /*===============================================*/ currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if ((currentPtr->charunget != NULL) ? QueryRouter(theEnv,logicalName,currentPtr) : FALSE) { if ((ch == '\r') || (ch == '\n')) { if ((RouterData(theEnv)->LineCountRouter != NULL) && (strcmp(logicalName,RouterData(theEnv)->LineCountRouter) == 0)) { DecrementLineCount(theEnv); } } SetEnvironmentRouterContext(theEnv,currentPtr->context); if (currentPtr->environmentAware) { return((*currentPtr->charunget)(theEnv,ch,logicalName)); } else { return(((int (*)(int,const char *)) (*currentPtr->charunget))(ch,logicalName)); } } currentPtr = currentPtr->next; } /*=====================================================*/ /* The logical name was not recognized by any routers. */ /*=====================================================*/ UnrecognizedRouterMessage(theEnv,logicalName); return(-1); } /*****************************************************/ /* ExitCommand: H/L command for exiting the program. */ /*****************************************************/ globle void ExitCommand( void *theEnv) { int argCnt; int status; if ((argCnt = EnvArgCountCheck(theEnv,"exit",NO_MORE_THAN,1)) == -1) return; if (argCnt == 0) { EnvExitRouter(theEnv,EXIT_SUCCESS); } else { status = (int) EnvRtnLong(theEnv,1); if (GetEvaluationError(theEnv)) return; EnvExitRouter(theEnv,status); } return; } /***********************************************/ /* EnvExitRouter: Generic exit function. Calls */ /* all of the router exit functions. */ /***********************************************/ globle void EnvExitRouter( void *theEnv, int num) { struct router *currentPtr, *nextPtr; RouterData(theEnv)->Abort = FALSE; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { nextPtr = currentPtr->next; if (currentPtr->active == TRUE) { if (currentPtr->exiter != NULL) { SetEnvironmentRouterContext(theEnv,currentPtr->context); if (currentPtr->environmentAware) { (*currentPtr->exiter)(theEnv,num); } else { ((int (*)(int))(*currentPtr->exiter))(num); } } } currentPtr = nextPtr; } if (RouterData(theEnv)->Abort) return; genexit(theEnv,num); } /********************************************/ /* AbortExit: Forces ExitRouter to terminate */ /* after calling all closing routers. */ /********************************************/ globle void AbortExit( void *theEnv) { RouterData(theEnv)->Abort = TRUE; } /************************************************************/ /* EnvAddRouter: Adds an I/O router to the list of routers. */ /************************************************************/ globle intBool EnvAddRouter( void *theEnv, const char *routerName, int priority, int (*queryFunction)(void *,const char *), int (*printFunction)(void *,const char *,const char *), int (*getcFunction)(void *,const char *), int (*ungetcFunction)(void *,int,const char *), int (*exitFunction)(void *,int)) { return EnvAddRouterWithContext(theEnv,routerName,priority, queryFunction,printFunction,getcFunction, ungetcFunction,exitFunction,NULL); } /***********************************************************************/ /* EnvAddRouterWithContext: Adds an I/O router to the list of routers. */ /***********************************************************************/ globle intBool EnvAddRouterWithContext( void *theEnv, const char *routerName, int priority, int (*queryFunction)(void *,const char *), int (*printFunction)(void *,const char *,const char *), int (*getcFunction)(void *,const char *), int (*ungetcFunction)(void *,int,const char *), int (*exitFunction)(void *,int), void *context) { struct router *newPtr, *lastPtr, *currentPtr; char *nameCopy; newPtr = get_struct(theEnv,router); nameCopy = (char *) genalloc(theEnv,strlen(routerName) + 1); genstrcpy(nameCopy,routerName); newPtr->name = nameCopy; newPtr->active = TRUE; newPtr->environmentAware = TRUE; newPtr->context = context; newPtr->priority = priority; newPtr->query = queryFunction; newPtr->printer = printFunction; newPtr->exiter = exitFunction; newPtr->charget = getcFunction; newPtr->charunget = ungetcFunction; newPtr->next = NULL; if (RouterData(theEnv)->ListOfRouters == NULL) { RouterData(theEnv)->ListOfRouters = newPtr; return(1); } lastPtr = NULL; currentPtr = RouterData(theEnv)->ListOfRouters; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = RouterData(theEnv)->ListOfRouters; RouterData(theEnv)->ListOfRouters = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); } /********************************************************************/ /* EnvDeleteRouter: Removes an I/O router from the list of routers. */ /********************************************************************/ globle int EnvDeleteRouter( void *theEnv, const char *routerName) { struct router *currentPtr, *lastPtr; currentPtr = RouterData(theEnv)->ListOfRouters; lastPtr = NULL; while (currentPtr != NULL) { if (strcmp(currentPtr->name,routerName) == 0) { genfree(theEnv,(void *) currentPtr->name,strlen(currentPtr->name) + 1); if (lastPtr == NULL) { RouterData(theEnv)->ListOfRouters = currentPtr->next; rm(theEnv,currentPtr,(int) sizeof(struct router)); return(1); } lastPtr->next = currentPtr->next; rm(theEnv,currentPtr,(int) sizeof(struct router)); return(1); } lastPtr = currentPtr; currentPtr = currentPtr->next; } return(0); } /*********************************************************************/ /* QueryRouters: Determines if any router recognizes a logical name. */ /*********************************************************************/ globle int QueryRouters( void *theEnv, const char *logicalName) { struct router *currentPtr; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if (QueryRouter(theEnv,logicalName,currentPtr) == TRUE) return(TRUE); currentPtr = currentPtr->next; } return(FALSE); } /************************************************/ /* QueryRouter: Determines if a specific router */ /* recognizes a logical name. */ /************************************************/ static int QueryRouter( void *theEnv, const char *logicalName, struct router *currentPtr) { /*===================================================*/ /* If the router is inactive, then it can't respond. */ /*===================================================*/ if (currentPtr->active == FALSE) { return(FALSE); } /*=============================================================*/ /* If the router has no query function, then it can't respond. */ /*=============================================================*/ if (currentPtr->query == NULL) return(FALSE); /*=========================================*/ /* Call the router's query function to see */ /* if it recognizes the logical name. */ /*=========================================*/ SetEnvironmentRouterContext(theEnv,currentPtr->context); if (currentPtr->environmentAware) { if ((*currentPtr->query)(theEnv,logicalName) == TRUE) { return(TRUE); } } else { if (((int (*)(const char *)) (*currentPtr->query))(logicalName) == TRUE) { return(TRUE); } } return(FALSE); } /*******************************************************/ /* EnvDeactivateRouter: Deactivates a specific router. */ /*******************************************************/ globle int EnvDeactivateRouter( void *theEnv, const char *routerName) { struct router *currentPtr; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if (strcmp(currentPtr->name,routerName) == 0) { currentPtr->active = FALSE; return(TRUE); } currentPtr = currentPtr->next; } return(FALSE); } /***************************************************/ /* EnvActivateRouter: Activates a specific router. */ /***************************************************/ globle int EnvActivateRouter( void *theEnv, const char *routerName) { struct router *currentPtr; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if (strcmp(currentPtr->name,routerName) == 0) { currentPtr->active = TRUE; return(TRUE); } currentPtr = currentPtr->next; } return(FALSE); } /********************************************************/ /* SetFastLoad: Used to bypass router system for loads. */ /********************************************************/ globle void SetFastLoad( void *theEnv, FILE *filePtr) { RouterData(theEnv)->FastLoadFilePtr = filePtr; } /********************************************************/ /* SetFastSave: Used to bypass router system for saves. */ /********************************************************/ globle void SetFastSave( void *theEnv, FILE *filePtr) { RouterData(theEnv)->FastSaveFilePtr = filePtr; } /******************************************************/ /* GetFastLoad: Returns the "fast load" file pointer. */ /******************************************************/ globle FILE *GetFastLoad( void *theEnv) { return(RouterData(theEnv)->FastLoadFilePtr); } /******************************************************/ /* GetFastSave: Returns the "fast save" file pointer. */ /******************************************************/ globle FILE *GetFastSave( void *theEnv) { return(RouterData(theEnv)->FastSaveFilePtr); } /*****************************************************/ /* UnrecognizedRouterMessage: Standard error message */ /* for an unrecognized router name. */ /*****************************************************/ globle void UnrecognizedRouterMessage( void *theEnv, const char *logicalName) { PrintErrorID(theEnv,"ROUTER",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Logical name "); EnvPrintRouter(theEnv,WERROR,logicalName); EnvPrintRouter(theEnv,WERROR," was not recognized by any routers\n"); } /*****************************************/ /* PrintNRouter: Generic print function. */ /*****************************************/ globle int PrintNRouter( void *theEnv, const char *logicalName, const char *str, unsigned long length) { char *tempStr; int rv; tempStr = (char *) genalloc(theEnv,length+1); genstrncpy(tempStr,str,length); tempStr[length] = 0; rv = EnvPrintRouter(theEnv,logicalName,tempStr); genfree(theEnv,tempStr,length+1); return(rv); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle int ActivateRouter( const char *routerName) { return EnvActivateRouter(GetCurrentEnvironment(),routerName); } globle intBool AddRouter( const char *routerName, int priority, int (*queryFunction)(const char *), int (*printFunction)(const char *,const char *), int (*getcFunction)(const char *), int (*ungetcFunction)(int,const char *), int (*exitFunction)(int)) { struct router *newPtr, *lastPtr, *currentPtr; void *theEnv; char *nameCopy; theEnv = GetCurrentEnvironment(); newPtr = get_struct(theEnv,router); nameCopy = (char *) genalloc(theEnv,strlen(routerName) + 1); genstrcpy(nameCopy,routerName); newPtr->name = nameCopy; newPtr->active = TRUE; newPtr->environmentAware = FALSE; newPtr->priority = priority; newPtr->context = NULL; newPtr->query = (int (*)(void *,const char *)) queryFunction; newPtr->printer = (int (*)(void *,const char *,const char *)) printFunction; newPtr->exiter = (int (*)(void *,int)) exitFunction; newPtr->charget = (int (*)(void *,const char *)) getcFunction; newPtr->charunget = (int (*)(void *,int,const char *)) ungetcFunction; newPtr->next = NULL; if (RouterData(theEnv)->ListOfRouters == NULL) { RouterData(theEnv)->ListOfRouters = newPtr; return(1); } lastPtr = NULL; currentPtr = RouterData(theEnv)->ListOfRouters; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = RouterData(theEnv)->ListOfRouters; RouterData(theEnv)->ListOfRouters = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); } globle int DeactivateRouter( const char *routerName) { return EnvDeactivateRouter(GetCurrentEnvironment(),routerName); } globle int DeleteRouter( const char *routerName) { return EnvDeleteRouter(GetCurrentEnvironment(),routerName); } globle void ExitRouter( int num) { EnvExitRouter(GetCurrentEnvironment(),num); } globle int GetcRouter( const char *logicalName) { return EnvGetcRouter(GetCurrentEnvironment(),logicalName); } globle int PrintRouter( const char *logicalName, const char *str) { return EnvPrintRouter(GetCurrentEnvironment(),logicalName,str); } globle int UngetcRouter( int ch, const char *logicalName) { return EnvUngetcRouter(GetCurrentEnvironment(),ch,logicalName); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/._factbld.h0000755000175000017500000000040712373742663016234 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._main.c0000755000175000017500000000040712424476503015546 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._immthpsr.c0000755000175000017500000000040712373755065016473 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlpsr.c0000755000175000017500000004160112373753361016235 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses the defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Made the construct redefinition message more */ /* prominent. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Moved WatchGlobals global to defglobalData. */ /* */ /*************************************************************/ #define _GLOBLPSR_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include #include "pprint.h" #include "router.h" #include "memalloc.h" #include "scanner.h" #include "evaluatn.h" #include "exprnpsr.h" #include "constrct.h" #include "multifld.h" #include "watch.h" #include "modulutl.h" #include "modulpsr.h" #include "cstrcpsr.h" #include "globldef.h" #include "globlbsc.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "globlpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static intBool GetVariableDefinition(void *,const char *,int *,int,struct token *); static void AddDefglobal(void *,SYMBOL_HN *,DATA_OBJECT_PTR,struct expr *); #endif /*********************************************************************/ /* ParseDefglobal: Coordinates all actions necessary for the parsing */ /* and creation of a defglobal into the current environment. */ /*********************************************************************/ globle intBool ParseDefglobal( void *theEnv, const char *readSource) { int defglobalError = FALSE; #if (! RUN_TIME) && (! BLOAD_ONLY) struct token theToken; int tokenRead = TRUE; struct defmodule *theModule; /*=====================================*/ /* Pretty print buffer initialization. */ /*=====================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defglobal "); /*=================================================*/ /* Individual defglobal constructs can't be parsed */ /* while a binary load is in effect. */ /*=================================================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defglobal"); return(TRUE); } #endif /*===========================*/ /* Look for the module name. */ /*===========================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type == SYMBOL) { /*=================================================*/ /* The optional module name can't contain a module */ /* separator like other constructs. For example, */ /* (defrule X::foo is OK for rules, but the right */ /* syntax for defglobals is (defglobal X ?*foo*. */ /*=================================================*/ tokenRead = FALSE; if (FindModuleSeparator(ValueToString(theToken.value))) { SyntaxErrorMessage(theEnv,"defglobal"); return(TRUE); } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value)); return(TRUE); } /*=========================================*/ /* If the module name was OK, then set the */ /* current module to the specified module. */ /*=========================================*/ SavePPBuffer(theEnv," "); EnvSetCurrentModule(theEnv,(void *) theModule); } /*===========================================*/ /* If the module name wasn't specified, then */ /* use the current module's name in the */ /* defglobal's pretty print representation. */ /*===========================================*/ else { PPBackup(theEnv); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); } /*======================*/ /* Parse the variables. */ /*======================*/ while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken)) { tokenRead = FALSE; FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defglobal "); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv," "); } #endif /*==================================*/ /* Return the parsing error status. */ /*==================================*/ return(defglobalError); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************************/ /* GetVariableDefinition: Parses and evaluates a single global */ /* variable in a defglobal construct. Returns TRUE if the */ /* variable was successfully parsed and FALSE if a right */ /* parenthesis is encountered (signifying the end of the */ /* defglobal construct) or an error occurs. The error status */ /* flag is also set if an error occurs. */ /***************************************************************/ static intBool GetVariableDefinition( void *theEnv, const char *readSource, int *defglobalError, int tokenRead, struct token *theToken) { SYMBOL_HN *variableName; struct expr *assignPtr; DATA_OBJECT assignValue; /*========================================*/ /* Get next token, which should either be */ /* a closing parenthesis or a variable. */ /*========================================*/ if (! tokenRead) GetToken(theEnv,readSource,theToken); if (theToken->type == RPAREN) return(FALSE); if (theToken->type == SF_VARIABLE) { SyntaxErrorMessage(theEnv,"defglobal"); *defglobalError = TRUE; return(FALSE); } else if (theToken->type != GBL_VARIABLE) { SyntaxErrorMessage(theEnv,"defglobal"); *defglobalError = TRUE; return(FALSE); } variableName = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); /*================================*/ /* Print out compilation message. */ /*================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == ON) && GetPrintWhileLoading(theEnv)) { const char *outRouter = WDIALOG; if (QFindDefglobal(theEnv,variableName) != NULL) { outRouter = WWARNING; PrintWarningID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,outRouter,"Redefining defglobal: "); } else EnvPrintRouter(theEnv,outRouter,"Defining defglobal: "); EnvPrintRouter(theEnv,outRouter,ValueToString(variableName)); EnvPrintRouter(theEnv,outRouter,"\n"); } else #endif { if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,":"); } /*==================================================================*/ /* Check for import/export conflicts from the construct definition. */ /*==================================================================*/ #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName))) { ImportExportConflictMessage(theEnv,"defglobal",ValueToString(variableName),NULL,NULL); *defglobalError = TRUE; return(FALSE); } #endif /*==============================*/ /* The next token must be an =. */ /*==============================*/ GetToken(theEnv,readSource,theToken); if (strcmp(theToken->printForm,"=") != 0) { SyntaxErrorMessage(theEnv,"defglobal"); *defglobalError = TRUE; return(FALSE); } SavePPBuffer(theEnv," "); /*======================================================*/ /* Parse the expression to be assigned to the variable. */ /*======================================================*/ assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL); if (assignPtr == NULL) { *defglobalError = TRUE; return(FALSE); } /*==========================*/ /* Evaluate the expression. */ /*==========================*/ if (! ConstructData(theEnv)->CheckSyntaxMode) { SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,assignPtr,&assignValue)) { ReturnExpression(theEnv,assignPtr); *defglobalError = TRUE; return(FALSE); } } else { ReturnExpression(theEnv,assignPtr); } SavePPBuffer(theEnv,")"); /*======================================*/ /* Add the variable to the global list. */ /*======================================*/ if (! ConstructData(theEnv)->CheckSyntaxMode) { AddDefglobal(theEnv,variableName,&assignValue,assignPtr); } /*==================================================*/ /* Return TRUE to indicate that the global variable */ /* definition was successfully parsed. */ /*==================================================*/ return(TRUE); } /*********************************************************/ /* AddDefglobal: Adds a defglobal to the current module. */ /*********************************************************/ static void AddDefglobal( void *theEnv, SYMBOL_HN *name, DATA_OBJECT_PTR vPtr, struct expr *ePtr) { struct defglobal *defglobalPtr; intBool newGlobal = FALSE; #if DEBUGGING_FUNCTIONS int GlobalHadWatch = FALSE; #endif /*========================================================*/ /* If the defglobal is already defined, then use the old */ /* data structure and substitute new values. If it hasn't */ /* been defined, then create a new data structure. */ /*========================================================*/ defglobalPtr = QFindDefglobal(theEnv,name); if (defglobalPtr == NULL) { newGlobal = TRUE; defglobalPtr = get_struct(theEnv,defglobal); } else { DeinstallConstructHeader(theEnv,&defglobalPtr->header); #if DEBUGGING_FUNCTIONS GlobalHadWatch = defglobalPtr->watch; #endif } /*===========================================*/ /* Remove the old values from the defglobal. */ /*===========================================*/ if (newGlobal == FALSE) { ValueDeinstall(theEnv,&defglobalPtr->current); if (defglobalPtr->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); } RemoveHashedExpression(theEnv,defglobalPtr->initial); } /*=======================================*/ /* Copy the new values to the defglobal. */ /*=======================================*/ defglobalPtr->current.type = vPtr->type; if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value; else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr); ValueInstall(theEnv,&defglobalPtr->current); defglobalPtr->initial = AddHashedExpression(theEnv,ePtr); ReturnExpression(theEnv,ePtr); DefglobalData(theEnv)->ChangeToGlobals = TRUE; /*=================================*/ /* Restore the old watch value to */ /* the defglobal if redefined. */ /*=================================*/ #if DEBUGGING_FUNCTIONS defglobalPtr->watch = GlobalHadWatch ? TRUE : DefglobalData(theEnv)->WatchGlobals; #endif /*======================================*/ /* Save the name and pretty print form. */ /*======================================*/ defglobalPtr->header.name = name; defglobalPtr->header.usrData = NULL; IncrementSymbolCount(name); SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { defglobalPtr->header.ppForm = NULL; } else { defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); } defglobalPtr->inScope = TRUE; /*=============================================*/ /* If the defglobal was redefined, we're done. */ /*=============================================*/ if (newGlobal == FALSE) return; /*===================================*/ /* Copy the defglobal variable name. */ /*===================================*/ defglobalPtr->busyCount = 0; defglobalPtr->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex); /*=============================================*/ /* Add the defglobal to the list of defglobals */ /* for the current module. */ /*=============================================*/ AddConstructToModule(&defglobalPtr->header); } /*****************************************************************/ /* ReplaceGlobalVariable: Replaces a global variable found in an */ /* expression with the appropriate primitive data type which */ /* can later be used to retrieve the global variable's value. */ /*****************************************************************/ globle intBool ReplaceGlobalVariable( void *theEnv, struct expr *ePtr) { struct defglobal *theGlobal; int count; /*=================================*/ /* Search for the global variable. */ /*=================================*/ theGlobal = (struct defglobal *) FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(ePtr->value), &count,TRUE,NULL); /*=============================================*/ /* If it wasn't found, print an error message. */ /*=============================================*/ if (theGlobal == NULL) { GlobalReferenceErrorMessage(theEnv,ValueToString(ePtr->value)); return(FALSE); } /*========================================================*/ /* The current implementation of the defmodules shouldn't */ /* allow a construct to be defined which would cause an */ /* ambiguous reference, but we'll check for it anyway. */ /*========================================================*/ if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"defglobal",ValueToString(ePtr->value)); return(FALSE); } /*==============================================*/ /* Replace the symbolic reference of the global */ /* variable with a direct pointer reference. */ /*==============================================*/ ePtr->type = DEFGLOBAL_PTR; ePtr->value = (void *) theGlobal; return(TRUE); } /*****************************************************************/ /* GlobalReferenceErrorMessage: Prints an error message when a */ /* symbolic reference to a global variable cannot be resolved. */ /*****************************************************************/ globle void GlobalReferenceErrorMessage( void *theEnv, const char *variableName) { PrintErrorID(theEnv,"GLOBLPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"\nGlobal variable ?*"); EnvPrintRouter(theEnv,WERROR,variableName); EnvPrintRouter(theEnv,WERROR,"* was referenced, but is not defined.\n"); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFGLOBAL_CONSTRUCT */ clips_core_source_630/core/emathfun.h0000755000175000017500000001132112373740015016211 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 12/27/07 */ /* */ /* EXTENDED MATH FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for numerous extended math */ /* functions including cos, sin, tan, sec, csc, cot, acos, */ /* asin, atan, asec, acsc, acot, cosh, sinh, tanh, sech, */ /* csch, coth, acosh, asinh, atanh, asech, acsch, acoth, */ /* mod, exp, log, log10, sqrt, pi, deg-rad, rad-deg, */ /* deg-grad, grad-deg, **, and round. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Support for long long integers. */ /* */ /* Renamed EX_MATH compiler flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_emathfun #define _H_emathfun #ifdef LOCALE #undef LOCALE #endif #ifdef _EMATHFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ExtendedMathFunctionDefinitions(void *theEnv); #if EXTENDED_MATH_FUNCTIONS LOCALE double CosFunction(void *); LOCALE double SinFunction(void *); LOCALE double TanFunction(void *); LOCALE double SecFunction(void *); LOCALE double CscFunction(void *); LOCALE double CotFunction(void *); LOCALE double AcosFunction(void *); LOCALE double AsinFunction(void *); LOCALE double AtanFunction(void *); LOCALE double AsecFunction(void *); LOCALE double AcscFunction(void *); LOCALE double AcotFunction(void *); LOCALE double CoshFunction(void *); LOCALE double SinhFunction(void *); LOCALE double TanhFunction(void *); LOCALE double SechFunction(void *); LOCALE double CschFunction(void *); LOCALE double CothFunction(void *); LOCALE double AcoshFunction(void *); LOCALE double AsinhFunction(void *); LOCALE double AtanhFunction(void *); LOCALE double AsechFunction(void *); LOCALE double AcschFunction(void *); LOCALE double AcothFunction(void *); LOCALE long long RoundFunction(void *); LOCALE void ModFunction(void *,DATA_OBJECT_PTR); LOCALE double ExpFunction(void *); LOCALE double LogFunction(void *); LOCALE double Log10Function(void *); LOCALE double SqrtFunction(void *); LOCALE double PiFunction(void *); LOCALE double DegRadFunction(void *); LOCALE double RadDegFunction(void *); LOCALE double DegGradFunction(void *); LOCALE double GradDegFunction(void *); LOCALE double PowFunction(void *); #endif #endif /* _H_emathfun */ clips_core_source_630/core/filertr.h0000755000175000017500000000655112373742630016067 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FILE I/O ROUTER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow files to be used */ /* as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Used gengetc and genungetchar rather than */ /* getc and ungetc. */ /* */ /* Replaced BASIC_IO and ADVANCED_IO compiler */ /* flags with the single IO_FUNCTIONS compiler */ /* flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_filertr #define _H_filertr #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define FILE_ROUTER_DATA 47 struct fileRouter { const char *logicalName; FILE *stream; struct fileRouter *next; }; struct fileRouterData { struct fileRouter *ListOfFileRouters; }; #define FileRouterData(theEnv) ((struct fileRouterData *) GetEnvironmentData(theEnv,FILE_ROUTER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FILERTR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeFileRouter(void *); LOCALE FILE *FindFptr(void *,const char *); LOCALE int OpenAFile(void *,const char *,const char *,const char *); LOCALE int CloseAllFiles(void *); LOCALE int CloseFile(void *,const char *); LOCALE int FindFile(void *,const char *); #endif /* _H_filertr */ clips_core_source_630/core/._iofun.c0000755000175000017500000000040712476444662015752 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/bmathfun.h0000755000175000017500000000560112373706601016215 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* BASIC MATH FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_bmathfun #define _H_bmathfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _BMATHFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void BasicMathFunctionDefinitions(void *); LOCALE void AdditionFunction(void *,DATA_OBJECT_PTR); LOCALE void MultiplicationFunction(void *,DATA_OBJECT_PTR); LOCALE void SubtractionFunction(void *,DATA_OBJECT_PTR); LOCALE void DivisionFunction(void *,DATA_OBJECT_PTR); LOCALE long long DivFunction(void *); LOCALE intBool SetAutoFloatDividendCommand(void *); LOCALE intBool GetAutoFloatDividendCommand(void *); LOCALE intBool EnvGetAutoFloatDividend(void *); LOCALE intBool EnvSetAutoFloatDividend(void *,int); LOCALE long long IntegerFunction(void *); LOCALE double FloatFunction(void *); LOCALE void AbsFunction(void *,DATA_OBJECT_PTR); LOCALE void MinFunction(void *,DATA_OBJECT_PTR); LOCALE void MaxFunction(void *,DATA_OBJECT_PTR); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool GetAutoFloatDividend(void); LOCALE intBool SetAutoFloatDividend(int); #endif #endif clips_core_source_630/core/._prcdrfun.h0000755000175000017500000000040712373743661016457 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._globlbsc.h0000755000175000017500000000040712373753372016423 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._strngrtr.c0000755000175000017500000000040712373755534016516 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factbld.h0000755000175000017500000000442412373742663016022 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT BUILD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /*************************************************************/ #ifndef _H_factbld #define _H_factbld #ifndef _H_pattern #include "pattern.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif struct factPatternNode { struct patternNodeHeader header; long bsaveID; unsigned short whichField; unsigned short whichSlot; unsigned short leaveFields; struct expr *networkTest; struct factPatternNode *nextLevel; struct factPatternNode *lastLevel; struct factPatternNode *leftNode; struct factPatternNode *rightNode; }; #ifdef _FACTBUILD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeFactPatterns(void *); LOCALE void DestroyFactPatternNetwork(void *, struct factPatternNode *); #endif /* _H_factbld */ clips_core_source_630/core/._sortfun.c0000755000175000017500000000040712375756716016336 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insmngr.c0000755000175000017500000012153612464742046016073 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* INSTANCE PRIMITIVE SUPPORT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Creation and Deletion of Instances Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Newly created instances can no longer use */ /* a preexisting instance name of another class */ /* [INSMNGR16]. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #if DEFRULE_CONSTRUCT #include "network.h" #include "drive.h" #include "objrtmch.h" #include "lgcldpnd.h" #endif #include "classcom.h" #include "classfun.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "extnfunc.h" #include "insfun.h" #include "modulutl.h" #include "msgcom.h" #include "msgfun.h" #include "prccode.h" #include "router.h" #include "sysdep.h" #include "utility.h" #define _INSMNGR_SOURCE_ #include "insmngr.h" #include "inscom.h" #include "watch.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MAKE_TRACE "==>" #define UNMAKE_TRACE "<==" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static INSTANCE_TYPE *NewInstance(void *); static INSTANCE_TYPE *InstanceLocationInfo(void *,DEFCLASS *,SYMBOL_HN *,INSTANCE_TYPE **, unsigned *); static void InstallInstance(void *,INSTANCE_TYPE *,int); static void BuildDefaultSlots(void *,intBool); static int CoreInitializeInstance(void *,INSTANCE_TYPE *,EXPRESSION *); static int InsertSlotOverrides(void *,INSTANCE_TYPE *,EXPRESSION *); static void EvaluateClassDefaults(void *,INSTANCE_TYPE *); #if DEBUGGING_FUNCTIONS static void PrintInstanceWatch(void *,const char *,INSTANCE_TYPE *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : InitializeInstanceCommand DESCRIPTION : Initializes an instance of a class INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (active-initialize-instance *) ***********************************************************/ globle void InitializeInstanceCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); ins = CheckInstance(theEnv,"initialize-instance"); if (ins == NULL) return; if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg) == TRUE) { SetpType(result,INSTANCE_NAME); SetpValue(result,(void *) ins->name); } } /**************************************************************** NAME : MakeInstanceCommand DESCRIPTION : Creates and initializes an instance of a class INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (active-make-instance of *) CHANGES : It's now possible to create an instance of a class that's not in scope if the module name is specified. ****************************************************************/ globle void MakeInstanceCommand( void *theEnv, DATA_OBJECT *result) { SYMBOL_HN *iname; INSTANCE_TYPE *ins; DATA_OBJECT temp; DEFCLASS *cls; SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); EvaluateExpression(theEnv,GetFirstArgument(),&temp); if ((GetType(temp) != SYMBOL) && (GetType(temp) != INSTANCE_NAME)) { PrintErrorID(theEnv,"INSMNGR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid name for new instance.\n"); SetEvaluationError(theEnv,TRUE); return; } iname = (SYMBOL_HN *) GetValue(temp); if (GetFirstArgument()->nextArg->type == DEFCLASS_PTR) cls = (DEFCLASS *) GetFirstArgument()->nextArg->value; else { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,&temp); if (GetType(temp) != SYMBOL) { PrintErrorID(theEnv,"INSMNGR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid class name for new instance.\n"); SetEvaluationError(theEnv,TRUE); return; } //cls = LookupDefclassInScope(theEnv,DOToString(temp)); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); // Module or scope is now allowed if (cls == NULL) { ClassExistError(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), DOToString(temp)); SetEvaluationError(theEnv,TRUE); return; } } ins = BuildInstance(theEnv,iname,cls,TRUE); if (ins == NULL) return; if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg->nextArg) == TRUE) { result->type = INSTANCE_NAME; result->value = (void *) GetFullInstanceName(theEnv,ins); } else QuashInstance(theEnv,ins); } /*************************************************** NAME : GetFullInstanceName DESCRIPTION : If this function is called while the current module is other than the one in which the instance resides, then the module name is prepended to the instance name. Otherwise - the base name only is returned. INPUTS : The instance RETURNS : The instance name symbol (with module name and :: prepended) SIDE EFFECTS : Temporary buffer allocated possibly and new symbol created NOTES : Used to differentiate between instances of the same name in different modules. Instances are now global in scope so each instance name must belong to a single instance. It's no longer necessary to return the full instance name. ***************************************************/ globle SYMBOL_HN *GetFullInstanceName( void *theEnv, INSTANCE_TYPE *ins) { /* const char *moduleName; char *buffer; size_t bufsz; SYMBOL_HN *iname; */ if (ins == &InstanceData(theEnv)->DummyInstance) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"Dummy Instance")); return(ins->name); /* if (ins->garbage) return(ins->name); if (ins->cls->header.whichModule->theModule == ((struct defmodule *) EnvGetCurrentModule(theEnv))) return(ins->name); moduleName = EnvGetDefmoduleName(theEnv,(void *) ins->cls->header.whichModule->theModule); bufsz = (sizeof(char) * (strlen(moduleName) + strlen(ValueToString(ins->name)) + 3)); buffer = (char *) gm2(theEnv,bufsz); gensprintf(buffer,"%s::%s",moduleName,ValueToString(ins->name)); iname = (SYMBOL_HN *) EnvAddSymbol(theEnv,buffer); rm(theEnv,(void *) buffer,bufsz); return(iname); */ } /*************************************************** NAME : BuildInstance DESCRIPTION : Creates an uninitialized instance INPUTS : 1) Name of the instance 2) Class pointer 3) Flag indicating whether init message will be called for this instance or not RETURNS : The address of the new instance, NULL on errors (or when a a logical basis in a rule was deleted int the same RHS in which the instance creation occurred) SIDE EFFECTS : Old definition (if any) is deleted NOTES : None ***************************************************/ globle INSTANCE_TYPE *BuildInstance( void *theEnv, SYMBOL_HN *iname, DEFCLASS *cls, intBool initMessage) { INSTANCE_TYPE *ins,*iprv; unsigned hashTableIndex; unsigned modulePosition; SYMBOL_HN *moduleName; DATA_OBJECT temp; #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress && cls->reactive) { PrintErrorID(theEnv,"INSMNGR",10,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of reactive classes while\n"); EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } #endif if (cls->abstract) { PrintErrorID(theEnv,"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } modulePosition = FindModuleSeparator(ValueToString(iname)); if (modulePosition) { moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(iname)); if ((moduleName == NULL) || (moduleName != cls->header.whichModule->theModule->name)) { PrintErrorID(theEnv,"INSMNGR",11,TRUE); EnvPrintRouter(theEnv,WERROR,"Invalid module specifier in new instance name.\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } iname = ExtractConstructName(theEnv,modulePosition,ValueToString(iname)); } ins = InstanceLocationInfo(theEnv,cls,iname,&iprv,&hashTableIndex); if (ins != NULL) { if (ins->cls != cls) { PrintErrorID(theEnv,"INSMNGR",16,FALSE); EnvPrintRouter(theEnv,WERROR,"The instance name "); EnvPrintRouter(theEnv,WERROR,ValueToString(iname)); EnvPrintRouter(theEnv,WERROR," is in use by an instance of class "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->cls->header.name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } if (ins->installed == 0) { PrintErrorID(theEnv,"INSMNGR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"The instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(iname)); EnvPrintRouter(theEnv,WERROR," has a slot-value which depends on the instance definition.\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } ins->busy++; IncrementSymbolCount(iname); if (ins->garbage == 0) { if (InstanceData(theEnv)->MkInsMsgPass) DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL); else QuashInstance(theEnv,ins); } ins->busy--; DecrementSymbolCount(theEnv,iname); if (ins->garbage == 0) { PrintErrorID(theEnv,"INSMNGR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete old instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(iname)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } } /* ============================================================= Create the base instance from the defaults of the inheritance precedence list ============================================================= */ InstanceData(theEnv)->CurrentInstance = NewInstance(theEnv); #if DEFRULE_CONSTRUCT /* ============================================== Add this new instance as a dependent to any currently active basis - if the partial match was deleted, abort the instance creation ============================================== */ if (AddLogicalDependencies(theEnv,(struct patternEntity *) InstanceData(theEnv)->CurrentInstance,FALSE) == FALSE) { rtn_struct(theEnv,instance,InstanceData(theEnv)->CurrentInstance); InstanceData(theEnv)->CurrentInstance = NULL; return(NULL); } #endif InstanceData(theEnv)->CurrentInstance->name = iname; InstanceData(theEnv)->CurrentInstance->cls = cls; BuildDefaultSlots(theEnv,initMessage); /* ============================================================ Put the instance in the instance hash table and put it on its class's instance list ============================================================ */ InstanceData(theEnv)->CurrentInstance->hashTableIndex = hashTableIndex; if (iprv == NULL) { InstanceData(theEnv)->CurrentInstance->nxtHash = InstanceData(theEnv)->InstanceTable[hashTableIndex]; if (InstanceData(theEnv)->InstanceTable[hashTableIndex] != NULL) InstanceData(theEnv)->InstanceTable[hashTableIndex]->prvHash = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->InstanceTable[hashTableIndex] = InstanceData(theEnv)->CurrentInstance; } else { InstanceData(theEnv)->CurrentInstance->nxtHash = iprv->nxtHash; if (iprv->nxtHash != NULL) iprv->nxtHash->prvHash = InstanceData(theEnv)->CurrentInstance; iprv->nxtHash = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance->prvHash = iprv; } /* ====================================== Put instance in global and class lists ====================================== */ if (InstanceData(theEnv)->CurrentInstance->cls->instanceList == NULL) InstanceData(theEnv)->CurrentInstance->cls->instanceList = InstanceData(theEnv)->CurrentInstance; else InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom->nxtClass = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance->prvClass = InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom; InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom = InstanceData(theEnv)->CurrentInstance; if (InstanceData(theEnv)->InstanceList == NULL) InstanceData(theEnv)->InstanceList = InstanceData(theEnv)->CurrentInstance; else InstanceData(theEnv)->InstanceListBottom->nxtList = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance->prvList = InstanceData(theEnv)->InstanceListBottom; InstanceData(theEnv)->InstanceListBottom = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->ChangesToInstances = TRUE; /* ============================================================================== Install the instance's name and slot-value symbols (prevent them from becoming ephemeral) - the class name and slot names are accounted for by the class ============================================================================== */ InstallInstance(theEnv,InstanceData(theEnv)->CurrentInstance,TRUE); ins = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance = NULL; if (InstanceData(theEnv)->MkInsMsgPass) { DirectMessage(theEnv,MessageHandlerData(theEnv)->CREATE_SYMBOL,ins,&temp,NULL); } #if DEFRULE_CONSTRUCT if (ins->cls->reactive) ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) ins,-1); #endif return(ins); } /***************************************************************************** NAME : InitSlotsCommand DESCRIPTION : Calls Kernel Expression Evaluator EvaluateExpression for each expression-value of an instance expression Evaluates default slots only - slots that were specified by overrides (sp->override == 1) are ignored) INPUTS : 1) Instance address RETURNS : Nothing useful SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced by the evaluation (by EvaluateExpression) of the expression in the slot list. The old expression-values are deleted. NOTES : H/L Syntax: (init-slots ) *****************************************************************************/ globle void InitSlotsCommand( void *theEnv, DATA_OBJECT *result) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); EvaluationData(theEnv)->EvaluationError = FALSE; if (CheckCurrentMessage(theEnv,"init-slots",TRUE) == FALSE) return; EvaluateClassDefaults(theEnv,GetActiveInstance(theEnv)); if (! EvaluationData(theEnv)->EvaluationError) { SetpType(result,INSTANCE_ADDRESS); SetpValue(result,(void *) GetActiveInstance(theEnv)); } } /****************************************************** NAME : QuashInstance DESCRIPTION : Deletes an instance if it is not in use, otherwise sticks it on the garbage list INPUTS : The instance RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Instance deleted or added to garbage NOTES : Even though the instance is removed from the class list, hash table and instance list, its links remain unchanged so that outside loops can still determine where the next node in the list is (assuming the instance was garbage collected). ******************************************************/ globle intBool QuashInstance( void *theEnv, INSTANCE_TYPE *ins) { register int iflag; IGARBAGE *gptr; #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress && ins->cls->reactive) { PrintErrorID(theEnv,"INSMNGR",12,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot delete instances of reactive classes while\n"); EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n"); SetEvaluationError(theEnv,TRUE); return(0); } #endif if (ins->garbage == 1) return(0); if (ins->installed == 0) { PrintErrorID(theEnv,"INSMNGR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot delete instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR," during initialization.\n"); SetEvaluationError(theEnv,TRUE); return(0); } #if DEBUGGING_FUNCTIONS if (ins->cls->traceInstances) PrintInstanceWatch(theEnv,UNMAKE_TRACE,ins); #endif #if DEFRULE_CONSTRUCT RemoveEntityDependencies(theEnv,(struct patternEntity *) ins); if (ins->cls->reactive) ObjectNetworkAction(theEnv,OBJECT_RETRACT,(INSTANCE_TYPE *) ins,-1); #endif if (ins->prvHash != NULL) ins->prvHash->nxtHash = ins->nxtHash; else InstanceData(theEnv)->InstanceTable[ins->hashTableIndex] = ins->nxtHash; if (ins->nxtHash != NULL) ins->nxtHash->prvHash = ins->prvHash; if (ins->prvClass != NULL) ins->prvClass->nxtClass = ins->nxtClass; else ins->cls->instanceList = ins->nxtClass; if (ins->nxtClass != NULL) ins->nxtClass->prvClass = ins->prvClass; else ins->cls->instanceListBottom = ins->prvClass; if (ins->prvList != NULL) ins->prvList->nxtList = ins->nxtList; else InstanceData(theEnv)->InstanceList = ins->nxtList; if (ins->nxtList != NULL) ins->nxtList->prvList = ins->prvList; else InstanceData(theEnv)->InstanceListBottom = ins->prvList; iflag = ins->installed; InstallInstance(theEnv,ins,FALSE); /* ============================================== If the instance is the basis for an executing rule, don't bother deleting its slots yet, for they may still be needed by pattern variables ============================================== */ #if DEFRULE_CONSTRUCT if ((iflag == 1) && (ins->header.busyCount == 0)) #else if (iflag == 1) #endif RemoveInstanceData(theEnv,ins); if ((ins->busy == 0) && (InstanceData(theEnv)->MaintainGarbageInstances == FALSE) #if DEFRULE_CONSTRUCT && (ins->header.busyCount == 0) #endif ) { DecrementSymbolCount(theEnv,ins->name); rtn_struct(theEnv,instance,ins); } else { gptr = get_struct(theEnv,igarbage); ins->garbage = 1; gptr->ins = ins; gptr->nxt = InstanceData(theEnv)->InstanceGarbageList; InstanceData(theEnv)->InstanceGarbageList = gptr; UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; } InstanceData(theEnv)->ChangesToInstances = TRUE; return(1); } #if DEFRULE_CONSTRUCT /**************************************************** NAME : InactiveInitializeInstance DESCRIPTION : Initializes an instance of a class Pattern-matching is automatically delayed until the instance is completely initialized INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (initialize-instance *) ****************************************************/ globle void InactiveInitializeInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); InitializeInstanceCommand(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /************************************************************** NAME : InactiveMakeInstance DESCRIPTION : Creates and initializes an instance of a class Pattern-matching is automatically delayed until the instance is completely initialized INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (make-instance of *) **************************************************************/ globle void InactiveMakeInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); MakeInstanceCommand(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : NewInstance DESCRIPTION : Allocates and initializes a new instance INPUTS : None RETURNS : The address of the new instance SIDE EFFECTS : None NOTES : None ********************************************************/ static INSTANCE_TYPE *NewInstance( void *theEnv) { INSTANCE_TYPE *instance; instance = get_struct(theEnv,instance); #if DEFRULE_CONSTRUCT instance->header.theInfo = &InstanceData(theEnv)->InstanceInfo; instance->header.dependents = NULL; instance->header.busyCount = 0; instance->header.timeTag = 0L; instance->partialMatchList = NULL; instance->basisSlots = NULL; instance->reteSynchronized = FALSE; #endif instance->busy = 0; instance->installed = 0; instance->garbage = 0; instance->initSlotsCalled = 0; instance->initializeInProgress = 0; instance->name = NULL; instance->hashTableIndex = 0; instance->cls = NULL; instance->slots = NULL; instance->slotAddresses = NULL; instance->prvClass = NULL; instance->nxtClass = NULL; instance->prvHash = NULL; instance->nxtHash = NULL; instance->prvList = NULL; instance->nxtList = NULL; return(instance); } /***************************************************************** NAME : InstanceLocationInfo DESCRIPTION : Determines where a specified instance belongs in the instance hash table INPUTS : 1) The class of the new instance 2) The symbol for the name of the instance 3) Caller's buffer for previous node address 4) Caller's buffer for hash value RETURNS : The address of the found instance, NULL otherwise SIDE EFFECTS : None NOTES : Instance names only have to be unique within a module. Change: instance names must be unique regardless of module. *****************************************************************/ static INSTANCE_TYPE *InstanceLocationInfo( void *theEnv, DEFCLASS *cls, SYMBOL_HN *iname, INSTANCE_TYPE **prv, unsigned *hashTableIndex) { INSTANCE_TYPE *ins; *hashTableIndex = HashInstance(iname); ins = InstanceData(theEnv)->InstanceTable[*hashTableIndex]; /* ======================================== Make sure all instances of the same name are grouped together regardless of what module their classes are in ======================================== */ *prv = NULL; while (ins != NULL) { if (ins->name == iname) { return(ins); } *prv = ins; ins = ins->nxtHash; } /* while ((ins != NULL) ? (ins->name != iname) : FALSE) { *prv = ins; ins = ins->nxtHash; } while ((ins != NULL) ? (ins->name == iname) : FALSE) { if (ins->cls->header.whichModule->theModule == cls->header.whichModule->theModule) return(ins); *prv = ins; ins = ins->nxtHash; } */ return(NULL); } /******************************************************** NAME : InstallInstance DESCRIPTION : Prevent name and slot value symbols from being ephemeral (all others taken care of by class defn) INPUTS : 1) The address of the instance 2) A flag indicating whether to install or deinstall RETURNS : Nothing useful SIDE EFFECTS : Symbol counts incremented or decremented NOTES : Slot symbol installations are handled by PutSlotValue ********************************************************/ static void InstallInstance( void *theEnv, INSTANCE_TYPE *ins, int set) { if (set == TRUE) { if (ins->installed) return; #if DEBUGGING_FUNCTIONS if (ins->cls->traceInstances) PrintInstanceWatch(theEnv,MAKE_TRACE,ins); #endif ins->installed = 1; IncrementSymbolCount(ins->name); IncrementDefclassBusyCount(theEnv,(void *) ins->cls); InstanceData(theEnv)->GlobalNumberOfInstances++; } else { if (! ins->installed) return; ins->installed = 0; InstanceData(theEnv)->GlobalNumberOfInstances--; /* ======================================= Class counts is decremented by RemoveInstanceData() when slot data is truly deleted - and name count is deleted by CleanupInstances() or QuashInstance() when instance is truly deleted ======================================= */ } } /**************************************************************** NAME : BuildDefaultSlots DESCRIPTION : The current instance's address is in the global variable CurrentInstance. This builds the slots and the default values from the direct class of the instance and its inheritances. INPUTS : Flag indicating whether init message will be called for this instance or not RETURNS : Nothing useful SIDE EFFECTS : Allocates the slot array for the current instance NOTES : The current instance's address is stored in a global variable ****************************************************************/ static void BuildDefaultSlots( void *theEnv, intBool initMessage) { register unsigned i,j; unsigned scnt; unsigned lscnt; INSTANCE_SLOT *dst = NULL,**adst; SLOT_DESC **src; scnt = InstanceData(theEnv)->CurrentInstance->cls->instanceSlotCount; lscnt = InstanceData(theEnv)->CurrentInstance->cls->localInstanceSlotCount; if (scnt > 0) { InstanceData(theEnv)->CurrentInstance->slotAddresses = adst = (INSTANCE_SLOT **) gm2(theEnv,(sizeof(INSTANCE_SLOT *) * scnt)); if (lscnt != 0) InstanceData(theEnv)->CurrentInstance->slots = dst = (INSTANCE_SLOT *) gm2(theEnv,(sizeof(INSTANCE_SLOT) * lscnt)); src = InstanceData(theEnv)->CurrentInstance->cls->instanceTemplate; /* ================================================== A map of slot addresses is created - shared slots point at values in the class, and local slots point at values in the instance Also - slots are always given an initial value (since slots cannot be unbound). If there is already an instance of a class with a shared slot, that value is left alone ================================================== */ for (i = 0 , j = 0 ; i < scnt ; i++) { if (src[i]->shared) { src[i]->sharedCount++; adst[i] = &(src[i]->sharedValue); } else { dst[j].desc = src[i]; dst[j].value = NULL; adst[i] = &dst[j++]; } if (adst[i]->value == NULL) { adst[i]->valueRequired = initMessage; if (adst[i]->desc->multiple) { adst[i]->type = MULTIFIELD; adst[i]->value = CreateMultifield2(theEnv,0L); MultifieldInstall(theEnv,(MULTIFIELD_PTR) adst[i]->value); } else { adst[i]->type = SYMBOL; adst[i]->value = EnvAddSymbol(theEnv,"nil"); AtomInstall(theEnv,(int) adst[i]->type,adst[i]->value); } } else adst[i]->valueRequired = FALSE; adst[i]->override = FALSE; } } } /******************************************************************* NAME : CoreInitializeInstance DESCRIPTION : Performs the core work for initializing an instance INPUTS : 1) The instance address 2) Slot override expressions RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors - slots evaluated NOTES : None *******************************************************************/ static int CoreInitializeInstance( void *theEnv, INSTANCE_TYPE *ins, EXPRESSION *ovrexp) { DATA_OBJECT temp; if (ins->installed == 0) { PrintErrorID(theEnv,"INSMNGR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR," is already being initialized.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } /* ======================================================= Replace all default-slot values with any slot-overrides ======================================================= */ ins->busy++; ins->installed = 0; /* ================================================================= If the slots are initialized properly - the initializeInProgress flag will be turned off. ================================================================= */ ins->initializeInProgress = 1; ins->initSlotsCalled = 0; if (InsertSlotOverrides(theEnv,ins,ovrexp) == FALSE) { ins->installed = 1; ins->busy--; return(FALSE); } /* ================================================================= Now that all the slot expressions are established - replace them with their evaluation ================================================================= */ if (InstanceData(theEnv)->MkInsMsgPass) DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,ins,&temp,NULL); else EvaluateClassDefaults(theEnv,ins); ins->busy--; ins->installed = 1; if (EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"INSMNGR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"An error occurred during the initialization of instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } ins->initializeInProgress = 0; return((ins->initSlotsCalled == 0) ? FALSE : TRUE); } /********************************************************** NAME : InsertSlotOverrides DESCRIPTION : Replaces value-expression for a slot INPUTS : 1) The instance address 2) The address of the beginning of the list of slot-expressions RETURNS : TRUE if all okay, FALSE otherwise SIDE EFFECTS : Old slot expression deallocated NOTES : Assumes symbols not yet installed EVALUATES the slot-name expression but simply copies the slot value-expression **********************************************************/ static int InsertSlotOverrides( void *theEnv, INSTANCE_TYPE *ins, EXPRESSION *slot_exp) { INSTANCE_SLOT *slot; DATA_OBJECT temp,junk; EvaluationData(theEnv)->EvaluationError = FALSE; while (slot_exp != NULL) { if ((EvaluateExpression(theEnv,slot_exp,&temp) == TRUE) ? TRUE : (GetType(temp) != SYMBOL)) { PrintErrorID(theEnv,"INSMNGR",9,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid slot name for slot-override.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } slot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) GetValue(temp)); if (slot == NULL) { PrintErrorID(theEnv,"INSMNGR",13,FALSE); EnvPrintRouter(theEnv,WERROR,"Slot "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR," does not exist in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (InstanceData(theEnv)->MkInsMsgPass) { DirectMessage(theEnv,slot->desc->overrideMessage, ins,NULL,slot_exp->nextArg->argList); } else if (slot_exp->nextArg->argList) { if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple, slot_exp->nextArg->argList,&temp,TRUE)) PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance"); } else { SetpDOBegin(&temp,1); SetpDOEnd(&temp,0); SetpType(&temp,MULTIFIELD); SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue); PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance"); } if (EvaluationData(theEnv)->EvaluationError) return(FALSE); slot->override = TRUE; slot_exp = slot_exp->nextArg->nextArg; } return(TRUE); } /***************************************************************************** NAME : EvaluateClassDefaults DESCRIPTION : Evaluates default slots only - slots that were specified by overrides (sp->override == 1) are ignored) INPUTS : 1) Instance address RETURNS : Nothing useful SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced by the evaluation (by EvaluateExpression) of the expression in the slot list. The old expression-values are deleted. NOTES : None *****************************************************************************/ static void EvaluateClassDefaults( void *theEnv, INSTANCE_TYPE *ins) { INSTANCE_SLOT *slot; DATA_OBJECT temp,junk; long i; if (ins->initializeInProgress == 0) { PrintErrorID(theEnv,"INSMNGR",15,FALSE); SetEvaluationError(theEnv,TRUE); EnvPrintRouter(theEnv,WERROR,"init-slots not valid in this context.\n"); return; } for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { slot = ins->slotAddresses[i]; /* =========================================================== Slot-overrides are just a short-hand for put-slots, so they should be done with messages. Defaults are from the class definition and can be placed directly. =========================================================== */ if (!slot->override) { if (slot->desc->dynamicDefault) { if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple, (EXPRESSION *) slot->desc->defaultValue, &temp,TRUE)) PutSlotValue(theEnv,ins,slot,&temp,&junk,"function init-slots"); } else if (((slot->desc->shared == 0) || (slot->desc->sharedCount == 1)) && (slot->desc->noDefault == 0)) DirectPutSlotValue(theEnv,ins,slot,(DATA_OBJECT *) slot->desc->defaultValue,&junk); else if (slot->valueRequired) { PrintErrorID(theEnv,"INSMNGR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Override required for slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(slot->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } slot->valueRequired = FALSE; if (ins->garbage == 1) { EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR," instance deleted by slot-override evaluation.\n"); SetEvaluationError(theEnv,TRUE); } if (EvaluationData(theEnv)->EvaluationError) return; } slot->override = FALSE; } ins->initSlotsCalled = 1; } #if DEBUGGING_FUNCTIONS /*************************************************** NAME : PrintInstanceWatch DESCRIPTION : Prints out a trace message for the creation/deletion of an instance INPUTS : 1) The trace string indicating if this is a creation or deletion 2) The instance RETURNS : Nothing usful SIDE EFFECTS : Watch message printed NOTES : None ***************************************************/ static void PrintInstanceWatch( void *theEnv, const char *traceString, INSTANCE_TYPE *theInstance) { EnvPrintRouter(theEnv,WTRACE,traceString); EnvPrintRouter(theEnv,WTRACE," instance "); PrintInstanceNameAndClass(theEnv,WTRACE,theInstance,TRUE); } #endif #endif clips_core_source_630/core/._tmpltbsc.h0000755000175000017500000000040712373754237016465 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/msgpsr.c0000755000175000017500000006310112375756074015731 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* MESSAGE-HANDLER PARSER FUNCTIONS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* 6.30: Renamed BOOLEAN macro type to intBool. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Changed integer type/precision. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_AND_SAVE */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #include #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "constrct.h" #include "cstrcpsr.h" #include "cstrnchk.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "insfun.h" #include "msgcom.h" #include "msgfun.h" #include "pprint.h" #include "prccode.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #include "sysdep.h" #define _MSGPSR_SOURCE_ #include "msgpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define SELF_LEN 4 #define SELF_SLOT_REF ':' /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool IsParameterSlotReference(void *,const char *); static int SlotReferenceVar(void *,EXPRESSION *,void *); static int BindSlotReference(void *,EXPRESSION *,void *); static SLOT_DESC *CheckSlotReference(void *,DEFCLASS *,int,void *,intBool,EXPRESSION *); static void GenHandlerSlotReference(void *,EXPRESSION *,unsigned short,SLOT_DESC *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************** NAME : ParseDefmessageHandler DESCRIPTION : Parses a message-handler for a class of objects INPUTS : The logical name of the input source RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Handler allocated and inserted into class NOTES : H/L Syntax: (defmessage-handler [] [] () *) ::= * | * $? ***********************************************************************/ globle int ParseDefmessageHandler( void *theEnv, const char *readSource) { DEFCLASS *cls; SYMBOL_HN *cname,*mname,*wildcard; unsigned mtype = MPRIMARY; int min,max,error,lvars; EXPRESSION *hndParams,*actions; HANDLER *hnd; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmessage-handler "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmessage-handler"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler", NULL,NULL,"~",TRUE,FALSE,TRUE,FALSE); if (cname == NULL) return(TRUE); cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname)); if (cls == NULL) { PrintErrorID(theEnv,"MSGPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n"); return(TRUE); } if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"MSGPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (HandlersExecuting(cls)) { PrintErrorID(theEnv,"MSGPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n"); EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n"); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SavePPBuffer(theEnv," "); if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken)); if (mtype == MERROR) return(TRUE); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } else { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } PPBackup(theEnv); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); hnd = FindHandlerByAddress(cls,mname,mtype); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Handler "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname)); EnvPrintRouter(theEnv,WDIALOG," "); EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]); if (hnd == NULL) EnvPrintRouter(theEnv,WDIALOG," defined.\n"); else EnvPrintRouter(theEnv,WDIALOG," redefined.\n"); } if ((hnd != NULL) ? hnd->system : FALSE) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); return(TRUE); } hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL); hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams, &wildcard,&min,&max,&error,IsParameterSlotReference); if (error) return(TRUE); PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"message-handler",readSource, &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard, SlotReferenceVar,BindSlotReference,&lvars, (void *) cls); if (actions == NULL) { ReturnExpression(theEnv,hndParams); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defmessage-handler"); ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv,"\n"); /* =================================================== If we're only checking syntax, don't add the successfully parsed defmessage-handler to the KB. =================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(FALSE); } if (hnd != NULL) { ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else { hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype); IncrementSymbolCount(hnd->name); } ReturnExpression(theEnv,hndParams); hnd->minParams = (short) min; hnd->maxParams = (short) max; hnd->localVarCount = (short) lvars; hnd->actions = actions; ExpressionInstall(theEnv,hnd->actions); #if DEBUGGING_FUNCTIONS /* =================================================== Old handler trace status is automatically preserved =================================================== */ if (EnvGetConserveMemory(theEnv) == FALSE) hnd->ppForm = CopyPPBuffer(theEnv); else #endif hnd->ppForm = NULL; return(FALSE); } /******************************************************************************* NAME : CreateGetAndPutHandlers DESCRIPTION : Creates two message-handlers with the following syntax for the slot: (defmessage-handler get- primary () ?self:) For single-field slots: (defmessage-handler put- primary (?value) (bind ?self: ?value)) For multifield slots: (defmessage-handler put- primary ($?value) (bind ?self: ?value)) INPUTS : The class slot descriptor RETURNS : Nothing useful SIDE EFFECTS : Message-handlers created NOTES : A put handler is not created for read-only slots *******************************************************************************/ globle void CreateGetAndPutHandlers( void *theEnv, SLOT_DESC *sd) { const char *className,*slotName; size_t bufsz; char *buf; const char *handlerRouter = "*** Default Public Handlers ***"; int oldPWL,oldCM; const char *oldRouter; char *oldString; long oldIndex; if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0)) return; className = ValueToString(sd->cls->header.name); slotName = ValueToString(sd->slotName->name); bufsz = (sizeof(char) * (strlen(className) + (strlen(slotName) * 2) + 80)); buf = (char *) gm2(theEnv,bufsz); oldPWL = GetPrintWhileLoading(theEnv); SetPrintWhileLoading(theEnv,FALSE); oldCM = EnvSetConserveMemory(theEnv,TRUE); if (sd->createReadAccessor) { gensprintf(buf,"%s get-%s () ?self:%s)",className,slotName,slotName); oldRouter = RouterData(theEnv)->FastCharGetRouter; oldString = RouterData(theEnv)->FastCharGetString; oldIndex = RouterData(theEnv)->FastCharGetIndex; RouterData(theEnv)->FastCharGetRouter = handlerRouter; RouterData(theEnv)->FastCharGetIndex = 0; RouterData(theEnv)->FastCharGetString = buf; ParseDefmessageHandler(theEnv,handlerRouter); DestroyPPBuffer(theEnv); /* if (OpenStringSource(theEnv,handlerRouter,buf,0)) { ParseDefmessageHandler(handlerRouter); DestroyPPBuffer(); CloseStringSource(theEnv,handlerRouter); } */ RouterData(theEnv)->FastCharGetRouter = oldRouter; RouterData(theEnv)->FastCharGetIndex = oldIndex; RouterData(theEnv)->FastCharGetString = oldString; } if (sd->createWriteAccessor) { gensprintf(buf,"%s put-%s ($?value) (bind ?self:%s ?value))", className,slotName,slotName); oldRouter = RouterData(theEnv)->FastCharGetRouter; oldString = RouterData(theEnv)->FastCharGetString; oldIndex = RouterData(theEnv)->FastCharGetIndex; RouterData(theEnv)->FastCharGetRouter = handlerRouter; RouterData(theEnv)->FastCharGetIndex = 0; RouterData(theEnv)->FastCharGetString = buf; ParseDefmessageHandler(theEnv,handlerRouter); DestroyPPBuffer(theEnv); /* if (OpenStringSource(theEnv,handlerRouter,buf,0)) { ParseDefmessageHandler(handlerRouter); DestroyPPBuffer(); CloseStringSource(theEnv,handlerRouter); } */ RouterData(theEnv)->FastCharGetRouter = oldRouter; RouterData(theEnv)->FastCharGetIndex = oldIndex; RouterData(theEnv)->FastCharGetString = oldString; } SetPrintWhileLoading(theEnv,oldPWL); EnvSetConserveMemory(theEnv,oldCM); rm(theEnv,(void *) buf,bufsz); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************************** NAME : IsParameterSlotReference DESCRIPTION : Determines if a message-handler parameter is of the form ?self:, which is not allowed since this is slot reference syntax INPUTS : The paramter name RETURNS : TRUE if the parameter is a slot reference, FALSE otherwise SIDE EFFECTS : None NOTES : None *****************************************************************/ static intBool IsParameterSlotReference( void *theEnv, const char *pname) { if ((strncmp(pname,SELF_STRING,SELF_LEN) == 0) ? (pname[SELF_LEN] == SELF_SLOT_REF) : FALSE) { PrintErrorID(theEnv,"MSGPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal slot reference in parameter list.\n"); return(TRUE); } return(FALSE); } /**************************************************************************** NAME : SlotReferenceVar DESCRIPTION : Replaces direct slot references in handler body with special function calls to reference active instance at run-time The slot in in the class bound at parse-time is always referenced (early binding). Slot references of the form ?self: directly reference ProcParamArray[0] (the message object - ?self) to find the specified slot at run-time INPUTS : 1) Variable expression 2) The class of the handler being parsed RETURNS : 0 if not recognized, 1 if so, -1 on errors SIDE EFFECTS : Handler body SF_VARIABLE and MF_VARIABLE replaced with direct slot access function NOTES : Objects are allowed to directly access their own slots without sending a message to themselves. Since the object is "within the boundary of its internals", this does not violate the encapsulation principle of OOP. ****************************************************************************/ static int SlotReferenceVar( void *theEnv, EXPRESSION *varexp, void *userBuffer) { struct token itkn; int oldpp; SLOT_DESC *sd; if ((varexp->type != SF_VARIABLE) && (varexp->type != MF_VARIABLE)) return(0); if ((strncmp(ValueToString(varexp->value),SELF_STRING,SELF_LEN) == 0) ? (ValueToString(varexp->value)[SELF_LEN] == SELF_SLOT_REF) : FALSE) { OpenStringSource(theEnv,"hnd-var",ValueToString(varexp->value) + SELF_LEN + 1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"hnd-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"hnd-var"); if (itkn.type != STOP) { sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value, FALSE,NULL); if (sd == NULL) return(-1); GenHandlerSlotReference(theEnv,varexp,HANDLER_GET,sd); return(1); } } return(0); } /**************************************************************************** NAME : BindSlotReference DESCRIPTION : Replaces direct slot binds in handler body with special function calls to reference active instance at run-time The slot in in the class bound at parse-time is always referenced (early binding). Slot references of the form ?self: directly reference ProcParamArray[0] (the message object - ?self) to find the specified slot at run-time INPUTS : 1) Variable expression 2) The class for the message-handler being parsed RETURNS : 0 if not recognized, 1 if so, -1 on errors SIDE EFFECTS : Handler body "bind" call replaced with direct slot access function NOTES : Objects are allowed to directly access their own slots without sending a message to themselves. Since the object is "within the boundary of its internals", this does not violate the encapsulation principle of OOP. ****************************************************************************/ static int BindSlotReference( void *theEnv, EXPRESSION *bindExp, void *userBuffer) { const char *bindName; struct token itkn; int oldpp; SLOT_DESC *sd; EXPRESSION *saveExp; bindName = ValueToString(bindExp->argList->value); if (strcmp(bindName,SELF_STRING) == 0) { PrintErrorID(theEnv,"MSGPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Active instance parameter cannot be changed.\n"); return(-1); } if ((strncmp(bindName,SELF_STRING,SELF_LEN) == 0) ? (bindName[SELF_LEN] == SELF_SLOT_REF) : FALSE) { OpenStringSource(theEnv,"hnd-var",bindName + SELF_LEN + 1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"hnd-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"hnd-var"); if (itkn.type != STOP) { saveExp = bindExp->argList->nextArg; sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value, TRUE,saveExp); if (sd == NULL) return(-1); GenHandlerSlotReference(theEnv,bindExp,HANDLER_PUT,sd); bindExp->argList->nextArg = NULL; ReturnExpression(theEnv,bindExp->argList); bindExp->argList = saveExp; return(1); } } return(0); } /********************************************************* NAME : CheckSlotReference DESCRIPTION : Examines a ?self: reference If the reference is a single-field or global variable, checking and evaluation is delayed until run-time. If the reference is a symbol, this routine verifies that the slot is a legal slot for the reference (i.e., it exists in the class to which the message-handler is being attached, it is visible and it is writable for write reference) INPUTS : 1) A buffer holding the class of the handler being parsed 2) The type of the slot reference 3) The value of the slot reference 4) A flag indicating if this is a read or write access 5) Value expression for write RETURNS : Class slot on success, NULL on errors SIDE EFFECTS : Messages printed on errors. NOTES : For static references, this function insures that the slot is either publicly visible or that the handler is being attached to the same class in which the private slot is defined. *********************************************************/ static SLOT_DESC *CheckSlotReference( void *theEnv, DEFCLASS *theDefclass, int theType, void *theValue, intBool writeFlag, EXPRESSION *writeExpression) { int slotIndex; SLOT_DESC *sd; int vCode; if (theType != SYMBOL) { PrintErrorID(theEnv,"MSGPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal value for ?self reference.\n"); return(NULL); } slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,(SYMBOL_HN *) theValue); if (slotIndex == -1) { PrintErrorID(theEnv,"MSGPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"No such slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theValue)); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) theDefclass)); EnvPrintRouter(theEnv,WERROR," for ?self reference.\n"); return(NULL); } sd = theDefclass->instanceTemplate[slotIndex]; if ((sd->publicVisibility == 0) && (sd->cls != theDefclass)) { SlotVisibilityViolationError(theEnv,sd,theDefclass); return(NULL); } if (! writeFlag) return(sd); /* ================================================= If a slot is initialize-only, the WithinInit flag still needs to be checked at run-time, for the handler could be called out of the context of an init. ================================================= */ if (sd->noWrite && (sd->initializeOnly == 0)) { SlotAccessViolationError(theEnv,ValueToString(theValue), FALSE,(void *) theDefclass); return(NULL); } if (EnvGetStaticConstraintChecking(theEnv)) { vCode = ConstraintCheckExpressionChain(theEnv,writeExpression,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expression for "); PrintSlot(theEnv,WERROR,sd,NULL,"direct slot write"); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,FALSE); return(NULL); } } return(sd); } /*************************************************** NAME : GenHandlerSlotReference DESCRIPTION : Creates a bitmap of the class id and slot index for the get or put operation. The bitmap and operation type are stored in the given expression. INPUTS : 1) The expression 2) The operation type 3) The class slot RETURNS : Nothing useful SIDE EFFECTS : Bitmap created and expression initialized NOTES : None ***************************************************/ static void GenHandlerSlotReference( void *theEnv, EXPRESSION *theExp, unsigned short theType, SLOT_DESC *sd) { HANDLER_SLOT_REFERENCE handlerReference; ClearBitString(&handlerReference,sizeof(HANDLER_SLOT_REFERENCE)); handlerReference.classID = (unsigned short) sd->cls->id; handlerReference.slotID = (unsigned) sd->slotName->id; theExp->type = theType; theExp->value = EnvAddBitMap(theEnv,(void *) &handlerReference, (int) sizeof(HANDLER_SLOT_REFERENCE)); } #endif clips_core_source_630/core/cstrnbin.c0000755000175000017500000002667512373714224016244 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT BLOAD/BSAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #define _CSTRNBIN_SOURCE_ #include "setup.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "bload.h" #if BLOAD_AND_BSAVE #include "bsave.h" #endif #include "cstrnbin.h" /*******************/ /* DATA STRUCTURES */ /*******************/ struct bsaveConstraintRecord { unsigned int anyAllowed : 1; unsigned int symbolsAllowed : 1; unsigned int stringsAllowed : 1; unsigned int floatsAllowed : 1; unsigned int integersAllowed : 1; unsigned int instanceNamesAllowed : 1; unsigned int instanceAddressesAllowed : 1; unsigned int externalAddressesAllowed : 1; unsigned int factAddressesAllowed : 1; unsigned int anyRestriction : 1; unsigned int symbolRestriction : 1; unsigned int stringRestriction : 1; unsigned int numberRestriction : 1; unsigned int floatRestriction : 1; unsigned int integerRestriction : 1; unsigned int classRestriction : 1; unsigned int instanceNameRestriction : 1; unsigned int multifieldsAllowed : 1; unsigned int singlefieldsAllowed : 1; long classList; long restrictionList; long minValue; long maxValue; long minFields; long maxFields; }; typedef struct bsaveConstraintRecord BSAVE_CONSTRAINT_RECORD; /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void CopyToBsaveConstraintRecord(void *,CONSTRAINT_RECORD *,BSAVE_CONSTRAINT_RECORD *); #endif static void CopyFromBsaveConstraintRecord(void *,void *,long); #if BLOAD_AND_BSAVE /**************************************************/ /* WriteNeededConstraints: Writes the constraints */ /* in the constraint table to the binary image */ /* currently being saved. */ /**************************************************/ globle void WriteNeededConstraints( void *theEnv, FILE *fp) { int i; unsigned short theIndex = 0; unsigned long int numberOfUsedConstraints = 0; CONSTRAINT_RECORD *tmpPtr; BSAVE_CONSTRAINT_RECORD bsaveConstraints; /*================================*/ /* Get the number of constraints. */ /*================================*/ for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { tmpPtr->bsaveIndex = theIndex++; numberOfUsedConstraints++; } } /*=============================================*/ /* If dynamic constraint checking is disabled, */ /* then no constraints are saved. */ /*=============================================*/ if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfUsedConstraints != 0)) { numberOfUsedConstraints = 0; PrintWarningID(theEnv,"CSTRNBIN",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a binary image\n"); EnvPrintRouter(theEnv,WWARNING," when dynamic constraint checking is disabled.\n"); } /*============================================*/ /* Write out the number of constraints in the */ /* constraint table followed by each of the */ /* constraints in the constraint table. */ /*============================================*/ GenWrite(&numberOfUsedConstraints,sizeof(unsigned long int),fp); if (numberOfUsedConstraints == 0) return; for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { CopyToBsaveConstraintRecord(theEnv,tmpPtr,&bsaveConstraints); GenWrite(&bsaveConstraints,sizeof(BSAVE_CONSTRAINT_RECORD),fp); } } } /****************************************************/ /* CopyToBsaveConstraintRecord: Copies a constraint */ /* record to the data structure used for storing */ /* constraints in a binary image. */ /****************************************************/ static void CopyToBsaveConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints, BSAVE_CONSTRAINT_RECORD *bsaveConstraints) { bsaveConstraints->anyAllowed = constraints->anyAllowed; bsaveConstraints->symbolsAllowed = constraints->symbolsAllowed; bsaveConstraints->stringsAllowed = constraints->stringsAllowed; bsaveConstraints->floatsAllowed = constraints->floatsAllowed; bsaveConstraints->integersAllowed = constraints->integersAllowed; bsaveConstraints->instanceNamesAllowed = constraints->instanceNamesAllowed; bsaveConstraints->instanceAddressesAllowed = constraints->instanceAddressesAllowed; bsaveConstraints->externalAddressesAllowed = constraints->externalAddressesAllowed; bsaveConstraints->multifieldsAllowed = constraints->multifieldsAllowed; bsaveConstraints->singlefieldsAllowed = constraints->singlefieldsAllowed; bsaveConstraints->factAddressesAllowed = constraints->factAddressesAllowed; bsaveConstraints->anyRestriction = constraints->anyRestriction; bsaveConstraints->symbolRestriction = constraints->symbolRestriction; bsaveConstraints->stringRestriction = constraints->stringRestriction; bsaveConstraints->floatRestriction = constraints->floatRestriction; bsaveConstraints->integerRestriction = constraints->integerRestriction; bsaveConstraints->classRestriction = constraints->classRestriction; bsaveConstraints->instanceNameRestriction = constraints->instanceNameRestriction; bsaveConstraints->restrictionList = HashedExpressionIndex(theEnv,constraints->restrictionList); bsaveConstraints->classList = HashedExpressionIndex(theEnv,constraints->classList); bsaveConstraints->minValue = HashedExpressionIndex(theEnv,constraints->minValue); bsaveConstraints->maxValue = HashedExpressionIndex(theEnv,constraints->maxValue); bsaveConstraints->minFields = HashedExpressionIndex(theEnv,constraints->minFields); bsaveConstraints->maxFields = HashedExpressionIndex(theEnv,constraints->maxFields); } #endif /* BLOAD_AND_BSAVE */ /********************************************************/ /* ReadNeededConstraints: Reads in the constraints used */ /* by the binary image currently being loaded. */ /********************************************************/ globle void ReadNeededConstraints( void *theEnv) { GenReadBinary(theEnv,(void *) &ConstraintData(theEnv)->NumberOfConstraints,sizeof(unsigned long int)); if (ConstraintData(theEnv)->NumberOfConstraints == 0) return; ConstraintData(theEnv)->ConstraintArray = (CONSTRAINT_RECORD *) genalloc(theEnv,(sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); BloadandRefresh(theEnv,ConstraintData(theEnv)->NumberOfConstraints,sizeof(BSAVE_CONSTRAINT_RECORD), CopyFromBsaveConstraintRecord); } /*****************************************************/ /* CopyFromBsaveConstraintRecord: Copies values to a */ /* constraint record from the data structure used */ /* for storing constraints in a binary image. */ /*****************************************************/ static void CopyFromBsaveConstraintRecord( void *theEnv, void *buf, long theIndex) { BSAVE_CONSTRAINT_RECORD *bsaveConstraints; CONSTRAINT_RECORD *constraints; bsaveConstraints = (BSAVE_CONSTRAINT_RECORD *) buf; constraints = (CONSTRAINT_RECORD *) &ConstraintData(theEnv)->ConstraintArray[theIndex]; constraints->anyAllowed = bsaveConstraints->anyAllowed; constraints->symbolsAllowed = bsaveConstraints->symbolsAllowed; constraints->stringsAllowed = bsaveConstraints->stringsAllowed; constraints->floatsAllowed = bsaveConstraints->floatsAllowed; constraints->integersAllowed = bsaveConstraints->integersAllowed; constraints->instanceNamesAllowed = bsaveConstraints->instanceNamesAllowed; constraints->instanceAddressesAllowed = bsaveConstraints->instanceAddressesAllowed; constraints->externalAddressesAllowed = bsaveConstraints->externalAddressesAllowed; constraints->voidAllowed = FALSE; constraints->multifieldsAllowed = bsaveConstraints->multifieldsAllowed; constraints->singlefieldsAllowed = bsaveConstraints->singlefieldsAllowed; constraints->factAddressesAllowed = bsaveConstraints->factAddressesAllowed; constraints->anyRestriction = bsaveConstraints->anyRestriction; constraints->symbolRestriction = bsaveConstraints->symbolRestriction; constraints->stringRestriction = bsaveConstraints->stringRestriction; constraints->floatRestriction = bsaveConstraints->floatRestriction; constraints->integerRestriction = bsaveConstraints->integerRestriction; constraints->classRestriction = bsaveConstraints->classRestriction; constraints->instanceNameRestriction = bsaveConstraints->instanceNameRestriction; constraints->restrictionList = HashedExpressionPointer(bsaveConstraints->restrictionList); constraints->classList = HashedExpressionPointer(bsaveConstraints->classList); constraints->minValue = HashedExpressionPointer(bsaveConstraints->minValue); constraints->maxValue = HashedExpressionPointer(bsaveConstraints->maxValue); constraints->minFields = HashedExpressionPointer(bsaveConstraints->minFields); constraints->maxFields = HashedExpressionPointer(bsaveConstraints->maxFields); constraints->multifield = NULL; } /********************************************************/ /* ClearBloadedConstraints: Releases memory associated */ /* with constraints loaded from binary image */ /********************************************************/ globle void ClearBloadedConstraints( void *theEnv) { if (ConstraintData(theEnv)->NumberOfConstraints != 0) { genfree(theEnv,(void *) ConstraintData(theEnv)->ConstraintArray, (sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); ConstraintData(theEnv)->NumberOfConstraints = 0; } } #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips_core_source_630/core/prcdrfun.c0000755000175000017500000005504512373743663016247 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PROCEDURAL FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several procedural */ /* functions including if, while, loop-for-count, bind, */ /* progn, return, break, and switch */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Local variables set with the bind function */ /* persist until a reset/clear command is issued. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Support for long long integers. */ /* */ /*************************************************************/ #define _PRCDRFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnops.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "multifld.h" #include "prcdrpsr.h" #include "router.h" #include "scanner.h" #include "utility.h" #include "prcdrfun.h" #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocateProceduralFunctionData(void *); /**********************************************/ /* ProceduralFunctionDefinitions: Initializes */ /* the procedural functions. */ /**********************************************/ globle void ProceduralFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,PRCDRFUN_DATA,sizeof(struct procedureFunctionData),DeallocateProceduralFunctionData); #if ! RUN_TIME EnvDefineFunction2(theEnv,"if", 'u', PTIEF IfFunction, "IfFunction", NULL); EnvDefineFunction2(theEnv,"while", 'u', PTIEF WhileFunction, "WhileFunction", NULL); EnvDefineFunction2(theEnv,"loop-for-count",'u', PTIEF LoopForCountFunction, "LoopForCountFunction", NULL); EnvDefineFunction2(theEnv,"(get-loop-count)",'g', PTIEF GetLoopCount, "GetLoopCount", NULL); EnvDefineFunction2(theEnv,"bind", 'u', PTIEF BindFunction, "BindFunction", NULL); EnvDefineFunction2(theEnv,"progn", 'u', PTIEF PrognFunction, "PrognFunction", NULL); EnvDefineFunction2(theEnv,"return", 'u', PTIEF ReturnFunction, "ReturnFunction",NULL); EnvDefineFunction2(theEnv,"break", 'v', PTIEF BreakFunction, "BreakFunction",NULL); EnvDefineFunction2(theEnv,"switch", 'u', PTIEF SwitchFunction, "SwitchFunction",NULL); ProceduralFunctionParsers(theEnv); FuncSeqOvlFlags(theEnv,"progn",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"if",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"while",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"loop-for-count",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"return",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"switch",FALSE,FALSE); #endif EnvAddResetFunction(theEnv,"bind",FlushBindList,0); EnvAddClearFunction(theEnv,"bind",FlushBindList,0); } /*************************************************************/ /* DeallocateProceduralFunctionData: Deallocates environment */ /* data for procedural functions. */ /*************************************************************/ static void DeallocateProceduralFunctionData( void *theEnv) { DATA_OBJECT_PTR nextPtr, garbagePtr; garbagePtr = ProcedureFunctionData(theEnv)->BindList; while (garbagePtr != NULL) { nextPtr = garbagePtr->next; rtn_struct(theEnv,dataObject,garbagePtr); garbagePtr = nextPtr; } } /***************************************/ /* WhileFunction: H/L access routine */ /* for the while function. */ /***************************************/ globle void WhileFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theResult; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; /*====================================================*/ /* Evaluate the body of the while loop as long as the */ /* while condition evaluates to a non-FALSE value. */ /*====================================================*/ oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; EnvRtnUnknown(theEnv,1,&theResult); while (((theResult.value != EnvFalseSymbol(theEnv)) || (theResult.type != SYMBOL)) && (EvaluationData(theEnv)->HaltExecution != TRUE)) { if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; EnvRtnUnknown(theEnv,2,&theResult); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); EnvRtnUnknown(theEnv,1,&theResult); } /*=====================================================*/ /* Reset the break flag. The return flag is not reset */ /* because the while loop is probably contained within */ /* a deffunction or RHS of a rule which needs to be */ /* returned from as well. */ /*=====================================================*/ ProcedureFunctionData(theEnv)->BreakFlag = FALSE; /*====================================================*/ /* If the return command was issued, then return that */ /* value, otherwise return the symbol FALSE. */ /*====================================================*/ if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { returnValue->type = theResult.type; returnValue->value = theResult.value; returnValue->begin = theResult.begin; returnValue->end = theResult.end; } else { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); } RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,returnValue); CallPeriodicTasks(theEnv); } /********************************************/ /* LoopForCountFunction: H/L access routine */ /* for the loop-for-count function. */ /********************************************/ globle void LoopForCountFunction( void *theEnv, DATA_OBJECT_PTR loopResult) { DATA_OBJECT arg_ptr; long long iterationEnd; LOOP_COUNTER_STACK *tmpCounter; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; tmpCounter = get_struct(theEnv,loopCounterStack); tmpCounter->loopCounter = 0L; tmpCounter->nxt = ProcedureFunctionData(theEnv)->LoopCounterStack; ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter; if (EnvArgTypeCheck(theEnv,"loop-for-count",1,INTEGER,&arg_ptr) == FALSE) { loopResult->type = SYMBOL; loopResult->value = EnvFalseSymbol(theEnv); ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt; rtn_struct(theEnv,loopCounterStack,tmpCounter); return; } tmpCounter->loopCounter = DOToLong(arg_ptr); if (EnvArgTypeCheck(theEnv,"loop-for-count",2,INTEGER,&arg_ptr) == FALSE) { loopResult->type = SYMBOL; loopResult->value = EnvFalseSymbol(theEnv); ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt; rtn_struct(theEnv,loopCounterStack,tmpCounter); return; } oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; iterationEnd = DOToLong(arg_ptr); while ((tmpCounter->loopCounter <= iterationEnd) && (EvaluationData(theEnv)->HaltExecution != TRUE)) { if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; EnvRtnUnknown(theEnv,3,&arg_ptr); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); tmpCounter->loopCounter++; } ProcedureFunctionData(theEnv)->BreakFlag = FALSE; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { loopResult->type = arg_ptr.type; loopResult->value = arg_ptr.value; loopResult->begin = arg_ptr.begin; loopResult->end = arg_ptr.end; } else { loopResult->type = SYMBOL; loopResult->value = EnvFalseSymbol(theEnv); } ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt; rtn_struct(theEnv,loopCounterStack,tmpCounter); RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,loopResult); CallPeriodicTasks(theEnv); } /*****************/ /* GetLoopCount: */ /*****************/ globle long long GetLoopCount( void *theEnv) { int depth; LOOP_COUNTER_STACK *tmpCounter; depth = ValueToInteger(GetFirstArgument()->value); tmpCounter = ProcedureFunctionData(theEnv)->LoopCounterStack; while (depth > 0) { tmpCounter = tmpCounter->nxt; depth--; } return(tmpCounter->loopCounter); } /************************************/ /* IfFunction: H/L access routine */ /* for the if function. */ /************************************/ globle void IfFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { int numArgs; struct expr *theExpr; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((EvaluationData(theEnv)->CurrentExpression->argList == NULL) || (EvaluationData(theEnv)->CurrentExpression->argList->nextArg == NULL)) { EnvArgRangeCheck(theEnv,"if",2,3); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg == NULL) { numArgs = 2; } else if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg->nextArg == NULL) { numArgs = 3; } else { EnvArgRangeCheck(theEnv,"if",2,3); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=========================*/ /* Evaluate the condition. */ /*=========================*/ EvaluateExpression(theEnv,EvaluationData(theEnv)->CurrentExpression->argList,returnValue); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=========================================*/ /* If the condition evaluated to FALSE and */ /* an "else" portion exists, evaluate it */ /* and return the value. */ /*=========================================*/ if ((returnValue->value == EnvFalseSymbol(theEnv)) && (returnValue->type == SYMBOL) && (numArgs == 3)) { theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg; switch (theExpr->type) { case INTEGER: case FLOAT: case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = theExpr->type; returnValue->value = theExpr->value; break; default: EvaluateExpression(theEnv,theExpr,returnValue); break; } return; } /*===================================================*/ /* Otherwise if the symbol evaluated to a non-FALSE */ /* value, evaluate the "then" portion and return it. */ /*===================================================*/ else if ((returnValue->value != EnvFalseSymbol(theEnv)) || (returnValue->type != SYMBOL)) { theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg; switch (theExpr->type) { case INTEGER: case FLOAT: case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = theExpr->type; returnValue->value = theExpr->value; break; default: EvaluateExpression(theEnv,theExpr,returnValue); break; } return; } /*=========================================*/ /* Return FALSE if the condition evaluated */ /* to FALSE and there is no "else" portion */ /* of the if statement. */ /*=========================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /**************************************/ /* BindFunction: H/L access routine */ /* for the bind function. */ /**************************************/ globle void BindFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT *theBind, *lastBind; int found = FALSE, unbindVar = FALSE; SYMBOL_HN *variableName = NULL; #if DEFGLOBAL_CONSTRUCT struct defglobal *theGlobal = NULL; #endif /*===============================================*/ /* Determine the name of the variable to be set. */ /*===============================================*/ #if DEFGLOBAL_CONSTRUCT if (GetFirstArgument()->type == DEFGLOBAL_PTR) { theGlobal = (struct defglobal *) GetFirstArgument()->value; } else #endif { EvaluateExpression(theEnv,GetFirstArgument(),returnValue); variableName = (SYMBOL_HN *) DOPToPointer(returnValue); } /*===========================================*/ /* Determine the new value for the variable. */ /*===========================================*/ if (GetFirstArgument()->nextArg == NULL) { unbindVar = TRUE; } else if (GetFirstArgument()->nextArg->nextArg == NULL) { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,returnValue); } else { StoreInMultifield(theEnv,returnValue,GetFirstArgument()->nextArg,TRUE); } /*==================================*/ /* Bind a defglobal if appropriate. */ /*==================================*/ #if DEFGLOBAL_CONSTRUCT if (theGlobal != NULL) { QSetDefglobalValue(theEnv,theGlobal,returnValue,unbindVar); return; } #endif /*===============================================*/ /* Search for the variable in the list of binds. */ /*===============================================*/ theBind = ProcedureFunctionData(theEnv)->BindList; lastBind = NULL; while ((theBind != NULL) && (found == FALSE)) { if (theBind->supplementalInfo == (void *) variableName) { found = TRUE; } else { lastBind = theBind; theBind = theBind->next; } } /*========================================================*/ /* If variable was not in the list of binds, then add it. */ /* Make sure that this operation preserves the bind list */ /* as a stack. */ /*========================================================*/ if (found == FALSE) { if (unbindVar == FALSE) { theBind = get_struct(theEnv,dataObject); theBind->supplementalInfo = (void *) variableName; IncrementSymbolCount(variableName); theBind->next = NULL; if (lastBind == NULL) { ProcedureFunctionData(theEnv)->BindList = theBind; } else { lastBind->next = theBind; } } else { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } } else { ValueDeinstall(theEnv,theBind); } /*================================*/ /* Set the value of the variable. */ /*================================*/ if (unbindVar == FALSE) { theBind->type = returnValue->type; theBind->value = returnValue->value; theBind->begin = returnValue->begin; theBind->end = returnValue->end; ValueInstall(theEnv,returnValue); } else { if (lastBind == NULL) ProcedureFunctionData(theEnv)->BindList = theBind->next; else lastBind->next = theBind->next; DecrementSymbolCount(theEnv,(struct symbolHashNode *) theBind->supplementalInfo); rtn_struct(theEnv,dataObject,theBind); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); } } /*******************************************/ /* GetBoundVariable: Searches the BindList */ /* for a specified variable. */ /*******************************************/ globle intBool GetBoundVariable( void *theEnv, DATA_OBJECT_PTR vPtr, SYMBOL_HN *varName) { DATA_OBJECT_PTR bindPtr; for (bindPtr = ProcedureFunctionData(theEnv)->BindList; bindPtr != NULL; bindPtr = bindPtr->next) { if (bindPtr->supplementalInfo == (void *) varName) { vPtr->type = bindPtr->type; vPtr->value = bindPtr->value; vPtr->begin = bindPtr->begin; vPtr->end = bindPtr->end; return(TRUE); } } return(FALSE); } /*************************************************/ /* FlushBindList: Removes all variables from the */ /* list of currently bound local variables. */ /*************************************************/ globle void FlushBindList( void *theEnv) { ReturnValues(theEnv,ProcedureFunctionData(theEnv)->BindList,TRUE); ProcedureFunctionData(theEnv)->BindList = NULL; } /***************************************/ /* PrognFunction: H/L access routine */ /* for the progn function. */ /***************************************/ globle void PrognFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct expr *argPtr; argPtr = EvaluationData(theEnv)->CurrentExpression->argList; if (argPtr == NULL) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } while ((argPtr != NULL) && (GetHaltExecution(theEnv) != TRUE)) { EvaluateExpression(theEnv,argPtr,returnValue); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; argPtr = argPtr->nextArg; } if (GetHaltExecution(theEnv) == TRUE) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } return; } /*****************************************************************/ /* ReturnFunction: H/L access routine for the return function. */ /*****************************************************************/ globle void ReturnFunction( void *theEnv, DATA_OBJECT_PTR result) { if (EnvRtnArgCount(theEnv) == 0) { result->type = RVOID; result->value = EnvFalseSymbol(theEnv); } else EnvRtnUnknown(theEnv,1,result); ProcedureFunctionData(theEnv)->ReturnFlag = TRUE; } /***************************************************************/ /* BreakFunction: H/L access routine for the break function. */ /***************************************************************/ globle void BreakFunction( void *theEnv) { ProcedureFunctionData(theEnv)->BreakFlag = TRUE; } /*****************************************************************/ /* SwitchFunction: H/L access routine for the switch function. */ /*****************************************************************/ globle void SwitchFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT switch_val,case_val; EXPRESSION *theExp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /* ========================== Get the value to switch on ========================== */ EvaluateExpression(theEnv,GetFirstArgument(),&switch_val); if (EvaluationData(theEnv)->EvaluationError) return; for (theExp = GetFirstArgument()->nextArg ; theExp != NULL ; theExp = theExp->nextArg->nextArg) { /* ================================================= RVOID is the default case (if any) for the switch ================================================= */ if (theExp->type == RVOID) { EvaluateExpression(theEnv,theExp->nextArg,result); return; } /* ==================================================== If the case matches, evaluate the actions and return ==================================================== */ EvaluateExpression(theEnv,theExp,&case_val); if (EvaluationData(theEnv)->EvaluationError) return; if (switch_val.type == case_val.type) { if ((case_val.type == MULTIFIELD) ? MultifieldDOsEqual(&switch_val,&case_val) : (switch_val.value == case_val.value)) { EvaluateExpression(theEnv,theExp->nextArg,result); return; } } } } clips_core_source_630/core/factrhs.h0000755000175000017500000000457612375261537016063 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/20/14 */ /* */ /* FACT RHS PATTERN PARSER HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /*************************************************************/ #ifndef _H_factrhs #define _H_factrhs #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTRHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct expr *BuildRHSAssert(void *,const char *,struct token *,int *,int,int,const char *); LOCALE struct expr *GetAssertArgument(void *,const char *,struct token *,int *,int,int,int *); LOCALE struct expr *GetRHSPattern(void *,const char *,struct token *,int *,int, int,int,int); LOCALE struct fact *StringToFact(void *,const char *); #endif /* _H_factrhs */ clips_core_source_630/core/modulutl.c0000755000175000017500000006263112374017670016261 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing module/construct */ /* names and searching through modules for specific */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Used genstrncpy instead of strncpy. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _MODULUTL_SOURCE_ #include "setup.h" #include "memalloc.h" #include "router.h" #include "envrnmnt.h" #include "sysdep.h" #include "modulpsr.h" #include "modulutl.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *SearchImportedConstructModules(void *,struct symbolHashNode *, struct defmodule *, struct moduleItem *,struct symbolHashNode *, int *,int,struct defmodule *); /********************************************************************/ /* FindModuleSeparator: Finds the :: separator which delineates the */ /* boundary between a module name and a construct name. The value */ /* zero is returned if the separator is not found, otherwise the */ /* position of the second colon within the string is returned. */ /********************************************************************/ globle unsigned FindModuleSeparator( const char *theString) { unsigned i, foundColon; for (i = 0, foundColon = FALSE; theString[i] != EOS; i++) { if (theString[i] == ':') { if (foundColon) return(i); foundColon = TRUE; } else { foundColon = FALSE; } } return(FALSE); } /*******************************************************************/ /* ExtractModuleName: Given the position of the :: separator and a */ /* module/construct name joined using the separator, returns a */ /* symbol reference to the module name (or NULL if a module name */ /* cannot be extracted). */ /*******************************************************************/ globle SYMBOL_HN *ExtractModuleName( void *theEnv, unsigned thePosition, const char *theString) { char *newString; SYMBOL_HN *returnValue; /*=============================================*/ /* Return NULL if the :: is in a position such */ /* that a module name can't be extracted. */ /*=============================================*/ if (thePosition <= 1) return(NULL); /*==========================================*/ /* Allocate storage for a temporary string. */ /*==========================================*/ newString = (char *) gm2(theEnv,thePosition); /*======================================================*/ /* Copy the entire module/construct name to the string. */ /*======================================================*/ genstrncpy(newString,theString, (STD_SIZE) thePosition - 1); /*========================================================*/ /* Place an end of string marker where the :: is located. */ /*========================================================*/ newString[thePosition-1] = EOS; /*=====================================================*/ /* Add the module name (the truncated module/construct */ /* name) to the symbol table. */ /*=====================================================*/ returnValue = (SYMBOL_HN *) EnvAddSymbol(theEnv,newString); /*=============================================*/ /* Return the storage of the temporary string. */ /*=============================================*/ rm(theEnv,newString,thePosition); /*=============================================*/ /* Return a pointer to the module name symbol. */ /*=============================================*/ return(returnValue); } /********************************************************************/ /* ExtractConstructName: Given the position of the :: separator and */ /* a module/construct name joined using the separator, returns a */ /* symbol reference to the construct name (or NULL if a construct */ /* name cannot be extracted). */ /********************************************************************/ globle SYMBOL_HN *ExtractConstructName( void *theEnv, unsigned thePosition, const char *theString) { size_t theLength; char *newString; SYMBOL_HN *returnValue; /*======================================*/ /* Just return the string if it doesn't */ /* contain the :: symbol. */ /*======================================*/ if (thePosition == 0) return((SYMBOL_HN *) EnvAddSymbol(theEnv,theString)); /*=====================================*/ /* Determine the length of the string. */ /*=====================================*/ theLength = strlen(theString); /*=================================================*/ /* Return NULL if the :: is at the very end of the */ /* string (and thus there is no construct name). */ /*=================================================*/ if (theLength <= (thePosition + 1)) return(NULL); /*====================================*/ /* Allocate a temporary string large */ /* enough to hold the construct name. */ /*====================================*/ newString = (char *) gm2(theEnv,theLength - thePosition); /*================================================*/ /* Copy the construct name portion of the */ /* module/construct name to the temporary string. */ /*================================================*/ genstrncpy(newString,&theString[thePosition+1], (STD_SIZE) theLength - thePosition); /*=============================================*/ /* Add the construct name to the symbol table. */ /*=============================================*/ returnValue = (SYMBOL_HN *) EnvAddSymbol(theEnv,newString); /*=============================================*/ /* Return the storage of the temporary string. */ /*=============================================*/ rm(theEnv,newString,theLength - thePosition); /*================================================*/ /* Return a pointer to the construct name symbol. */ /*================================================*/ return(returnValue); } /****************************************************/ /* ExtractModuleAndConstructName: Extracts both the */ /* module and construct name from a string. Sets */ /* the current module to the specified module. */ /****************************************************/ globle const char *ExtractModuleAndConstructName( void *theEnv, const char *theName) { unsigned separatorPosition; SYMBOL_HN *moduleName, *shortName; struct defmodule *theModule; /*========================*/ /* Find the :: separator. */ /*========================*/ separatorPosition = FindModuleSeparator(theName); if (! separatorPosition) return(theName); /*==========================*/ /* Extract the module name. */ /*==========================*/ moduleName = ExtractModuleName(theEnv,separatorPosition,theName); if (moduleName == NULL) return(NULL); /*====================================*/ /* Check to see if the module exists. */ /*====================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); if (theModule == NULL) return(NULL); /*============================*/ /* Change the current module. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*=============================*/ /* Extract the construct name. */ /*=============================*/ shortName = ExtractConstructName(theEnv,separatorPosition,theName); if (shortName == NULL) return(NULL); return(ValueToString(shortName)); } /************************************************************/ /* FindImportedConstruct: High level routine which searches */ /* a module and other modules from which it imports */ /* constructs for a specified construct. */ /************************************************************/ globle void *FindImportedConstruct( void *theEnv, const char *constructName, struct defmodule *matchModule, const char *findName, int *count, int searchCurrent, struct defmodule *notYetDefinedInModule) { void *rv; struct moduleItem *theModuleItem; /*=============================================*/ /* Set the number of references found to zero. */ /*=============================================*/ *count = 0; /*===============================*/ /* The :: should not be included */ /* in the construct's name. */ /*===============================*/ if (FindModuleSeparator(findName)) return(NULL); /*=============================================*/ /* Remember the current module since we'll be */ /* changing it during the search and will want */ /* to restore it once the search is completed. */ /*=============================================*/ SaveCurrentModule(theEnv); /*==========================================*/ /* Find the module related access functions */ /* for the construct type being sought. */ /*==========================================*/ if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) { RestoreCurrentModule(theEnv); return(NULL); } /*===========================================*/ /* If the construct type doesn't have a find */ /* function, then we can't look for it. */ /*===========================================*/ if (theModuleItem->findFunction == NULL) { RestoreCurrentModule(theEnv); return(NULL); } /*==================================*/ /* Initialize the search by marking */ /* all modules as unvisited. */ /*==================================*/ MarkModulesAsUnvisited(theEnv); /*===========================*/ /* Search for the construct. */ /*===========================*/ rv = SearchImportedConstructModules(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,constructName), matchModule,theModuleItem, (SYMBOL_HN *) EnvAddSymbol(theEnv,findName),count, searchCurrent,notYetDefinedInModule); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*====================================*/ /* Return a pointer to the construct. */ /*====================================*/ return(rv); } /*********************************************************/ /* AmbiguousReferenceErrorMessage: Error message printed */ /* when a reference to a specific construct can be */ /* imported from more than one module. */ /*********************************************************/ globle void AmbiguousReferenceErrorMessage( void *theEnv, const char *constructName, const char *findName) { EnvPrintRouter(theEnv,WERROR,"Ambiguous reference to "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,findName); EnvPrintRouter(theEnv,WERROR,".\nIt is imported from more than one module.\n"); } /****************************************************/ /* MarkModulesAsUnvisited: Used for initializing a */ /* search through the module heirarchies. Sets */ /* the visited flag of each module to FALSE. */ /****************************************************/ globle void MarkModulesAsUnvisited( void *theEnv) { struct defmodule *theModule; DefmoduleData(theEnv)->CurrentModule->visitedFlag = FALSE; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { theModule->visitedFlag = FALSE; } } /***********************************************************/ /* SearchImportedConstructModules: Low level routine which */ /* searches a module and other modules from which it */ /* imports constructs for a specified construct. */ /***********************************************************/ static void *SearchImportedConstructModules( void *theEnv, struct symbolHashNode *constructType, struct defmodule *matchModule, struct moduleItem *theModuleItem, struct symbolHashNode *findName, int *count, int searchCurrent, struct defmodule *notYetDefinedInModule) { struct defmodule *theModule; struct portItem *theImportList, *theExportList; void *rv, *arv = NULL; int searchModule, exported; struct defmodule *currentModule; /*=========================================*/ /* Start the search in the current module. */ /* If the current module has already been */ /* visited, then return. */ /*=========================================*/ currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (currentModule->visitedFlag) return(NULL); /*=======================================================*/ /* The searchCurrent flag indicates whether the current */ /* module should be included in the search. In addition, */ /* if matchModule is non-NULL, the current module will */ /* only be searched if it is the specific module from */ /* which we want the construct imported. */ /*=======================================================*/ if ((searchCurrent) && ((matchModule == NULL) || (currentModule == matchModule))) { /*===============================================*/ /* Look for the construct in the current module. */ /*===============================================*/ rv = (*theModuleItem->findFunction)(theEnv,ValueToString(findName)); /*========================================================*/ /* If we're in the process of defining the construct in */ /* the module we're searching then go ahead and increment */ /* the count indicating the number of modules in which */ /* the construct was found. */ /*========================================================*/ if (notYetDefinedInModule == currentModule) { (*count)++; arv = rv; } /*=========================================================*/ /* Otherwise, if the construct is in the specified module, */ /* increment the count only if the construct actually */ /* belongs to the module. [Some constructs, like the COOL */ /* system classes, can be found in any module, but they */ /* actually belong to the MAIN module.] */ /*=========================================================*/ else if (rv != NULL) { if (((struct constructHeader *) rv)->whichModule->theModule == currentModule) { (*count)++; } arv = rv; } } /*=====================================*/ /* Mark the current module as visited. */ /*=====================================*/ currentModule->visitedFlag = TRUE; /*===================================*/ /* Search through all of the modules */ /* imported by the current module. */ /*===================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); theImportList = theModule->importList; while (theImportList != NULL) { /*===================================================*/ /* Determine if the module should be searched (based */ /* upon whether the entire module, all constructs of */ /* a specific type, or specifically named constructs */ /* are imported). */ /*===================================================*/ searchModule = FALSE; if ((theImportList->constructType == NULL) || (theImportList->constructType == constructType)) { if ((theImportList->constructName == NULL) || (theImportList->constructName == findName)) { searchModule = TRUE; } } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ if (searchModule) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theImportList->moduleName)); if (theModule == NULL) searchModule = FALSE; } /*=======================================================*/ /* Determine if the construct is exported by the module. */ /*=======================================================*/ if (searchModule) { exported = FALSE; theExportList = theModule->exportList; while ((theExportList != NULL) && (! exported)) { if ((theExportList->constructType == NULL) || (theExportList->constructType == constructType)) { if ((theExportList->constructName == NULL) || (theExportList->constructName == findName)) { exported = TRUE; } } theExportList = theExportList->next; } if (! exported) searchModule = FALSE; } /*=================================*/ /* Search in the specified module. */ /*=================================*/ if (searchModule) { EnvSetCurrentModule(theEnv,(void *) theModule); if ((rv = SearchImportedConstructModules(theEnv,constructType,matchModule, theModuleItem,findName, count,TRUE, notYetDefinedInModule)) != NULL) { arv = rv; } } /*====================================*/ /* Move on to the next imported item. */ /*====================================*/ theImportList = theImportList->next; } /*=========================*/ /* Return a pointer to the */ /* last construct found. */ /*=========================*/ return(arv); } /**************************************************************/ /* ConstructExported: Returns TRUE if the specified construct */ /* is exported from the specified module. */ /**************************************************************/ globle intBool ConstructExported( void *theEnv, const char *constructTypeStr, struct symbolHashNode *moduleName, struct symbolHashNode *findName) { struct symbolHashNode *constructType; struct defmodule *theModule; struct portItem *theExportList; constructType = FindSymbolHN(theEnv,constructTypeStr); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); if ((constructType == NULL) || (theModule == NULL) || (findName == NULL)) { return(FALSE); } theExportList = theModule->exportList; while (theExportList != NULL) { if ((theExportList->constructType == NULL) || (theExportList->constructType == constructType)) { if ((theExportList->constructName == NULL) || (theExportList->constructName == findName)) { return TRUE; } } theExportList = theExportList->next; } return FALSE; } /*********************************************************/ /* AllImportedModulesVisited: Returns TRUE if all of the */ /* imported modules for a module have been visited. */ /*********************************************************/ globle intBool AllImportedModulesVisited( void *theEnv, struct defmodule *theModule) { struct portItem *theImportList; struct defmodule *theImportModule; theImportList = theModule->importList; while (theImportList != NULL) { theImportModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theImportList->moduleName)); if (! theImportModule->visitedFlag) return FALSE; theImportList = theImportList->next; } return TRUE; } /***************************************/ /* ListItemsDriver: Driver routine for */ /* listing items in a module. */ /***************************************/ globle void ListItemsDriver( void *theEnv, const char *logicalName, struct defmodule *theModule, const char *singleName, const char *pluralName, void *(*nextFunction)(void *,void *), const char *(*nameFunction)(void *), void (*printFunction)(void *,const char *,void *), int (*doItFunction)(void *,void *)) { void *constructPtr; const char *constructName; long count = 0; int allModules = FALSE; int doIt; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*======================*/ /* Print out the items. */ /*======================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } while (theModule != NULL) { if (allModules) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); } EnvSetCurrentModule(theEnv,(void *) theModule); constructPtr = (*nextFunction)(theEnv,NULL); while (constructPtr != NULL) { if (EvaluationData(theEnv)->HaltExecution == TRUE) return; if (doItFunction == NULL) doIt = TRUE; else doIt = (*doItFunction)(theEnv,constructPtr); if (! doIt) {} else if (nameFunction != NULL) { constructName = (*nameFunction)(constructPtr); if (constructName != NULL) { if (allModules) EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,constructName); EnvPrintRouter(theEnv,logicalName,"\n"); } } else if (printFunction != NULL) { if (allModules) EnvPrintRouter(theEnv,logicalName," "); (*printFunction)(theEnv,logicalName,constructPtr); EnvPrintRouter(theEnv,logicalName,"\n"); } constructPtr = (*nextFunction)(theEnv,constructPtr); count++; } if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); else theModule = NULL; } /*=================================================*/ /* Print the tally and restore the current module. */ /*=================================================*/ if (singleName != NULL) PrintTally(theEnv,logicalName,count,singleName,pluralName); RestoreCurrentModule(theEnv); } /********************************************************/ /* DoForAllModules: Executes an action for all modules. */ /********************************************************/ globle long DoForAllModules( void *theEnv, void (*actionFunction)(struct defmodule *,void *), int interruptable, void *userBuffer) { void *theModule; long moduleCount = 0L; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule), moduleCount++) { EnvSetCurrentModule(theEnv,(void *) theModule); if ((interruptable) && GetHaltExecution(theEnv)) { RestoreCurrentModule(theEnv); return(-1L); } (*actionFunction)((struct defmodule *) theModule,userBuffer); } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*=========================================*/ /* Return the number of modules traversed. */ /*=========================================*/ return(moduleCount); } clips_core_source_630/core/tmpltrhs.c0000755000175000017500000004547612365012263016272 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 07/25/14 */ /* */ /* DEFTEMPLATE RHS PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses deftemplate fact patterns used with the */ /* assert function. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added additional argument required for */ /* DeriveDefaultFromConstraints. */ /* */ /* Added additional argument required for */ /* InvalidDeftemplateSlotMessage. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _TMPLTRHS_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "prntutil.h" #include "router.h" #include "tmpltfun.h" #include "tmpltdef.h" #include "factrhs.h" #include "extnfunc.h" #include "modulutl.h" #include "default.h" #include "tmpltutl.h" #include "tmpltlhs.h" #include "tmpltrhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct expr *ParseAssertSlotValues(void *,const char *,struct token *,struct templateSlot *,int *,int); static struct expr *ReorderAssertSlotValues(void *,struct templateSlot *,struct expr *,int *); static struct expr *GetSlotAssertValues(void *,struct templateSlot *,struct expr *,int *); static struct expr *FindAssertSlotItem(struct templateSlot *,struct expr *); static struct templateSlot *ParseSlotLabel(void *,const char *,struct token *,struct deftemplate *,int *,int); /******************************************************************/ /* ParseAssertTemplate: Parses and builds the list of values that */ /* are used for an assert of a fact with a deftemplate. */ /******************************************************************/ globle struct expr *ParseAssertTemplate( void *theEnv, const char *readSource, struct token *theToken, int *error, int endType, int constantsOnly, struct deftemplate *theDeftemplate) { struct expr *firstSlot, *lastSlot, *nextSlot; struct expr *firstArg, *tempSlot; struct templateSlot *slotPtr; firstSlot = NULL; lastSlot = NULL; /*==============================================*/ /* Parse each of the slot fields in the assert. */ /*==============================================*/ while ((slotPtr = ParseSlotLabel(theEnv,readSource,theToken,theDeftemplate,error,endType)) != NULL) { /*========================================================*/ /* Check to see that the slot hasn't already been parsed. */ /*========================================================*/ for (tempSlot = firstSlot; tempSlot != NULL; tempSlot = tempSlot->nextArg) { if (tempSlot->value == (void *) slotPtr->slotName) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(slotPtr->slotName)); *error = TRUE; ReturnExpression(theEnv,firstSlot); return(NULL); } } /*============================================*/ /* Parse the values to be stored in the slot. */ /*============================================*/ nextSlot = ParseAssertSlotValues(theEnv,readSource,theToken, slotPtr,error,constantsOnly); if (*error) { ReturnExpression(theEnv,firstSlot); return(NULL); } /*============================================*/ /* Check to see if the values to be stored in */ /* the slot violate the slot's constraints. */ /*============================================*/ if (CheckRHSSlotTypes(theEnv,nextSlot->argList,slotPtr,"assert") == 0) { *error = TRUE; ReturnExpression(theEnv,firstSlot); ReturnExpression(theEnv,nextSlot); return(NULL); } /*===================================================*/ /* Add the slot to the list of slots already parsed. */ /*===================================================*/ if (lastSlot == NULL) { firstSlot = nextSlot; } else { lastSlot->nextArg = nextSlot; } lastSlot = nextSlot; } /*=================================================*/ /* Return if an error occured parsing a slot name. */ /*=================================================*/ if (*error) { ReturnExpression(theEnv,firstSlot); return(NULL); } /*=============================================================*/ /* Reorder the arguments to the order used by the deftemplate. */ /*=============================================================*/ firstArg = ReorderAssertSlotValues(theEnv,theDeftemplate->slotList,firstSlot,error); ReturnExpression(theEnv,firstSlot); /*==============================*/ /* Return the assert arguments. */ /*==============================*/ return(firstArg); } /****************************************************************/ /* ParseSlotLabel: Parses the beginning of a slot definition. */ /* Checks for opening left parenthesis and a valid slot name. */ /****************************************************************/ static struct templateSlot *ParseSlotLabel( void *theEnv, const char *inputSource, struct token *tempToken, struct deftemplate *theDeftemplate, int *error, int endType) { struct templateSlot *slotPtr; short position; /*========================*/ /* Initialize error flag. */ /*========================*/ *error = FALSE; /*============================================*/ /* If token is a right parenthesis, then fact */ /* template definition is complete. */ /*============================================*/ GetToken(theEnv,inputSource,tempToken); if (tempToken->type == endType) { return(NULL); } /*=======================================*/ /* Put a space between the template name */ /* and the first slot definition. */ /*=======================================*/ PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,tempToken->printForm); /*=======================================================*/ /* Slot definition begins with opening left parenthesis. */ /*=======================================================*/ if (tempToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"deftemplate pattern"); *error = TRUE; return(NULL); } /*=============================*/ /* Slot name must be a symbol. */ /*=============================*/ GetToken(theEnv,inputSource,tempToken); if (tempToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate pattern"); *error = TRUE; return(NULL); } /*======================================================*/ /* Check that the slot name is valid for this template. */ /*======================================================*/ if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempToken->value,&position)) == NULL) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempToken->value), ValueToString(theDeftemplate->header.name),TRUE); *error = TRUE; return(NULL); } /*====================================*/ /* Return a pointer to the slot name. */ /*====================================*/ return(slotPtr); } /**************************************************************************/ /* ParseAssertSlotValues: Gets a single assert slot value for a template. */ /**************************************************************************/ static struct expr *ParseAssertSlotValues( void *theEnv, const char *inputSource, struct token *tempToken, struct templateSlot *slotPtr, int *error, int constantsOnly) { struct expr *nextSlot; struct expr *newField, *valueList, *lastValue; int printError; /*=============================*/ /* Handle a single field slot. */ /*=============================*/ if (slotPtr->multislot == FALSE) { /*=====================*/ /* Get the slot value. */ /*=====================*/ SavePPBuffer(theEnv," "); newField = GetAssertArgument(theEnv,inputSource,tempToken, error,RPAREN,constantsOnly,&printError); if (*error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); return(NULL); } /*=================================================*/ /* A single field slot value must contain a value. */ /* Only a multifield slot can be empty. */ /*=================================================*/ if (newField == NULL) { *error = TRUE; SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(NULL); } /*==============================================*/ /* A function returning a multifield value can */ /* not be called to get the value for the slot. */ /*==============================================*/ if ((newField->type == FCALL) ? (ExpressionFunctionType(newField) == 'm') : (newField->type == MF_VARIABLE)) { *error = TRUE; SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); ReturnExpression(theEnv,newField); return(NULL); } /*============================*/ /* Move on to the next token. */ /*============================*/ GetToken(theEnv,inputSource,tempToken); } /*========================================*/ /* Handle a multifield slot. Build a list */ /* of the values stored in the slot. */ /*========================================*/ else { SavePPBuffer(theEnv," "); valueList = GetAssertArgument(theEnv,inputSource,tempToken, error,RPAREN,constantsOnly,&printError); if (*error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); return(NULL); } if (valueList == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } lastValue = valueList; while (lastValue != NULL) /* (tempToken->type != RPAREN) */ { if (tempToken->type == RPAREN) { SavePPBuffer(theEnv," "); } else { /* PPBackup(theEnv); */ SavePPBuffer(theEnv," "); /* SavePPBuffer(theEnv,tempToken->printForm); */ } newField = GetAssertArgument(theEnv,inputSource,tempToken,error,RPAREN,constantsOnly,&printError); if (*error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); ReturnExpression(theEnv,valueList); return(NULL); } if (newField == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } lastValue->nextArg = newField; lastValue = newField; } newField = valueList; } /*==========================================================*/ /* Slot definition must be closed with a right parenthesis. */ /*==========================================================*/ if (tempToken->type != RPAREN) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); *error = TRUE; ReturnExpression(theEnv,newField); return(NULL); } /*=========================================================*/ /* Build and return a structure describing the slot value. */ /*=========================================================*/ nextSlot = GenConstant(theEnv,SYMBOL,slotPtr->slotName); nextSlot->argList = newField; return(nextSlot); } /*************************************************************************/ /* ReorderAssertSlotValues: Rearranges the asserted values to correspond */ /* to the order of the values described by the deftemplate. */ /*************************************************************************/ static struct expr *ReorderAssertSlotValues( void *theEnv, struct templateSlot *slotPtr, struct expr *firstSlot, int *error) { struct expr *firstArg = NULL; struct expr *lastArg = NULL, *newArg; /*=============================================*/ /* Loop through each of the slots in the order */ /* they're found in the deftemplate. */ /*=============================================*/ for (; slotPtr != NULL; slotPtr = slotPtr->next) { /*==============================================*/ /* Get either the value specified in the assert */ /* command or the default value for the slot. */ /*==============================================*/ newArg = GetSlotAssertValues(theEnv,slotPtr,firstSlot,error); if (*error) { ReturnExpression(theEnv,firstArg); return(NULL); } /*=====================================*/ /* Add the value to the list of values */ /* for the assert command. */ /*=====================================*/ if (newArg != NULL) { if (lastArg == NULL) { firstArg = newArg; } else { lastArg->nextArg = newArg; } lastArg = newArg; } } /*==============================*/ /* Return the list of arguments */ /* for the assert command. */ /*==============================*/ return(firstArg); } /***************************************************************/ /* GetSlotAssertValues: Gets the assert value for a given slot */ /* of a deftemplate. If the value was supplied by the user, */ /* it will be used. If not the default value or default */ /* default value will be used. */ /***************************************************************/ static struct expr *GetSlotAssertValues( void *theEnv, struct templateSlot *slotPtr, struct expr *firstSlot, int *error) { struct expr *slotItem; struct expr *newArg, *tempArg; DATA_OBJECT theDefault; const char *nullBitMap = "\0"; /*==================================================*/ /* Determine if the slot is assigned in the assert. */ /*==================================================*/ slotItem = FindAssertSlotItem(slotPtr,firstSlot); /*==========================================*/ /* If the slot is assigned, use that value. */ /*==========================================*/ if (slotItem != NULL) { newArg = slotItem->argList; slotItem->argList = NULL; } /*=================================*/ /* Otherwise, use a default value. */ /*=================================*/ else { /*================================================*/ /* If the (default ?NONE) attribute was specified */ /* for the slot, then a value must be supplied. */ /*================================================*/ if (slotPtr->noDefault) { PrintErrorID(theEnv,"TMPLTRHS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Slot "); EnvPrintRouter(theEnv,WERROR,slotPtr->slotName->contents); EnvPrintRouter(theEnv,WERROR," requires a value because of its (default ?NONE) attribute.\n"); *error = TRUE; return(NULL); } /*===================================================*/ /* If the (default ?DERIVE) attribute was specified */ /* (the default), then derive the default value from */ /* the slot's constraints. */ /*===================================================*/ else if ((slotPtr->defaultPresent == FALSE) && (slotPtr->defaultDynamic == FALSE)) { DeriveDefaultFromConstraints(theEnv,slotPtr->constraints,&theDefault, (int) slotPtr->multislot,TRUE); newArg = ConvertValueToExpression(theEnv,&theDefault); } /*=========================================*/ /* Otherwise, use the expression contained */ /* in the default attribute. */ /*=========================================*/ else { newArg = CopyExpression(theEnv,slotPtr->defaultList); } } /*=======================================================*/ /* Since a multifield slot default can contain a list of */ /* values, the values need to have a store-multifield */ /* function called wrapped around it to group all of the */ /* values into a single multifield value. */ /*=======================================================*/ if (slotPtr->multislot) { tempArg = GenConstant(theEnv,FACT_STORE_MULTIFIELD,EnvAddBitMap(theEnv,(void *) nullBitMap,1)); tempArg->argList = newArg; newArg = tempArg; } /*==============================================*/ /* Return the value to be asserted in the slot. */ /*==============================================*/ return(newArg); } /*******************************************************************/ /* FindAssertSlotItem: Finds a particular slot in a list of slots. */ /*******************************************************************/ static struct expr *FindAssertSlotItem( struct templateSlot *slotPtr, struct expr *listOfSlots) { while (listOfSlots != NULL) { if (listOfSlots->value == (void *) slotPtr->slotName) return (listOfSlots); listOfSlots = listOfSlots->nextArg; } return(NULL); } #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/tmpltlhs.h0000755000175000017500000000365412373754202016266 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE LHS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for rete network exists node. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_tmpltlhs #define _H_tmpltlhs #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTLHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct lhsParseNode *DeftemplateLHSParse(void *,const char *,struct deftemplate *); #endif /* _H_tmpltlhs */ clips_core_source_630/core/._emathfun.h0000755000175000017500000000040712373740015016431 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnops.h0000755000175000017500000000365212373714214016267 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT OPERATIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for performing operations on */ /* constraint records including computing the intersection */ /* and union of constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrnops #define _H_cstrnops #if (! RUN_TIME) #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNOPS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct constraintRecord *IntersectConstraints(void *,struct constraintRecord *,struct constraintRecord *); #if (! BLOAD_ONLY) LOCALE struct constraintRecord *UnionConstraints(void *,struct constraintRecord *,struct constraintRecord *); LOCALE void RemoveConstantFromConstraint(void *,int,void *,CONSTRAINT_RECORD *); #endif #endif /* (! RUN_TIME) */ #endif /* _H_cstrnops */ clips_core_source_630/core/._ruledlt.h0000755000175000017500000000040712374024356016301 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insqypsr.c0000755000175000017500000006172512464742046016311 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* INSTANCE-SET QUERIES PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Instance_set Queries Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Fixed memory leaks when error occurred. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if INSTANCE_SET_QUERIES && (! RUN_TIME) #include #include "classcom.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "insquery.h" #include "prcdrpsr.h" #include "prntutil.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #define _INSQYPSR_SOURCE_ #include "insqypsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define INSTANCE_SLOT_REF ':' /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static EXPRESSION *ParseQueryRestrictions(void *,EXPRESSION *,const char *,struct token *); static intBool ReplaceClassNameWithReference(void *,EXPRESSION *); static int ParseQueryTestExpression(void *,EXPRESSION *,const char *); static int ParseQueryActionExpression(void *,EXPRESSION *,const char *,EXPRESSION *,struct token *); static void ReplaceInstanceVariables(void *,EXPRESSION *,EXPRESSION *,int,int); static void ReplaceSlotReference(void *,EXPRESSION *,EXPRESSION *, struct FunctionDefinition *,int); static int IsQueryFunction(EXPRESSION *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************** NAME : ParseQueryNoAction DESCRIPTION : Parses the following functions : (any-instancep) (find-first-instance) (find-all-instances) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *ParseQueryNoAction( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *insQuerySetVars; struct token queryInputToken; insQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (insQuerySetVars == NULL) return(NULL); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); GetToken(theEnv,readSource,&queryInputToken); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList,TRUE,0); ReturnExpression(theEnv,insQuerySetVars); return(top); } /*********************************************************************** NAME : ParseQueryAction DESCRIPTION : Parses the following functions : (do-for-instance) (do-for-all-instances) (delayed-do-for-all-instances) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *ParseQueryAction( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *insQuerySetVars; struct token queryInputToken; insQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (insQuerySetVars == NULL) return(NULL); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } PPCRAndIndent(theEnv); if (ParseQueryActionExpression(theEnv,top,readSource,insQuerySetVars,&queryInputToken) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList,TRUE,0); ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList->nextArg,FALSE,0); ReturnExpression(theEnv,insQuerySetVars); return(top); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************** NAME : ParseQueryRestrictions DESCRIPTION : Parses the class restrictions for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) Caller's token buffer RETURNS : The instance-variable expressions SIDE EFFECTS : Entire query expression deleted on errors Nodes allocated for restrictions and instance variable expressions Class restrictions attached to query-expression as arguments NOTES : Expects top != NULL ***************************************************************/ static EXPRESSION *ParseQueryRestrictions( void *theEnv, EXPRESSION *top, const char *readSource, struct token *queryInputToken) { EXPRESSION *insQuerySetVars = NULL,*lastInsQuerySetVars = NULL, *classExp = NULL,*lastClassExp, *tmp,*lastOne = NULL; int error = FALSE; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) goto ParseQueryRestrictionsError1; GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) goto ParseQueryRestrictionsError1; while (queryInputToken->type == LPAREN) { GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != SF_VARIABLE) goto ParseQueryRestrictionsError1; tmp = insQuerySetVars; while (tmp != NULL) { if (tmp->value == queryInputToken->value) { PrintErrorID(theEnv,"INSQYPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate instance member variable name in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); goto ParseQueryRestrictionsError2; } tmp = tmp->nextArg; } tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value); if (insQuerySetVars == NULL) insQuerySetVars = tmp; else lastInsQuerySetVars->nextArg = tmp; lastInsQuerySetVars = tmp; SavePPBuffer(theEnv," "); classExp = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseQueryRestrictionsError2; if (classExp == NULL) goto ParseQueryRestrictionsError1; if (ReplaceClassNameWithReference(theEnv,classExp) == FALSE) goto ParseQueryRestrictionsError2; lastClassExp = classExp; SavePPBuffer(theEnv," "); while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL) { if (ReplaceClassNameWithReference(theEnv,tmp) == FALSE) goto ParseQueryRestrictionsError2; lastClassExp->nextArg = tmp; lastClassExp = tmp; SavePPBuffer(theEnv," "); } if (error) goto ParseQueryRestrictionsError2; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); tmp = GenConstant(theEnv,SYMBOL,(void *) InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); lastClassExp->nextArg = tmp; lastClassExp = tmp; if (top->argList == NULL) top->argList = classExp; else lastOne->nextArg = classExp; lastOne = lastClassExp; classExp = NULL; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); } if (queryInputToken->type != RPAREN) goto ParseQueryRestrictionsError1; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(insQuerySetVars); ParseQueryRestrictionsError1: SyntaxErrorMessage(theEnv,"instance-set query function"); ParseQueryRestrictionsError2: ReturnExpression(theEnv,classExp); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } /*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing an instance-set query, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current and imported modules for reference ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { const char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,"class",theClassName); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif } return(TRUE); } /************************************************************* NAME : ParseQueryTestExpression DESCRIPTION : Parses the test-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Test shoved in front of class-restrictions on query argument list NOTES : Expects top != NULL *************************************************************/ static int ParseQueryTestExpression( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *qtest; int error; struct BindInfo *oldBindList; error = FALSE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); qtest = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(FALSE); } if (qtest == NULL) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qtest->nextArg = top->argList; top->argList = qtest; if (ParsedBindNamesEmpty(theEnv) == FALSE) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"INSQYPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in instance-set query in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } SetParsedBindNames(theEnv,oldBindList); return(TRUE); } /************************************************************* NAME : ParseQueryActionExpression DESCRIPTION : Parses the action-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) List of query parameters RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Action shoved in front of class-restrictions and in back of test-expression on query argument list NOTES : Expects top != NULL && top->argList != NULL *************************************************************/ static int ParseQueryActionExpression( void *theEnv, EXPRESSION *top, const char *readSource, EXPRESSION *insQuerySetVars, struct token *queryInputToken) { EXPRESSION *qaction,*tmpInsSetVars; struct BindInfo *oldBindList,*newBindList,*prev; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,queryInputToken->printForm); ExpressionData(theEnv)->BreakContext = FALSE; if (qaction == NULL) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qaction->nextArg = top->argList->nextArg; top->argList->nextArg = qaction; newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { tmpInsSetVars = insQuerySetVars; while (tmpInsSetVars != NULL) { if (tmpInsSetVars->value == (void *) newBindList->name) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"INSQYPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind instance-set member variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(tmpInsSetVars->value)); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } tmpInsSetVars = tmpInsSetVars->nextArg; } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; return(TRUE); } /*********************************************************************************** NAME : ReplaceInstanceVariables DESCRIPTION : Replaces all references to instance-variables within an instance query-function with function calls to query-instance (which references the instance array at run-time) INPUTS : 1) The instance-variable list 2) A boolean expression containing variable references 3) A flag indicating whether to allow slot references of the type : for direct slot access or not 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If a SF_VARIABLE node is found and is on the list of instance variables, it is replaced with a query-instance function call. NOTES : Other SF_VARIABLE(S) are left alone for replacement by other parsers. This implies that a user may use defgeneric, defrule, and defmessage-handler variables within a query-function where they do not conflict with instance-variable names. ***********************************************************************************/ static void ReplaceInstanceVariables( void *theEnv, EXPRESSION *vlist, EXPRESSION *bexp, int sdirect, int ndepth) { EXPRESSION *eptr; struct FunctionDefinition *rindx_func,*rslot_func; int posn; rindx_func = FindFunction(theEnv,"(query-instance)"); rslot_func = FindFunction(theEnv,"(query-instance-slot)"); while (bexp != NULL) { if (bexp->type == SF_VARIABLE) { eptr = vlist; posn = 0; while ((eptr != NULL) ? (eptr->value != bexp->value) : FALSE) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { bexp->type = FCALL; bexp->value = (void *) rindx_func; eptr = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) ndepth)); eptr->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) posn)); bexp->argList = eptr; } else if (sdirect == TRUE) ReplaceSlotReference(theEnv,vlist,bexp,rslot_func,ndepth); } if (bexp->argList != NULL) { if (IsQueryFunction(bexp)) ReplaceInstanceVariables(theEnv,vlist,bexp->argList,sdirect,ndepth+1); else ReplaceInstanceVariables(theEnv,vlist,bexp->argList,sdirect,ndepth); } bexp = bexp->nextArg; } } /************************************************************************* NAME : ReplaceSlotReference DESCRIPTION : Replaces instance-set query function variable references of the form: : with function calls to get these instance-slots at run time INPUTS : 1) The instance-set variable list 2) The expression containing the variable 3) The address of the instance slot access function 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If the variable is a slot reference, then it is replaced with the appropriate function-call. NOTES : None *************************************************************************/ static void ReplaceSlotReference( void *theEnv, EXPRESSION *vlist, EXPRESSION *theExp, struct FunctionDefinition *func, int ndepth) { size_t len; int posn,oldpp; size_t i; const char *str; EXPRESSION *eptr; struct token itkn; str = ValueToString(theExp->value); len = strlen(str); if (len < 3) return; for (i = len-2 ; i >= 1 ; i--) { if ((str[i] == INSTANCE_SLOT_REF) ? (i >= 1) : FALSE) { eptr = vlist; posn = 0; while (eptr && ((i != strlen(ValueToString(eptr->value))) || strncmp(ValueToString(eptr->value),str, (STD_SIZE) i))) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { OpenStringSource(theEnv,"query-var",str+i+1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"query-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"query-var"); theExp->type = FCALL; theExp->value = (void *) func; theExp->argList = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) ndepth)); theExp->argList->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) posn)); theExp->argList->nextArg->nextArg = GenConstant(theEnv,itkn.type,itkn.value); break; } } } } /******************************************************************** NAME : IsQueryFunction DESCRIPTION : Determines if an expression is a query function call INPUTS : The expression RETURNS : TRUE if query function call, FALSE otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ static int IsQueryFunction( EXPRESSION *theExp) { int (*fptr)(void); if (theExp->type != FCALL) return(FALSE); fptr = (int (*)(void)) ExpressionFunctionPointer(theExp); if (fptr == (int (*)(void)) AnyInstances) return(TRUE); if (fptr == (int (*)(void)) QueryFindInstance) return(TRUE); if (fptr == (int (*)(void)) QueryFindAllInstances) return(TRUE); if (fptr == (int (*)(void)) QueryDoForInstance) return(TRUE); if (fptr == (int (*)(void)) QueryDoForAllInstances) return(TRUE); if (fptr == (int (*)(void)) DelayedQueryDoForAllInstances) return(TRUE); return(FALSE); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips_core_source_630/core/objrtbld.c0000755000175000017500000025531112500721260016201 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/13/15 */ /* */ /* OBJECT PATTERN MATCHER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: RETE Network Parsing Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for long long integers. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Added support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #if (! BLOAD_ONLY) && (! RUN_TIME) #include #include #include "classcom.h" #include "classfun.h" #include "cstrnutl.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnops.h" #include "drive.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "memalloc.h" #include "network.h" #include "object.h" #include "pattern.h" #include "reteutil.h" #include "ruledef.h" #include "rulepsr.h" #include "scanner.h" #include "symbol.h" #include "utility.h" #endif #include "constrct.h" #include "objrtmch.h" #include "objrtgen.h" #include "objrtfnx.h" #include "reorder.h" #include "router.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "objrtcmp.h" #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "objrtbin.h" #endif #define _OBJRTBLD_SOURCE_ #include "objrtbld.h" #if ! DEFINSTANCES_CONSTRUCT #include "extnfunc.h" #include "classfun.h" #include "classcom.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define OBJECT_PATTERN_INDICATOR "object" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool PatternParserFind(SYMBOL_HN *); static struct lhsParseNode *ObjectLHSParse(void *,const char *,struct token *); static intBool ReorderAndAnalyzeObjectPattern(void *,struct lhsParseNode *); static struct patternNodeHeader *PlaceObjectPattern(void *,struct lhsParseNode *); static OBJECT_PATTERN_NODE *FindObjectPatternNode(OBJECT_PATTERN_NODE *,struct lhsParseNode *, OBJECT_PATTERN_NODE **,unsigned,unsigned); static OBJECT_PATTERN_NODE *CreateNewObjectPatternNode(void *,struct lhsParseNode *,OBJECT_PATTERN_NODE *, OBJECT_PATTERN_NODE *,unsigned,unsigned); static void DetachObjectPattern(void *,struct patternNodeHeader *); static void ClearObjectPatternMatches(void *,OBJECT_ALPHA_NODE *); static void RemoveObjectPartialMatches(void *,INSTANCE_TYPE *,struct patternNodeHeader *); static intBool CheckDuplicateSlots(void *,struct lhsParseNode *,SYMBOL_HN *); static struct lhsParseNode *ParseClassRestriction(void *,const char *,struct token *); static struct lhsParseNode *ParseNameRestriction(void *,const char *,struct token *); static struct lhsParseNode *ParseSlotRestriction(void *,const char *,struct token *,CONSTRAINT_RECORD *,int); static CLASS_BITMAP *NewClassBitMap(void *,int,int); static void InitializeClassBitMap(void *,CLASS_BITMAP *,int); static void DeleteIntermediateClassBitMap(void *,CLASS_BITMAP *); static void *CopyClassBitMap(void *,void *); static void DeleteClassBitMap(void *,void *); static void MarkBitMapClassesBusy(void *,BITMAP_HN *,int); static intBool EmptyClassBitMap(CLASS_BITMAP *); static intBool IdenticalClassBitMap(CLASS_BITMAP *,CLASS_BITMAP *); static intBool ProcessClassRestriction(void *,CLASS_BITMAP *,struct lhsParseNode **,int); static CONSTRAINT_RECORD *ProcessSlotRestriction(void *,CLASS_BITMAP *,SYMBOL_HN *,int *); static void IntersectClassBitMaps(CLASS_BITMAP *,CLASS_BITMAP *); static void UnionClassBitMaps(CLASS_BITMAP *,CLASS_BITMAP *); static CLASS_BITMAP *PackClassBitMap(void *,CLASS_BITMAP *); static struct lhsParseNode *FilterObjectPattern(void *,struct patternParser *, struct lhsParseNode *,struct lhsParseNode **, struct lhsParseNode **,struct lhsParseNode **); static BITMAP_HN *FormSlotBitMap(void *,struct lhsParseNode *); static struct lhsParseNode *RemoveSlotExistenceTests(void *,struct lhsParseNode *,BITMAP_HN **); static struct lhsParseNode *CreateInitialObjectPattern(void *); static EXPRESSION *ObjectMatchDelayParse(void *,EXPRESSION *,const char *); static void MarkObjectPtnIncrementalReset(void *,struct patternNodeHeader *,int); static void ObjectIncrementalReset(void *); #endif #if ! DEFINSTANCES_CONSTRUCT static void ResetInitialObject(void *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : SetupObjectPatternStuff DESCRIPTION : Installs the parsers and other items necessary for recognizing and processing object patterns in defrules INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Rete network interfaces for objects initialized NOTES : None ********************************************************/ globle void SetupObjectPatternStuff( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) struct patternParser *newPtr; if (ReservedPatternSymbol(theEnv,"object",NULL) == TRUE) { SystemError(theEnv,"OBJRTBLD",1); EnvExitRouter(theEnv,EXIT_FAILURE); } AddReservedPatternSymbol(theEnv,"object",NULL); /* =========================================================================== The object pattern parser needs to have a higher priority than deftemplates or regular facts so that the "object" keyword is always recognized first =========================================================================== */ newPtr = get_struct(theEnv,patternParser); newPtr->name = "objects"; newPtr->priority = 20; newPtr->entityType = &InstanceData(theEnv)->InstanceInfo; newPtr->recognizeFunction = PatternParserFind; newPtr->parseFunction = ObjectLHSParse; newPtr->postAnalysisFunction = ReorderAndAnalyzeObjectPattern; newPtr->addPatternFunction = PlaceObjectPattern; newPtr->removePatternFunction = DetachObjectPattern; newPtr->genJNConstantFunction = NULL; newPtr->replaceGetJNValueFunction = ReplaceGetJNObjectValue; newPtr->genGetJNValueFunction = GenGetJNObjectValue; newPtr->genCompareJNValuesFunction = ObjectJNVariableComparison; newPtr->genPNConstantFunction = GenObjectPNConstantCompare; newPtr->replaceGetPNValueFunction = ReplaceGetPNObjectValue; newPtr->genGetPNValueFunction = GenGetPNObjectValue; newPtr->genComparePNValuesFunction = ObjectPNVariableComparison; newPtr->returnUserDataFunction = DeleteClassBitMap; newPtr->copyUserDataFunction = CopyClassBitMap; newPtr->markIRPatternFunction = MarkObjectPtnIncrementalReset; newPtr->incrementalResetFunction = ObjectIncrementalReset; newPtr->initialPatternFunction = CreateInitialObjectPattern; #if CONSTRUCT_COMPILER && (! RUN_TIME) newPtr->codeReferenceFunction = ObjectPatternNodeReference; #else newPtr->codeReferenceFunction = NULL; #endif AddPatternParser(theEnv,newPtr); EnvDefineFunction2(theEnv,"object-pattern-match-delay",'u', PTIEF ObjectMatchDelay,"ObjectMatchDelay",NULL); AddFunctionParser(theEnv,"object-pattern-match-delay",ObjectMatchDelayParse); FuncSeqOvlFlags(theEnv,"object-pattern-match-delay",FALSE,FALSE); #endif InstallObjectPrimitives(theEnv); #if CONSTRUCT_COMPILER && (! RUN_TIME) ObjectPatternsCompilerSetup(theEnv); #endif #if ! DEFINSTANCES_CONSTRUCT EnvAddResetFunction(theEnv,"reset-initial-object",ResetInitialObject,0); #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupObjectPatternsBload(theEnv); #endif } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! DEFINSTANCES_CONSTRUCT static void ResetInitialObject( void *theEnv) { EXPRESSION *tmp; DATA_OBJECT rtn; tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); tmp->argList->nextArg = GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)); EvaluateExpression(theEnv,tmp,&rtn); ReturnExpression(theEnv,tmp); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /***************************************************** NAME : PatternParserFind DESCRIPTION : Determines if a pattern CE is an object pattern (i.e. the first field is the constant symbol "object") INPUTS : 1) The type of the first field 2) The value of the first field RETURNS : TRUE if it is an object pattern, FALSE otherwise SIDE EFFECTS : None NOTES : Used by AddPatternParser() *****************************************************/ static intBool PatternParserFind( SYMBOL_HN *value) { if (strcmp(ValueToString(value),OBJECT_PATTERN_INDICATOR) == 0) return(TRUE); return(FALSE); } /************************************************************************************ NAME : ObjectLHSParse DESCRIPTION : Scans and parses an object pattern for a rule INPUTS : 1) The logical name of the input source 2) A buffer holding the last token read RETURNS : The address of struct lhsParseNodes, NULL on errors SIDE EFFECTS : A series of struct lhsParseNodes are created to represent the intermediate parse of the pattern Pretty-print form for the pattern is saved NOTES : Object Pattern Syntax: (object [] [] *) ::= (is-a ) ::= (name ) ::= ( *) ************************************************************************************/ static struct lhsParseNode *ObjectLHSParse( void *theEnv, const char *readSource, struct token *lastToken) { #if MAC_XCD #pragma unused(lastToken) #endif struct token theToken; struct lhsParseNode *firstNode = NULL,*lastNode = NULL,*tmpNode; CLASS_BITMAP *clsset,*tmpset; CONSTRAINT_RECORD *slotConstraints; int ppbackupReqd = FALSE,multip; /* ======================================================== Get a bitmap big enough to mark the ids of all currently existing classes - and set all bits, since the initial set of applicable classes is everything. ======================================================== */ clsset = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,1); if (EmptyClassBitMap(clsset)) { PrintErrorID(theEnv,"OBJRTBLD",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern.\n"); DeleteIntermediateClassBitMap(theEnv,clsset); return(NULL); } tmpset = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,1); IncrementIndentDepth(theEnv,7); /* =========================================== Parse the class, name and slot restrictions =========================================== */ GetToken(theEnv,readSource,&theToken); while (theToken.type != RPAREN) { ppbackupReqd = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"object pattern"); goto ObjectLHSParseERROR; } GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"object pattern"); goto ObjectLHSParseERROR; } if (CheckDuplicateSlots(theEnv,firstNode,(SYMBOL_HN *) theToken.value)) goto ObjectLHSParseERROR; if (theToken.value == (void *) DefclassData(theEnv)->ISA_SYMBOL) { tmpNode = ParseClassRestriction(theEnv,readSource,&theToken); if (tmpNode == NULL) goto ObjectLHSParseERROR; InitializeClassBitMap(theEnv,tmpset,0); if (ProcessClassRestriction(theEnv,tmpset,&tmpNode->bottom,TRUE) == FALSE) { ReturnLHSParseNodes(theEnv,tmpNode); goto ObjectLHSParseERROR; } IntersectClassBitMaps(clsset,tmpset); } else if (theToken.value == (void *) DefclassData(theEnv)->NAME_SYMBOL) { tmpNode = ParseNameRestriction(theEnv,readSource,&theToken); if (tmpNode == NULL) goto ObjectLHSParseERROR; InitializeClassBitMap(theEnv,tmpset,1); } else { slotConstraints = ProcessSlotRestriction(theEnv,clsset,(SYMBOL_HN *) theToken.value,&multip); if (slotConstraints != NULL) { InitializeClassBitMap(theEnv,tmpset,1); tmpNode = ParseSlotRestriction(theEnv,readSource,&theToken,slotConstraints,multip); if (tmpNode == NULL) goto ObjectLHSParseERROR; } else { InitializeClassBitMap(theEnv,tmpset,0); tmpNode = GetLHSParseNode(theEnv); tmpNode->slot = (SYMBOL_HN *) theToken.value; } } if (EmptyClassBitMap(tmpset)) { PrintErrorID(theEnv,"OBJRTBLD",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy "); EnvPrintRouter(theEnv,WERROR,ValueToString(tmpNode->slot)); EnvPrintRouter(theEnv,WERROR," restriction in object pattern.\n"); ReturnLHSParseNodes(theEnv,tmpNode); goto ObjectLHSParseERROR; } if (EmptyClassBitMap(clsset)) { PrintErrorID(theEnv,"OBJRTBLD",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern.\n"); ReturnLHSParseNodes(theEnv,tmpNode); goto ObjectLHSParseERROR; } if (tmpNode != NULL) { if (firstNode == NULL) firstNode = tmpNode; else lastNode->right = tmpNode; lastNode = tmpNode; } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&theToken); } if (firstNode == NULL) { if (EmptyClassBitMap(clsset)) { PrintErrorID(theEnv,"OBJRTBLD",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern.\n"); goto ObjectLHSParseERROR; } firstNode = GetLHSParseNode(theEnv); firstNode->type = SF_WILDCARD; firstNode->slot = DefclassData(theEnv)->ISA_SYMBOL; firstNode->slotNumber = ISA_ID; firstNode->index = 1; } if (ppbackupReqd) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); } DeleteIntermediateClassBitMap(theEnv,tmpset); clsset = PackClassBitMap(theEnv,clsset); firstNode->userData = EnvAddBitMap(theEnv,(void *) clsset,ClassBitMapSize(clsset)); IncrementBitMapCount(firstNode->userData); DeleteIntermediateClassBitMap(theEnv,clsset); DecrementIndentDepth(theEnv,7); return(firstNode); ObjectLHSParseERROR: DeleteIntermediateClassBitMap(theEnv,clsset); DeleteIntermediateClassBitMap(theEnv,tmpset); ReturnLHSParseNodes(theEnv,firstNode); DecrementIndentDepth(theEnv,7); return(NULL); } /************************************************************** NAME : ReorderAndAnalyzeObjectPattern DESCRIPTION : This function reexamines the object pattern after constraint and variable analysis info has been propagated from other patterns. Any slots which are no longer applicable to the pattern are eliminated from the class set. Also, the slot names are ordered according to lexical value to aid in deteterming sharing between object patterns. (The is-a and name restrictions are always placed first regardless of symbolic hash value.) INPUTS : The pattern CE lhsParseNode RETURNS : FALSE if all OK, otherwise TRUE (e.g. all classes are eliminated as potential matching candidates for the pattern) SIDE EFFECTS : Slot restrictions are reordered (if necessary) NOTES : Adds a default is-a slot if one does not already exist **************************************************************/ static intBool ReorderAndAnalyzeObjectPattern( void *theEnv, struct lhsParseNode *topNode) { CLASS_BITMAP *clsset,*tmpset; EXPRESSION *rexp,*tmpmin,*tmpmax; DEFCLASS *cls; struct lhsParseNode *tmpNode,*subNode,*bitmap_node,*isa_node,*name_node; register unsigned short i; SLOT_DESC *sd; CONSTRAINT_RECORD *crossConstraints, *theConstraint; int incompatibleConstraint,clssetChanged = FALSE; /* ========================================================== Make sure that the bitmap marking which classes of object can match the pattern is attached to the class restriction (which will always be present and the last restriction after the sort) ========================================================== */ topNode->right = FilterObjectPattern(theEnv,topNode->patternType,topNode->right, &bitmap_node,&isa_node,&name_node); if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE); /* ============================================ Allocate a temporary set for marking classes ============================================ */ clsset = (CLASS_BITMAP *) ValueToBitMap(bitmap_node->userData); tmpset = NewClassBitMap(theEnv,(int) clsset->maxid,0); /* ========================================================== Check the allowed-values for the constraint on the is-a slot. If there are any, make sure that only the classes with those values as names are marked in the bitmap. There will only be symbols in the list because the original constraint on the is-a slot allowed only symbols. ========================================================== */ if ((isa_node == NULL) ? FALSE : ((isa_node->constraints == NULL) ? FALSE : (isa_node->constraints->restrictionList != NULL))) { rexp = isa_node->constraints->restrictionList; while (rexp != NULL) { cls = LookupDefclassInScope(theEnv,ValueToString(rexp->value)); if (cls != NULL) { if ((cls->id <= (unsigned) clsset->maxid) ? TestBitMap(clsset->map,cls->id) : FALSE) SetBitMap(tmpset->map,cls->id); } rexp = rexp->nextArg; } clssetChanged = IdenticalClassBitMap(tmpset,clsset) ? FALSE : TRUE; } else GenCopyMemory(char,tmpset->maxid / BITS_PER_BYTE + 1,tmpset->map,clsset->map); /* ================================================================ For each of the slots (excluding name and is-a), check the total constraints for the slot against the individual constraints for each occurrence of the slot in the classes marked in the bitmap. For any slot which is not compatible with the overall constraint, clear its class's bit in the bitmap. ================================================================ */ tmpNode = topNode->right; while (tmpNode != bitmap_node) { if ((tmpNode == isa_node) || (tmpNode == name_node)) { tmpNode = tmpNode->right; continue; } for (i = 0 ; i <= tmpset->maxid ; i++) if (TestBitMap(tmpset->map,i)) { cls = DefclassData(theEnv)->ClassIDMap[i]; sd = cls->instanceTemplate[FindInstanceTemplateSlot(theEnv,cls,tmpNode->slot)]; /* ========================================= Check the top-level lhsParseNode for type and cardinality compatibility ========================================= */ crossConstraints = IntersectConstraints(theEnv,tmpNode->constraints,sd->constraint); incompatibleConstraint = UnmatchableConstraint(crossConstraints); RemoveConstraint(theEnv,crossConstraints); if (incompatibleConstraint) { ClearBitMap(tmpset->map,i); clssetChanged = TRUE; } else if (tmpNode->type == MF_WILDCARD) { /* ========================================== Check the sub-nodes for type compatibility ========================================== */ for (subNode = tmpNode->bottom ; subNode != NULL ; subNode = subNode->right) { /* ======================================================== Temporarily reset cardinality of variables to match slot so that no cardinality errors will be flagged ======================================================== */ if ((subNode->type == MF_WILDCARD) || (subNode->type == MF_VARIABLE)) { theConstraint = subNode->constraints->multifield; } else { theConstraint = subNode->constraints; } tmpmin = theConstraint->minFields; theConstraint->minFields = sd->constraint->minFields; tmpmax = theConstraint->maxFields; theConstraint->maxFields = sd->constraint->maxFields; crossConstraints = IntersectConstraints(theEnv,theConstraint,sd->constraint); theConstraint->minFields = tmpmin; theConstraint->maxFields = tmpmax; incompatibleConstraint = UnmatchableConstraint(crossConstraints); RemoveConstraint(theEnv,crossConstraints); if (incompatibleConstraint) { ClearBitMap(tmpset->map,i); clssetChanged = TRUE; break; } } } } tmpNode = tmpNode->right; } if (clssetChanged) { /* ======================================================= Make sure that there are still classes of objects which can satisfy this pattern. Otherwise, signal an error. ======================================================= */ if (EmptyClassBitMap(tmpset)) { PrintErrorID(theEnv,"OBJRTBLD",3,TRUE); DeleteIntermediateClassBitMap(theEnv,tmpset); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern #"); PrintLongInteger(theEnv,WERROR,(long long) topNode->pattern); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } clsset = PackClassBitMap(theEnv,tmpset); DeleteClassBitMap(theEnv,(void *) bitmap_node->userData); bitmap_node->userData = EnvAddBitMap(theEnv,(void *) clsset,ClassBitMapSize(clsset)); IncrementBitMapCount(bitmap_node->userData); DeleteIntermediateClassBitMap(theEnv,clsset); } else DeleteIntermediateClassBitMap(theEnv,tmpset); return(FALSE); } /***************************************************** NAME : PlaceObjectPattern DESCRIPTION : Integrates an object pattern into the object pattern network INPUTS : The intermediate parse representation of the pattern RETURNS : The address of the new pattern SIDE EFFECTS : Object pattern network updated NOTES : None *****************************************************/ static struct patternNodeHeader *PlaceObjectPattern( void *theEnv, struct lhsParseNode *thePattern) { OBJECT_PATTERN_NODE *currentLevel,*lastLevel; struct lhsParseNode *tempPattern = NULL; OBJECT_PATTERN_NODE *nodeSlotGroup, *newNode; OBJECT_ALPHA_NODE *newAlphaNode; unsigned endSlot; BITMAP_HN *newClassBitMap,*newSlotBitMap; struct expr *rightHash; /*========================================================*/ /* Get the top of the object pattern network and prepare */ /* for the traversal to look for shareable pattern nodes. */ /*========================================================*/ currentLevel = ObjectNetworkPointer(theEnv); lastLevel = NULL; /*====================================================*/ /* Remove slot existence tests from the pattern since */ /* these are accounted for by the class bitmap and */ /* find the class and slot bitmaps. */ /*====================================================*/ rightHash = thePattern->rightHash; newSlotBitMap = FormSlotBitMap(theEnv,thePattern->right); thePattern->right = RemoveSlotExistenceTests(theEnv,thePattern->right,&newClassBitMap); thePattern = thePattern->right; /*=========================================================*/ /* Loop until all fields in the pattern have been added to */ /* the pattern network. Process the bitmap node ONLY if it */ /* is the only node in the pattern. */ /*=========================================================*/ do { if (thePattern->multifieldSlot) { tempPattern = thePattern; thePattern = thePattern->bottom; } /*============================================*/ /* Determine if the last pattern field within */ /* a multifield slot is being processed. */ /*============================================*/ if (((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) && (thePattern->right == NULL) && (tempPattern != NULL)) { endSlot = TRUE; } else { endSlot = FALSE; } /*========================================*/ /* Is there a node in the pattern network */ /* that can be reused (shared)? */ /*========================================*/ newNode = FindObjectPatternNode(currentLevel,thePattern,&nodeSlotGroup,endSlot,FALSE); /*================================================*/ /* If the pattern node cannot be shared, then add */ /* a new pattern node to the pattern network. */ /*================================================*/ if (newNode == NULL) { newNode = CreateNewObjectPatternNode(theEnv,thePattern,nodeSlotGroup,lastLevel,endSlot,FALSE); } if (thePattern->constantSelector != NULL) { currentLevel = newNode->nextLevel; lastLevel = newNode; newNode = FindObjectPatternNode(currentLevel,thePattern,&nodeSlotGroup,endSlot,TRUE); if (newNode == NULL) { newNode = CreateNewObjectPatternNode(theEnv,thePattern,nodeSlotGroup,lastLevel,endSlot,TRUE); } } /*=======================================================*/ /* Move on to the next field in the pattern to be added. */ /*=======================================================*/ if ((thePattern->right == NULL) && (tempPattern != NULL)) { thePattern = tempPattern; tempPattern = NULL; } lastLevel = newNode; currentLevel = newNode->nextLevel; thePattern = thePattern->right; } while ((thePattern != NULL) ? (thePattern->userData == NULL) : FALSE); /*==================================================*/ /* Return the leaf node of the newly added pattern. */ /*==================================================*/ newAlphaNode = lastLevel->alphaNode; while (newAlphaNode != NULL) { if ((newClassBitMap == newAlphaNode->classbmp) && (newSlotBitMap == newAlphaNode->slotbmp) && IdenticalExpression(newAlphaNode->header.rightHash,rightHash)) return((struct patternNodeHeader *) newAlphaNode); newAlphaNode = newAlphaNode->nxtInGroup; } newAlphaNode = get_struct(theEnv,objectAlphaNode); InitializePatternHeader(theEnv,&newAlphaNode->header); newAlphaNode->header.rightHash = AddHashedExpression(theEnv,rightHash); newAlphaNode->matchTimeTag = 0L; newAlphaNode->patternNode = lastLevel; newAlphaNode->classbmp = newClassBitMap; IncrementBitMapCount(newClassBitMap); MarkBitMapClassesBusy(theEnv,newClassBitMap,1); newAlphaNode->slotbmp = newSlotBitMap; if (newSlotBitMap != NULL) IncrementBitMapCount(newSlotBitMap); newAlphaNode->bsaveID = 0L; newAlphaNode->nxtInGroup = lastLevel->alphaNode; lastLevel->alphaNode = newAlphaNode; newAlphaNode->nxtTerminal = ObjectNetworkTerminalPointer(theEnv); SetObjectNetworkTerminalPointer(theEnv,newAlphaNode); return((struct patternNodeHeader *) newAlphaNode); } /************************************************************************ NAME : FindObjectPatternNode DESCRIPTION : Looks for a pattern node at a specified level in the pattern network that can be reused (shared) with a pattern field being added to the pattern network. INPUTS : 1) The current layer of nodes being examined in the object pattern network 2) The intermediate parse representation of the pattern being added 3) A buffer for holding the first node of a group of slots with the same name as the new node 4) An integer code indicating if this is the last fiedl in a slot pattern or not RETURNS : The old pattern network node matching the new node, or NULL if there is none (nodeSlotGroup will hold the place where to attach a new node) SIDE EFFECTS : nodeSlotGroup set NOTES : None ************************************************************************/ static OBJECT_PATTERN_NODE *FindObjectPatternNode( OBJECT_PATTERN_NODE *listOfNodes, struct lhsParseNode *thePattern, OBJECT_PATTERN_NODE **nodeSlotGroup, unsigned endSlot, unsigned constantSelector) { struct expr *compareTest; *nodeSlotGroup = NULL; if (constantSelector) { compareTest = thePattern->constantValue; } else if (thePattern->constantSelector != NULL) { compareTest = thePattern->constantSelector; } else { compareTest = thePattern->networkTest; } /*==========================================================*/ /* Loop through the nodes at the given level in the pattern */ /* network looking for a node that can be reused (shared). */ /*==========================================================*/ while (listOfNodes != NULL) { /*=========================================================*/ /* A object pattern node can be shared if the slot name is */ /* the same, the test is on the same field in the pattern, */ /* and the network test expressions are the same. */ /*=========================================================*/ if (((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) ? listOfNodes->multifieldNode : (listOfNodes->multifieldNode == 0)) { if ((thePattern->slotNumber == (int) listOfNodes->slotNameID) && (thePattern->index == (int) listOfNodes->whichField) && (thePattern->singleFieldsAfter == listOfNodes->leaveFields) && (endSlot == listOfNodes->endSlot) && IdenticalExpression(listOfNodes->networkTest,compareTest)) return(listOfNodes); } /*===============================================*/ /* Find the beginning of a group of nodes with */ /* the same slot name testing on the same field. */ /*===============================================*/ if ((*nodeSlotGroup == NULL) && (thePattern->index == (int) listOfNodes->whichField) && (thePattern->slotNumber == (int) listOfNodes->slotNameID)) *nodeSlotGroup = listOfNodes; listOfNodes = listOfNodes->rightNode; } /*==============================================*/ /* A shareable pattern node could not be found. */ /*==============================================*/ return(NULL); } /***************************************************************** NAME : CreateNewObjectPatternNode DESCRIPTION : Creates a new pattern node and initializes all of its values. INPUTS : 1) The intermediate parse representation of the new pattern node 2) A pointer to the network node after which to add the new node 3) A pointer to the parent node on the level above to link the new node 4) An integer code indicating if this is the last fiedl in a slot pattern or not RETURNS : A pointer to the new pattern node SIDE EFFECTS : Pattern node allocated, initialized and attached NOTES : None *****************************************************************/ static OBJECT_PATTERN_NODE *CreateNewObjectPatternNode( void *theEnv, struct lhsParseNode *thePattern, OBJECT_PATTERN_NODE *nodeSlotGroup, OBJECT_PATTERN_NODE *upperLevel, unsigned endSlot, unsigned constantSelector) { OBJECT_PATTERN_NODE *newNode,*prvNode,*curNode; newNode = get_struct(theEnv,objectPatternNode); newNode->blocked = FALSE; newNode->multifieldNode = FALSE; newNode->alphaNode = NULL; newNode->matchTimeTag = 0L; newNode->nextLevel = NULL; newNode->rightNode = NULL; newNode->leftNode = NULL; newNode->bsaveID = 0L; if ((thePattern->constantSelector != NULL) && (! constantSelector)) { newNode->selector = TRUE; } else { newNode->selector = FALSE; } /*===========================================================*/ /* Install the expression associated with this pattern node. */ /*===========================================================*/ if (constantSelector) { newNode->networkTest = AddHashedExpression(theEnv,thePattern->constantValue); } else if (thePattern->constantSelector != NULL) { newNode->networkTest = AddHashedExpression(theEnv,thePattern->constantSelector); } else { newNode->networkTest = AddHashedExpression(theEnv,thePattern->networkTest); } newNode->whichField = thePattern->index; newNode->leaveFields = thePattern->singleFieldsAfter; /*=========================================*/ /* Install the slot name for the new node. */ /*=========================================*/ newNode->slotNameID = (unsigned) thePattern->slotNumber; if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) newNode->multifieldNode = TRUE; newNode->endSlot = endSlot; /*===============================================*/ /* Set the upper level pointer for the new node. */ /*===============================================*/ newNode->lastLevel = upperLevel; if ((upperLevel != NULL) && (upperLevel->selector)) { AddHashedPatternNode(theEnv,upperLevel,newNode,newNode->networkTest->type,newNode->networkTest->value); } /*==============================================*/ /* If there are no nodes with this slot name on */ /* this level, simply prepend it to the front. */ /*==============================================*/ if (nodeSlotGroup == NULL) { if (upperLevel == NULL) { newNode->rightNode = ObjectNetworkPointer(theEnv); SetObjectNetworkPointer(theEnv,newNode); } else { newNode->rightNode = upperLevel->nextLevel; upperLevel->nextLevel = newNode; } if (newNode->rightNode != NULL) newNode->rightNode->leftNode = newNode; return(newNode); } /* =========================================================== Group this node with other nodes of the same name testing on the same field in the pattern on this level. This allows us to do some optimization with constant tests on a particular slots. If we put all constant tests for a particular slot/field group at the end of that group, then when one of those test succeeds during pattern-matching, we don't have to test any more of the nodes with that slot/field name to the right. =========================================================== */ prvNode = NULL; curNode = nodeSlotGroup; while ((curNode == NULL) ? FALSE : (curNode->slotNameID == nodeSlotGroup->slotNameID) && (curNode->whichField == nodeSlotGroup->whichField)) { if ((curNode->networkTest == NULL) ? FALSE : ((curNode->networkTest->type != OBJ_PN_CONSTANT) ? FALSE : ((struct ObjectCmpPNConstant *) ValueToBitMap(curNode->networkTest->value))->pass)) break; prvNode = curNode; curNode = curNode->rightNode; } if (curNode != NULL) { newNode->leftNode = curNode->leftNode; newNode->rightNode = curNode; if (curNode->leftNode != NULL) curNode->leftNode->rightNode = newNode; else if (curNode->lastLevel != NULL) curNode->lastLevel->nextLevel = newNode; else SetObjectNetworkPointer(theEnv,newNode); curNode->leftNode = newNode; } else { newNode->leftNode = prvNode; prvNode->rightNode = newNode; } return(newNode); } /******************************************************** NAME : DetachObjectPattern DESCRIPTION : Removes a pattern node and all of its parent nodes from the pattern network. Nodes are only removed if they are no longer shared (i.e. a pattern node that has more than one child node is shared). A pattern from a rule is typically removed by removing the bottom most pattern node used by the pattern and then removing any parent nodes which are not shared by other patterns. Example: Patterns (a b c d) and (a b e f) would be represented by the pattern net shown on the left. If (a b c d) was detached, the resultant pattern net would be the one shown on the right. The '=' represents an end-of-pattern node. a a | | b b | | c--e e | | | d f f | | | = = = INPUTS : The pattern to be removed RETURNS : Nothing useful SIDE EFFECTS : All non-shared nodes associated with the pattern are removed NOTES : None ********************************************************/ static void DetachObjectPattern( void *theEnv, struct patternNodeHeader *thePattern) { OBJECT_ALPHA_NODE *alphaPtr,*prv,*terminalPtr; OBJECT_PATTERN_NODE *patternPtr,*upperLevel; /*====================================================*/ /* Get rid of any matches stored in the alpha memory. */ /*====================================================*/ alphaPtr = (OBJECT_ALPHA_NODE *) thePattern; ClearObjectPatternMatches(theEnv,alphaPtr); /*========================================================*/ /* Unmark the classes to which the pattern is applicable */ /* and unmark the class and slot id maps so that they can */ /* become ephemeral. */ /*========================================================*/ MarkBitMapClassesBusy(theEnv,alphaPtr->classbmp,-1); DeleteClassBitMap(theEnv,alphaPtr->classbmp); if (alphaPtr->slotbmp != NULL) { DecrementBitMapCount(theEnv,alphaPtr->slotbmp); } /*=========================================*/ /* Only continue deleting this pattern if */ /* this is the last alpha memory attached. */ /*=========================================*/ prv = NULL; terminalPtr = ObjectNetworkTerminalPointer(theEnv); while (terminalPtr != alphaPtr) { prv = terminalPtr; terminalPtr = terminalPtr->nxtTerminal; } if (prv == NULL) { SetObjectNetworkTerminalPointer(theEnv,terminalPtr->nxtTerminal); } else { prv->nxtTerminal = terminalPtr->nxtTerminal; } prv = NULL; terminalPtr = alphaPtr->patternNode->alphaNode; while (terminalPtr != alphaPtr) { prv = terminalPtr; terminalPtr = terminalPtr->nxtInGroup; } if (prv == NULL) { if (alphaPtr->nxtInGroup != NULL) { alphaPtr->patternNode->alphaNode = alphaPtr->nxtInGroup; RemoveHashedExpression(theEnv,alphaPtr->header.rightHash); rtn_struct(theEnv,objectAlphaNode,alphaPtr); return; } } else { prv->nxtInGroup = alphaPtr->nxtInGroup; RemoveHashedExpression(theEnv,alphaPtr->header.rightHash); rtn_struct(theEnv,objectAlphaNode,alphaPtr); return; } alphaPtr->patternNode->alphaNode = NULL; RemoveHashedExpression(theEnv,alphaPtr->header.rightHash); upperLevel = alphaPtr->patternNode; rtn_struct(theEnv,objectAlphaNode,alphaPtr); if (upperLevel->nextLevel != NULL) return; /*==============================================================*/ /* Loop until all appropriate pattern nodes have been detached. */ /*==============================================================*/ while (upperLevel != NULL) { if ((upperLevel->leftNode == NULL) && (upperLevel->rightNode == NULL)) { /*===============================================*/ /* Pattern node is the only node on this level. */ /* Remove it and continue detaching other nodes */ /* above this one, because no other patterns are */ /* dependent upon this node. */ /*===============================================*/ patternPtr = upperLevel; upperLevel = patternPtr->lastLevel; if (upperLevel == NULL) SetObjectNetworkPointer(theEnv,NULL); else { if (upperLevel->selector) { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); } upperLevel->nextLevel = NULL; if (upperLevel->alphaNode != NULL) upperLevel = NULL; } RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest); rtn_struct(theEnv,objectPatternNode,patternPtr); } else if (upperLevel->leftNode != NULL) { /*====================================================*/ /* Pattern node has another pattern node which must */ /* be checked preceding it. Remove the pattern node, */ /* but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; if ((patternPtr->lastLevel != NULL) && (patternPtr->lastLevel->selector)) { RemoveHashedPatternNode(theEnv,patternPtr->lastLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); } upperLevel->leftNode->rightNode = upperLevel->rightNode; if (upperLevel->rightNode != NULL) { upperLevel->rightNode->leftNode = upperLevel->leftNode; } RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest); rtn_struct(theEnv,objectPatternNode,patternPtr); upperLevel = NULL; } else { /*====================================================*/ /* Pattern node has no pattern node preceding it, but */ /* does have one succeeding it. Remove the pattern */ /* node, but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; upperLevel = upperLevel->lastLevel; if (upperLevel == NULL) { SetObjectNetworkPointer(theEnv,patternPtr->rightNode); } else { if (upperLevel->selector) { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); } upperLevel->nextLevel = patternPtr->rightNode; } patternPtr->rightNode->leftNode = NULL; RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest); rtn_struct(theEnv,objectPatternNode,patternPtr); upperLevel = NULL; } } } /*************************************************** NAME : ClearObjectPatternMatches DESCRIPTION : Removes a pattern node alpha memory from the list of partial matches on all instances (active or garbage collected) INPUTS : The pattern node to remove RETURNS : Nothing useful SIDE EFFECTS : Pattern alpha memory removed from all object partial match lists NOTES : Used when a pattern is removed ***************************************************/ static void ClearObjectPatternMatches( void *theEnv, OBJECT_ALPHA_NODE *alphaPtr) { INSTANCE_TYPE *ins; IGARBAGE *igrb; /* ============================================= Loop through every active and queued instance ============================================= */ ins = InstanceData(theEnv)->InstanceList; while (ins != NULL) { RemoveObjectPartialMatches(theEnv,(INSTANCE_TYPE *) ins,(struct patternNodeHeader *) alphaPtr); ins = ins->nxtList; } /* ============================ Check for garbaged instances ============================ */ igrb = InstanceData(theEnv)->InstanceGarbageList; while (igrb != NULL) { RemoveObjectPartialMatches(theEnv,(INSTANCE_TYPE *) igrb->ins,(struct patternNodeHeader *) alphaPtr); igrb = igrb->nxt; } } /*************************************************** NAME : RemoveObjectPartialMatches DESCRIPTION : Removes a partial match from a list of partial matches for an instance INPUTS : 1) The instance 2) The pattern node header corresponding to the match RETURNS : Nothing useful SIDE EFFECTS : Match removed NOTES : None ***************************************************/ static void RemoveObjectPartialMatches( void *theEnv, INSTANCE_TYPE *ins, struct patternNodeHeader *phead) { struct patternMatch *match_before, *match_ptr; match_before = NULL; match_ptr = (struct patternMatch *) ins->partialMatchList; /* ======================================= Loop through every match for the object ======================================= */ while (match_ptr != NULL) { if (match_ptr->matchingPattern == phead) { ins->busy--; if (match_before == NULL) { ins->partialMatchList = (void *) match_ptr->next; rtn_struct(theEnv,patternMatch,match_ptr); match_ptr = (struct patternMatch *) ins->partialMatchList; } else { match_before->next = match_ptr->next; rtn_struct(theEnv,patternMatch,match_ptr); match_ptr = match_before->next; } } else { match_before = match_ptr; match_ptr = match_ptr->next; } } } /****************************************************** NAME : CheckDuplicateSlots DESCRIPTION : Determines if a restriction has already been defined in a pattern INPUTS : The list of already built restrictions RETURNS : TRUE if a definition already exists, FALSE otherwise SIDE EFFECTS : An error message is printed if a duplicate is found NOTES : None ******************************************************/ static intBool CheckDuplicateSlots( void *theEnv, struct lhsParseNode *nodeList, SYMBOL_HN *slotName) { while (nodeList != NULL) { if (nodeList->slot == slotName) { PrintErrorID(theEnv,"OBJRTBLD",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Multiple restrictions on attribute "); EnvPrintRouter(theEnv,WERROR,ValueToString(slotName)); EnvPrintRouter(theEnv,WERROR," not allowed.\n"); return(TRUE); } nodeList = nodeList->right; } return(FALSE); } /********************************************************** NAME : ParseClassRestriction DESCRIPTION : Parses the single-field constraint on the class an object pattern INPUTS : 1) The logical input source 2) A buffer for tokens RETURNS : The intermediate pattern nodes representing the class constraint (NULL on errors) SIDE EFFECTS : Intermediate pattern nodes allocated NOTES : None **********************************************************/ static struct lhsParseNode *ParseClassRestriction( void *theEnv, const char *readSource, struct token *theToken) { struct lhsParseNode *tmpNode; SYMBOL_HN *rln; CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = 0; rv->symbolsAllowed = 1; rln = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); tmpNode = RestrictionParse(theEnv,readSource,theToken,FALSE,rln,ISA_ID,rv,0); if (tmpNode == NULL) { RemoveConstraint(theEnv,rv); return(NULL); } if ((theToken->type != RPAREN) || (tmpNode->type == MF_WILDCARD) || (tmpNode->type == MF_VARIABLE)) { PPBackup(theEnv); if (theToken->type != RPAREN) { SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); } SyntaxErrorMessage(theEnv,"class restriction in object pattern"); ReturnLHSParseNodes(theEnv,tmpNode); RemoveConstraint(theEnv,rv); return(NULL); } tmpNode->derivedConstraints = 1; return(tmpNode); } /********************************************************** NAME : ParseNameRestriction DESCRIPTION : Parses the single-field constraint on the name of an object pattern INPUTS : 1) The logical input source 2) A buffer for tokens RETURNS : The intermediate pattern nodes representing the name constraint (NULL on errors) SIDE EFFECTS : Intermediate pattern nodes allocated NOTES : None **********************************************************/ static struct lhsParseNode *ParseNameRestriction( void *theEnv, const char *readSource, struct token *theToken) { struct lhsParseNode *tmpNode; SYMBOL_HN *rln; CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = 0; rv->instanceNamesAllowed = 1; rln = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); tmpNode = RestrictionParse(theEnv,readSource,theToken,FALSE,rln,NAME_ID,rv,0); if (tmpNode == NULL) { RemoveConstraint(theEnv,rv); return(NULL); } if ((theToken->type != RPAREN) || (tmpNode->type == MF_WILDCARD) || (tmpNode->type == MF_VARIABLE)) { PPBackup(theEnv); if (theToken->type != RPAREN) { SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); } SyntaxErrorMessage(theEnv,"name restriction in object pattern"); ReturnLHSParseNodes(theEnv,tmpNode); RemoveConstraint(theEnv,rv); return(NULL); } tmpNode->derivedConstraints = 1; return(tmpNode); } /*************************************************** NAME : ParseSlotRestriction DESCRIPTION : Parses the field constraint(s) on a slot of an object pattern INPUTS : 1) The logical input source 2) A buffer for tokens 3) Constraint record holding the unioned constraints of all the slots which could match the slot pattern 4) A flag indicating if any multifield slots match the name RETURNS : The intermediate pattern nodes representing the slot constraint(s) (NULL on errors) SIDE EFFECTS : Intermediate pattern nodes allocated NOTES : None ***************************************************/ static struct lhsParseNode *ParseSlotRestriction( void *theEnv, const char *readSource, struct token *theToken, CONSTRAINT_RECORD *slotConstraints, int multip) { struct lhsParseNode *tmpNode; SYMBOL_HN *slotName; slotName = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); tmpNode = RestrictionParse(theEnv,readSource,theToken,multip,slotName,FindSlotNameID(theEnv,slotName), slotConstraints,1); if (tmpNode == NULL) { RemoveConstraint(theEnv,slotConstraints); return(NULL); } if (theToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); SyntaxErrorMessage(theEnv,"object slot pattern"); ReturnLHSParseNodes(theEnv,tmpNode); RemoveConstraint(theEnv,slotConstraints); return(NULL); } if ((tmpNode->bottom == NULL) && (tmpNode->multifieldSlot)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } tmpNode->derivedConstraints = 1; return(tmpNode); } /******************************************************** NAME : NewClassBitMap DESCRIPTION : Creates a new bitmap large enough to hold all ids of classes in the system and initializes all the bits to zero or one. INPUTS : 1) The maximum id that will be set in the bitmap 2) An integer code indicating if all the bits are to be set to zero or one RETURNS : The new bitmap SIDE EFFECTS : BitMap allocated and initialized NOTES : None ********************************************************/ static CLASS_BITMAP *NewClassBitMap( void *theEnv, int maxid, int set) { register CLASS_BITMAP *bmp; unsigned size; if (maxid == -1) maxid = 0; size = sizeof(CLASS_BITMAP) + (sizeof(char) * (maxid / BITS_PER_BYTE)); bmp = (CLASS_BITMAP *) gm2(theEnv,size); ClearBitString((void *) bmp,size); bmp->maxid = (unsigned short) maxid; InitializeClassBitMap(theEnv,bmp,set); return(bmp); } /*********************************************************** NAME : InitializeClassBitMap DESCRIPTION : Initializes a bitmap to all zeroes or ones. INPUTS : 1) The bitmap 2) An integer code indicating if all the bits are to be set to zero or one RETURNS : Nothing useful SIDE EFFECTS : The bitmap is initialized NOTES : None ***********************************************************/ static void InitializeClassBitMap( void *theEnv, CLASS_BITMAP *bmp, int set) { register int i,bytes; DEFCLASS *cls; struct defmodule *currentModule; bytes = bmp->maxid / BITS_PER_BYTE + 1; while (bytes > 0) { bmp->map[bytes - 1] = (char) 0; bytes--; } if (set) { currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); for (i = 0 ; i <= (int) bmp->maxid ; i++) { cls = DefclassData(theEnv)->ClassIDMap[i]; if ((cls != NULL) ? DefclassInScope(theEnv,cls,currentModule) : FALSE) { if (cls->reactive && (cls->abstract == 0)) SetBitMap(bmp->map,i); } } } } /******************************************** NAME : DeleteIntermediateClassBitMap DESCRIPTION : Deallocates a bitmap INPUTS : The class set RETURNS : Nothing useful SIDE EFFECTS : Class set deallocated NOTES : None ********************************************/ static void DeleteIntermediateClassBitMap( void *theEnv, CLASS_BITMAP *bmp) { rm(theEnv,(void *) bmp,ClassBitMapSize(bmp)); } /****************************************************** NAME : CopyClassBitMap DESCRIPTION : Increments the in use count of a bitmap and returns the same pointer INPUTS : The bitmap RETURNS : The bitmap SIDE EFFECTS : Increments the in use count NOTES : Class sets are shared by multiple copies of an object pattern within an OR CE. The use count prevents having to make duplicate copies of the bitmap ******************************************************/ static void *CopyClassBitMap( void *theEnv, void *gset) { #if MAC_XCD #pragma unused(theEnv) #endif if (gset != NULL) IncrementBitMapCount(gset); return(gset); } /********************************************************** NAME : DeleteClassBitMap DESCRIPTION : Deallocates a bitmap, and decrements the busy flags of the classes marked in the bitmap INPUTS : The bitmap RETURNS : Nothing useful SIDE EFFECTS : Class set deallocated and classes unmarked NOTES : None **********************************************************/ static void DeleteClassBitMap( void *theEnv, void *gset) { if (gset == NULL) return; DecrementBitMapCount(theEnv,(BITMAP_HN *) gset); } /*************************************************** NAME : MarkBitMapClassesBusy DESCRIPTION : Increments/Decrements busy counts of all classes marked in a bitmap INPUTS : 1) The bitmap hash node 2) 1 or -1 (to increment or decrement class busy counts) RETURNS : Nothing useful SIDE EFFECTS : Bitmap class busy counts updated NOTES : None ***************************************************/ static void MarkBitMapClassesBusy( void *theEnv, BITMAP_HN *bmphn, int offset) { register CLASS_BITMAP *bmp; register unsigned short i; register DEFCLASS *cls; /* ==================================== If a clear is in progress, we do not have to worry about busy counts ==================================== */ if (ConstructData(theEnv)->ClearInProgress) return; bmp = (CLASS_BITMAP *) ValueToBitMap(bmphn); for (i = 0 ; i <= bmp->maxid ; i++) if (TestBitMap(bmp->map,i)) { cls = DefclassData(theEnv)->ClassIDMap[i]; cls->busy += (unsigned int) offset; } } /**************************************************** NAME : EmptyClassBitMap DESCRIPTION : Determines if one or more bits are marked in a bitmap INPUTS : The bitmap RETURNS : TRUE if the set has no bits marked, FALSE otherwise SIDE EFFECTS : None NOTES : None ****************************************************/ static intBool EmptyClassBitMap( CLASS_BITMAP *bmp) { register unsigned short bytes; bytes = (unsigned short) (bmp->maxid / BITS_PER_BYTE + 1); while (bytes > 0) { if (bmp->map[bytes - 1] != (char) 0) return(FALSE); bytes--; } return(TRUE); } /*************************************************** NAME : IdenticalClassBitMap DESCRIPTION : Determines if two bitmaps are identical INPUTS : 1) First bitmap 2) Second bitmap RETURNS : TRUE if bitmaps are the same, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ static intBool IdenticalClassBitMap( CLASS_BITMAP *cs1, CLASS_BITMAP *cs2) { register int i; if (cs1->maxid != cs2->maxid) return(FALSE); for (i = 0 ; i < (int) (cs1->maxid / BITS_PER_BYTE + 1) ; i++) if (cs1->map[i] != cs2->map[i]) return(FALSE); return(TRUE); } /***************************************************************** NAME : ProcessClassRestriction DESCRIPTION : Examines a class restriction and forms a bitmap corresponding to the maximal set of classes which can satisfy a static analysis of the restriction INPUTS : 1) The bitmap to mark classes in 2) The lhsParseNodes of the restriction 3) A flag indicating if this is the first non-recursive call or not RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Class bitmap set and lhsParseNodes corressponding to constant restrictions are removed NOTES : None *****************************************************************/ static intBool ProcessClassRestriction( void *theEnv, CLASS_BITMAP *clsset, struct lhsParseNode **classRestrictions, int recursiveCall) { register struct lhsParseNode *chk,**oraddr; CLASS_BITMAP *tmpset1,*tmpset2; int constant_restriction = TRUE; if (*classRestrictions == NULL) { if (recursiveCall) InitializeClassBitMap(theEnv,clsset,1); return(TRUE); } /* =============================================== Determine the corresponding class set and union it with the current total class set. If an AND restriction is comprised entirely of symbols, it can be removed =============================================== */ tmpset1 = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,1); tmpset2 = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,0); for (chk = *classRestrictions ; chk != NULL ; chk = chk->right) { if (chk->type == SYMBOL) { //chk->value = (void *) LookupDefclassInScope(theEnv,ValueToString(chk->value)); chk->value = (void *) LookupDefclassByMdlOrScope(theEnv,ValueToString(chk->value)); if (chk->value == NULL) { PrintErrorID(theEnv,"OBJRTBLD",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Undefined class in object pattern.\n"); DeleteIntermediateClassBitMap(theEnv,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset2); return(FALSE); } if (chk->negated) { InitializeClassBitMap(theEnv,tmpset2,1); MarkBitMapSubclasses(tmpset2->map,(DEFCLASS *) chk->value,0); } else { InitializeClassBitMap(theEnv,tmpset2,0); MarkBitMapSubclasses(tmpset2->map,(DEFCLASS *) chk->value,1); } IntersectClassBitMaps(tmpset1,tmpset2); } else constant_restriction = FALSE; } if (EmptyClassBitMap(tmpset1)) { PrintErrorID(theEnv,"OBJRTBLD",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy "); EnvPrintRouter(theEnv,WERROR,"is-a restriction in object pattern.\n"); DeleteIntermediateClassBitMap(theEnv,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset2); return(FALSE); } if (constant_restriction) { chk = *classRestrictions; *classRestrictions = chk->bottom; chk->bottom = NULL; ReturnLHSParseNodes(theEnv,chk); oraddr = classRestrictions; } else oraddr = &(*classRestrictions)->bottom; UnionClassBitMaps(clsset,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset2); /* ===================================== Process the next OR class restriction ===================================== */ return(ProcessClassRestriction(theEnv,clsset,oraddr,FALSE)); } /**************************************************************** NAME : ProcessSlotRestriction DESCRIPTION : Determines which slots could match the slot pattern and determines the union of all constraints for the pattern INPUTS : 1) The class set 2) The slot name 3) A buffer to hold a flag indicating if any multifield slots are found w/ this name RETURNS : A union of the constraints on all the slots which could match the slots (NULL if no slots found) SIDE EFFECTS : The class bitmap set is marked/cleared NOTES : None ****************************************************************/ static CONSTRAINT_RECORD *ProcessSlotRestriction( void *theEnv, CLASS_BITMAP *clsset, SYMBOL_HN *slotName, int *multip) { register DEFCLASS *cls; register int si; CONSTRAINT_RECORD *totalConstraints = NULL,*tmpConstraints; register unsigned i; *multip = FALSE; for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) for (cls = DefclassData(theEnv)->ClassTable[i] ; cls != NULL ; cls = cls->nxtHash) { if (TestBitMap(clsset->map,cls->id)) { si = FindInstanceTemplateSlot(theEnv,cls,slotName); if ((si != -1) ? cls->instanceTemplate[si]->reactive : FALSE) { if (cls->instanceTemplate[si]->multiple) *multip = TRUE; tmpConstraints = UnionConstraints(theEnv,cls->instanceTemplate[si]->constraint,totalConstraints); RemoveConstraint(theEnv,totalConstraints); totalConstraints = tmpConstraints; } else ClearBitMap(clsset->map,cls->id); } } return(totalConstraints); } /**************************************************** NAME : IntersectClassBitMaps DESCRIPTION : Bitwise-ands two bitmaps and stores the result in the first INPUTS : The two bitmaps RETURNS : Nothing useful SIDE EFFECTS : ClassBitMaps anded NOTES : Assumes the first bitmap is at least as large as the second ****************************************************/ static void IntersectClassBitMaps( CLASS_BITMAP *cs1, CLASS_BITMAP *cs2) { register unsigned short bytes; bytes = (unsigned short) (cs2->maxid / BITS_PER_BYTE + 1); while (bytes > 0) { cs1->map[bytes - 1] &= cs2->map[bytes - 1]; bytes--; } } /**************************************************** NAME : UnionClassBitMaps DESCRIPTION : Bitwise-ors two bitmaps and stores the result in the first INPUTS : The two bitmaps RETURNS : Nothing useful SIDE EFFECTS : ClassBitMaps ored NOTES : Assumes the first bitmap is at least as large as the second ****************************************************/ static void UnionClassBitMaps( CLASS_BITMAP *cs1, CLASS_BITMAP *cs2) { register unsigned short bytes; bytes = (unsigned short) (cs2->maxid / BITS_PER_BYTE + 1); while (bytes > 0) { cs1->map[bytes - 1] |= cs2->map[bytes - 1]; bytes--; } } /***************************************************** NAME : PackClassBitMap DESCRIPTION : This routine packs a bitmap bitmap such that at least one of the bits in the rightmost byte is set (i.e. the bitmap takes up the smallest space possible). INPUTS : The bitmap RETURNS : The new (packed) bitmap SIDE EFFECTS : The oldset is deallocated NOTES : None *****************************************************/ static CLASS_BITMAP *PackClassBitMap( void *theEnv, CLASS_BITMAP *oldset) { register unsigned short newmaxid; CLASS_BITMAP *newset; for (newmaxid = oldset->maxid ; newmaxid > 0 ; newmaxid--) if (TestBitMap(oldset->map,newmaxid)) break; if (newmaxid != oldset->maxid) { newset = NewClassBitMap(theEnv,(int) newmaxid,0); GenCopyMemory(char,newmaxid / BITS_PER_BYTE + 1,newset->map,oldset->map); DeleteIntermediateClassBitMap(theEnv,oldset); } else newset = oldset; return(newset); } /***************************************************************** NAME : FilterObjectPattern DESCRIPTION : Appends an extra node to hold the bitmap, and finds is-a and name nodes INPUTS : 1) The object pattern parser address to give to a default is-a slot 2) The unfiltered slot list 3) A buffer to hold the address of the class bitmap restriction node 4) A buffer to hold the address of the is-a restriction node 4) A buffer to hold the address of the name restriction node RETURNS : The filtered slot list SIDE EFFECTS : clsset is attached to extra slot pattern Pointers to the is-a and name slots are also stored (if they exist) for easy reference NOTES : None *****************************************************************/ static struct lhsParseNode *FilterObjectPattern( void *theEnv, struct patternParser *selfPatternType, struct lhsParseNode *unfilteredSlots, struct lhsParseNode **bitmap_slot, struct lhsParseNode **isa_slot, struct lhsParseNode **name_slot) { struct lhsParseNode *prv,*cur; *isa_slot = NULL; *name_slot = NULL; /* ============================================ Create a dummy node to attach to the end of the pattern which holds the class bitmap. ============================================ */ *bitmap_slot = GetLHSParseNode(theEnv); (*bitmap_slot)->type = SF_WILDCARD; (*bitmap_slot)->slot = DefclassData(theEnv)->ISA_SYMBOL; (*bitmap_slot)->slotNumber = ISA_ID; (*bitmap_slot)->index = 1; (*bitmap_slot)->patternType = selfPatternType; (*bitmap_slot)->userData = unfilteredSlots->userData; unfilteredSlots->userData = NULL; /* ======================== Find is-a and name nodes ======================== */ prv = NULL; cur = unfilteredSlots; while (cur != NULL) { if (cur->slot == DefclassData(theEnv)->ISA_SYMBOL) *isa_slot = cur; else if (cur->slot == DefclassData(theEnv)->NAME_SYMBOL) *name_slot = cur; prv = cur; cur = cur->right; } /* ================================ Add the class bitmap conditional element to end of pattern ================================ */ if (prv == NULL) unfilteredSlots = *bitmap_slot; else prv->right = *bitmap_slot; return(unfilteredSlots); } /*************************************************** NAME : FormSlotBitMap DESCRIPTION : Examines an object pattern and forms a minimal bitmap marking the ids of the slots used in the pattern INPUTS : The intermediate parsed pattern RETURNS : The new slot bitmap (can be NULL) SIDE EFFECTS : Bitmap created and added to hash table - corresponding bits set for ids of slots used in pattern NOTES : None ***************************************************/ static BITMAP_HN *FormSlotBitMap( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *node; int maxSlotID = -1; unsigned size; SLOT_BITMAP *bmp; BITMAP_HN *hshBmp; /* ======================================= Find the largest slot id in the pattern ======================================= */ for (node = thePattern ; node != NULL ; node = node->right) if (node->slotNumber > maxSlotID) maxSlotID = node->slotNumber; /* =================================================== If the pattern contains no slot tests or only tests on the class or name (which do not change) do not store a slot bitmap =================================================== */ if ((maxSlotID == ISA_ID) || (maxSlotID == NAME_ID)) return(NULL); /* =================================== Initialize the bitmap to all zeroes =================================== */ size = (sizeof(SLOT_BITMAP) + (sizeof(char) * (maxSlotID / BITS_PER_BYTE))); bmp = (SLOT_BITMAP *) gm2(theEnv,size); ClearBitString((void *) bmp,size); bmp->maxid = (unsigned short) maxSlotID; /* ============================================ Add (retrieve) a bitmap to (from) the bitmap hash table which has a corresponding bit set for the id of every slot used in the pattern ============================================ */ for (node = thePattern ; node != NULL ; node = node->right) SetBitMap(bmp->map,node->slotNumber); hshBmp = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) bmp,SlotBitMapSize(bmp)); rm(theEnv,(void *) bmp,size); return(hshBmp); } /**************************************************** NAME : RemoveSlotExistenceTests DESCRIPTION : Removes slot existence test since these are accounted for by class bitmap or name slot. INPUTS : 1) The intermediate pattern nodes 2) A buffer to hold the class bitmap RETURNS : The filtered list SIDE EFFECTS : Slot existence tests removed NOTES : None ****************************************************/ static struct lhsParseNode *RemoveSlotExistenceTests( void *theEnv, struct lhsParseNode *thePattern, BITMAP_HN **bmp) { struct lhsParseNode *tempPattern = thePattern; struct lhsParseNode *lastPattern = NULL, *head = thePattern; while (tempPattern != NULL) { /* ========================================== Remember the class bitmap for this pattern ========================================== */ if (tempPattern->userData != NULL) { *bmp = (BITMAP_HN *) tempPattern->userData; lastPattern = tempPattern; tempPattern = tempPattern->right; } /* =========================================================== A single field slot that has no pattern network expression associated with it can be removed (i.e. any value contained in this slot will satisfy the pattern being matched). =========================================================== */ else if (((tempPattern->type == SF_WILDCARD) || (tempPattern->type == SF_VARIABLE)) && (tempPattern->networkTest == NULL)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /* ===================================================== A multifield variable or wildcard within a multifield slot can be removed if there are no other multifield variables or wildcards contained in the same slot (and the multifield has no expressions which must be evaluated in the fact pattern network). ===================================================== */ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest == NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /* ================================================================ A multifield wildcard or variable contained in a multifield slot that contains no other multifield wildcards or variables, but does have an expression that must be evaluated, can be changed to a single field pattern node with the same expression. ================================================================ */ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest != NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { tempPattern->type = SF_WILDCARD; lastPattern = tempPattern; tempPattern = tempPattern->right; } /* ======================================================= If we're dealing with a multifield slot with no slot restrictions, then treat the multfield slot as a single field slot, but attach a test which verifies that the slot contains a zero length multifield value. ======================================================= */ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE) && (tempPattern->bottom == NULL)) { tempPattern->type = SF_WILDCARD; GenObjectZeroLengthTest(theEnv,tempPattern); tempPattern->multifieldSlot = FALSE; lastPattern = tempPattern; tempPattern = tempPattern->right; } /* ====================================================== Recursively call RemoveSlotExistenceTests for the slot restrictions contained within a multifield slot. ====================================================== */ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE)) { /* ===================================================== Add an expression to the first pattern restriction in the multifield slot that determines whether or not the fact's slot value contains the minimum number of required fields to satisfy the pattern restrictions for this slot. The length check is place before any other tests, so that preceeding checks do not have to determine if there are enough fields in the slot to safely retrieve a value. ===================================================== */ GenObjectLengthTest(theEnv,tempPattern->bottom); /* ======================================================= Remove any unneeded pattern restrictions from the slot. ======================================================= */ tempPattern->bottom = RemoveSlotExistenceTests(theEnv,tempPattern->bottom,bmp); /* ========================================================= If the slot no longer contains any restrictions, then the multifield slot can be completely removed. In any case, move on to the next slot to be examined for removal. ========================================================= */ if (tempPattern->bottom == NULL) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /* ===================================================== If none of the other tests for removing slots or slot restrictions apply, then move on to the next slot or slot restriction to be tested. ===================================================== */ else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /* ==================================== Return the pattern with unused slots and slot restrictions removed. ==================================== */ return(head); } /*************************************************** NAME : CreateInitialObjectPattern DESCRIPTION : Creates a default object pattern for use in defrules INPUTS : None RETURNS : The default initial pattern SIDE EFFECTS : Pattern created NOTES : The pattern created is: (object (is-a INITIAL-OBJECT) (name [initial-object])) ***************************************************/ static struct lhsParseNode *CreateInitialObjectPattern( void *theEnv) { struct lhsParseNode *topNode; CLASS_BITMAP *clsset; int initialObjectClassID; initialObjectClassID = LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)->id; clsset = NewClassBitMap(theEnv,initialObjectClassID,0); SetBitMap(clsset->map,initialObjectClassID); clsset = PackClassBitMap(theEnv,clsset); topNode = GetLHSParseNode(theEnv); topNode->userData = EnvAddBitMap(theEnv,(void *) clsset,ClassBitMapSize(clsset)); IncrementBitMapCount(topNode->userData); DeleteIntermediateClassBitMap(theEnv,clsset); topNode->type = SF_WILDCARD; topNode->index = 1; topNode->slot = DefclassData(theEnv)->NAME_SYMBOL; topNode->slotNumber = NAME_ID; topNode->bottom = GetLHSParseNode(theEnv); topNode->bottom->type = INSTANCE_NAME; topNode->bottom->value = (void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL; return(topNode); } /************************************************************** NAME : ObjectMatchDelayParse DESCRIPTION : Parses the object-pattern-match-delay function INPUTS : 1) The function call expression 2) The logical name of the input source RETURNS : The top expression with the other action expressions attached SIDE EFFECTS : Parses the function call and attaches the appropriate arguments to the top node NOTES : None **************************************************************/ static EXPRESSION *ObjectMatchDelayParse( void *theEnv, struct expr *top, const char *infile) { struct token tkn; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); top->argList = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); DecrementIndentDepth(theEnv,3); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } return(top); } /*************************************************** NAME : MarkObjectPtnIncrementalReset DESCRIPTION : Marks/unmarks an object pattern for incremental reset INPUTS : 1) The object pattern alpha node 2) The value to which to set the incremental reset flag RETURNS : Nothing useful SIDE EFFECTS : The pattern node is set/unset NOTES : The pattern node can only be set if it is a new node and thus marked for initialization by PlaceObjectPattern ***************************************************/ static void MarkObjectPtnIncrementalReset( void *theEnv, struct patternNodeHeader *thePattern, int value) { #if MAC_XCD #pragma unused(theEnv) #endif if (thePattern->initialize == FALSE) return; thePattern->initialize = value; } /*********************************************************** NAME : ObjectIncrementalReset DESCRIPTION : Performs an assert for all instances in the system. All new patterns in the pattern network from the new rule have been marked as needing processing. Old patterns will be ignored. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : All objects driven through new patterns NOTES : None ***********************************************************/ static void ObjectIncrementalReset( void *theEnv) { INSTANCE_TYPE *ins; for (ins = InstanceData(theEnv)->InstanceList ; ins != NULL ; ins = ins->nxtList) ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) ins,-1); } #endif #endif clips_core_source_630/core/._objrtfnx.c0000755000175000017500000000040712374023166016453 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltdef.h0000755000175000017500000000040712461253173016443 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._constrct.h0000755000175000017500000000040712461254362016464 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulecmp.h0000755000175000017500000000523312374024365016062 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFRULE CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for join network changes. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_rulecmp #define _H_rulecmp #include "conscomp.h" #ifndef _H_extnfunc #include "extnfunc.h" #endif #define JoinPrefix() ArbitraryPrefix(DefruleData(theEnv)->DefruleCodeItem,2) #define LinkPrefix() ArbitraryPrefix(DefruleData(theEnv)->DefruleCodeItem,3) #ifdef LOCALE #undef LOCALE #endif #ifdef _RULECMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefruleCompilerSetup(void *); LOCALE void DefruleCModuleReference(void *,FILE *,int,int,int); #endif /* _H_rulecmp */ clips_core_source_630/core/._objbin.h0000755000175000017500000000040712374023216016063 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlcmp.c0000755000175000017500000002745312373753370016221 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _GLOBLCMP_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "globldef.h" #include "envrnmnt.h" #include "globlcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void DefglobalToCode(void *,FILE *,struct defglobal *, int,int,int); static void DefglobalModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void CloseDefglobalFiles(void *,FILE *,FILE *,int); static void BeforeDefglobalsToCode(void *); static void InitDefglobalsCode(void *,FILE *,int,int); /***************************************************************/ /* DefglobalCompilerSetup: Initializes the defglobal construct */ /* for use with the constructs-to-c command. */ /***************************************************************/ globle void DefglobalCompilerSetup( void *theEnv) { DefglobalData(theEnv)->DefglobalCodeItem = AddCodeGeneratorItem(theEnv,"defglobal",0,BeforeDefglobalsToCode, InitDefglobalsCode,ConstructToCode,2); } /**************************************************************/ /* BeforeDefglobalsToCode: Assigns each defglobal a unique ID */ /* which will be used for pointer references when the data */ /* structures are written to a file as C code */ /**************************************************************/ static void BeforeDefglobalsToCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DefglobalData(theEnv)->DefglobalModuleIndex); } /*************************************************/ /* InitDefglobalsCode: Writes out initialization */ /* code for defglobals for a run-time module. */ /*************************************************/ static void InitDefglobalsCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_XCD #pragma unused(maxIndices) #pragma unused(imageID) #pragma unused(theEnv) #endif fprintf(initFP," ResetDefglobals(theEnv);\n"); } /***********************************************************/ /* ConstructToCode: Produces defglobal code for a run-time */ /* module created using the constructs-to-c function. */ /***********************************************************/ static int ConstructToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct defglobal *theDefglobal; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int defglobalArrayCount = 0, defglobalArrayVersion = 1; FILE *moduleFile = NULL, *defglobalFile = NULL; /*================================================*/ /* Include the appropriate defglobal header file. */ /*================================================*/ fprintf(headerFP,"#include \"globldef.h\"\n"); /*===================================================================*/ /* Loop through all the modules and all the defglobals writing their */ /* C code representation to the file as they are traversed. */ /*===================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct defglobalModule",ModulePrefix(DefglobalData(theEnv)->DefglobalCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDefglobalFiles(theEnv,moduleFile,defglobalFile,maxIndices); return(0); } DefglobalModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); for (theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); theDefglobal != NULL; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { defglobalFile = OpenFileIfNeeded(theEnv,defglobalFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, defglobalArrayVersion,headerFP, "struct defglobal",ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem), FALSE,NULL); if (defglobalFile == NULL) { CloseDefglobalFiles(theEnv,moduleFile,defglobalFile,maxIndices); return(0); } DefglobalToCode(theEnv,defglobalFile,theDefglobal,imageID,maxIndices,moduleCount); defglobalArrayCount++; defglobalFile = CloseFileIfNeeded(theEnv,defglobalFile,&defglobalArrayCount, &defglobalArrayVersion,maxIndices,NULL,NULL); } moduleCount++; moduleArrayCount++; } CloseDefglobalFiles(theEnv,moduleFile,defglobalFile,maxIndices); return(1); } /**********************************************************/ /* CloseDefglobalFiles: Closes all of the C files created */ /* for defglobals. Called when an error occurs or when */ /* the defglobals have all been written to the files. */ /**********************************************************/ static void CloseDefglobalFiles( void *theEnv, FILE *moduleFile, FILE *defglobalFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (defglobalFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,defglobalFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /***********************************************************/ /* DefglobalModuleToCode: Writes the C code representation */ /* of a single defglobal module to the specified file. */ /***********************************************************/ static void DefglobalModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefglobalData(theEnv)->DefglobalModuleIndex,ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem)); fprintf(theFile,"}"); } /**********************************************************/ /* DefglobalToCode: Writes the C code representation of a */ /* single defglobal construct to the specified file. */ /**********************************************************/ static void DefglobalToCode( void *theEnv, FILE *theFile, struct defglobal *theDefglobal, int imageID, int maxIndices, int moduleCount) { /*==================*/ /* Defglobal Header */ /*==================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefglobal->header,imageID,maxIndices, moduleCount,ModulePrefix(DefglobalData(theEnv)->DefglobalCodeItem), ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem)); fprintf(theFile,","); /*============================================*/ /* Watch Flag, In Scope Flag, and Busy Count. */ /*============================================*/ fprintf(theFile,"0,0,%ld,",theDefglobal->busyCount); /*================*/ /* Current Value. */ /*================*/ fprintf(theFile,"{NULL,RVOID}"); /*=====================*/ /* Initial Expression. */ /*=====================*/ fprintf(theFile,","); PrintHashedExpressionReference(theEnv,theFile,theDefglobal->initial,imageID,maxIndices); fprintf(theFile,"}"); } /***************************************************************/ /* DefglobalCModuleReference: Writes the C code representation */ /* of a reference to a defglobal module data structure. */ /***************************************************************/ globle void DefglobalCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DefglobalData(theEnv)->DefglobalCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /******************************************************************/ /* DefglobalCConstructReference: Writes the C code representation */ /* of a reference to a defglobal data structure. */ /******************************************************************/ globle void DefglobalCConstructReference( void *theEnv, FILE *theFile, void *vTheGlobal, int imageID, int maxIndices) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; if (theGlobal == NULL) { fprintf(theFile,"NULL"); } else { fprintf(theFile,"&%s%d_%ld[%ld]",ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem), imageID, (theGlobal->header.bsaveID / maxIndices) + 1, theGlobal->header.bsaveID % maxIndices); } } #endif /* DEFGLOBAL_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/dffnxexe.c0000755000175000017500000002052612373730371016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Deffunction Execution Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include #include "constrct.h" #include "envrnmnt.h" #include "prcdrfun.h" #include "prccode.h" #include "proflfun.h" #include "router.h" #include "utility.h" #include "watch.h" #define _DFFNXEXE_SOURCE_ #include "dffnxexe.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BEGIN_TRACE ">> " #define END_TRACE "<< " /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void UnboundDeffunctionErr(void *); #if DEBUGGING_FUNCTIONS static void WatchDeffunction(void *,const char *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /**************************************************** NAME : CallDeffunction DESCRIPTION : Executes the body of a deffunction INPUTS : 1) The deffunction 2) Argument expressions 3) Data object buffer to hold result RETURNS : Nothing useful SIDE EFFECTS : Deffunction executed and result stored in data object buffer NOTES : Used in EvaluateExpression(theEnv,) ****************************************************/ globle void CallDeffunction( void *theEnv, DEFFUNCTION *dptr, EXPRESSION *args, DATA_OBJECT *result) { int oldce; DEFFUNCTION *previouslyExecutingDeffunction; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previouslyExecutingDeffunction = DeffunctionData(theEnv)->ExecutingDeffunction; DeffunctionData(theEnv)->ExecutingDeffunction = dptr; EvaluationData(theEnv)->CurrentEvaluationDepth++; dptr->executing++; PushProcParameters(theEnv,args,CountArguments(args),EnvGetDeffunctionName(theEnv,(void *) dptr), "deffunction",UnboundDeffunctionErr); if (EvaluationData(theEnv)->EvaluationError) { dptr->executing--; DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction; EvaluationData(theEnv)->CurrentEvaluationDepth--; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } #if DEBUGGING_FUNCTIONS if (dptr->trace) WatchDeffunction(theEnv,BEGIN_TRACE); #endif #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &dptr->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,dptr->header.whichModule->theModule, dptr->code,dptr->numberOfLocalVars, result,UnboundDeffunctionErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif #if DEBUGGING_FUNCTIONS if (dptr->trace) WatchDeffunction(theEnv,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; dptr->executing--; PopProcParameters(theEnv); DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction; EvaluationData(theEnv)->CurrentEvaluationDepth--; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : UnboundDeffunctionErr DESCRIPTION : Print out a synopis of the currently executing deffunction for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None *******************************************************/ static void UnboundDeffunctionErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) DeffunctionData(theEnv)->ExecutingDeffunction)); EnvPrintRouter(theEnv,WERROR,".\n"); } #if DEBUGGING_FUNCTIONS /*************************************************** NAME : WatchDeffunction DESCRIPTION : Displays a message indicating when a deffunction began and ended execution INPUTS : The beginning or end trace string to print when deffunction starts or finishes respectively RETURNS : Nothing useful SIDE EFFECTS : Watch message printed NOTES : None ***************************************************/ static void WatchDeffunction( void *theEnv, const char *tstring) { EnvPrintRouter(theEnv,WTRACE,"DFN "); EnvPrintRouter(theEnv,WTRACE,tstring); if (DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *) DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule)); EnvPrintRouter(theEnv,WTRACE,"::"); } EnvPrintRouter(theEnv,WTRACE,ValueToString(DeffunctionData(theEnv)->ExecutingDeffunction->header.name)); EnvPrintRouter(theEnv,WTRACE," ED:"); PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,WTRACE); } #endif #endif clips_core_source_630/core/prntutil.h0000755000175000017500000001267612424473401016300 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* PRINT UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for printing various items */ /* and messages. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Added DataObjectToString function. */ /* */ /* Added SlotExistError function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Support for DATA_OBJECT_ARRAY primitive. */ /* */ /* Support for typed EXTERNAL_ADDRESS. */ /* */ /* Used gensprintf and genstrcat instead of */ /* sprintf and strcat. */ /* */ /* Changed integer type/precision. */ /* */ /* Added code for capturing errors/warnings. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #ifndef _H_prntutil #define _H_prntutil #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define PRINT_UTILITY_DATA 53 struct printUtilityData { intBool PreserveEscapedCharacters; intBool AddressesToStrings; intBool InstanceAddressesToNames; }; #define PrintUtilityData(theEnv) ((struct printUtilityData *) GetEnvironmentData(theEnv,PRINT_UTILITY_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PRNTUTIL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializePrintUtilityData(void *); LOCALE void PrintInChunks(void *,const char *,const char *); LOCALE void PrintFloat(void *,const char *,double); LOCALE void PrintLongInteger(void *,const char *,long long); LOCALE void PrintAtom(void *,const char *,int,void *); LOCALE void PrintTally(void *,const char *,long long,const char *,const char *); LOCALE const char *FloatToString(void *,double); LOCALE const char *LongIntegerToString(void *,long long); LOCALE const char *DataObjectToString(void *,DATA_OBJECT *); LOCALE void SyntaxErrorMessage(void *,const char *); LOCALE void SystemError(void *,const char *,int); LOCALE void PrintErrorID(void *,const char *,int,int); LOCALE void PrintWarningID(void *,const char *,int,int); LOCALE void CantFindItemErrorMessage(void *,const char *,const char *); LOCALE void CantDeleteItemErrorMessage(void *,const char *,const char *); LOCALE void AlreadyParsedErrorMessage(void *,const char *,const char *); LOCALE void LocalVariableErrorMessage(void *,const char *); LOCALE void DivideByZeroErrorMessage(void *,const char *); LOCALE void SalienceInformationError(void *,const char *,const char *); LOCALE void SalienceRangeError(void *,int,int); LOCALE void SalienceNonIntegerError(void *); LOCALE void CantFindItemInFunctionErrorMessage(void *,const char *,const char *,const char *); LOCALE void SlotExistError(void *,const char *,const char *); #endif /* _H_prntutil */ clips_core_source_630/core/._watch.c0000755000175000017500000000040712375756702015737 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._multifld.h0000755000175000017500000000040712374717747016463 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/drive.c0000755000175000017500000012526512500146076015522 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DRIVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the addition of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /* Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Removed pseudo-facts used in not CE. */ /* */ /*************************************************************/ #define _DRIVE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "agenda.h" #include "constant.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "prntutil.h" #include "reteutil.h" #include "retract.h" #include "router.h" #include "lgcldpnd.h" #include "incrrset.h" #include "drive.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void EmptyDrive(void *,struct joinNode *,struct partialMatch *,int); static void JoinNetErrorMessage(void *,struct joinNode *); /************************************************/ /* NetworkAssert: Primary routine for filtering */ /* a partial match through the join network. */ /************************************************/ globle void NetworkAssert( void *theEnv, struct partialMatch *binds, struct joinNode *join) { /*=========================================================*/ /* If an incremental reset is being performed and the join */ /* is not part of the network to be reset, then return. */ /*=========================================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return; #endif /*==================================================*/ /* Use a special routine if this is the first join. */ /*==================================================*/ if (join->firstJoin) { EmptyDrive(theEnv,join,binds,NETWORK_ASSERT); return; } /*================================*/ /* Enter the join from the right. */ /*================================*/ NetworkAssertRight(theEnv,binds,join,NETWORK_ASSERT); return; } /*****************************************************/ /* NetworkAssertRight: Primary routine for filtering */ /* a partial match through the join network from */ /* the RHS of a join. */ /*****************************************************/ globle void NetworkAssertRight( void *theEnv, struct partialMatch *rhsBinds, struct joinNode *join, int operation) { struct partialMatch *lhsBinds, *nextBind; int exprResult, restore = FALSE; struct partialMatch *oldLHSBinds = NULL; struct partialMatch *oldRHSBinds = NULL; struct joinNode *oldJoin = NULL; /*=========================================================*/ /* If an incremental reset is being performed and the join */ /* is not part of the network to be reset, then return. */ /*=========================================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return; #endif if (join->firstJoin) { EmptyDrive(theEnv,join,rhsBinds,operation); return; } /*=====================================================*/ /* The partial matches entering from the LHS of a join */ /* are stored in the left beta memory of the join. */ /*=====================================================*/ lhsBinds = GetLeftBetaMemory(join,rhsBinds->hashValue); #if DEVELOPER if (lhsBinds != NULL) { EngineData(theEnv)->rightToLeftLoops++; } #endif /*====================================*/ /* Set up the evaluation environment. */ /*====================================*/ if (lhsBinds != NULL) { oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalRHSBinds = rhsBinds; EngineData(theEnv)->GlobalJoin = join; restore = TRUE; } /*===================================================*/ /* Compare each set of binds on the opposite side of */ /* the join with the set of binds that entered this */ /* join. If the binds don't mismatch, then perform */ /* the appropriate action for the logic of the join. */ /*===================================================*/ while (lhsBinds != NULL) { nextBind = lhsBinds->nextInMemory; join->memoryCompares++; /*===========================================================*/ /* Initialize some variables pointing to the partial matches */ /* in the LHS and RHS of the join. */ /*===========================================================*/ if (lhsBinds->hashValue != rhsBinds->hashValue) { #if DEVELOPER if (join->leftMemory->size == 1) { EngineData(theEnv)->betaHashListSkips++; } else { EngineData(theEnv)->betaHashHTSkips++; } if (lhsBinds->marker != NULL) { EngineData(theEnv)->unneededMarkerCompare++; } #endif lhsBinds = nextBind; continue; } /*===============================================================*/ /* If there already is an associated RHS partial match stored in */ /* the LHS partial match from the beta memory of this join, then */ /* the exists/nand CE has already been satisfied and we can move */ /* on to the next partial match found in the beta memory. */ /*===============================================================*/ if (lhsBinds->marker != NULL) { #if DEVELOPER EngineData(theEnv)->unneededMarkerCompare++; #endif lhsBinds = nextBind; continue; } /*===================================================*/ /* If the join has no expression associated with it, */ /* then the new partial match derived from the LHS */ /* and RHS partial matches is valid. */ /*===================================================*/ if (join->networkTest == NULL) { exprResult = TRUE; } /*=========================================================*/ /* If the join has an expression associated with it, then */ /* evaluate the expression to determine if the new partial */ /* match derived from the LHS and RHS partial matches is */ /* valid (i.e. variable bindings are consistent and */ /* predicate expressions evaluate to TRUE). */ /*=========================================================*/ else { #if DEVELOPER EngineData(theEnv)->rightToLeftComparisons++; #endif EngineData(theEnv)->GlobalLHSBinds = lhsBinds; exprResult = EvaluateJoinExpression(theEnv,join->networkTest,join); if (EvaluationData(theEnv)->EvaluationError) { if (join->patternIsNegated) exprResult = TRUE; SetEvaluationError(theEnv,FALSE); } #if DEVELOPER if (exprResult) { EngineData(theEnv)->rightToLeftSucceeds++; } #endif } if ((join->secondaryNetworkTest != NULL) && exprResult) { EngineData(theEnv)->GlobalLHSBinds = lhsBinds; exprResult = EvaluateJoinExpression(theEnv,join->secondaryNetworkTest,join); if (EvaluationData(theEnv)->EvaluationError) { SetEvaluationError(theEnv,FALSE); } } /*====================================================*/ /* If the join expression evaluated to TRUE (i.e. */ /* there were no conflicts between variable bindings, */ /* all tests were satisfied, etc.), then perform the */ /* appropriate action given the logic of this join. */ /*====================================================*/ if (exprResult != FALSE) { if (join->patternIsExists) { AddBlockedLink(lhsBinds,rhsBinds); PPDrive(theEnv,lhsBinds,NULL,join,operation); } else if (join->patternIsNegated || join->joinFromTheRight) { AddBlockedLink(lhsBinds,rhsBinds); if (lhsBinds->children != NULL) { PosEntryRetractBeta(theEnv,lhsBinds,lhsBinds->children,operation); } /* if (lhsBinds->dependents != NULL) { RemoveLogicalSupport(theEnv,lhsBinds); } */ } else { PPDrive(theEnv,lhsBinds,rhsBinds,join,operation); } } /*====================================*/ /* Move on to the next partial match. */ /*====================================*/ lhsBinds = nextBind; } /*=========================================*/ /* Restore the old evaluation environment. */ /*=========================================*/ if (restore) { EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; } return; } /****************************************************/ /* NetworkAssertLeft: Primary routine for filtering */ /* a partial match through the join network when */ /* entering through the left side of a join. */ /****************************************************/ globle void NetworkAssertLeft( void *theEnv, struct partialMatch *lhsBinds, struct joinNode *join, int operation) { struct partialMatch *rhsBinds; int exprResult, restore = FALSE; unsigned long entryHashValue; struct partialMatch *oldLHSBinds = NULL; struct partialMatch *oldRHSBinds = NULL; struct joinNode *oldJoin = NULL; if ((operation == NETWORK_RETRACT) && PartialMatchWillBeDeleted(theEnv,lhsBinds)) { return; } /*=========================================================*/ /* If an incremental reset is being performed and the join */ /* is not part of the network to be reset, then return. */ /*=========================================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return; #endif /*===================================*/ /* The only action for the last join */ /* of a rule is to activate it. */ /*===================================*/ if (join->ruleToActivate != NULL) { AddActivation(theEnv,join->ruleToActivate,lhsBinds); return; } /*=====================================*/ /* Handle a join handling a test CE at */ /* the beginning of a not/and group. */ /*=====================================*/ if (join->rightSideEntryStructure == NULL) { exprResult = TRUE; if (join->networkTest != NULL) { oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = lhsBinds; EngineData(theEnv)->GlobalRHSBinds = NULL; EngineData(theEnv)->GlobalJoin = join; exprResult = EvaluateJoinExpression(theEnv,join->networkTest,join); if (EvaluationData(theEnv)->EvaluationError) { SetEvaluationError(theEnv,FALSE); } EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; } if (exprResult) { PPDrive(theEnv,lhsBinds,NULL,join,operation); } return; } /*==================================================*/ /* Initialize some variables used to indicate which */ /* side is being compared to the new partial match. */ /*==================================================*/ entryHashValue = lhsBinds->hashValue; if (join->joinFromTheRight) { rhsBinds = GetRightBetaMemory(join,entryHashValue); } else { rhsBinds = GetAlphaMemory(theEnv,(struct patternNodeHeader *) join->rightSideEntryStructure,entryHashValue); } #if DEVELOPER if (rhsBinds != NULL) { EngineData(theEnv)->leftToRightLoops++; } #endif /*====================================*/ /* Set up the evaluation environment. */ /*====================================*/ if ((rhsBinds != NULL) || (join->secondaryNetworkTest != NULL)) { oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = lhsBinds; EngineData(theEnv)->GlobalJoin = join; restore = TRUE; } /*===================================================*/ /* Compare each set of binds on the opposite side of */ /* the join with the set of binds that entered this */ /* join. If the binds don't mismatch, then perform */ /* the appropriate action for the logic of the join. */ /*===================================================*/ while (rhsBinds != NULL) { if ((operation == NETWORK_RETRACT) && PartialMatchWillBeDeleted(theEnv,rhsBinds)) { rhsBinds = rhsBinds->nextInMemory; continue; } join->memoryCompares++; /*===================================================*/ /* If the join has no expression associated with it, */ /* then the new partial match derived from the LHS */ /* and RHS partial matches is valid. */ /*===================================================*/ if (join->networkTest == NULL) { exprResult = TRUE; } /*=========================================================*/ /* If the join has an expression associated with it, then */ /* evaluate the expression to determine if the new partial */ /* match derived from the LHS and RHS partial matches is */ /* valid (i.e. variable bindings are consistent and */ /* predicate expressions evaluate to TRUE). */ /*=========================================================*/ else { #if DEVELOPER EngineData(theEnv)->leftToRightComparisons++; #endif EngineData(theEnv)->GlobalRHSBinds = rhsBinds; exprResult = EvaluateJoinExpression(theEnv,join->networkTest,join); if (EvaluationData(theEnv)->EvaluationError) { if (join->patternIsNegated) exprResult = TRUE; SetEvaluationError(theEnv,FALSE); } #if DEVELOPER if (exprResult) { EngineData(theEnv)->leftToRightSucceeds++; } #endif } // Bug Fix - Need to evaluate secondary network test for exists CE 0881 if ((join->secondaryNetworkTest != NULL) && exprResult && join->patternIsExists) { EngineData(theEnv)->GlobalRHSBinds = rhsBinds; exprResult = EvaluateJoinExpression(theEnv,join->secondaryNetworkTest,join); if (EvaluationData(theEnv)->EvaluationError) { SetEvaluationError(theEnv,FALSE); } } /*====================================================*/ /* If the join expression evaluated to TRUE (i.e. */ /* there were no conflicts between variable bindings, */ /* all tests were satisfied, etc.), then perform the */ /* appropriate action given the logic of this join. */ /*====================================================*/ if (exprResult != FALSE) { /*==============================================*/ /* Use the PPDrive routine when the join isn't */ /* associated with a not CE and it doesn't have */ /* a join from the right. */ /*==============================================*/ if ((join->patternIsNegated == FALSE) && (join->patternIsExists == FALSE) && (join->joinFromTheRight == FALSE)) { PPDrive(theEnv,lhsBinds,rhsBinds,join,operation); } /*==================================================*/ /* At most, one partial match will be generated for */ /* a match from the right memory of an exists CE. */ /*==================================================*/ else if (join->patternIsExists) { AddBlockedLink(lhsBinds,rhsBinds); PPDrive(theEnv,lhsBinds,NULL,join,operation); EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return; } /*===========================================================*/ /* If the new partial match entered from the LHS of the join */ /* and the join is either associated with a not CE or the */ /* join has a join from the right, then mark the LHS partial */ /* match indicating that there is a RHS partial match */ /* preventing this join from being satisfied. Once this has */ /* happened, the other RHS partial matches don't have to be */ /* tested since it only takes one partial match to prevent */ /* the LHS from being satisfied. */ /*===========================================================*/ else { AddBlockedLink(lhsBinds,rhsBinds); break; } } /*====================================*/ /* Move on to the next partial match. */ /*====================================*/ rhsBinds = rhsBinds->nextInMemory; } /*==================================================================*/ /* If a join with an associated not CE or join from the right was */ /* entered from the LHS side of the join, and the join expression */ /* failed for all sets of matches for the new bindings on the LHS */ /* side (there was no RHS partial match preventing the LHS partial */ /* match from being satisfied), then the LHS partial match appended */ /* with an pseudo-fact that represents the instance of the not */ /* pattern or join from the right that was satisfied should be sent */ /* to the joins below this join. */ /*==================================================================*/ if ((join->patternIsNegated || join->joinFromTheRight) && (! join->patternIsExists) && (lhsBinds->marker == NULL)) { if (join->secondaryNetworkTest != NULL) { EngineData(theEnv)->GlobalRHSBinds = NULL; exprResult = EvaluateJoinExpression(theEnv,join->secondaryNetworkTest,join); if (EvaluationData(theEnv)->EvaluationError) { SetEvaluationError(theEnv,FALSE); } if (exprResult) { PPDrive(theEnv,lhsBinds,NULL,join,operation); } } else { PPDrive(theEnv,lhsBinds,NULL,join,operation); } } /*=========================================*/ /* Restore the old evaluation environment. */ /*=========================================*/ if (restore) { EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; } return; } /*******************************************************/ /* EvaluateJoinExpression: Evaluates join expressions. */ /* Performs a faster evaluation for join expressions */ /* than if EvaluateExpression was used directly. */ /*******************************************************/ globle intBool EvaluateJoinExpression( void *theEnv, struct expr *joinExpr, struct joinNode *joinPtr) { DATA_OBJECT theResult; int andLogic, result = TRUE; /*======================================*/ /* A NULL expression evaluates to TRUE. */ /*======================================*/ if (joinExpr == NULL) return(TRUE); /*====================================================*/ /* Initialize some variables which allow this routine */ /* to avoid calling the "and" and "or" functions if */ /* they are the first part of the expression to be */ /* evaluated. Most of the join expressions do not use */ /* deeply nested and/or functions so this technique */ /* speeds up evaluation. */ /*====================================================*/ if (joinExpr->value == ExpressionData(theEnv)->PTR_AND) { andLogic = TRUE; joinExpr = joinExpr->argList; } else if (joinExpr->value == ExpressionData(theEnv)->PTR_OR) { andLogic = FALSE; joinExpr = joinExpr->argList; } else { andLogic = TRUE; } /*=========================================*/ /* Evaluate each of the expressions linked */ /* together in the join expression. */ /*=========================================*/ while (joinExpr != NULL) { /*================================*/ /* Evaluate a primitive function. */ /*================================*/ if ((EvaluationData(theEnv)->PrimitivesArray[joinExpr->type] == NULL) ? FALSE : EvaluationData(theEnv)->PrimitivesArray[joinExpr->type]->evaluateFunction != NULL) { struct expr *oldArgument; oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = joinExpr; result = (*EvaluationData(theEnv)->PrimitivesArray[joinExpr->type]->evaluateFunction)(theEnv,joinExpr->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; } /*=============================*/ /* Evaluate the "or" function. */ /*=============================*/ else if (joinExpr->value == ExpressionData(theEnv)->PTR_OR) { result = FALSE; if (EvaluateJoinExpression(theEnv,joinExpr,joinPtr) == TRUE) { if (EvaluationData(theEnv)->EvaluationError) { return(FALSE); } result = TRUE; } else if (EvaluationData(theEnv)->EvaluationError) { return(FALSE); } } /*==============================*/ /* Evaluate the "and" function. */ /*==============================*/ else if (joinExpr->value == ExpressionData(theEnv)->PTR_AND) { result = TRUE; if (EvaluateJoinExpression(theEnv,joinExpr,joinPtr) == FALSE) { if (EvaluationData(theEnv)->EvaluationError) { return(FALSE); } result = FALSE; } else if (EvaluationData(theEnv)->EvaluationError) { return(FALSE); } } /*==========================================================*/ /* Evaluate all other expressions using EvaluateExpression. */ /*==========================================================*/ else { EvaluateExpression(theEnv,joinExpr,&theResult); if (EvaluationData(theEnv)->EvaluationError) { JoinNetErrorMessage(theEnv,joinPtr); return(FALSE); } if ((theResult.value == EnvFalseSymbol(theEnv)) && (theResult.type == SYMBOL)) { result = FALSE; } else { result = TRUE; } } /*====================================*/ /* Handle the short cut evaluation of */ /* the "and" and "or" functions. */ /*====================================*/ if ((andLogic == TRUE) && (result == FALSE)) { return(FALSE); } else if ((andLogic == FALSE) && (result == TRUE)) { return(TRUE); } /*==============================================*/ /* Move to the next expression to be evaluated. */ /*==============================================*/ joinExpr = joinExpr->nextArg; } /*=================================================*/ /* Return the result of evaluating the expression. */ /*=================================================*/ return(result); } /*******************************************************/ /* EvaluateSecondaryNetworkTest: */ /*******************************************************/ globle intBool EvaluateSecondaryNetworkTest( void *theEnv, struct partialMatch *leftMatch, struct joinNode *joinPtr) { int joinExpr; struct partialMatch *oldLHSBinds; struct partialMatch *oldRHSBinds; struct joinNode *oldJoin; if (joinPtr->secondaryNetworkTest == NULL) { return(TRUE); } #if DEVELOPER EngineData(theEnv)->rightToLeftComparisons++; #endif oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = leftMatch; EngineData(theEnv)->GlobalRHSBinds = NULL; EngineData(theEnv)->GlobalJoin = joinPtr; joinExpr = EvaluateJoinExpression(theEnv,joinPtr->secondaryNetworkTest,joinPtr); EvaluationData(theEnv)->EvaluationError = FALSE; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(joinExpr); } /*******************************************************/ /* BetaMemoryHashValue: */ /*******************************************************/ globle unsigned long BetaMemoryHashValue( void *theEnv, struct expr *hashExpr, struct partialMatch *lbinds, struct partialMatch *rbinds, struct joinNode *joinPtr) { DATA_OBJECT theResult; struct partialMatch *oldLHSBinds; struct partialMatch *oldRHSBinds; struct joinNode *oldJoin; unsigned long hashValue = 0; unsigned long multiplier = 1; union { void *vv; unsigned long liv; } fis; /*======================================*/ /* A NULL expression evaluates to zero. */ /*======================================*/ if (hashExpr == NULL) return(0); /*=========================================*/ /* Initialize some of the global variables */ /* used when evaluating expressions. */ /*=========================================*/ oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = lbinds; EngineData(theEnv)->GlobalRHSBinds = rbinds; EngineData(theEnv)->GlobalJoin = joinPtr; /*=========================================*/ /* Evaluate each of the expressions linked */ /* together in the join expression. */ /*=========================================*/ while (hashExpr != NULL) { /*================================*/ /* Evaluate a primitive function. */ /*================================*/ if ((EvaluationData(theEnv)->PrimitivesArray[hashExpr->type] == NULL) ? FALSE : EvaluationData(theEnv)->PrimitivesArray[hashExpr->type]->evaluateFunction != NULL) { struct expr *oldArgument; oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = hashExpr; (*EvaluationData(theEnv)->PrimitivesArray[hashExpr->type]->evaluateFunction)(theEnv,hashExpr->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; } /*==========================================================*/ /* Evaluate all other expressions using EvaluateExpression. */ /*==========================================================*/ else { EvaluateExpression(theEnv,hashExpr,&theResult); } switch (theResult.type) { case STRING: case SYMBOL: case INSTANCE_NAME: hashValue += (((SYMBOL_HN *) theResult.value)->bucket * multiplier); break; case INTEGER: hashValue += (((INTEGER_HN *) theResult.value)->bucket * multiplier); break; case FLOAT: hashValue += (((FLOAT_HN *) theResult.value)->bucket * multiplier); break; case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif fis.liv = 0; fis.vv = theResult.value; hashValue += (unsigned long) (fis.liv * multiplier); break; case EXTERNAL_ADDRESS: fis.liv = 0; fis.vv = ValueToExternalAddress(theResult.value); hashValue += (unsigned long) (fis.liv * multiplier); break; } /*==============================================*/ /* Move to the next expression to be evaluated. */ /*==============================================*/ hashExpr = hashExpr->nextArg; multiplier = multiplier * 509; } /*=======================================*/ /* Restore some of the global variables. */ /*=======================================*/ EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; /*=================================================*/ /* Return the result of evaluating the expression. */ /*=================================================*/ return(hashValue); } /*******************************************************************/ /* PPDrive: Handles the merging of an alpha memory partial match */ /* with a beta memory partial match for a join that has positive */ /* LHS entry and positive RHS entry. The partial matches being */ /* merged have previously been checked to determine that they */ /* satisify the constraints for the join. Once merged, the new */ /* partial match is sent to each child join of the join from */ /* which the merge took place. */ /*******************************************************************/ globle void PPDrive( void *theEnv, struct partialMatch *lhsBinds, struct partialMatch *rhsBinds, struct joinNode *join, int operation) { struct partialMatch *linker; struct joinLink *listOfJoins; unsigned long hashValue; /*================================================*/ /* Send the new partial match to all child joins. */ /*================================================*/ listOfJoins = join->nextLinks; if (listOfJoins == NULL) return; /*===============================================================*/ /* In the current implementation, all children of this join must */ /* be entered from the same side (either all left or all right). */ /*===============================================================*/ while (listOfJoins != NULL) { /*==================================================*/ /* Merge the alpha and beta memory partial matches. */ /*==================================================*/ linker = MergePartialMatches(theEnv,lhsBinds,rhsBinds); /*================================================*/ /* Determine the hash value of the partial match. */ /*================================================*/ if (listOfJoins->enterDirection == LHS) { if (listOfJoins->join->leftHash != NULL) { hashValue = BetaMemoryHashValue(theEnv,listOfJoins->join->leftHash,linker,NULL,listOfJoins->join); } else { hashValue = 0; } } else { if (listOfJoins->join->rightHash != NULL) { hashValue = BetaMemoryHashValue(theEnv,listOfJoins->join->rightHash,linker,NULL,listOfJoins->join); } else { hashValue = 0; } } /*=======================================================*/ /* Add the partial match to the beta memory of the join. */ /*=======================================================*/ UpdateBetaPMLinks(theEnv,linker,lhsBinds,rhsBinds,listOfJoins->join,hashValue,listOfJoins->enterDirection); if (listOfJoins->enterDirection == LHS) { NetworkAssertLeft(theEnv,linker,listOfJoins->join,operation); } else { NetworkAssertRight(theEnv,linker,listOfJoins->join,operation); } listOfJoins = listOfJoins->next; } return; } /***********************************************************************/ /* EPMDrive: Drives an empty partial match to the next level of joins. */ /* An empty partial match is usually associated with a negated CE */ /* that is the first CE of a rule. */ /***********************************************************************/ globle void EPMDrive( void *theEnv, struct partialMatch *parent, struct joinNode *join, int operation) { struct partialMatch *linker; struct joinLink *listOfJoins; listOfJoins = join->nextLinks; if (listOfJoins == NULL) return; while (listOfJoins != NULL) { linker = CreateEmptyPartialMatch(theEnv); UpdateBetaPMLinks(theEnv,linker,parent,NULL,listOfJoins->join,0,listOfJoins->enterDirection); if (listOfJoins->enterDirection == LHS) { NetworkAssertLeft(theEnv,linker,listOfJoins->join,operation); } else { NetworkAssertRight(theEnv,linker,listOfJoins->join,operation); } listOfJoins = listOfJoins->next; } } /***************************************************************/ /* EmptyDrive: Handles the entry of a alpha memory partial */ /* match from the RHS of a join that is the first join of */ /* a rule (i.e. a join that cannot be entered from the LHS). */ /***************************************************************/ static void EmptyDrive( void *theEnv, struct joinNode *join, struct partialMatch *rhsBinds, int operation) { struct partialMatch *linker, *existsParent = NULL, *notParent; struct joinLink *listOfJoins; int joinExpr; unsigned long hashValue; struct partialMatch *oldLHSBinds; struct partialMatch *oldRHSBinds; struct joinNode *oldJoin; /*======================================================*/ /* Determine if the alpha memory partial match satifies */ /* the join expression. If it doesn't then no further */ /* action is taken. */ /*======================================================*/ if (join->networkTest != NULL) { #if DEVELOPER EngineData(theEnv)->rightToLeftComparisons++; #endif oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = NULL; EngineData(theEnv)->GlobalRHSBinds = rhsBinds; EngineData(theEnv)->GlobalJoin = join; joinExpr = EvaluateJoinExpression(theEnv,join->networkTest,join); EvaluationData(theEnv)->EvaluationError = FALSE; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; if (joinExpr == FALSE) return; } if (join->secondaryNetworkTest != NULL) { #if DEVELOPER EngineData(theEnv)->rightToLeftComparisons++; #endif oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = NULL; EngineData(theEnv)->GlobalRHSBinds = rhsBinds; EngineData(theEnv)->GlobalJoin = join; joinExpr = EvaluateJoinExpression(theEnv,join->secondaryNetworkTest,join); EvaluationData(theEnv)->EvaluationError = FALSE; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; if (joinExpr == FALSE) return; } /*========================================================*/ /* Handle a negated first pattern or join from the right. */ /*========================================================*/ if (join->patternIsNegated || (join->joinFromTheRight && (! join->patternIsExists))) /* reorder to remove patternIsExists test */ { notParent = join->leftMemory->beta[0]; if (notParent->marker != NULL) { return; } AddBlockedLink(notParent,rhsBinds); if (notParent->children != NULL) { PosEntryRetractBeta(theEnv,notParent,notParent->children,operation); } /* if (notParent->dependents != NULL) { RemoveLogicalSupport(theEnv,notParent); } */ return; } /*=====================================================*/ /* For exists CEs used as the first pattern of a rule, */ /* a special partial match in the left memory of the */ /* join is used to track the RHS partial match */ /* satisfying the CE. */ /*=====================================================*/ /* TBD reorder */ if (join->patternIsExists) { existsParent = join->leftMemory->beta[0]; if (existsParent->marker != NULL) { return; } AddBlockedLink(existsParent,rhsBinds); } /*============================================*/ /* Send the partial match to all child joins. */ /*============================================*/ listOfJoins = join->nextLinks; if (listOfJoins == NULL) return; while (listOfJoins != NULL) { /*===================================================================*/ /* An exists CE as the first pattern of a rule can generate at most */ /* one partial match, so if there's already a partial match in the */ /* beta memory nothing further needs to be done. Since there are no */ /* variable bindings which child joins can use for indexing, the */ /* partial matches will always be stored in the bucket with index 0. */ /* Although an exists is associated with a specific fact/instance */ /* (through its rightParent link) that allows it to be satisfied, */ /* the bindings in the partial match will be empty for this CE. */ /*===================================================================*/ if (join->patternIsExists) { linker = CreateEmptyPartialMatch(theEnv); } /*=============================================================*/ /* Othewise just copy the partial match from the alpha memory. */ /*=============================================================*/ else { linker = CopyPartialMatch(theEnv,rhsBinds); } /*================================================*/ /* Determine the hash value of the partial match. */ /*================================================*/ if (listOfJoins->enterDirection == LHS) { if (listOfJoins->join->leftHash != NULL) { hashValue = BetaMemoryHashValue(theEnv,listOfJoins->join->leftHash,linker,NULL,listOfJoins->join); } else { hashValue = 0; } } else { if (listOfJoins->join->rightHash != NULL) { hashValue = BetaMemoryHashValue(theEnv,listOfJoins->join->rightHash,linker,NULL,listOfJoins->join); } else { hashValue = 0; } } /*=======================================================*/ /* Add the partial match to the beta memory of the join. */ /*=======================================================*/ if (join->patternIsExists) { UpdateBetaPMLinks(theEnv,linker,existsParent,NULL,listOfJoins->join,hashValue,listOfJoins->enterDirection); } else { UpdateBetaPMLinks(theEnv,linker,NULL,rhsBinds,listOfJoins->join,hashValue,listOfJoins->enterDirection); } if (listOfJoins->enterDirection == LHS) { NetworkAssertLeft(theEnv,linker,listOfJoins->join,operation); } else { NetworkAssertRight(theEnv,linker,listOfJoins->join,operation); } listOfJoins = listOfJoins->next; } } /********************************************************************/ /* JoinNetErrorMessage: Prints an informational message indicating */ /* which join of a rule generated an error when a join expression */ /* was being evaluated. */ /********************************************************************/ static void JoinNetErrorMessage( void *theEnv, struct joinNode *joinPtr) { PrintErrorID(theEnv,"DRIVE",1,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred in the join network\n"); EnvPrintRouter(theEnv,WERROR," Problem resides in associated join\n"); /* TBD generate test case for join with JFTR */ /* sprintf(buffer," Problem resides in join #%d in rule(s):\n",joinPtr->depth); EnvPrintRouter(theEnv,WERROR,buffer); */ TraceErrorToRule(theEnv,joinPtr," "); EnvPrintRouter(theEnv,WERROR,"\n"); } #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/developr.c0000755000175000017500000005213712373721332016230 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEVELOPER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines useful for browsing various */ /* data structures. The functions are provided for */ /* development use. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Changed garbage collection algorithm. */ /* Functions enable-gc-heuristics and */ /* disable-gc-heuristics are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers and type casts to */ /* remove C++ warnings. */ /* */ /* Replaced deprecated WCLIPS logical name with */ /* WPROMPT. */ /* */ /*************************************************************/ #define _DEVELOPR_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "extnfunc.h" #include "inscom.h" #include "modulutl.h" #include "router.h" #include "utility.h" #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT #include "tmpltdef.h" #include "factbld.h" #include "facthsh.h" #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #include "objrtmch.h" #endif #if OBJECT_SYSTEM #include "insfun.h" #endif #include "developr.h" #if DEVELOPER #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM static void PrintOPNLevel(void *theEnv,OBJECT_PATTERN_NODE *,char *,int); #endif /**************************************************/ /* DeveloperCommands: Sets up developer commands. */ /**************************************************/ globle void DeveloperCommands( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"primitives-info",'v', PTIEF PrimitiveTablesInfo,"PrimitiveTablesInfo","00"); EnvDefineFunction2(theEnv,"primitives-usage",'v', PTIEF PrimitiveTablesUsage,"PrimitiveTablesUsage","00"); #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT EnvDefineFunction2(theEnv,"validate-fact-integrity", 'b', ValidateFactIntegrity, "ValidateFactIntegrity", "00"); EnvDefineFunction2(theEnv,"show-fpn",'v', PTIEF ShowFactPatternNetwork,"ShowFactPatternNetwork","11w"); EnvDefineFunction2(theEnv,"show-fht",'v', PTIEF ShowFactHashTable,"ShowFactHashTable","00"); #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM EnvDefineFunction2(theEnv,"show-opn",'v',PTIEF PrintObjectPatternNetwork, "PrintObjectPatternNetwork","00"); #endif #if OBJECT_SYSTEM EnvDefineFunction2(theEnv,"instance-table-usage",'v', PTIEF InstanceTableUsage,"InstanceTableUsage","00"); #endif #endif } /******************************************************/ /* PrimitiveTablesInfo: Prints information about the */ /* symbol, float, integer, and bitmap tables. */ /******************************************************/ globle void PrimitiveTablesInfo( void *theEnv) { unsigned long i; SYMBOL_HN **symbolArray, *symbolPtr; FLOAT_HN **floatArray, *floatPtr; INTEGER_HN **integerArray, *integerPtr; BITMAP_HN **bitMapArray, *bitMapPtr; unsigned long int symbolCount = 0, integerCount = 0; unsigned long int floatCount = 0, bitMapCount = 0; EnvArgCountCheck(theEnv,"primitives-info",EXACTLY,0); /*====================================*/ /* Count entries in the symbol table. */ /*====================================*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { symbolCount++; } } /*====================================*/ /* Count entries in the integer table. */ /*====================================*/ integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { integerCount++; } } /*====================================*/ /* Count entries in the float table. */ /*====================================*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { floatCount++; } } /*====================================*/ /* Count entries in the bitmap table. */ /*====================================*/ bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { bitMapCount++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Symbols: "); PrintLongInteger(theEnv,WDISPLAY,(long long) symbolCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Integers: "); PrintLongInteger(theEnv,WDISPLAY,(long long) integerCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Floats: "); PrintLongInteger(theEnv,WDISPLAY,(long long) floatCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"BitMaps: "); PrintLongInteger(theEnv,WDISPLAY,(long long) bitMapCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); /* EnvPrintRouter(theEnv,WDISPLAY,"Ephemerals: "); PrintLongInteger(theEnv,WDISPLAY,(long long) EphemeralSymbolCount()); EnvPrintRouter(theEnv,WDISPLAY,"\n"); */ } #define COUNT_SIZE 21 /******************************************************/ /* PrimitiveTablesUsage: Prints information about the */ /* symbol, float, integer, and bitmap tables. */ /******************************************************/ globle void PrimitiveTablesUsage( void *theEnv) { unsigned long i; int symbolCounts[COUNT_SIZE], floatCounts[COUNT_SIZE]; SYMBOL_HN **symbolArray, *symbolPtr; FLOAT_HN **floatArray, *floatPtr; unsigned long int symbolCount, totalSymbolCount = 0; unsigned long int floatCount, totalFloatCount = 0; EnvArgCountCheck(theEnv,"primitives-usage",EXACTLY,0); for (i = 0; i < 21; i++) { symbolCounts[i] = 0; floatCounts[i] = 0; } /*====================================*/ /* Count entries in the symbol table. */ /*====================================*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { symbolCount = 0; for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { symbolCount++; totalSymbolCount++; } if (symbolCount < (COUNT_SIZE - 1)) { symbolCounts[symbolCount]++; } else { symbolCounts[COUNT_SIZE - 1]++; } } /*===================================*/ /* Count entries in the float table. */ /*===================================*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { floatCount = 0; for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { floatCount++; totalFloatCount++; } if (floatCount < (COUNT_SIZE - 1)) { floatCounts[floatCount]++; } else { floatCounts[COUNT_SIZE - 1]++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Total Symbols: "); PrintLongInteger(theEnv,WDISPLAY,(long long) totalSymbolCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long long) symbolCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } EnvPrintRouter(theEnv,WDISPLAY,"\nTotal Floats: "); PrintLongInteger(theEnv,WDISPLAY,(long long) totalFloatCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long long) floatCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT /***********************************************/ /* ValidateFactIntegrity: Command for checking */ /* the facts for atom value integrity. */ /***********************************************/ globle intBool ValidateFactIntegrity( void *theEnv) { struct fact *theFact; struct multifield *theSegment; int i; SYMBOL_HN *theSymbol; FLOAT_HN *theFloat; INTEGER_HN *theInteger; if (((struct environmentData *) theEnv)->initialized == FALSE) { return TRUE; } for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL); theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact)) { if (theFact->factHeader.busyCount <= 0) { return FALSE; } theSegment = &theFact->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { if ((theSegment->theFields[i].type == SYMBOL) || (theSegment->theFields[i].type == STRING) || (theSegment->theFields[i].type == INSTANCE_NAME)) { theSymbol = (SYMBOL_HN *) theSegment->theFields[i].value; if (theSymbol->count <= 0) { return FALSE; } } if (theSegment->theFields[i].type == INTEGER) { theInteger = (INTEGER_HN *) theSegment->theFields[i].value; if (theInteger->count <= 0) { return FALSE; } } if (theSegment->theFields[i].type == FLOAT) { theFloat = (FLOAT_HN *) theSegment->theFields[i].value; if (theFloat->count <= 0) { return FALSE; } } } } return TRUE; } /*******************************************************/ /* ShowFactPatternNetwork: Command for displaying the */ /* fact pattern network for a specified deftemplate. */ /*******************************************************/ globle void ShowFactPatternNetwork( void *theEnv) { struct factPatternNode *patternPtr; struct deftemplate *theDeftemplate; const char *theName; int depth = 0, i; theName = GetConstructName(theEnv,"show-fpn","template name"); if (theName == NULL) return; theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,theName); if (theDeftemplate == NULL) return; patternPtr = theDeftemplate->patternNetwork; while (patternPtr != NULL) { for (i = 0; i < depth; i++) EnvPrintRouter(theEnv,WDISPLAY," "); if (patternPtr->header.singlefieldNode) EnvPrintRouter(theEnv,WDISPLAY,"SF "); else if (patternPtr->header.multifieldNode) { EnvPrintRouter(theEnv,WDISPLAY,"MF"); if (patternPtr->header.endSlot) EnvPrintRouter(theEnv,WDISPLAY,")"); else EnvPrintRouter(theEnv,WDISPLAY,"*"); PrintLongInteger(theEnv,WDISPLAY,(long long) patternPtr->leaveFields); EnvPrintRouter(theEnv,WDISPLAY," "); } EnvPrintRouter(theEnv,WDISPLAY,"Slot: "); PrintLongInteger(theEnv,WDISPLAY,(long long) patternPtr->whichSlot); EnvPrintRouter(theEnv,WDISPLAY," Field: "); PrintLongInteger(theEnv,WDISPLAY,(long long) patternPtr->whichField); EnvPrintRouter(theEnv,WDISPLAY," Expression: "); if (patternPtr->networkTest == NULL) EnvPrintRouter(theEnv,WDISPLAY,"None"); else PrintExpression(theEnv,WDISPLAY,patternPtr->networkTest); EnvPrintRouter(theEnv,WDISPLAY," RightHash: "); if (patternPtr->header.rightHash == NULL) EnvPrintRouter(theEnv,WDISPLAY,"None"); else PrintExpression(theEnv,WDISPLAY,patternPtr->header.rightHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; depth--; if (patternPtr == NULL) return; } patternPtr = patternPtr->rightNode; } else { patternPtr = patternPtr->nextLevel; depth++; } } } #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM /*************************************************** NAME : PrintObjectPatternNetwork DESCRIPTION : Displays an indented printout of the object pattern network INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Object pattern network displayed NOTES : None ***************************************************/ globle void PrintObjectPatternNetwork( void *theEnv) { char indentbuf[80]; indentbuf[0] = '\0'; PrintOPNLevel(theEnv,ObjectNetworkPointer(theEnv),indentbuf,0); } /********************************************************** NAME : PrintOPNLevel DESCRIPTION : Recursivley prints object pattern network INPUTS : 1) The current object pattern network node 2) A buffer holding preceding indentation text showing the level in the tree 3) The length of the indentation text RETURNS : Nothing useful SIDE EFFECTS : Pattern nodes recursively printed NOTES : None **********************************************************/ static void PrintOPNLevel( void *theEnv, OBJECT_PATTERN_NODE *pptr, char *indentbuf, int ilen) { CLASS_BITMAP *cbmp; SLOT_BITMAP *sbmp; register unsigned i; OBJECT_PATTERN_NODE *uptr; OBJECT_ALPHA_NODE *alphaPtr; while (pptr != NULL) { EnvPrintRouter(theEnv,WDISPLAY,indentbuf); if (pptr->alphaNode != NULL) EnvPrintRouter(theEnv,WDISPLAY,"+"); EnvPrintRouter(theEnv,WDISPLAY,ValueToString(FindIDSlotName(theEnv,pptr->slotNameID))); EnvPrintRouter(theEnv,WDISPLAY," ("); PrintLongInteger(theEnv,WDISPLAY,(long long) pptr->slotNameID); EnvPrintRouter(theEnv,WDISPLAY,") "); EnvPrintRouter(theEnv,WDISPLAY,pptr->endSlot ? "EPF#" : "PF#"); PrintLongInteger(theEnv,WDISPLAY,(long long) pptr->whichField); EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,WDISPLAY,pptr->multifieldNode ? "$? " : "? "); if (pptr->networkTest != NULL) PrintExpression(theEnv,WDISPLAY,pptr->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); alphaPtr = pptr->alphaNode; while (alphaPtr != NULL) { EnvPrintRouter(theEnv,WDISPLAY,indentbuf); EnvPrintRouter(theEnv,WDISPLAY," Classes:"); cbmp = (CLASS_BITMAP *) ValueToBitMap(alphaPtr->classbmp); for (i = 0 ; i <= cbmp->maxid ; i++) if (TestBitMap(cbmp->map,i)) { EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefclassName(theEnv,(void *) DefclassData(theEnv)->ClassIDMap[i])); } if (alphaPtr->slotbmp != NULL) { sbmp = (SLOT_BITMAP *) ValueToBitMap(pptr->alphaNode->slotbmp); EnvPrintRouter(theEnv,WDISPLAY," *** Slots:"); for (i = NAME_ID ; i <= sbmp->maxid ; i++) if (TestBitMap(sbmp->map,i)) { for (uptr = pptr ; uptr != NULL ; uptr = uptr->lastLevel) if (uptr->slotNameID == i) break; if (uptr == NULL) { EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,WDISPLAY,ValueToString(FindIDSlotName(theEnv,i))); } } } if (alphaPtr->header.rightHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," RH: "); PrintExpression(theEnv,WDISPLAY,alphaPtr->header.rightHash); } EnvPrintRouter(theEnv,WDISPLAY,"\n"); alphaPtr = alphaPtr->nxtInGroup; } indentbuf[ilen++] = (char) ((pptr->rightNode != NULL) ? '|' : ' '); indentbuf[ilen++] = ' '; indentbuf[ilen++] = ' '; indentbuf[ilen] = '\0'; PrintOPNLevel(theEnv,pptr->nextLevel,indentbuf,ilen); ilen -= 3; indentbuf[ilen] = '\0'; pptr = pptr->rightNode; } } #endif #if OBJECT_SYSTEM /******************************************************/ /* InstanceTableUsage: Prints information about the */ /* instances in the instance hash table. */ /******************************************************/ globle void InstanceTableUsage( void *theEnv) { unsigned long i; int instanceCounts[COUNT_SIZE]; INSTANCE_TYPE *ins; unsigned long int instanceCount, totalInstanceCount = 0; EnvArgCountCheck(theEnv,"instance-table-usage",EXACTLY,0); for (i = 0; i < COUNT_SIZE; i++) { instanceCounts[i] = 0; } /*======================================*/ /* Count entries in the instance table. */ /*======================================*/ for (i = 0; i < INSTANCE_TABLE_HASH_SIZE; i++) { instanceCount = 0; for (ins = InstanceData(theEnv)->InstanceTable[i]; ins != NULL; ins = ins->nxtHash) { instanceCount++; totalInstanceCount++; } if (instanceCount < (COUNT_SIZE - 1)) { instanceCounts[instanceCount]++; } else { instanceCounts[COUNT_SIZE - 1]++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Total Instances: "); PrintLongInteger(theEnv,WDISPLAY,(long long) totalInstanceCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long long) instanceCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } #endif #if DEFRULE_CONSTRUCT /******************/ /* ExamineMemory: */ /******************/ static void ExamineMemory( void *theEnv, struct joinNode *theJoin, struct betaMemory *theMemory) { #if MAC_XCD #pragma unused(theJoin) #endif if (theMemory->size > 10000) { /* Set a break point here */ } } /*************************/ /* TraverseBetaMemories: */ /*************************/ static void TraverseBetaMemories( void *theEnv, struct joinNode *theJoin) { if (theJoin == NULL) { return; } if (theJoin->lastLevel != NULL) { TraverseBetaMemories(theEnv,theJoin->lastLevel); } if (theJoin->depth > 2) { ExamineMemory(theEnv,theJoin,theJoin->leftMemory); } if (theJoin->joinFromTheRight) { TraverseBetaMemories(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure); } if ((theJoin->joinFromTheRight) && (((struct joinNode *) (theJoin->rightSideEntryStructure))->depth > 1)) { ExamineMemory(theEnv,theJoin,theJoin->rightMemory); } } /***********************************/ /* ValidateRuleBetaMemoriesAction: */ /***********************************/ static void ValidateRuleBetaMemoriesAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct defrule *rulePtr, *tmpPtr; for (rulePtr = (struct defrule *) theConstruct, tmpPtr = rulePtr; rulePtr != NULL; rulePtr = rulePtr->disjunct) { TraverseBetaMemories(theEnv,rulePtr->lastJoin); } } /************************/ /* ValidateBetaMemories */ /************************/ globle void ValidateBetaMemories( void *theEnv) { EnvPrintRouter(theEnv,WPROMPT,"ValidateBetaMemories"); DoForAllConstructs(theEnv,ValidateRuleBetaMemoriesAction,DefruleData(theEnv)->DefruleModuleIndex,FALSE,NULL); } #endif #endif clips_core_source_630/core/._rulebin.c0000755000175000017500000000040712374024071016253 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/scanner.h0000755000175000017500000000577612373755544016071 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SCANNER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for scanning lexical tokens from an */ /* input source. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Added SetLineCount function. */ /* */ /* Added UTF-8 support. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_scanner #define _H_scanner struct token; #ifndef _H_pprint #include "pprint.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SCANNER_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct token { unsigned short type; void *value; const char *printForm; }; #define SCANNER_DATA 57 struct scannerData { char *GlobalString; size_t GlobalMax; size_t GlobalPos; long LineCount; int IgnoreCompletionErrors; }; #define ScannerData(theEnv) ((struct scannerData *) GetEnvironmentData(theEnv,SCANNER_DATA)) LOCALE void InitializeScannerData(void *); LOCALE void GetToken(void *,const char *,struct token *); LOCALE void CopyToken(struct token *,struct token *); LOCALE void ResetLineCount(void *); LOCALE long GetLineCount(void *); LOCALE long SetLineCount(void *,long); LOCALE void IncrementLineCount(void *); LOCALE void DecrementLineCount(void *); #endif /* _H_scanner */ clips_core_source_630/core/tmpltpsr.c0000755000175000017500000006524512461252211016272 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFTEMPLATE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses the deftemplate construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Support for deftemplate slot facets. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _TMPLTPSR_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "memalloc.h" #include "symbol.h" #include "scanner.h" #include "exprnpsr.h" #include "router.h" #include "constrct.h" #include "envrnmnt.h" #include "factmngr.h" #include "cstrnchk.h" #include "cstrnpsr.h" #include "cstrcpsr.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "default.h" #include "pattern.h" #include "watch.h" #include "cstrnutl.h" #include "tmpltdef.h" #include "tmpltbsc.h" #include "tmpltpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct templateSlot *SlotDeclarations(void *,const char *,struct token *); static struct templateSlot *ParseSlot(void *,const char *,struct token *,struct templateSlot *); static struct templateSlot *DefinedSlots(void *,const char *,SYMBOL_HN *,int,struct token *); static intBool ParseFacetAttribute(void *,const char *,struct templateSlot *,intBool); #endif /*******************************************************/ /* ParseDeftemplate: Parses the deftemplate construct. */ /*******************************************************/ globle int ParseDeftemplate( void *theEnv, const char *readSource) { #if (! RUN_TIME) && (! BLOAD_ONLY) SYMBOL_HN *deftemplateName; struct deftemplate *newDeftemplate; struct templateSlot *slots; struct token inputToken; /*================================================*/ /* Initialize pretty print and error information. */ /*================================================*/ DeftemplateData(theEnv)->DeftemplateError = FALSE; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(deftemplate "); /*==============================================================*/ /* Deftemplates can not be added when a binary image is loaded. */ /*==============================================================*/ #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"deftemplate"); return(TRUE); } #endif /*=======================================================*/ /* Parse the name and comment fields of the deftemplate. */ /*=======================================================*/ #if DEBUGGING_FUNCTIONS DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0; #endif deftemplateName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deftemplate", EnvFindDeftemplateInModule,EnvUndeftemplate,"%", TRUE,TRUE,TRUE,FALSE); if (deftemplateName == NULL) return(TRUE); if (ReservedPatternSymbol(theEnv,ValueToString(deftemplateName),"deftemplate")) { ReservedPatternSymbolErrorMsg(theEnv,ValueToString(deftemplateName),"a deftemplate name"); return(TRUE); } /*===========================================*/ /* Parse the slot fields of the deftemplate. */ /*===========================================*/ slots = SlotDeclarations(theEnv,readSource,&inputToken); if (DeftemplateData(theEnv)->DeftemplateError == TRUE) return(TRUE); /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deftemplate to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnSlots(theEnv,slots); return(FALSE); } /*=====================================*/ /* Create a new deftemplate structure. */ /*=====================================*/ newDeftemplate = get_struct(theEnv,deftemplate); newDeftemplate->header.name = deftemplateName; newDeftemplate->header.next = NULL; newDeftemplate->header.usrData = NULL; newDeftemplate->slotList = slots; newDeftemplate->implied = FALSE; newDeftemplate->numberOfSlots = 0; newDeftemplate->busyCount = 0; newDeftemplate->watch = 0; newDeftemplate->inScope = TRUE; newDeftemplate->patternNetwork = NULL; newDeftemplate->factList = NULL; newDeftemplate->lastFact = NULL; newDeftemplate->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex); /*================================*/ /* Determine the number of slots. */ /*================================*/ while (slots != NULL) { newDeftemplate->numberOfSlots++; slots = slots->next; } /*====================================*/ /* Store pretty print representation. */ /*====================================*/ if (EnvGetConserveMemory(theEnv) == TRUE) { newDeftemplate->header.ppForm = NULL; } else { newDeftemplate->header.ppForm = CopyPPBuffer(theEnv); } /*=======================================================================*/ /* If a template is redefined, then we want to restore its watch status. */ /*=======================================================================*/ #if DEBUGGING_FUNCTIONS if ((BitwiseTest(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0)) || EnvGetWatchItem(theEnv,"facts")) { EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); } #endif /*==============================================*/ /* Add deftemplate to the list of deftemplates. */ /*==============================================*/ AddConstructToModule(&newDeftemplate->header); InstallDeftemplate(theEnv,newDeftemplate); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif return(FALSE); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************************/ /* InstallDeftemplate: Increments all occurrences in the hash */ /* table of symbols found in an deftemplate and adds it to */ /* the hash table. */ /**************************************************************/ globle void InstallDeftemplate( void *theEnv, struct deftemplate *theDeftemplate) { struct templateSlot *slotPtr; struct expr *tempExpr; IncrementSymbolCount(theDeftemplate->header.name); for (slotPtr = theDeftemplate->slotList; slotPtr != NULL; slotPtr = slotPtr->next) { IncrementSymbolCount(slotPtr->slotName); tempExpr = AddHashedExpression(theEnv,slotPtr->defaultList); ReturnExpression(theEnv,slotPtr->defaultList); slotPtr->defaultList = tempExpr; tempExpr = AddHashedExpression(theEnv,slotPtr->facetList); ReturnExpression(theEnv,slotPtr->facetList); slotPtr->facetList = tempExpr; slotPtr->constraints = AddConstraint(theEnv,slotPtr->constraints); } } /********************************************************************/ /* SlotDeclarations: Parses the slot declarations of a deftemplate. */ /********************************************************************/ static struct templateSlot *SlotDeclarations( void *theEnv, const char *readSource, struct token *inputToken) { struct templateSlot *newSlot, *slotList = NULL, *lastSlot = NULL; struct templateSlot *multiSlot = NULL; while (inputToken->type != RPAREN) { /*====================================================*/ /* Slots begin with a '(' followed by a slot keyword. */ /*====================================================*/ if (inputToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"deftemplate"); ReturnSlots(theEnv,slotList); ReturnSlots(theEnv,multiSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate"); ReturnSlots(theEnv,slotList); ReturnSlots(theEnv,multiSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=================*/ /* Parse the slot. */ /*=================*/ newSlot = ParseSlot(theEnv,readSource,inputToken,slotList); if (DeftemplateData(theEnv)->DeftemplateError == TRUE) { ReturnSlots(theEnv,newSlot); ReturnSlots(theEnv,slotList); ReturnSlots(theEnv,multiSlot); return(NULL); } /*===========================================*/ /* Attach the new slot to the list of slots. */ /*===========================================*/ if (newSlot != NULL) { if (lastSlot == NULL) { slotList = newSlot; } else { lastSlot->next = newSlot; } lastSlot = newSlot; } /*================================*/ /* Check for closing parenthesis. */ /*================================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } } SavePPBuffer(theEnv,"\n"); /*=======================*/ /* Return the slot list. */ /*=======================*/ return(slotList); } /*****************************************************/ /* ParseSlot: Parses a single slot of a deftemplate. */ /*****************************************************/ static struct templateSlot *ParseSlot( void *theEnv, const char *readSource, struct token *inputToken, struct templateSlot *slotList) { int parsingMultislot; SYMBOL_HN *slotName; struct templateSlot *newSlot; int rv; /*=====================================================*/ /* Slots must begin with keyword field or multifield. */ /*=====================================================*/ if ((strcmp(ValueToString(inputToken->value),"field") != 0) && (strcmp(ValueToString(inputToken->value),"multifield") != 0) && (strcmp(ValueToString(inputToken->value),"slot") != 0) && (strcmp(ValueToString(inputToken->value),"multislot") != 0)) { SyntaxErrorMessage(theEnv,"deftemplate"); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*===============================================*/ /* Determine if multifield slot is being parsed. */ /*===============================================*/ if ((strcmp(ValueToString(inputToken->value),"multifield") == 0) || (strcmp(ValueToString(inputToken->value),"multislot") == 0)) { parsingMultislot = TRUE; } else { parsingMultislot = FALSE; } /*========================================*/ /* The name of the slot must be a symbol. */ /*========================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate"); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } slotName = (SYMBOL_HN *) inputToken->value; /*================================================*/ /* Determine if the slot has already been parsed. */ /*================================================*/ while (slotList != NULL) { if (slotList->slotName == slotName) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(slotList->slotName)); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } slotList = slotList->next; } /*===================================*/ /* Parse the attributes of the slot. */ /*===================================*/ newSlot = DefinedSlots(theEnv,readSource,slotName,parsingMultislot,inputToken); if (newSlot == NULL) { DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=================================*/ /* Check for slot conflict errors. */ /*=================================*/ if (CheckConstraintParseConflicts(theEnv,newSlot->constraints) == FALSE) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } if ((newSlot->defaultPresent) || (newSlot->defaultDynamic)) { rv = ConstraintCheckExpressionChain(theEnv,newSlot->defaultList,newSlot->constraints); } else { rv = NO_VIOLATION; } if ((rv != NO_VIOLATION) && EnvGetStaticConstraintChecking(theEnv)) { const char *temp; if (newSlot->defaultDynamic) temp = "the default-dynamic attribute"; else temp = "the default attribute"; ConstraintViolationErrorMessage(theEnv,"An expression",temp,FALSE,0, newSlot->slotName,0,rv,newSlot->constraints,TRUE); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*==================*/ /* Return the slot. */ /*==================*/ return(newSlot); } /**************************************************************/ /* DefinedSlots: Parses a field or multifield slot attribute. */ /**************************************************************/ static struct templateSlot *DefinedSlots( void *theEnv, const char *readSource, SYMBOL_HN *slotName, int multifieldSlot, struct token *inputToken) { struct templateSlot *newSlot; struct expr *defaultList; int defaultFound = FALSE; int noneSpecified, deriveSpecified; CONSTRAINT_PARSE_RECORD parsedConstraints; /*===========================*/ /* Build the slot container. */ /*===========================*/ newSlot = get_struct(theEnv,templateSlot); newSlot->slotName = slotName; newSlot->defaultList = NULL; newSlot->facetList = NULL; newSlot->constraints = GetConstraintRecord(theEnv); if (multifieldSlot) { newSlot->constraints->multifieldsAllowed = TRUE; } newSlot->multislot = multifieldSlot; newSlot->noDefault = FALSE; newSlot->defaultPresent = FALSE; newSlot->defaultDynamic = FALSE; newSlot->next = NULL; /*========================================*/ /* Parse the primitive slot if it exists. */ /*========================================*/ InitializeConstraintParseRecord(&parsedConstraints); GetToken(theEnv,readSource,inputToken); while (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,inputToken->printForm); /*================================================*/ /* Slot attributes begin with a left parenthesis. */ /*================================================*/ if (inputToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"deftemplate"); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=============================================*/ /* The name of the attribute must be a symbol. */ /*=============================================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate"); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*================================================================*/ /* Determine if the attribute is one of the standard constraints. */ /*================================================================*/ if (StandardConstraint(ValueToString(inputToken->value))) { if (ParseStandardConstraint(theEnv,readSource,(ValueToString(inputToken->value)), newSlot->constraints,&parsedConstraints, multifieldSlot) == FALSE) { DeftemplateData(theEnv)->DeftemplateError = TRUE; ReturnSlots(theEnv,newSlot); return(NULL); } } /*=================================================*/ /* else if the attribute is the default attribute, */ /* then get the default list for this slot. */ /*=================================================*/ else if ((strcmp(ValueToString(inputToken->value),"default") == 0) || (strcmp(ValueToString(inputToken->value),"default-dynamic") == 0)) { /*======================================================*/ /* Check to see if the default has already been parsed. */ /*======================================================*/ if (defaultFound) { AlreadyParsedErrorMessage(theEnv,"default attribute",NULL); DeftemplateData(theEnv)->DeftemplateError = TRUE; ReturnSlots(theEnv,newSlot); return(NULL); } newSlot->noDefault = FALSE; /*=====================================================*/ /* Determine whether the default is dynamic or static. */ /*=====================================================*/ if (strcmp(ValueToString(inputToken->value),"default") == 0) { newSlot->defaultPresent = TRUE; newSlot->defaultDynamic = FALSE; } else { newSlot->defaultPresent = FALSE; newSlot->defaultDynamic = TRUE; } /*===================================*/ /* Parse the list of default values. */ /*===================================*/ defaultList = ParseDefault(theEnv,readSource,multifieldSlot,(int) newSlot->defaultDynamic, TRUE,&noneSpecified,&deriveSpecified,&DeftemplateData(theEnv)->DeftemplateError); if (DeftemplateData(theEnv)->DeftemplateError == TRUE) { ReturnSlots(theEnv,newSlot); return(NULL); } /*==================================*/ /* Store the default with the slot. */ /*==================================*/ defaultFound = TRUE; if (deriveSpecified) newSlot->defaultPresent = FALSE; else if (noneSpecified) { newSlot->noDefault = TRUE; newSlot->defaultPresent = FALSE; } newSlot->defaultList = defaultList; } /*===============================================*/ /* else if the attribute is the facet attribute. */ /*===============================================*/ else if (strcmp(ValueToString(inputToken->value),"facet") == 0) { if (! ParseFacetAttribute(theEnv,readSource,newSlot,FALSE)) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } } else if (strcmp(ValueToString(inputToken->value),"multifacet") == 0) { if (! ParseFacetAttribute(theEnv,readSource,newSlot,TRUE)) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } } /*============================================*/ /* Otherwise the attribute is an invalid one. */ /*============================================*/ else { SyntaxErrorMessage(theEnv,"slot attributes"); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*===================================*/ /* Begin parsing the next attribute. */ /*===================================*/ GetToken(theEnv,readSource,inputToken); } /*============================*/ /* Return the attribute list. */ /*============================*/ return(newSlot); } /***************************************************/ /* ParseFacetAttribute: Parses the type attribute. */ /***************************************************/ static intBool ParseFacetAttribute( void *theEnv, const char *readSource, struct templateSlot *theSlot, intBool multifacet) { struct token inputToken; SYMBOL_HN *facetName; struct expr *facetPair, *tempFacet, *facetValue = NULL, *lastValue = NULL; /*==============================*/ /* Parse the name of the facet. */ /*==============================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); /*==================================*/ /* The facet name must be a symbol. */ /*==================================*/ if (inputToken.type != SYMBOL) { if (multifacet) SyntaxErrorMessage(theEnv,"multifacet attribute"); else SyntaxErrorMessage(theEnv,"facet attribute"); return(FALSE); } facetName = (SYMBOL_HN *) inputToken.value; /*===================================*/ /* Don't allow facets with the same */ /* name as a predefined CLIPS facet. */ /*===================================*/ /*====================================*/ /* Has the facet already been parsed? */ /*====================================*/ for (tempFacet = theSlot->facetList; tempFacet != NULL; tempFacet = tempFacet->nextArg) { if (tempFacet->value == facetName) { if (multifacet) AlreadyParsedErrorMessage(theEnv,"multifacet ",ValueToString(facetName)); else AlreadyParsedErrorMessage(theEnv,"facet ",ValueToString(facetName)); return(FALSE); } } /*===============================*/ /* Parse the value of the facet. */ /*===============================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); while (inputToken.type != RPAREN) { /*=====================================*/ /* The facet value must be a constant. */ /*=====================================*/ if (! ConstantType(inputToken.type)) { if (multifacet) SyntaxErrorMessage(theEnv,"multifacet attribute"); else SyntaxErrorMessage(theEnv,"facet attribute"); ReturnExpression(theEnv,facetValue); return(FALSE); } /*======================================*/ /* Add the value to the list of values. */ /*======================================*/ if (lastValue == NULL) { facetValue = GenConstant(theEnv,inputToken.type,inputToken.value); lastValue = facetValue; } else { lastValue->nextArg = GenConstant(theEnv,inputToken.type,inputToken.value); lastValue = lastValue->nextArg; } /*=====================*/ /* Get the next token. */ /*=====================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); /*===============================================*/ /* A facet can't contain more than one constant. */ /*===============================================*/ if ((! multifacet) && (inputToken.type != RPAREN)) { SyntaxErrorMessage(theEnv,"facet attribute"); ReturnExpression(theEnv,facetValue); return(FALSE); } } /*========================================================*/ /* Remove the space before the closing right parenthesis. */ /*========================================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*====================================*/ /* A facet must contain one constant. */ /*====================================*/ if ((! multifacet) && (facetValue == NULL)) { SyntaxErrorMessage(theEnv,"facet attribute"); return(FALSE); } /*=================================================*/ /* Add the facet to the list of the slot's facets. */ /*=================================================*/ facetPair = GenConstant(theEnv,SYMBOL,facetName); if (multifacet) { facetPair->argList = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); facetPair->argList->argList = facetValue; } else { facetPair->argList = facetValue; } facetPair->nextArg = theSlot->facetList; theSlot->facetList = facetPair; /*===============================================*/ /* The facet/multifacet was successfully parsed. */ /*===============================================*/ return(TRUE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/._strngrtr.h0000755000175000017500000000040712373755532016521 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._insfile.c0000755000175000017500000000040712464554105016252 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/constrnt.c0000755000175000017500000005614112373714236016266 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for creating and removing */ /* constraint records, adding them to the contraint hash */ /* table, and enabling and disabling static and dynamic */ /* constraint checking. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Changed integer type/precision. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _CONSTRNT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "argacces.h" #include "constant.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "multifld.h" #include "router.h" #include "scanner.h" #include "constrnt.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void InstallConstraintRecord(void *,CONSTRAINT_RECORD *); static int ConstraintCompare(struct constraintRecord *,struct constraintRecord *); #endif #if (! RUN_TIME) static void ReturnConstraintRecord(void *,CONSTRAINT_RECORD *); static void DeinstallConstraintRecord(void *,CONSTRAINT_RECORD *); #endif static void DeallocateConstraintData(void *); /*****************************************************/ /* InitializeConstraints: Initializes the constraint */ /* hash table to NULL and defines the static and */ /* dynamic constraint access functions. */ /*****************************************************/ globle void InitializeConstraints( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) int i; #endif AllocateEnvironmentData(theEnv,CONSTRAINT_DATA,sizeof(struct constraintData),DeallocateConstraintData); ConstraintData(theEnv)->StaticConstraintChecking = TRUE; #if (! RUN_TIME) && (! BLOAD_ONLY) ConstraintData(theEnv)->ConstraintHashtable = (struct constraintRecord **) gm2(theEnv,(int) sizeof (struct constraintRecord *) * SIZE_CONSTRAINT_HASH); if (ConstraintData(theEnv)->ConstraintHashtable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE); for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) ConstraintData(theEnv)->ConstraintHashtable[i] = NULL; #endif #if (! RUN_TIME) EnvDefineFunction2(theEnv,"get-dynamic-constraint-checking",'b',GDCCommand,"GDCCommand", "00"); EnvDefineFunction2(theEnv,"set-dynamic-constraint-checking",'b',SDCCommand,"SDCCommand", "11"); EnvDefineFunction2(theEnv,"get-static-constraint-checking",'b',GSCCommand,"GSCCommand", "00"); EnvDefineFunction2(theEnv,"set-static-constraint-checking",'b',SSCCommand,"SSCCommand", "11"); #endif } /*****************************************************/ /* DeallocateConstraintData: Deallocates environment */ /* data for constraints. */ /*****************************************************/ static void DeallocateConstraintData( void *theEnv) { #if ! RUN_TIME struct constraintRecord *tmpPtr, *nextPtr; int i; for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) { tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; ReturnConstraintRecord(theEnv,tmpPtr); tmpPtr = nextPtr; } } rm(theEnv,ConstraintData(theEnv)->ConstraintHashtable, (int) sizeof (struct constraintRecord *) * SIZE_CONSTRAINT_HASH); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) if (ConstraintData(theEnv)->NumberOfConstraints != 0) { genfree(theEnv,(void *) ConstraintData(theEnv)->ConstraintArray, (sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); } #endif } #if (! RUN_TIME) /*************************************************************/ /* ReturnConstraintRecord: Frees the data structures used by */ /* a constraint record. If the returnOnlyFields argument */ /* is FALSE, then the constraint record is also freed. */ /*************************************************************/ static void ReturnConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints) { if (constraints == NULL) return; if (constraints->bucket < 0) { ReturnExpression(theEnv,constraints->classList); ReturnExpression(theEnv,constraints->restrictionList); ReturnExpression(theEnv,constraints->maxValue); ReturnExpression(theEnv,constraints->minValue); ReturnExpression(theEnv,constraints->minFields); ReturnExpression(theEnv,constraints->maxFields); } ReturnConstraintRecord(theEnv,constraints->multifield); rtn_struct(theEnv,constraintRecord,constraints); } /***************************************************/ /* DeinstallConstraintRecord: Decrements the count */ /* values of all occurrences of primitive data */ /* types found in a constraint record. */ /***************************************************/ static void DeinstallConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints) { if (constraints->bucket >= 0) { RemoveHashedExpression(theEnv,constraints->classList); RemoveHashedExpression(theEnv,constraints->restrictionList); RemoveHashedExpression(theEnv,constraints->maxValue); RemoveHashedExpression(theEnv,constraints->minValue); RemoveHashedExpression(theEnv,constraints->minFields); RemoveHashedExpression(theEnv,constraints->maxFields); } else { ExpressionDeinstall(theEnv,constraints->classList); ExpressionDeinstall(theEnv,constraints->restrictionList); ExpressionDeinstall(theEnv,constraints->maxValue); ExpressionDeinstall(theEnv,constraints->minValue); ExpressionDeinstall(theEnv,constraints->minFields); ExpressionDeinstall(theEnv,constraints->maxFields); } if (constraints->multifield != NULL) { DeinstallConstraintRecord(theEnv,constraints->multifield); } } /******************************************/ /* RemoveConstraint: Removes a constraint */ /* from the constraint hash table. */ /******************************************/ globle void RemoveConstraint( void *theEnv, struct constraintRecord *theConstraint) { struct constraintRecord *tmpPtr, *prevPtr = NULL; if (theConstraint == NULL) return; /*========================================*/ /* If the bucket value is less than zero, */ /* then the constraint wasn't stored in */ /* the hash table. */ /*========================================*/ if (theConstraint->bucket < 0) { ReturnConstraintRecord(theEnv,theConstraint); return; } /*================================*/ /* Find and remove the constraint */ /* from the contraint hash table. */ /*================================*/ tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[theConstraint->bucket]; while (tmpPtr != NULL) { if (tmpPtr == theConstraint) { theConstraint->count--; if (theConstraint->count == 0) { if (prevPtr == NULL) { ConstraintData(theEnv)->ConstraintHashtable[theConstraint->bucket] = theConstraint->next; } else { prevPtr->next = theConstraint->next; } DeinstallConstraintRecord(theEnv,theConstraint); ReturnConstraintRecord(theEnv,theConstraint); } return; } prevPtr = tmpPtr; tmpPtr = tmpPtr->next; } return; } #endif /* (! RUN_TIME) */ #if (! RUN_TIME) && (! BLOAD_ONLY) /***********************************/ /* HashConstraint: Returns a hash */ /* value for a given constraint. */ /***********************************/ globle unsigned long HashConstraint( struct constraintRecord *theConstraint) { int i = 0; unsigned long count = 0; unsigned long hashValue; struct expr *tmpPtr; count += (unsigned long) (theConstraint->anyAllowed * 17) + (theConstraint->symbolsAllowed * 5) + (theConstraint->stringsAllowed * 23) + (theConstraint->floatsAllowed * 19) + (theConstraint->integersAllowed * 29) + (theConstraint->instanceNamesAllowed * 31) + (theConstraint->instanceAddressesAllowed * 17); count += (unsigned long) (theConstraint->externalAddressesAllowed * 29) + (theConstraint->voidAllowed * 29) + (theConstraint->multifieldsAllowed * 29) + (theConstraint->factAddressesAllowed * 79) + (theConstraint->anyRestriction * 59) + (theConstraint->symbolRestriction * 61); count += (unsigned long) (theConstraint->stringRestriction * 3) + (theConstraint->floatRestriction * 37) + (theConstraint->integerRestriction * 9) + (theConstraint->classRestriction * 11) + (theConstraint->instanceNameRestriction * 7); for (tmpPtr = theConstraint->classList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->restrictionList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->minValue; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->maxValue; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->minFields; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->maxFields; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } if (theConstraint->multifield != NULL) { count += HashConstraint(theConstraint->multifield); } hashValue = (unsigned long) (count % SIZE_CONSTRAINT_HASH); return(hashValue); } /**********************************************/ /* ConstraintCompare: Compares two constraint */ /* records and returns TRUE if they are */ /* identical, otherwise FALSE. */ /**********************************************/ static int ConstraintCompare( struct constraintRecord *constraint1, struct constraintRecord *constraint2) { struct expr *tmpPtr1, *tmpPtr2; if ((constraint1->anyAllowed != constraint2->anyAllowed) || (constraint1->symbolsAllowed != constraint2->symbolsAllowed) || (constraint1->stringsAllowed != constraint2->stringsAllowed) || (constraint1->floatsAllowed != constraint2->floatsAllowed) || (constraint1->integersAllowed != constraint2->integersAllowed) || (constraint1->instanceNamesAllowed != constraint2->instanceNamesAllowed) || (constraint1->instanceAddressesAllowed != constraint2->instanceAddressesAllowed) || (constraint1->externalAddressesAllowed != constraint2->externalAddressesAllowed) || (constraint1->voidAllowed != constraint2->voidAllowed) || (constraint1->multifieldsAllowed != constraint2->multifieldsAllowed) || (constraint1->singlefieldsAllowed != constraint2->singlefieldsAllowed) || (constraint1->factAddressesAllowed != constraint2->factAddressesAllowed) || (constraint1->anyRestriction != constraint2->anyRestriction) || (constraint1->symbolRestriction != constraint2->symbolRestriction) || (constraint1->stringRestriction != constraint2->stringRestriction) || (constraint1->floatRestriction != constraint2->floatRestriction) || (constraint1->integerRestriction != constraint2->integerRestriction) || (constraint1->classRestriction != constraint2->classRestriction) || (constraint1->instanceNameRestriction != constraint2->instanceNameRestriction)) { return(FALSE); } for (tmpPtr1 = constraint1->classList, tmpPtr2 = constraint2->classList; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->restrictionList, tmpPtr2 = constraint2->restrictionList; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->minValue, tmpPtr2 = constraint2->minValue; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->maxValue, tmpPtr2 = constraint2->maxValue; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->minFields, tmpPtr2 = constraint2->minFields; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->maxFields, tmpPtr2 = constraint2->maxFields; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); if (((constraint1->multifield == NULL) && (constraint2->multifield != NULL)) || ((constraint1->multifield != NULL) && (constraint2->multifield == NULL))) { return(FALSE); } else if (constraint1->multifield == constraint2->multifield) { return(TRUE); } return(ConstraintCompare(constraint1->multifield,constraint2->multifield)); } /************************************/ /* AddConstraint: Adds a constraint */ /* to the constraint hash table. */ /************************************/ globle struct constraintRecord *AddConstraint( void *theEnv, struct constraintRecord *theConstraint) { struct constraintRecord *tmpPtr; unsigned long hashValue; if (theConstraint == NULL) return(NULL); hashValue = HashConstraint(theConstraint); for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[hashValue]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { if (ConstraintCompare(theConstraint,tmpPtr)) { tmpPtr->count++; ReturnConstraintRecord(theEnv,theConstraint); return(tmpPtr); } } InstallConstraintRecord(theEnv,theConstraint); theConstraint->count = 1; theConstraint->bucket = hashValue; theConstraint->next = ConstraintData(theEnv)->ConstraintHashtable[hashValue]; ConstraintData(theEnv)->ConstraintHashtable[hashValue] = theConstraint; return(theConstraint); } /*************************************************/ /* InstallConstraintRecord: Increments the count */ /* values of all occurrences of primitive data */ /* types found in a constraint record. */ /*************************************************/ static void InstallConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints) { struct expr *tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->classList); ReturnExpression(theEnv,constraints->classList); constraints->classList = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->restrictionList); ReturnExpression(theEnv,constraints->restrictionList); constraints->restrictionList = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->maxValue); ReturnExpression(theEnv,constraints->maxValue); constraints->maxValue = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->minValue); ReturnExpression(theEnv,constraints->minValue); constraints->minValue = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->minFields); ReturnExpression(theEnv,constraints->minFields); constraints->minFields = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->maxFields); ReturnExpression(theEnv,constraints->maxFields); constraints->maxFields = tempExpr; if (constraints->multifield != NULL) { InstallConstraintRecord(theEnv,constraints->multifield); } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /**********************************************/ /* SDCCommand: H/L access routine for the */ /* set-dynamic-constraint-checking command. */ /**********************************************/ globle int SDCCommand( void *theEnv) { int oldValue; DATA_OBJECT arg_ptr; oldValue = EnvGetDynamicConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"set-dynamic-constraint-checking",EXACTLY,1) == -1) { return(oldValue); } EnvRtnUnknown(theEnv,1,&arg_ptr); if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL)) { EnvSetDynamicConstraintChecking(theEnv,FALSE); } else { EnvSetDynamicConstraintChecking(theEnv,TRUE); } return(oldValue); } /**********************************************/ /* GDCCommand: H/L access routine for the */ /* get-dynamic-constraint-checking command. */ /**********************************************/ globle int GDCCommand( void *theEnv) { int oldValue; oldValue = EnvGetDynamicConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"get-dynamic-constraint-checking",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /*********************************************/ /* SSCCommand: H/L access routine for the */ /* set-static-constraint-checking command. */ /*********************************************/ globle int SSCCommand( void *theEnv) { int oldValue; DATA_OBJECT arg_ptr; oldValue = EnvGetStaticConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"set-static-constraint-checking",EXACTLY,1) == -1) { return(oldValue); } EnvRtnUnknown(theEnv,1,&arg_ptr); if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL)) { EnvSetStaticConstraintChecking(theEnv,FALSE); } else { EnvSetStaticConstraintChecking(theEnv,TRUE); } return(oldValue); } /*********************************************/ /* GSCCommand: H/L access routine for the */ /* get-static-constraint-checking command. */ /*********************************************/ globle int GSCCommand( void *theEnv) { int oldValue; oldValue = EnvGetStaticConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"get-static-constraint-checking",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /******************************************************/ /* EnvSetDynamicConstraintChecking: C access routine */ /* for the set-dynamic-constraint-checking command. */ /******************************************************/ globle intBool EnvSetDynamicConstraintChecking( void *theEnv, int value) { int ov; ov = ConstraintData(theEnv)->DynamicConstraintChecking; ConstraintData(theEnv)->DynamicConstraintChecking = value; return(ov); } /******************************************************/ /* EnvGetDynamicConstraintChecking: C access routine */ /* for the get-dynamic-constraint-checking command. */ /******************************************************/ globle intBool EnvGetDynamicConstraintChecking( void *theEnv) { return(ConstraintData(theEnv)->DynamicConstraintChecking); } /*****************************************************/ /* EnvSetStaticConstraintChecking: C access routine */ /* for the set-static-constraint-checking command. */ /*****************************************************/ globle intBool EnvSetStaticConstraintChecking( void *theEnv, int value) { int ov; ov = ConstraintData(theEnv)->StaticConstraintChecking; ConstraintData(theEnv)->StaticConstraintChecking = value; return(ov); } /*****************************************************/ /* EnvGetStaticConstraintChecking: C access routine */ /* for the get-static-constraint-checking command. */ /*****************************************************/ globle intBool EnvGetStaticConstraintChecking( void *theEnv) { return(ConstraintData(theEnv)->StaticConstraintChecking); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool SetDynamicConstraintChecking( int value) { return EnvSetDynamicConstraintChecking(GetCurrentEnvironment(),value); } globle intBool GetDynamicConstraintChecking() { return EnvGetDynamicConstraintChecking(GetCurrentEnvironment()); } globle intBool SetStaticConstraintChecking( int value) { return EnvSetStaticConstraintChecking(GetCurrentEnvironment(),value); } globle intBool GetStaticConstraintChecking() { return EnvGetStaticConstraintChecking(GetCurrentEnvironment()); } #endif clips_core_source_630/core/modulbin.h0000755000175000017500000000501412373756454016233 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_modulbin #define _H_modulbin #ifndef _H_moduldef #include "moduldef.h" #endif struct bsaveDefmodule { unsigned long name; long importList; long exportList; long next; long bsaveID; }; struct bsaveDefmoduleItemHeader { long theModule; long firstItem; long lastItem; }; struct bsavePortItem { long moduleName; long constructType; long constructName; long next; }; #define ModulePointer(i) ((struct defmodule *) (&DefmoduleData(theEnv)->DefmoduleArray[i])) #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefmoduleBinarySetup(void *); LOCALE void UpdateDefmoduleItemHeader (void *,struct bsaveDefmoduleItemHeader *, struct defmoduleItemHeader *,int,void *); #if BLOAD_AND_BSAVE LOCALE void AssignBsaveDefmdlItemHdrVals (struct bsaveDefmoduleItemHeader *, struct defmoduleItemHeader *); #endif #endif /* _H_modulbin */ clips_core_source_630/core/._factrete.h0000755000175000017500000000040712373742636016432 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factcom.h0000755000175000017500000000040712464554105016242 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/pattern.c0000755000175000017500000013172212365012260016055 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 07/25/14 */ /* */ /* RULE PATTERN MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the mechanism for recognizing and */ /* parsing the various types of patterns that can be used */ /* in the LHS of a rule. In version 6.0, the only pattern */ /* types provided are for deftemplate and instance */ /* patterns. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _PATTERN_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #if DEFRULE_CONSTRUCT #include "constant.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "match.h" #include "memalloc.h" #include "reteutil.h" #include "router.h" #include "rulecmp.h" #include "pattern.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct lhsParseNode *ConjuctiveRestrictionParse(void *,const char *,struct token *,int *); static struct lhsParseNode *LiteralRestrictionParse(void *,const char *,struct token *,int *); static int CheckForVariableMixing(void *,struct lhsParseNode *); static void TallyFieldTypes(struct lhsParseNode *); #endif static void DeallocatePatternData(void *); static struct patternNodeHashEntry **CreatePatternHashTable(void *,unsigned long); /*****************************************************************************/ /* InitializePatterns: Initializes the global data associated with patterns. */ /*****************************************************************************/ globle void InitializePatterns( void *theEnv) { AllocateEnvironmentData(theEnv,PATTERN_DATA,sizeof(struct patternData),DeallocatePatternData); PatternData(theEnv)->NextPosition = 1; PatternData(theEnv)->PatternHashTable = CreatePatternHashTable(theEnv,SIZE_PATTERN_HASH); PatternData(theEnv)->PatternHashTableSize = SIZE_PATTERN_HASH; } /*******************************************************************/ /* CreatePatternHashTable: Creates and initializes a fact hash table. */ /*******************************************************************/ static struct patternNodeHashEntry **CreatePatternHashTable( void *theEnv, unsigned long tableSize) { unsigned long i; struct patternNodeHashEntry **theTable; theTable = (struct patternNodeHashEntry **) gm3(theEnv,sizeof (struct patternNodeHashEntry *) * tableSize); if (theTable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE); for (i = 0; i < tableSize; i++) theTable[i] = NULL; return(theTable); } /**************************************************/ /* DeallocatePatternData: Deallocates environment */ /* data for rule pattern registration. */ /**************************************************/ static void DeallocatePatternData( void *theEnv) { struct reservedSymbol *tmpRSPtr, *nextRSPtr; struct patternParser *tmpPPPtr, *nextPPPtr; struct patternNodeHashEntry *tmpPNEPtr, *nextPNEPtr; unsigned long i; tmpRSPtr = PatternData(theEnv)->ListOfReservedPatternSymbols; while (tmpRSPtr != NULL) { nextRSPtr = tmpRSPtr->next; rtn_struct(theEnv,reservedSymbol,tmpRSPtr); tmpRSPtr = nextRSPtr; } tmpPPPtr = PatternData(theEnv)->ListOfPatternParsers; while (tmpPPPtr != NULL) { nextPPPtr = tmpPPPtr->next; rtn_struct(theEnv,patternParser,tmpPPPtr); tmpPPPtr = nextPPPtr; } for (i = 0; i < PatternData(theEnv)->PatternHashTableSize; i++) { tmpPNEPtr = PatternData(theEnv)->PatternHashTable[i]; while (tmpPNEPtr != NULL) { nextPNEPtr = tmpPNEPtr->next; rtn_struct(theEnv,patternNodeHashEntry,tmpPNEPtr); tmpPNEPtr = nextPNEPtr; } } rm3(theEnv,PatternData(theEnv)->PatternHashTable, sizeof(struct patternNodeHashEntry *) * PatternData(theEnv)->PatternHashTableSize); } /******************************************************************************/ /* AddHashedPatternNode: Adds a pattern node entry to the pattern hash table. */ /******************************************************************************/ globle void AddHashedPatternNode( void *theEnv, void *parent, void *child, unsigned short keyType, void *keyValue) { unsigned long hashValue; struct patternNodeHashEntry *newhash, *temp; hashValue = GetAtomicHashValue(keyType,keyValue,1) + HashExternalAddress(parent,0); /* TBD mult * 30 */ newhash = get_struct(theEnv,patternNodeHashEntry); newhash->parent = parent; newhash->child = child; newhash->type = keyType; newhash->value = keyValue; hashValue = (hashValue % PatternData(theEnv)->PatternHashTableSize); temp = PatternData(theEnv)->PatternHashTable[hashValue]; PatternData(theEnv)->PatternHashTable[hashValue] = newhash; newhash->next = temp; } /***************************************************/ /* RemoveHashedPatternNode: Removes a pattern node */ /* entry from the pattern node hash table. */ /***************************************************/ globle intBool RemoveHashedPatternNode( void *theEnv, void *parent, void *child, unsigned short keyType, void *keyValue) { unsigned long hashValue; struct patternNodeHashEntry *hptr, *prev; hashValue = GetAtomicHashValue(keyType,keyValue,1) + HashExternalAddress(parent,0); /* TBD mult * 30 */ hashValue = (hashValue % PatternData(theEnv)->PatternHashTableSize); for (hptr = PatternData(theEnv)->PatternHashTable[hashValue], prev = NULL; hptr != NULL; hptr = hptr->next) { if (hptr->child == child) { if (prev == NULL) { PatternData(theEnv)->PatternHashTable[hashValue] = hptr->next; rtn_struct(theEnv,patternNodeHashEntry,hptr); return(1); } else { prev->next = hptr->next; rtn_struct(theEnv,patternNodeHashEntry,hptr); return(1); } } prev = hptr; } return(0); } /***********************************************/ /* FindHashedPatternNode: Finds a pattern node */ /* entry in the pattern node hash table. */ /***********************************************/ globle void *FindHashedPatternNode( void *theEnv, void *parent, unsigned short keyType, void *keyValue) { unsigned long hashValue; struct patternNodeHashEntry *hptr; hashValue = GetAtomicHashValue(keyType,keyValue,1) + HashExternalAddress(parent,0); /* TBD mult * 30 */ hashValue = (hashValue % PatternData(theEnv)->PatternHashTableSize); for (hptr = PatternData(theEnv)->PatternHashTable[hashValue]; hptr != NULL; hptr = hptr->next) { if ((hptr->parent == parent) && (keyType == hptr->type) && (keyValue == hptr->value)) { return(hptr->child); } } return(NULL); } /******************************************************************/ /* AddReservedPatternSymbol: Adds a symbol to the list of symbols */ /* that are restricted for use in patterns. For example, the */ /* deftemplate construct cannot use the symbol "object", since */ /* this needs to be reserved for object patterns. Some symbols, */ /* such as "exists" are completely reserved and can not be used */ /* to start any type of pattern CE. */ /******************************************************************/ void AddReservedPatternSymbol( void *theEnv, const char *theSymbol, const char *reservedBy) { struct reservedSymbol *newSymbol; newSymbol = get_struct(theEnv,reservedSymbol); newSymbol->theSymbol = theSymbol; newSymbol->reservedBy = reservedBy; newSymbol->next = PatternData(theEnv)->ListOfReservedPatternSymbols; PatternData(theEnv)->ListOfReservedPatternSymbols = newSymbol; } /******************************************************************/ /* ReservedPatternSymbol: Returns TRUE if the specified symbol is */ /* a reserved pattern symbol, otherwise FALSE is returned. If */ /* the construct which is trying to use the symbol is the same */ /* construct that reserved the symbol, then FALSE is returned. */ /******************************************************************/ intBool ReservedPatternSymbol( void *theEnv, const char *theSymbol, const char *checkedBy) { struct reservedSymbol *currentSymbol; for (currentSymbol = PatternData(theEnv)->ListOfReservedPatternSymbols; currentSymbol != NULL; currentSymbol = currentSymbol->next) { if (strcmp(theSymbol,currentSymbol->theSymbol) == 0) { if ((currentSymbol->reservedBy == NULL) || (checkedBy == NULL)) { return(TRUE); } if (strcmp(checkedBy,currentSymbol->reservedBy) == 0) return(FALSE); return(TRUE); } } return(FALSE); } /********************************************************/ /* ReservedPatternSymbolErrorMsg: Generic error message */ /* for attempting to use a reserved pattern symbol. */ /********************************************************/ void ReservedPatternSymbolErrorMsg( void *theEnv, const char *theSymbol, const char *usedFor) { PrintErrorID(theEnv,"PATTERN",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The symbol "); EnvPrintRouter(theEnv,WERROR,theSymbol); EnvPrintRouter(theEnv,WERROR," has special meaning\n"); EnvPrintRouter(theEnv,WERROR,"and may not be used as "); EnvPrintRouter(theEnv,WERROR,usedFor); EnvPrintRouter(theEnv,WERROR,".\n"); } /************************************************************/ /* GetNextEntity: Utility routine for accessing all of the */ /* data entities that can match patterns. Currently facts */ /* and instances are the only data entities available. */ /************************************************************/ globle void GetNextPatternEntity( void *theEnv, struct patternParser **theParser, struct patternEntity **theEntity) { /*=============================================================*/ /* If the current parser is NULL, then we want to retrieve the */ /* very first data entity. The traversal of entities is done */ /* by entity type (e.g. all facts are traversed followed by */ /* all instances). To get the first entity type to traverse, */ /* the current parser is set to the first parser on the list */ /* of pattern parsers. */ /*=============================================================*/ if (*theParser == NULL) { *theParser = PatternData(theEnv)->ListOfPatternParsers; *theEntity = NULL; } /*================================================================*/ /* Otherwise try to retrieve the next entity following the entity */ /* returned by the last call to GetNextEntity. If that entity was */ /* the last of its data type, then move on to the next pattern */ /* parser, otherwise return that entity as the next one. */ /*================================================================*/ else if (theEntity != NULL) { *theEntity = (struct patternEntity *) (*(*theParser)->entityType->base.getNextFunction)(theEnv,*theEntity); if ((*theEntity) != NULL) return; *theParser = (*theParser)->next; } /*===============================================================*/ /* Otherwise, we encountered a situation which should not occur. */ /* Once a NULL entity is returned from GetNextEntity, it should */ /* not be passed back to GetNextEntity. */ /*===============================================================*/ else { SystemError(theEnv,"PATTERN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*================================================*/ /* Keep looping through the lists of entities and */ /* pattern parsers until an entity is found. */ /*================================================*/ while ((*theEntity == NULL) && (*theParser != NULL)) { *theEntity = (struct patternEntity *) (*(*theParser)->entityType->base.getNextFunction)(theEnv,*theEntity); if (*theEntity != NULL) return; *theParser = (*theParser)->next; } return; } /**************************************************************/ /* DetachPattern: Detaches a pattern from the pattern network */ /* by calling the appropriate function for the data type */ /* associated with the pattern. */ /**************************************************************/ void DetachPattern( void *theEnv, int rhsType, struct patternNodeHeader *theHeader) { if (rhsType == 0) return; if (PatternData(theEnv)->PatternParserArray[rhsType-1] != NULL) { FlushAlphaMemory(theEnv,theHeader); (*PatternData(theEnv)->PatternParserArray[rhsType-1]->removePatternFunction)(theEnv,theHeader); } } /**************************************************/ /* AddPatternParser: Adds a pattern type to the */ /* list of pattern parsers used to detect valid */ /* patterns in the LHS of a rule. */ /**************************************************/ globle intBool AddPatternParser( void *theEnv, struct patternParser *newPtr) { struct patternParser *currentPtr, *lastPtr = NULL; /*============================================*/ /* Check to see that the limit for the number */ /* of pattern parsers has not been exceeded. */ /*============================================*/ if (PatternData(theEnv)->NextPosition >= MAX_POSITIONS) return(FALSE); /*================================*/ /* Create the new pattern parser. */ /*================================*/ newPtr->positionInArray = PatternData(theEnv)->NextPosition; PatternData(theEnv)->PatternParserArray[PatternData(theEnv)->NextPosition-1] = newPtr; PatternData(theEnv)->NextPosition++; /*================================*/ /* Add the parser to the list of */ /* parsers based on its priority. */ /*================================*/ if (PatternData(theEnv)->ListOfPatternParsers == NULL) { newPtr->next = NULL; PatternData(theEnv)->ListOfPatternParsers = newPtr; return(TRUE); } currentPtr = PatternData(theEnv)->ListOfPatternParsers; while ((currentPtr != NULL) ? (newPtr->priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = PatternData(theEnv)->ListOfPatternParsers; PatternData(theEnv)->ListOfPatternParsers = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(TRUE); } /****************************************************/ /* FindPatternParser: Searches for a pattern parser */ /* that can parse a pattern beginning with the */ /* specified keyword (e.g. "object"). */ /****************************************************/ globle struct patternParser *FindPatternParser( void *theEnv, const char *name) { struct patternParser *tempParser; for (tempParser = PatternData(theEnv)->ListOfPatternParsers; tempParser != NULL; tempParser = tempParser->next) { if (strcmp(tempParser->name,name) == 0) return(tempParser); } return(NULL); } /******************************************************/ /* GetPatternParser: Returns a pointer to the pattern */ /* parser for the specified data entity. */ /******************************************************/ struct patternParser *GetPatternParser( void *theEnv, int rhsType) { if (rhsType == 0) return(NULL); return(PatternData(theEnv)->PatternParserArray[rhsType-1]); } #if CONSTRUCT_COMPILER && (! RUN_TIME) /*************************************************************/ /* PatternNodeHeaderToCode: Writes the C code representation */ /* of a patternNodeHeader data structure. */ /*************************************************************/ globle void PatternNodeHeaderToCode( void *theEnv, FILE *fp, struct patternNodeHeader *theHeader, int imageID, int maxIndices) { fprintf(fp,"{NULL,NULL,"); if (theHeader->entryJoin == NULL) { fprintf(fp,"NULL,"); } else { fprintf(fp,"&%s%d_%d[%d],", JoinPrefix(),imageID, (((int) theHeader->entryJoin->bsaveID) / maxIndices) + 1, ((int) theHeader->entryJoin->bsaveID) % maxIndices); } PrintHashedExpressionReference(theEnv,fp,theHeader->rightHash,imageID,maxIndices); fprintf(fp,",%d,%d,%d,0,0,%d,%d,%d}",theHeader->singlefieldNode, theHeader->multifieldNode, theHeader->stopNode, theHeader->beginSlot, theHeader->endSlot, theHeader->selector); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ #if (! RUN_TIME) && (! BLOAD_ONLY) /****************************************************************/ /* PostPatternAnalysis: Calls the post analysis routines for */ /* each of the pattern parsers to allow additional processing */ /* by the pattern parser after the variable analysis routines */ /* have analyzed the LHS patterns. */ /****************************************************************/ globle intBool PostPatternAnalysis( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *patternPtr; struct patternParser *tempParser; for (patternPtr = theLHS; patternPtr != NULL; patternPtr = patternPtr->bottom) { if ((patternPtr->type == PATTERN_CE) && (patternPtr->patternType != NULL)) { tempParser = patternPtr->patternType; if (tempParser->postAnalysisFunction != NULL) { if ((*tempParser->postAnalysisFunction)(theEnv,patternPtr)) return(TRUE); } } } return(FALSE); } /******************************************************************/ /* RestrictionParse: Parses a single field within a pattern. This */ /* field may either be a single field wildcard, a multifield */ /* wildcard, a single field variable, a multifield variable, */ /* or a series of connected constraints. */ /* */ /* ::= ? | */ /* $? | */ /* */ /******************************************************************/ struct lhsParseNode *RestrictionParse( void *theEnv, const char *readSource, struct token *theToken, int multifieldSlot, struct symbolHashNode *theSlot, short slotNumber, CONSTRAINT_RECORD *theConstraints, short position) { struct lhsParseNode *topNode = NULL, *lastNode = NULL, *nextNode; int numberOfSingleFields = 0; int numberOfMultifields = 0; short startPosition = position; int error = FALSE; CONSTRAINT_RECORD *tempConstraints; /*==================================================*/ /* Keep parsing fields until a right parenthesis is */ /* encountered. This will either indicate the end */ /* of an instance or deftemplate slot or the end of */ /* an ordered fact. */ /*==================================================*/ while (theToken->type != RPAREN) { /*========================================*/ /* Look for either a single or multifield */ /* wildcard or a conjuctive restriction. */ /*========================================*/ if ((theToken->type == SF_WILDCARD) || (theToken->type == MF_WILDCARD)) { nextNode = GetLHSParseNode(theEnv); nextNode->type = theToken->type; nextNode->negated = FALSE; nextNode->exists = FALSE; GetToken(theEnv,readSource,theToken); } else { nextNode = ConjuctiveRestrictionParse(theEnv,readSource,theToken,&error); if (nextNode == NULL) { ReturnLHSParseNodes(theEnv,topNode); return(NULL); } } /*========================================================*/ /* Fix up the pretty print representation of a multifield */ /* slot so that the fields don't run together. */ /*========================================================*/ if ((theToken->type != RPAREN) && (multifieldSlot == TRUE)) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); } /*========================================*/ /* Keep track of the number of single and */ /* multifield restrictions encountered. */ /*========================================*/ if ((nextNode->type == SF_WILDCARD) || (nextNode->type == SF_VARIABLE)) { numberOfSingleFields++; } else { numberOfMultifields++; } /*===================================*/ /* Assign the slot name and indices. */ /*===================================*/ nextNode->slot = theSlot; nextNode->slotNumber = slotNumber; nextNode->index = position++; /*==============================================*/ /* If we're not dealing with a multifield slot, */ /* attach the constraints directly to the node */ /* and return. */ /*==============================================*/ if (! multifieldSlot) { if (theConstraints == NULL) { if (nextNode->type == SF_VARIABLE) { nextNode->constraints = GetConstraintRecord(theEnv); } else nextNode->constraints = NULL; } else nextNode->constraints = theConstraints; return(nextNode); } /*====================================================*/ /* Attach the restriction to the list of restrictions */ /* already parsed for this slot or ordered fact. */ /*====================================================*/ if (lastNode == NULL) topNode = nextNode; else lastNode->right = nextNode; lastNode = nextNode; } /*=====================================================*/ /* Once we're through parsing, check to make sure that */ /* a single field slot was given a restriction. If the */ /* following test fails, then we know we're dealing */ /* with a multifield slot. */ /*=====================================================*/ if ((topNode == NULL) && (! multifieldSlot)) { SyntaxErrorMessage(theEnv,"defrule"); return(NULL); } /*===============================================*/ /* Loop through each of the restrictions in the */ /* list of restrictions for the multifield slot. */ /*===============================================*/ for (nextNode = topNode; nextNode != NULL; nextNode = nextNode->right) { /*===================================================*/ /* Assign a constraint record to each constraint. If */ /* the slot has an explicit constraint, then copy */ /* this and store it with the constraint. Otherwise, */ /* create a constraint record for a single field */ /* constraint and skip the constraint modifications */ /* for a multifield constraint. */ /*===================================================*/ if (theConstraints == NULL) { if (nextNode->type == SF_VARIABLE) { nextNode->constraints = GetConstraintRecord(theEnv); } else { continue; } } else { nextNode->constraints = CopyConstraintRecord(theEnv,theConstraints); } /*==========================================*/ /* Remove the min and max field constraints */ /* for the entire slot from the constraint */ /* record for this single constraint. */ /*==========================================*/ ReturnExpression(theEnv,nextNode->constraints->minFields); ReturnExpression(theEnv,nextNode->constraints->maxFields); nextNode->constraints->minFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->NegativeInfinity); nextNode->constraints->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity); nextNode->derivedConstraints = TRUE; /*====================================================*/ /* If we're not dealing with a multifield constraint, */ /* then no further modifications are needed to the */ /* min and max constraints for this constraint. */ /*====================================================*/ if ((nextNode->type != MF_WILDCARD) && (nextNode->type != MF_VARIABLE)) { continue; } /*==========================================================*/ /* Create a separate constraint record to keep track of the */ /* cardinality information for this multifield constraint. */ /*==========================================================*/ tempConstraints = GetConstraintRecord(theEnv); SetConstraintType(MULTIFIELD,tempConstraints); tempConstraints->singlefieldsAllowed = FALSE; tempConstraints->multifield = nextNode->constraints; nextNode->constraints = tempConstraints; /*=====================================================*/ /* Adjust the min and max field values for this single */ /* multifield constraint based on the min and max */ /* fields for the entire slot and the number of single */ /* field values contained in the slot. */ /*=====================================================*/ if (theConstraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity) { ReturnExpression(theEnv,tempConstraints->maxFields); tempConstraints->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,ValueToLong(theConstraints->maxFields->value) - numberOfSingleFields)); } if ((numberOfMultifields == 1) && (theConstraints->minFields->value != SymbolData(theEnv)->NegativeInfinity)) { ReturnExpression(theEnv,tempConstraints->minFields); tempConstraints->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,ValueToLong(theConstraints->minFields->value) - numberOfSingleFields)); } } /*================================================*/ /* If a multifield slot is being parsed, place a */ /* node on top of the list of constraints parsed. */ /*================================================*/ if (multifieldSlot) { nextNode = GetLHSParseNode(theEnv); nextNode->type = MF_WILDCARD; nextNode->multifieldSlot = TRUE; nextNode->bottom = topNode; nextNode->slot = theSlot; nextNode->slotNumber = slotNumber; nextNode->index = startPosition; nextNode->constraints = theConstraints; topNode = nextNode; TallyFieldTypes(topNode->bottom); } /*=================================*/ /* Return the list of constraints. */ /*=================================*/ return(topNode); } /***************************************************************/ /* TallyFieldTypes: Determines the number of single field and */ /* multifield variables and wildcards that appear before and */ /* after each restriction found in a multifield slot. */ /***************************************************************/ static void TallyFieldTypes( struct lhsParseNode *theRestrictions) { struct lhsParseNode *tempNode1, *tempNode2, *tempNode3; unsigned short totalSingleFields = 0, totalMultiFields = 0; unsigned short runningSingleFields = 0, runningMultiFields = 0; /*========================================*/ /* Compute the total number of single and */ /* multifield variables and wildcards. */ /*========================================*/ for (tempNode1 = theRestrictions; tempNode1 != NULL; tempNode1 = tempNode1->right) { if ((tempNode1->type == SF_VARIABLE) || (tempNode1->type == SF_WILDCARD)) { totalSingleFields++; } else { totalMultiFields++; } } /*======================================================*/ /* Loop through each constraint tallying the numbers of */ /* the variable types before and after along the way. */ /*======================================================*/ for (tempNode1 = theRestrictions; tempNode1 != NULL; tempNode1 = tempNode1->right) { /*===================================*/ /* Assign the values to the "binding */ /* variable" node of the constraint. */ /*===================================*/ tempNode1->singleFieldsBefore = runningSingleFields; tempNode1->multiFieldsBefore = runningMultiFields; tempNode1->withinMultifieldSlot = TRUE; if ((tempNode1->type == SF_VARIABLE) || (tempNode1->type == SF_WILDCARD)) { tempNode1->singleFieldsAfter = (unsigned short) (totalSingleFields - (runningSingleFields + 1)); tempNode1->multiFieldsAfter = (unsigned short) (totalMultiFields - runningMultiFields); } else { tempNode1->singleFieldsAfter = (unsigned short) (totalSingleFields - runningSingleFields); tempNode1->multiFieldsAfter = (unsigned short) (totalMultiFields - (runningMultiFields + 1)); } /*=====================================================*/ /* Assign the values to each of the and (&) and or (|) */ /* connected constraints within the constraint. */ /*=====================================================*/ for (tempNode2 = tempNode1->bottom; tempNode2 != NULL; tempNode2 = tempNode2->bottom) { for (tempNode3 = tempNode2; tempNode3 != NULL; tempNode3 = tempNode3->right) { tempNode3->singleFieldsBefore = tempNode1->singleFieldsBefore; tempNode3->singleFieldsAfter = tempNode1->singleFieldsAfter; tempNode3->multiFieldsBefore = tempNode1->multiFieldsBefore; tempNode3->multiFieldsAfter = tempNode1->multiFieldsAfter; tempNode3->withinMultifieldSlot = TRUE; } } /*=======================================*/ /* Calculate the running total of single */ /* and multifield constraints. */ /*=======================================*/ if ((tempNode1->type == SF_VARIABLE) || (tempNode1->type == SF_WILDCARD)) { runningSingleFields++; } else { runningMultiFields++; } } } /*******************************************************************/ /* ConjuctiveRestrictionParse: Parses a single constraint field in */ /* a pattern that is not a single field wildcard, multifield */ /* wildcard, or multifield variable. The field may consist of a */ /* number of subfields tied together using the & connective */ /* constraint and/or the | connective constraint. */ /* */ /* */ /* ::= | */ /* & | */ /* | */ /*******************************************************************/ static struct lhsParseNode *ConjuctiveRestrictionParse( void *theEnv, const char *readSource, struct token *theToken, int *error) { struct lhsParseNode *bindNode; struct lhsParseNode *theNode, *nextOr, *nextAnd; int connectorType; /*=====================================*/ /* Get the first node and determine if */ /* it is a binding variable. */ /*=====================================*/ theNode = LiteralRestrictionParse(theEnv,readSource,theToken,error); if (*error == TRUE) { return(NULL); } GetToken(theEnv,readSource,theToken); if (((theNode->type == SF_VARIABLE) || (theNode->type == MF_VARIABLE)) && (theNode->negated == FALSE) && (theToken->type != OR_CONSTRAINT)) { theNode->bindingVariable = TRUE; bindNode = theNode; nextOr = NULL; nextAnd = NULL; } else { bindNode = GetLHSParseNode(theEnv); if (theNode->type == MF_VARIABLE) bindNode->type = MF_WILDCARD; else bindNode->type = SF_WILDCARD; bindNode->negated = FALSE; bindNode->bottom = theNode; nextOr = theNode; nextAnd = theNode; } /*===================================*/ /* Process the connected constraints */ /* within the constraint */ /*===================================*/ while ((theToken->type == OR_CONSTRAINT) || (theToken->type == AND_CONSTRAINT)) { /*==========================*/ /* Get the next constraint. */ /*==========================*/ connectorType = theToken->type; GetToken(theEnv,readSource,theToken); theNode = LiteralRestrictionParse(theEnv,readSource,theToken,error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,bindNode); return(NULL); } /*=======================================*/ /* Attach the new constraint to the list */ /* of constraints for this field. */ /*=======================================*/ if (connectorType == OR_CONSTRAINT) { if (nextOr == NULL) { bindNode->bottom = theNode; } else { nextOr->bottom = theNode; } nextOr = theNode; nextAnd = theNode; } else if (connectorType == AND_CONSTRAINT) { if (nextAnd == NULL) { bindNode->bottom = theNode; nextOr = theNode; } else { nextAnd->right = theNode; } nextAnd = theNode; } else { SystemError(theEnv,"RULEPSR",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*==================================================*/ /* Determine if any more restrictions are connected */ /* to the current list of restrictions. */ /*==================================================*/ GetToken(theEnv,readSource,theToken); } /*==========================================*/ /* Check for illegal mixing of single and */ /* multifield values within the constraint. */ /*==========================================*/ if (CheckForVariableMixing(theEnv,bindNode)) { *error = TRUE; ReturnLHSParseNodes(theEnv,bindNode); return(NULL); } /*========================*/ /* Return the constraint. */ /*========================*/ return(bindNode); } /*****************************************************/ /* CheckForVariableMixing: Checks a field constraint */ /* to determine if single and multifield variables */ /* are illegally mixed within it. */ /*****************************************************/ static int CheckForVariableMixing( void *theEnv, struct lhsParseNode *theRestriction) { struct lhsParseNode *tempRestriction; CONSTRAINT_RECORD *theConstraint; int multifield = FALSE; int singlefield = FALSE; int constant = FALSE; int singleReturnValue = FALSE; int multiReturnValue = FALSE; /*================================================*/ /* If the constraint contains a binding variable, */ /* determine whether it is a single field or */ /* multifield variable. */ /*================================================*/ if (theRestriction->type == SF_VARIABLE) singlefield = TRUE; else if (theRestriction->type == MF_VARIABLE) multifield = TRUE; /*===========================================*/ /* Loop through each of the or (|) connected */ /* constraints within the constraint. */ /*===========================================*/ for (theRestriction = theRestriction->bottom; theRestriction != NULL; theRestriction = theRestriction->bottom) { /*============================================*/ /* Loop through each of the and (&) connected */ /* constraints within the or (|) constraint. */ /*============================================*/ for (tempRestriction = theRestriction; tempRestriction != NULL; tempRestriction = tempRestriction->right) { /*=====================================================*/ /* Determine if the constraint contains a single field */ /* variable, multifield variable, constant (a single */ /* field), a return value constraint of a function */ /* returning a single field value, or a return value */ /* constraint of a function returning a multifield */ /* value. */ /*=====================================================*/ if (tempRestriction->type == SF_VARIABLE) singlefield = TRUE; else if (tempRestriction->type == MF_VARIABLE) multifield = TRUE; else if (ConstantType(tempRestriction->type)) constant = TRUE; else if (tempRestriction->type == RETURN_VALUE_CONSTRAINT) { theConstraint = FunctionCallToConstraintRecord(theEnv,tempRestriction->expression->value); if (theConstraint->anyAllowed) { /* Do nothing. */ } else if (theConstraint->multifieldsAllowed) multiReturnValue = TRUE; else singleReturnValue = TRUE; RemoveConstraint(theEnv,theConstraint); } } } /*================================================================*/ /* Using a single field value (a single field variable, constant, */ /* or function returning a single field value) together with a */ /* multifield value (a multifield variable or function returning */ /* a multifield value) is illegal. Return TRUE if this occurs. */ /*================================================================*/ if ((singlefield || constant || singleReturnValue) && (multifield || multiReturnValue)) { PrintErrorID(theEnv,"PATTERN",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Single and multifield constraints cannot be mixed in a field constraint\n"); return(TRUE); } /*=======================================*/ /* Otherwise return FALSE to indicate no */ /* illegal variable mixing was detected. */ /*=======================================*/ return(FALSE); } /***********************************************************/ /* LiteralRestrictionParse: Parses a single constraint. */ /* The constraint may be a literal constraint, a */ /* predicate constraint, a return value constraint, or a */ /* variable constraint. The constraints may also be */ /* negated using the ~ connective constraint. */ /* */ /* ::= | ~ */ /* */ /* ::= | */ /* | */ /* | */ /* : | */ /* = */ /***********************************************************/ static struct lhsParseNode *LiteralRestrictionParse( void *theEnv, const char *readSource, struct token *theToken, int *error) { struct lhsParseNode *topNode; struct expr *theExpression; /*============================================*/ /* Create a node to represent the constraint. */ /*============================================*/ topNode = GetLHSParseNode(theEnv); /*=================================================*/ /* Determine if the constraint has a '~' preceding */ /* it. If it does, then the field is negated */ /* (e.g. ~red means "not the constant red." */ /*=================================================*/ if (theToken->type == NOT_CONSTRAINT) { GetToken(theEnv,readSource,theToken); topNode->negated = TRUE; } else { topNode->negated = FALSE; } /*===========================================*/ /* Determine if the constraint is one of the */ /* recognized types. These are ?variables, */ /* symbols, strings, numbers, :(expression), */ /* and =(expression). */ /*===========================================*/ topNode->type = theToken->type; /*============================================*/ /* Any symbol is valid, but an = signifies a */ /* return value constraint and an : signifies */ /* a predicate constraint. */ /*============================================*/ if (theToken->type == SYMBOL) { /*==============================*/ /* If the symbol is an =, parse */ /* a return value constraint. */ /*==============================*/ if (strcmp(ValueToString(theToken->value),"=") == 0) { theExpression = Function0Parse(theEnv,readSource); if (theExpression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->type = RETURN_VALUE_CONSTRAINT; topNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); } /*=============================*/ /* If the symbol is a :, parse */ /* a predicate constraint. */ /*=============================*/ else if (strcmp(ValueToString(theToken->value),":") == 0) { theExpression = Function0Parse(theEnv,readSource); if (theExpression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->type = PREDICATE_CONSTRAINT; topNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); } /*==============================================*/ /* Otherwise, treat the constraint as a symbol. */ /*==============================================*/ else { topNode->value = theToken->value; } } /*=====================================================*/ /* Single and multifield variables and float, integer, */ /* string, and instance name constants are also valid. */ /*=====================================================*/ else if ((theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE) || (theToken->type == FLOAT) || (theToken->type == INTEGER) || (theToken->type == STRING) || (theToken->type == INSTANCE_NAME)) { topNode->value = theToken->value; } /*===========================*/ /* Anything else is invalid. */ /*===========================*/ else { SyntaxErrorMessage(theEnv,"defrule"); *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } /*===============================*/ /* Return the parsed constraint. */ /*===============================*/ return(topNode); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/modulbin.c0000755000175000017500000005474712373755047016244 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #define _MODULBIN_SOURCE_ #include "setup.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "constrct.h" #include "moduldef.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "modulbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDefmodule(void *,void *,long); static void UpdatePortItem(void *,void *,long); static void ClearBload(void *); /*********************************************/ /* DefmoduleBinarySetup: Installs the binary */ /* save/load feature for defmodules. */ /*********************************************/ globle void DefmoduleBinarySetup( void *theEnv) { AddBeforeBloadFunction(theEnv,"defmodule",RemoveAllDefmodules,2000); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defmodule",0,BsaveFind,NULL, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif AddAbortBloadFunction(theEnv,"defmodule",CreateMainModule,0); #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"defmodule",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /**************************************************************/ /* UpdateDefmoduleItemHeader: Updates the values in defmodule */ /* item headers for the loaded binary image. */ /**************************************************************/ globle void UpdateDefmoduleItemHeader( void *theEnv, struct bsaveDefmoduleItemHeader *theBsaveHeader, struct defmoduleItemHeader *theHeader, int itemSize, void *itemArray) { long firstOffset,lastOffset; theHeader->theModule = ModulePointer(theBsaveHeader->theModule); if (theBsaveHeader->firstItem == -1L) { theHeader->firstItem = NULL; theHeader->lastItem = NULL; } else { firstOffset = itemSize * theBsaveHeader->firstItem; lastOffset = itemSize * theBsaveHeader->lastItem; theHeader->firstItem = (struct constructHeader *) &((char *) itemArray)[firstOffset]; theHeader->lastItem = (struct constructHeader *) &((char *) itemArray)[lastOffset]; } } #if BLOAD_AND_BSAVE /*********************************************************/ /* AssignBsaveDefmdlItemHdrVals: Assigns the appropriate */ /* values to a bsave defmodule item header record. */ /*********************************************************/ globle void AssignBsaveDefmdlItemHdrVals( struct bsaveDefmoduleItemHeader *theBsaveHeader, struct defmoduleItemHeader *theHeader) { theBsaveHeader->theModule = theHeader->theModule->bsaveID; if (theHeader->firstItem == NULL) { theBsaveHeader->firstItem = -1L; theBsaveHeader->lastItem = -1L; } else { theBsaveHeader->firstItem = theHeader->firstItem->bsaveID; theBsaveHeader->lastItem = theHeader->lastItem->bsaveID; } } /**********************************************************/ /* BsaveFind: Counts the number of data structures which */ /* must be saved in the binary image for the defmodules */ /* in the current environment. */ /**********************************************************/ static void BsaveFind( void *theEnv) { struct defmodule *defmodulePtr; struct portItem *theList; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DefmoduleData(theEnv)->BNumberOfDefmodules); SaveBloadCount(theEnv,DefmoduleData(theEnv)->NumberOfPortItems); /*==========================================*/ /* Set the count of defmodule and defmodule */ /* port items data structures to zero. */ /*==========================================*/ DefmoduleData(theEnv)->BNumberOfDefmodules = 0; DefmoduleData(theEnv)->NumberOfPortItems = 0; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); defmodulePtr != NULL; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr)) { /*==============================================*/ /* Increment the number of modules encountered. */ /*==============================================*/ DefmoduleData(theEnv)->BNumberOfDefmodules++; /*===========================*/ /* Mark the defmodule's name */ /* as being a needed symbol. */ /*===========================*/ defmodulePtr->name->neededSymbol = TRUE; /*==============================================*/ /* Loop through each of the port items in the */ /* defmodule's import list incrementing the */ /* number of port items encountered and marking */ /* needed symbols. */ /*==============================================*/ for (theList = defmodulePtr->importList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName != NULL) { theList->moduleName->neededSymbol = TRUE; } if (theList->constructType != NULL) { theList->constructType->neededSymbol = TRUE; } if (theList->constructName != NULL) { theList->constructName->neededSymbol = TRUE; } } /*==============================================*/ /* Loop through each of the port items in the */ /* defmodule's export list incrementing the */ /* number of port items encountered and marking */ /* needed symbols. */ /*==============================================*/ for (theList = defmodulePtr->exportList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName != NULL) { theList->moduleName->neededSymbol = TRUE; } if (theList->constructType != NULL) { theList->constructType->neededSymbol = TRUE; } if (theList->constructName != NULL) { theList->constructName->neededSymbol = TRUE; } } } } /*********************************************************/ /* BsaveStorage: Writes out the storage requirements for */ /* all defmodule structures to the binary file. */ /*********************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { size_t space; space = sizeof(long) * 2; GenWrite(&space,sizeof(size_t),fp); GenWrite(&DefmoduleData(theEnv)->BNumberOfDefmodules,sizeof(long int),fp); GenWrite(&DefmoduleData(theEnv)->NumberOfPortItems,sizeof(long int),fp); } /*********************************************/ /* BsaveBinaryItem: Writes out all defmodule */ /* structures to the binary file. */ /*********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { size_t space; struct defmodule *defmodulePtr; struct bsaveDefmodule newDefmodule; struct bsavePortItem newPortItem; struct portItem *theList; /*=========================================================*/ /* Write out the amount of space taken up by the defmodule */ /* and port item data structures in the binary image. */ /*=========================================================*/ space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct bsaveDefmodule); space += DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct bsavePortItem); GenWrite(&space,sizeof(size_t),fp); /*==========================================*/ /* Write out each defmodule data structure. */ /*==========================================*/ DefmoduleData(theEnv)->BNumberOfDefmodules = 0; DefmoduleData(theEnv)->NumberOfPortItems = 0; for (defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); defmodulePtr != NULL; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr)) { newDefmodule.name = defmodulePtr->name->bucket; DefmoduleData(theEnv)->BNumberOfDefmodules++; if (defmodulePtr->next != NULL) { newDefmodule.next = DefmoduleData(theEnv)->BNumberOfDefmodules; } else { newDefmodule.next = -1L; } if (defmodulePtr->importList == NULL) { newDefmodule.importList = -1L; } else { newDefmodule.importList = DefmoduleData(theEnv)->NumberOfPortItems; for (theList = defmodulePtr->importList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; } } if (defmodulePtr->exportList == NULL) { newDefmodule.exportList = -1L; } else { newDefmodule.exportList = DefmoduleData(theEnv)->NumberOfPortItems; for (theList = defmodulePtr->exportList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; } } newDefmodule.bsaveID = defmodulePtr->bsaveID; GenWrite(&newDefmodule,sizeof(struct bsaveDefmodule),fp); } /*==========================================*/ /* Write out each port item data structure. */ /*==========================================*/ DefmoduleData(theEnv)->NumberOfPortItems = 0; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (defmodulePtr != NULL) { for (theList = defmodulePtr->importList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName == NULL) newPortItem.moduleName = -1L; else newPortItem.moduleName = (long) theList->moduleName->bucket; if (theList->constructType == NULL) newPortItem.constructType = -1L; else newPortItem.constructType = (long) theList->constructType->bucket; if (theList->constructName == NULL) newPortItem.constructName = -1L; else newPortItem.constructName = (long) theList->constructName->bucket; if (theList->next == NULL) newPortItem.next = -1L; else newPortItem.next = DefmoduleData(theEnv)->NumberOfPortItems; GenWrite(&newPortItem,sizeof(struct bsavePortItem),fp); } for (theList = defmodulePtr->exportList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName == NULL) newPortItem.moduleName = -1L; else newPortItem.moduleName = (long) theList->moduleName->bucket; if (theList->constructType == NULL) newPortItem.constructType = -1L; else newPortItem.constructType = (long) theList->constructType->bucket; if (theList->constructName == NULL) newPortItem.constructName = -1L; else newPortItem.constructName = (long) theList->constructName->bucket; if (theList->next == NULL) newPortItem.next = -1L; else newPortItem.next = DefmoduleData(theEnv)->NumberOfPortItems; GenWrite(&newPortItem,sizeof(struct bsavePortItem),fp); } defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr); } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of defmodule and port items in the binary image (these were */ /* overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DefmoduleData(theEnv)->BNumberOfDefmodules); RestoreBloadCount(theEnv,&DefmoduleData(theEnv)->NumberOfPortItems); } #endif /* BLOAD_AND_BSAVE */ /**********************************************************/ /* BloadStorage: Allocates storage requirements for the */ /* defmodules and port items used by this binary image. */ /**********************************************************/ static void BloadStorage( void *theEnv) { size_t space; /*=======================================*/ /* Determine the number of defmodule and */ /* port item data structures to be read. */ /*=======================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DefmoduleData(theEnv)->BNumberOfDefmodules,sizeof(long int)); GenReadBinary(theEnv,&DefmoduleData(theEnv)->NumberOfPortItems,sizeof(long int)); /*================================*/ /* Allocate the space needed for */ /* the defmodule data structures. */ /*================================*/ if (DefmoduleData(theEnv)->BNumberOfDefmodules == 0) { DefmoduleData(theEnv)->DefmoduleArray = NULL; return; } space = (DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule)); DefmoduleData(theEnv)->DefmoduleArray = (struct defmodule *) genalloc(theEnv,space); /*================================*/ /* Allocate the space needed for */ /* the port item data structures. */ /*================================*/ if (DefmoduleData(theEnv)->NumberOfPortItems == 0) { DefmoduleData(theEnv)->PortItemArray = NULL; return; } space = (DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem)); DefmoduleData(theEnv)->PortItemArray = (struct portItem *) genalloc(theEnv,space); } /********************************************/ /* BloadBinaryItem: Loads and refreshes the */ /* defmodules used by this binary image. */ /********************************************/ static void BloadBinaryItem( void *theEnv) { size_t space; GenReadBinary(theEnv,&space,sizeof(size_t)); if (DefmoduleData(theEnv)->BNumberOfDefmodules == 0) return; BloadandRefresh(theEnv,DefmoduleData(theEnv)->BNumberOfDefmodules,sizeof(struct bsaveDefmodule),UpdateDefmodule); BloadandRefresh(theEnv,DefmoduleData(theEnv)->NumberOfPortItems,sizeof(struct bsavePortItem),UpdatePortItem); SetListOfDefmodules(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray); EnvSetCurrentModule(theEnv,(void *) EnvGetNextDefmodule(theEnv,NULL)); } /******************************************/ /* UpdateDefmodule: Bload refresh routine */ /* for defmodule data structure. */ /******************************************/ static void UpdateDefmodule( void *theEnv, void *buf, long obji) { struct bsaveDefmodule *bdp; struct moduleItem *theItem; int i; bdp = (struct bsaveDefmodule *) buf; DefmoduleData(theEnv)->DefmoduleArray[obji].name = SymbolPointer(bdp->name); IncrementSymbolCount(DefmoduleData(theEnv)->DefmoduleArray[obji].name); if (bdp->next != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].next = (struct defmodule *) &DefmoduleData(theEnv)->DefmoduleArray[bdp->next]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].next = NULL; } if (GetNumberOfModuleItems(theEnv) == 0) { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = NULL; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * GetNumberOfModuleItems(theEnv)); } for (i = 0, theItem = GetListOfModuleItems(theEnv); (i < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ; i++, theItem = theItem->next) { if (theItem->bloadModuleReference == NULL) { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = NULL; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->bloadModuleReference)(theEnv,obji); } } DefmoduleData(theEnv)->DefmoduleArray[obji].ppForm = NULL; if (bdp->importList != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->importList]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = NULL; } if (bdp->exportList != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->exportList]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = NULL; } DefmoduleData(theEnv)->DefmoduleArray[obji].bsaveID = bdp->bsaveID; } /*****************************************/ /* UpdatePortItem: Bload refresh routine */ /* for port item data structure. */ /*****************************************/ static void UpdatePortItem( void *theEnv, void *buf, long obji) { struct bsavePortItem *bdp; bdp = (struct bsavePortItem *) buf; if (bdp->moduleName != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = SymbolPointer(bdp->moduleName); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].moduleName); } else { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = NULL; } if (bdp->constructType != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].constructType = SymbolPointer(bdp->constructType); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructType); } else { DefmoduleData(theEnv)->PortItemArray[obji].constructType = NULL; } if (bdp->constructName != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].constructName = SymbolPointer(bdp->constructName); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructName); } else { DefmoduleData(theEnv)->PortItemArray[obji].constructName = NULL; } if (bdp->next != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].next = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->next]; } else { DefmoduleData(theEnv)->PortItemArray[obji].next = NULL; } } /***************************************/ /* ClearBload: Defmodule clear routine */ /* when a binary load is in effect. */ /***************************************/ static void ClearBload( void *theEnv) { long i; size_t space; struct portItem *theList; /*===========================*/ /* Decrement in use counters */ /* used by the binary image. */ /*===========================*/ for (i = 0; i < DefmoduleData(theEnv)->BNumberOfDefmodules; i++) { DecrementSymbolCount(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].name); for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].importList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName); } for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].exportList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName); } rm(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray,sizeof(void *) * GetNumberOfModuleItems(theEnv)); } /*================================*/ /* Deallocate the space used for */ /* the defmodule data structures. */ /*================================*/ space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule); if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray,space); DefmoduleData(theEnv)->BNumberOfDefmodules = 0; /*================================*/ /* Deallocate the space used for */ /* the port item data structures. */ /*================================*/ space = DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem); if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->PortItemArray,space); DefmoduleData(theEnv)->NumberOfPortItems = 0; /*===========================*/ /* Reset module information. */ /*===========================*/ SetListOfDefmodules(theEnv,NULL); CreateMainModule(theEnv); DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; } #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips_core_source_630/core/classini.c0000755000175000017500000010345312500721260016203 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* CLASS INITIALIZATION MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Defclass Initialization Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "classcom.h" #include "classexm.h" #include "classfun.h" #include "classinf.h" #include "classpsr.h" #include "cstrccom.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "extnfunc.h" #include "inscom.h" #include "memalloc.h" #include "modulpsr.h" #include "modulutl.h" #include "msgcom.h" #include "watch.h" #if DEFINSTANCES_CONSTRUCT #include "defins.h" #endif #if INSTANCE_SET_QUERIES #include "insquery.h" #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "bload.h" #include "objbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "objcmp.h" #endif #if DEFRULE_CONSTRUCT #include "objrtbld.h" #include "objrtfnx.h" #include "objrtmch.h" #endif #if RUN_TIME #include "insfun.h" #include "msgfun.h" #endif #include "classini.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define SUPERCLASS_RLN "is-a" #define NAME_RLN "name" #define INITIAL_OBJECT_NAME "initial-object" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void SetupDefclasses(void *); static void DeallocateDefclassData(void *); #if (! RUN_TIME) static void DestroyDefclassAction(void *,struct constructHeader *,void *); static DEFCLASS *AddSystemClass(void *,const char *,DEFCLASS *); static void *AllocateModule(void *); static void ReturnModule(void *,void *); #else static void SearchForHashedPatternNodes(void *,OBJECT_PATTERN_NODE *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT static void UpdateDefclassesScope(void *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************** NAME : SetupObjectSystem DESCRIPTION : Initializes all COOL constructs, functions, and data structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : COOL initialized NOTES : Order of setup calls is important **********************************************************/ globle void SetupObjectSystem( void *theEnv) { ENTITY_RECORD defclassEntityRecord = { "DEFCLASS_PTR", DEFCLASS_PTR,1,0,0, NULL,NULL,NULL,NULL,NULL, DecrementDefclassBusyCount, IncrementDefclassBusyCount, NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL); AddEnvironmentCleanupFunction(theEnv,"defclasses",DeallocateDefclassData,-500); memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord)); #if ! RUN_TIME DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE; DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN); IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL); DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN); IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL); #if DEFRULE_CONSTRUCT DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME); IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); #endif #endif SetupDefclasses(theEnv); SetupInstances(theEnv); SetupMessageHandlers(theEnv); #if DEFINSTANCES_CONSTRUCT SetupDefinstances(theEnv); #endif #if INSTANCE_SET_QUERIES SetupQuery(theEnv); #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupObjectsBload(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) SetupObjectsCompiler(theEnv); #endif #if DEFRULE_CONSTRUCT SetupObjectPatternStuff(theEnv); #endif } /***************************************************/ /* DeallocateDefclassData: Deallocates environment */ /* data for the defclass construct. */ /***************************************************/ static void DeallocateDefclassData( void *theEnv) { #if ! RUN_TIME SLOT_NAME *tmpSNPPtr, *nextSNPPtr; int i; struct defclassModule *theModuleItem; void *theModule; int bloaded = FALSE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) bloaded = TRUE; #endif /*=============================*/ /* Destroy all the defclasses. */ /*=============================*/ if (! bloaded) { DoForAllConstructs(theEnv,DestroyDefclassAction,DefclassData(theEnv)->DefclassModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defclassModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefclassData(theEnv)->DefclassModuleIndex); rtn_struct(theEnv,defclassModule,theModuleItem); } } /*==========================*/ /* Remove the class tables. */ /*==========================*/ if (! bloaded) { if (DefclassData(theEnv)->ClassIDMap != NULL) { genfree(theEnv,DefclassData(theEnv)->ClassIDMap,DefclassData(theEnv)->AvailClassID * sizeof(DEFCLASS *)); } } if (DefclassData(theEnv)->ClassTable != NULL) { genfree(theEnv,DefclassData(theEnv)->ClassTable,sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE); } /*==============================*/ /* Free up the slot name table. */ /*==============================*/ if (! bloaded) { for (i = 0; i < SLOT_NAME_TABLE_HASH_SIZE; i++) { tmpSNPPtr = DefclassData(theEnv)->SlotNameTable[i]; while (tmpSNPPtr != NULL) { nextSNPPtr = tmpSNPPtr->nxt; rtn_struct(theEnv,slotName,tmpSNPPtr); tmpSNPPtr = nextSNPPtr; } } } if (DefclassData(theEnv)->SlotNameTable != NULL) { genfree(theEnv,DefclassData(theEnv)->SlotNameTable,sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE); } #else DEFCLASS *cls; void *tmpexp; register unsigned int i; register int j; if (DefclassData(theEnv)->ClassTable != NULL) { for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++) for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash) { for (i = 0 ; i < cls->slotCount ; i++) { if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0)) { tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo; rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); cls->slots[i].defaultValue = tmpexp; } } } } #endif } #if ! RUN_TIME /*********************************************************/ /* DestroyDefclassAction: Action used to remove defclass */ /* as a result of DestroyEnvironment. */ /*********************************************************/ static void DestroyDefclassAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct defclass *theDefclass = (struct defclass *) theConstruct; if (theDefclass == NULL) return; #if (! BLOAD_ONLY) DestroyDefclass(theEnv,theDefclass); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #endif #if RUN_TIME /*************************************************** NAME : ObjectsRunTimeInitialize DESCRIPTION : Initializes objects system lists in a run-time module INPUTS : 1) Pointer to new class hash table 2) Pointer to new slot name table RETURNS : Nothing useful SIDE EFFECTS : Global pointers set NOTES : None ***************************************************/ globle void ObjectsRunTimeInitialize( void *theEnv, DEFCLASS *ctable[], SLOT_NAME *sntable[], DEFCLASS **cidmap, unsigned mid) { DEFCLASS *cls; void *tmpexp; register unsigned int i,j; if (DefclassData(theEnv)->ClassTable != NULL) { for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++) for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash) { for (i = 0 ; i < cls->slotCount ; i++) { /* ===================================================================== For static default values, the data object value needs to deinstalled and deallocated, and the expression needs to be restored (which was temporarily stored in the supplementalInfo field of the data object) ===================================================================== */ if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0)) { tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo; ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue); rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); cls->slots[i].defaultValue = tmpexp; } } } } InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING); MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING); MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING); MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING); DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN); DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN); #if DEFRULE_CONSTRUCT DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME); #endif DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable; DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable; DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap; DefclassData(theEnv)->MaxClassID = (unsigned short) mid; DefclassData(theEnv)->PrimitiveClassMap[FLOAT] = LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[INTEGER] = LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[STRING] = LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] = LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] = LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] = LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] = LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] = LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME); DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] = LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME); for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++) for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash) { for (i = 0 ; i < cls->slotCount ; i++) { if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0)) { tmpexp = cls->slots[i].defaultValue; cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject); EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp, (DATA_OBJECT *) cls->slots[i].defaultValue,TRUE); ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue); ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp; } } } SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer); } /*******************************************************************/ /* SearchForHashedPatternNodes: */ /*******************************************************************/ static void SearchForHashedPatternNodes( void *theEnv, OBJECT_PATTERN_NODE *theNode) { while (theNode != NULL) { if ((theNode->lastLevel != NULL) && (theNode->lastLevel->selector)) { AddHashedPatternNode(theEnv,theNode->lastLevel,theNode,theNode->networkTest->type,theNode->networkTest->value); } SearchForHashedPatternNodes(theEnv,theNode->nextLevel); theNode = theNode->rightNode; } } #else /*************************************************************** NAME : CreateSystemClasses DESCRIPTION : Creates the built-in system classes INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : System classes inserted in the class hash table NOTES : The binary/load save indices for the primitive types (integer, float, symbol and string, multifield, external-address and fact-address) are very important. Need to be able to refer to types with the same index regardless of whether the object system is installed or not. Thus, the bsave/blaod indices of these classes match their integer codes. WARNING!!: Assumes no classes exist yet! ***************************************************************/ globle void CreateSystemClasses( void *theEnv) { DEFCLASS *user,*any,*primitive,*number,*lexeme,*address,*instance; #if DEFRULE_CONSTRUCT DEFCLASS *initialObject; #endif /* =================================== Add canonical slot name entries for the is-a and name fields - used for object patterns =================================== */ AddSlotName(theEnv,DefclassData(theEnv)->ISA_SYMBOL,ISA_ID,TRUE); AddSlotName(theEnv,DefclassData(theEnv)->NAME_SYMBOL,NAME_ID,TRUE); /* ========================================================= Bsave Indices for non-primitive classes start at 9 Object is 9, Primitive is 10, Number is 11, Lexeme is 12, Address is 13, and Instance is 14. because: float = 0, integer = 1, symbol = 2, string = 3, multifield = 4, and external-address = 5 and fact-address = 6, instance-adress = 7 and instance-name = 8. ========================================================= */ any = AddSystemClass(theEnv,OBJECT_TYPE_NAME,NULL); primitive = AddSystemClass(theEnv,PRIMITIVE_TYPE_NAME,any); user = AddSystemClass(theEnv,USER_TYPE_NAME,any); number = AddSystemClass(theEnv,NUMBER_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[INTEGER] = AddSystemClass(theEnv,INTEGER_TYPE_NAME,number); DefclassData(theEnv)->PrimitiveClassMap[FLOAT] = AddSystemClass(theEnv,FLOAT_TYPE_NAME,number); lexeme = AddSystemClass(theEnv,LEXEME_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] = AddSystemClass(theEnv,SYMBOL_TYPE_NAME,lexeme); DefclassData(theEnv)->PrimitiveClassMap[STRING] = AddSystemClass(theEnv,STRING_TYPE_NAME,lexeme); DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] = AddSystemClass(theEnv,MULTIFIELD_TYPE_NAME,primitive); address = AddSystemClass(theEnv,ADDRESS_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] = AddSystemClass(theEnv,EXTERNAL_ADDRESS_TYPE_NAME,address); DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] = AddSystemClass(theEnv,FACT_ADDRESS_TYPE_NAME,address); instance = AddSystemClass(theEnv,INSTANCE_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] = AddSystemClass(theEnv,INSTANCE_ADDRESS_TYPE_NAME,instance); DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] = AddSystemClass(theEnv,INSTANCE_NAME_TYPE_NAME,instance); #if DEFRULE_CONSTRUCT initialObject = AddSystemClass(theEnv,INITIAL_OBJECT_CLASS_NAME,user); initialObject->abstract = 0; initialObject->reactive = 1; #endif /* ================================================================================ INSTANCE-ADDRESS is-a INSTANCE and ADDRESS. The links between INSTANCE-ADDRESS and ADDRESS still need to be made. =============================================================================== */ AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->directSuperclasses,address,-1); AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->allSuperclasses,address,2); AddClassLink(theEnv,&address->directSubclasses,DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS],-1); /* ======================================================================= The order of the class in the list MUST correspond to their type codes! See CONSTANT.H ======================================================================= */ AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FLOAT]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INTEGER]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[SYMBOL]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[STRING]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]); AddConstructToModule((struct constructHeader *) any); AddConstructToModule((struct constructHeader *) primitive); AddConstructToModule((struct constructHeader *) number); AddConstructToModule((struct constructHeader *) lexeme); AddConstructToModule((struct constructHeader *) address); AddConstructToModule((struct constructHeader *) instance); AddConstructToModule((struct constructHeader *) user); #if DEFRULE_CONSTRUCT AddConstructToModule((struct constructHeader *) initialObject); #endif for (any = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; any != NULL ; any = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) any)) AssignClassID(theEnv,any); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************* NAME : SetupDefclasses DESCRIPTION : Initializes Class Hash Table, Function Parsers, and Data Structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : NOTES : None *********************************************************/ static void SetupDefclasses( void *theEnv) { InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR); DefclassData(theEnv)->DefclassModuleIndex = RegisterModuleItem(theEnv,"defclass", #if (! RUN_TIME) AllocateModule,ReturnModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefclassModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefclassCModuleReference, #else NULL, #endif EnvFindDefclassInModule); DefclassData(theEnv)->DefclassConstruct = AddConstruct(theEnv,"defclass","defclasses", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDefclass, #else NULL, #endif EnvFindDefclass, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefclass, SetNextConstruct,EnvIsDefclassDeletable, EnvUndefclass, #if (! RUN_TIME) RemoveDefclass #else NULL #endif ); AddClearReadyFunction(theEnv,"defclass",InstancesPurge,0); #if ! RUN_TIME EnvAddClearFunction(theEnv,"defclass",CreateSystemClasses,0); InitializeClasses(theEnv); #if ! BLOAD_ONLY #if DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"defclass",SYMBOL); AddAfterModuleDefinedFunction(theEnv,"defclass",UpdateDefclassesScope,0); #endif EnvDefineFunction2(theEnv,"undefclass",'v',PTIEF UndefclassCommand,"UndefclassCommand","11w"); AddSaveFunction(theEnv,"defclass",SaveDefclasses,10); #endif #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-defclasses",'v',PTIEF ListDefclassesCommand,"ListDefclassesCommand","01"); EnvDefineFunction2(theEnv,"ppdefclass",'v',PTIEF PPDefclassCommand,"PPDefclassCommand","11w"); EnvDefineFunction2(theEnv,"describe-class",'v',PTIEF DescribeClassCommand,"DescribeClassCommand","11w"); EnvDefineFunction2(theEnv,"browse-classes",'v',PTIEF BrowseClassesCommand,"BrowseClassesCommand","01w"); #endif EnvDefineFunction2(theEnv,"get-defclass-list",'m',PTIEF GetDefclassListFunction, "GetDefclassListFunction","01"); EnvDefineFunction2(theEnv,"superclassp",'b',PTIEF SuperclassPCommand,"SuperclassPCommand","22w"); EnvDefineFunction2(theEnv,"subclassp",'b',PTIEF SubclassPCommand,"SubclassPCommand","22w"); EnvDefineFunction2(theEnv,"class-existp",'b',PTIEF ClassExistPCommand,"ClassExistPCommand","11w"); EnvDefineFunction2(theEnv,"message-handler-existp",'b', PTIEF MessageHandlerExistPCommand,"MessageHandlerExistPCommand","23w"); EnvDefineFunction2(theEnv,"class-abstractp",'b',PTIEF ClassAbstractPCommand,"ClassAbstractPCommand","11w"); #if DEFRULE_CONSTRUCT EnvDefineFunction2(theEnv,"class-reactivep",'b',PTIEF ClassReactivePCommand,"ClassReactivePCommand","11w"); #endif EnvDefineFunction2(theEnv,"class-slots",'m',PTIEF ClassSlotsCommand,"ClassSlotsCommand","12w"); EnvDefineFunction2(theEnv,"class-superclasses",'m', PTIEF ClassSuperclassesCommand,"ClassSuperclassesCommand","12w"); EnvDefineFunction2(theEnv,"class-subclasses",'m', PTIEF ClassSubclassesCommand,"ClassSubclassesCommand","12w"); EnvDefineFunction2(theEnv,"get-defmessage-handler-list",'m', PTIEF GetDefmessageHandlersListCmd,"GetDefmessageHandlersListCmd","02w"); EnvDefineFunction2(theEnv,"slot-existp",'b',PTIEF SlotExistPCommand,"SlotExistPCommand","23w"); EnvDefineFunction2(theEnv,"slot-facets",'m',PTIEF SlotFacetsCommand,"SlotFacetsCommand","22w"); EnvDefineFunction2(theEnv,"slot-sources",'m',PTIEF SlotSourcesCommand,"SlotSourcesCommand","22w"); EnvDefineFunction2(theEnv,"slot-types",'m',PTIEF SlotTypesCommand,"SlotTypesCommand","22w"); EnvDefineFunction2(theEnv,"slot-allowed-values",'m',PTIEF SlotAllowedValuesCommand,"SlotAllowedValuesCommand","22w"); EnvDefineFunction2(theEnv,"slot-allowed-classes",'m',PTIEF SlotAllowedClassesCommand,"SlotAllowedClassesCommand","22w"); EnvDefineFunction2(theEnv,"slot-range",'m',PTIEF SlotRangeCommand,"SlotRangeCommand","22w"); EnvDefineFunction2(theEnv,"slot-cardinality",'m',PTIEF SlotCardinalityCommand,"SlotCardinalityCommand","22w"); EnvDefineFunction2(theEnv,"slot-writablep",'b',PTIEF SlotWritablePCommand,"SlotWritablePCommand","22w"); EnvDefineFunction2(theEnv,"slot-initablep",'b',PTIEF SlotInitablePCommand,"SlotInitablePCommand","22w"); EnvDefineFunction2(theEnv,"slot-publicp",'b',PTIEF SlotPublicPCommand,"SlotPublicPCommand","22w"); EnvDefineFunction2(theEnv,"slot-direct-accessp",'b',PTIEF SlotDirectAccessPCommand, "SlotDirectAccessPCommand","22w"); EnvDefineFunction2(theEnv,"slot-default-value",'u',PTIEF SlotDefaultValueCommand, "SlotDefaultValueCommand","22w"); EnvDefineFunction2(theEnv,"defclass-module",'w',PTIEF GetDefclassModuleCommand, "GetDefclassModuleCommand","11w"); EnvDefineFunction2(theEnv,"get-class-defaults-mode", 'w', PTIEF GetClassDefaultsModeCommand, "GetClassDefaultsModeCommand", "00"); EnvDefineFunction2(theEnv,"set-class-defaults-mode", 'w', PTIEF SetClassDefaultsModeCommand, "SetClassDefaultsModeCommand", "11w"); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint); AddWatchItem(theEnv,"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint); #endif } #if (! RUN_TIME) /********************************************************* NAME : AddSystemClass DESCRIPTION : Performs all necessary allocations for adding a system class INPUTS : 1) The name-string of the system class 2) The address of the parent class (NULL if none) RETURNS : The address of the new system class SIDE EFFECTS : Allocations performed NOTES : Assumes system-class name is unique Also assumes SINGLE INHERITANCE for system classes to simplify precedence list determination Adds classes to has table but NOT to class list (this is responsibility of caller) *********************************************************/ static DEFCLASS *AddSystemClass( void *theEnv, const char *name, DEFCLASS *parent) { DEFCLASS *sys; long i; char defaultScopeMap[1]; sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name)); sys->abstract = 1; #if DEFRULE_CONSTRUCT sys->reactive = 0; #endif IncrementSymbolCount(sys->header.name); sys->installed = 1; sys->system = 1; sys->hashTableIndex = HashClass(sys->header.name); AddClassLink(theEnv,&sys->allSuperclasses,sys,-1); if (parent != NULL) { AddClassLink(theEnv,&sys->directSuperclasses,parent,-1); AddClassLink(theEnv,&parent->directSubclasses,sys,-1); AddClassLink(theEnv,&sys->allSuperclasses,parent,-1); for (i = 1 ; i < parent->allSuperclasses.classCount ; i++) AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1); } sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex]; DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys; /* ========================================= Add default scope maps for a system class There is only one module (MAIN) so far - which has an id of 0 ========================================= */ ClearBitString((void *) defaultScopeMap,(int) sizeof(char)); SetBitMap(defaultScopeMap,0); #if DEFMODULE_CONSTRUCT sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char)); IncrementBitMapCount(sys->scopeMap); #endif return(sys); } /***************************************************** NAME : AllocateModule DESCRIPTION : Creates and initializes a list of defclasses for a new module INPUTS : None RETURNS : The new defclass module SIDE EFFECTS : Defclass module created NOTES : None *****************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,defclassModule)); } /*************************************************** NAME : ReturnModule DESCRIPTION : Removes a defclass module and all associated defclasses INPUTS : The defclass module RETURNS : Nothing useful SIDE EFFECTS : Module and defclasses deleted NOTES : None ***************************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefclassData(theEnv)->DefclassConstruct); DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,ISA_ID)); DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,NAME_ID)); rtn_struct(theEnv,defclassModule,theItem); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT /*************************************************** NAME : UpdateDefclassesScope DESCRIPTION : This function updates the scope bitmaps for existing classes when a new module is defined INPUTS : None RETURNS : Nothing SIDE EFFECTS : Class scope bitmaps are updated NOTES : None ***************************************************/ static void UpdateDefclassesScope( void *theEnv) { register unsigned i; DEFCLASS *theDefclass; int newModuleID,count; char *newScopeMap; unsigned newScopeMapSize; const char *className; struct defmodule *matchModule; newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID; newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1)); newScopeMap = (char *) gm2(theEnv,newScopeMapSize); for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) for (theDefclass = DefclassData(theEnv)->ClassTable[i] ; theDefclass != NULL ; theDefclass = theDefclass->nxtHash) { matchModule = theDefclass->header.whichModule->theModule; className = ValueToString(theDefclass->header.name); ClearBitString((void *) newScopeMap,newScopeMapSize); GenCopyMemory(char,theDefclass->scopeMap->size, newScopeMap,ValueToBitMap(theDefclass->scopeMap)); DecrementBitMapCount(theEnv,theDefclass->scopeMap); if (theDefclass->system) SetBitMap(newScopeMap,newModuleID); else if (FindImportedConstruct(theEnv,"defclass",matchModule, className,&count,TRUE,NULL) != NULL) SetBitMap(newScopeMap,newModuleID); theDefclass->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize); IncrementBitMapCount(theDefclass->scopeMap); } rm(theEnv,(void *) newScopeMap,newScopeMapSize); } #endif #endif clips_core_source_630/core/reteutil.h0000755000175000017500000001513512500146515016243 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RETE UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for join network changes. */ /* */ /* Support for using an asterick (*) to indicate */ /* that existential patterns are matched. */ /* */ /* Support for partial match changes. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added support for hashed memories. */ /* */ /* Removed pseudo-facts used in not CEs. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_reteutil #define _H_reteutil #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RETEUTIL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define NETWORK_ASSERT 0 #define NETWORK_RETRACT 1 LOCALE void PrintPartialMatch(void *,const char *,struct partialMatch *); LOCALE struct partialMatch *CopyPartialMatch(void *,struct partialMatch *); LOCALE struct partialMatch *MergePartialMatches(void *,struct partialMatch *,struct partialMatch *); LOCALE long int IncrementPseudoFactIndex(void); LOCALE struct partialMatch *GetAlphaMemory(void *,struct patternNodeHeader *,unsigned long); LOCALE struct partialMatch *GetLeftBetaMemory(struct joinNode *,unsigned long); LOCALE struct partialMatch *GetRightBetaMemory(struct joinNode *,unsigned long); LOCALE void ReturnLeftMemory(void *,struct joinNode *); LOCALE void ReturnRightMemory(void *,struct joinNode *); LOCALE void DestroyBetaMemory(void *,struct joinNode *,int); LOCALE void FlushBetaMemory(void *,struct joinNode *,int); LOCALE intBool BetaMemoryNotEmpty(struct joinNode *); LOCALE void RemoveAlphaMemoryMatches(void *,struct patternNodeHeader *,struct partialMatch *, struct alphaMatch *); LOCALE void DestroyAlphaMemory(void *,struct patternNodeHeader *,int); LOCALE void FlushAlphaMemory(void *,struct patternNodeHeader *); LOCALE void FlushAlphaBetaMemory(void *,struct partialMatch *); LOCALE void DestroyAlphaBetaMemory(void *,struct partialMatch *); LOCALE int GetPatternNumberFromJoin(struct joinNode *); LOCALE struct multifieldMarker *CopyMultifieldMarkers(void *,struct multifieldMarker *); LOCALE struct partialMatch *CreateAlphaMatch(void *,void *,struct multifieldMarker *, struct patternNodeHeader *,unsigned long); LOCALE void TraceErrorToRule(void *,struct joinNode *,const char *); LOCALE void InitializePatternHeader(void *,struct patternNodeHeader *); LOCALE void MarkRuleNetwork(void *,int); LOCALE void TagRuleNetwork(void *,long *,long *,long *,long *); LOCALE int FindEntityInPartialMatch(struct patternEntity *,struct partialMatch *); LOCALE unsigned long ComputeRightHashValue(void *,struct patternNodeHeader *); LOCALE void UpdateBetaPMLinks(void *,struct partialMatch *,struct partialMatch *,struct partialMatch *, struct joinNode *,unsigned long,int); LOCALE void UnlinkBetaPMFromNodeAndLineage(void *,struct joinNode *,struct partialMatch *,int); LOCALE void UnlinkNonLeftLineage(void *,struct joinNode *,struct partialMatch *,int); LOCALE struct partialMatch *CreateEmptyPartialMatch(void *); LOCALE void MarkRuleJoins(struct joinNode *,int); LOCALE void AddBlockedLink(struct partialMatch *,struct partialMatch *); LOCALE void RemoveBlockedLink(struct partialMatch *); LOCALE unsigned long PrintBetaMemory(void *,const char *,struct betaMemory *,int,const char *,int); #endif /* _H_reteutil */ clips_core_source_630/core/dfinsbin.c0000755000175000017500000004666212373731174016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Definstances */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFINSTANCES_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "memalloc.h" #include "cstrcbin.h" #include "defins.h" #include "modulbin.h" #define _DFINSBIN_SOURCE_ #include "dfinsbin.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct bsaveDefinstancesModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFINSTANCES_MODULE; typedef struct bsaveDefinstances { struct bsaveConstructHeader header; long mkinstance; } BSAVE_DEFINSTANCES; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveDefinstancesFind(void *); static void MarkDefinstancesItems(void *,struct constructHeader *,void *); static void BsaveDefinstancesExpressions(void *,FILE *); static void BsaveDefinstancesExpression(void *,struct constructHeader *,void *); static void BsaveStorageDefinstances(void *,FILE *); static void BsaveDefinstancesDriver(void *,FILE *); static void BsaveDefinstances(void *,struct constructHeader *,void *); #endif static void BloadStorageDefinstances(void *); static void BloadDefinstances(void *); static void UpdateDefinstancesModule(void *,void *,long); static void UpdateDefinstances(void *,void *,long); static void ClearDefinstancesBload(void *); static void DeallocateDefinstancesBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupDefinstancesBload DESCRIPTION : Initializes data structures and routines for binary loads of definstances INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupDefinstancesBload( void *theEnv) { AllocateEnvironmentData(theEnv,DFINSBIN_DATA,sizeof(struct definstancesBinaryData),DeallocateDefinstancesBinaryData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"definstances",0,BsaveDefinstancesFind,BsaveDefinstancesExpressions, BsaveStorageDefinstances,BsaveDefinstancesDriver, BloadStorageDefinstances,BloadDefinstances, ClearDefinstancesBload); #else AddBinaryItem(theEnv,"definstances",0,NULL,NULL,NULL,NULL, BloadStorageDefinstances,BloadDefinstances, ClearDefinstancesBload); #endif } /*************************************************************/ /* DeallocateDefinstancesBinaryData: Deallocates environment */ /* data for the definstances binary functionality. */ /*************************************************************/ static void DeallocateDefinstancesBinaryData( void *theEnv) { size_t space; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) space = DefinstancesBinaryData(theEnv)->DefinstancesCount * sizeof(struct definstances); if (space != 0) genfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray,space); space = DefinstancesBinaryData(theEnv)->ModuleCount * sizeof(struct definstancesModule); if (space != 0) genfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->ModuleArray,space); #endif } /*************************************************** NAME : BloadDefinstancesModuleRef DESCRIPTION : Returns a pointer to the appropriate definstances module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDefinstancesModuleRef( void *theEnv, int theIndex) { return ((void *) &DefinstancesBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveDefinstancesFind DESCRIPTION : For all definstances, this routine marks all the needed symbols. Also, it also counts the number of expression structures needed. Also, counts total number of definstances. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols are marked in their structures NOTES : Also sets bsaveIndex for each definstances (assumes definstances will be bsaved in order of binary list) ***************************************************************************/ static void BsaveDefinstancesFind( void *theEnv) { SaveBloadCount(theEnv,DefinstancesBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,DefinstancesBinaryData(theEnv)->DefinstancesCount); DefinstancesBinaryData(theEnv)->DefinstancesCount = 0L; DefinstancesBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDefinstancesItems,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,NULL); } /*************************************************** NAME : MarkDefinstancesItems DESCRIPTION : Marks the needed items for a definstances bsave INPUTS : 1) The definstances 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Needed items marked NOTES : None ***************************************************/ static void MarkDefinstancesItems( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { #if MAC_XCD #pragma unused(userBuffer) #endif MarkConstructHeaderNeededItems(theDefinstances,DefinstancesBinaryData(theEnv)->DefinstancesCount++); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(((DEFINSTANCES *) theDefinstances)->mkinstance); MarkNeededItems(theEnv,((DEFINSTANCES *) theDefinstances)->mkinstance); } /*************************************************** NAME : BsaveDefinstancesExpressions DESCRIPTION : Writes out all expressions needed by deffunctyions INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveDefinstancesExpressions( void *theEnv, FILE *fp) { DoForAllConstructs(theEnv,BsaveDefinstancesExpression,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveDefinstancesExpression DESCRIPTION : Saves the needed expressions for a definstances bsave INPUTS : 1) The definstances 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Expressions saved NOTES : None ***************************************************/ static void BsaveDefinstancesExpression( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { BsaveExpression(theEnv,((DEFINSTANCES *) theDefinstances)->mkinstance,(FILE *) userBuffer); } /*********************************************************** NAME : BsaveStorageDefinstances DESCRIPTION : Writes out number of each type of structure required for definstances Space required for counts (unsigned long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ***********************************************************/ static void BsaveStorageDefinstances( void *theEnv, FILE *fp) { size_t space; space = sizeof(unsigned long) * 2; GenWrite((void *) &space,sizeof(size_t),fp); GenWrite((void *) &DefinstancesBinaryData(theEnv)->ModuleCount,sizeof(unsigned long),fp); GenWrite((void *) &DefinstancesBinaryData(theEnv)->DefinstancesCount,sizeof(unsigned long),fp); } /************************************************************************************* NAME : BsaveDefinstancesDriver DESCRIPTION : Writes out definstances in binary format Space required (unsigned long) All definstances (sizeof(DEFINSTANCES) * Number of definstances) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveDefinstancesDriver( void *theEnv, FILE *fp) { size_t space; struct defmodule *theModule; DEFINSTANCES_MODULE *theModuleItem; BSAVE_DEFINSTANCES_MODULE dummy_mitem; space = ((sizeof(BSAVE_DEFINSTANCES_MODULE) * DefinstancesBinaryData(theEnv)->ModuleCount) + (sizeof(BSAVE_DEFINSTANCES) * DefinstancesBinaryData(theEnv)->DefinstancesCount)); GenWrite((void *) &space,sizeof(size_t),fp); /* ================================= Write out each definstances module ================================= */ DefinstancesBinaryData(theEnv)->DefinstancesCount = 0L; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFINSTANCES_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"definstances")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_mitem.header,&theModuleItem->header); GenWrite((void *) &dummy_mitem,sizeof(BSAVE_DEFINSTANCES_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ========================== Write out each definstances ========================== */ DoForAllConstructs(theEnv,BsaveDefinstances,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,(void *) fp); RestoreBloadCount(theEnv,&DefinstancesBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&DefinstancesBinaryData(theEnv)->DefinstancesCount); } /*************************************************** NAME : BsaveDefinstances DESCRIPTION : Bsaves a definstances INPUTS : 1) The definstances 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Definstances saved NOTES : None ***************************************************/ static void BsaveDefinstances( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { DEFINSTANCES *dptr = (DEFINSTANCES *) theDefinstances; BSAVE_DEFINSTANCES dummy_df; AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header); if (dptr->mkinstance != NULL) { dummy_df.mkinstance = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->mkinstance); } else dummy_df.mkinstance = -1L; GenWrite((void *) &dummy_df,(unsigned long) sizeof(BSAVE_DEFINSTANCES),(FILE *) userBuffer); } #endif /*********************************************************************** NAME : BloadStorageDefinstances DESCRIPTION : This routine space required for definstances structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageDefinstances( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; GenReadBinary(theEnv,(void *) &DefinstancesBinaryData(theEnv)->ModuleCount,sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &DefinstancesBinaryData(theEnv)->DefinstancesCount,sizeof(unsigned long)); if (DefinstancesBinaryData(theEnv)->ModuleCount == 0L) { DefinstancesBinaryData(theEnv)->ModuleArray = NULL; DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; return; } space = (DefinstancesBinaryData(theEnv)->ModuleCount * sizeof(DEFINSTANCES_MODULE)); DefinstancesBinaryData(theEnv)->ModuleArray = (DEFINSTANCES_MODULE *) genalloc(theEnv,space); if (DefinstancesBinaryData(theEnv)->DefinstancesCount == 0L) { DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; return; } space = (DefinstancesBinaryData(theEnv)->DefinstancesCount * sizeof(DEFINSTANCES)); DefinstancesBinaryData(theEnv)->DefinstancesArray = (DEFINSTANCES *) genalloc(theEnv,space); } /********************************************************************* NAME : BloadDefinstances DESCRIPTION : This routine reads definstances information from a binary file This routine moves through the definstances binary array updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished ********************************************************************/ static void BloadDefinstances( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); BloadandRefresh(theEnv,DefinstancesBinaryData(theEnv)->ModuleCount,sizeof(BSAVE_DEFINSTANCES_MODULE),UpdateDefinstancesModule); BloadandRefresh(theEnv,DefinstancesBinaryData(theEnv)->DefinstancesCount,sizeof(BSAVE_DEFINSTANCES),UpdateDefinstances); } /******************************************************* NAME : UpdateDefinstancesModule DESCRIPTION : Updates definstances module with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Definstances moudle pointers updated NOTES : None *******************************************************/ static void UpdateDefinstancesModule( void *theEnv, void *buf, long obji) { BSAVE_DEFINSTANCES_MODULE *bdptr; bdptr = (BSAVE_DEFINSTANCES_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&DefinstancesBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFINSTANCES),(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray); } /*************************************************** NAME : UpdateDefinstances DESCRIPTION : Updates definstances with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Definstances pointers upadted NOTES : None ***************************************************/ static void UpdateDefinstances( void *theEnv, void *buf, long obji) { BSAVE_DEFINSTANCES *bdptr; DEFINSTANCES *dfiptr; bdptr = (BSAVE_DEFINSTANCES *) buf; dfiptr = (DEFINSTANCES *) &DefinstancesBinaryData(theEnv)->DefinstancesArray[obji]; UpdateConstructHeader(theEnv,&bdptr->header,&dfiptr->header, (int) sizeof(DEFINSTANCES_MODULE),(void *) DefinstancesBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFINSTANCES),(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray); dfiptr->mkinstance = ExpressionPointer(bdptr->mkinstance); dfiptr->busy = 0; } /*************************************************************** NAME : ClearDefinstancesBload DESCRIPTION : Release all binary-loaded definstances structure arrays Resets definstances list to NULL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : Definstances name symbol counts decremented ***************************************************************/ static void ClearDefinstancesBload( void *theEnv) { register long i; size_t space; space = (sizeof(DEFINSTANCES_MODULE) * DefinstancesBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->ModuleArray,space); DefinstancesBinaryData(theEnv)->ModuleArray = NULL; DefinstancesBinaryData(theEnv)->ModuleCount = 0L; for (i = 0L ; i < DefinstancesBinaryData(theEnv)->DefinstancesCount ; i++) UnmarkConstructHeader(theEnv,&DefinstancesBinaryData(theEnv)->DefinstancesArray[i].header); space = (sizeof(DEFINSTANCES) * DefinstancesBinaryData(theEnv)->DefinstancesCount); if (space == 0L) return; genfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray,space); DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; DefinstancesBinaryData(theEnv)->DefinstancesCount = 0L; } #endif clips_core_source_630/core/cstrcbin.h0000755000175000017500000000375412373714231016225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrcbin #define _H_cstrcbin #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE struct bsaveConstructHeader { long name; long whichModule; long next; }; #ifndef _H_constrct #include "constrct.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if BLOAD_AND_BSAVE LOCALE void MarkConstructHeaderNeededItems(struct constructHeader *,long); LOCALE void AssignBsaveConstructHeaderVals(struct bsaveConstructHeader *, struct constructHeader *); #endif LOCALE void UpdateConstructHeader(void *, struct bsaveConstructHeader *, struct constructHeader *,int,void *,int,void *); LOCALE void UnmarkConstructHeader(void *,struct constructHeader *); #ifndef _CSTRCBIN_SOURCE_ #endif #endif #endif clips_core_source_630/core/incrrset.h0000755000175000017500000000626112373755061016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INCREMENTAL RESET HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality for the incremental */ /* reset of the pattern and join networks when a new */ /* rule is added. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed alpha memories and */ /* other join network changes. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Modified EnvSetIncrementalReset to check for */ /* the existance of rules. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_incrrset #define _H_incrrset #ifndef _H_ruledef #include "ruledef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INCRRSET_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void IncrementalReset(void *,struct defrule *); LOCALE intBool EnvGetIncrementalReset(void *); LOCALE intBool EnvSetIncrementalReset(void *,intBool); LOCALE int GetIncrementalResetCommand(void *); LOCALE int SetIncrementalResetCommand(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool GetIncrementalReset(void); LOCALE intBool SetIncrementalReset(int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_incrrset */ clips_core_source_630/core/._dffctdef.h0000755000175000017500000000040712461253173016371 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxbin.c0000755000175000017500000004734112373721221016204 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Deffunctions */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "memalloc.h" #include "cstrcbin.h" #include "envrnmnt.h" #include "modulbin.h" #define _DFFNXBIN_SOURCE_ #include "dffnxbin.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct bsaveDeffunctionModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFFUNCTION_MODULE; typedef struct bsaveDeffunctionStruct { struct bsaveConstructHeader header; int minNumberOfParameters, maxNumberOfParameters, numberOfLocalVars; long name, code; } BSAVE_DEFFUNCTION; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveDeffunctionFind(void *); static void MarkDeffunctionItems(void *,struct constructHeader *,void *); static void BsaveDeffunctionExpressions(void *,FILE *); static void BsaveDeffunctionExpression(void *,struct constructHeader *,void *); static void BsaveStorageDeffunctions(void *,FILE *); static void BsaveDeffunctions(void *,FILE *); static void BsaveDeffunction(void *,struct constructHeader *,void *); #endif static void BloadStorageDeffunctions(void *); static void BloadDeffunctions(void *); static void UpdateDeffunctionModule(void *,void *,long); static void UpdateDeffunction(void *,void *,long); static void ClearDeffunctionBload(void *); static void DeallocateDeffunctionBloadData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupDeffunctionsBload DESCRIPTION : Initializes data structures and routines for binary loads of deffunctions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupDeffunctionsBload( void *theEnv) { AllocateEnvironmentData(theEnv,DFFNXBIN_DATA,sizeof(struct deffunctionBinaryData),DeallocateDeffunctionBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"deffunctions",0,BsaveDeffunctionFind,BsaveDeffunctionExpressions, BsaveStorageDeffunctions,BsaveDeffunctions, BloadStorageDeffunctions,BloadDeffunctions, ClearDeffunctionBload); #else AddBinaryItem(theEnv,"deffunctions",0,NULL,NULL,NULL,NULL, BloadStorageDeffunctions,BloadDeffunctions, ClearDeffunctionBload); #endif } /***********************************************************/ /* DeallocateDeffunctionBloadData: Deallocates environment */ /* data for the deffunction bsave functionality. */ /***********************************************************/ static void DeallocateDeffunctionBloadData( void *theEnv) { size_t space; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) space = DeffunctionBinaryData(theEnv)->DeffunctionCount * sizeof(struct deffunctionStruct); if (space != 0) genfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray,space); space = DeffunctionBinaryData(theEnv)->ModuleCount * sizeof(struct deffunctionModule); if (space != 0) genfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->ModuleArray,space); #endif } /*************************************************** NAME : BloadDeffunctionModuleReference DESCRIPTION : Returns a pointer to the appropriate deffunction module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDeffunctionModuleReference( void *theEnv, int theIndex) { return ((void *) &DeffunctionBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveDeffunctionFind DESCRIPTION : For all deffunctions, this routine marks all the needed symbols. Also, it also counts the number of expression structures needed. Also, counts total number of deffunctions. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols are marked in their structures NOTES : Also sets bsaveIndex for each deffunction (assumes deffunctions will be bsaved in order of binary list) ***************************************************************************/ static void BsaveDeffunctionFind( void *theEnv) { SaveBloadCount(theEnv,DeffunctionBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,DeffunctionBinaryData(theEnv)->DeffunctionCount); DeffunctionBinaryData(theEnv)->DeffunctionCount = 0L; DeffunctionBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDeffunctionItems,DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,NULL); } /*************************************************** NAME : MarkDeffunctionItems DESCRIPTION : Marks the needed items for a deffunction bsave INPUTS : 1) The deffunction 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Needed items marked NOTES : None ***************************************************/ static void MarkDeffunctionItems( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { #if MAC_XCD #pragma unused(userBuffer) #endif MarkConstructHeaderNeededItems(theDeffunction,DeffunctionBinaryData(theEnv)->DeffunctionCount++); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(((DEFFUNCTION *) theDeffunction)->code); MarkNeededItems(theEnv,((DEFFUNCTION *) theDeffunction)->code); } /*************************************************** NAME : BsaveDeffunctionExpressions DESCRIPTION : Writes out all expressions needed by deffunctyions INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveDeffunctionExpressions( void *theEnv, FILE *fp) { DoForAllConstructs(theEnv,BsaveDeffunctionExpression,DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveDeffunctionExpression DESCRIPTION : Saves the needed expressions for a deffunction bsave INPUTS : 1) The deffunction 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Expressions saved NOTES : None ***************************************************/ static void BsaveDeffunctionExpression( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { BsaveExpression(theEnv,((DEFFUNCTION *) theDeffunction)->code,(FILE *) userBuffer); } /*********************************************************** NAME : BsaveStorageDeffunctions DESCRIPTION : Writes out number of each type of structure required for deffunctions Space required for counts (unsigned long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ***********************************************************/ static void BsaveStorageDeffunctions( void *theEnv, FILE *fp) { size_t space; space = sizeof(unsigned long) * 2; GenWrite((void *) &space,sizeof(size_t),fp); GenWrite((void *) &DeffunctionBinaryData(theEnv)->ModuleCount,sizeof(unsigned long),fp); GenWrite((void *) &DeffunctionBinaryData(theEnv)->DeffunctionCount,sizeof(unsigned long),fp); } /************************************************************************************* NAME : BsaveDeffunctions DESCRIPTION : Writes out deffunction in binary format Space required (unsigned long) All deffunctions (sizeof(DEFFUNCTION) * Number of deffunctions) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveDeffunctions( void *theEnv, FILE *fp) { size_t space; struct defmodule *theModule; DEFFUNCTION_MODULE *theModuleItem; BSAVE_DEFFUNCTION_MODULE dummy_mitem; space = ((sizeof(BSAVE_DEFFUNCTION_MODULE) * DeffunctionBinaryData(theEnv)->ModuleCount) + (sizeof(BSAVE_DEFFUNCTION) * DeffunctionBinaryData(theEnv)->DeffunctionCount)); GenWrite((void *) &space,sizeof(size_t),fp); /* ================================= Write out each deffunction module ================================= */ DeffunctionBinaryData(theEnv)->DeffunctionCount = 0L; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFFUNCTION_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"deffunction")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_mitem.header,&theModuleItem->header); GenWrite((void *) &dummy_mitem,sizeof(BSAVE_DEFFUNCTION_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ========================== Write out each deffunction ========================== */ DoForAllConstructs(theEnv,BsaveDeffunction,DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,(void *) fp); RestoreBloadCount(theEnv,&DeffunctionBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&DeffunctionBinaryData(theEnv)->DeffunctionCount); } /*************************************************** NAME : BsaveDeffunction DESCRIPTION : Bsaves a deffunction INPUTS : 1) The deffunction 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Deffunction saved NOTES : None ***************************************************/ static void BsaveDeffunction( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { DEFFUNCTION *dptr = (DEFFUNCTION *) theDeffunction; BSAVE_DEFFUNCTION dummy_df; AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header); dummy_df.minNumberOfParameters = dptr->minNumberOfParameters; dummy_df.maxNumberOfParameters = dptr->maxNumberOfParameters; dummy_df.numberOfLocalVars = dptr->numberOfLocalVars; if (dptr->code != NULL) { dummy_df.code = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->code); } else dummy_df.code = -1L; GenWrite((void *) &dummy_df,sizeof(BSAVE_DEFFUNCTION),(FILE *) userBuffer); } #endif /*********************************************************************** NAME : BloadStorageDeffunctions DESCRIPTION : This routine space required for deffunction structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageDeffunctions( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; GenReadBinary(theEnv,(void *) &DeffunctionBinaryData(theEnv)->ModuleCount,sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &DeffunctionBinaryData(theEnv)->DeffunctionCount,sizeof(unsigned long)); if (DeffunctionBinaryData(theEnv)->ModuleCount == 0L) { DeffunctionBinaryData(theEnv)->ModuleArray = NULL; DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; return; } space = (DeffunctionBinaryData(theEnv)->ModuleCount * sizeof(DEFFUNCTION_MODULE)); DeffunctionBinaryData(theEnv)->ModuleArray = (DEFFUNCTION_MODULE *) genalloc(theEnv,space); if (DeffunctionBinaryData(theEnv)->DeffunctionCount == 0L) { DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; return; } space = (DeffunctionBinaryData(theEnv)->DeffunctionCount * sizeof(DEFFUNCTION)); DeffunctionBinaryData(theEnv)->DeffunctionArray = (DEFFUNCTION *) genalloc(theEnv,space); } /********************************************************************* NAME : BloadDeffunctions DESCRIPTION : This routine reads deffunction information from a binary file This routine moves through the deffunction binary array updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished ********************************************************************/ static void BloadDeffunctions( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); BloadandRefresh(theEnv,DeffunctionBinaryData(theEnv)->ModuleCount,sizeof(BSAVE_DEFFUNCTION_MODULE),UpdateDeffunctionModule); BloadandRefresh(theEnv,DeffunctionBinaryData(theEnv)->DeffunctionCount,sizeof(BSAVE_DEFFUNCTION),UpdateDeffunction); } /******************************************************* NAME : UpdateDeffunctionModule DESCRIPTION : Updates deffunction module with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Deffunction moudle pointers updated NOTES : None *******************************************************/ static void UpdateDeffunctionModule( void *theEnv, void *buf, long obji) { BSAVE_DEFFUNCTION_MODULE *bdptr; bdptr = (BSAVE_DEFFUNCTION_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&DeffunctionBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFFUNCTION),(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray); } /*************************************************** NAME : UpdateDeffunction DESCRIPTION : Updates deffunction with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Deffunction pointers upadted NOTES : None ***************************************************/ static void UpdateDeffunction( void *theEnv, void *buf, long obji) { BSAVE_DEFFUNCTION *bdptr; DEFFUNCTION *dptr; bdptr = (BSAVE_DEFFUNCTION *) buf; dptr = (DEFFUNCTION *) &DeffunctionBinaryData(theEnv)->DeffunctionArray[obji]; UpdateConstructHeader(theEnv,&bdptr->header,&dptr->header, (int) sizeof(DEFFUNCTION_MODULE),(void *) DeffunctionBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFFUNCTION),(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray); dptr->code = ExpressionPointer(bdptr->code); dptr->busy = 0; dptr->executing = 0; #if DEBUGGING_FUNCTIONS dptr->trace = (unsigned short) DeffunctionData(theEnv)->WatchDeffunctions; #endif dptr->minNumberOfParameters = bdptr->minNumberOfParameters; dptr->maxNumberOfParameters = bdptr->maxNumberOfParameters; dptr->numberOfLocalVars = bdptr->numberOfLocalVars; } /*************************************************************** NAME : ClearDeffunctionBload DESCRIPTION : Release all binary-loaded deffunction structure arrays Resets deffunction list to NULL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : Deffunction name symbol counts decremented ***************************************************************/ static void ClearDeffunctionBload( void *theEnv) { register long i; size_t space; space = (sizeof(DEFFUNCTION_MODULE) * DeffunctionBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->ModuleArray,space); DeffunctionBinaryData(theEnv)->ModuleArray = NULL; DeffunctionBinaryData(theEnv)->ModuleCount = 0L; for (i = 0L ; i < DeffunctionBinaryData(theEnv)->DeffunctionCount ; i++) UnmarkConstructHeader(theEnv,&DeffunctionBinaryData(theEnv)->DeffunctionArray[i].header); space = (sizeof(DEFFUNCTION) * DeffunctionBinaryData(theEnv)->DeffunctionCount); if (space == 0L) return; genfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray,space); DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; DeffunctionBinaryData(theEnv)->DeffunctionCount = 0L; } #endif clips_core_source_630/core/rulecom.c0000755000175000017500000014443112375756721016071 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* RULE COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the matches command. Also provides the */ /* the developer commands show-joins and rule-complexity. */ /* Also provides the initialization routine which */ /* registers rule commands found in other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* INCREMENTAL_RESET, and LOGICAL_DEPENDENCIES */ /* compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added support for hashed memories. */ /* */ /* Improvements to matches command. */ /* */ /* Add join-activity and join-activity-reset */ /* commands. */ /* */ /* Added get-beta-memory-resizing and */ /* set-beta-memory-resizing functions. */ /* */ /* Added timetag function. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _RULECOM_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "argacces.h" #include "constant.h" #include "constrct.h" #include "crstrtgy.h" #include "engine.h" #include "envrnmnt.h" #include "evaluatn.h" #include "extnfunc.h" #include "incrrset.h" #include "lgcldpnd.h" #include "memalloc.h" #include "multifld.h" #include "pattern.h" #include "reteutil.h" #include "router.h" #include "ruledlt.h" #include "sysdep.h" #include "watch.h" #if BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY #include "rulebin.h" #endif #include "rulecom.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEVELOPER static void ShowJoins(void *,void *); #endif #if DEBUGGING_FUNCTIONS static long long ListAlphaMatches(void *,struct joinInformation *,int); static long long ListBetaMatches(void *,struct joinInformation *,long,long,int); static void ListBetaJoinActivity(void *,struct joinInformation *,long,long,int,DATA_OBJECT *); static long AlphaJoinCountDriver(void *,struct joinNode *); static long BetaJoinCountDriver(void *,struct joinNode *); static void AlphaJoinsDriver(void *,struct joinNode *,long,struct joinInformation *); static void BetaJoinsDriver(void *,struct joinNode *,long,struct joinInformation *,struct betaMemory *,struct joinNode *); static int CountPatterns(void *,struct joinNode *,int); static const char *BetaHeaderString(void *,struct joinInformation *,long,long); static const char *ActivityHeaderString(void *,struct joinInformation *,long,long); static void JoinActivityReset(void *,struct constructHeader *,void *); #endif /****************************************************************/ /* DefruleCommands: Initializes defrule commands and functions. */ /****************************************************************/ globle void DefruleCommands( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"run",'v', PTIEF RunCommand,"RunCommand", "*1i"); EnvDefineFunction2(theEnv,"halt",'v', PTIEF HaltCommand,"HaltCommand","00"); EnvDefineFunction2(theEnv,"focus",'b', PTIEF FocusCommand,"FocusCommand", "1*w"); EnvDefineFunction2(theEnv,"clear-focus-stack",'v',PTIEF ClearFocusStackCommand, "ClearFocusStackCommand","00"); EnvDefineFunction2(theEnv,"get-focus-stack",'m',PTIEF GetFocusStackFunction, "GetFocusStackFunction","00"); EnvDefineFunction2(theEnv,"pop-focus",'w',PTIEF PopFocusFunction, "PopFocusFunction","00"); EnvDefineFunction2(theEnv,"get-focus",'w',PTIEF GetFocusFunction, "GetFocusFunction","00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"set-break",'v', PTIEF SetBreakCommand, "SetBreakCommand","11w"); EnvDefineFunction2(theEnv,"remove-break",'v', PTIEF RemoveBreakCommand, "RemoveBreakCommand", "*1w"); EnvDefineFunction2(theEnv,"show-breaks",'v', PTIEF ShowBreaksCommand, "ShowBreaksCommand", "01w"); EnvDefineFunction2(theEnv,"matches",'u',PTIEF MatchesCommand,"MatchesCommand","12w"); EnvDefineFunction2(theEnv,"join-activity",'u',PTIEF JoinActivityCommand,"JoinActivityCommand","12w"); EnvDefineFunction2(theEnv,"join-activity-reset",'v', PTIEF JoinActivityResetCommand, "JoinActivityResetCommand", "00"); EnvDefineFunction2(theEnv,"list-focus-stack",'v', PTIEF ListFocusStackCommand, "ListFocusStackCommand", "00"); EnvDefineFunction2(theEnv,"dependencies", 'v', PTIEF DependenciesCommand, "DependenciesCommand", "11h"); EnvDefineFunction2(theEnv,"dependents", 'v', PTIEF DependentsCommand, "DependentsCommand", "11h"); EnvDefineFunction2(theEnv,"timetag", 'g', PTIEF TimetagFunction, "TimetagFunction", "11h"); #endif /* DEBUGGING_FUNCTIONS */ EnvDefineFunction2(theEnv,"get-incremental-reset",'b', GetIncrementalResetCommand,"GetIncrementalResetCommand","00"); EnvDefineFunction2(theEnv,"set-incremental-reset",'b', SetIncrementalResetCommand,"SetIncrementalResetCommand","11"); EnvDefineFunction2(theEnv,"get-beta-memory-resizing",'b', GetBetaMemoryResizingCommand,"GetBetaMemoryResizingCommand","00"); EnvDefineFunction2(theEnv,"set-beta-memory-resizing",'b', SetBetaMemoryResizingCommand,"SetBetaMemoryResizingCommand","11"); EnvDefineFunction2(theEnv,"get-strategy", 'w', PTIEF GetStrategyCommand, "GetStrategyCommand", "00"); EnvDefineFunction2(theEnv,"set-strategy", 'w', PTIEF SetStrategyCommand, "SetStrategyCommand", "11w"); #if DEVELOPER && (! BLOAD_ONLY) EnvDefineFunction2(theEnv,"rule-complexity",'l', PTIEF RuleComplexityCommand,"RuleComplexityCommand", "11w"); EnvDefineFunction2(theEnv,"show-joins", 'v', PTIEF ShowJoinsCommand, "ShowJoinsCommand", "11w"); EnvDefineFunction2(theEnv,"show-aht", 'v', PTIEF ShowAlphaHashTable, "ShowAlphaHashTable", "00"); #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"rule-analysis",0,&DefruleData(theEnv)->WatchRuleAnalysis,0,NULL,NULL); #endif #endif /* DEVELOPER && (! BLOAD_ONLY) */ #else #if MAC_XCD #pragma unused(theEnv) #endif #endif /* ! RUN_TIME */ } /***********************************************/ /* EnvGetBetaMemoryResizing: C access routine */ /* for the get-beta-memory-resizing command. */ /***********************************************/ globle intBool EnvGetBetaMemoryResizing( void *theEnv) { return(DefruleData(theEnv)->BetaMemoryResizingFlag); } /***********************************************/ /* EnvSetBetaMemoryResizing: C access routine */ /* for the set-beta-memory-resizing command. */ /***********************************************/ globle intBool EnvSetBetaMemoryResizing( void *theEnv, int value) { int ov; ov = DefruleData(theEnv)->BetaMemoryResizingFlag; DefruleData(theEnv)->BetaMemoryResizingFlag = value; return(ov); } /****************************************************/ /* SetBetaMemoryResizingCommand: H/L access routine */ /* for the set-beta-memory-resizing command. */ /****************************************************/ globle int SetBetaMemoryResizingCommand( void *theEnv) { int oldValue; DATA_OBJECT argPtr; oldValue = EnvGetBetaMemoryResizing(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-beta-memory-resizing",EXACTLY,1) == -1) { return(oldValue); } /*=================================================*/ /* The symbol FALSE disables beta memory resizing. */ /* Any other value enables beta memory resizing. */ /*=================================================*/ EnvRtnUnknown(theEnv,1,&argPtr); if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL)) { EnvSetBetaMemoryResizing(theEnv,FALSE); } else { EnvSetBetaMemoryResizing(theEnv,TRUE); } /*=======================*/ /* Return the old value. */ /*=======================*/ return(oldValue); } /****************************************************/ /* GetBetaMemoryResizingCommand: H/L access routine */ /* for the get-beta-memory-resizing command. */ /****************************************************/ globle int GetBetaMemoryResizingCommand( void *theEnv) { int oldValue; oldValue = EnvGetBetaMemoryResizing(theEnv); if (EnvArgCountCheck(theEnv,"get-beta-memory-resizing",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } #if DEBUGGING_FUNCTIONS /****************************************/ /* MatchesCommand: H/L access routine */ /* for the matches command. */ /****************************************/ globle void MatchesCommand( void *theEnv, DATA_OBJECT *result) { const char *ruleName, *argument; void *rulePtr; int numberOfArguments; DATA_OBJECT argPtr; int output; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if ((numberOfArguments = EnvArgRangeCheck(theEnv,"matches",1,2)) == -1) return; if (EnvArgTypeCheck(theEnv,"matches",1,SYMBOL,&argPtr) == FALSE) return; if (GetType(argPtr) != SYMBOL) { ExpectedTypeError1(theEnv,"matches",1,"rule name"); return; } ruleName = DOToString(argPtr); rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } if (numberOfArguments == 2) { if (EnvArgTypeCheck(theEnv,"matches",2,SYMBOL,&argPtr) == FALSE) { return; } argument = DOToString(argPtr); if (strcmp(argument,"verbose") == 0) { output = VERBOSE; } else if (strcmp(argument,"succinct") == 0) { output = SUCCINCT; } else if (strcmp(argument,"terse") == 0) { output = TERSE; } else { ExpectedTypeError1(theEnv,"matches",2,"symbol with value verbose, succinct, or terse"); return; } } else { output = VERBOSE; } EnvMatches(theEnv,rulePtr,output,result); } /********************************/ /* EnvMatches: C access routine */ /* for the matches command. */ /********************************/ globle void EnvMatches( void *theEnv, void *theRule, int output, DATA_OBJECT *result) { struct defrule *rulePtr; long disjunctCount, disjunctIndex, joinIndex; long arraySize; struct joinInformation *theInfo; long long alphaMatchCount = 0; long long betaMatchCount = 0; long long activations = 0; ACTIVATION *agendaPtr; /*==========================*/ /* Set up the return value. */ /*==========================*/ result->type = MULTIFIELD; result->begin = 0; result->end = 2; result->value = EnvCreateMultifield(theEnv,3L); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,INTEGER); SetMFValue(result->value,2,SymbolData(theEnv)->Zero); SetMFType(result->value,3,INTEGER); SetMFValue(result->value,3,SymbolData(theEnv)->Zero); /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ disjunctCount = EnvGetDisjunctCount(theEnv,theRule); for (disjunctIndex = 1; disjunctIndex <= disjunctCount; disjunctIndex++) { rulePtr = (struct defrule *) EnvGetNthDisjunct(theEnv,theRule,disjunctIndex); /*===============================================*/ /* Create the array containing the list of alpha */ /* join nodes (those connected to a pattern CE). */ /*===============================================*/ arraySize = EnvAlphaJoinCount(theEnv,rulePtr); theInfo = EnvCreateJoinArray(theEnv,arraySize); EnvAlphaJoins(theEnv,rulePtr,arraySize,theInfo); /*=========================*/ /* List the alpha matches. */ /*=========================*/ for (joinIndex = 0; joinIndex < arraySize; joinIndex++) { alphaMatchCount += ListAlphaMatches(theEnv,&theInfo[joinIndex],output); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,EnvAddLong(theEnv,alphaMatchCount)); } /*================================*/ /* Free the array of alpha joins. */ /*================================*/ EnvFreeJoinArray(theEnv,theInfo,arraySize); /*==============================================*/ /* Create the array containing the list of beta */ /* join nodes (joins from the right plus joins */ /* connected to a pattern CE). */ /*==============================================*/ arraySize = EnvBetaJoinCount(theEnv,rulePtr); theInfo = EnvCreateJoinArray(theEnv,arraySize); EnvBetaJoins(theEnv,rulePtr,arraySize,theInfo); /*======================================*/ /* List the beta matches (for all joins */ /* except the first pattern CE). */ /*======================================*/ for (joinIndex = 1; joinIndex < arraySize; joinIndex++) { betaMatchCount += ListBetaMatches(theEnv,theInfo,joinIndex,arraySize,output); SetMFType(result->value,2,INTEGER); SetMFValue(result->value,2,EnvAddLong(theEnv,betaMatchCount)); } /*================================*/ /* Free the array of alpha joins. */ /*================================*/ EnvFreeJoinArray(theEnv,theInfo,arraySize); } /*===================*/ /* List activations. */ /*===================*/ if (output == VERBOSE) { EnvPrintRouter(theEnv,WDISPLAY,"Activations\n"); } for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL); agendaPtr != NULL; agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr)) { if (GetHaltExecution(theEnv) == TRUE) return; if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name) { activations++; if (output == VERBOSE) { PrintPartialMatch(theEnv,WDISPLAY,EnvGetActivationBasis(theEnv,agendaPtr)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } } if (output == SUCCINCT) { EnvPrintRouter(theEnv,WDISPLAY,"Activations: "); PrintLongInteger(theEnv,WDISPLAY,activations); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if ((activations == 0) && (output == VERBOSE)) EnvPrintRouter(theEnv,WDISPLAY," None\n"); SetMFType(result->value,3,INTEGER); SetMFValue(result->value,3,EnvAddLong(theEnv,activations)); } /****************************************************/ /* AlphaJoinCountDriver: Driver routine to iterate */ /* over a rule's joins to determine the number of */ /* alpha joins. */ /****************************************************/ static long AlphaJoinCountDriver( void *theEnv, struct joinNode *theJoin) { long alphaCount = 0; if (theJoin == NULL) { return(alphaCount); } if (theJoin->joinFromTheRight) { return AlphaJoinCountDriver(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure); } else if (theJoin->lastLevel != NULL) { alphaCount += AlphaJoinCountDriver(theEnv,theJoin->lastLevel); } alphaCount++; return(alphaCount); } /**************************************************/ /* EnvAlphaJoinCount: Returns the number of alpha */ /* joins associated with the specified rule. */ /**************************************************/ globle long EnvAlphaJoinCount( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule = (struct defrule *) vTheDefrule; return AlphaJoinCountDriver(theEnv,theDefrule->lastJoin->lastLevel); } /***************************************/ /* AlphaJoinsDriver: Driver routine to */ /* retrieve a rule's alpha joins. */ /***************************************/ static void AlphaJoinsDriver( void *theEnv, struct joinNode *theJoin, long alphaIndex, struct joinInformation *theInfo) { if (theJoin == NULL) { return; } if (theJoin->joinFromTheRight) { AlphaJoinsDriver(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure,alphaIndex,theInfo); return; } else if (theJoin->lastLevel != NULL) { AlphaJoinsDriver(theEnv,theJoin->lastLevel,alphaIndex-1,theInfo); } theInfo[alphaIndex-1].whichCE = alphaIndex; theInfo[alphaIndex-1].theJoin = theJoin; return; } /********************************************/ /* EnvAlphaJoins: Retrieves the alpha joins */ /* associated with the specified rule. */ /********************************************/ globle void EnvAlphaJoins( void *theEnv, void *vTheDefrule, long alphaCount, struct joinInformation *theInfo) { struct defrule *theDefrule = (struct defrule *) vTheDefrule; AlphaJoinsDriver(theEnv,theDefrule->lastJoin->lastLevel,alphaCount,theInfo); } /****************************************************/ /* BetaJoinCountDriver: Driver routine to iterate */ /* over a rule's joins to determine the number of */ /* beta joins. */ /****************************************************/ static long BetaJoinCountDriver( void *theEnv, struct joinNode *theJoin) { long betaCount = 0; if (theJoin == NULL) { return(betaCount); } betaCount++; if (theJoin->joinFromTheRight) { betaCount += BetaJoinCountDriver(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure); } else if (theJoin->lastLevel != NULL) { betaCount += BetaJoinCountDriver(theEnv,theJoin->lastLevel); } return(betaCount); } /************************************************/ /* EnvBetaJoinCount: Returns the number of beta */ /* joins associated with the specified rule. */ /************************************************/ globle long EnvBetaJoinCount( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule = (struct defrule *) vTheDefrule; return BetaJoinCountDriver(theEnv,theDefrule->lastJoin->lastLevel); } /**************************************/ /* BetaJoinsDriver: Driver routine to */ /* retrieve a rule's beta joins. */ /**************************************/ static void BetaJoinsDriver( void *theEnv, struct joinNode *theJoin, long betaIndex, struct joinInformation *theJoinInfoArray, struct betaMemory *lastMemory, struct joinNode *nextJoin) { int theCE = 0, theCount; struct joinNode *tmpPtr; if (theJoin == NULL) { return; } theJoinInfoArray[betaIndex-1].theJoin = theJoin; theJoinInfoArray[betaIndex-1].theMemory = lastMemory; theJoinInfoArray[betaIndex-1].nextJoin = nextJoin; /*===================================*/ /* Determine the conditional element */ /* index for this join. */ /*===================================*/ for (tmpPtr = theJoin; tmpPtr != NULL; tmpPtr = tmpPtr->lastLevel) { theCE++; } theJoinInfoArray[betaIndex-1].whichCE = theCE; /*==============================================*/ /* The end pattern in the range of patterns for */ /* this join is always the number of patterns */ /* remaining to be encountered. */ /*==============================================*/ theCount = CountPatterns(theEnv,theJoin,TRUE); theJoinInfoArray[betaIndex-1].patternEnd = theCount; /*========================================================*/ /* Determine where the block of patterns for a CE begins. */ /*========================================================*/ theCount = CountPatterns(theEnv,theJoin,FALSE); theJoinInfoArray[betaIndex-1].patternBegin = theCount; /*==========================*/ /* Find the next beta join. */ /*==========================*/ if (theJoin->joinFromTheRight) { BetaJoinsDriver(theEnv,(struct joinNode *) theJoin->rightSideEntryStructure,betaIndex-1,theJoinInfoArray,theJoin->rightMemory,theJoin); } else if (theJoin->lastLevel != NULL) { BetaJoinsDriver(theEnv,theJoin->lastLevel,betaIndex-1,theJoinInfoArray,theJoin->leftMemory,theJoin); } return; } /******************************************/ /* EnvBetaJoins: Retrieves the beta joins */ /* associated with the specified rule. */ /******************************************/ globle void EnvBetaJoins( void *theEnv, void *vTheDefrule, long betaArraySize, struct joinInformation *theInfo) { struct defrule *theDefrule = (struct defrule *) vTheDefrule; BetaJoinsDriver(theEnv,theDefrule->lastJoin->lastLevel,betaArraySize,theInfo,theDefrule->lastJoin->leftMemory,theDefrule->lastJoin); } /**************************************************/ /* EnvCreateJoinArray: Creates a join information */ /* array of the specified size. */ /**************************************************/ globle struct joinInformation *EnvCreateJoinArray( void *theEnv, long size) { if (size == 0) return (NULL); return (struct joinInformation *) genalloc(theEnv,sizeof(struct joinInformation) * size); } /**********************************************/ /* EnvFreeJoinArray: Frees a join information */ /* array of the specified size. */ /**********************************************/ globle void EnvFreeJoinArray( void *theEnv, struct joinInformation *theArray, long size) { if (size == 0) return; genfree(theEnv,theArray,sizeof(struct joinInformation) * size); } /*********************/ /* ListAlphaMatches: */ /*********************/ static long long ListAlphaMatches( void *theEnv, struct joinInformation *theInfo, int output) { struct alphaMemoryHash *listOfHashNodes; struct partialMatch *listOfMatches; long long count; struct joinNode *theJoin; long long alphaCount = 0; if (GetHaltExecution(theEnv) == TRUE) { return(alphaCount); } theJoin = theInfo->theJoin; if (output == VERBOSE) { EnvPrintRouter(theEnv,WDISPLAY,"Matches for Pattern "); PrintLongInteger(theEnv,WDISPLAY,theInfo->whichCE); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (theJoin->rightSideEntryStructure == NULL) { if (theJoin->rightMemory->beta[0]->children != NULL) { alphaCount += 1; } if (output == VERBOSE) { if (theJoin->rightMemory->beta[0]->children != NULL) { EnvPrintRouter(theEnv,WDISPLAY,"*\n"); } else { EnvPrintRouter(theEnv,WDISPLAY," None\n"); } } else if (output == SUCCINCT) { EnvPrintRouter(theEnv,WDISPLAY,"Pattern "); PrintLongInteger(theEnv,WDISPLAY,theInfo->whichCE); EnvPrintRouter(theEnv,WDISPLAY,": "); if (theJoin->rightMemory->beta[0]->children != NULL) { EnvPrintRouter(theEnv,WDISPLAY,"1"); } else { EnvPrintRouter(theEnv,WDISPLAY,"0"); } EnvPrintRouter(theEnv,WDISPLAY,"\n"); } return(alphaCount); } listOfHashNodes = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->firstHash; for (count = 0; listOfHashNodes != NULL; listOfHashNodes = listOfHashNodes->nextHash) { listOfMatches = listOfHashNodes->alphaMemory; while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { return(alphaCount); } count++; if (output == VERBOSE) { PrintPartialMatch(theEnv,WDISPLAY,listOfMatches); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } listOfMatches = listOfMatches->nextInMemory; } } alphaCount += count; if ((count == 0) && (output == VERBOSE)) EnvPrintRouter(theEnv,WDISPLAY," None\n"); if (output == SUCCINCT) { EnvPrintRouter(theEnv,WDISPLAY,"Pattern "); PrintLongInteger(theEnv,WDISPLAY,theInfo->whichCE); EnvPrintRouter(theEnv,WDISPLAY,": "); PrintLongInteger(theEnv,WDISPLAY,count); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } return(alphaCount); } /********************/ /* BetaHeaderString */ /********************/ static const char *BetaHeaderString( void *theEnv, struct joinInformation *infoArray, long joinIndex, long arraySize) { struct joinNode *theJoin; struct joinInformation *theInfo; long i, j, startPosition, endPosition, positionsToPrint = 0; int nestedCEs = FALSE; const char *returnString = ""; long lastIndex; char buffer[32]; /*=============================================*/ /* Determine which joins need to be traversed. */ /*=============================================*/ for (i = 0; i < arraySize; i++) { infoArray[i].marked = FALSE; } theInfo = &infoArray[joinIndex]; theJoin = theInfo->theJoin; lastIndex = joinIndex; while (theJoin != NULL) { for (i = lastIndex; i >= 0; i--) { if (infoArray[i].theJoin == theJoin) { positionsToPrint++; infoArray[i].marked = TRUE; if (infoArray[i].patternBegin != infoArray[i].patternEnd) { nestedCEs = TRUE; } lastIndex = i - 1; break; } } theJoin = theJoin->lastLevel; } for (i = 0; i <= joinIndex; i++) { if (infoArray[i].marked == FALSE) continue; positionsToPrint--; startPosition = i; endPosition = i; if (infoArray[i].patternBegin == infoArray[i].patternEnd) { for (j = i + 1; j <= joinIndex; j++) { if (infoArray[j].marked == FALSE) continue; if (infoArray[j].patternBegin != infoArray[j].patternEnd) break; positionsToPrint--; i = j; endPosition = j; } } theInfo = &infoArray[startPosition]; gensprintf(buffer,"%d",theInfo->whichCE); returnString = AppendStrings(theEnv,returnString,buffer); if (nestedCEs) { if (theInfo->patternBegin == theInfo->patternEnd) { returnString = AppendStrings(theEnv,returnString," (P"); gensprintf(buffer,"%d",theInfo->patternBegin); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString,")"); } else { returnString = AppendStrings(theEnv,returnString," (P"); gensprintf(buffer,"%d",theInfo->patternBegin); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString," - P"); gensprintf(buffer,"%d",theInfo->patternEnd); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString,")"); } } if (startPosition != endPosition) { theInfo = &infoArray[endPosition]; returnString = AppendStrings(theEnv,returnString," - "); gensprintf(buffer,"%d",theInfo->whichCE); returnString = AppendStrings(theEnv,returnString,buffer); if (nestedCEs) { if (theInfo->patternBegin == theInfo->patternEnd) { returnString = AppendStrings(theEnv,returnString," (P"); gensprintf(buffer,"%d",theInfo->patternBegin); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString,")"); } else { returnString = AppendStrings(theEnv,returnString," (P"); gensprintf(buffer,"%d",theInfo->patternBegin); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString," - P"); gensprintf(buffer,"%d",theInfo->patternEnd); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString,")"); } } } if (positionsToPrint > 0) { returnString = AppendStrings(theEnv,returnString," , "); } } return returnString; } /********************/ /* ListBetaMatches: */ /********************/ static long long ListBetaMatches( void *theEnv, struct joinInformation *infoArray, long joinIndex, long arraySize, int output) { long betaCount = 0; struct joinInformation *theInfo; long int count; if (GetHaltExecution(theEnv) == TRUE) { return(betaCount); } theInfo = &infoArray[joinIndex]; if (output == VERBOSE) { EnvPrintRouter(theEnv,WDISPLAY,"Partial matches for CEs "); EnvPrintRouter(theEnv,WDISPLAY, BetaHeaderString(theEnv,infoArray,joinIndex,arraySize)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } count = PrintBetaMemory(theEnv,WDISPLAY,theInfo->theMemory,TRUE,"",output); betaCount += count; if ((output == VERBOSE) && (count == 0)) { EnvPrintRouter(theEnv,WDISPLAY," None\n"); } else if (output == SUCCINCT) { EnvPrintRouter(theEnv,WDISPLAY,"CEs "); EnvPrintRouter(theEnv,WDISPLAY, BetaHeaderString(theEnv,infoArray,joinIndex,arraySize)); EnvPrintRouter(theEnv,WDISPLAY,": "); PrintLongInteger(theEnv,WDISPLAY,betaCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } return(betaCount); } /******************/ /* CountPatterns: */ /******************/ static int CountPatterns( void *theEnv, struct joinNode *theJoin, int followRight) { int theCount = 0; if (theJoin == NULL) return theCount; if (theJoin->joinFromTheRight && (followRight == FALSE)) { theCount++; } while (theJoin != NULL) { if (theJoin->joinFromTheRight) { if (followRight) { theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { theJoin = theJoin->lastLevel; } } else { theCount++; theJoin = theJoin->lastLevel; } followRight = TRUE; } return theCount; } /*******************************************/ /* JoinActivityCommand: H/L access routine */ /* for the join-activity command. */ /*******************************************/ globle void JoinActivityCommand( void *theEnv, DATA_OBJECT *result) { const char *ruleName, *argument; void *rulePtr; int numberOfArguments; DATA_OBJECT argPtr; int output; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if ((numberOfArguments = EnvArgRangeCheck(theEnv,"join-activity",1,2)) == -1) return; if (EnvArgTypeCheck(theEnv,"join-activity",1,SYMBOL,&argPtr) == FALSE) return; if (GetType(argPtr) != SYMBOL) { ExpectedTypeError1(theEnv,"join-activity",1,"rule name"); return; } ruleName = DOToString(argPtr); rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } if (numberOfArguments == 2) { if (EnvArgTypeCheck(theEnv,"join-activity",2,SYMBOL,&argPtr) == FALSE) { return; } argument = DOToString(argPtr); if (strcmp(argument,"verbose") == 0) { output = VERBOSE; } else if (strcmp(argument,"succinct") == 0) { output = SUCCINCT; } else if (strcmp(argument,"terse") == 0) { output = TERSE; } else { ExpectedTypeError1(theEnv,"join-activity",2,"symbol with value verbose, succinct, or terse"); return; } } else { output = VERBOSE; } EnvJoinActivity(theEnv,rulePtr,output,result); } /*************************************/ /* EnvJoinActivity: C access routine */ /* for the join-activity command. */ /*************************************/ globle void EnvJoinActivity( void *theEnv, void *theRule, int output, DATA_OBJECT *result) { struct defrule *rulePtr; long disjunctCount, disjunctIndex, joinIndex; long arraySize; struct joinInformation *theInfo; /*==========================*/ /* Set up the return value. */ /*==========================*/ result->type = MULTIFIELD; result->begin = 0; result->end = 2; result->value = EnvCreateMultifield(theEnv,3L); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,INTEGER); SetMFValue(result->value,2,SymbolData(theEnv)->Zero); SetMFType(result->value,3,INTEGER); SetMFValue(result->value,3,SymbolData(theEnv)->Zero); /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ disjunctCount = EnvGetDisjunctCount(theEnv,theRule); for (disjunctIndex = 1; disjunctIndex <= disjunctCount; disjunctIndex++) { rulePtr = (struct defrule *) EnvGetNthDisjunct(theEnv,theRule,disjunctIndex); /*==============================================*/ /* Create the array containing the list of beta */ /* join nodes (joins from the right plus joins */ /* connected to a pattern CE). */ /*==============================================*/ arraySize = EnvBetaJoinCount(theEnv,rulePtr); theInfo = EnvCreateJoinArray(theEnv,arraySize); EnvBetaJoins(theEnv,rulePtr,arraySize,theInfo); /*======================================*/ /* List the beta matches (for all joins */ /* except the first pattern CE). */ /*======================================*/ for (joinIndex = 0; joinIndex < arraySize; joinIndex++) { ListBetaJoinActivity(theEnv,theInfo,joinIndex,arraySize,output,result); } /*================================*/ /* Free the array of alpha joins. */ /*================================*/ EnvFreeJoinArray(theEnv,theInfo,arraySize); } } /************************/ /* ActivityHeaderString */ /************************/ static const char *ActivityHeaderString( void *theEnv, struct joinInformation *infoArray, long joinIndex, long arraySize) { struct joinNode *theJoin; struct joinInformation *theInfo; long i; int nestedCEs = FALSE; const char *returnString = ""; long lastIndex; char buffer[32]; /*=============================================*/ /* Determine which joins need to be traversed. */ /*=============================================*/ for (i = 0; i < arraySize; i++) { infoArray[i].marked = FALSE; } theInfo = &infoArray[joinIndex]; theJoin = theInfo->theJoin; lastIndex = joinIndex; while (theJoin != NULL) { for (i = lastIndex; i >= 0; i--) { if (infoArray[i].theJoin == theJoin) { if (infoArray[i].patternBegin != infoArray[i].patternEnd) { nestedCEs = TRUE; } lastIndex = i - 1; break; } } theJoin = theJoin->lastLevel; } gensprintf(buffer,"%d",theInfo->whichCE); returnString = AppendStrings(theEnv,returnString,buffer); if (nestedCEs == FALSE) { return returnString; } if (theInfo->patternBegin == theInfo->patternEnd) { returnString = AppendStrings(theEnv,returnString," (P"); gensprintf(buffer,"%d",theInfo->patternBegin); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString,")"); } else { returnString = AppendStrings(theEnv,returnString," (P"); gensprintf(buffer,"%d",theInfo->patternBegin); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString," - P"); gensprintf(buffer,"%d",theInfo->patternEnd); returnString = AppendStrings(theEnv,returnString,buffer); returnString = AppendStrings(theEnv,returnString,")"); } return returnString; } /*************************/ /* ListBetaJoinActivity: */ /*************************/ static void ListBetaJoinActivity( void *theEnv, struct joinInformation *infoArray, long joinIndex, long arraySize, int output, DATA_OBJECT *result) { long long activity = 0; long long compares, adds, deletes; struct joinNode *theJoin, *nextJoin; struct joinInformation *theInfo; if (GetHaltExecution(theEnv) == TRUE) { return; } theInfo = &infoArray[joinIndex]; theJoin = theInfo->theJoin; nextJoin = theInfo->nextJoin; compares = theJoin->memoryCompares; if (theInfo->nextJoin->joinFromTheRight) { adds = nextJoin->memoryRightAdds; deletes = nextJoin->memoryRightDeletes; } else { adds = nextJoin->memoryLeftAdds; deletes = nextJoin->memoryLeftDeletes; } activity = compares + adds + deletes; if (output == VERBOSE) { char buffer[100]; EnvPrintRouter(theEnv,WDISPLAY,"Activity for CE "); EnvPrintRouter(theEnv,WDISPLAY, ActivityHeaderString(theEnv,infoArray,joinIndex,arraySize)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); sprintf(buffer," Compares: %10lld\n",compares); EnvPrintRouter(theEnv,WDISPLAY,buffer); sprintf(buffer," Adds: %10lld\n",adds); EnvPrintRouter(theEnv,WDISPLAY,buffer); sprintf(buffer," Deletes: %10lld\n",deletes); EnvPrintRouter(theEnv,WDISPLAY,buffer); } else if (output == SUCCINCT) { EnvPrintRouter(theEnv,WDISPLAY,"CE "); EnvPrintRouter(theEnv,WDISPLAY, ActivityHeaderString(theEnv,infoArray,joinIndex,arraySize)); EnvPrintRouter(theEnv,WDISPLAY,": "); PrintLongInteger(theEnv,WDISPLAY,activity); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } compares += ValueToLong(GetMFValue(result->value,1)); adds += ValueToLong(GetMFValue(result->value,2)); deletes += ValueToLong(GetMFValue(result->value,3)); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,EnvAddLong(theEnv,compares)); SetMFType(result->value,2,INTEGER); SetMFValue(result->value,2,EnvAddLong(theEnv,adds)); SetMFType(result->value,3,INTEGER); SetMFValue(result->value,3,EnvAddLong(theEnv,deletes)); } /*********************************************/ /* JoinActivityReset: Sets the join activity */ /* counts for each rule back to 0. */ /*********************************************/ static void JoinActivityReset( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct defrule *theDefrule = (struct defrule *) theConstruct; struct joinNode *theJoin = theDefrule->lastJoin; while (theJoin != NULL) { theJoin->memoryCompares = 0; theJoin->memoryLeftAdds = 0; theJoin->memoryRightAdds = 0; theJoin->memoryLeftDeletes = 0; theJoin->memoryRightDeletes = 0; if (theJoin->joinFromTheRight) { theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { theJoin = theJoin->lastLevel; } } } /************************************************/ /* JoinActivityResetCommand: H/L access routine */ /* for the reset-join-activity command. */ /************************************************/ globle void JoinActivityResetCommand( void *theEnv) { DoForAllConstructs(theEnv,JoinActivityReset,DefruleData(theEnv)->DefruleModuleIndex,TRUE,NULL); } /***************************************/ /* TimetagFunction: H/L access routine */ /* for the timetag function. */ /***************************************/ globle long long TimetagFunction( void *theEnv) { DATA_OBJECT item; void *ptr; if (EnvArgCountCheck(theEnv,"timetag",EXACTLY,1) == -1) return(-1LL); ptr = GetFactOrInstanceArgument(theEnv,1,&item,"timetag"); if (ptr == NULL) return(-1); return ((struct patternEntity *) ptr)->timeTag; } #endif /* DEBUGGING_FUNCTIONS */ #if DEVELOPER /***********************************************/ /* RuleComplexityCommand: H/L access routine */ /* for the rule-complexity function. */ /***********************************************/ globle long RuleComplexityCommand( void *theEnv) { const char *ruleName; struct defrule *rulePtr; ruleName = GetConstructName(theEnv,"rule-complexity","rule name"); if (ruleName == NULL) return(-1); rulePtr = (struct defrule *) EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return(-1); } return(rulePtr->complexity); } /******************************************/ /* ShowJoinsCommand: H/L access routine */ /* for the show-joins command. */ /******************************************/ globle void ShowJoinsCommand( void *theEnv) { const char *ruleName; void *rulePtr; ruleName = GetConstructName(theEnv,"show-joins","rule name"); if (ruleName == NULL) return; rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } ShowJoins(theEnv,rulePtr); return; } /*********************************/ /* ShowJoins: C access routine */ /* for the show-joins command. */ /*********************************/ static void ShowJoins( void *theEnv, void *theRule) { struct defrule *rulePtr; struct joinNode *theJoin; struct joinNode *joinList[MAXIMUM_NUMBER_OF_PATTERNS]; int numberOfJoins; char rhsType; rulePtr = (struct defrule *) theRule; /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ while (rulePtr != NULL) { /*=====================================*/ /* Determine the number of join nodes. */ /*=====================================*/ numberOfJoins = -1; theJoin = rulePtr->lastJoin; while (theJoin != NULL) { if (theJoin->joinFromTheRight) { numberOfJoins++; joinList[numberOfJoins] = theJoin; theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { numberOfJoins++; joinList[numberOfJoins] = theJoin; theJoin = theJoin->lastLevel; } } /*====================*/ /* Display the joins. */ /*====================*/ while (numberOfJoins >= 0) { char buffer[20]; if (joinList[numberOfJoins]->patternIsNegated) { rhsType = 'n'; } else if (joinList[numberOfJoins]->patternIsExists) { rhsType = 'x'; } else { rhsType = ' '; } gensprintf(buffer,"%2d%c%c%c%c : ",(int) joinList[numberOfJoins]->depth, (joinList[numberOfJoins]->firstJoin) ? 'f' : ' ', rhsType, (joinList[numberOfJoins]->joinFromTheRight) ? 'j' : ' ', (joinList[numberOfJoins]->logicalJoin) ? 'l' : ' '); EnvPrintRouter(theEnv,WDISPLAY,buffer); PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); if (joinList[numberOfJoins]->ruleToActivate != NULL) { EnvPrintRouter(theEnv,WDISPLAY," RA : "); EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefruleName(theEnv,joinList[numberOfJoins]->ruleToActivate)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (joinList[numberOfJoins]->secondaryNetworkTest != NULL) { EnvPrintRouter(theEnv,WDISPLAY," SNT : "); PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->secondaryNetworkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (joinList[numberOfJoins]->leftHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," LH : "); PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->leftHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (joinList[numberOfJoins]->rightHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," RH : "); PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->rightHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (! joinList[numberOfJoins]->firstJoin) { EnvPrintRouter(theEnv,WDISPLAY," LM : "); if (PrintBetaMemory(theEnv,WDISPLAY,joinList[numberOfJoins]->leftMemory,FALSE," ",SUCCINCT) == 0) { EnvPrintRouter(theEnv,WDISPLAY,"None\n"); } } if (joinList[numberOfJoins]->joinFromTheRight) { EnvPrintRouter(theEnv,WDISPLAY," RM : "); if (PrintBetaMemory(theEnv,WDISPLAY,joinList[numberOfJoins]->rightMemory,FALSE," ",SUCCINCT) == 0) { EnvPrintRouter(theEnv,WDISPLAY,"None\n"); } } numberOfJoins--; }; /*===============================*/ /* Proceed to the next disjunct. */ /*===============================*/ rulePtr = rulePtr->disjunct; if (rulePtr != NULL) EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } /******************************************************/ /* ShowAlphaHashTable: Displays the number of entries */ /* in each slot of the alpha hash table. */ /******************************************************/ globle void ShowAlphaHashTable( void *theEnv) { int i, count; long totalCount = 0; struct alphaMemoryHash *theEntry; struct partialMatch *theMatch; char buffer[40]; for (i = 0; i < ALPHA_MEMORY_HASH_SIZE; i++) { for (theEntry = DefruleData(theEnv)->AlphaMemoryTable[i], count = 0; theEntry != NULL; theEntry = theEntry->next) { count++; } if (count != 0) { totalCount += count; gensprintf(buffer,"%4d: %4d ->",i,count); EnvPrintRouter(theEnv,WDISPLAY,buffer); for (theEntry = DefruleData(theEnv)->AlphaMemoryTable[i], count = 0; theEntry != NULL; theEntry = theEntry->next) { for (theMatch = theEntry->alphaMemory; theMatch != NULL; theMatch = theMatch->nextInMemory) { count++; } gensprintf(buffer," %4d",count); EnvPrintRouter(theEnv,WDISPLAY,buffer); if (theEntry->owner->rightHash == NULL) { EnvPrintRouter(theEnv,WDISPLAY,"*"); } } EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } gensprintf(buffer,"Total Count: %ld\n",totalCount); EnvPrintRouter(theEnv,WDISPLAY,buffer); } #endif /* DEVELOPER */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS globle void Matches( void *theRule, int output, DATA_OBJECT *result) { EnvMatches(GetCurrentEnvironment(),theRule,output,result); } globle void JoinActivity( void *theRule, int output, DATA_OBJECT *result) { EnvJoinActivity(GetCurrentEnvironment(),theRule,output,result); } #endif /* DEBUGGING_FUNCTIONS */ globle intBool GetBetaMemoryResizing() { return EnvGetBetaMemoryResizing(GetCurrentEnvironment()); } globle intBool SetBetaMemoryResizing( int value) { return EnvSetBetaMemoryResizing(GetCurrentEnvironment(),value); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/._inscom.h0000755000175000017500000000040712424473406016116 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/ruledlt.c0000755000175000017500000004746712424473376016106 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE DELETION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for deleting a rule including */ /* freeing the defrule data structures and removing the */ /* appropriate joins from the join network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added support for hashed memories. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #define _RULEDLT_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "memalloc.h" #include "engine.h" #include "envrnmnt.h" #include "reteutil.h" #include "pattern.h" #include "agenda.h" #include "drive.h" #include "retract.h" #include "constrct.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "ruledlt.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void RemoveIntranetworkLink(void *,struct joinNode *); #endif static void DetachJoins(void *,struct joinNode *,intBool); static void DetachJoinsDriver(void *,struct defrule *,intBool); /**********************************************************************/ /* ReturnDefrule: Returns a defrule data structure and its associated */ /* data structures to the memory manager. Note that the first */ /* disjunct of a rule is the only disjunct which allocates storage */ /* for the rule's dynamic salience and pretty print form (so these */ /* are only deallocated for the first disjunct). */ /**********************************************************************/ globle void ReturnDefrule( void *theEnv, void *vWaste) { #if (! RUN_TIME) && (! BLOAD_ONLY) struct defrule *waste = (struct defrule *) vWaste; int first = TRUE; struct defrule *nextPtr, *tmpPtr; if (waste == NULL) return; /*======================================*/ /* If a rule is redefined, then we want */ /* to save its breakpoint status. */ /*======================================*/ #if DEBUGGING_FUNCTIONS DefruleData(theEnv)->DeletedRuleDebugFlags = 0; if (waste->afterBreakpoint) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,0); if (waste->watchActivation) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,1); if (waste->watchFiring) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,2); #endif /*================================*/ /* Clear the agenda of all the */ /* activations added by the rule. */ /*================================*/ ClearRuleFromAgenda(theEnv,waste); /*======================*/ /* Get rid of the rule. */ /*======================*/ while (waste != NULL) { /*================================================*/ /* Remove the rule's joins from the join network. */ /*================================================*/ DetachJoinsDriver(theEnv,waste,FALSE); /*=============================================*/ /* If this is the first disjunct, get rid of */ /* the dynamic salience and pretty print form. */ /*=============================================*/ if (first) { if (waste->dynamicSalience != NULL) { ExpressionDeinstall(theEnv,waste->dynamicSalience); ReturnPackedExpression(theEnv,waste->dynamicSalience); waste->dynamicSalience = NULL; } if (waste->header.ppForm != NULL) { rm(theEnv,(void *) waste->header.ppForm,strlen(waste->header.ppForm) + 1); waste->header.ppForm = NULL; /*=======================================================*/ /* All of the rule disjuncts share the same pretty print */ /* form, so we want to avoid deleting it again. */ /*=======================================================*/ for (tmpPtr = waste->disjunct; tmpPtr != NULL; tmpPtr = tmpPtr->disjunct) { tmpPtr->header.ppForm = NULL; } } first = FALSE; } /*===========================*/ /* Get rid of any user data. */ /*===========================*/ if (waste->header.usrData != NULL) { ClearUserDataList(theEnv,waste->header.usrData); } /*===========================================*/ /* Decrement the count for the defrule name. */ /*===========================================*/ DecrementSymbolCount(theEnv,waste->header.name); /*========================================*/ /* Get rid of the the rule's RHS actions. */ /*========================================*/ if (waste->actions != NULL) { ExpressionDeinstall(theEnv,waste->actions); ReturnPackedExpression(theEnv,waste->actions); } /*===============================*/ /* Move on to the next disjunct. */ /*===============================*/ nextPtr = waste->disjunct; rtn_struct(theEnv,defrule,waste); waste = nextPtr; } /*==========================*/ /* Free up partial matches. */ /*==========================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); #endif } /********************************************************/ /* DestroyDefrule: Action used to remove defrules */ /* as a result of DestroyEnvironment. */ /********************************************************/ globle void DestroyDefrule( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule = (struct defrule *) vTheDefrule; struct defrule *nextDisjunct; int first = TRUE; if (theDefrule == NULL) return; while (theDefrule != NULL) { DetachJoinsDriver(theEnv,theDefrule,TRUE); if (first) { #if (! BLOAD_ONLY) && (! RUN_TIME) if (theDefrule->dynamicSalience != NULL) { ReturnPackedExpression(theEnv,theDefrule->dynamicSalience); } if (theDefrule->header.ppForm != NULL) { struct defrule *tmpPtr; rm(theEnv,(void *) theDefrule->header.ppForm,strlen(theDefrule->header.ppForm) + 1); /*=======================================================*/ /* All of the rule disjuncts share the same pretty print */ /* form, so we want to avoid deleting it again. */ /*=======================================================*/ for (tmpPtr = theDefrule->disjunct; tmpPtr != NULL; tmpPtr = tmpPtr->disjunct) { tmpPtr->header.ppForm = NULL; } } #endif first = FALSE; } if (theDefrule->header.usrData != NULL) { ClearUserDataList(theEnv,theDefrule->header.usrData); } #if (! BLOAD_ONLY) && (! RUN_TIME) if (theDefrule->actions != NULL) { ReturnPackedExpression(theEnv,theDefrule->actions); } #endif nextDisjunct = theDefrule->disjunct; #if (! BLOAD_ONLY) && (! RUN_TIME) rtn_struct(theEnv,defrule,theDefrule); #endif theDefrule = nextDisjunct; } } /**********************************************************************/ /* DetachJoinsDriver: */ /**********************************************************************/ static void DetachJoinsDriver( void *theEnv, struct defrule *theRule, intBool destroy) { struct joinNode *join; /*==================================*/ /* Find the last join for the rule. */ /*==================================*/ join = theRule->lastJoin; theRule->lastJoin = NULL; if (join == NULL) return; /*===================================================*/ /* Remove the activation link from the last join. If */ /* there are joins below this join, then all of the */ /* joins for this rule were shared with another rule */ /* and thus no joins can be deleted. */ /*===================================================*/ join->ruleToActivate = NULL; if (join->nextLinks != NULL) return; DetachJoins(theEnv,join,destroy); } /**********************************************************************/ /* DetachJoins: Removes a join node and all of its parent nodes from */ /* the join network. Nodes are only removed if they are no required */ /* by other rules (the same join can be shared by multiple rules). */ /* Any partial matches associated with the join are also removed. */ /* A rule's joins are typically removed by removing the bottom most */ /* join used by the rule and then removing any parent joins which */ /* are not shared by other rules. */ /**********************************************************************/ static void DetachJoins( void *theEnv, struct joinNode *join, intBool destroy) { struct joinNode *prevJoin, *rightJoin; struct joinLink *lastLink, *theLink; int lastMark; /*===========================*/ /* Begin removing the joins. */ /*===========================*/ while (join != NULL) { if (join->marked) return; /*==========================================================*/ /* Remember the join "above" this join (the one that enters */ /* from the left). If the join is entered from the right by */ /* another join, remember the right entering join as well. */ /*==========================================================*/ prevJoin = join->lastLevel; if (join->joinFromTheRight) { rightJoin = (struct joinNode *) join->rightSideEntryStructure; } else { rightJoin = NULL; } /*=================================================*/ /* If the join was attached to a pattern, remove */ /* any structures associated with the pattern that */ /* are no longer needed. */ /*=================================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) if (! destroy) { if ((join->rightSideEntryStructure != NULL) && (join->joinFromTheRight == FALSE)) { RemoveIntranetworkLink(theEnv,join); } } #endif /*======================================*/ /* Remove any partial matches contained */ /* in the beta memory of the join. */ /*======================================*/ if (destroy) { DestroyBetaMemory(theEnv,join,LHS); DestroyBetaMemory(theEnv,join,RHS); } else { FlushBetaMemory(theEnv,join,LHS); FlushBetaMemory(theEnv,join,RHS); } ReturnLeftMemory(theEnv,join); ReturnRightMemory(theEnv,join); /*===================================*/ /* Remove the expressions associated */ /* with the join. */ /*===================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) if (! destroy) { RemoveHashedExpression(theEnv,join->networkTest); RemoveHashedExpression(theEnv,join->secondaryNetworkTest); RemoveHashedExpression(theEnv,join->leftHash); RemoveHashedExpression(theEnv,join->rightHash); } #endif /*============================*/ /* Fix the right prime links. */ /*============================*/ if (join->firstJoin && (join->rightSideEntryStructure == NULL)) { lastLink = NULL; theLink = DefruleData(theEnv)->RightPrimeJoins; while (theLink != NULL) { if (theLink->join == join) { if (lastLink == NULL) { DefruleData(theEnv)->RightPrimeJoins = theLink->next; } else { lastLink->next = theLink->next; } #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinLink,theLink); #endif theLink = NULL; } else { lastLink = theLink; theLink = lastLink->next; } } } /*===========================*/ /* Fix the left prime links. */ /*===========================*/ if (join->firstJoin && (join->patternIsNegated || join->joinFromTheRight) && (! join->patternIsExists)) { lastLink = NULL; theLink = DefruleData(theEnv)->LeftPrimeJoins; while (theLink != NULL) { if (theLink->join == join) { if (lastLink == NULL) { DefruleData(theEnv)->LeftPrimeJoins = theLink->next; } else { lastLink->next = theLink->next; } #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinLink,theLink); #endif theLink = NULL; } else { lastLink = theLink; theLink = theLink->next; } } } /*==================================================*/ /* Remove the link to the join from the join above. */ /*==================================================*/ if (prevJoin != NULL) { lastLink = NULL; theLink = prevJoin->nextLinks; while (theLink != NULL) { if (theLink->join == join) { if (lastLink == NULL) { prevJoin->nextLinks = theLink->next; } else { lastLink->next = theLink->next; } #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinLink,theLink); #endif theLink = NULL; } else { lastLink = theLink; theLink = theLink->next; } } } /*==========================================*/ /* Remove the right join link if it exists. */ /*==========================================*/ if (rightJoin != NULL) { lastLink = NULL; theLink = rightJoin->nextLinks; while (theLink != NULL) { if (theLink->join == join) { if (lastLink == NULL) { rightJoin->nextLinks = theLink->next; } else { lastLink->next = theLink->next; } #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinLink,theLink); #endif theLink = NULL; } else { lastLink = theLink; theLink = theLink->next; } } if ((rightJoin->nextLinks == NULL) && (rightJoin->ruleToActivate == NULL)) { if (prevJoin != NULL) { lastMark = prevJoin->marked; prevJoin->marked = TRUE; DetachJoins(theEnv,rightJoin,destroy); prevJoin->marked = lastMark; } else { DetachJoins(theEnv,rightJoin,destroy); } } } /*==================*/ /* Delete the join. */ /*==================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinNode,join); #endif /*===========================================================*/ /* Move on to the next join to be removed. All the joins of */ /* a rule can be deleted by following the right joins links */ /* (when these links exist) and then following the left join */ /* links. This works because if join A enters join B from */ /* the right, the right/left links of join A eventually lead */ /* to the join which enters join B from the left. */ /*===========================================================*/ if (prevJoin == NULL) { return; } else if (prevJoin->ruleToActivate != NULL) { return; } else if (prevJoin->nextLinks == NULL) { join = prevJoin; } else { return; } } } #if (! RUN_TIME) && (! BLOAD_ONLY) /***********************************************************************/ /* RemoveIntranetworkLink: Removes the link between a join node in the */ /* join network and its corresponding pattern node in the pattern */ /* network. If the pattern node is then no longer associated with */ /* any other joins, it is removed using the function DetachPattern. */ /***********************************************************************/ static void RemoveIntranetworkLink( void *theEnv, struct joinNode *join) { struct patternNodeHeader *patternPtr; struct joinNode *joinPtr, *lastJoin; /*================================================*/ /* Determine the pattern that enters this join. */ /* Determine the list of joins which this pattern */ /* enters from the right. */ /*================================================*/ patternPtr = (struct patternNodeHeader *) join->rightSideEntryStructure; joinPtr = patternPtr->entryJoin; lastJoin = NULL; /*=================================================*/ /* Loop through the list of joins that the pattern */ /* enters until the join being removed is found. */ /* Remove this join from the list. */ /*=================================================*/ while (joinPtr != NULL) { if (joinPtr == join) { if (lastJoin == NULL) { patternPtr->entryJoin = joinPtr->rightMatchNode; } else { lastJoin->rightMatchNode = joinPtr->rightMatchNode; } joinPtr = NULL; } else { lastJoin = joinPtr; joinPtr = joinPtr->rightMatchNode; } } /*===================================================*/ /* If the terminal node of the pattern doesn't point */ /* to any joins, then start removing the pattern. */ /*===================================================*/ if (patternPtr->entryJoin == NULL) { DetachPattern(theEnv,(int) join->rhsType,patternPtr); } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/strngrtr.h0000755000175000017500000000625712373755532016315 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* STRING I/O ROUTER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow strings to be */ /* used as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Used genstrcpy instead of strcpy. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_strngrtr #define _H_strngrtr #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define STRING_ROUTER_DATA 48 struct stringRouter { const char *name; const char *readString; char *writeString; //char *str; size_t currentPosition; size_t maximumPosition; int readWriteType; struct stringRouter *next; }; struct stringRouterData { struct stringRouter *ListOfStringRouters; }; #define StringRouterData(theEnv) ((struct stringRouterData *) GetEnvironmentData(theEnv,STRING_ROUTER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _STRNGRTR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /**************************/ /* I/O ROUTER DEFINITIONS */ /**************************/ LOCALE void InitializeStringRouter(void *); LOCALE int OpenStringSource(void *,const char *,const char *,size_t); LOCALE int OpenTextSource(void *,const char *,const char *,size_t,size_t); LOCALE int CloseStringSource(void *,const char *); LOCALE int OpenStringDestination(void *,const char *,char *,size_t); LOCALE int CloseStringDestination(void *,const char *); #endif /* _H_strngrtr */ clips_core_source_630/core/._factlhs.c0000755000175000017500000000040712373742653016253 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._symblbin.c0000755000175000017500000000040712373755531016445 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._globlpsr.h0000755000175000017500000000040712373753360016455 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/sysdep.c0000755000175000017500000014273412466460165015731 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* SYSTEM DEPENDENT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Isolation of system dependent routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Modified GenOpen to check the file length */ /* against the system constant FILENAME_MAX. */ /* */ /* 6.24: Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Made gensystem functional for Xcode. */ /* */ /* Added BeforeOpenFunction and AfterOpenFunction */ /* hooks. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Updated UNIX_V gentime functionality. */ /* */ /* Removed GenOpen check against FILENAME_MAX. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, IBM_ICB, IBM_TBC, IBM_ZTC, and */ /* IBM_SC). */ /* */ /* Renamed IBM_MSC and WIN_MVC compiler flags */ /* and IBM_GCC to WIN_GCC. */ /* */ /* Added LINUX and DARWIN compiler flags. */ /* */ /* Removed HELP_FUNCTIONS compilation flag and */ /* associated functionality. */ /* */ /* Removed EMACS_EDITOR compilation flag and */ /* associated functionality. */ /* */ /* Combined BASIC_IO and EXT_IO compilation */ /* flags into the single IO_FUNCTIONS flag. */ /* */ /* Changed the EX_MATH compilation flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Support for typed EXTERNAL_ADDRESS. */ /* */ /* GenOpen function checks for UTF-8 Byte Order */ /* Marker. */ /* */ /* Added gengetchar, genungetchar, genprintfile, */ /* genstrcpy, genstrncpy, genstrcat, genstrncat, */ /* and gensprintf functions. */ /* */ /* Added SetJmpBuffer function. */ /* */ /* Added environment argument to genexit. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _SYSDEP_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include #if VAX_VMS #include timeb #include #include #include #include signal extern int LIB$SPAWN(); #endif #if MAC_XCD #include #define kTwoPower32 (4294967296.0) /* 2^32 */ #endif #if MAC_XCD #include #endif #if MAC_XCD #include #endif /* #if WIN_MVC #define _UNICODE #define UNICODE #include #endif */ #if WIN_MVC #include #include #include #include #include #include #include #endif #if UNIX_7 || WIN_GCC #include #include #include #endif #if UNIX_V || LINUX || DARWIN #include #include #include #include #include #endif #include "argacces.h" #include "bmathfun.h" #include "commline.h" #include "conscomp.h" #include "constrnt.h" #include "constrct.h" #include "cstrcpsr.h" #include "emathfun.h" #include "envrnmnt.h" #include "filecom.h" #include "iofun.h" #include "memalloc.h" #include "miscfun.h" #include "multifld.h" #include "multifun.h" #include "parsefun.h" #include "prccode.h" #include "prdctfun.h" #include "proflfun.h" #include "prcdrfun.h" #include "router.h" #include "sortfun.h" #include "strngfun.h" #include "textpro.h" #include "utility.h" #include "watch.h" #include "sysdep.h" #if DEFFACTS_CONSTRUCT #include "dffctdef.h" #endif #if DEFRULE_CONSTRUCT #include "ruledef.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltdef.h" #endif #if OBJECT_SYSTEM #include "classini.h" #endif #include "moduldef.h" #if DEVELOPER #include "developr.h" #endif /***************/ /* DEFINITIONS */ /***************/ #define NO_SWITCH 0 #define BATCH_SWITCH 1 #define BATCH_STAR_SWITCH 2 #define LOAD_SWITCH 3 /********************/ /* ENVIRONMENT DATA */ /********************/ #define SYSTEM_DEPENDENT_DATA 58 struct systemDependentData { void (*RedrawScreenFunction)(void *); void (*PauseEnvFunction)(void *); void (*ContinueEnvFunction)(void *,int); /* #if ! WINDOW_INTERFACE #if WIN_MVC void (interrupt *OldCtrlC)(void); void (interrupt *OldBreak)(void); #endif #endif */ #if WIN_MVC int BinaryFileHandle; unsigned char getcBuffer[7]; int getcLength; int getcPosition; #endif #if (! WIN_MVC) FILE *BinaryFP; #endif int (*BeforeOpenFunction)(void *); int (*AfterOpenFunction)(void *); jmp_buf *jmpBuffer; }; #define SystemDependentData(theEnv) ((struct systemDependentData *) GetEnvironmentData(theEnv,SYSTEM_DEPENDENT_DATA)) /****************************************/ /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */ /****************************************/ extern void UserFunctions(void); extern void EnvUserFunctions(void *); /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void InitializeSystemDependentData(void *); static void SystemFunctionDefinitions(void *); static void InitializeKeywords(void *); static void InitializeNonportableFeatures(void *); #if (VAX_VMS || UNIX_V || LINUX || DARWIN || UNIX_7 || WIN_GCC || WIN_MVC) && (! WINDOW_INTERFACE) static void CatchCtrlC(int); #endif /* #if (WIN_MVC) && (! WINDOW_INTERFACE) static void interrupt CatchCtrlC(void); static void RestoreInterruptVectors(void); #endif */ /********************************************************/ /* InitializeSystemDependentData: Allocates environment */ /* data for system dependent routines. */ /********************************************************/ static void InitializeSystemDependentData( void *theEnv) { AllocateEnvironmentData(theEnv,SYSTEM_DEPENDENT_DATA,sizeof(struct systemDependentData),NULL); } /**************************************************/ /* InitializeEnvironment: Performs initialization */ /* of the KB environment. */ /**************************************************/ #if ALLOW_ENVIRONMENT_GLOBALS globle void InitializeEnvironment() { if (GetCurrentEnvironment() == NULL) { CreateEnvironment(); } } #endif /*****************************************************/ /* EnvInitializeEnvironment: Performs initialization */ /* of the KB environment. */ /*****************************************************/ globle void EnvInitializeEnvironment( void *vtheEnvironment, struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable, struct externalAddressHashNode **externalAddressTable) { struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment; /*================================================*/ /* Don't allow the initialization to occur twice. */ /*================================================*/ if (theEnvironment->initialized) return; /*================================*/ /* Initialize the memory manager. */ /*================================*/ InitializeMemory(theEnvironment); /*===================================================*/ /* Initialize environment data for various features. */ /*===================================================*/ InitializeCommandLineData(theEnvironment); #if CONSTRUCT_COMPILER && (! RUN_TIME) InitializeConstructCompilerData(theEnvironment); #endif InitializeConstructData(theEnvironment); InitializeEvaluationData(theEnvironment); InitializeExternalFunctionData(theEnvironment); InitializePrettyPrintData(theEnvironment); InitializePrintUtilityData(theEnvironment); InitializeScannerData(theEnvironment); InitializeSystemDependentData(theEnvironment); InitializeUserDataData(theEnvironment); InitializeUtilityData(theEnvironment); #if DEBUGGING_FUNCTIONS InitializeWatchData(theEnvironment); #endif /*===============================================*/ /* Initialize the hash tables for atomic values. */ /*===============================================*/ InitializeAtomTables(theEnvironment,symbolTable,floatTable,integerTable,bitmapTable,externalAddressTable); /*=========================================*/ /* Initialize file and string I/O routers. */ /*=========================================*/ InitializeDefaultRouters(theEnvironment); /*=========================================================*/ /* Initialize some system dependent features such as time. */ /*=========================================================*/ InitializeNonportableFeatures(theEnvironment); /*=============================================*/ /* Register system and user defined functions. */ /*=============================================*/ SystemFunctionDefinitions(theEnvironment); UserFunctions(); EnvUserFunctions(theEnvironment); /*====================================*/ /* Initialize the constraint manager. */ /*====================================*/ InitializeConstraints(theEnvironment); /*==========================================*/ /* Initialize the expression hash table and */ /* pointers to specific functions. */ /*==========================================*/ InitExpressionData(theEnvironment); /*===================================*/ /* Initialize the construct manager. */ /*===================================*/ #if ! RUN_TIME InitializeConstructs(theEnvironment); #endif /*=====================================*/ /* Initialize the defmodule construct. */ /*=====================================*/ AllocateDefmoduleGlobals(theEnvironment); /*===================================*/ /* Initialize the defrule construct. */ /*===================================*/ #if DEFRULE_CONSTRUCT InitializeDefrules(theEnvironment); #endif /*====================================*/ /* Initialize the deffacts construct. */ /*====================================*/ #if DEFFACTS_CONSTRUCT InitializeDeffacts(theEnvironment); #endif /*=====================================================*/ /* Initialize the defgeneric and defmethod constructs. */ /*=====================================================*/ #if DEFGENERIC_CONSTRUCT SetupGenericFunctions(theEnvironment); #endif /*=======================================*/ /* Initialize the deffunction construct. */ /*=======================================*/ #if DEFFUNCTION_CONSTRUCT SetupDeffunctions(theEnvironment); #endif /*=====================================*/ /* Initialize the defglobal construct. */ /*=====================================*/ #if DEFGLOBAL_CONSTRUCT InitializeDefglobals(theEnvironment); #endif /*=======================================*/ /* Initialize the deftemplate construct. */ /*=======================================*/ #if DEFTEMPLATE_CONSTRUCT InitializeDeftemplates(theEnvironment); #endif /*=============================*/ /* Initialize COOL constructs. */ /*=============================*/ #if OBJECT_SYSTEM SetupObjectSystem(theEnvironment); #endif /*=====================================*/ /* Initialize the defmodule construct. */ /*=====================================*/ InitializeDefmodules(theEnvironment); /*======================================================*/ /* Register commands and functions for development use. */ /*======================================================*/ #if DEVELOPER DeveloperCommands(theEnvironment); #endif /*=========================================*/ /* Install the special function primitives */ /* used by procedural code in constructs. */ /*=========================================*/ InstallProcedurePrimitives(theEnvironment); /*==============================================*/ /* Install keywords in the symbol table so that */ /* they are available for command completion. */ /*==============================================*/ InitializeKeywords(theEnvironment); /*========================*/ /* Issue a clear command. */ /*========================*/ EnvClear(theEnvironment); /*=============================*/ /* Initialization is complete. */ /*=============================*/ theEnvironment->initialized = TRUE; } /******************************************************/ /* SetRedrawFunction: Sets the redraw screen function */ /* for use with a user interface that may be */ /* overwritten by execution of a command. */ /******************************************************/ globle void SetRedrawFunction( void *theEnv, void (*theFunction)(void *)) { SystemDependentData(theEnv)->RedrawScreenFunction = theFunction; } /******************************************************/ /* SetPauseEnvFunction: Set the normal state function */ /* which puts terminal in a normal state. */ /******************************************************/ globle void SetPauseEnvFunction( void *theEnv, void (*theFunction)(void *)) { SystemDependentData(theEnv)->PauseEnvFunction = theFunction; } /*********************************************************/ /* SetContinueEnvFunction: Sets the continue environment */ /* function which returns the terminal to a special */ /* screen interface state. */ /*********************************************************/ globle void SetContinueEnvFunction( void *theEnv, void (*theFunction)(void *,int)) { SystemDependentData(theEnv)->ContinueEnvFunction = theFunction; } /*******************************************************/ /* GetRedrawFunction: Gets the redraw screen function. */ /*******************************************************/ globle void (*GetRedrawFunction(void *theEnv))(void *) { return SystemDependentData(theEnv)->RedrawScreenFunction; } /*****************************************************/ /* GetPauseEnvFunction: Gets the normal state function. */ /*****************************************************/ globle void (*GetPauseEnvFunction(void *theEnv))(void *) { return SystemDependentData(theEnv)->PauseEnvFunction; } /*********************************************/ /* GetContinueEnvFunction: Gets the continue */ /* environment function. */ /*********************************************/ globle void (*GetContinueEnvFunction(void *theEnv))(void *,int) { return SystemDependentData(theEnv)->ContinueEnvFunction; } /*************************************************/ /* RerouteStdin: Processes the -f, -f2, and -l */ /* options available on machines which support */ /* argc and arv command line options. */ /*************************************************/ globle void RerouteStdin( void *theEnv, int argc, char *argv[]) { int i; int theSwitch = NO_SWITCH; /*======================================*/ /* If there aren't enough arguments for */ /* the -f argument, then return. */ /*======================================*/ if (argc < 3) { return; } /*=====================================*/ /* If argv was not passed then return. */ /*=====================================*/ if (argv == NULL) return; /*=============================================*/ /* Process each of the command line arguments. */ /*=============================================*/ for (i = 1 ; i < argc ; i++) { if (strcmp(argv[i],"-f") == 0) theSwitch = BATCH_SWITCH; #if ! RUN_TIME else if (strcmp(argv[i],"-f2") == 0) theSwitch = BATCH_STAR_SWITCH; else if (strcmp(argv[i],"-l") == 0) theSwitch = LOAD_SWITCH; #endif else if (theSwitch == NO_SWITCH) { PrintErrorID(theEnv,"SYSDEP",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid option\n"); } if (i > (argc-1)) { PrintErrorID(theEnv,"SYSDEP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No file found for "); switch(theSwitch) { case BATCH_SWITCH: EnvPrintRouter(theEnv,WERROR,"-f"); break; case BATCH_STAR_SWITCH: EnvPrintRouter(theEnv,WERROR,"-f2"); break; case LOAD_SWITCH: EnvPrintRouter(theEnv,WERROR,"-l"); } EnvPrintRouter(theEnv,WERROR," option\n"); return; } switch(theSwitch) { case BATCH_SWITCH: OpenBatch(theEnv,argv[++i],TRUE); break; #if (! RUN_TIME) && (! BLOAD_ONLY) case BATCH_STAR_SWITCH: EnvBatchStar(theEnv,argv[++i]); break; case LOAD_SWITCH: EnvLoad(theEnv,argv[++i]); break; #endif } } } /**************************************************/ /* SystemFunctionDefinitions: Sets up definitions */ /* of system defined functions. */ /**************************************************/ static void SystemFunctionDefinitions( void *theEnv) { ProceduralFunctionDefinitions(theEnv); MiscFunctionDefinitions(theEnv); #if IO_FUNCTIONS IOFunctionDefinitions(theEnv); #endif PredicateFunctionDefinitions(theEnv); BasicMathFunctionDefinitions(theEnv); FileCommandDefinitions(theEnv); SortFunctionDefinitions(theEnv); #if DEBUGGING_FUNCTIONS WatchFunctionDefinitions(theEnv); #endif #if MULTIFIELD_FUNCTIONS MultifieldFunctionDefinitions(theEnv); #endif #if STRING_FUNCTIONS StringFunctionDefinitions(theEnv); #endif #if EXTENDED_MATH_FUNCTIONS ExtendedMathFunctionDefinitions(theEnv); #endif #if TEXTPRO_FUNCTIONS HelpFunctionDefinitions(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) ConstructsToCCommandDefinition(theEnv); #endif #if PROFILING_FUNCTIONS ConstructProfilingFunctionDefinitions(theEnv); #endif ParseFunctionDefinitions(theEnv); } /*********************************************************/ /* gentime: A function to return a floating point number */ /* which indicates the present time. Used internally */ /* for timing rule firings and debugging. */ /*********************************************************/ globle double gentime() { #if MAC_XCD UnsignedWide result; Microseconds(&result); return(((((double) result.hi) * kTwoPower32) + result.lo) / 1000000.0); #elif UNIX_V || DARWIN #if defined(_POSIX_TIMERS) && (_POSIX_TIMERS > 0) struct timespec now; clock_gettime( #if defined(_POSIX_MONOTONIC_CLOCK) CLOCK_MONOTONIC, #else CLOCK_REALTIME, #endif &now); return (now.tv_nsec / 1000000000.0) + now.tv_sec; #else struct timeval now; gettimeofday(&now, 0); return (now.tv_usec / 1000000.0) + now.tv_sec; #endif #elif LINUX #if defined(_POSIX_TIMERS) && (_POSIX_TIMERS > 0) && defined(_POSIX_C_SOURCE) && (_POSIX_C_SOURCE >= 199309L) struct timespec now; clock_gettime( #if defined(_POSIX_MONOTONIC_CLOCK) CLOCK_MONOTONIC, #else CLOCK_REALTIME, #endif &now); return (now.tv_nsec / 1000000000.0) + now.tv_sec; #else struct timeval now; gettimeofday(&now, 0); return (now.tv_usec / 1000000.0) + now.tv_sec; #endif #elif UNIX_7 struct timeval now; gettimeofday(&now, 0); return (now.tv_usec / 1000000.0) + now.tv_sec; #else return((double) clock() / (double) CLOCKS_PER_SEC); #endif } /*****************************************************/ /* gensystem: Generic routine for passing a string */ /* representing a command to the operating system. */ /*****************************************************/ globle void gensystem( void *theEnv) { char *commandBuffer = NULL; size_t bufferPosition = 0; size_t bufferMaximum = 0; int numa, i; DATA_OBJECT tempValue; const char *theString; /*===========================================*/ /* Check for the corret number of arguments. */ /*===========================================*/ if ((numa = EnvArgCountCheck(theEnv,"system",AT_LEAST,1)) == -1) return; /*============================================================*/ /* Concatenate the arguments together to form a single string */ /* containing the command to be sent to the operating system. */ /*============================================================*/ for (i = 1 ; i <= numa; i++) { EnvRtnUnknown(theEnv,i,&tempValue); if ((GetType(tempValue) != STRING) && (GetType(tempValue) != SYMBOL)) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); ExpectedTypeError2(theEnv,"system",i); return; } theString = DOToString(tempValue); commandBuffer = AppendToString(theEnv,theString,commandBuffer,&bufferPosition,&bufferMaximum); } if (commandBuffer == NULL) return; /*=======================================*/ /* Execute the operating system command. */ /*=======================================*/ #if VAX_VMS if (SystemDependentData(theEnv)->PauseEnvFunction != NULL) (*SystemDependentData(theEnv)->PauseEnvFunction)(theEnv); VMSSystem(commandBuffer); putchar('\n'); if (SystemDependentData(theEnv)->ContinueEnvFunction != NULL) (*SystemDependentData(theEnv)->ContinueEnvFunction)(theEnv,1); if (SystemDependentData(theEnv)->RedrawScreenFunction != NULL) (*SystemDependentData(theEnv)->RedrawScreenFunction)(theEnv); #endif #if UNIX_7 || UNIX_V || LINUX || DARWIN || WIN_MVC || WIN_GCC || MAC_XCD if (SystemDependentData(theEnv)->PauseEnvFunction != NULL) (*SystemDependentData(theEnv)->PauseEnvFunction)(theEnv); system(commandBuffer); if (SystemDependentData(theEnv)->ContinueEnvFunction != NULL) (*SystemDependentData(theEnv)->ContinueEnvFunction)(theEnv,1); if (SystemDependentData(theEnv)->RedrawScreenFunction != NULL) (*SystemDependentData(theEnv)->RedrawScreenFunction)(theEnv); #else #if ! VAX_VMS EnvPrintRouter(theEnv,WDIALOG, "System function not fully defined for this system.\n"); #endif #endif /*==================================================*/ /* Return the string buffer containing the command. */ /*==================================================*/ rm(theEnv,commandBuffer,bufferMaximum); return; } #if VAX_VMS /*************************************************/ /* VMSSystem: Implements system command for VMS. */ /*************************************************/ globle void VMSSystem( char *cmd) { long status, complcode; struct dsc$descriptor_s cmd_desc; cmd_desc.dsc$w_length = strlen(cmd); cmd_desc.dsc$a_pointer = cmd; cmd_desc.dsc$b_class = DSC$K_CLASS_S; cmd_desc.dsc$b_dtype = DSC$K_DTYPE_T; status = LIB$SPAWN(&cmd_desc,0,0,0,0,0,&complcode,0,0,0); } #endif /*******************************************/ /* gengetchar: Generic routine for getting */ /* a character from stdin. */ /*******************************************/ globle int gengetchar( void *theEnv) { /* #if WIN_MVC if (SystemDependentData(theEnv)->getcLength == SystemDependentData(theEnv)->getcPosition) { TCHAR tBuffer = 0; DWORD count = 0; WCHAR wBuffer = 0; ReadConsole(GetStdHandle(STD_INPUT_HANDLE),&tBuffer,1,&count,NULL); wBuffer = tBuffer; SystemDependentData(theEnv)->getcLength = WideCharToMultiByte(CP_UTF8,0,&wBuffer,1, (char *) SystemDependentData(theEnv)->getcBuffer, 7,NULL,NULL); SystemDependentData(theEnv)->getcPosition = 0; } return SystemDependentData(theEnv)->getcBuffer[SystemDependentData(theEnv)->getcPosition++]; #else */ return(getc(stdin)); /* #endif */ } /***********************************************/ /* genungetchar: Generic routine for ungetting */ /* a character from stdin. */ /***********************************************/ globle int genungetchar( void *theEnv, int theChar) { /* #if WIN_MVC if (SystemDependentData(theEnv)->getcPosition > 0) { SystemDependentData(theEnv)->getcPosition--; return theChar; } else { return EOF; } #else */ return(ungetc(theChar,stdin)); /* #endif */ } /****************************************************/ /* genprintfile: Generic routine for print a single */ /* character string to a file (including stdout). */ /****************************************************/ globle void genprintfile( void *theEnv, FILE *fptr, const char *str) { if (fptr != stdout) { fprintf(fptr,"%s",str); fflush(fptr); } else { #if WIN_MVC /* int rv; wchar_t *wbuffer; size_t len = strlen(str); wbuffer = genalloc(theEnv,sizeof(wchar_t) * (len + 1)); rv = MultiByteToWideChar(CP_UTF8,MB_ERR_INVALID_CHARS,str,-1,wbuffer,len+1); fwprintf(fptr,L"%ls",wbuffer); fflush(fptr); genfree(theEnv,wbuffer,sizeof(wchar_t) * (len + 1)); */ fprintf(fptr,"%s",str); fflush(fptr); #else fprintf(fptr,"%s",str); fflush(fptr); #endif } } /***********************************************************/ /* InitializeNonportableFeatures: Initializes non-portable */ /* features. Currently, the only non-portable feature */ /* requiring initialization is the interrupt handler */ /* which allows execution to be halted. */ /***********************************************************/ static void InitializeNonportableFeatures( void *theEnv) { #if MAC_XCD #pragma unused(theEnv) #endif #if ! WINDOW_INTERFACE #if VAX_VMS || UNIX_V || LINUX || DARWIN || UNIX_7 || WIN_GCC || WIN_MVC signal(SIGINT,CatchCtrlC); #endif /* #if WIN_MVC SystemDependentData(theEnv)->OldCtrlC = _dos_getvect(0x23); SystemDependentData(theEnv)->OldBreak = _dos_getvect(0x1b); _dos_setvect(0x23,CatchCtrlC); _dos_setvect(0x1b,CatchCtrlC); atexit(RestoreInterruptVectors); #endif */ #endif } /*************************************************************/ /* Functions For Handling Control C Interrupt: The following */ /* functions handle interrupt processing for several */ /* machines. For the Macintosh control-c is not handle, */ /* but a function is provided to call periodically which */ /* calls SystemTask (allowing periodic tasks to be handled */ /* by the operating system). */ /*************************************************************/ #if ! WINDOW_INTERFACE #if VAX_VMS || UNIX_V || LINUX || DARWIN || UNIX_7 || WIN_GCC || WIN_MVC || DARWIN /**********************************************/ /* CatchCtrlC: VMS and UNIX specific function */ /* to allow control-c interrupts. */ /**********************************************/ static void CatchCtrlC( int sgnl) { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif signal(SIGINT,CatchCtrlC); } #endif #if WIN_MVC /******************************************************/ /* CatchCtrlC: IBM Microsoft C and Borland Turbo C */ /* specific function to allow control-c interrupts. */ /******************************************************/ /* static void interrupt CatchCtrlC() { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif } */ /**************************************************************/ /* RestoreInterruptVectors: IBM Microsoft C and Borland Turbo */ /* C specific function for restoring interrupt vectors. */ /**************************************************************/ /* static void RestoreInterruptVectors() { #if ALLOW_ENVIRONMENT_GLOBALS void *theEnv; theEnv = GetCurrentEnvironment(); _dos_setvect(0x23,SystemDependentData(theEnv)->OldCtrlC); _dos_setvect(0x1b,SystemDependentData(theEnv)->OldBreak); #endif } */ #endif #endif /**************************************/ /* genexit: A generic exit function. */ /**************************************/ globle void genexit( void *theEnv, int num) { if (SystemDependentData(theEnv)->jmpBuffer != NULL) { longjmp(*SystemDependentData(theEnv)->jmpBuffer,1); } exit(num); } /**************************************/ /* SetJmpBuffer: */ /**************************************/ globle void SetJmpBuffer( void *theEnv, jmp_buf *theJmpBuffer) { SystemDependentData(theEnv)->jmpBuffer = theJmpBuffer; } /******************************************/ /* genstrcpy: Generic genstrcpy function. */ /******************************************/ char *genstrcpy( char *dest, const char *src) { return strcpy(dest,src); } /********************************************/ /* genstrncpy: Generic genstrncpy function. */ /********************************************/ char *genstrncpy( char *dest, const char *src, size_t n) { return strncpy(dest,src,n); } /******************************************/ /* genstrcat: Generic genstrcat function. */ /******************************************/ char *genstrcat( char *dest, const char *src) { return strcat(dest,src); } /********************************************/ /* genstrncat: Generic genstrncat function. */ /********************************************/ char *genstrncat( char *dest, const char *src, size_t n) { return strncat(dest,src,n); } /*****************************************/ /* gensprintf: Generic sprintf function. */ /*****************************************/ int gensprintf( char *buffer, const char *restrictStr, ...) { va_list args; int rv; va_start(args,restrictStr); rv = vsprintf(buffer,restrictStr,args); va_end(args); return rv; } /******************************************************/ /* genrand: Generic random number generator function. */ /******************************************************/ int genrand() { return(rand()); } /**********************************************************************/ /* genseed: Generic function for seeding the random number generator. */ /**********************************************************************/ globle void genseed( int seed) { srand((unsigned) seed); } /*********************************************/ /* gengetcwd: Generic function for returning */ /* the current directory. */ /*********************************************/ globle char *gengetcwd( char *buffer, int buflength) { #if MAC_XCD return(getcwd(buffer,buflength)); #endif if (buffer != NULL) { buffer[0] = 0; } return(buffer); } /****************************************************/ /* genremove: Generic function for removing a file. */ /****************************************************/ globle int genremove( const char *fileName) { if (remove(fileName)) return(FALSE); return(TRUE); } /****************************************************/ /* genrename: Generic function for renaming a file. */ /****************************************************/ globle int genrename( const char *oldFileName, const char *newFileName) { if (rename(oldFileName,newFileName)) return(FALSE); return(TRUE); } /**************************************/ /* EnvSetBeforeOpenFunction: Sets the */ /* value of BeforeOpenFunction. */ /**************************************/ globle int (*EnvSetBeforeOpenFunction(void *theEnv, int (*theFunction)(void *)))(void *) { int (*tempFunction)(void *); tempFunction = SystemDependentData(theEnv)->BeforeOpenFunction; SystemDependentData(theEnv)->BeforeOpenFunction = theFunction; return(tempFunction); } /*************************************/ /* EnvSetAfterOpenFunction: Sets the */ /* value of AfterOpenFunction. */ /*************************************/ globle int (*EnvSetAfterOpenFunction(void *theEnv, int (*theFunction)(void *)))(void *) { int (*tempFunction)(void *); tempFunction = SystemDependentData(theEnv)->AfterOpenFunction; SystemDependentData(theEnv)->AfterOpenFunction = theFunction; return(tempFunction); } /*********************************************/ /* GenOpen: Trap routine for opening a file. */ /*********************************************/ globle FILE *GenOpen( void *theEnv, const char *fileName, const char *accessType) { FILE *theFile; /*==================================*/ /* Invoke the before open function. */ /*==================================*/ if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } /*================*/ /* Open the file. */ /*================*/ #if WIN_MVC #if _MSC_VER >= 1400 fopen_s(&theFile,fileName,accessType); #else theFile = fopen(fileName,accessType); #endif #else theFile = fopen(fileName,accessType); #endif /*=====================================*/ /* Check for a UTF-8 Byte Order Marker */ /* (BOM): 0xEF,0xBB,0xBF. */ /*=====================================*/ if ((theFile != NULL) & (strcmp(accessType,"r") == 0)) { int theChar; theChar = getc(theFile); if (theChar == 0xEF) { theChar = getc(theFile); if (theChar == 0xBB) { theChar = getc(theFile); if (theChar != 0xBF) { ungetc(theChar,theFile);} } else { ungetc(theChar,theFile);} } else { ungetc(theChar,theFile); } } /*=================================*/ /* Invoke the after open function. */ /*=================================*/ if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } /*===============================*/ /* Return a pointer to the file. */ /*===============================*/ return theFile; } /**********************************************/ /* GenClose: Trap routine for closing a file. */ /**********************************************/ globle int GenClose( void *theEnv, FILE *theFile) { int rv; if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } rv = fclose(theFile); if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } return rv; } /************************************************************/ /* GenOpenReadBinary: Generic and machine specific code for */ /* opening a file for binary access. Only one file may be */ /* open at a time when using this function since the file */ /* pointer is stored in a global variable. */ /************************************************************/ globle int GenOpenReadBinary( void *theEnv, const char *funcName, const char *fileName) { if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } #if WIN_MVC SystemDependentData(theEnv)->BinaryFileHandle = _open(fileName,O_RDONLY | O_BINARY); if (SystemDependentData(theEnv)->BinaryFileHandle == -1) { if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } OpenErrorMessage(theEnv,funcName,fileName); return(FALSE); } #endif #if (! WIN_MVC) if ((SystemDependentData(theEnv)->BinaryFP = fopen(fileName,"rb")) == NULL) { if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } OpenErrorMessage(theEnv,funcName,fileName); return(FALSE); } #endif if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } return(TRUE); } /***********************************************/ /* GenReadBinary: Generic and machine specific */ /* code for reading from a file. */ /***********************************************/ globle void GenReadBinary( void *theEnv, void *dataPtr, size_t size) { #if WIN_MVC char *tempPtr; tempPtr = (char *) dataPtr; while (size > INT_MAX) { _read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,INT_MAX); size -= INT_MAX; tempPtr = tempPtr + INT_MAX; } if (size > 0) { _read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,(unsigned int) size); } #endif #if (! WIN_MVC) fread(dataPtr,size,1,SystemDependentData(theEnv)->BinaryFP); #endif } /***************************************************/ /* GetSeekCurBinary: Generic and machine specific */ /* code for seeking a position in a file. */ /***************************************************/ globle void GetSeekCurBinary( void *theEnv, long offset) { #if WIN_MVC _lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_CUR); #endif #if (! WIN_MVC) fseek(SystemDependentData(theEnv)->BinaryFP,offset,SEEK_CUR); #endif } /***************************************************/ /* GetSeekSetBinary: Generic and machine specific */ /* code for seeking a position in a file. */ /***************************************************/ globle void GetSeekSetBinary( void *theEnv, long offset) { #if WIN_MVC _lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_SET); #endif #if (! WIN_MVC) fseek(SystemDependentData(theEnv)->BinaryFP,offset,SEEK_SET); #endif } /************************************************/ /* GenTellBinary: Generic and machine specific */ /* code for telling a position in a file. */ /************************************************/ globle void GenTellBinary( void *theEnv, long *offset) { #if WIN_MVC *offset = _lseek(SystemDependentData(theEnv)->BinaryFileHandle,0,SEEK_CUR); #endif #if (! WIN_MVC) *offset = ftell(SystemDependentData(theEnv)->BinaryFP); #endif } /****************************************/ /* GenCloseBinary: Generic and machine */ /* specific code for closing a file. */ /****************************************/ globle void GenCloseBinary( void *theEnv) { if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } #if WIN_MVC _close(SystemDependentData(theEnv)->BinaryFileHandle); #endif #if (! WIN_MVC) fclose(SystemDependentData(theEnv)->BinaryFP); #endif if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } } /***********************************************/ /* GenWrite: Generic routine for writing to a */ /* file. No machine specific code as of yet. */ /***********************************************/ globle void GenWrite( void *dataPtr, size_t size, FILE *fp) { if (size == 0) return; #if UNIX_7 fwrite(dataPtr,size,1,fp); #else fwrite(dataPtr,size,1,fp); #endif } /*********************************************/ /* InitializeKeywords: Adds key words to the */ /* symbol table so that they are available */ /* for command completion. */ /*********************************************/ static void InitializeKeywords( void *theEnv) { #if (! RUN_TIME) && WINDOW_INTERFACE void *ts; /*====================*/ /* construct keywords */ /*====================*/ ts = EnvAddSymbol(theEnv,"defrule"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defglobal"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deftemplate"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffacts"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffunction"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defmethod"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defgeneric"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defclass"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defmessage-handler"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"definstances"); IncrementSymbolCount(ts); /*=======================*/ /* set-strategy keywords */ /*=======================*/ ts = EnvAddSymbol(theEnv,"depth"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"breadth"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"lex"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"mea"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"simplicity"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"complexity"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"random"); IncrementSymbolCount(ts); /*==================================*/ /* set-salience-evaluation keywords */ /*==================================*/ ts = EnvAddSymbol(theEnv,"when-defined"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"when-activated"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"every-cycle"); IncrementSymbolCount(ts); /*======================*/ /* deftemplate keywords */ /*======================*/ ts = EnvAddSymbol(theEnv,"field"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"multifield"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"default"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"type"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-symbols"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-strings"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-numbers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-integers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-floats"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-values"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"min-number-of-elements"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"max-number-of-elements"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"NONE"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"VARIABLE"); IncrementSymbolCount(ts); /*==================*/ /* defrule keywords */ /*==================*/ ts = EnvAddSymbol(theEnv,"declare"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"salience"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"test"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"or"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"and"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"not"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"logical"); IncrementSymbolCount(ts); /*===============*/ /* COOL keywords */ /*===============*/ ts = EnvAddSymbol(theEnv,"is-a"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"role"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"abstract"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"concrete"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"pattern-match"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"reactive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"non-reactive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"slot"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"field"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"multiple"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"single"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"storage"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"shared"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"local"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"access"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"write"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read-only"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read-write"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"initialize-only"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"propagation"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"inherit"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"no-inherit"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"source"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"composite"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"exclusive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-lexemes"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-instances"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"around"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"before"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"primary"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"after"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"of"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"self"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"visibility"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"override-message"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"private"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"public"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"create-accessor"); IncrementSymbolCount(ts); /*================*/ /* watch keywords */ /*================*/ ts = EnvAddSymbol(theEnv,"compilations"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffunctions"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"globals"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"rules"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"activations"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"statistics"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"facts"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"generic-functions"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"methods"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"instances"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"slots"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"messages"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"message-handlers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"focus"); IncrementSymbolCount(ts); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } clips_core_source_630/core/iofun.h0000755000175000017500000001144212373756315015540 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* I/O FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added the get-char, set-locale, and */ /* read-number functions. */ /* */ /* Modified printing of floats in the format */ /* function to use the locale from the set-locale */ /* function. */ /* */ /* Moved IllegalLogicalNameMessage function to */ /* argacces.c. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Removed the undocumented use of t in the */ /* printout command to perform the same function */ /* as crlf. */ /* */ /* Replaced EXT_IO and BASIC_IO compiler flags */ /* with IO_FUNCTIONS compiler flag. */ /* */ /* Added a+, w+, rb, ab, r+b, w+b, and a+b modes */ /* for the open function. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added put-char function. */ /* */ /* Added SetFullCRLF which allows option to */ /* specify crlf as \n or \r\n. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_iofun #define _H_iofun #ifdef LOCALE #undef LOCALE #endif #ifdef _IOFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void IOFunctionDefinitions(void *); #if IO_FUNCTIONS LOCALE intBool SetFullCRLF(void *,intBool); LOCALE void PrintoutFunction(void *); LOCALE void ReadFunction(void *,DATA_OBJECT_PTR); LOCALE int OpenFunction(void *); LOCALE int CloseFunction(void *); LOCALE int GetCharFunction(void *); LOCALE void PutCharFunction(void *); LOCALE void ReadlineFunction(void *,DATA_OBJECT_PTR); LOCALE void *FormatFunction(void *); LOCALE int RemoveFunction(void *); LOCALE int RenameFunction(void *); LOCALE void SetLocaleFunction(void *,DATA_OBJECT_PTR); LOCALE void ReadNumberFunction(void *,DATA_OBJECT_PTR); #endif #endif /* _H_iofun */ clips_core_source_630/core/insqypsr.h0000755000175000017500000000505612373756327016317 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Fixed memory leaks when error occurred. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_insqypsr #define _H_insqypsr #if INSTANCE_SET_QUERIES && (! RUN_TIME) #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSQYPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE EXPRESSION *ParseQueryNoAction(void *,EXPRESSION *,const char *); LOCALE EXPRESSION *ParseQueryAction(void *,EXPRESSION *,const char *); #endif /* INSTANCE_SET_QUERIES && (! RUN_TIME) */ #endif /* _H_insqypsr */ clips_core_source_630/core/symblbin.h0000755000175000017500000000546112373755530016241 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SYMBOL BINARY SAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* atomic data values. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /*************************************************************/ #ifndef _H_symblbin #define _H_symblbin #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SYMBLBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define BitMapPointer(i) ((BITMAP_HN *) (SymbolData(theEnv)->BitMapArray[i])) #define SymbolPointer(i) ((SYMBOL_HN *) (SymbolData(theEnv)->SymbolArray[i])) #define FloatPointer(i) ((FLOAT_HN *) (SymbolData(theEnv)->FloatArray[i])) #define IntegerPointer(i) ((INTEGER_HN *) (SymbolData(theEnv)->IntegerArray[i])) LOCALE void MarkNeededAtomicValues(void); LOCALE void WriteNeededAtomicValues(void *,FILE *); LOCALE void ReadNeededAtomicValues(void *); LOCALE void InitAtomicValueNeededFlags(void *); LOCALE void FreeAtomicValueStorage(void *); LOCALE void WriteNeededSymbols(void *,FILE *); LOCALE void WriteNeededFloats(void *,FILE *); LOCALE void WriteNeededIntegers(void *,FILE *); LOCALE void ReadNeededSymbols(void *); LOCALE void ReadNeededFloats(void *); LOCALE void ReadNeededIntegers(void *); #endif /* _H_symblbin */ clips_core_source_630/core/inspsr.c0000755000175000017500000005526312464742046015737 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* INSTANCE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Instance Function Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed ParseSlotOverrides memory release issue. */ /* */ /* It's now possible to create an instance of a */ /* class that's not in scope if the module name */ /* is specified. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include #include "classcom.h" #include "classfun.h" #include "classinf.h" #include "constant.h" #include "envrnmnt.h" #include "evaluatn.h" #include "exprnpsr.h" #include "extnfunc.h" #include "moduldef.h" #include "prntutil.h" #include "router.h" #define _INSPSR_SOURCE_ #include "inspsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MAKE_TYPE 0 #define INITIALIZE_TYPE 1 #define MODIFY_TYPE 2 #define DUPLICATE_TYPE 3 #define CLASS_RLN "of" #define DUPLICATE_NAME_REF "to" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ReplaceClassNameWithReference(void *,EXPRESSION *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! RUN_TIME /************************************************************************************* NAME : ParseInitializeInstance DESCRIPTION : Parses initialize-instance and make-instance function calls into an EXPRESSION form that can later be evaluated with EvaluateExpression(theEnv,) INPUTS : 1) The address of the top node of the expression containing the initialize-instance function call 2) The logical name of the input source RETURNS : The address of the modified expression, or NULL if there is an error SIDE EFFECTS : The expression is enhanced to include all aspects of the initialize-instance call (slot-overrides etc.) The "top" expression is deleted on errors. NOTES : This function parses a initialize-instance call into an expression of the following form : (initialize-instance *) where ::= ( +) goes to --> initialize-instance | V ->->... | V ... (make-instance of *) goes to --> make-instance | V ->->->... | V ... (make-instance of *) goes to --> make-instance | V (gensym*)->->->... | V ... (modify-instance *) goes to --> modify-instance | V ->->... | V ... (duplicate-instance [to ] *) goes to --> duplicate-instance | V ->->->... OR | (gensym*) V ... *************************************************************************************/ globle EXPRESSION *ParseInitializeInstance( void *theEnv, EXPRESSION *top, const char *readSource) { int error,fcalltype,readclass; if ((top->value == (void *) FindFunction(theEnv,"make-instance")) || (top->value == (void *) FindFunction(theEnv,"active-make-instance"))) fcalltype = MAKE_TYPE; else if ((top->value == (void *) FindFunction(theEnv,"initialize-instance")) || (top->value == (void *) FindFunction(theEnv,"active-initialize-instance"))) fcalltype = INITIALIZE_TYPE; else if ((top->value == (void *) FindFunction(theEnv,"modify-instance")) || (top->value == (void *) FindFunction(theEnv,"active-modify-instance")) || (top->value == (void *) FindFunction(theEnv,"message-modify-instance")) || (top->value == (void *) FindFunction(theEnv,"active-message-modify-instance"))) fcalltype = MODIFY_TYPE; else fcalltype = DUPLICATE_TYPE; IncrementIndentDepth(theEnv,3); error = FALSE; if (top->type == UNKNOWN_VALUE) top->type = FCALL; else SavePPBuffer(theEnv," "); top->argList = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; else if (top->argList == NULL) { SyntaxErrorMessage(theEnv,"instance"); goto ParseInitializeInstanceError; } SavePPBuffer(theEnv," "); if (fcalltype == MAKE_TYPE) { /* ====================================== Handle the case of anonymous instances where the name was not specified ====================================== */ if ((top->argList->type != SYMBOL) ? FALSE : (strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0)) { top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance class"); goto ParseInitializeInstanceError; } if ((top->argList->nextArg->type != SYMBOL) ? TRUE : (strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0)) { top->argList->type = FCALL; top->argList->value = (void *) FindFunction(theEnv,"gensym*"); readclass = FALSE; } else readclass = TRUE; } else { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0)) { SyntaxErrorMessage(theEnv,"make-instance"); goto ParseInitializeInstanceError; } SavePPBuffer(theEnv," "); readclass = TRUE; } if (readclass) { top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance class"); goto ParseInitializeInstanceError; } } /* ============================================== If the class name is a constant, go ahead and look it up now and replace it with the pointer ============================================== */ if (ReplaceClassNameWithReference(theEnv,top->argList->nextArg) == FALSE) goto ParseInitializeInstanceError; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } else { PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (fcalltype == DUPLICATE_TYPE) { if ((DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DUPLICATE_NAME_REF) == 0)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance name"); goto ParseInitializeInstanceError; } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } else top->argList->nextArg = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"gensym*")); top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } else top->argList->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } if (error) goto ParseInitializeInstanceError; if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"slot-override"); goto ParseInitializeInstanceError; } DecrementIndentDepth(theEnv,3); return(top); ParseInitializeInstanceError: SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); DecrementIndentDepth(theEnv,3); return(NULL); } /******************************************************************************** NAME : ParseSlotOverrides DESCRIPTION : Forms expressions for slot-overrides INPUTS : 1) The logical name of the input 2) Caller's buffer for error flkag RETURNS : Address override expressions, NULL if none or error. SIDE EFFECTS : Slot-expression built Caller's error flag set NOTES : ::= ( *)* goes to --> --> --> ... | V --> --> ... Assumes first token has already been scanned ********************************************************************************/ globle EXPRESSION *ParseSlotOverrides( void *theEnv, const char *readSource, int *error) { EXPRESSION *top = NULL,*bot = NULL,*theExp; EXPRESSION *theExpNext; while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { *error = FALSE; theExp = ArgumentParse(theEnv,readSource,error); if (*error == TRUE) { ReturnExpression(theEnv,top); return(NULL); } else if (theExp == NULL) { SyntaxErrorMessage(theEnv,"slot-override"); *error = TRUE; ReturnExpression(theEnv,top); SetEvaluationError(theEnv,TRUE); return(NULL); } theExpNext = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv)); if (CollectArguments(theEnv,theExpNext,readSource) == NULL) { *error = TRUE; ReturnExpression(theEnv,top); ReturnExpression(theEnv,theExp); return(NULL); } theExp->nextArg = theExpNext; if (top == NULL) top = theExp; else bot->nextArg = theExp; bot = theExp->nextArg; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); return(top); } #endif /**************************************************************************** NAME : ParseSimpleInstance DESCRIPTION : Parses instances from file for load-instances into an EXPRESSION forms that can later be evaluated with EvaluateExpression(theEnv,) INPUTS : 1) The address of the top node of the expression containing the make-instance function call 2) The logical name of the input source RETURNS : The address of the modified expression, or NULL if there is an error SIDE EFFECTS : The expression is enhanced to include all aspects of the make-instance call (slot-overrides etc.) The "top" expression is deleted on errors. NOTES : The name, class, values etc. must be constants. This function parses a make-instance call into an expression of the following form : (make-instance of *) where ::= ( +) goes to --> make-instance | V ->->->... | V ... ****************************************************************************/ globle EXPRESSION *ParseSimpleInstance( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *theExp,*vals = NULL,*vbot,*tval; unsigned short type; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != INSTANCE_NAME) && (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)) goto MakeInstanceError; if ((GetType(DefclassData(theEnv)->ObjectParseToken) == SYMBOL) && (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) == 0)) { top->argList = GenConstant(theEnv,FCALL, (void *) FindFunction(theEnv,"gensym*")); } else { top->argList = GenConstant(theEnv,INSTANCE_NAME, (void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0)) goto MakeInstanceError; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) goto MakeInstanceError; top->argList->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); theExp = top->argList->nextArg; if (ReplaceClassNameWithReference(theEnv,theExp) == FALSE) goto MakeInstanceError; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) goto SlotOverrideError; theExp->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); theExp->nextArg->nextArg = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv)); theExp = theExp->nextArg->nextArg; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); vbot = NULL; while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { type = GetType(DefclassData(theEnv)->ObjectParseToken); if (type == LPAREN) { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(ValueToString(DefclassData(theEnv)->ObjectParseToken.value),"create$") != 0)) goto SlotOverrideError; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) goto SlotOverrideError; tval = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); } else { if ((type != SYMBOL) && (type != STRING) && (type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME)) goto SlotOverrideError; tval = GenConstant(theEnv,type,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); } if (vals == NULL) vals = tval; else vbot->nextArg = tval; vbot = tval; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } theExp->argList = vals; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); vals = NULL; } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) goto SlotOverrideError; return(top); MakeInstanceError: SyntaxErrorMessage(theEnv,"make-instance"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); return(NULL); SlotOverrideError: SyntaxErrorMessage(theEnv,"slot-override"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); ReturnExpression(theEnv,vals); return(NULL); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference CHANGES : It's now possible to create an instance of a class that's not in scope if the module name is specified. ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { const char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); //theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName); theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); // Module or scope is now allowed if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,"class",theClassName); return(FALSE); } if (EnvClassAbstractP(theEnv,theDefclass)) { PrintErrorID(theEnv,"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,theClassName); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif } return(TRUE); } #endif clips_core_source_630/core/generate.c0000755000175000017500000012607212373753417016213 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* GENERATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for converting field */ /* constraints to expressions which can be used */ /* in the pattern and join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Reimplemented algorithm for comparisons to */ /* variables contained within not/and CEs. */ /* */ /*************************************************************/ #define _GENERATE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "symbol.h" #include "exprnpsr.h" #include "argacces.h" #include "extnfunc.h" #include "router.h" #include "ruledef.h" #include "pattern.h" #include "generate.h" #if DEFGLOBAL_CONSTRUCT #include "globlpsr.h" #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ExtractAnds(void *,struct lhsParseNode *,int, struct expr **,struct expr **,struct expr **, struct expr **,struct nandFrame *); static void ExtractFieldTest(void *,struct lhsParseNode *,int, struct expr **,struct expr **,struct expr **, struct expr **,struct nandFrame *); static struct expr *GetfieldReplace(void *,struct lhsParseNode *); static struct expr *GenPNConstant(void *,struct lhsParseNode *); static struct expr *GenJNConstant(void *,struct lhsParseNode *,int); static struct expr *GenJNColon(void *,struct lhsParseNode *,int,struct nandFrame *); static struct expr *GenPNColon(void *,struct lhsParseNode *); static struct expr *GenJNEq(void *,struct lhsParseNode *,int,struct nandFrame *); static struct expr *GenPNEq(void *,struct lhsParseNode *); static struct expr *GenJNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *,int); static struct expr *GenPNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *); static int AllVariablesInPattern(struct lhsParseNode *, int); static int AllVariablesInExpression(struct lhsParseNode *, int); /*******************************************************/ /* FieldConversion: Generates join and pattern network */ /* expressions for a field constraint. */ /*******************************************************/ globle void FieldConversion( void *theEnv, struct lhsParseNode *theField, struct lhsParseNode *thePattern, struct nandFrame *theNandFrames) { int testInPatternNetwork = TRUE; struct lhsParseNode *patternPtr; struct expr *headOfPNExpression, *headOfJNExpression; struct expr *lastPNExpression, *lastJNExpression; struct expr *tempExpression; struct expr *patternNetTest = NULL; struct expr *joinNetTest = NULL; struct expr *constantSelector = NULL; struct expr *constantValue = NULL; /*==================================================*/ /* Consider a NULL pointer to be an internal error. */ /*==================================================*/ if (theField == NULL) { SystemError(theEnv,"ANALYSIS",3); EnvExitRouter(theEnv,EXIT_FAILURE); } /*========================================================*/ /* Determine if constant testing must be performed in the */ /* join network. Only possible when a field contains an */ /* or ('|') and references are made to variables outside */ /* the pattern. */ /*========================================================*/ if (theField->bottom != NULL) { if (theField->bottom->bottom != NULL) { testInPatternNetwork = AllVariablesInPattern(theField->bottom,theField->pattern); } } /*=============================================================*/ /* Extract pattern and join network expressions. Loop through */ /* the or'ed constraints of the field, extracting pattern and */ /* join network expressions and adding them to a running list. */ /*=============================================================*/ headOfPNExpression = lastPNExpression = NULL; headOfJNExpression = lastJNExpression = NULL; for (patternPtr = theField->bottom; patternPtr != NULL; patternPtr = patternPtr->bottom) { /*=============================================*/ /* Extract pattern and join network tests from */ /* the or'ed constraint being examined. */ /*=============================================*/ ExtractAnds(theEnv,patternPtr,testInPatternNetwork,&patternNetTest,&joinNetTest, &constantSelector,&constantValue,theNandFrames); /*=============================================================*/ /* Constant hashing is only used in the pattern network if the */ /* field doesn't contain an or'ed constraint. For example, the */ /* constaint "red | blue" can not use hashing. */ /*=============================================================*/ if (constantSelector != NULL) { if ((patternPtr == theField->bottom) && (patternPtr->bottom == NULL)) { theField->constantSelector = constantSelector; theField->constantValue = constantValue; } else { ReturnExpression(theEnv,constantSelector); ReturnExpression(theEnv,constantValue); ReturnExpression(theEnv,theField->constantSelector); ReturnExpression(theEnv,theField->constantValue); theField->constantSelector = NULL; theField->constantValue = NULL; } } /*=====================================================*/ /* Add the new pattern network expressions to the list */ /* of pattern network expressions being constructed. */ /*=====================================================*/ if (patternNetTest != NULL) { if (lastPNExpression == NULL) { headOfPNExpression = patternNetTest; } else { lastPNExpression->nextArg = patternNetTest; } lastPNExpression = patternNetTest; } /*==================================================*/ /* Add the new join network expressions to the list */ /* of join network expressions being constructed. */ /*==================================================*/ if (joinNetTest != NULL) { if (lastJNExpression == NULL) { headOfJNExpression = joinNetTest; } else { lastJNExpression->nextArg = joinNetTest; } lastJNExpression = joinNetTest; } } /*==========================================================*/ /* If there was more than one expression generated from the */ /* or'ed field constraints for the pattern network, then */ /* enclose the expressions within an "or" function call. */ /*==========================================================*/ if ((headOfPNExpression != NULL) ? (headOfPNExpression->nextArg != NULL) : FALSE) { tempExpression = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_OR); tempExpression->argList = headOfPNExpression; headOfPNExpression = tempExpression; } /*==========================================================*/ /* If there was more than one expression generated from the */ /* or'ed field constraints for the join network, then */ /* enclose the expressions within an "or" function call. */ /*==========================================================*/ if ((headOfJNExpression != NULL) ? (headOfJNExpression->nextArg != NULL) : FALSE) { tempExpression = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_OR); tempExpression->argList = headOfJNExpression; headOfJNExpression = tempExpression; } /*===============================================================*/ /* If the field constraint binds a variable that was previously */ /* bound somewhere in the LHS of the rule, then generate an */ /* expression to compare this binding occurrence of the variable */ /* to the previous binding occurrence. */ /*===============================================================*/ if (((theField->type == MF_VARIABLE) || (theField->type == SF_VARIABLE)) && (theField->referringNode != NULL)) { /*================================================================*/ /* If the previous variable reference is within the same pattern, */ /* then the variable comparison can occur in the pattern network. */ /*================================================================*/ if (theField->referringNode->pattern == theField->pattern) { tempExpression = GenPNVariableComparison(theEnv,theField,theField->referringNode); headOfPNExpression = CombineExpressions(theEnv,tempExpression,headOfPNExpression); } /*====================================*/ /* Otherwise, the variable comparison */ /* must occur in the join network. */ /*====================================*/ else if (theField->referringNode->pattern > 0) { AddNandUnification(theEnv,theField,theNandFrames); /*====================================*/ /* Generate an expression to test the */ /* variable in a non-nand join. */ /*====================================*/ tempExpression = GenJNVariableComparison(theEnv,theField,theField->referringNode,FALSE); headOfJNExpression = CombineExpressions(theEnv,tempExpression,headOfJNExpression); /*==========================*/ /* Generate the hash index. */ /*==========================*/ if (theField->patternType->genGetPNValueFunction != NULL) { tempExpression = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); thePattern->rightHash = AppendExpressions(tempExpression,thePattern->rightHash); } if (theField->referringNode->patternType->genGetJNValueFunction) { tempExpression = (*theField->referringNode->patternType->genGetJNValueFunction)(theEnv,theField->referringNode,LHS); thePattern->leftHash = AppendExpressions(tempExpression,thePattern->leftHash); } } } /*======================================================*/ /* Attach the pattern network expressions to the field. */ /*======================================================*/ theField->networkTest = headOfPNExpression; /*=====================================================*/ /* Attach the join network expressions to the pattern. */ /*=====================================================*/ thePattern->networkTest = CombineExpressions(theEnv,thePattern->networkTest,headOfJNExpression); } /****************************************************************************/ /* ExtractAnds: Loops through a single set of subfields bound together by */ /* an & connective constraint in a field and generates expressions needed */ /* for testing conditions in the pattern and join network. */ /****************************************************************************/ static void ExtractAnds( void *theEnv, struct lhsParseNode *andField, int testInPatternNetwork, struct expr **patternNetTest, struct expr **joinNetTest, struct expr **constantSelector, struct expr **constantValue, struct nandFrame *theNandFrames) { struct expr *newPNTest, *newJNTest, *newConstantSelector, *newConstantValue; /*=================================================*/ /* Before starting, the subfield has no pattern or */ /* join network expressions associated with it. */ /*=================================================*/ *patternNetTest = NULL; *joinNetTest = NULL; *constantSelector = NULL; *constantValue = NULL; /*=========================================*/ /* Loop through each of the subfields tied */ /* together by the & constraint. */ /*=========================================*/ for (; andField != NULL; andField = andField->right) { /*======================================*/ /* Extract the pattern and join network */ /* expressions from the subfield. */ /*======================================*/ ExtractFieldTest(theEnv,andField,testInPatternNetwork,&newPNTest,&newJNTest, &newConstantSelector,&newConstantValue,theNandFrames); /*=================================================*/ /* Add the new expressions to the list of pattern */ /* and join network expressions being constructed. */ /*=================================================*/ *patternNetTest = CombineExpressions(theEnv,*patternNetTest,newPNTest); *joinNetTest = CombineExpressions(theEnv,*joinNetTest,newJNTest); *constantSelector = CombineExpressions(theEnv,*constantSelector,newConstantSelector); *constantValue = CombineExpressions(theEnv,*constantValue,newConstantValue); } } /************************************************************************/ /* ExtractFieldTest: Generates the pattern or join network expression */ /* associated with the basic field constraints: constants, predicate, */ /* return value, and variable constraints. Based on the context in */ /* which a constraint is used, some constraints may be tested in the */ /* pattern network while other constraints must be tested in the join */ /* network. Constraints which refer to variables in other patterns */ /* must be tested in the join network. The predicate constraint */ /* associated with a test CE is tested in the join network (even if */ /* all the variables it refers to are contained in the previous */ /* pattern CE). If one of the or'ed constraints in a field refers to */ /* a binding occurrence of a variable in another pattern, then the */ /* other constraints in the field must be tested in the join network */ /* (this is how some constant constraint tests must occasionally be */ /* performed in the join network). */ /************************************************************************/ static void ExtractFieldTest( void *theEnv, struct lhsParseNode *theField, int testInPatternNetwork, struct expr **patternNetTest, struct expr **joinNetTest, struct expr **constantSelector, struct expr **constantValue, struct nandFrame *theNandFrames) { *patternNetTest = NULL; *joinNetTest = NULL; *constantSelector = NULL; *constantValue = NULL; /*==========================================================*/ /* Generate a network expression for a constant constraint. */ /*==========================================================*/ if ((theField->type == STRING) || (theField->type == SYMBOL) || #if OBJECT_SYSTEM (theField->type == INSTANCE_NAME) || #endif (theField->type == FLOAT) || (theField->type == INTEGER)) { if (testInPatternNetwork == TRUE) { *patternNetTest = GenPNConstant(theEnv,theField); if (! theField->negated) { *constantSelector = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); *constantValue = GenConstant(theEnv,theField->type,theField->value); } } else { *joinNetTest = GenJNConstant(theEnv,theField,FALSE); } // TBD Remove FALSE } /*===========================================================*/ /* Generate a network expression for a predicate constraint. */ /*===========================================================*/ else if (theField->type == PREDICATE_CONSTRAINT) { if ((testInPatternNetwork == TRUE) && (AllVariablesInExpression(theField->expression,theField->pattern) == TRUE)) { *patternNetTest = GenPNColon(theEnv,theField); } else { *joinNetTest = GenJNColon(theEnv,theField,FALSE,theNandFrames); } // TBD Remove FALSE } /*==============================================================*/ /* Generate a network expression for a return value constraint. */ /*==============================================================*/ else if (theField->type == RETURN_VALUE_CONSTRAINT) { if ((testInPatternNetwork == TRUE) && (AllVariablesInExpression(theField->expression,theField->pattern) == TRUE)) { *patternNetTest = GenPNEq(theEnv,theField); } else { *joinNetTest = GenJNEq(theEnv,theField,FALSE,theNandFrames); } // TBD Remove FALSE } /*=====================================================================*/ /* Generate a network expression for a variable comparison constraint. */ /*=====================================================================*/ else if ((theField->type == SF_VARIABLE) || (theField->type == MF_VARIABLE)) { if ((testInPatternNetwork == TRUE) && ((theField->referringNode != NULL) ? (theField->referringNode->pattern == theField->pattern) : FALSE)) { *patternNetTest = GenPNVariableComparison(theEnv,theField,theField->referringNode); } else { *joinNetTest = GenJNVariableComparison(theEnv,theField,theField->referringNode,FALSE); AddNandUnification(theEnv,theField,theNandFrames); } } } /*********************************************************/ /* GenPNConstant: Generates an expression for use in the */ /* pattern network of a data entity (such as a fact or */ /* instance). The expression generated is for comparing */ /* a constant value against a specified slot/field in */ /* the data entity for equality or inequality. */ /*********************************************************/ static struct expr *GenPNConstant( void *theEnv, struct lhsParseNode *theField) { struct expr *top; /*===============================================*/ /* If the pattern parser is capable of creating */ /* a specialized test, then call the function to */ /* generate the pattern network test and return */ /* the expression generated. */ /*===============================================*/ if (theField->patternType->genPNConstantFunction != NULL) { return (*theField->patternType->genPNConstantFunction)(theEnv,theField); } /*===================================================*/ /* Otherwise, generate a test which uses the eq/neq */ /* function to compare the pattern field/slot to the */ /* constant and then return the expression. */ /*===================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value); return(top); } /************************************************************/ /* GenJNConstant: Generates an expression for use in the */ /* join network. The expression generated is for comparing */ /* a constant value against a specified slot/field in the */ /* data entity for equality or inequality. */ /************************************************************/ static struct expr *GenJNConstant( void *theEnv, struct lhsParseNode *theField, int isNand) { struct expr *top; /*===============================================*/ /* If the pattern parser is capable of creating */ /* a specialized test, then call the function to */ /* generate the join network test and return the */ /* expression generated. */ /*===============================================*/ if (theField->patternType->genJNConstantFunction != NULL) { if (isNand) { return (*theField->patternType->genJNConstantFunction)(theEnv,theField,NESTED_RHS); } else { return (*theField->patternType->genJNConstantFunction)(theEnv,theField,RHS); } } /*===================================================*/ /* Otherwise, generate a test which uses the eq/neq */ /* function to compare the pattern field/slot to the */ /* constant and then return the expression. */ /*===================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } if (isNand) { top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField,NESTED_RHS); } else { top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField,RHS); } top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value); return(top); } /******************************************************/ /* GenJNColon: Generates an expression for use in the */ /* join network. The expression generated is for a */ /* predicate field constraint (the : constraint). */ /******************************************************/ static struct expr *GenJNColon( void *theEnv, struct lhsParseNode *theField, int isNand, struct nandFrame *theNandFrames) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ if (isNand) { conversion = GetvarReplace(theEnv,theField->expression,TRUE,theNandFrames); } else { conversion = GetvarReplace(theEnv,theField->expression,FALSE,theNandFrames); } /*================================================*/ /* If the predicate constraint is negated by a ~, */ /* then wrap a "not" function call around the */ /* expression before returning it. Otherwise, */ /* just return the expression. */ /*================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT); top->argList = conversion; } else { top = conversion; } return(top); } /******************************************************/ /* GenPNColon: Generates an expression for use in the */ /* pattern network. The expression generated is for */ /* a predicate field constraint (the : constraint). */ /******************************************************/ static struct expr *GenPNColon( void *theEnv, struct lhsParseNode *theField) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ conversion = GetfieldReplace(theEnv,theField->expression); /*================================================*/ /* If the predicate constraint is negated by a ~, */ /* then wrap a "not" function call around the */ /* expression before returning it. Otherwise, */ /* just return the expression. */ /*================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT); top->argList = conversion; } else { top = conversion; } return(top); } /******************************************************/ /* GenJNEq: Generates an expression for use in the */ /* join network. The expression generated is for a */ /* return value field constraint (the = constraint). */ /******************************************************/ static struct expr *GenJNEq( void *theEnv, struct lhsParseNode *theField, int isNand, struct nandFrame *theNandFrames) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ if (isNand) { conversion = GetvarReplace(theEnv,theField->expression,TRUE,theNandFrames); } else { conversion = GetvarReplace(theEnv,theField->expression,FALSE,theNandFrames); } /*============================================================*/ /* If the return value constraint is negated by a ~, then use */ /* the neq function to compare the value of the field to the */ /* value returned by the function call. Otherwise, use eq to */ /* compare the two values. */ /*============================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } if (isNand) { top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField,NESTED_RHS); } else { top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField,RHS); } top->argList->nextArg = conversion; return(top); } /*******************************************************/ /* GenPNEq: Generates an expression for use in the */ /* pattern network. The expression generated is for a */ /* return value field constraint (the = constraint). */ /*******************************************************/ static struct expr *GenPNEq( void *theEnv, struct lhsParseNode *theField) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ conversion = GetfieldReplace(theEnv,theField->expression); /*============================================================*/ /* If the return value constraint is negated by a ~, then use */ /* the neq function to compare the value of the field to the */ /* value returned by the function call. Otherwise, use eq to */ /* compare the two values. */ /*============================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); top->argList->nextArg = conversion; return(top); } /************************************************************************/ /* AddNandUnification: Adds expressions to the nand joins to unify the */ /* variable bindings that need to match from the left and right paths */ /* taken through the join network for not/and CE group. */ /************************************************************************/ globle void AddNandUnification( void *theEnv, struct lhsParseNode *nodeList, struct nandFrame *theNandFrames) { struct nandFrame *theFrame; struct expr *tempExpression; /*====================================================*/ /* If the reference is to a prior variable within the */ /* same nand group, then there's no need to create an */ /* external network test. */ /*====================================================*/ if (nodeList->beginNandDepth == nodeList->referringNode->beginNandDepth) { return; } /*=========================================*/ /* Don't generate an external network test */ /* if one has already been generated. */ /*=========================================*/ if (nodeList->referringNode->marked) { return; } /*======================================================*/ /* Find the frame to which the test should be attached. */ /*======================================================*/ for (theFrame = theNandFrames; theFrame != NULL; theFrame = theFrame->next) { if (theFrame->depth >= nodeList->referringNode->beginNandDepth) { nodeList->referringNode->marked = TRUE; tempExpression = GenJNVariableComparison(theEnv,nodeList->referringNode,nodeList->referringNode,TRUE); theFrame->nandCE->externalNetworkTest = CombineExpressions(theEnv,theFrame->nandCE->externalNetworkTest,tempExpression); tempExpression = (*nodeList->referringNode->patternType->genGetJNValueFunction)(theEnv,nodeList->referringNode,LHS); theFrame->nandCE->externalRightHash = AppendExpressions(theFrame->nandCE->externalRightHash,tempExpression); tempExpression = (*nodeList->referringNode->patternType->genGetJNValueFunction)(theEnv,nodeList->referringNode,LHS); theFrame->nandCE->externalLeftHash = AppendExpressions(theFrame->nandCE->externalLeftHash,tempExpression); } } } /*******************************************************************/ /* GetvarReplace: Replaces occurences of variables in expressions */ /* with function calls that will extract the variable's value */ /* from a partial match (i.e. from information stored in the */ /* join network or the activation of the rule). */ /*******************************************************************/ globle struct expr *GetvarReplace( void *theEnv, struct lhsParseNode *nodeList, int isNand, struct nandFrame *theNandFrames) { struct expr *newList; /*====================================*/ /* Return NULL for a NULL pointer */ /* (i.e. nothing has to be replaced). */ /*====================================*/ if (nodeList == NULL) return(NULL); /*=====================================================*/ /* Create an expression data structure and recursively */ /* replace variables in its argument list and next */ /* argument links. */ /*=====================================================*/ newList = get_struct(theEnv,expr); newList->type = nodeList->type; newList->value = nodeList->value; newList->nextArg = GetvarReplace(theEnv,nodeList->right,isNand,theNandFrames); newList->argList = GetvarReplace(theEnv,nodeList->bottom,isNand,theNandFrames); /*=========================================================*/ /* If the present node being examined is either a local or */ /* global variable, then replace it with a function call */ /* that will return the variable's value. */ /*=========================================================*/ if ((nodeList->type == SF_VARIABLE) || (nodeList->type == MF_VARIABLE)) { AddNandUnification(theEnv,nodeList,theNandFrames); /*=============================================================*/ /* Referencing a variable outside the scope of the immediately */ /* enclosing not/and CE requires that the test be performed in */ /* the "join from the right" join. */ /*=============================================================*/ if (isNand) { if (nodeList->beginNandDepth > nodeList->referringNode->beginNandDepth) { (*nodeList->referringNode->patternType->replaceGetJNValueFunction) (theEnv,newList,nodeList->referringNode,LHS); } else { (*nodeList->referringNode->patternType->replaceGetJNValueFunction) (theEnv,newList,nodeList->referringNode,NESTED_RHS); } } else { if (nodeList->joinDepth != nodeList->referringNode->joinDepth) { (*nodeList->referringNode->patternType->replaceGetJNValueFunction) (theEnv,newList,nodeList->referringNode,LHS); } else { (*nodeList->referringNode->patternType->replaceGetJNValueFunction) (theEnv,newList,nodeList->referringNode,RHS); } } } #if DEFGLOBAL_CONSTRUCT else if (newList->type == GBL_VARIABLE) { ReplaceGlobalVariable(theEnv,newList); } #endif /*====================================================*/ /* Return the expression with its variables replaced. */ /*====================================================*/ return(newList); } /**********************************************************************/ /* GetfieldReplace: Replaces occurences of variables in expressions */ /* with function calls that will extract the variable's value */ /* given a pointer to the data entity that contains the value (i.e. */ /* from information stored in the pattern network). */ /**********************************************************************/ static struct expr *GetfieldReplace( void *theEnv, struct lhsParseNode *nodeList) { struct expr *newList; /*====================================*/ /* Return NULL for a NULL pointer */ /* (i.e. nothing has to be replaced). */ /*====================================*/ if (nodeList == NULL) return(NULL); /*=====================================================*/ /* Create an expression data structure and recursively */ /* replace variables in its argument list and next */ /* argument links. */ /*=====================================================*/ newList = get_struct(theEnv,expr); newList->type = nodeList->type; newList->value = nodeList->value; newList->nextArg = GetfieldReplace(theEnv,nodeList->right); newList->argList = GetfieldReplace(theEnv,nodeList->bottom); /*=========================================================*/ /* If the present node being examined is either a local or */ /* global variable, then replace it with a function call */ /* that will return the variable's value. */ /*=========================================================*/ if ((nodeList->type == SF_VARIABLE) || (nodeList->type == MF_VARIABLE)) { (*nodeList->referringNode->patternType->replaceGetPNValueFunction) (theEnv,newList,nodeList->referringNode); } #if DEFGLOBAL_CONSTRUCT else if (newList->type == GBL_VARIABLE) { ReplaceGlobalVariable(theEnv,newList); } #endif /*====================================================*/ /* Return the expression with its variables replaced. */ /*====================================================*/ return(newList); } /**************************************************************/ /* GenJNVariableComparison: Generates a join network test for */ /* comparing two variables found in different patterns. */ /**************************************************************/ static struct expr *GenJNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode, int isNand) { struct expr *top; /*========================================================*/ /* If either pattern is missing a function for generating */ /* the appropriate test, then no test is generated. */ /*========================================================*/ if ((selfNode->patternType->genCompareJNValuesFunction == NULL) || (referringNode->patternType->genCompareJNValuesFunction == NULL)) { return(NULL); } /*=====================================================*/ /* If both patterns are of the same type, then use the */ /* special function for generating the join test. */ /*=====================================================*/ if (selfNode->patternType->genCompareJNValuesFunction == referringNode->patternType->genCompareJNValuesFunction) { return (*selfNode->patternType->genCompareJNValuesFunction)(theEnv,selfNode, referringNode,isNand); } /*===========================================================*/ /* If the patterns are of different types, then generate a */ /* join test by using the eq/neq function with its arguments */ /* being function calls to retrieve the appropriate values */ /* from the patterns. */ /*===========================================================*/ if (selfNode->negated) top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); else top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); top->argList = (*selfNode->patternType->genGetJNValueFunction)(theEnv,selfNode,RHS); top->argList->nextArg = (*referringNode->patternType->genGetJNValueFunction)(theEnv,referringNode,LHS); return(top); } /*************************************************************/ /* GenPNVariableComparison: Generates a pattern network test */ /* for comparing two variables found in the same pattern. */ /*************************************************************/ static struct expr *GenPNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { if (selfNode->patternType->genComparePNValuesFunction != NULL) { return (*selfNode->patternType->genComparePNValuesFunction)(theEnv,selfNode,referringNode); } return(NULL); } /************************************************************/ /* AllVariablesInPattern: Determines if all of the variable */ /* references in a field constraint can be referenced */ /* within thepattern in which the field is contained. */ /************************************************************/ static int AllVariablesInPattern( struct lhsParseNode *orField, int pattern) { struct lhsParseNode *andField; /*=========================================*/ /* Loop through each of the | constraints. */ /*=========================================*/ for (; orField != NULL; orField = orField->bottom) { /*=========================================*/ /* Loop through each of the & constraints. */ /*=========================================*/ for (andField = orField; andField != NULL; andField = andField->right) { /*========================================================*/ /* If a variable is found, make sure the pattern in which */ /* the variable was previously bound is the same as the */ /* pattern being checked. */ /*========================================================*/ if ((andField->type == SF_VARIABLE) || (andField->type == MF_VARIABLE)) { if (andField->referringNode->pattern != pattern) return(FALSE); } /*========================================================*/ /* Check predicate and return value constraints to see */ /* that all variables can be referenced from the pattern. */ /*========================================================*/ else if ((andField->type == PREDICATE_CONSTRAINT) || (andField->type == RETURN_VALUE_CONSTRAINT)) { if (AllVariablesInExpression(andField->expression,pattern) == FALSE) { return(FALSE); } } } } /*=====================================*/ /* All variables in the field can be */ /* referenced from within the pattern. */ /*=====================================*/ return(TRUE); } /**************************************************************************/ /* AllVariablesInExpression: Determines if all of the variable references */ /* in an expression can be referenced within the pattern in which the */ /* expression is contained. */ /**************************************************************************/ static int AllVariablesInExpression( struct lhsParseNode *theExpression, int pattern) { /*==========================================*/ /* Check all expressions in the right link. */ /*==========================================*/ for (; theExpression != NULL; theExpression = theExpression->right) { /*========================================================*/ /* If a variable is found, make sure the pattern in which */ /* the variable is bound is the same as the pattern being */ /* checked. */ /*========================================================*/ if ((theExpression->type == SF_VARIABLE) || (theExpression->type == MF_VARIABLE)) { if (theExpression->referringNode->pattern != pattern) return(FALSE); } /*=======================================================*/ /* Recursively check all expressions in the bottom link. */ /*=======================================================*/ if (AllVariablesInExpression(theExpression->bottom,pattern) == FALSE) { return(FALSE); } } /*========================================*/ /* All variables in the expression can be */ /* referenced from within the pattern. */ /*========================================*/ return(TRUE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips_core_source_630/core/classfun.h0000755000175000017500000001307712500721260016223 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Used genstrcpy and genstrcat instead of strcpy */ /* and strcat. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_classfun #define _H_classfun #ifndef _H_object #include "object.h" #endif #define TestTraversalID(traversalRecord,id) TestBitMap(traversalRecord,id) #define SetTraversalID(traversalRecord,id) SetBitMap(traversalRecord,id) #define ClearTraversalID(traversalRecord,id) ClearBitMap(traversalRecord,id) #define CLASS_TABLE_HASH_SIZE 167 #define SLOT_NAME_TABLE_HASH_SIZE 167 #define INITIAL_OBJECT_CLASS_NAME "INITIAL-OBJECT" #define ISA_ID 0 #define NAME_ID 1 #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void IncrementDefclassBusyCount(void *,void *); LOCALE void DecrementDefclassBusyCount(void *,void *); LOCALE intBool InstancesPurge(void *theEnv); #if ! RUN_TIME LOCALE void InitializeClasses(void *); #endif LOCALE SLOT_DESC *FindClassSlot(DEFCLASS *,SYMBOL_HN *); LOCALE void ClassExistError(void *,const char *,const char *); LOCALE void DeleteClassLinks(void *,CLASS_LINK *); LOCALE void PrintClassName(void *,const char *,DEFCLASS *,intBool); #if DEBUGGING_FUNCTIONS || ((! BLOAD_ONLY) && (! RUN_TIME)) LOCALE void PrintPackedClassLinks(void *,const char *,const char *,PACKED_CLASS_LINKS *); #endif #if ! RUN_TIME LOCALE void PutClassInTable(void *,DEFCLASS *); LOCALE void RemoveClassFromTable(void *,DEFCLASS *); LOCALE void AddClassLink(void *,PACKED_CLASS_LINKS *,DEFCLASS *,int); LOCALE void DeleteSubclassLink(void *,DEFCLASS *,DEFCLASS *); LOCALE void DeleteSuperclassLink(void *,DEFCLASS *,DEFCLASS *); LOCALE DEFCLASS *NewClass(void *,SYMBOL_HN *); LOCALE void DeletePackedClassLinks(void *,PACKED_CLASS_LINKS *,int); LOCALE void AssignClassID(void *,DEFCLASS *); LOCALE SLOT_NAME *AddSlotName(void *,SYMBOL_HN *,int,int); LOCALE void DeleteSlotName(void *,SLOT_NAME *); LOCALE void RemoveDefclass(void *,void *); LOCALE void InstallClass(void *,DEFCLASS *,int); #endif LOCALE void DestroyDefclass(void *,void *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int IsClassBeingUsed(DEFCLASS *); LOCALE int RemoveAllUserClasses(void *); LOCALE int DeleteClassUAG(void *,DEFCLASS *); LOCALE void MarkBitMapSubclasses(char *,DEFCLASS *,int); #endif LOCALE short FindSlotNameID(void *,SYMBOL_HN *); LOCALE SYMBOL_HN *FindIDSlotName(void *,int); LOCALE SLOT_NAME *FindIDSlotNameHash(void *,int); LOCALE int GetTraversalID(void *); LOCALE void ReleaseTraversalID(void *); LOCALE unsigned HashClass(SYMBOL_HN *); #ifndef _CLASSFUN_SOURCE_ #if DEFRULE_CONSTRUCT extern SYMBOL_HN *INITIAL_OBJECT_SYMBOL; #endif #if DEBUGGING_FUNCTIONS extern unsigned WatchInstances,WatchSlots; #endif #endif #define DEFCLASS_DATA 21 #define PRIMITIVE_CLASSES 9 struct defclassData { struct construct *DefclassConstruct; int DefclassModuleIndex; ENTITY_RECORD DefclassEntityRecord; DEFCLASS *PrimitiveClassMap[PRIMITIVE_CLASSES]; DEFCLASS **ClassIDMap; DEFCLASS **ClassTable; unsigned short MaxClassID; unsigned short AvailClassID; SLOT_NAME **SlotNameTable; SYMBOL_HN *ISA_SYMBOL; SYMBOL_HN *NAME_SYMBOL; #if DEFRULE_CONSTRUCT SYMBOL_HN *INITIAL_OBJECT_SYMBOL; #endif #if DEBUGGING_FUNCTIONS unsigned WatchInstances; unsigned WatchSlots; #endif unsigned short CTID; struct token ObjectParseToken; unsigned short ClassDefaultsMode; }; #define DefclassData(theEnv) ((struct defclassData *) GetEnvironmentData(theEnv,DEFCLASS_DATA)) #endif clips_core_source_630/core/._factqury.h0000644000175000017500000000040712373743674016473 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dfinscmp.c0000755000175000017500000000040712373731172016424 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._textpro.c0000755000175000017500000000040712461762345016332 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxexe.h0000755000175000017500000000420712373731201016213 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_dffnxexe #define _H_dffnxexe #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXEXE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void CallDeffunction(void *,DEFFUNCTION *,EXPRESSION *,DATA_OBJECT *); #endif /* DEFFUNCTION_CONSTRUCT */ #endif /* _H_dffnxexe */ clips_core_source_630/core/factrhs.c0000755000175000017500000005346612464742046016056 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* FACT RHS PATTERN PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a number of routines for parsing fact */ /* patterns typically found on the RHS of a rule (such as */ /* the assert command). Also contains some functions for */ /* parsing RHS slot values (used by functions such as */ /* assert, modify, and duplicate). */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Chris Culbert */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ #define _FACTRHS_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include "constant.h" #include "envrnmnt.h" #include "extnfunc.h" #include "modulutl.h" #include "modulpsr.h" #include "pattern.h" #include "prntutil.h" #include "cstrcpsr.h" #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "bload.h" #endif #include "tmpltpsr.h" #include "tmpltrhs.h" #include "tmpltutl.h" #include "exprnpsr.h" #include "strngrtr.h" #include "router.h" #include "factrhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE static void NoSuchTemplateError(void *,const char *); #endif #if (! RUN_TIME) /**********************************************************************/ /* BuildRHSAssert: Parses zero or more RHS fact patterns (the format */ /* which is used by the assert command and the deffacts construct). */ /* Each of the RHS patterns is attached to an assert command and if */ /* there is more than one assert command, then a progn command is */ /* wrapped around all of the assert commands. */ /**********************************************************************/ globle struct expr *BuildRHSAssert( void *theEnv, const char *logicalName, struct token *theToken, int *error, int atLeastOne, int readFirstParen, const char *whereParsed) { struct expr *lastOne, *nextOne, *assertList, *stub; *error = FALSE; /*===============================================================*/ /* If the first parenthesis of the RHS fact pattern has not been */ /* read yet, then get the next token. If a right parenthesis is */ /* encountered then exit (however, set the error return value if */ /* at least one fact was expected). */ /*===============================================================*/ if (readFirstParen == FALSE) { if (theToken->type == RPAREN) { if (atLeastOne) { *error = TRUE; SyntaxErrorMessage(theEnv,whereParsed); } return(NULL); } } /*================================================*/ /* Parse the facts until no more are encountered. */ /*================================================*/ lastOne = assertList = NULL; while ((nextOne = GetRHSPattern(theEnv,logicalName,theToken, error,FALSE,readFirstParen, TRUE,RPAREN)) != NULL) { PPCRAndIndent(theEnv); stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"assert")); stub->argList = nextOne; nextOne = stub; if (lastOne == NULL) { assertList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; readFirstParen = TRUE; } /*======================================================*/ /* If an error was detected while parsing, then return. */ /*======================================================*/ if (*error) { ReturnExpression(theEnv,assertList); return(NULL); } /*======================================*/ /* Fix the pretty print representation. */ /*======================================*/ if (theToken->type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } /*==============================================================*/ /* If no facts are being asserted then return NULL. In addition */ /* if at least one fact was required, then signal an error. */ /*==============================================================*/ if (assertList == NULL) { if (atLeastOne) { *error = TRUE; SyntaxErrorMessage(theEnv,whereParsed); } return(NULL); } /*===============================================*/ /* If more than one fact is being asserted, then */ /* wrap the assert commands within a progn call. */ /*===============================================*/ if (assertList->nextArg != NULL) { stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"progn")); stub->argList = assertList; assertList = stub; } /*==========================================================*/ /* Return the expression for asserting the specified facts. */ /*==========================================================*/ return(assertList); } #endif /***************************************************************/ /* GetRHSPattern: Parses a single RHS fact pattern. The return */ /* value is the fact just parsed (or NULL if the delimiter */ /* for no more facts is the first token parsed). If an error */ /* occurs, then the error flag passed as an argument is set. */ /***************************************************************/ globle struct expr *GetRHSPattern( void *theEnv, const char *readSource, struct token *tempToken, int *error, int constantsOnly, int readFirstParen, int checkFirstParen, int endType) { struct expr *lastOne = NULL; struct expr *nextOne, *firstOne, *argHead = NULL; int printError, count; struct deftemplate *theDeftemplate; struct symbolHashNode *templateName; const char *nullBitMap = "\0"; /*=================================================*/ /* Get the opening parenthesis of the RHS pattern. */ /*=================================================*/ *error = FALSE; if (readFirstParen) GetToken(theEnv,readSource,tempToken); if (checkFirstParen) { if (tempToken->type == endType) return(NULL); if (tempToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"RHS patterns"); *error = TRUE; return(NULL); } } /*======================================================*/ /* The first field of an asserted fact must be a symbol */ /* (but not = or : which have special significance). */ /*======================================================*/ GetToken(theEnv,readSource,tempToken); if (tempToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"first field of a RHS pattern"); *error = TRUE; return(NULL); } else if ((strcmp(ValueToString(tempToken->value),"=") == 0) || (strcmp(ValueToString(tempToken->value),":") == 0)) { SyntaxErrorMessage(theEnv,"first field of a RHS pattern"); *error = TRUE; return(NULL); } /*=========================================================*/ /* Check to see if the relation name is a reserved symbol. */ /*=========================================================*/ templateName = (struct symbolHashNode *) tempToken->value; if (ReservedPatternSymbol(theEnv,ValueToString(templateName),NULL)) { ReservedPatternSymbolErrorMsg(theEnv,ValueToString(templateName),"a relation name"); *error = TRUE; return(NULL); } /*============================================================*/ /* A module separator in the name is illegal in this context. */ /*============================================================*/ if (FindModuleSeparator(ValueToString(templateName))) { IllegalModuleSpecifierMessage(theEnv); *error = TRUE; return(NULL); } /*=============================================================*/ /* Determine if there is an associated deftemplate. If so, let */ /* the deftemplate parsing functions parse the RHS pattern and */ /* then return the fact pattern that was parsed. */ /*=============================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(templateName), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(templateName)); *error = TRUE; return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) #if (! BLOAD_ONLY) && (! RUN_TIME) { #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { NoSuchTemplateError(theEnv,ValueToString(templateName)); *error = TRUE; return(NULL); } #endif #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(templateName))) { ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(templateName),NULL,NULL); *error = TRUE; return(NULL); } #endif if (! ConstructData(theEnv)->CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) templateName,TRUE); } } #else { NoSuchTemplateError(theEnv,ValueToString(templateName)); *error = TRUE; return(NULL); } #endif /*=========================================*/ /* If an explicit deftemplate exists, then */ /* parse the fact as a deftemplate fact. */ /*=========================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate); firstOne->nextArg = ParseAssertTemplate(theEnv,readSource,tempToken, error,endType, constantsOnly,theDeftemplate); #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif if (*error) { ReturnExpression(theEnv,firstOne); firstOne = NULL; } return(firstOne); } /*========================================*/ /* Parse the fact as an ordered RHS fact. */ /*========================================*/ firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate); #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(theEnv," "); #endif while ((nextOne = GetAssertArgument(theEnv,readSource,tempToken, error,endType,constantsOnly,&printError)) != NULL) { if (argHead == NULL) argHead = nextOne; else lastOne->nextArg = nextOne; lastOne = nextOne; #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(theEnv," "); #endif } /*===========================================================*/ /* If an error occurred, set the error flag and return NULL. */ /*===========================================================*/ if (*error) { if (printError) SyntaxErrorMessage(theEnv,"RHS patterns"); ReturnExpression(theEnv,firstOne); ReturnExpression(theEnv,argHead); return(NULL); } /*=====================================*/ /* Fix the pretty print representation */ /* of the RHS ordered fact. */ /*=====================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tempToken->printForm); #endif /*==========================================================*/ /* Ordered fact assertions are processed by stuffing all of */ /* the fact's proposition (except the relation name) into a */ /* single multifield slot. */ /*==========================================================*/ firstOne->nextArg = GenConstant(theEnv,FACT_STORE_MULTIFIELD,EnvAddBitMap(theEnv,(void *) nullBitMap,1)); firstOne->nextArg->argList = argHead; /*==============================*/ /* Return the RHS ordered fact. */ /*==============================*/ return(firstOne); } /********************************************************************/ /* GetAssertArgument: Parses a single RHS slot value and returns an */ /* expression representing the value. When parsing a deftemplate */ /* slot, the slot name has already been parsed when this function */ /* is called. NULL is returned if a slot or fact delimiter is */ /* encountered. In the event of a parse error, the error flag */ /* passed as an argument is set. */ /********************************************************************/ globle struct expr *GetAssertArgument( void *theEnv, const char *logicalName, struct token *theToken, int *error, int endType, int constantsOnly, int *printError) { #if ! RUN_TIME struct expr *nextField; #else struct expr *nextField = NULL; #endif /*=================================================*/ /* Read in the first token of the slot's value. If */ /* the end delimiter is encountered, then return. */ /*=================================================*/ *printError = TRUE; GetToken(theEnv,logicalName,theToken); if (theToken->type == endType) return(NULL); /*=============================================================*/ /* If an equal sign of left parenthesis was parsed, then parse */ /* a function which is to be evaluated to determine the slot's */ /* value. The equal sign corresponds to the return value */ /* constraint which can be used in LHS fact patterns. The */ /* equal sign is no longer necessary on either the LHS or RHS */ /* of a rule to indicate that a function is being evaluated to */ /* determine its value either for assignment or pattern */ /* matching. */ /*=============================================================*/ if ((theToken->type == SYMBOL) ? (strcmp(ValueToString(theToken->value),"=") == 0) : (theToken->type == LPAREN)) { if (constantsOnly) { *error = TRUE; return(NULL); } #if ! RUN_TIME if (theToken->type == LPAREN) nextField = Function1Parse(theEnv,logicalName); else nextField = Function0Parse(theEnv,logicalName); if (nextField == NULL) #endif { *printError = FALSE; *error = TRUE; } #if ! RUN_TIME else { theToken->type= RPAREN; theToken->value = (void *) EnvAddSymbol(theEnv,")"); theToken->printForm = ")"; } #endif return(nextField); } /*==================================================*/ /* Constants are always allowed as RHS slot values. */ /*==================================================*/ if ((theToken->type == SYMBOL) || (theToken->type == STRING) || #if OBJECT_SYSTEM (theToken->type == INSTANCE_NAME) || #endif (theToken->type == FLOAT) || (theToken->type == INTEGER)) { return(GenConstant(theEnv,theToken->type,theToken->value)); } /*========================================*/ /* Variables are also allowed as RHS slot */ /* values under some circumstances. */ /*========================================*/ if ((theToken->type == SF_VARIABLE) || #if DEFGLOBAL_CONSTRUCT (theToken->type == GBL_VARIABLE) || (theToken->type == MF_GBL_VARIABLE) || #endif (theToken->type == MF_VARIABLE)) { if (constantsOnly) { *error = TRUE; return(NULL); } return(GenConstant(theEnv,theToken->type,theToken->value)); } /*==========================================================*/ /* If none of the other cases have been satisfied, then the */ /* token parsed is not appropriate for a RHS slot value. */ /*==========================================================*/ *error = TRUE; return(NULL); } /****************************************************/ /* StringToFact: Converts the string representation */ /* of a fact to a fact data structure. */ /****************************************************/ globle struct fact *StringToFact( void *theEnv, const char *str) { struct token theToken; struct fact *factPtr; unsigned numberOfFields = 0, whichField; struct expr *assertArgs, *tempPtr; int error = FALSE; DATA_OBJECT theResult; /*=========================================*/ /* Open a string router and parse the fact */ /* using the router as an input source. */ /*=========================================*/ SetEvaluationError(theEnv,FALSE); OpenStringSource(theEnv,"assert_str",str,0); assertArgs = GetRHSPattern(theEnv,"assert_str",&theToken, &error,FALSE,TRUE, TRUE,RPAREN); CloseStringSource(theEnv,"assert_str"); /*===========================================*/ /* Check for errors or the use of variables. */ /*===========================================*/ if ((assertArgs == NULL) && (! error)) { SyntaxErrorMessage(theEnv,"RHS patterns"); ReturnExpression(theEnv,assertArgs); return(NULL); } if (error) { ReturnExpression(theEnv,assertArgs); return(NULL); } if (ExpressionContainsVariables(assertArgs,FALSE)) { LocalVariableErrorMessage(theEnv,"the assert-string function"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,assertArgs); return(NULL); } /*=======================================================*/ /* Count the number of fields needed for the fact and */ /* create a fact data structure of the appropriate size. */ /*=======================================================*/ for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { numberOfFields++; } factPtr = (struct fact *) CreateFactBySize(theEnv,numberOfFields); factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value; /*=============================================*/ /* Copy the fields to the fact data structure. */ /*=============================================*/ EnvIncrementClearReadyLocks(theEnv); ExpressionInstall(theEnv,assertArgs); /* DR0836 */ whichField = 0; for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { EvaluateExpression(theEnv,tempPtr,&theResult); factPtr->theProposition.theFields[whichField].type = theResult.type; factPtr->theProposition.theFields[whichField].value = theResult.value; whichField++; } ExpressionDeinstall(theEnv,assertArgs); /* DR0836 */ ReturnExpression(theEnv,assertArgs); EnvDecrementClearReadyLocks(theEnv); /*==================*/ /* Return the fact. */ /*==================*/ return(factPtr); } #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE /*********************************************************/ /* NoSuchTemplateError: Prints out an error message */ /* in a BLOAD_ONLY, RUN_TIME or bload active environment */ /* when an implied deftemplate cannot be created for */ /* an assert */ /*********************************************************/ static void NoSuchTemplateError( void *theEnv, const char *templateName) { PrintErrorID(theEnv,"FACTRHS",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Template "); EnvPrintRouter(theEnv,WERROR,templateName); EnvPrintRouter(theEnv,WERROR," does not exist for assert.\n"); } #endif /* RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/._classcom.c0000755000175000017500000000040712464554105016425 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltcmp.h0000755000175000017500000000536412373754231016261 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for deftemplate slot facets. */ /* */ /* Added code for deftemplate run time */ /* initialization of hashed comparisons to */ /* constants. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_tmpltcmp #define _H_tmpltcmp #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeftemplateCompilerSetup(void *); LOCALE void DeftemplateCModuleReference(void *,FILE *,int,int,int); LOCALE void DeftemplateCConstructReference(void *,FILE *,void *,int,int); #endif /* _H_tmpltcmp */ clips_core_source_630/core/msgpsr.h0000755000175000017500000000565412374017646015741 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* 6.30: Renamed BOOLEAN macro type to intBool. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Changed integer type/precision. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_AND_SAVE */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #ifndef _H_msgpsr #define _H_msgpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #define SELF_STRING "self" #ifndef _H_object #include "object.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDefmessageHandler(void *,const char *); LOCALE void CreateGetAndPutHandlers(void *,SLOT_DESC *); #endif /* OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) */ #endif /* _H_msgpsr */ clips_core_source_630/core/._evaluatn.c0000755000175000017500000000040712464554105016440 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulepsr.h0000755000175000017500000000040712374023477016325 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffnxcmp.c0000755000175000017500000000040712373721244016425 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._prntutil.h0000755000175000017500000000040712424473401016502 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlcom.c0000755000175000017500000002373212373753366016221 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the show-defglobals, set-reset-globals, */ /* and get-reset-globals commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _GLOBLCOM_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include "extnfunc.h" #include "argacces.h" #include "prntutil.h" #include "router.h" #include "envrnmnt.h" #include "globldef.h" #include "globlcom.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEBUGGING_FUNCTIONS static void PrintDefglobalValueForm(void *,const char *,void *); #endif /************************************************************/ /* DefglobalCommandDefinitions: Defines defglobal commands. */ /************************************************************/ globle void DefglobalCommandDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"set-reset-globals",'b', SetResetGlobalsCommand,"SetResetGlobalsCommand", "11"); EnvDefineFunction2(theEnv,"get-reset-globals",'b', GetResetGlobalsCommand,"GetResetGlobalsCommand", "00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"show-defglobals",'v', PTIEF ShowDefglobalsCommand,"ShowDefglobalsCommand", "01w"); #endif #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /************************************************/ /* SetResetGlobalsCommand: H/L access routine */ /* for the get-reset-globals command. */ /************************************************/ globle int SetResetGlobalsCommand( void *theEnv) { int oldValue; DATA_OBJECT arg_ptr; /*===========================================*/ /* Remember the old value of this attribute. */ /*===========================================*/ oldValue = EnvGetResetGlobals(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-reset-globals",EXACTLY,1) == -1) { return(oldValue); } /*===========================================*/ /* Determine the new value of the attribute. */ /*===========================================*/ EnvRtnUnknown(theEnv,1,&arg_ptr); if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL)) { EnvSetResetGlobals(theEnv,FALSE); } else { EnvSetResetGlobals(theEnv,TRUE); } /*========================================*/ /* Return the old value of the attribute. */ /*========================================*/ return(oldValue); } /****************************************/ /* EnvSetResetGlobals: C access routine */ /* for the set-reset-globals command. */ /****************************************/ globle intBool EnvSetResetGlobals( void *theEnv, int value) { int ov; ov = DefglobalData(theEnv)->ResetGlobals; DefglobalData(theEnv)->ResetGlobals = value; return(ov); } /************************************************/ /* GetResetGlobalsCommand: H/L access routine */ /* for the get-reset-globals command. */ /************************************************/ globle int GetResetGlobalsCommand( void *theEnv) { int oldValue; oldValue = EnvGetResetGlobals(theEnv); if (EnvArgCountCheck(theEnv,"get-reset-globals",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /****************************************/ /* EnvGetResetGlobals: C access routine */ /* for the get-reset-globals command. */ /****************************************/ globle intBool EnvGetResetGlobals( void *theEnv) { return(DefglobalData(theEnv)->ResetGlobals); } #if DEBUGGING_FUNCTIONS /***********************************************/ /* ShowDefglobalsCommand: H/L access routine */ /* for the show-defglobals command. */ /***********************************************/ globle void ShowDefglobalsCommand( void *theEnv) { struct defmodule *theModule; int numArgs, error; if ((numArgs = EnvArgCountCheck(theEnv,"show-defglobals",NO_MORE_THAN,1)) == -1) return; if (numArgs == 1) { theModule = GetModuleName(theEnv,"show-defglobals",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } EnvShowDefglobals(theEnv,WDISPLAY,theModule); } /***************************************/ /* EnvShowDefglobals: C access routine */ /* for the show-defglobals command. */ /***************************************/ globle void EnvShowDefglobals( void *theEnv, const char *logicalName, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; struct constructHeader *constructPtr; int allModules = FALSE; struct defmoduleItemHeader *theModuleItem; /*=======================================*/ /* If the module specified is NULL, then */ /* list all constructs in all modules. */ /*=======================================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } /*======================================================*/ /* Print out the constructs in the specified module(s). */ /*======================================================*/ for (; theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*===========================================*/ /* Print the module name before every group */ /* of defglobals listed if we're listing the */ /* defglobals from every module. */ /*===========================================*/ if (allModules) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); } /*=====================================*/ /* Print every defglobal in the module */ /* currently being examined. */ /*=====================================*/ theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex); for (constructPtr = theModuleItem->firstItem; constructPtr != NULL; constructPtr = constructPtr->next) { if (EvaluationData(theEnv)->HaltExecution == TRUE) return; if (allModules) EnvPrintRouter(theEnv,logicalName," "); PrintDefglobalValueForm(theEnv,logicalName,(void *) constructPtr); EnvPrintRouter(theEnv,logicalName,"\n"); } /*===================================*/ /* If we're only listing the globals */ /* for one module, then return. */ /*===================================*/ if (! allModules) return; } } /*****************************************************/ /* PrintDefglobalValueForm: Prints the value form of */ /* a defglobal (the current value). For example, */ /* ?*x* = 3 */ /*****************************************************/ static void PrintDefglobalValueForm( void *theEnv, const char *logicalName, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; EnvPrintRouter(theEnv,logicalName,"?*"); EnvPrintRouter(theEnv,logicalName,ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,logicalName,"* = "); PrintDataObject(theEnv,logicalName,&theGlobal->current); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool GetResetGlobals() { return EnvGetResetGlobals(GetCurrentEnvironment()); } globle intBool SetResetGlobals( int value) { return EnvSetResetGlobals(GetCurrentEnvironment(),value); } #if DEBUGGING_FUNCTIONS globle void ShowDefglobals( const char *logicalName, void *vTheModule) { EnvShowDefglobals(GetCurrentEnvironment(),logicalName,vTheModule); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFGLOBAL_CONSTRUCT */ clips_core_source_630/core/._default.c0000755000175000017500000000040712373721033016240 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factqury.c0000644000175000017500000012544012500141166016232 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Query Functions for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Added fact-set queries. */ /* */ /* 6.24: Corrected errors when compiling as a C++ file. */ /* DR0868 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Fixes for run-time use of query functions. */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if FACT_SET_QUERIES #include "argacces.h" #include "envrnmnt.h" #include "memalloc.h" #include "exprnpsr.h" #include "modulutl.h" #include "tmpltutl.h" #include "insfun.h" #include "factqpsr.h" #include "prcdrfun.h" #include "router.h" #include "utility.h" #define _FACTQURY_SOURCE_ #include "factqury.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PushQueryCore(void *); static void PopQueryCore(void *); static QUERY_CORE *FindQueryCore(void *,int); static QUERY_TEMPLATE *DetermineQueryTemplates(void *,EXPRESSION *,const char *,unsigned *); static QUERY_TEMPLATE *FormChain(void *,const char *,DATA_OBJECT *); static void DeleteQueryTemplates(void *,QUERY_TEMPLATE *); static int TestForFirstInChain(void *,QUERY_TEMPLATE *,int); static int TestForFirstFactInTemplate(void *,struct deftemplate *,QUERY_TEMPLATE *,int); static void TestEntireChain(void *,QUERY_TEMPLATE *,int); static void TestEntireTemplate(void *,struct deftemplate *,QUERY_TEMPLATE *,int); static void AddSolution(void *); static void PopQuerySoln(void *); /**************************************************** NAME : SetupFactQuery DESCRIPTION : Initializes fact query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupFactQuery( void *theEnv) { AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL); #if RUN_TIME FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING); #endif #if ! RUN_TIME FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING); IncrementSymbolCount(FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); EnvDefineFunction2(theEnv,"(query-fact)",'u', PTIEF GetQueryFact,"GetQueryFact",NULL); EnvDefineFunction2(theEnv,"(query-fact-slot)",'u', PTIEF GetQueryFactSlot,"GetQueryFactSlot",NULL); EnvDefineFunction2(theEnv,"any-factp",'b',PTIEF AnyFacts,"AnyFacts",NULL); AddFunctionParser(theEnv,"any-factp",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"find-fact",'m', PTIEF QueryFindFact,"QueryFindFact",NULL); AddFunctionParser(theEnv,"find-fact",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"find-all-facts",'m', PTIEF QueryFindAllFacts,"QueryFindAllFacts",NULL); AddFunctionParser(theEnv,"find-all-facts",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"do-for-fact",'u', PTIEF QueryDoForFact,"QueryDoForFact",NULL); AddFunctionParser(theEnv,"do-for-fact",FactParseQueryAction); EnvDefineFunction2(theEnv,"do-for-all-facts",'u', PTIEF QueryDoForAllFacts,"QueryDoForAllFacts",NULL); AddFunctionParser(theEnv,"do-for-all-facts",FactParseQueryAction); EnvDefineFunction2(theEnv,"delayed-do-for-all-facts",'u', PTIEF DelayedQueryDoForAllFacts, "DelayedQueryDoForAllFacts",NULL); AddFunctionParser(theEnv,"delayed-do-for-all-facts",FactParseQueryAction); #endif } /************************************************************* NAME : GetQueryFact DESCRIPTION : Internal function for referring to fact array on fact-queries INPUTS : None RETURNS : The name of the specified fact-set member SIDE EFFECTS : None NOTES : H/L Syntax : ((query-fact) ) *************************************************************/ globle void GetQueryFact( void *theEnv, DATA_OBJECT *result) { register QUERY_CORE *core; core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument()))); result->type = FACT_ADDRESS; result->value = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))]; } /*************************************************************************** NAME : GetQueryFactSlot DESCRIPTION : Internal function for referring to slots of fact in fact array on fact-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-fact-slot) ) **************************************************************************/ globle void GetQueryFactSlot( void *theEnv, DATA_OBJECT *result) { struct fact *theFact; DATA_OBJECT temp; QUERY_CORE *core; short position; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument()))); theFact = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))]; EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theFact->whichDeftemplate->implied) { if (strcmp(ValueToString(temp.value),"implied") != 0) { SlotExistError(theEnv,ValueToString(temp.value),"fact-set query"); return; } position = 1; } else if (FindSlot((struct deftemplate *) theFact->whichDeftemplate, (struct symbolHashNode *) temp.value,&position) == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"fact-set query"); return; } result->type = theFact->theProposition.theFields[position-1].type; result->value = theFact->theProposition.theFields[position-1].value; if (result->type == MULTIFIELD) { SetpDOBegin(result,1); SetpDOEnd(result,((struct multifield *) result->value)->multifieldLength); } } /* ============================================================================= ============================================================================= Following are the instance query functions : any-factp : Determines if any facts satisfy the query find-fact : Finds first (set of) fact(s) which satisfies the query and stores it in a multi-field find-all-facts : Finds all (sets of) facts which satisfy the the query and stores them in a multi-field do-for-fact : Executes a given action for the first (set of) fact(s) which satisfy the query do-for-all-facts : Executes an action for all facts which satisfy the query as they are found delayed-do-for-all-facts : Same as above - except that the list of facts which satisfy the query is formed before any actions are executed Fact candidate search algorithm : All permutations of first restriction template facts with other restriction template facts (Rightmost are varied first) For any one template, fact are examined in the order they were defined Example : (deftemplate a (slot v)) (deftemplate b (slot v)) (deftemplate c (slot v)) (assert (a (v a1))) (assert (a (v a2))) (assert (b (v b1))) (assert (b (v b2))) (assert (c (v c1))) (assert (c (v c2))) (assert (d (v d1))) (assert (d (v d2))) (any-factp ((?a a b) (?b c)) ) The permutations (?a ?b) would be examined in the following order : (a1 c1),(a1 c2),(a2 c1),(a2 c2), (b1 c1),(b1 c2),(b2 c1),(b2 c2) ============================================================================= ============================================================================= */ /****************************************************************************** NAME : AnyFacts DESCRIPTION : Determines if there any existing facts which satisfy the query INPUTS : None RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaluates to TRUE - if at all). NOTES : H/L Syntax : See FactParseQueryNoAction() ******************************************************************************/ globle intBool AnyFacts( void *theEnv) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; int TestResult; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "any-factp",&rcnt); if (qtemplates == NULL) return(FALSE); PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); TestResult = TestForFirstInChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); return(TestResult); } /****************************************************************************** NAME : QueryFindFact DESCRIPTION : Finds the first set of facts which satisfy the query and stores their addresses in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindFact( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt,i; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "find-fact",&rcnt); if (qtemplates == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE) { result->value = (void *) EnvCreateMultifield(theEnv,rcnt); SetpDOEnd(result,rcnt); for (i = 1 ; i <= rcnt ; i++) { SetMFType(result->value,i,FACT_ADDRESS); SetMFValue(result->value,i,FactQueryData(theEnv)->QueryCore->solns[i - 1]); } } else result->value = (void *) EnvCreateMultifield(theEnv,0L); FactQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : QueryFindAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; register unsigned i,j; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "find-all-facts",&rcnt); if (qtemplates == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = NULL; FactQueryData(theEnv)->QueryCore->soln_set = NULL; FactQueryData(theEnv)->QueryCore->soln_size = rcnt; FactQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; result->value = (void *) EnvCreateMultifield(theEnv,FactQueryData(theEnv)->QueryCore->soln_cnt * rcnt); while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++) { SetMFType(result->value,j,FACT_ADDRESS); SetMFValue(result->value,j,FactQueryData(theEnv)->QueryCore->soln_set->soln[i]); } result->end = (long) j-2; PopQuerySoln(theEnv); } rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : QueryDoForFact DESCRIPTION : Finds the first set of facts which satisfy the query and executes a user-action with that set INPUTS : None RETURNS : Caller's result buffer SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaulates to TRUE - if at all). Also the action expression is executed zero or once. Caller's result buffer holds result of user-action NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ globle void QueryDoForFact( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-fact",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE) EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result); FactQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : QueryDoForAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and executes a user-function for each set as it is found INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. Also, the action is executed for every fact set. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See FactParseQueryAction() ******************************************************************************/ globle void QueryDoForAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-all-facts",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; FactQueryData(theEnv)->QueryCore->result = result; ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result); TestEntireChain(theEnv,qtemplates,0); ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result); FactQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : DelayedQueryDoForAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and and exceutes a user-action for each set This function differs from QueryDoForAllFacts() in that it forms the complete list of query satisfactions BEFORE executing any actions. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. The action is executed for evry query satisfaction. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See FactParseQueryNoAction() ******************************************************************************/ globle void DelayedQueryDoForAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; register unsigned i; struct garbageFrame newGarbageFrame, *oldGarbageFrame; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "delayed-do-for-all-facts",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = NULL; FactQueryData(theEnv)->QueryCore->soln_set = NULL; FactQueryData(theEnv)->QueryCore->soln_size = rcnt; FactQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 ; i < rcnt ; i++) FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i]; PopQuerySoln(theEnv); EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) PopQuerySoln(theEnv); break; } CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : PushQueryCore DESCRIPTION : Pushes the current QueryCore onto stack INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Allocates new stack node and changes QueryCoreStack NOTES : None *******************************************************/ static void PushQueryCore( void *theEnv) { QUERY_STACK *qptr; qptr = get_struct(theEnv,query_stack); qptr->core = FactQueryData(theEnv)->QueryCore; qptr->nxt = FactQueryData(theEnv)->QueryCoreStack; FactQueryData(theEnv)->QueryCoreStack = qptr; } /****************************************************** NAME : PopQueryCore DESCRIPTION : Pops top of QueryCore stack and restores QueryCore to this core INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack node deallocated, QueryCoreStack changed and QueryCore reset NOTES : Assumes stack is not empty ******************************************************/ static void PopQueryCore( void *theEnv) { QUERY_STACK *qptr; FactQueryData(theEnv)->QueryCore = FactQueryData(theEnv)->QueryCoreStack->core; qptr = FactQueryData(theEnv)->QueryCoreStack; FactQueryData(theEnv)->QueryCoreStack = FactQueryData(theEnv)->QueryCoreStack->nxt; rtn_struct(theEnv,query_stack,qptr); } /*************************************************** NAME : FindQueryCore DESCRIPTION : Looks up a QueryCore Stack Frame Depth 0 is current frame 1 is next deepest, etc. INPUTS : Depth RETURNS : Address of query core stack frame SIDE EFFECTS : None NOTES : None ***************************************************/ static QUERY_CORE *FindQueryCore( void *theEnv, int depth) { QUERY_STACK *qptr; if (depth == 0) return(FactQueryData(theEnv)->QueryCore); qptr = FactQueryData(theEnv)->QueryCoreStack; while (depth > 1) { qptr = qptr->nxt; depth--; } return(qptr->core); } /********************************************************** NAME : DetermineQueryTemplates DESCRIPTION : Builds a list of templates to be used in fact queries - uses parse form. INPUTS : 1) The parse template expression chain 2) The name of the function being executed 3) Caller's buffer for restriction count (# of separate lists) RETURNS : The query list, or NULL on errors SIDE EFFECTS : Memory allocated for list Busy count incremented for all templates NOTES : Each restriction is linked by nxt pointer, multiple templates in a restriction are linked by the chain pointer. Rcnt caller's buffer is set to reflect the total number of chains Assumes classExp is not NULL and that each restriction chain is terminated with the QUERY_DELIMITER_SYMBOL "(QDS)" **********************************************************/ static QUERY_TEMPLATE *DetermineQueryTemplates( void *theEnv, EXPRESSION *templateExp, const char *func, unsigned *rcnt) { QUERY_TEMPLATE *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp; int new_list = FALSE; DATA_OBJECT temp; *rcnt = 0; while (templateExp != NULL) { if (EvaluateExpression(theEnv,templateExp,&temp)) { DeleteQueryTemplates(theEnv,clist); return(NULL); } if ((temp.type == SYMBOL) && (temp.value == (void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL)) { new_list = TRUE; (*rcnt)++; } else if ((tmp = FormChain(theEnv,func,&temp)) != NULL) { if (clist == NULL) clist = cnxt = cchain = tmp; else if (new_list == TRUE) { new_list = FALSE; cnxt->nxt = tmp; cnxt = cchain = tmp; } else cchain->chain = tmp; while (cchain->chain != NULL) cchain = cchain->chain; } else { SyntaxErrorMessage(theEnv,"fact-set query class restrictions"); DeleteQueryTemplates(theEnv,clist); SetEvaluationError(theEnv,TRUE); return(NULL); } templateExp = templateExp->nextArg; } return(clist); } /************************************************************* NAME : FormChain DESCRIPTION : Builds a list of classes to be used in fact queries - uses parse form. INPUTS : 1) Name of calling function for error msgs 2) Data object - must be a symbol or a multifield value containing all symbols The symbols must be names of existing templates RETURNS : The query chain, or NULL on errors SIDE EFFECTS : Memory allocated for chain Busy count incremented for all templates NOTES : None *************************************************************/ static QUERY_TEMPLATE *FormChain( void *theEnv, const char *func, DATA_OBJECT *val) { struct deftemplate *templatePtr; QUERY_TEMPLATE *head,*bot,*tmp; register long i,end; /* 6.04 Bug Fix */ const char *templateName; int count; if (val->type == DEFTEMPLATE_PTR) { IncrementDeftemplateBusyCount(theEnv,(void *) val->value); head = get_struct(theEnv,query_template); head->templatePtr = (struct deftemplate *) val->value; head->chain = NULL; head->nxt = NULL; return(head); } if (val->type == SYMBOL) { /* =============================================== Allow instance-set query restrictions to have a module specifier as part of the class name, but search imported defclasses too if a module specifier is not given =============================================== */ templatePtr = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,DOPToString(val), &count,TRUE,NULL); if (templatePtr == NULL) { CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",DOPToString(val),func); return(NULL); } IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr); head = get_struct(theEnv,query_template); head->templatePtr = templatePtr; head->chain = NULL; head->nxt = NULL; return(head); } if (val->type == MULTIFIELD) { head = bot = NULL; end = GetpDOEnd(val); for (i = GetpDOBegin(val) ; i <= end ; i++) { if (GetMFType(val->value,i) == SYMBOL) { templateName = ValueToString(GetMFValue(val->value,i)); templatePtr = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,templateName, &count,TRUE,NULL); if (templatePtr == NULL) { CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",templateName,func); DeleteQueryTemplates(theEnv,head); return(NULL); } } else { DeleteQueryTemplates(theEnv,head); return(NULL); } IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr); tmp = get_struct(theEnv,query_template); tmp->templatePtr = templatePtr; tmp->chain = NULL; tmp->nxt = NULL; if (head == NULL) head = tmp; else bot->chain = tmp; bot = tmp; } return(head); } return(NULL); } /****************************************************** NAME : DeleteQueryTemplates DESCRIPTION : Deletes a query class-list INPUTS : The query list address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated Busy count decremented for all templates NOTES : None ******************************************************/ static void DeleteQueryTemplates( void *theEnv, QUERY_TEMPLATE *qlist) { QUERY_TEMPLATE *tmp; while (qlist != NULL) { while (qlist->chain != NULL) { tmp = qlist->chain; qlist->chain = qlist->chain->chain; DecrementDeftemplateBusyCount(theEnv,(void *) tmp->templatePtr); rtn_struct(theEnv,query_template,tmp); } tmp = qlist; qlist = qlist->nxt; DecrementDeftemplateBusyCount(theEnv,(void *) tmp->templatePtr); rtn_struct(theEnv,query_template,tmp); } } /************************************************************ NAME : TestForFirstInChain DESCRIPTION : Processes all templates in a restriction chain until success or done INPUTS : 1) The current chain 2) The index of the chain restriction (e.g. the 4th query-variable) RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Sets current restriction class Fact variable values set NOTES : None ************************************************************/ static int TestForFirstInChain( void *theEnv, QUERY_TEMPLATE *qchain, int indx) { QUERY_TEMPLATE *qptr; FactQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { FactQueryData(theEnv)->AbortQuery = FALSE; if (TestForFirstFactInTemplate(theEnv,qptr->templatePtr,qchain,indx)) { return(TRUE); } if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); } /***************************************************************** NAME : TestForFirstFactInTemplate DESCRIPTION : Processes all facts in a template INPUTS : 1) Visitation traversal id 2) The template 3) The current template restriction chain 4) The index of the current restriction RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Fact variable values set NOTES : None *****************************************************************/ static int TestForFirstFactInTemplate( void *theEnv, struct deftemplate *templatePtr, QUERY_TEMPLATE *qchain, int indx) { struct fact *theFact; DATA_OBJECT temp; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; theFact = templatePtr->factList; while (theFact != NULL) { FactQueryData(theEnv)->QueryCore->solns[indx] = theFact; if (qchain->nxt != NULL) { theFact->factHeader.busyCount++; if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE) { theFact->factHeader.busyCount--; break; } theFact->factHeader.busyCount--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) break; } else { theFact->factHeader.busyCount++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); theFact->factHeader.busyCount--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) break; } theFact = theFact->nextTemplateFact; while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE) theFact = theFact->nextTemplateFact; } RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); if (theFact != NULL) return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) ? FALSE : TRUE); return(FALSE); } /************************************************************ NAME : TestEntireChain DESCRIPTION : Processes all templates in a restriction chain until done INPUTS : 1) The current chain 2) The index of the chain restriction (i.e. the 4th query-variable) RETURNS : Nothing useful SIDE EFFECTS : Sets current restriction template Query fact variables set Solution sets stored in global list NOTES : None ************************************************************/ static void TestEntireChain( void *theEnv, QUERY_TEMPLATE *qchain, int indx) { QUERY_TEMPLATE *qptr; FactQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { FactQueryData(theEnv)->AbortQuery = FALSE; TestEntireTemplate(theEnv,qptr->templatePtr,qchain,indx); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) return; } } /***************************************************************** NAME : TestEntireTemplate DESCRIPTION : Processes all facts in a template INPUTS : 1) The module for which templates tested must be in scope 3) The template 4) The current template restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireTemplate( void *theEnv, struct deftemplate *templatePtr, QUERY_TEMPLATE *qchain, int indx) { struct fact *theFact; DATA_OBJECT temp; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; theFact = templatePtr->factList; while (theFact != NULL) { FactQueryData(theEnv)->QueryCore->solns[indx] = theFact; if (qchain->nxt != NULL) { theFact->factHeader.busyCount++; TestEntireChain(theEnv,qchain->nxt,indx+1); theFact->factHeader.busyCount--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) break; } else { theFact->factHeader.busyCount++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp); theFact->factHeader.busyCount--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) { if (FactQueryData(theEnv)->QueryCore->action != NULL) { theFact->factHeader.busyCount++; ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result); EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result); ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result); theFact->factHeader.busyCount--; if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { FactQueryData(theEnv)->AbortQuery = TRUE; break; } if (EvaluationData(theEnv)->HaltExecution == TRUE) break; } else AddSolution(theEnv); } } theFact = theFact->nextTemplateFact; while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE) theFact = theFact->nextTemplateFact; CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); } /*************************************************************************** NAME : AddSolution DESCRIPTION : Adds the current fact set to a global list of solutions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Global list and count updated NOTES : Solutions are stored as sequential arrays of struct fact * ***************************************************************************/ static void AddSolution( void *theEnv) { QUERY_SOLN *new_soln; register unsigned i; new_soln = (QUERY_SOLN *) gm2(theEnv,(int) sizeof(QUERY_SOLN)); new_soln->soln = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * (FactQueryData(theEnv)->QueryCore->soln_size))); for (i = 0 ; i < FactQueryData(theEnv)->QueryCore->soln_size ; i++) new_soln->soln[i] = FactQueryData(theEnv)->QueryCore->solns[i]; new_soln->nxt = NULL; if (FactQueryData(theEnv)->QueryCore->soln_set == NULL) FactQueryData(theEnv)->QueryCore->soln_set = new_soln; else FactQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln; FactQueryData(theEnv)->QueryCore->soln_bottom = new_soln; FactQueryData(theEnv)->QueryCore->soln_cnt++; } /*************************************************** NAME : PopQuerySoln DESCRIPTION : Deallocates the topmost solution set for an fact-set query INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Solution set deallocated NOTES : Assumes QueryCore->soln_set != 0 ***************************************************/ static void PopQuerySoln( void *theEnv) { FactQueryData(theEnv)->QueryCore->soln_bottom = FactQueryData(theEnv)->QueryCore->soln_set; FactQueryData(theEnv)->QueryCore->soln_set = FactQueryData(theEnv)->QueryCore->soln_set->nxt; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->soln_bottom->soln, (sizeof(struct fact *) * FactQueryData(theEnv)->QueryCore->soln_size)); rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN)); } #endif clips_core_source_630/core/factrete.h0000755000175000017500000000660112373742636016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT RETE ACCESS FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for hashing optimizations. */ /* */ /*************************************************************/ #ifndef _H_factrete #define _H_factrete #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTRETE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool FactPNGetVar1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNGetVar2(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNGetVar3(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactJNGetVar1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactJNGetVar2(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactJNGetVar3(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactSlotLength(void *,void *,DATA_OBJECT_PTR); LOCALE int FactJNCompVars1(void *,void *,DATA_OBJECT_PTR); LOCALE int FactJNCompVars2(void *,void *,DATA_OBJECT_PTR); LOCALE int FactPNCompVars1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNConstant1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNConstant2(void *,void *,DATA_OBJECT_PTR); LOCALE int FactStoreMultifield(void *,void *,DATA_OBJECT_PTR); LOCALE unsigned short AdjustFieldPosition(void *,struct multifieldMarker *, unsigned short,unsigned short,int *); #endif clips_core_source_630/core/exprnops.c0000755000175000017500000004667012373740003016267 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION OPERATIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides utility routines for manipulating and */ /* examining expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Add NegateExpression function. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _EXPRNOPS_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "memalloc.h" #include "envrnmnt.h" #include "router.h" #include "extnfunc.h" #include "cstrnchk.h" #include "prntutil.h" #include "cstrnutl.h" #include "cstrnops.h" #include "exprnops.h" #if (! RUN_TIME) /**************************************************************/ /* CheckArgumentAgainstRestriction: Compares an argument to a */ /* function to the set of restrictions for that function to */ /* determine if any incompatibilities exist. If so, the */ /* value TRUE is returned, otherwise FALSE is returned. */ /* Restrictions checked are: */ /* a - external address */ /* d - float */ /* e - instance address, instance name, or symbol */ /* f - float */ /* g - integer, float, or symbol */ /* h - instance address, instance name, fact address, */ /* integer, or symbol */ /* i - integer */ /* j - symbol, string, or instance name */ /* k - symbol or string */ /* l - integer */ /* m - multifield */ /* n - float or integer */ /* o - instance name */ /* p - instance name or symbol */ /* q - string, symbol, or multifield */ /* s - string */ /* u - unknown (any type allowed) */ /* w - symbol */ /* x - instance address */ /* y - fact address */ /* z - fact address, integer, or symbol (*) */ /**************************************************************/ globle int CheckArgumentAgainstRestriction( void *theEnv, struct expr *theExpression, int theRestriction) { CONSTRAINT_RECORD *cr1, *cr2, *cr3; /*=============================================*/ /* Generate a constraint record for the actual */ /* argument passed to the function. */ /*=============================================*/ cr1 = ExpressionToConstraintRecord(theEnv,theExpression); /*================================================*/ /* Generate a constraint record based on the type */ /* of argument expected by the function. */ /*================================================*/ cr2 = ArgumentTypeToConstraintRecord(theEnv,theRestriction); /*===============================================*/ /* Intersect the two constraint records and then */ /* discard them. */ /*===============================================*/ cr3 = IntersectConstraints(theEnv,cr1,cr2); RemoveConstraint(theEnv,cr1); RemoveConstraint(theEnv,cr2); /*====================================================*/ /* If the intersection of the two constraint records */ /* is empty, then the argument passed to the function */ /* doesn't satisfy the restrictions for the argument. */ /*====================================================*/ if (UnmatchableConstraint(cr3)) { RemoveConstraint(theEnv,cr3); return(TRUE); } /*===================================================*/ /* The argument satisfies the function restrictions. */ /*===================================================*/ RemoveConstraint(theEnv,cr3); return(FALSE); } #endif /* (! RUN_TIME) */ /************************************************************/ /* ConstantExpression: Returns TRUE if the expression */ /* is a constant, otherwise FALSE. */ /************************************************************/ globle intBool ConstantExpression( struct expr *testPtr) { while (testPtr != NULL) { if ((testPtr->type != SYMBOL) && (testPtr->type != STRING) && #if OBJECT_SYSTEM (testPtr->type != INSTANCE_NAME) && (testPtr->type != INSTANCE_ADDRESS) && #endif (testPtr->type != INTEGER) && (testPtr->type != FLOAT)) { return(FALSE); } testPtr = testPtr->nextArg; } return(TRUE); } /************************************************/ /* ConstantType: Returns TRUE if the type */ /* is a constant, otherwise FALSE. */ /************************************************/ globle intBool ConstantType( int theType) { switch (theType) { case SYMBOL: case STRING: case INTEGER: case FLOAT: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif return(TRUE); } return(FALSE); } /*****************************************************************************/ /* IdenticalExpression: Determines if two expressions are identical. Returns */ /* TRUE if the expressions are identical, otherwise FALSE is returned. */ /*****************************************************************************/ globle intBool IdenticalExpression( struct expr *firstList, struct expr *secondList) { /*==============================================*/ /* Compare each argument in both expressions by */ /* following the nextArg list. */ /*==============================================*/ for (; (firstList != NULL) && (secondList != NULL); firstList = firstList->nextArg, secondList = secondList->nextArg) { /*=========================*/ /* Compare type and value. */ /*=========================*/ if (firstList->type != secondList->type) { return(FALSE); } if (firstList->value != secondList->value) { return (FALSE); } /*==============================*/ /* Compare the arguments lists. */ /*==============================*/ if (IdenticalExpression(firstList->argList,secondList->argList) == FALSE) { return(FALSE); } } /*=====================================================*/ /* If firstList and secondList aren't both NULL, then */ /* one of the lists contains more expressions than the */ /* other. */ /*=====================================================*/ if (firstList != secondList) return(FALSE); /*============================*/ /* Expressions are identical. */ /*============================*/ return(TRUE); } /****************************************************/ /* CountArguments: Returns the number of structures */ /* stored in an expression as traversed through */ /* the nextArg pointer but not the argList */ /* pointer. */ /****************************************************/ globle int CountArguments( struct expr *testPtr) { int size = 0; while (testPtr != NULL) { size++; testPtr = testPtr->nextArg; } return(size); } /******************************************/ /* CopyExpresssion: Copies an expression. */ /******************************************/ globle struct expr *CopyExpression( void *theEnv, struct expr *original) { struct expr *topLevel, *next, *last; if (original == NULL) return(NULL); topLevel = GenConstant(theEnv,original->type,original->value); topLevel->argList = CopyExpression(theEnv,original->argList); last = topLevel; original = original->nextArg; while (original != NULL) { next = GenConstant(theEnv,original->type,original->value); next->argList = CopyExpression(theEnv,original->argList); last->nextArg = next; last = next; original = original->nextArg; } return(topLevel); } /************************************************************/ /* ExpressionContainsVariables: Determines if an expression */ /* contains any variables. Returns TRUE if the expression */ /* contains any variables, otherwise FALSE is returned. */ /************************************************************/ globle intBool ExpressionContainsVariables( struct expr *theExpression, intBool globalsAreVariables) { while (theExpression != NULL) { if (theExpression->argList != NULL) { if (ExpressionContainsVariables(theExpression->argList,globalsAreVariables)) { return(TRUE); } } if ((theExpression->type == MF_VARIABLE) || (theExpression->type == SF_VARIABLE) || (theExpression->type == FACT_ADDRESS) || (((theExpression->type == GBL_VARIABLE) || (theExpression->type == MF_GBL_VARIABLE)) && (globalsAreVariables == TRUE))) { return(TRUE); } theExpression = theExpression->nextArg; } return(FALSE); } /*****************************************/ /* ExpressionSize: Returns the number of */ /* structures stored in an expression. */ /*****************************************/ globle long ExpressionSize( struct expr *testPtr) { long size = 0; while (testPtr != NULL) { size++; if (testPtr->argList != NULL) { size += ExpressionSize(testPtr->argList); } testPtr = testPtr->nextArg; } return(size); } /************************************************/ /* GenConstant: Generates a constant expression */ /* value of type string, symbol, or number. */ /************************************************/ globle struct expr *GenConstant( void *theEnv, unsigned short type, void *value) { struct expr *top; top = get_struct(theEnv,expr); top->nextArg = NULL; top->argList = NULL; top->type = type; top->value = value; return(top); } /*************************************************/ /* PrintExpression: Pretty prints an expression. */ /*************************************************/ globle void PrintExpression( void *theEnv, const char *fileid, struct expr *theExpression) { struct expr *oldExpression; if (theExpression == NULL) { return; } while (theExpression != NULL) { switch (theExpression->type) { case SF_VARIABLE: case GBL_VARIABLE: EnvPrintRouter(theEnv,fileid,"?"); EnvPrintRouter(theEnv,fileid,ValueToString(theExpression->value)); break; case MF_VARIABLE: case MF_GBL_VARIABLE: EnvPrintRouter(theEnv,fileid,"$?"); EnvPrintRouter(theEnv,fileid,ValueToString(theExpression->value)); break; case FCALL: EnvPrintRouter(theEnv,fileid,"("); EnvPrintRouter(theEnv,fileid,ValueToString(ExpressionFunctionCallName(theExpression))); if (theExpression->argList != NULL) { EnvPrintRouter(theEnv,fileid," "); } PrintExpression(theEnv,fileid,theExpression->argList); EnvPrintRouter(theEnv,fileid,")"); break; default: oldExpression = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theExpression; PrintAtom(theEnv,fileid,theExpression->type,theExpression->value); EvaluationData(theEnv)->CurrentExpression = oldExpression; break; } theExpression = theExpression->nextArg; if (theExpression != NULL) EnvPrintRouter(theEnv,fileid," "); } return; } /*************************************************************************/ /* CombineExpressions: Combines two expressions into a single equivalent */ /* expression. Mainly serves to merge expressions containing "and" */ /* and "or" expressions without unnecessary duplication of the "and" */ /* and "or" expressions (i.e., two "and" expressions can be merged by */ /* placing them as arguments within another "and" expression, but it */ /* is more efficient to add the arguments of one of the "and" */ /* expressions to the list of arguments for the other and expression). */ /*************************************************************************/ globle struct expr *CombineExpressions( void *theEnv, struct expr *expr1, struct expr *expr2) { struct expr *tempPtr; /*===========================================================*/ /* If the 1st expression is NULL, return the 2nd expression. */ /*===========================================================*/ if (expr1 == NULL) return(expr2); /*===========================================================*/ /* If the 2nd expression is NULL, return the 1st expression. */ /*===========================================================*/ if (expr2 == NULL) return(expr1); /*============================================================*/ /* If the 1st expression is an "and" expression, and the 2nd */ /* expression is not an "and" expression, then include the */ /* 2nd expression in the argument list of the 1st expression. */ /*============================================================*/ if ((expr1->value == ExpressionData(theEnv)->PTR_AND) && (expr2->value != ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr1->argList; if (tempPtr == NULL) { rtn_struct(theEnv,expr,expr1); return(expr2); } while (tempPtr->nextArg != NULL) { tempPtr = tempPtr->nextArg; } tempPtr->nextArg = expr2; return(expr1); } /*============================================================*/ /* If the 2nd expression is an "and" expression, and the 1st */ /* expression is not an "and" expression, then include the */ /* 1st expression in the argument list of the 2nd expression. */ /*============================================================*/ if ((expr1->value != ExpressionData(theEnv)->PTR_AND) && (expr2->value == ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr2->argList; if (tempPtr == NULL) { rtn_struct(theEnv,expr,expr2); return(expr1); } expr2->argList = expr1; expr1->nextArg = tempPtr; return(expr2); } /*===========================================================*/ /* If both expressions are "and" expressions, then add the */ /* 2nd expression to the argument list of the 1st expression */ /* and throw away the extraneous "and" expression. */ /*===========================================================*/ if ((expr1->value == ExpressionData(theEnv)->PTR_AND) && (expr2->value == ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr1->argList; if (tempPtr == NULL) { rtn_struct(theEnv,expr,expr1); return(expr2); } while (tempPtr->nextArg != NULL) { tempPtr = tempPtr->nextArg; } tempPtr->nextArg = expr2->argList; rtn_struct(theEnv,expr,expr2); return(expr1); } /*=====================================================*/ /* If neither expression is an "and" expression, then */ /* create an "and" expression and add both expressions */ /* to the argument list of that "and" expression. */ /*=====================================================*/ tempPtr = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_AND); tempPtr->argList = expr1; expr1->nextArg = expr2; return(tempPtr); } /*********************/ /* NegateExpression: */ /*********************/ globle struct expr *NegateExpression( void *theEnv, struct expr *theExpression) { struct expr *tempPtr; /*=========================================*/ /* If the expression is NULL, return NULL. */ /*=========================================*/ if (theExpression == NULL) return(NULL); /*==================================================*/ /* The expression is already wrapped within a "not" */ /* function call, just remove the function call. */ /*==================================================*/ if (theExpression->value == ExpressionData(theEnv)->PTR_NOT) { tempPtr = theExpression->argList; rtn_struct(theEnv,expr,theExpression); return(tempPtr); } /*===================================================*/ /* Wrap the expression within a "not" function call. */ /*===================================================*/ tempPtr = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT); tempPtr->argList = theExpression; return(tempPtr); } /********************************************************/ /* AppendExpressions: Attaches an expression to the end */ /* of another expression's nextArg list. */ /********************************************************/ globle struct expr *AppendExpressions( struct expr *expr1, struct expr *expr2) { struct expr *tempPtr; /*===========================================================*/ /* If the 1st expression is NULL, return the 2nd expression. */ /*===========================================================*/ if (expr1 == NULL) return(expr2); /*===========================================================*/ /* If the 2nd expression is NULL, return the 1st expression. */ /*===========================================================*/ if (expr2 == NULL) return(expr1); /*====================================*/ /* Find the end of the 1st expression */ /* and attach the 2nd expression. */ /*====================================*/ tempPtr = expr1; while (tempPtr->nextArg != NULL) tempPtr = tempPtr->nextArg; tempPtr->nextArg = expr2; /*===============================*/ /* Return the merged expression. */ /*===============================*/ return(expr1); } clips_core_source_630/core/._object.h0000755000175000017500000000040712374023210016060 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulebsc.c0000755000175000017500000000040712500146515016251 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factfun.h0000755000175000017500000000040712373742660016260 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrnbin.c0000755000175000017500000000040712373714224016442 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrccom.c0000755000175000017500000016175312461252076016234 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* CONSTRUCT COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains generic routines for deleting, pretty */ /* printing, finding, obtaining module information, */ /* obtaining lists of constructs, listing constructs, and */ /* manipulation routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modified GetConstructList to remove buffer */ /* overflow problem with large construct/module */ /* names. DR0858 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Corrected an error when compiling as a C++ */ /* file. DR0868 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added ConstructsDeletable function. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Change find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _CSTRCCOM_SOURCE_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "moduldef.h" #include "argacces.h" #include "multifld.h" #include "modulutl.h" #include "router.h" #include "utility.h" #include "commline.h" #include "sysdep.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "cstrcpsr.h" #endif #include "cstrccom.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEBUGGING_FUNCTIONS static void ConstructPrintWatch(void *,const char *,struct construct *,void *, unsigned (*)(void *,void *)); static unsigned ConstructWatchSupport(void *,struct construct *,const char *, const char *,EXPRESSION *,intBool, unsigned,unsigned (*)(void *,void *), void (*)(void *,unsigned,void *)); #endif #if (! RUN_TIME) /************************************/ /* AddConstructToModule: Adds a */ /* construct to the current module. */ /************************************/ globle void AddConstructToModule( struct constructHeader *theConstruct) { if (theConstruct->whichModule->lastItem == NULL) { theConstruct->whichModule->firstItem = theConstruct; } else { theConstruct->whichModule->lastItem->next = theConstruct; } theConstruct->whichModule->lastItem = theConstruct; theConstruct->next = NULL; } #endif /* (! RUN_TIME) */ /****************************************************/ /* DeleteNamedConstruct: Generic driver routine for */ /* deleting a specific construct from a module. */ /****************************************************/ globle intBool DeleteNamedConstruct( void *theEnv, const char *constructName, struct construct *constructClass) { #if (! BLOAD_ONLY) void *constructPtr; /*=============================*/ /* Constructs can't be deleted */ /* while a bload is in effect. */ /*=============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif /*===============================*/ /* Look for the named construct. */ /*===============================*/ constructPtr = (*constructClass->findFunction)(theEnv,constructName); /*========================================*/ /* If the construct was found, delete it. */ /*========================================*/ if (constructPtr != NULL) { return((*constructClass->deleteFunction)(theEnv,constructPtr)); } /*========================================*/ /* If the construct wasn't found, but the */ /* special symbol * was used, then delete */ /* all constructs of the specified type. */ /*========================================*/ if (strcmp("*",constructName) == 0) { (*constructClass->deleteFunction)(theEnv,NULL); return(TRUE); } /*===============================*/ /* Otherwise, return FALSE to */ /* indicate no deletion occured. */ /*===============================*/ return(FALSE); #else #if MAC_XCD #pragma unused(theEnv,constructName,constructClass) #endif return(FALSE); #endif } /********************************************************/ /* FindNamedConstructInModuleOrImports: Generic routine */ /* for searching for a specified construct. */ /********************************************************/ globle void *FindNamedConstructInModuleOrImports( void *theEnv, const char *constructName, struct construct *constructClass) { void *theConstruct; int count; /*================================================*/ /* First look in the current or specified module. */ /*================================================*/ theConstruct = FindNamedConstructInModule(theEnv,constructName,constructClass); if (theConstruct != NULL) return theConstruct; /*=====================================*/ /* If there's a module specifier, then */ /* the construct does not exist. */ /*=====================================*/ if (FindModuleSeparator(constructName)) { return(NULL); } /*========================================*/ /* Otherwise, search in imported modules. */ /*========================================*/ theConstruct = FindImportedConstruct(theEnv,constructClass->constructName,NULL, constructName,&count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,constructClass->constructName,constructName); return(NULL); } return(theConstruct); } /***********************************************/ /* FindNamedConstructInModule: Generic routine */ /* for searching for a specified construct. */ /***********************************************/ globle void *FindNamedConstructInModule( void *theEnv, const char *constructName, struct construct *constructClass) { void *theConstruct; SYMBOL_HN *findValue; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=========================================================*/ /* Extract the construct name. If a module was specified, */ /* then ExtractModuleAndConstructName will set the current */ /* module to the module specified in the name. */ /*=========================================================*/ constructName = ExtractModuleAndConstructName(theEnv,constructName); /*=================================================*/ /* If a valid construct name couldn't be extracted */ /* or the construct name isn't in the symbol table */ /* (which means the construct doesn't exist), then */ /* return NULL to indicate the specified construct */ /* couldn't be found. */ /*=================================================*/ if ((constructName == NULL) ? TRUE : ((findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,constructName)) == NULL)) { RestoreCurrentModule(theEnv); return(NULL); } /*===============================================*/ /* If we find the symbol for the construct name, */ /* but it has a count of 0, then it can't be for */ /* a construct that's currently defined. */ /*===============================================*/ if (findValue->count == 0) { RestoreCurrentModule(theEnv); return(NULL); } /*===============================================*/ /* Loop through every construct of the specified */ /* class in the current module checking to see */ /* if the construct's name matches the construct */ /* being sought. If found, restore the current */ /* module and return a pointer to the construct. */ /*===============================================*/ for (theConstruct = (*constructClass->getNextItemFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) { if (findValue == (*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct)) { RestoreCurrentModule(theEnv); return (theConstruct); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*====================================*/ /* Return NULL to indicated the named */ /* construct was not found. */ /*====================================*/ return(NULL); } /*****************************************/ /* UndefconstructCommand: Driver routine */ /* for the undef commands. */ /*****************************************/ globle void UndefconstructCommand( void *theEnv, const char *command, struct construct *constructClass) { const char *constructName; char buffer[80]; /*==============================================*/ /* Get the name of the construct to be deleted. */ /*==============================================*/ gensprintf(buffer,"%s name",constructClass->constructName); constructName = GetConstructName(theEnv,command,buffer); if (constructName == NULL) return; #if (! RUN_TIME) && (! BLOAD_ONLY) /*=============================================*/ /* Check to see if the named construct exists. */ /*=============================================*/ if (((*constructClass->findFunction)(theEnv,constructName) == NULL) && (strcmp("*",constructName) != 0)) { CantFindItemErrorMessage(theEnv,constructClass->constructName,constructName); return; } /*===============================================*/ /* If the construct does exist, try deleting it. */ /*===============================================*/ else if (DeleteNamedConstruct(theEnv,constructName,constructClass) == FALSE) { CantDeleteItemErrorMessage(theEnv,constructClass->constructName,constructName); return; } return; #else /*=====================================*/ /* Constructs can't be deleted in a */ /* run-time or bload only environment. */ /*=====================================*/ CantDeleteItemErrorMessage(theEnv,constructClass->constructName,constructName); return; #endif } /******************************************/ /* PPConstructCommand: Driver routine for */ /* the ppdef commands. */ /******************************************/ globle void PPConstructCommand( void *theEnv, const char *command, struct construct *constructClass) { const char *constructName; char buffer[80]; /*===============================*/ /* Get the name of the construct */ /* to be "pretty printed." */ /*===============================*/ gensprintf(buffer,"%s name",constructClass->constructName); constructName = GetConstructName(theEnv,command,buffer); if (constructName == NULL) return; /*================================*/ /* Call the driver routine for */ /* pretty printing the construct. */ /*================================*/ if (PPConstruct(theEnv,constructName,WDISPLAY,constructClass) == FALSE) { CantFindItemErrorMessage(theEnv,constructClass->constructName,constructName); } } /***********************************/ /* PPConstruct: Driver routine for */ /* pretty printing a construct. */ /***********************************/ globle int PPConstruct( void *theEnv, const char *constructName, const char *logicalName, struct construct *constructClass) { void *constructPtr; /*==================================*/ /* Use the construct's name to find */ /* a pointer to actual construct. */ /*==================================*/ constructPtr = (*constructClass->findFunction)(theEnv,constructName); if (constructPtr == NULL) return(FALSE); /*==============================================*/ /* If the pretty print form is NULL (because of */ /* conserve-mem), return TRUE (which indicates */ /* the construct was found). */ /*==============================================*/ if ((*constructClass->getPPFormFunction)(theEnv,(struct constructHeader *) constructPtr) == NULL) { return(TRUE); } /*============================================*/ /* Print the pretty print string in smaller */ /* chunks. (VMS had a bug that didn't allow */ /* printing a string greater than 512 bytes.) */ /*============================================*/ PrintInChunks(theEnv,logicalName,(*constructClass->getPPFormFunction)(theEnv,(struct constructHeader *) constructPtr)); /*=======================================*/ /* Return TRUE to indicate the construct */ /* was found and pretty printed. */ /*=======================================*/ return(TRUE); } /*********************************************/ /* GetConstructModuleCommand: Driver routine */ /* for def-module routines */ /*********************************************/ globle SYMBOL_HN *GetConstructModuleCommand( void *theEnv, const char *command, struct construct *constructClass) { const char *constructName; char buffer[80]; struct defmodule *constructModule; /*=========================================*/ /* Get the name of the construct for which */ /* we want to determine its module. */ /*=========================================*/ gensprintf(buffer,"%s name",constructClass->constructName); constructName = GetConstructName(theEnv,command,buffer); if (constructName == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); /*==========================================*/ /* Get a pointer to the construct's module. */ /*==========================================*/ constructModule = GetConstructModule(theEnv,constructName,constructClass); if (constructModule == NULL) { CantFindItemErrorMessage(theEnv,constructClass->constructName,constructName); return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); } /*============================================*/ /* Return the name of the construct's module. */ /*============================================*/ return(constructModule->name); } /******************************************/ /* GetConstructModule: Driver routine for */ /* getting the module for a construct */ /******************************************/ globle struct defmodule *GetConstructModule( void *theEnv, const char *constructName, struct construct *constructClass) { struct constructHeader *constructPtr; int count; unsigned position; SYMBOL_HN *theName; /*====================================================*/ /* If the construct name contains a module specifier, */ /* then get a pointer to the defmodule associated */ /* with the specified name. */ /*====================================================*/ if ((position = FindModuleSeparator(constructName)) != FALSE) { theName = ExtractModuleName(theEnv,position,constructName); if (theName != NULL) { return((struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theName))); } } /*============================================*/ /* No module was specified, so search for the */ /* named construct in the current module and */ /* modules from which it imports. */ /*============================================*/ constructPtr = (struct constructHeader *) FindImportedConstruct(theEnv,constructClass->constructName,NULL,constructName, &count,TRUE,NULL); if (constructPtr == NULL) return(NULL); return(constructPtr->whichModule->theModule); } /*************************************/ /* Undefconstruct: Generic C routine */ /* for deleting a construct. */ /*************************************/ globle intBool Undefconstruct( void *theEnv, void *theConstruct, struct construct *constructClass) { #if BLOAD_ONLY || RUN_TIME #if MAC_XCD #pragma unused(theConstruct) #pragma unused(constructClass) #pragma unused(theEnv) #endif return(FALSE); #else void *currentConstruct,*nextConstruct; intBool success; /*================================================*/ /* Delete all constructs of the specified type if */ /* the construct pointer is the NULL pointer. */ /*================================================*/ if (theConstruct == NULL) { success = TRUE; /*===================================================*/ /* Loop through all of the constructs in the module. */ /*===================================================*/ currentConstruct = (*constructClass->getNextItemFunction)(theEnv,NULL); while (currentConstruct != NULL) { /*==============================*/ /* Remember the next construct. */ /*==============================*/ nextConstruct = (*constructClass->getNextItemFunction)(theEnv,currentConstruct); /*=============================*/ /* Try deleting the construct. */ /*=============================*/ if ((*constructClass->isConstructDeletableFunction)(theEnv,currentConstruct)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) currentConstruct); (*constructClass->freeFunction)(theEnv,currentConstruct); } else { CantDeleteItemErrorMessage(theEnv,constructClass->constructName, ValueToString((*constructClass->getConstructNameFunction)((struct constructHeader *) currentConstruct))); success = FALSE; } /*================================*/ /* Move on to the next construct. */ /*================================*/ currentConstruct = nextConstruct; } /*=======================================*/ /* Perform periodic cleanup if embedded. */ /*=======================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*============================================*/ /* Return TRUE if all constructs successfully */ /* deleted, otherwise FALSE. */ /*============================================*/ return(success); } /*==================================================*/ /* Return FALSE if the construct cannot be deleted. */ /*==================================================*/ if ((*constructClass->isConstructDeletableFunction)(theEnv,theConstruct) == FALSE) { return(FALSE); } /*===========================*/ /* Remove the construct from */ /* the list in its module. */ /*===========================*/ RemoveConstructFromModule(theEnv,(struct constructHeader *) theConstruct); /*=======================*/ /* Delete the construct. */ /*=======================*/ (*constructClass->freeFunction)(theEnv,theConstruct); /*=======================================*/ /* Perform periodic cleanup if embedded. */ /*=======================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*=============================*/ /* Return TRUE to indicate the */ /* construct was deleted. */ /*=============================*/ return(TRUE); #endif } /***********************************/ /* SaveConstruct: Generic routine */ /* for saving a construct class. */ /***********************************/ globle void SaveConstruct( void *theEnv, void *theModule, const char *logicalName, struct construct *constructClass) { const char *ppform; struct constructHeader *theConstruct; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*===========================*/ /* Set the current module to */ /* the one we're examining. */ /*===========================*/ EnvSetCurrentModule(theEnv,theModule); /*==============================================*/ /* Loop through each construct of the specified */ /* construct class in the module. */ /*==============================================*/ for (theConstruct = (struct constructHeader *) (*constructClass->getNextItemFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (struct constructHeader *) (*constructClass->getNextItemFunction)(theEnv,theConstruct)) { /*==========================================*/ /* Print the construct's pretty print form. */ /*==========================================*/ ppform = (*constructClass->getPPFormFunction)(theEnv,theConstruct); if (ppform != NULL) { PrintInChunks(theEnv,logicalName,ppform); EnvPrintRouter(theEnv,logicalName,"\n"); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*********************************************************/ /* GetConstructModuleName: Generic routine for returning */ /* the name of the module to which a construct belongs */ /*********************************************************/ globle const char *GetConstructModuleName( struct constructHeader *theConstruct) { return(EnvGetDefmoduleName(NULL,(void *) theConstruct->whichModule->theModule)); } /*********************************************************/ /* GetConstructNameString: Generic routine for returning */ /* the name string of a construct. */ /*********************************************************/ globle const char *GetConstructNameString( struct constructHeader *theConstruct) { return(ValueToString(theConstruct->name)); } /**************************************************/ /* EnvGetConstructNameString: Generic routine for */ /* returning the name string of a construct. */ /**************************************************/ globle const char *EnvGetConstructNameString( void *theEnv, struct constructHeader *theConstruct) { #if MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(theConstruct->name)); } /**********************************************************/ /* GetConstructNamePointer: Generic routine for returning */ /* the name pointer of a construct. */ /**********************************************************/ globle SYMBOL_HN *GetConstructNamePointer( struct constructHeader *theConstruct) { return(theConstruct->name); } /************************************************/ /* GetConstructListFunction: Generic Routine */ /* for retrieving the constructs in a module. */ /************************************************/ globle void GetConstructListFunction( void *theEnv, const char *functionName, DATA_OBJECT_PTR returnValue, struct construct *constructClass) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,functionName,NO_MORE_THAN,1)) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*====================================*/ /* If an argument was given, check to */ /* see that it's a valid module name. */ /*====================================*/ if (numArgs == 1) { /*======================================*/ /* Only symbols are valid module names. */ /*======================================*/ EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } /*===========================================*/ /* Verify that the named module exists or is */ /* the symbol * (for obtaining the construct */ /* list for all modules). */ /*===========================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } theModule = NULL; } } /*=====================================*/ /* Otherwise use the current module to */ /* generate the construct list. */ /*=====================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=============================*/ /* Call the driver routine to */ /* get the list of constructs. */ /*=============================*/ GetConstructList(theEnv,returnValue,constructClass,theModule); } /********************************************/ /* GetConstructList: Generic C Routine for */ /* retrieving the constructs in a module. */ /********************************************/ globle void GetConstructList( void *theEnv, DATA_OBJECT_PTR returnValue, struct construct *constructClass, struct defmodule *theModule) { void *theConstruct; unsigned long count = 0; struct multifield *theList; SYMBOL_HN *theName; struct defmodule *loopModule; int allModules = FALSE; size_t largestConstructNameSize = 0, bufferSize = 80; /* prevents warning */ char *buffer; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=======================================*/ /* If the module specified is NULL, then */ /* get all constructs in all modules. */ /*=======================================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } /*======================================================*/ /* Count the number of constructs to be retrieved and */ /* determine the buffer size needed to store the */ /* module-name::construct-names that will be generated. */ /*======================================================*/ loopModule = theModule; while (loopModule != NULL) { size_t tempSize; /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) loopModule); /*===========================================*/ /* Loop over every construct in the module. */ /*===========================================*/ theConstruct = NULL; largestConstructNameSize = 0; while ((theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) != NULL) { /*================================*/ /* Increment the construct count. */ /*================================*/ count++; /*=================================================*/ /* Is this the largest construct name encountered? */ /*=================================================*/ tempSize = strlen(ValueToString((*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct))); if (tempSize > largestConstructNameSize) { largestConstructNameSize = tempSize; } } /*========================================*/ /* Determine the size of the module name. */ /*========================================*/ tempSize = strlen(EnvGetDefmoduleName(theEnv,loopModule)); /*======================================================*/ /* The buffer must be large enough for the module name, */ /* the largest name of all the constructs, and the ::. */ /*======================================================*/ if ((tempSize + largestConstructNameSize + 5) > bufferSize) { bufferSize = tempSize + largestConstructNameSize + 5; } /*=============================*/ /* Move on to the next module. */ /*=============================*/ if (allModules) loopModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,loopModule); else loopModule = NULL; } /*===========================*/ /* Allocate the name buffer. */ /*===========================*/ buffer = (char *) genalloc(theEnv,bufferSize); /*================================*/ /* Create the multifield value to */ /* store the construct names. */ /*================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===========================*/ /* Store the construct names */ /* in the multifield value. */ /*===========================*/ loopModule = theModule; count = 1; while (loopModule != NULL) { /*============================*/ /* Set the current module to */ /* the module being examined. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) loopModule); /*===============================*/ /* Add each construct name found */ /* in the module to the list. */ /*===============================*/ theConstruct = NULL; while ((theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) != NULL) { theName = (*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct); SetMFType(theList,count,SYMBOL); if (allModules) { genstrcpy(buffer,EnvGetDefmoduleName(theEnv,loopModule)); genstrcat(buffer,"::"); genstrcat(buffer,ValueToString(theName)); SetMFValue(theList,count,EnvAddSymbol(theEnv,buffer)); } else { SetMFValue(theList,count,EnvAddSymbol(theEnv,ValueToString(theName))); } count++; } /*==================================*/ /* Move on to the next module (if */ /* the list is to contain the names */ /* of constructs from all modules). */ /*==================================*/ if (allModules) loopModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,loopModule); else loopModule = NULL; } /*=========================*/ /* Return the name buffer. */ /*=========================*/ genfree(theEnv,buffer,bufferSize); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*********************************************/ /* ListConstructCommand: Generic Routine for */ /* listing the constructs in a module. */ /*********************************************/ globle void ListConstructCommand( void *theEnv, const char *functionName, struct construct *constructClass) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,functionName,NO_MORE_THAN,1)) == -1) return; /*====================================*/ /* If an argument was given, check to */ /* see that it's a valid module name. */ /*====================================*/ if (numArgs == 1) { /*======================================*/ /* Only symbols are valid module names. */ /*======================================*/ EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } /*===========================================*/ /* Verify that the named module exists or is */ /* the symbol * (for obtaining the construct */ /* list for all modules). */ /*===========================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } theModule = NULL; } } /*=====================================*/ /* Otherwise use the current module to */ /* generate the construct list. */ /*=====================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=========================*/ /* Call the driver routine */ /* to list the constructs. */ /*=========================*/ ListConstruct(theEnv,constructClass,WDISPLAY,theModule); } /*****************************************/ /* ListConstruct: Generic C Routine for */ /* listing the constructs in a module. */ /*****************************************/ globle void ListConstruct( void *theEnv, struct construct *constructClass, const char *logicalName, struct defmodule *theModule) { void *constructPtr; SYMBOL_HN *constructName; long count = 0; int allModules = FALSE; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=======================================*/ /* If the module specified is NULL, then */ /* list all constructs in all modules. */ /*=======================================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ while (theModule != NULL) { /*========================================*/ /* If we're printing the construct in all */ /* modules, then preface each module */ /* listing with the name of the module. */ /*========================================*/ if (allModules) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); } /*===============================*/ /* Set the current module to the */ /* module we're examining. */ /*===============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*===========================================*/ /* List all of the constructs in the module. */ /*===========================================*/ for (constructPtr = (*constructClass->getNextItemFunction)(theEnv,NULL); constructPtr != NULL; constructPtr = (*constructClass->getNextItemFunction)(theEnv,constructPtr)) { if (EvaluationData(theEnv)->HaltExecution == TRUE) return; constructName = (*constructClass->getConstructNameFunction)((struct constructHeader *) constructPtr); if (constructName != NULL) { if (allModules) EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,logicalName,ValueToString(constructName)); EnvPrintRouter(theEnv,logicalName,"\n"); } count++; } /*====================================*/ /* Move on to the next module (if the */ /* listing is to contain the names of */ /* constructs from all modules). */ /*====================================*/ if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); else theModule = NULL; } /*=================================================*/ /* Print the tally and restore the current module. */ /*=================================================*/ PrintTally(theEnv,WDISPLAY,count,constructClass->constructName, constructClass->pluralName); RestoreCurrentModule(theEnv); } /**********************************************************/ /* SetNextConstruct: Sets the next field of one construct */ /* to point to another construct of the same type. */ /**********************************************************/ globle void SetNextConstruct( struct constructHeader *theConstruct, struct constructHeader *targetConstruct) { theConstruct->next = targetConstruct; } /********************************************************************/ /* GetConstructModuleItem: Returns the construct module for a given */ /* construct (note that this is a pointer to a data structure */ /* like the deffactsModule, not a pointer to an environment */ /* module which contains a number of types of constructs. */ /********************************************************************/ globle struct defmoduleItemHeader *GetConstructModuleItem( struct constructHeader *theConstruct) { return(theConstruct->whichModule); } /*************************************************/ /* GetConstructPPForm: Returns the pretty print */ /* representation for the specified construct. */ /*************************************************/ globle const char *GetConstructPPForm( void *theEnv, struct constructHeader *theConstruct) { #if MAC_XCD #pragma unused(theEnv) #endif return(theConstruct->ppForm); } /****************************************************/ /* GetNextConstructItem: Returns the next construct */ /* items from a list of constructs. */ /****************************************************/ globle struct constructHeader *GetNextConstructItem( void *theEnv, struct constructHeader *theConstruct, int moduleIndex) { struct defmoduleItemHeader *theModuleItem; if (theConstruct == NULL) { theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,moduleIndex); if (theModuleItem == NULL) return(NULL); return(theModuleItem->firstItem); } return(theConstruct->next); } /*******************************************************/ /* GetConstructModuleItemByIndex: Returns a pointer to */ /* the defmodule item for the specified construct. If */ /* theModule is NULL, then the construct module item */ /* for the current module is returned, otherwise the */ /* construct module item for the specified construct */ /* is returned. */ /*******************************************************/ globle struct defmoduleItemHeader *GetConstructModuleItemByIndex( void *theEnv, struct defmodule *theModule, int moduleIndex) { if (theModule != NULL) { return((struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,moduleIndex)); } return((struct defmoduleItemHeader *) GetModuleItem(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)),moduleIndex)); } /******************************************/ /* FreeConstructHeaderModule: Deallocates */ /* the data structures associated with */ /* the construct module item header. */ /******************************************/ globle void FreeConstructHeaderModule( void *theEnv, struct defmoduleItemHeader *theModuleItem, struct construct *constructClass) { struct constructHeader *thisOne, *nextOne; thisOne = theModuleItem->firstItem; while (thisOne != NULL) { nextOne = thisOne->next; (*constructClass->freeFunction)(theEnv,thisOne); thisOne = nextOne; } } /**********************************************/ /* DoForAllConstructs: Executes an action for */ /* all constructs of a specified type. */ /**********************************************/ globle long DoForAllConstructs( void *theEnv, void (*actionFunction)(void *,struct constructHeader *,void *), int moduleItemIndex, int interruptable, void *userBuffer) { struct constructHeader *theConstruct; struct defmoduleItemHeader *theModuleItem; void *theModule; long moduleCount = 0L; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule), moduleCount++) { /*=============================*/ /* Set the current module to */ /* the module we're examining. */ /*=============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*================================================*/ /* Perform the action for each of the constructs. */ /*================================================*/ theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,(struct defmodule *) theModule,moduleItemIndex); for (theConstruct = theModuleItem->firstItem; theConstruct != NULL; theConstruct = theConstruct->next) { if (interruptable) { if (GetHaltExecution(theEnv) == TRUE) { RestoreCurrentModule(theEnv); return(-1L); } } (*actionFunction)(theEnv,theConstruct,userBuffer); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*=========================================*/ /* Return the number of modules traversed. */ /*=========================================*/ return(moduleCount); } /******************************************************/ /* DoForAllConstructsInModule: Executes an action for */ /* all constructs of a specified type in a module. */ /******************************************************/ globle void DoForAllConstructsInModule( void *theEnv, void *theModule, void (*actionFunction)(void *,struct constructHeader *,void *), int moduleItemIndex, int interruptable, void *userBuffer) { struct constructHeader *theConstruct; struct defmoduleItemHeader *theModuleItem; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=============================*/ /* Set the current module to */ /* the module we're examining. */ /*=============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*================================================*/ /* Perform the action for each of the constructs. */ /*================================================*/ theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,(struct defmodule *) theModule,moduleItemIndex); for (theConstruct = theModuleItem->firstItem; theConstruct != NULL; theConstruct = theConstruct->next) { if (interruptable) { if (GetHaltExecution(theEnv) == TRUE) { RestoreCurrentModule(theEnv); return; } } (*actionFunction)(theEnv,theConstruct,userBuffer); } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*****************************************************/ /* InitializeConstructHeader: Initializes construct */ /* header info, including to which module item the */ /* new construct belongs */ /*****************************************************/ globle void InitializeConstructHeader( void *theEnv, const char *constructType, struct constructHeader *theConstruct, SYMBOL_HN *theConstructName) { struct moduleItem *theModuleItem; struct defmoduleItemHeader *theItemHeader; theModuleItem = FindModuleItem(theEnv,constructType); theItemHeader = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,theModuleItem->moduleIndex); theConstruct->whichModule = theItemHeader; theConstruct->name = theConstructName; theConstruct->ppForm = NULL; theConstruct->bsaveID = 0L; theConstruct->next = NULL; theConstruct->usrData = NULL; } /*************************************************/ /* SetConstructPPForm: Sets a construct's pretty */ /* print form and deletes the old one. */ /*************************************************/ globle void SetConstructPPForm( void *theEnv, struct constructHeader *theConstruct, const char *ppForm) { if (theConstruct->ppForm != NULL) { rm(theEnv,(void *) theConstruct->ppForm, ((strlen(theConstruct->ppForm) + 1) * sizeof(char))); } theConstruct->ppForm = ppForm; } #if DEBUGGING_FUNCTIONS /******************************************************/ /* ConstructPrintWatchAccess: Provides an interface */ /* to the list-watch-items function for a construct */ /******************************************************/ globle unsigned ConstructPrintWatchAccess( void *theEnv, struct construct *constructClass, const char *logName, EXPRESSION *argExprs, unsigned (*getWatchFunc)(void *,void *), void (*setWatchFunc)(void *,unsigned,void *)) { return(ConstructWatchSupport(theEnv,constructClass,"list-watch-items",logName,argExprs, FALSE,FALSE,getWatchFunc,setWatchFunc)); } /**************************************************/ /* ConstructSetWatchAccess: Provides an interface */ /* to the watch function for a construct */ /**************************************************/ globle unsigned ConstructSetWatchAccess( void *theEnv, struct construct *constructClass, unsigned newState, EXPRESSION *argExprs, unsigned (*getWatchFunc)(void *,void *), void (*setWatchFunc)(void *,unsigned,void *)) { return(ConstructWatchSupport(theEnv,constructClass,"watch",WERROR,argExprs, TRUE,newState,getWatchFunc,setWatchFunc)); } /******************************************************/ /* ConstructWatchSupport: Generic construct interface */ /* into watch and list-watch-items. */ /******************************************************/ static unsigned ConstructWatchSupport( void *theEnv, struct construct *constructClass, const char *funcName, const char *logName, EXPRESSION *argExprs, intBool setFlag, unsigned newState, unsigned (*getWatchFunc)(void *,void *), void (*setWatchFunc)(void *,unsigned,void *)) { struct defmodule *theModule; void *theConstruct; DATA_OBJECT constructName; int argIndex = 2; /*========================================*/ /* If no constructs are specified, then */ /* show/set the trace for all constructs. */ /*========================================*/ if (argExprs == NULL) { /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule)) { /*============================*/ /* Set the current module to */ /* the module being examined. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*====================================================*/ /* If we're displaying the names of constructs with */ /* watch flags enabled, then preface each module */ /* listing of constructs with the name of the module. */ /*====================================================*/ if (setFlag == FALSE) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } /*============================================*/ /* Loop through each construct in the module. */ /*============================================*/ for (theConstruct = (*constructClass->getNextItemFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) { /*=============================================*/ /* Either set the watch flag for the construct */ /* or display its current state. */ /*=============================================*/ if (setFlag) { (*setWatchFunc)(theEnv,newState,theConstruct); } else { EnvPrintRouter(theEnv,logName," "); ConstructPrintWatch(theEnv,logName,constructClass,theConstruct,getWatchFunc); } } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*====================================*/ /* Return TRUE to indicate successful */ /* completion of the command. */ /*====================================*/ return(TRUE); } /*==================================================*/ /* Show/set the trace for each specified construct. */ /*==================================================*/ while (argExprs != NULL) { /*==========================================*/ /* Evaluate the argument that should be a */ /* construct name. Return FALSE is an error */ /* occurs when evaluating the argument. */ /*==========================================*/ if (EvaluateExpression(theEnv,argExprs,&constructName)) { return(FALSE); } /*================================================*/ /* Check to see that it's a valid construct name. */ /*================================================*/ if ((constructName.type != SYMBOL) ? TRUE : ((theConstruct = LookupConstruct(theEnv,constructClass, DOToString(constructName),TRUE)) == NULL)) { ExpectedTypeError1(theEnv,funcName,argIndex,constructClass->constructName); return(FALSE); } /*=============================================*/ /* Either set the watch flag for the construct */ /* or display its current state. */ /*=============================================*/ if (setFlag) { (*setWatchFunc)(theEnv,newState,theConstruct); } else { ConstructPrintWatch(theEnv,logName,constructClass,theConstruct,getWatchFunc); } /*===============================*/ /* Move on to the next argument. */ /*===============================*/ argIndex++; argExprs = GetNextArgument(argExprs); } /*====================================*/ /* Return TRUE to indicate successful */ /* completion of the command. */ /*====================================*/ return(TRUE); } /*************************************************/ /* ConstructPrintWatch: Displays the trace value */ /* of a construct for list-watch-items */ /*************************************************/ static void ConstructPrintWatch( void *theEnv, const char *logName, struct construct *constructClass, void *theConstruct, unsigned (*getWatchFunc)(void *,void *)) { EnvPrintRouter(theEnv,logName,ValueToString((*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct))); if ((*getWatchFunc)(theEnv,theConstruct)) EnvPrintRouter(theEnv,logName," = on\n"); else EnvPrintRouter(theEnv,logName," = off\n"); } #endif /* DEBUGGING_FUNCTIONS */ /*****************************************************/ /* LookupConstruct: Finds a construct in the current */ /* or imported modules. If specified, will also */ /* look for construct in a non-imported module. */ /*****************************************************/ globle void *LookupConstruct( void *theEnv, struct construct *constructClass, const char *constructName, intBool moduleNameAllowed) { void *theConstruct; const char *constructType; int moduleCount; /*============================================*/ /* Look for the specified construct in the */ /* current module or in any imported modules. */ /*============================================*/ constructType = constructClass->constructName; theConstruct = FindImportedConstruct(theEnv,constructType,NULL,constructName, &moduleCount,TRUE,NULL); /*===========================================*/ /* Return NULL if the reference is ambiguous */ /* (it was found in more than one module). */ /*===========================================*/ if (theConstruct != NULL) { if (moduleCount > 1) { AmbiguousReferenceErrorMessage(theEnv,constructType,constructName); return(NULL); } return(theConstruct); } /*=============================================*/ /* If specified, check to see if the construct */ /* is in a non-imported module. */ /*=============================================*/ if (moduleNameAllowed && FindModuleSeparator(constructName)) { theConstruct = (*constructClass->findFunction)(theEnv,constructName); } /*====================================*/ /* Return a pointer to the construct. */ /*====================================*/ return(theConstruct); } /***********************************************************/ /* ConstructsDeletable: Returns a boolean value indicating */ /* whether constructs in general can be deleted. */ /***********************************************************/ globle intBool ConstructsDeletable( void *theEnv) { #if BLOAD_ONLY || RUN_TIME || ((! BLOAD) && (! BLOAD_AND_BSAVE)) #if MAC_XCD #pragma unused(theEnv) #endif #endif #if BLOAD_ONLY || RUN_TIME return(FALSE); #elif BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); return TRUE; #else return(TRUE); #endif } clips_core_source_630/core/._factcom.c0000755000175000017500000000040712462743521016235 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/genrccom.c0000755000175000017500000020774412464742046016221 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Functions Interface Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when DEBUGGING_FUNCTIONS */ /* is set to 0 and PROFILING_FUNCTIONS is set to */ /* 1. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT #include #if DEFRULE_CONSTRUCT #include "network.h" #endif #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "genrcbin.h" #endif #if CONSTRUCT_COMPILER #include "genrccmp.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "constrct.h" #include "genrcpsr.h" #endif #if OBJECT_SYSTEM #include "classcom.h" #include "inscom.h" #endif #if DEBUGGING_FUNCTIONS #include "watch.h" #endif #include "argacces.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "extnfunc.h" #include "genrcexe.h" #include "memalloc.h" #include "modulpsr.h" #include "multifld.h" #include "router.h" #define _GENRCCOM_SOURCE_ #include "genrccom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PrintGenericCall(void *,const char *,void *); static intBool EvaluateGenericCall(void *,void *,DATA_OBJECT *); static void DecrementGenericBusyCount(void *,void *); static void IncrementGenericBusyCount(void *,void *); static void DeallocateDefgenericData(void *); #if ! RUN_TIME static void DestroyDefgenericAction(void *,struct constructHeader *,void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) static void SaveDefgenerics(void *,void *,const char *); static void SaveDefmethods(void *,void *,const char *); static void SaveDefmethodsForDefgeneric(void *,struct constructHeader *,void *); static void RemoveDefgenericMethod(void *,DEFGENERIC *,long); #endif #if DEBUGGING_FUNCTIONS static long ListMethodsForGeneric(void *,const char *,DEFGENERIC *); static unsigned DefgenericWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DefgenericWatchPrint(void *,const char *,int,EXPRESSION *); static unsigned DefmethodWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DefmethodWatchPrint(void *,const char *,int,EXPRESSION *); static unsigned DefmethodWatchSupport(void *,const char *,const char *,unsigned, void (*)(void *,const char *,void *,long), void (*)(void *,unsigned,void *,long), EXPRESSION *); static void PrintMethodWatchFlag(void *,const char *,void *,long); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupGenericFunctions DESCRIPTION : Initializes all generic function data structures, constructs and functions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Generic function H/L functions set up NOTES : None ***********************************************************/ globle void SetupGenericFunctions( void *theEnv) { ENTITY_RECORD genericEntityRecord = { "GCALL", GCALL,0,0,1, PrintGenericCall,PrintGenericCall, NULL,EvaluateGenericCall,NULL, DecrementGenericBusyCount,IncrementGenericBusyCount, NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFGENERIC_DATA,sizeof(struct defgenericData),DeallocateDefgenericData); memcpy(&DefgenericData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&DefgenericData(theEnv)->GenericEntityRecord,GCALL); DefgenericData(theEnv)->DefgenericModuleIndex = RegisterModuleItem(theEnv,"defgeneric", #if (! RUN_TIME) AllocateDefgenericModule,FreeDefgenericModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefgenericModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefgenericCModuleReference, #else NULL, #endif EnvFindDefgenericInModule); DefgenericData(theEnv)->DefgenericConstruct = AddConstruct(theEnv,"defgeneric","defgenerics", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDefgeneric, #else NULL, #endif EnvFindDefgeneric, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefgeneric, SetNextConstruct,EnvIsDefgenericDeletable, EnvUndefgeneric, #if (! BLOAD_ONLY) && (! RUN_TIME) RemoveDefgeneric #else NULL #endif ); #if ! RUN_TIME AddClearReadyFunction(theEnv,"defgeneric",ClearDefgenericsReady,0); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE SetupGenericsBload(theEnv); #endif #if CONSTRUCT_COMPILER SetupGenericsCompiler(theEnv); #endif #if ! BLOAD_ONLY #if DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"defgeneric",SYMBOL); #endif AddConstruct(theEnv,"defmethod","defmethods",ParseDefmethod, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL); /* ================================================================ Make sure defmethods are cleared last, for other constructs may be using them and need to be cleared first Need to be cleared in two stages so that mutually dependent constructs (like classes) can be cleared ================================================================ */ AddSaveFunction(theEnv,"defgeneric",SaveDefgenerics,1000); AddSaveFunction(theEnv,"defmethod",SaveDefmethods,-1000); EnvDefineFunction2(theEnv,"undefgeneric",'v',PTIEF UndefgenericCommand,"UndefgenericCommand","11w"); EnvDefineFunction2(theEnv,"undefmethod",'v',PTIEF UndefmethodCommand,"UndefmethodCommand","22*wg"); #endif EnvDefineFunction2(theEnv,"call-next-method",'u',PTIEF CallNextMethod,"CallNextMethod","00"); FuncSeqOvlFlags(theEnv,"call-next-method",TRUE,FALSE); EnvDefineFunction2(theEnv,"call-specific-method",'u',PTIEF CallSpecificMethod, "CallSpecificMethod","2**wi"); FuncSeqOvlFlags(theEnv,"call-specific-method",TRUE,FALSE); EnvDefineFunction2(theEnv,"override-next-method",'u',PTIEF OverrideNextMethod, "OverrideNextMethod",NULL); FuncSeqOvlFlags(theEnv,"override-next-method",TRUE,FALSE); EnvDefineFunction2(theEnv,"next-methodp",'b',PTIEF NextMethodP,"NextMethodP","00"); FuncSeqOvlFlags(theEnv,"next-methodp",TRUE,FALSE); EnvDefineFunction2(theEnv,"(gnrc-current-arg)",'u',PTIEF GetGenericCurrentArgument, "GetGenericCurrentArgument",NULL); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"ppdefgeneric",'v',PTIEF PPDefgenericCommand,"PPDefgenericCommand","11w"); EnvDefineFunction2(theEnv,"list-defgenerics",'v',PTIEF ListDefgenericsCommand,"ListDefgenericsCommand","01"); EnvDefineFunction2(theEnv,"ppdefmethod",'v',PTIEF PPDefmethodCommand,"PPDefmethodCommand","22*wi"); EnvDefineFunction2(theEnv,"list-defmethods",'v',PTIEF ListDefmethodsCommand,"ListDefmethodsCommand","01w"); EnvDefineFunction2(theEnv,"preview-generic",'v',PTIEF PreviewGeneric,"PreviewGeneric","1**w"); #endif EnvDefineFunction2(theEnv,"get-defgeneric-list",'m',PTIEF GetDefgenericListFunction, "GetDefgenericListFunction","01"); EnvDefineFunction2(theEnv,"get-defmethod-list",'m',PTIEF GetDefmethodListCommand, "GetDefmethodListCommand","01w"); EnvDefineFunction2(theEnv,"get-method-restrictions",'m',PTIEF GetMethodRestrictionsCommand, "GetMethodRestrictionsCommand","22iw"); EnvDefineFunction2(theEnv,"defgeneric-module",'w',PTIEF GetDefgenericModuleCommand, "GetDefgenericModuleCommand","11w"); #if OBJECT_SYSTEM EnvDefineFunction2(theEnv,"type",'u',PTIEF ClassCommand,"ClassCommand","11u"); #else EnvDefineFunction2(theEnv,"type",'u',PTIEF TypeCommand,"TypeCommand","11u"); #endif #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"generic-functions",0,&DefgenericData(theEnv)->WatchGenerics,34, DefgenericWatchAccess,DefgenericWatchPrint); AddWatchItem(theEnv,"methods",0,&DefgenericData(theEnv)->WatchMethods,33, DefmethodWatchAccess,DefmethodWatchPrint); #endif } /*****************************************************/ /* DeallocateDefgenericData: Deallocates environment */ /* data for the defgeneric construct. */ /*****************************************************/ static void DeallocateDefgenericData( void *theEnv) { #if ! RUN_TIME struct defgenericModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefgenericAction,DefgenericData(theEnv)->DefgenericModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defgenericModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefgenericData(theEnv)->DefgenericModuleIndex); rtn_struct(theEnv,defgenericModule,theModuleItem); } #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /****************************************************/ /* DestroyDefgenericAction: Action used to remove */ /* defgenerics as a result of DestroyEnvironment. */ /****************************************************/ static void DestroyDefgenericAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct defgeneric *theDefgeneric = (struct defgeneric *) theConstruct; long i; if (theDefgeneric == NULL) return; for (i = 0 ; i < theDefgeneric->mcnt ; i++) { DestroyMethodInfo(theEnv,theDefgeneric,&theDefgeneric->methods[i]); } if (theDefgeneric->mcnt != 0) rm(theEnv,(void *) theDefgeneric->methods,(sizeof(DEFMETHOD) * theDefgeneric->mcnt)); DestroyConstructHeader(theEnv,&theDefgeneric->header); rtn_struct(theEnv,defgeneric,theDefgeneric); #else #if MAC_XCD #pragma unused(theEnv,theConstruct) #endif #endif } #endif /*************************************************** NAME : EnvFindDefgeneric DESCRIPTION : Searches for a generic INPUTS : The name of the generic (possibly including a module name) RETURNS : Pointer to the generic if found, otherwise NULL SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDefgeneric( void *theEnv, const char *genericModuleAndName) { return(FindNamedConstructInModuleOrImports(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct)); } /*************************************************** NAME : EnvFindDefgenericInModule DESCRIPTION : Searches for a generic INPUTS : The name of the generic (possibly including a module name) RETURNS : Pointer to the generic if found, otherwise NULL SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDefgenericInModule( void *theEnv, const char *genericModuleAndName) { return(FindNamedConstructInModule(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct)); } /*************************************************** NAME : LookupDefgenericByMdlOrScope DESCRIPTION : Finds a defgeneric anywhere (if module is specified) or in current or imported modules INPUTS : The defgeneric name RETURNS : The defgeneric (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFGENERIC *LookupDefgenericByMdlOrScope( void *theEnv, const char *defgenericName) { return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,TRUE)); } /*************************************************** NAME : LookupDefgenericInScope DESCRIPTION : Finds a defgeneric in current or imported modules (module specifier is not allowed) INPUTS : The defgeneric name RETURNS : The defgeneric (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFGENERIC *LookupDefgenericInScope( void *theEnv, const char *defgenericName) { return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,FALSE)); } /*********************************************************** NAME : EnvGetNextDefgeneric DESCRIPTION : Finds first or next generic function INPUTS : The address of the current generic function RETURNS : The address of the next generic function (NULL if none) SIDE EFFECTS : None NOTES : If ptr == NULL, the first generic function is returned. ***********************************************************/ globle void *EnvGetNextDefgeneric( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefgenericData(theEnv)->DefgenericModuleIndex)); } /*********************************************************** NAME : EnvGetNextDefmethod DESCRIPTION : Find the next method for a generic function INPUTS : 1) The generic function address 2) The index of the current method RETURNS : The index of the next method (0 if none) SIDE EFFECTS : None NOTES : If index == 0, the index of the first method is returned ***********************************************************/ globle long EnvGetNextDefmethod( void *theEnv, void *ptr, long theIndex) { DEFGENERIC *gfunc; long mi; #if MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) ptr; if (theIndex == 0) { if (gfunc->methods != NULL) return(gfunc->methods[0].index); return(0); } mi = FindMethodByIndex(gfunc,theIndex); if ((mi+1) == gfunc->mcnt) return(0); return(gfunc->methods[mi+1].index); } /***************************************************** NAME : GetDefmethodPointer DESCRIPTION : Returns a pointer to a method INPUTS : 1) Pointer to a defgeneric 2) Array index of method in generic's method array (+1) RETURNS : Pointer to the method. SIDE EFFECTS : None NOTES : None *****************************************************/ globle DEFMETHOD *GetDefmethodPointer( void *ptr, long theIndex) { return(&((DEFGENERIC *) ptr)->methods[theIndex-1]); } /*************************************************** NAME : EnvIsDefgenericDeletable DESCRIPTION : Determines if a generic function can be deleted INPUTS : Address of the generic function RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefgenericDeletable( void *theEnv, void *ptr) { if (! ConstructsDeletable(theEnv)) { return FALSE; } return ((((DEFGENERIC *) ptr)->busy == 0) ? TRUE : FALSE); } /*************************************************** NAME : EnvIsDefmethodDeletable DESCRIPTION : Determines if a generic function method can be deleted INPUTS : 1) Address of the generic function 2) Index of the method RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefmethodDeletable( void *theEnv, void *ptr, long theIndex) { if (! ConstructsDeletable(theEnv)) { return FALSE; } if (((DEFGENERIC *) ptr)->methods[FindMethodByIndex((DEFGENERIC *) ptr,theIndex)].system) return(FALSE); #if (! BLOAD_ONLY) && (! RUN_TIME) return((MethodsExecuting((DEFGENERIC *) ptr) == FALSE) ? TRUE : FALSE); #else return FALSE; #endif } /********************************************************** NAME : UndefgenericCommand DESCRIPTION : Deletes all methods for a generic function INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : methods deallocated NOTES : H/L Syntax: (undefgeneric | *) **********************************************************/ globle void UndefgenericCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefgeneric",DefgenericData(theEnv)->DefgenericConstruct); } /**************************************************************** NAME : GetDefgenericModuleCommand DESCRIPTION : Determines to which module a defgeneric belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (defgeneric-module ) ****************************************************************/ globle void *GetDefgenericModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defgeneric-module",DefgenericData(theEnv)->DefgenericConstruct)); } /************************************************************** NAME : UndefmethodCommand DESCRIPTION : Deletes one method for a generic function INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : methods deallocated NOTES : H/L Syntax: (undefmethod | *) **************************************************************/ globle void UndefmethodCommand( void *theEnv) { DATA_OBJECT temp; DEFGENERIC *gfunc; long mi; if (EnvArgTypeCheck(theEnv,"undefmethod",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp)); if ((gfunc == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE) { PrintErrorID(theEnv,"GENRCCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No such generic function "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR," in function undefmethod.\n"); return; } EnvRtnUnknown(theEnv,2,&temp); if (temp.type == SYMBOL) { if (strcmp(DOToString(temp),"*") != 0) { PrintErrorID(theEnv,"GENRCCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n"); return; } mi = 0; } else if (temp.type == INTEGER) { mi = (long) DOToLong(temp); if (mi == 0) { PrintErrorID(theEnv,"GENRCCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n"); return; } } else { PrintErrorID(theEnv,"GENRCCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n"); return; } EnvUndefmethod(theEnv,(void *) gfunc,mi); } /************************************************************** NAME : EnvUndefgeneric DESCRIPTION : Deletes all methods for a generic function INPUTS : The generic-function address (NULL for all) RETURNS : TRUE if generic successfully deleted, FALSE otherwise SIDE EFFECTS : methods deallocated NOTES : None **************************************************************/ globle intBool EnvUndefgeneric( void *theEnv, void *vptr) { #if RUN_TIME || BLOAD_ONLY return(FALSE); #else DEFGENERIC *gfunc; int success = TRUE; gfunc = (DEFGENERIC *) vptr; if (gfunc == NULL) { if (ClearDefmethods(theEnv) == FALSE) success = FALSE; if (ClearDefgenerics(theEnv) == FALSE) success = FALSE; return(success); } if (EnvIsDefgenericDeletable(theEnv,vptr) == FALSE) return(FALSE); RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr); RemoveDefgeneric(theEnv,gfunc); return(TRUE); #endif } /************************************************************** NAME : EnvUndefmethod DESCRIPTION : Deletes one method for a generic function INPUTS : 1) Address of generic function (can be NULL) 2) Method index (0 for all) RETURNS : TRUE if method deleted successfully, FALSE otherwise SIDE EFFECTS : methods deallocated NOTES : None **************************************************************/ globle intBool EnvUndefmethod( void *theEnv, void *vptr, long mi) { DEFGENERIC *gfunc; #if RUN_TIME || BLOAD_ONLY gfunc = (DEFGENERIC *) vptr; PrintErrorID(theEnv,"PRNTUTIL",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete method "); if (gfunc != NULL) { PrintGenericName(theEnv,WERROR,gfunc); EnvPrintRouter(theEnv,WERROR," #"); PrintLongInteger(theEnv,WERROR,(long long) mi); } else EnvPrintRouter(theEnv,WERROR,"*"); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); #else long nmi; gfunc = (DEFGENERIC *) vptr; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) { PrintErrorID(theEnv,"PRNTUTIL",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete method "); if (gfunc != NULL) { EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," #"); PrintLongInteger(theEnv,WERROR,(long long) mi); } else EnvPrintRouter(theEnv,WERROR,"*"); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } #endif if (gfunc == NULL) { if (mi != 0) { PrintErrorID(theEnv,"GENRCCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Incomplete method specification for deletion.\n"); return(FALSE); } return(ClearDefmethods(theEnv)); } if (MethodsExecuting(gfunc)) { MethodAlterError(theEnv,gfunc); return(FALSE); } if (mi == 0) RemoveAllExplicitMethods(theEnv,gfunc); else { nmi = CheckMethodExists(theEnv,"undefmethod",gfunc,mi); if (nmi == -1) return(FALSE); RemoveDefgenericMethod(theEnv,gfunc,nmi); } return(TRUE); #endif } #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS /***************************************************** NAME : EnvGetDefmethodDescription DESCRIPTION : Prints a synopsis of method parameter restrictions into caller's buffer INPUTS : 1) Caller's buffer 2) Buffer size (not including space for terminating '\0') 3) Address of generic function 4) Index of method RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer written NOTES : Terminating '\n' not written *****************************************************/ globle void EnvGetDefmethodDescription( void *theEnv, char *buf, size_t buflen, void *ptr, long theIndex) { DEFGENERIC *gfunc; long mi; #if MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) ptr; mi = FindMethodByIndex(gfunc,theIndex); PrintMethod(theEnv,buf,buflen,&gfunc->methods[mi]); } #endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */ #if DEBUGGING_FUNCTIONS /********************************************************* NAME : EnvGetDefgenericWatch DESCRIPTION : Determines if trace messages are gnerated when executing generic function INPUTS : A pointer to the generic RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle unsigned EnvGetDefgenericWatch( void *theEnv, void *theGeneric) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFGENERIC *) theGeneric)->trace); } /********************************************************* NAME : EnvSetDefgenericWatch DESCRIPTION : Sets the trace to ON/OFF for the generic function INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the generic RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the generic set NOTES : None *********************************************************/ globle void EnvSetDefgenericWatch( void *theEnv, unsigned newState, void *theGeneric) { #if MAC_XCD #pragma unused(theEnv) #endif ((DEFGENERIC *) theGeneric)->trace = newState; } /********************************************************* NAME : EnvGetDefmethodWatch DESCRIPTION : Determines if trace messages for calls to this method will be generated or not INPUTS : 1) A pointer to the generic 2) The index of the method RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle unsigned EnvGetDefmethodWatch( void *theEnv, void *theGeneric, long theIndex) { DEFGENERIC *gfunc; long mi; #if MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) theGeneric; mi = FindMethodByIndex(gfunc,theIndex); return(gfunc->methods[mi].trace); } /********************************************************* NAME : EnvSetDefmethodWatch DESCRIPTION : Sets the trace to ON/OFF for the calling of the method INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the generic 3) The index of the method RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the method set NOTES : None *********************************************************/ globle void EnvSetDefmethodWatch( void *theEnv, unsigned newState, void *theGeneric, long theIndex) { DEFGENERIC *gfunc; long mi; #if MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) theGeneric; mi = FindMethodByIndex(gfunc,theIndex); gfunc->methods[mi].trace = newState; } /******************************************************** NAME : PPDefgenericCommand DESCRIPTION : Displays the pretty-print form of a generic function header INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefgeneric ) ********************************************************/ globle void PPDefgenericCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefgeneric",DefgenericData(theEnv)->DefgenericConstruct); } /********************************************************** NAME : PPDefmethodCommand DESCRIPTION : Displays the pretty-print form of a method INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefmethod ) **********************************************************/ globle void PPDefmethodCommand( void *theEnv) { DATA_OBJECT temp; const char *gname; DEFGENERIC *gfunc; int gi; if (EnvArgTypeCheck(theEnv,"ppdefmethod",1,SYMBOL,&temp) == FALSE) return; gname = DOToString(temp); if (EnvArgTypeCheck(theEnv,"ppdefmethod",2,INTEGER,&temp) == FALSE) return; gfunc = CheckGenericExists(theEnv,"ppdefmethod",gname); if (gfunc == NULL) return; gi = CheckMethodExists(theEnv,"ppdefmethod",gfunc,(long) DOToLong(temp)); if (gi == -1) return; if (gfunc->methods[gi].ppForm != NULL) PrintInChunks(theEnv,WDISPLAY,gfunc->methods[gi].ppForm); } /****************************************************** NAME : ListDefmethodsCommand DESCRIPTION : Lists a brief description of methods for a particular generic function INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (list-defmethods ) ******************************************************/ globle void ListDefmethodsCommand( void *theEnv) { DATA_OBJECT temp; DEFGENERIC *gfunc; if (EnvRtnArgCount(theEnv) == 0) EnvListDefmethods(theEnv,WDISPLAY,NULL); else { if (EnvArgTypeCheck(theEnv,"list-defmethods",1,SYMBOL,&temp) == FALSE) return; gfunc = CheckGenericExists(theEnv,"list-defmethods",DOToString(temp)); if (gfunc != NULL) EnvListDefmethods(theEnv,WDISPLAY,(void *) gfunc); } } /*************************************************************** NAME : EnvGetDefmethodPPForm DESCRIPTION : Getsa generic function method pretty print form INPUTS : 1) Address of the generic function 2) Index of the method RETURNS : Method ppform SIDE EFFECTS : None NOTES : None ***************************************************************/ globle const char *EnvGetDefmethodPPForm( void *theEnv, void *ptr, long theIndex) { DEFGENERIC *gfunc; int mi; #if MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) ptr; mi = FindMethodByIndex(gfunc,theIndex); return(gfunc->methods[mi].ppForm); } /*************************************************** NAME : ListDefgenericsCommand DESCRIPTION : Displays all defgeneric names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Defgeneric names printed NOTES : H/L Interface ***************************************************/ globle void ListDefgenericsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defgenerics",DefgenericData(theEnv)->DefgenericConstruct); } /*************************************************** NAME : EnvListDefgenerics DESCRIPTION : Displays all defgeneric names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Defgeneric names printed NOTES : C Interface ***************************************************/ globle void EnvListDefgenerics( void *theEnv, const char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logicalName,theModule); } /****************************************************** NAME : EnvListDefmethods DESCRIPTION : Lists a brief description of methods for a particular generic function INPUTS : 1) The logical name of the output 2) Generic function to list methods for (NULL means list all methods) RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ******************************************************/ globle void EnvListDefmethods( void *theEnv, const char *logicalName, void *vptr) { DEFGENERIC *gfunc; long count; if (vptr != NULL) count = ListMethodsForGeneric(theEnv,logicalName,(DEFGENERIC *) vptr); else { count = 0L; for (gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL) ; gfunc != NULL ; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc)) { count += ListMethodsForGeneric(theEnv,logicalName,gfunc); if (EnvGetNextDefgeneric(theEnv,(void *) gfunc) != NULL) EnvPrintRouter(theEnv,logicalName,"\n"); } } PrintTally(theEnv,logicalName,count,"method","methods"); } #endif /* DEBUGGING_FUNCTIONS */ /*************************************************************** NAME : GetDefgenericListFunction DESCRIPTION : Groups all defgeneric names into a multifield list INPUTS : A data object buffer to hold the multifield result RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : H/L Syntax: (get-defgeneric-list []) ***************************************************************/ globle void GetDefgenericListFunction( void *theEnv, DATA_OBJECT*returnValue) { GetConstructListFunction(theEnv,"get-defgeneric-list",returnValue,DefgenericData(theEnv)->DefgenericConstruct); } /*************************************************************** NAME : EnvGetDefgenericList DESCRIPTION : Groups all defgeneric names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain defgenerics RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDefgenericList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DefgenericData(theEnv)->DefgenericConstruct,theModule); } /*********************************************************** NAME : GetDefmethodListCommand DESCRIPTION : Groups indices of all methdos for a generic function into a multifield variable (NULL means get methods for all generics) INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Multifield set to list of method indices NOTES : None ***********************************************************/ globle void GetDefmethodListCommand( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT temp; DEFGENERIC *gfunc; if (EnvRtnArgCount(theEnv) == 0) EnvGetDefmethodList(theEnv,NULL,returnValue); else { if (EnvArgTypeCheck(theEnv,"get-defmethod-list",1,SYMBOL,&temp) == FALSE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } gfunc = CheckGenericExists(theEnv,"get-defmethod-list",DOToString(temp)); if (gfunc != NULL) EnvGetDefmethodList(theEnv,(void *) gfunc,returnValue); else EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*********************************************************** NAME : EnvGetDefmethodList DESCRIPTION : Groups indices of all methdos for a generic function into a multifield variable (NULL means get methods for all generics) INPUTS : 1) A pointer to a generic function 2) A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Multifield set to list of method indices NOTES : None ***********************************************************/ globle void EnvGetDefmethodList( void *theEnv, void *vgfunc, DATA_OBJECT_PTR returnValue) { DEFGENERIC *gfunc,*svg,*svnxt; long i,j; unsigned long count; MULTIFIELD_PTR theList; if (vgfunc != NULL) { gfunc = (DEFGENERIC *) vgfunc; svnxt = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,vgfunc); SetNextDefgeneric(vgfunc,NULL); } else { gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); svnxt = (gfunc != NULL) ? (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc) : NULL; } count = 0; for (svg = gfunc ; gfunc != NULL ; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc)) count += (unsigned long) gfunc->mcnt; count *= 2; SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,count); theList = (MULTIFIELD_PTR) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,theList); for (gfunc = svg , i = 1 ; gfunc != NULL ; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc)) { for (j = 0 ; j < gfunc->mcnt ; j++) { SetMFType(theList,i,SYMBOL); SetMFValue(theList,i++,GetDefgenericNamePointer((void *) gfunc)); SetMFType(theList,i,INTEGER); SetMFValue(theList,i++,EnvAddLong(theEnv,(long long) gfunc->methods[j].index)); } } if (svg != NULL) SetNextDefgeneric((void *) svg,(void *) svnxt); } /*********************************************************************************** NAME : GetMethodRestrictionsCommand DESCRIPTION : Stores restrictions of a method in multifield INPUTS : A data object buffer to hold a multifield RETURNS : Nothing useful SIDE EFFECTS : Multifield created (length zero on errors) NOTES : Syntax: (get-method-restrictions ) ***********************************************************************************/ globle void GetMethodRestrictionsCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT temp; DEFGENERIC *gfunc; if (EnvArgTypeCheck(theEnv,"get-method-restrictions",1,SYMBOL,&temp) == FALSE) { EnvSetMultifieldErrorValue(theEnv,result); return; } gfunc = CheckGenericExists(theEnv,"get-method-restrictions",DOToString(temp)); if (gfunc == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } if (EnvArgTypeCheck(theEnv,"get-method-restrictions",2,INTEGER,&temp) == FALSE) { EnvSetMultifieldErrorValue(theEnv,result); return; } if (CheckMethodExists(theEnv,"get-method-restrictions",gfunc,(long) DOToLong(temp)) == -1) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvGetMethodRestrictions(theEnv,(void *) gfunc,(unsigned) DOToLong(temp),result); } /*********************************************************************** NAME : EnvGetMethodRestrictions DESCRIPTION : Stores restrictions of a method in multifield INPUTS : 1) Pointer to the generic function 2) The method index 3) A data object buffer to hold a multifield RETURNS : Nothing useful SIDE EFFECTS : Multifield created (length zero on errors) NOTES : The restrictions are stored in the multifield in the following format: (-1 if wildcard allowed) . . . . . . . Thus, for the method (defmethod foo ((?a NUMBER SYMBOL) (?b (= 1 1)) $?c)) (get-method-restrictions foo 1) would yield (2 -1 3 7 11 13 FALSE 2 NUMBER SYMBOL TRUE 0 FALSE 0) ***********************************************************************/ globle void EnvGetMethodRestrictions( void *theEnv, void *vgfunc, long mi, DATA_OBJECT *result) { short i,j; register DEFMETHOD *meth; register RESTRICTION *rptr; long count; int roffset,rstrctIndex; MULTIFIELD_PTR theList; meth = ((DEFGENERIC *) vgfunc)->methods + FindMethodByIndex((DEFGENERIC *) vgfunc,mi); count = 3; for (i = 0 ; i < meth->restrictionCount ; i++) count += meth->restrictions[i].tcnt + 3; theList = (MULTIFIELD_PTR) EnvCreateMultifield(theEnv,count); SetpType(result,MULTIFIELD); SetpValue(result,theList); SetpDOBegin(result,1); SetpDOEnd(result,count); SetMFType(theList,1,INTEGER); SetMFValue(theList,1,EnvAddLong(theEnv,(long long) meth->minRestrictions)); SetMFType(theList,2,INTEGER); SetMFValue(theList,2,EnvAddLong(theEnv,(long long) meth->maxRestrictions)); SetMFType(theList,3,INTEGER); SetMFValue(theList,3,EnvAddLong(theEnv,(long long) meth->restrictionCount)); roffset = 3 + meth->restrictionCount + 1; rstrctIndex = 4; for (i = 0 ; i < meth->restrictionCount ; i++) { rptr = meth->restrictions + i; SetMFType(theList,rstrctIndex,INTEGER); SetMFValue(theList,rstrctIndex++,EnvAddLong(theEnv,(long long) roffset)); SetMFType(theList,roffset,SYMBOL); SetMFValue(theList,roffset++,(rptr->query != NULL) ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv)); SetMFType(theList,roffset,INTEGER); SetMFValue(theList,roffset++,EnvAddLong(theEnv,(long long) rptr->tcnt)); for (j = 0 ; j < rptr->tcnt ; j++) { SetMFType(theList,roffset,SYMBOL); #if OBJECT_SYSTEM SetMFValue(theList,roffset++,EnvAddSymbol(theEnv,EnvGetDefclassName(theEnv,rptr->types[j]))); #else SetMFValue(theList,roffset++,EnvAddSymbol(theEnv,TypeName(theEnv,ValueToInteger(rptr->types[j])))); #endif } } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : PrintGenericCall DESCRIPTION : PrintExpression() support function for generic function calls INPUTS : 1) The output logical name 2) The generic function RETURNS : Nothing useful SIDE EFFECTS : Call expression printed NOTES : None ***************************************************/ static void PrintGenericCall( void *theEnv, const char *logName, void *value) { #if DEVELOPER EnvPrintRouter(theEnv,logName,"("); EnvPrintRouter(theEnv,logName,EnvGetDefgenericName(theEnv,value)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logName," "); PrintExpression(theEnv,logName,GetFirstArgument()); } EnvPrintRouter(theEnv,logName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logName) #pragma unused(value) #endif #endif } /******************************************************* NAME : EvaluateGenericCall DESCRIPTION : Primitive support function for calling a generic function INPUTS : 1) The generic function 2) A data object buffer to hold the evaluation result RETURNS : FALSE if the generic function returns the symbol FALSE, TRUE otherwise SIDE EFFECTS : Data obejct buffer set and any side-effects of calling the generic NOTES : None *******************************************************/ static intBool EvaluateGenericCall( void *theEnv, void *value, DATA_OBJECT *result) { GenericDispatch(theEnv,(DEFGENERIC *) value,NULL,NULL,GetFirstArgument(),result); if ((GetpType(result) == SYMBOL) && (GetpValue(result) == EnvFalseSymbol(theEnv))) return(FALSE); return(TRUE); } /*************************************************** NAME : DecrementGenericBusyCount DESCRIPTION : Lowers the busy count of a generic function construct INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : Busy count decremented if a clear is not in progress (see comment) NOTES : None ***************************************************/ static void DecrementGenericBusyCount( void *theEnv, void *value) { /* ============================================== The generics to which expressions in other constructs may refer may already have been deleted - thus, it is important not to modify the busy flag during a clear. ============================================== */ if (! ConstructData(theEnv)->ClearInProgress) ((DEFGENERIC *) value)->busy--; } /*************************************************** NAME : IncrementGenericBusyCount DESCRIPTION : Raises the busy count of a generic function construct INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : Busy count incremented NOTES : None ***************************************************/ static void IncrementGenericBusyCount( void *theEnv, void *value) { #if MAC_XCD #pragma unused(theEnv) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif ((DEFGENERIC *) value)->busy++; } #if (! BLOAD_ONLY) && (! RUN_TIME) /********************************************************************** NAME : SaveDefgenerics DESCRIPTION : Outputs pretty-print forms of generic function headers INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None **********************************************************************/ static void SaveDefgenerics( void *theEnv, void *theModule, const char *logName) { SaveConstruct(theEnv,theModule,logName,DefgenericData(theEnv)->DefgenericConstruct); } /********************************************************************** NAME : SaveDefmethods DESCRIPTION : Outputs pretty-print forms of generic function methods INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None **********************************************************************/ static void SaveDefmethods( void *theEnv, void *theModule, const char *logName) { DoForAllConstructsInModule(theEnv,theModule,SaveDefmethodsForDefgeneric, DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) logName); } /*************************************************** NAME : SaveDefmethodsForDefgeneric DESCRIPTION : Save the pretty-print forms of all methods for a generic function to a file INPUTS : 1) The defgeneric 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Methods written NOTES : None ***************************************************/ static void SaveDefmethodsForDefgeneric( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; const char *logName = (const char *) userBuffer; long i; for (i = 0 ; i < gfunc->mcnt ; i++) { if (gfunc->methods[i].ppForm != NULL) { PrintInChunks(theEnv,logName,gfunc->methods[i].ppForm); EnvPrintRouter(theEnv,logName,"\n"); } } } /**************************************************** NAME : RemoveDefgenericMethod DESCRIPTION : Removes a generic function method from the array and removes the generic too if its the last method INPUTS : 1) The generic function 2) The array index of the method RETURNS : Nothing useful SIDE EFFECTS : List adjusted Nodes deallocated NOTES : Assumes deletion is safe ****************************************************/ static void RemoveDefgenericMethod( void *theEnv, DEFGENERIC *gfunc, long gi) { DEFMETHOD *narr; long b,e; if (gfunc->methods[gi].system) { SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"GENRCCOM",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot remove implicit system function method for generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR,".\n"); return; } DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[gi]); if (gfunc->mcnt == 1) { rm(theEnv,(void *) gfunc->methods,(int) sizeof(DEFMETHOD)); gfunc->mcnt = 0; gfunc->methods = NULL; } else { gfunc->mcnt--; narr = (DEFMETHOD *) gm2(theEnv,(sizeof(DEFMETHOD) * gfunc->mcnt)); for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++) { if (((int) b) == gi) e++; GenCopyMemory(DEFMETHOD,1,&narr[b],&gfunc->methods[e]); } rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * (gfunc->mcnt+1))); gfunc->methods = narr; } } #endif #if DEBUGGING_FUNCTIONS /****************************************************** NAME : ListMethodsForGeneric DESCRIPTION : Lists a brief description of methods for a particular generic function INPUTS : 1) The logical name of the output 2) Generic function to list methods for RETURNS : The number of methods printed SIDE EFFECTS : None NOTES : None ******************************************************/ static long ListMethodsForGeneric( void *theEnv, const char *logicalName, DEFGENERIC *gfunc) { long gi; char buf[256]; for (gi = 0 ; gi < gfunc->mcnt ; gi++) { EnvPrintRouter(theEnv,logicalName,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,logicalName," #"); PrintMethod(theEnv,buf,255,&gfunc->methods[gi]); EnvPrintRouter(theEnv,logicalName,buf); EnvPrintRouter(theEnv,logicalName,"\n"); } return((long) gfunc->mcnt); } /****************************************************************** NAME : DefgenericWatchAccess DESCRIPTION : Parses a list of generic names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set Ignored 2) The value to which to set the trace flags 3) A list of expressions containing the names of the generics for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified generics NOTES : Accessory function for AddWatchItem() ******************************************************************/ static unsigned DefgenericWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,newState,argExprs, EnvGetDefgenericWatch,EnvSetDefgenericWatch)); } /*********************************************************************** NAME : DefgenericWatchPrint DESCRIPTION : Parses a list of generic names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined Ignored 3) A list of expressions containing the names of the generics for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified generics NOTES : Accessory function for AddWatchItem() ***********************************************************************/ static unsigned DefgenericWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logName,argExprs, EnvGetDefgenericWatch,EnvSetDefgenericWatch)); } /****************************************************************** NAME : DefmethodWatchAccess DESCRIPTION : Parses a list of methods passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set Ignored 2) The value to which to set the trace flags 3) A list of expressions containing the methods for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified methods NOTES : Accessory function for AddWatchItem() ******************************************************************/ static unsigned DefmethodWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif if (newState) return(DefmethodWatchSupport(theEnv,"watch",NULL,newState,NULL,EnvSetDefmethodWatch,argExprs)); else return(DefmethodWatchSupport(theEnv,"unwatch",NULL,newState,NULL,EnvSetDefmethodWatch,argExprs)); } /*********************************************************************** NAME : DefmethodWatchPrint DESCRIPTION : Parses a list of methods passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined Ignored 3) A list of expressions containing the methods for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified methods NOTES : Accessory function for AddWatchItem() ***********************************************************************/ static unsigned DefmethodWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(DefmethodWatchSupport(theEnv,"list-watch-items",logName,0, PrintMethodWatchFlag,NULL,argExprs)); } /******************************************************* NAME : DefmethodWatchSupport DESCRIPTION : Sets or displays methods specified INPUTS : 1) The calling function name 2) The logical output name for displays (can be NULL) 3) The new set state 4) The print function (can be NULL) 5) The trace function (can be NULL) 6) The methods expression list RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Method trace flags set or displayed NOTES : None *******************************************************/ static unsigned DefmethodWatchSupport( void *theEnv, const char *funcName, const char *logName, unsigned newState, void (*printFunc)(void *,const char *,void *,long), void (*traceFunc)(void *,unsigned,void *,long), EXPRESSION *argExprs) { void *theGeneric; unsigned long theMethod = 0; int argIndex = 2; DATA_OBJECT genericName,methodIndex; struct defmodule *theModule; /* ============================== If no methods are specified, show the trace for all methods in all generics ============================== */ if (argExprs == NULL) { SaveCurrentModule(theEnv); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); if (traceFunc == NULL) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } theGeneric = EnvGetNextDefgeneric(theEnv,NULL); while (theGeneric != NULL) { theMethod = EnvGetNextDefmethod(theEnv,theGeneric,0); while (theMethod != 0) { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theGeneric,theMethod); else { EnvPrintRouter(theEnv,logName," "); (*printFunc)(theEnv,logName,theGeneric,theMethod); } theMethod = EnvGetNextDefmethod(theEnv,theGeneric,theMethod); } theGeneric = EnvGetNextDefgeneric(theEnv,theGeneric); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } RestoreCurrentModule(theEnv); return(TRUE); } /* ========================================= Set the traces for every method specified ========================================= */ while (argExprs != NULL) { if (EvaluateExpression(theEnv,argExprs,&genericName)) return(FALSE); if ((genericName.type != SYMBOL) ? TRUE : ((theGeneric = (void *) LookupDefgenericByMdlOrScope(theEnv,DOToString(genericName))) == NULL)) { ExpectedTypeError1(theEnv,funcName,argIndex,"generic function name"); return(FALSE); } if (GetNextArgument(argExprs) == NULL) theMethod = 0; else { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&methodIndex)) return(FALSE); if ((methodIndex.type != INTEGER) ? FALSE : ((DOToLong(methodIndex) <= 0) ? FALSE : (FindMethodByIndex((DEFGENERIC *) theGeneric,theMethod) != -1))) theMethod = (long) DOToLong(methodIndex); else { ExpectedTypeError1(theEnv,funcName,argIndex,"method index"); return(FALSE); } } if (theMethod == 0) { theMethod = EnvGetNextDefmethod(theEnv,theGeneric,0); while (theMethod != 0) { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theGeneric,theMethod); else (*printFunc)(theEnv,logName,theGeneric,theMethod); theMethod = EnvGetNextDefmethod(theEnv,theGeneric,theMethod); } } else { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theGeneric,theMethod); else (*printFunc)(theEnv,logName,theGeneric,theMethod); } argExprs = GetNextArgument(argExprs); argIndex++; } return(TRUE); } /*************************************************** NAME : PrintMethodWatchFlag DESCRIPTION : Displays trace value for method INPUTS : 1) The logical name of the output 2) The generic function 3) The method index RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintMethodWatchFlag( void *theEnv, const char *logName, void *theGeneric, long theMethod) { char buf[60]; EnvPrintRouter(theEnv,logName,EnvGetDefgenericName(theEnv,theGeneric)); EnvPrintRouter(theEnv,logName," "); EnvGetDefmethodDescription(theEnv,buf,59,theGeneric,theMethod); EnvPrintRouter(theEnv,logName,buf); if (EnvGetDefmethodWatch(theEnv,theGeneric,theMethod)) EnvPrintRouter(theEnv,logName," = on\n"); else EnvPrintRouter(theEnv,logName," = off\n"); } #endif #if ! OBJECT_SYSTEM /*************************************************** NAME : TypeCommand DESCRIPTION : Works like "class" in COOL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (type ) ***************************************************/ globle void TypeCommand( void *theEnv, DATA_OBJECT *result) { EvaluateExpression(theEnv,GetFirstArgument(),result); result->value = (void *) EnvAddSymbol(theEnv,TypeName(theEnv,result->type)); result->type = SYMBOL; } #endif /*#############################*/ /* Additional Access Functions */ /*#############################*/ globle SYMBOL_HN *GetDefgenericNamePointer( void *theDefgeneric) { return GetConstructNamePointer((struct constructHeader *) theDefgeneric); } globle void SetNextDefgeneric( void *theDefgeneric, void *targetDefgeneric) { SetNextConstruct((struct constructHeader *) theDefgeneric, (struct constructHeader *) targetDefgeneric); } /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvDefgenericModule( void *theEnv, void *theDefgeneric) { return GetConstructModuleName((struct constructHeader *) theDefgeneric); } globle const char *EnvGetDefgenericName( void *theEnv, void *theDefgeneric) { return GetConstructNameString((struct constructHeader *) theDefgeneric); } globle const char *EnvGetDefgenericPPForm( void *theEnv, void *theDefgeneric) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDefgeneric); } globle SYMBOL_HN *EnvGetDefgenericNamePointer( void *theEnv, void *theDefgeneric) { return GetConstructNamePointer((struct constructHeader *) theDefgeneric); } globle void EnvSetDefgenericPPForm( void *theEnv, void *theDefgeneric, const char *thePPForm) { SetConstructPPForm(theEnv,(struct constructHeader *) theDefgeneric,thePPForm); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void SetDefgenericPPForm( void *theDefgeneric, const char *thePPForm) { EnvSetDefgenericPPForm(GetCurrentEnvironment(),theDefgeneric,thePPForm); } globle const char *DefgenericModule( void *theDefgeneric) { return EnvDefgenericModule(GetCurrentEnvironment(),theDefgeneric); } globle void *FindDefgeneric( const char *genericModuleAndName) { return EnvFindDefgeneric(GetCurrentEnvironment(),genericModuleAndName); } globle void GetDefgenericList( DATA_OBJECT *returnValue, struct defmodule *theModule) { EnvGetDefgenericList(GetCurrentEnvironment(),returnValue,theModule); } globle const char *GetDefgenericName( void *theDefgeneric) { return EnvGetDefgenericName(GetCurrentEnvironment(),theDefgeneric); } globle const char *GetDefgenericPPForm( void *theDefgeneric) { return EnvGetDefgenericPPForm(GetCurrentEnvironment(),theDefgeneric); } globle void *GetNextDefgeneric( void *ptr) { return EnvGetNextDefgeneric(GetCurrentEnvironment(),ptr); } globle int IsDefgenericDeletable( void *ptr) { return EnvIsDefgenericDeletable(GetCurrentEnvironment(),ptr); } globle intBool Undefgeneric( void *vptr) { return EnvUndefgeneric(GetCurrentEnvironment(),vptr); } globle void GetDefmethodList( void *vgfunc, DATA_OBJECT_PTR returnValue) { EnvGetDefmethodList(GetCurrentEnvironment(),vgfunc,returnValue); } globle void GetMethodRestrictions( void *vgfunc, long mi, DATA_OBJECT *result) { EnvGetMethodRestrictions(GetCurrentEnvironment(),vgfunc,mi,result); } globle long GetNextDefmethod( void *ptr, long theIndex) { return EnvGetNextDefmethod(GetCurrentEnvironment(),ptr,theIndex); } globle int IsDefmethodDeletable( void *ptr, long theIndex) { return EnvIsDefmethodDeletable(GetCurrentEnvironment(),ptr,theIndex); } globle intBool Undefmethod( void *vptr, long mi) { return EnvUndefmethod(GetCurrentEnvironment(),vptr,mi); } #if DEBUGGING_FUNCTIONS globle unsigned GetDefgenericWatch( void *theGeneric) { return EnvGetDefgenericWatch(GetCurrentEnvironment(),theGeneric); } globle void ListDefgenerics( const char *logicalName, struct defmodule *theModule) { EnvListDefgenerics(GetCurrentEnvironment(),logicalName,theModule); } globle void SetDefgenericWatch( unsigned newState, void *theGeneric) { EnvSetDefgenericWatch(GetCurrentEnvironment(),newState,theGeneric); } globle const char *GetDefmethodPPForm( void *ptr, long theIndex) { return EnvGetDefmethodPPForm(GetCurrentEnvironment(),ptr,theIndex); } globle unsigned GetDefmethodWatch( void *theGeneric, long theIndex) { return EnvGetDefmethodWatch(GetCurrentEnvironment(),theGeneric,theIndex); } globle void ListDefmethods( const char *logicalName, void *vptr) { EnvListDefmethods(GetCurrentEnvironment(),logicalName,vptr); } globle void SetDefmethodWatch( unsigned newState, void *theGeneric, long theIndex) { EnvSetDefmethodWatch(GetCurrentEnvironment(),newState,theGeneric,theIndex); } #endif /* DEBUGGING_FUNCTIONS */ #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS globle void GetDefmethodDescription( char *buf, int buflen, void *ptr, long theIndex) { EnvGetDefmethodDescription(GetCurrentEnvironment(),buf,buflen,ptr,theIndex); } #endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFGENERIC_CONSTRUCT */ clips_core_source_630/core/._factmngr.h0000755000175000017500000000040712500146515016420 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/prccode.c0000755000175000017500000016407312373743665016047 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /**************************************************************/ /* Purpose: Procedural Code Support Routines for */ /* Deffunctions, Generic Function Methods, */ /* Message-Handlersand Rules */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Updated ENTITY_RECORD definitions to include */ /* additional NULL initializers. */ /* */ /* Added ReleaseProcParameters call. */ /* */ /* Added tracked memory calls. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #include #include #include "memalloc.h" #include "constant.h" #include "envrnmnt.h" #if DEFGLOBAL_CONSTRUCT #include "globlpsr.h" #endif #include "exprnpsr.h" #include "multifld.h" #if OBJECT_SYSTEM #include "object.h" #endif #include "prcdrpsr.h" #include "router.h" #include "utility.h" #define _PRCCODE_SOURCE_ #include "prccode.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct { unsigned firstFlag : 1; unsigned first : 15; unsigned secondFlag : 1; unsigned second : 15; } PACKED_PROC_VAR; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void EvaluateProcParameters(void *,EXPRESSION *,int,const char *,const char *); static intBool RtnProcParam(void *,void *,DATA_OBJECT *); static intBool GetProcBind(void *,void *,DATA_OBJECT *); static intBool PutProcBind(void *,void *,DATA_OBJECT *); static intBool RtnProcWild(void *,void *,DATA_OBJECT *); static void DeallocateProceduralPrimitiveData(void *); static void ReleaseProcParameters(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) static int FindProcParameter(SYMBOL_HN *,EXPRESSION *,SYMBOL_HN *); static int ReplaceProcBinds(void *,EXPRESSION *, int (*)(void *,EXPRESSION *,void *),void *); static EXPRESSION *CompactActions(void *,EXPRESSION *); #endif #if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT) static intBool EvaluateBadCall(void *,void *,DATA_OBJECT *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /**************************************************** NAME : InstallProcedurePrimitives DESCRIPTION : Installs primitive function handlers for accessing parameters and local variables within the bodies of message-handlers, methods, rules and deffunctions. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Primitive entities installed NOTES : None ****************************************************/ globle void InstallProcedurePrimitives( void *theEnv) { ENTITY_RECORD procParameterInfo = { "PROC_PARAM", PROC_PARAM,0,1,0,NULL,NULL,NULL, RtnProcParam,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }, procWildInfo = { "PROC_WILD_PARAM", PROC_WILD_PARAM,0,1,0,NULL,NULL,NULL, RtnProcWild,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }, procGetInfo = { "PROC_GET_BIND", PROC_GET_BIND,0,1,0,NULL,NULL,NULL, GetProcBind,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }, procBindInfo = { "PROC_BIND", PROC_BIND,0,1,0,NULL,NULL,NULL, PutProcBind,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; #if ! DEFFUNCTION_CONSTRUCT ENTITY_RECORD deffunctionEntityRecord = { "PCALL", PCALL,0,0,1, NULL,NULL,NULL, EvaluateBadCall, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; #endif #if ! DEFGENERIC_CONSTRUCT ENTITY_RECORD genericEntityRecord = { "GCALL", GCALL,0,0,1, NULL,NULL,NULL, EvaluateBadCall, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; #endif AllocateEnvironmentData(theEnv,PROCEDURAL_PRIMITIVE_DATA,sizeof(struct proceduralPrimitiveData),DeallocateProceduralPrimitiveData); memcpy(&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,&procParameterInfo,sizeof(struct entityRecord)); memcpy(&ProceduralPrimitiveData(theEnv)->ProcWildInfo,&procWildInfo,sizeof(struct entityRecord)); memcpy(&ProceduralPrimitiveData(theEnv)->ProcGetInfo,&procGetInfo,sizeof(struct entityRecord)); memcpy(&ProceduralPrimitiveData(theEnv)->ProcBindInfo,&procBindInfo,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,PROC_PARAM); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcWildInfo,PROC_WILD_PARAM); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcGetInfo,PROC_GET_BIND); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcBindInfo,PROC_BIND); ProceduralPrimitiveData(theEnv)->Oldindex = -1; /* =============================================== Make sure a default evaluation function is in place for deffunctions and generic functions in the event that a binary image containing these items is loaded into a configuration that does not support them. =============================================== */ #if ! DEFFUNCTION_CONSTRUCT memcpy(&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,PCALL); #endif #if ! DEFGENERIC_CONSTRUCT memcpy(&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,GCALL); #endif /* ============================================= Install the special empty multifield to let callers distinguish between no parameters and zero-length multifield parameters ============================================= */ ProceduralPrimitiveData(theEnv)->NoParamValue = CreateMultifield2(theEnv,0L); MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->NoParamValue); } /**************************************************************/ /* DeallocateProceduralPrimitiveData: Deallocates environment */ /* data for the procedural primitives functionality. */ /**************************************************************/ static void DeallocateProceduralPrimitiveData( void *theEnv) { ReturnMultifield(theEnv,(struct multifield *) ProceduralPrimitiveData(theEnv)->NoParamValue); ReleaseProcParameters(theEnv); } #if (! BLOAD_ONLY) && (! RUN_TIME) #if DEFFUNCTION_CONSTRUCT || OBJECT_SYSTEM /************************************************************ NAME : ParseProcParameters DESCRIPTION : Parses a parameter list for a procedural routine, such as a deffunction or message-handler INPUTS : 1) The logical name of the input 2) A buffer for scanned tokens 3) The partial list of parameters so far (can be NULL) 3) A buffer for a wildcard symbol (if any) 4) A buffer for a minimum of parameters 5) A buffer for a maximum of parameters (will be set to -1 if there is a wilcard) 6) A buffer for an error flag 7) The address of a function to do specialized checking on a parameter (can be NULL) The function should accept a string and return FALSE if the parameter is OK, TRUE otherwise. RETURNS : A list of expressions containing the parameter names SIDE EFFECTS : Parameters parsed and expressions formed NOTES : None ************************************************************/ globle EXPRESSION *ParseProcParameters( void *theEnv, const char *readSource, struct token *tkn, EXPRESSION *parameterList, SYMBOL_HN **wildcard, int *min, int *max, int *error, int (*checkfunc)(void *,const char *)) { EXPRESSION *nextOne,*lastOne,*check; int paramprintp = 0; *wildcard = NULL; *min = 0; *error = TRUE; lastOne = nextOne = parameterList; while (nextOne != NULL) { (*min)++; lastOne = nextOne; nextOne = nextOne->nextArg; } if (tkn->type != LPAREN) { SyntaxErrorMessage(theEnv,"parameter list"); ReturnExpression(theEnv,parameterList); return(NULL); } GetToken(theEnv,readSource,tkn); while ((tkn->type == SF_VARIABLE) || (tkn->type == MF_VARIABLE)) { for (check = parameterList ; check != NULL ; check = check->nextArg) if (check->value == tkn->value) { PrintErrorID(theEnv,"PRCCODE",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n"); ReturnExpression(theEnv,parameterList); return(NULL); } if (*wildcard != NULL) { PrintErrorID(theEnv,"PRCCODE",8,FALSE); EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n"); ReturnExpression(theEnv,parameterList); return(NULL); } if ((checkfunc != NULL) ? (*checkfunc)(theEnv,ValueToString(tkn->value)) : FALSE) { ReturnExpression(theEnv,parameterList); return(NULL); } nextOne = GenConstant(theEnv,tkn->type,tkn->value); if (tkn->type == MF_VARIABLE) *wildcard = (SYMBOL_HN *) tkn->value; else (*min)++; if (lastOne == NULL) { parameterList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; SavePPBuffer(theEnv," "); paramprintp = 1; GetToken(theEnv,readSource,tkn); } if (tkn->type != RPAREN) { SyntaxErrorMessage(theEnv,"parameter list"); ReturnExpression(theEnv,parameterList); return(NULL); } if (paramprintp) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } *error = FALSE; *max = (*wildcard != NULL) ? -1 : *min; return(parameterList); } #endif /************************************************************************* NAME : ParseProcActions DESCRIPTION : Parses the bodies of deffunctions, generic function methods and message-handlers. Replaces parameter and local variable references with appropriate runtime access functions INPUTS : 1) The type of procedure body being parsed 2) The logical name of the input 3) A buffer for scanned tokens 4) A list of expressions containing the names of the parameters 5) The wilcard parameter symbol (NULL if none) 6) A pointer to a function to parse variables not recognized by the standard parser The function should accept the variable expression and a generic pointer for special data (can be NULL) as arguments. If the variable is recognized, the function should modify the expression to access this variable. Return 1 if recognized, 0 if not, -1 on errors This argument can be NULL. 7) A pointer to a function to handle binds in a special way. The function should accept the bind function call expression as an argument. If the variable is recognized and treated specially, the function should modify the expression appropriately (including attaching/removing any necessary argument expressions). Return 1 if recognized, 0 if not, -1 on errors. This argument can be NULL. 8) A buffer for holding the number of local vars used by this procedure body. 9) Special user data buffer to pass to variable reference and bind replacement functions RETURNS : A packed expression containing the body, NULL on errors. SIDE EFFECTS : Variable references replaced with runtime calls to access the paramter and local variable array NOTES : None *************************************************************************/ globle EXPRESSION *ParseProcActions( void *theEnv, const char *bodytype, const char *readSource, struct token *tkn, EXPRESSION *params, SYMBOL_HN *wildcard, int (*altvarfunc)(void *,EXPRESSION *,void *), int (*altbindfunc)(void *,EXPRESSION *,void *), int *lvarcnt, void *userBuffer) { EXPRESSION *actions,*pactions; /* ==================================================================== Clear parsed bind list - so that only local vars from this body will be on it. The position of vars on thsi list are used to generate indices into the LocalVarArray at runtime. The parsing of the "bind" function adds vars to this list. ==================================================================== */ ClearParsedBindNames(theEnv); actions = GroupActions(theEnv,readSource,tkn,TRUE,NULL,FALSE); if (actions == NULL) return(NULL); /* ==================================================================== Replace any bind functions with special functions before replacing any variable references. This allows those bind names to be removed before they can be seen by variable replacement and thus generate incorrect indices. ==================================================================== */ if (altbindfunc != NULL) { if (ReplaceProcBinds(theEnv,actions,altbindfunc,userBuffer)) { ClearParsedBindNames(theEnv); ReturnExpression(theEnv,actions); return(NULL); } } /* ====================================================================== The number of names left on the bind list is the number of local vars for this procedure body. Replace all variable reference with runtime access functions for ProcParamArray, LocalVarArray or other special items, such as direct slot references, global variables, or fact field references. ====================================================================== */ *lvarcnt = CountParsedBindNames(theEnv); if (ReplaceProcVars(theEnv,bodytype,actions,params,wildcard,altvarfunc,userBuffer)) { ClearParsedBindNames(theEnv); ReturnExpression(theEnv,actions); return(NULL); } /* ======================================================================= Normally, actions are grouped in a progn. If there is only one action, the progn is unnecessary and can be removed. Also, the actions are packed into a contiguous array to save on memory overhead. The intermediate parsed bind names are freed to avoid tying up memory. ======================================================================= */ actions = CompactActions(theEnv,actions); pactions = PackExpression(theEnv,actions); ReturnExpression(theEnv,actions); ClearParsedBindNames(theEnv); return(pactions); } /************************************************************************* NAME : ReplaceProcVars DESCRIPTION : Examines an expression for variables and replaces any that correspond to procedure parameters or globals with function calls that get these variables' values at run-time. For example, procedure arguments are stored an array at run-time, so at parse-time, parameter-references are replaced with function calls referencing this array at the appropriate position. INPUTS : 1) The type of procedure being parsed 2) The expression-actions to be examined 3) The parameter list 4) The wildcard parameter symbol (NULL if none) 5) A pointer to a function to parse variables not recognized by the standard parser The function should accept the variable expression and a generic pointer for special data (can be NULL) as arguments. If the variable is recognized, the function should modify the expression to access this variable. Return 1 if recognized, 0 if not, -1 on errors This argument can be NULL. 6) Data buffer to be passed to alternate parsing function RETURNS : FALSE if OK, TRUE on errors SIDE EFFECTS : Variable references replaced with function calls NOTES : This function works from the ParsedBindNames list in SPCLFORM.C to access local binds. Make sure that the list accurately reflects the binds by calling ClearParsedBindNames(theEnv) before the parse of the body in which variables are being replaced. *************************************************************************/ globle int ReplaceProcVars( void *theEnv, const char *bodytype, EXPRESSION *actions, EXPRESSION *parameterList, SYMBOL_HN *wildcard, int (*altvarfunc)(void *,EXPRESSION *,void *), void *specdata) { int position,altcode; intBool boundPosn; EXPRESSION *arg_lvl,*altvarexp; SYMBOL_HN *bindName; PACKED_PROC_VAR pvar; while (actions != NULL) { if (actions->type == SF_VARIABLE) { /*===============================================*/ /* See if the variable is in the parameter list. */ /*===============================================*/ bindName = (SYMBOL_HN *) actions->value; position = FindProcParameter(bindName,parameterList,wildcard); /*=============================================================*/ /* Check to see if the variable is bound within the procedure. */ /*=============================================================*/ boundPosn = SearchParsedBindNames(theEnv,bindName); /*=============================================*/ /* If variable is not defined in the parameter */ /* list or as part of a bind action then... */ /*=============================================*/ if ((position == 0) && (boundPosn == 0)) { /*================================================================*/ /* Check to see if the variable has a special access function, */ /* such as direct slot reference or a rule RHS pattern reference. */ /*================================================================*/ if ((altvarfunc != NULL) ? ((*altvarfunc)(theEnv,actions,specdata) != 1) : TRUE) { PrintErrorID(theEnv,"PRCCODE",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Undefined variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(bindName)); EnvPrintRouter(theEnv,WERROR," referenced in "); EnvPrintRouter(theEnv,WERROR,bodytype); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } } /*===================================================*/ /* Else if variable is defined in the parameter list */ /* and not rebound within the procedure then... */ /*===================================================*/ else if ((position > 0) && (boundPosn == 0)) { actions->type = (unsigned short) ((bindName != wildcard) ? PROC_PARAM : PROC_WILD_PARAM); actions->value = EnvAddBitMap(theEnv,(void *) &position,(int) sizeof(int)); } /*=========================================================*/ /* Else the variable is rebound within the procedure so... */ /*=========================================================*/ else { if (altvarfunc != NULL) { altvarexp = GenConstant(theEnv,actions->type,actions->value); altcode = (*altvarfunc)(theEnv,altvarexp,specdata); if (altcode == 0) { rtn_struct(theEnv,expr,altvarexp); altvarexp = NULL; } else if (altcode == -1) { rtn_struct(theEnv,expr,altvarexp); return(TRUE); } } else altvarexp = NULL; actions->type = PROC_GET_BIND; ClearBitString((void *) &pvar,(int) sizeof(PACKED_PROC_VAR)); pvar.first = boundPosn; pvar.second = position; pvar.secondFlag = (bindName != wildcard) ? 0 : 1; actions->value = EnvAddBitMap(theEnv,(void *) &pvar,(int) sizeof(PACKED_PROC_VAR)); actions->argList = GenConstant(theEnv,SYMBOL,(void *) bindName); actions->argList->nextArg = altvarexp; } } #if DEFGLOBAL_CONSTRUCT else if (actions->type == GBL_VARIABLE) { if (ReplaceGlobalVariable(theEnv,actions) == FALSE) return(-1); } #endif if ((altvarfunc != NULL) ? ((*altvarfunc)(theEnv,actions,specdata) == -1) : FALSE) return(TRUE); if (actions->argList != NULL) { if (ReplaceProcVars(theEnv,bodytype,actions->argList,parameterList, wildcard,altvarfunc,specdata)) return(TRUE); /* ==================================================================== Check to see if this is a call to the bind function. If so (and the second argument is a symbol) then it is a locally bound variable (as opposed to a global). Replace the call to "bind" with a call to PROC_BIND - the special internal function for procedure local variables. ==================================================================== */ if ((actions->value == (void *) FindFunction(theEnv,"bind")) && (actions->argList->type == SYMBOL)) { actions->type = PROC_BIND; boundPosn = SearchParsedBindNames(theEnv,(SYMBOL_HN *) actions->argList->value); actions->value = EnvAddBitMap(theEnv,(void *) &boundPosn,(int) sizeof(intBool)); arg_lvl = actions->argList->nextArg; rtn_struct(theEnv,expr,actions->argList); actions->argList = arg_lvl; } } actions = actions->nextArg; } return(FALSE); } #if DEFGENERIC_CONSTRUCT /***************************************************** NAME : GenProcWildcardReference DESCRIPTION : Returns an expression to access the wildcard parameter for a method INPUTS : The starting index of the wildcard RETURNS : An expression containing the wildcard reference SIDE EFFECTS : Expression allocated NOTES : None *****************************************************/ globle EXPRESSION *GenProcWildcardReference( void *theEnv, int theIndex) { return(GenConstant(theEnv,PROC_WILD_PARAM,EnvAddBitMap(theEnv,(void *) &theIndex,(int) sizeof(int)))); } #endif #endif /******************************************************************* NAME : PushProcParameters DESCRIPTION : Given a list of parameter expressions, this function evaluates each expression and stores the results in a contiguous array of DATA_OBJECTS. Used in creating a new ProcParamArray for the execution of a procedure The current arrays are saved on a stack. INPUTS : 1) The paramter expression list 2) The number of parameters in the list 3) The name of the procedure for which these parameters are being evaluated 4) The type of procedure 5) A pointer to a function to print out a trace message about the currently executing procedure when unbound variables are detected at runtime (The function should take no arguments and have no return value. The function should print its synopsis to WERROR and include the final carriage-return.) RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of the evaluation of the parameter expressions DATA_OBJECT array allocated (deallocated on errors) ProcParamArray set NOTES : EvaluationError set on errors *******************************************************************/ globle void PushProcParameters( void *theEnv, EXPRESSION *parameterList, int numberOfParameters, const char *pname, const char *bodytype, void (*UnboundErrFunc)(void *)) { register PROC_PARAM_STACK *ptmp; ptmp = get_struct(theEnv,ProcParamStack); ptmp->ParamArray = ProceduralPrimitiveData(theEnv)->ProcParamArray; ptmp->ParamArraySize = ProceduralPrimitiveData(theEnv)->ProcParamArraySize; ptmp->UnboundErrFunc = ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc; ptmp->nxt = ProceduralPrimitiveData(theEnv)->pstack; ProceduralPrimitiveData(theEnv)->pstack = ptmp; EvaluateProcParameters(theEnv,parameterList,numberOfParameters,pname,bodytype); if (EvaluationData(theEnv)->EvaluationError) { ptmp = ProceduralPrimitiveData(theEnv)->pstack; ProceduralPrimitiveData(theEnv)->pstack = ProceduralPrimitiveData(theEnv)->pstack->nxt; rtn_struct(theEnv,ProcParamStack,ptmp); return; } /* ================================================================ Record ProcParamExpressions and WildcardValue for previous frame AFTER evaluating arguments for the new frame, because they could have gone from NULL to non-NULL (if they were already non-NULL, they would remain unchanged.) ================================================================ */ #if DEFGENERIC_CONSTRUCT ptmp->ParamExpressions = ProceduralPrimitiveData(theEnv)->ProcParamExpressions; ProceduralPrimitiveData(theEnv)->ProcParamExpressions = NULL; #endif ptmp->WildcardValue = ProceduralPrimitiveData(theEnv)->WildcardValue; ProceduralPrimitiveData(theEnv)->WildcardValue = NULL; ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc = UnboundErrFunc; } /****************************************************************** NAME : PopProcParameters DESCRIPTION : Restores old procedure arrays INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack popped and globals restored NOTES : Assumes pstack != NULL ******************************************************************/ globle void PopProcParameters( void *theEnv) { register PROC_PARAM_STACK *ptmp; if (ProceduralPrimitiveData(theEnv)->ProcParamArray != NULL) rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamArray,(sizeof(DATA_OBJECT) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); #if DEFGENERIC_CONSTRUCT if (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL) rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamExpressions,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); #endif ptmp = ProceduralPrimitiveData(theEnv)->pstack; ProceduralPrimitiveData(theEnv)->pstack = ProceduralPrimitiveData(theEnv)->pstack->nxt; ProceduralPrimitiveData(theEnv)->ProcParamArray = ptmp->ParamArray; ProceduralPrimitiveData(theEnv)->ProcParamArraySize = ptmp->ParamArraySize; #if DEFGENERIC_CONSTRUCT ProceduralPrimitiveData(theEnv)->ProcParamExpressions = ptmp->ParamExpressions; #endif if (ProceduralPrimitiveData(theEnv)->WildcardValue != NULL) { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue); } ProceduralPrimitiveData(theEnv)->WildcardValue = ptmp->WildcardValue; ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc = ptmp->UnboundErrFunc; rtn_struct(theEnv,ProcParamStack,ptmp); } /****************************************************************** NAME : ReleaseProcParameters DESCRIPTION : Restores old procedure arrays INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack popped and globals restored NOTES : Assumes pstack != NULL ******************************************************************/ static void ReleaseProcParameters( void *theEnv) { register PROC_PARAM_STACK *ptmp, *next; if (ProceduralPrimitiveData(theEnv)->ProcParamArray != NULL) rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamArray,(sizeof(DATA_OBJECT) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); if (ProceduralPrimitiveData(theEnv)->WildcardValue != NULL) { if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) { ReturnMultifield(theEnv,(struct multifield *) ProceduralPrimitiveData(theEnv)->WildcardValue->value); } rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue); } #if DEFGENERIC_CONSTRUCT if (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL) rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamExpressions,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); #endif ptmp = ProceduralPrimitiveData(theEnv)->pstack; while (ptmp != NULL) { next = ptmp->nxt; if (ptmp->ParamArray != NULL) { rm(theEnv,(void *) ptmp->ParamArray,(sizeof(DATA_OBJECT) * ptmp->ParamArraySize)); } #if DEFGENERIC_CONSTRUCT if (ptmp->ParamExpressions != NULL) { rm(theEnv,(void *) ptmp->ParamExpressions,(sizeof(EXPRESSION) * ptmp->ParamArraySize)); } #endif if (ptmp->WildcardValue != NULL) { if (ptmp->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) { ReturnMultifield(theEnv,(struct multifield *) ptmp->WildcardValue->value); } rtn_struct(theEnv,dataObject,ptmp->WildcardValue); } rtn_struct(theEnv,ProcParamStack,ptmp); ptmp = next; } } #if DEFGENERIC_CONSTRUCT /*********************************************************** NAME : GetProcParamExpressions DESCRIPTION : Forms an array of expressions equivalent to the current procedure paramter array. Used to conveniently attach these parameters as arguments to a H/L system function call (used by the generic dispatch). INPUTS : None RETURNS : A pointer to an array of expressions SIDE EFFECTS : Expression array created NOTES : None ***********************************************************/ globle EXPRESSION *GetProcParamExpressions( void *theEnv) { register int i; if ((ProceduralPrimitiveData(theEnv)->ProcParamArray == NULL) || (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL)) return(ProceduralPrimitiveData(theEnv)->ProcParamExpressions); ProceduralPrimitiveData(theEnv)->ProcParamExpressions = (EXPRESSION *) gm2(theEnv,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); for (i = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type; if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type != MULTIFIELD) ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].value = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].value; else ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].value = (void *) &ProceduralPrimitiveData(theEnv)->ProcParamArray[i]; ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].argList = NULL; ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].nextArg = ((i + 1) != ProceduralPrimitiveData(theEnv)->ProcParamArraySize) ? &ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i+1] : NULL; } return(ProceduralPrimitiveData(theEnv)->ProcParamExpressions); } #endif /*********************************************************** NAME : EvaluateProcActions DESCRIPTION : Evaluates the actions of a deffunction, generic function method or message-handler. INPUTS : 1) The module where the actions should be executed 2) The actions (linked by nextArg fields) 3) The number of local variables to reserve space for. 4) A buffer to hold the result of evaluating the actions. 5) A function which prints out the name of the currently executing body for error messages (can be NULL). RETURNS : Nothing useful SIDE EFFECTS : Allocates and deallocates space for local variable array. NOTES : None ***********************************************************/ globle void EvaluateProcActions( void *theEnv, struct defmodule *theModule, EXPRESSION *actions, int lvarcnt, DATA_OBJECT *result, void (*crtproc)(void *)) { DATA_OBJECT *oldLocalVarArray; register int i; struct defmodule *oldModule; EXPRESSION *oldActions; struct trackedMemory *theTM; oldLocalVarArray = ProceduralPrimitiveData(theEnv)->LocalVarArray; ProceduralPrimitiveData(theEnv)->LocalVarArray = (lvarcnt == 0) ? NULL : (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * lvarcnt)); if (lvarcnt != 0) { theTM = AddTrackedMemory(theEnv,ProceduralPrimitiveData(theEnv)->LocalVarArray,sizeof(DATA_OBJECT) * lvarcnt); } else { theTM = NULL; } for (i = 0 ; i < lvarcnt ; i++) ProceduralPrimitiveData(theEnv)->LocalVarArray[i].supplementalInfo = EnvFalseSymbol(theEnv); oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (oldModule != theModule) EnvSetCurrentModule(theEnv,(void *) theModule); oldActions = ProceduralPrimitiveData(theEnv)->CurrentProcActions; ProceduralPrimitiveData(theEnv)->CurrentProcActions = actions; if (EvaluateExpression(theEnv,actions,result)) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } ProceduralPrimitiveData(theEnv)->CurrentProcActions = oldActions; if (oldModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) EnvSetCurrentModule(theEnv,(void *) oldModule); if ((crtproc != NULL) ? EvaluationData(theEnv)->HaltExecution : FALSE) { PrintErrorID(theEnv,"PRCCODE",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of "); (*crtproc)(theEnv); } if ((ProceduralPrimitiveData(theEnv)->WildcardValue != NULL) ? (result->value == ProceduralPrimitiveData(theEnv)->WildcardValue->value) : FALSE) { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue); ProceduralPrimitiveData(theEnv)->WildcardValue = NULL; } if (lvarcnt != 0) { RemoveTrackedMemory(theEnv,theTM); for (i = 0 ; i < lvarcnt ; i++) if (ProceduralPrimitiveData(theEnv)->LocalVarArray[i].supplementalInfo == EnvTrueSymbol(theEnv)) ValueDeinstall(theEnv,&ProceduralPrimitiveData(theEnv)->LocalVarArray[i]); rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->LocalVarArray,(sizeof(DATA_OBJECT) * lvarcnt)); } ProceduralPrimitiveData(theEnv)->LocalVarArray = oldLocalVarArray; } /**************************************************** NAME : PrintProcParamArray DESCRIPTION : Displays the contents of the current procedure parameter array INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ****************************************************/ globle void PrintProcParamArray( void *theEnv, const char *logName) { register int i; EnvPrintRouter(theEnv,logName," ("); for (i = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { PrintDataObject(theEnv,logName,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]); if (i != ProceduralPrimitiveData(theEnv)->ProcParamArraySize-1) EnvPrintRouter(theEnv,logName," "); } EnvPrintRouter(theEnv,logName,")\n"); } /**************************************************************** NAME : GrabProcWildargs DESCRIPTION : Groups a portion of the ProcParamArray into a multi-field variable INPUTS : 1) Starting index in ProcParamArray for grouping of arguments into multi-field variable 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Multi-field variable allocated and set with corresponding values of ProcParamArray NOTES : Multi-field is NOT on list of ephemeral segments ****************************************************************/ globle void GrabProcWildargs( void *theEnv, DATA_OBJECT *result, int theIndex) { register int i,j; long k; /* 6.04 Bug Fix */ long size; DATA_OBJECT *val; result->type = MULTIFIELD; result->begin = 0; if (ProceduralPrimitiveData(theEnv)->WildcardValue == NULL) { ProceduralPrimitiveData(theEnv)->WildcardValue = get_struct(theEnv,dataObject); ProceduralPrimitiveData(theEnv)->WildcardValue->begin = 0; } else if (theIndex == ProceduralPrimitiveData(theEnv)->Oldindex) { result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end; result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value; return; } else { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); } ProceduralPrimitiveData(theEnv)->Oldindex = theIndex; size = ProceduralPrimitiveData(theEnv)->ProcParamArraySize - theIndex + 1; if (size <= 0) { result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end = -1; result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value = ProceduralPrimitiveData(theEnv)->NoParamValue; MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); return; } for (i = theIndex-1 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == MULTIFIELD) size += ProceduralPrimitiveData(theEnv)->ProcParamArray[i].end - ProceduralPrimitiveData(theEnv)->ProcParamArray[i].begin; } result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end = size-1; result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value = (void *) CreateMultifield2(theEnv,(unsigned long) size); for (i = theIndex-1 , j = 1 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type != MULTIFIELD) { SetMFType(result->value,j,(short) ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type); SetMFValue(result->value,j,ProceduralPrimitiveData(theEnv)->ProcParamArray[i].value); j++; } else { val = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i]; for (k = val->begin + 1 ; k <= val->end + 1 ; k++ , j++) { SetMFType(result->value,j,GetMFType(val->value,k)); SetMFValue(result->value,j,GetMFValue(val->value,k)); } } } MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************************* NAME : EvaluateProcParameters DESCRIPTION : Given a list of parameter expressions, this function evaluates each expression and stores the results in a contiguous array of DATA_OBJECTS. Used in creating a new ProcParamArray for the execution of a procedure INPUTS : 1) The paramter expression list 2) The number of parameters in the list 3) The name of the procedure for which these parameters are being evaluated 4) The type of procedure RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of the evaluation of the parameter expressions DATA_OBJECT array allocated (deallocated on errors) ProcParamArray set NOTES : EvaluationError set on errors *******************************************************************/ static void EvaluateProcParameters( void *theEnv, EXPRESSION *parameterList, int numberOfParameters, const char *pname, const char *bodytype) { DATA_OBJECT *rva,temp; int i = 0; if (numberOfParameters == 0) { ProceduralPrimitiveData(theEnv)->ProcParamArray = NULL; ProceduralPrimitiveData(theEnv)->ProcParamArraySize = 0; return; } rva = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * numberOfParameters)); while (parameterList != NULL) { if ((EvaluateExpression(theEnv,parameterList,&temp) == TRUE) ? TRUE : (temp.type == RVOID)) { if (temp.type == RVOID) { PrintErrorID(theEnv,"PRCCODE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Functions without a return value are illegal as "); EnvPrintRouter(theEnv,WERROR,bodytype); EnvPrintRouter(theEnv,WERROR," arguments.\n"); SetEvaluationError(theEnv,TRUE); } PrintErrorID(theEnv,"PRCCODE",6,FALSE); EnvPrintRouter(theEnv,WERROR,"This error occurred while evaluating arguments "); EnvPrintRouter(theEnv,WERROR,"for the "); EnvPrintRouter(theEnv,WERROR,bodytype); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,pname); EnvPrintRouter(theEnv,WERROR,".\n"); rm(theEnv,(void *) rva,(sizeof(DATA_OBJECT) * numberOfParameters)); return; } rva[i].type = temp.type; rva[i].value = temp.value; rva[i].begin = temp.begin; rva[i].end = temp.end; parameterList = parameterList->nextArg; i++; } ProceduralPrimitiveData(theEnv)->ProcParamArraySize = numberOfParameters; ProceduralPrimitiveData(theEnv)->ProcParamArray = rva; } /*************************************************** NAME : RtnProcParam DESCRIPTION : Internal function for getting the value of an argument passed to a procedure INPUTS : 1) Expression to evaluate (PROC_PARAM index) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer set to specified node of ProcParamArray NOTES : None ***************************************************/ static intBool RtnProcParam( void *theEnv, void *value, DATA_OBJECT *result) { register DATA_OBJECT *src; src = &ProceduralPrimitiveData(theEnv)->ProcParamArray[*((int *) ValueToBitMap(value)) - 1]; result->type = src->type; result->value = src->value; result->begin = src->begin; result->end = src->end; return(TRUE); } /************************************************************** NAME : GetProcBind DESCRIPTION : Internal function for looking up the values of parameters or bound variables within procedures INPUTS : 1) Expression to evaluate (PROC_GET_BIND index) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer set to parameter value in ProcParamArray or the value in LocalVarArray NOTES : None **************************************************************/ static intBool GetProcBind( void *theEnv, void *value, DATA_OBJECT *result) { register DATA_OBJECT *src; PACKED_PROC_VAR *pvar; pvar = (PACKED_PROC_VAR *) ValueToBitMap(value); src = &ProceduralPrimitiveData(theEnv)->LocalVarArray[pvar->first - 1]; if (src->supplementalInfo == EnvTrueSymbol(theEnv)) { result->type = src->type; result->value = src->value; result->begin = src->begin; result->end = src->end; return(TRUE); } if (GetFirstArgument()->nextArg != NULL) { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,result); return(TRUE); } if (pvar->second == 0) { PrintErrorID(theEnv,"PRCCODE",5,FALSE); SetEvaluationError(theEnv,TRUE); EnvPrintRouter(theEnv,WERROR,"Variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(GetFirstArgument()->value)); if (ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc != NULL) { EnvPrintRouter(theEnv,WERROR," unbound in "); (*ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc)(theEnv); } else EnvPrintRouter(theEnv,WERROR," unbound.\n"); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return(TRUE); } if (pvar->secondFlag == 0) { src = &ProceduralPrimitiveData(theEnv)->ProcParamArray[pvar->second - 1]; result->type = src->type; result->value = src->value; result->begin = src->begin; result->end = src->end; } else GrabProcWildargs(theEnv,result,(int) pvar->second); return(TRUE); } /************************************************************** NAME : PutProcBind DESCRIPTION : Internal function for setting the values of of locally bound variables within procedures INPUTS : 1) Expression to evaluate (PROC_PARAM index) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Bound variable in LocalVarArray set to value in caller's buffer. NOTES : None **************************************************************/ static intBool PutProcBind( void *theEnv, void *value, DATA_OBJECT *result) { register DATA_OBJECT *dst; dst = &ProceduralPrimitiveData(theEnv)->LocalVarArray[*((int *) ValueToBitMap(value)) - 1]; if (GetFirstArgument() == NULL) { if (dst->supplementalInfo == EnvTrueSymbol(theEnv)) ValueDeinstall(theEnv,dst); dst->supplementalInfo = EnvFalseSymbol(theEnv); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } else { if (GetFirstArgument()->nextArg != NULL) StoreInMultifield(theEnv,result,GetFirstArgument(),TRUE); else EvaluateExpression(theEnv,GetFirstArgument(),result); if (dst->supplementalInfo == EnvTrueSymbol(theEnv)) ValueDeinstall(theEnv,dst); dst->supplementalInfo = EnvTrueSymbol(theEnv); dst->type = result->type; dst->value = result->value; dst->begin = result->begin; dst->end = result->end; ValueInstall(theEnv,dst); } return(TRUE); } /**************************************************************** NAME : RtnProcWild DESCRIPTION : Groups a portion of the ProcParamArray into a multi-field variable INPUTS : 1) Starting index in ProcParamArray for grouping of arguments into multi-field variable (expression value) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Multi-field variable allocated and set with corresponding values of ProcParamArray NOTES : Multi-field is NOT on list of ephemeral segments ****************************************************************/ static intBool RtnProcWild( void *theEnv, void *value, DATA_OBJECT *result) { GrabProcWildargs(theEnv,result,*(int *) ValueToBitMap(value)); return(TRUE); } #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : FindProcParameter DESCRIPTION : Determines the relative position in an n-element list of a certain parameter. The index is 1..n. INPUTS : 1) Parameter name 2) Parameter list 3) Wildcard symbol (NULL if none) RETURNS : Index of parameter in list, 0 if not found SIDE EFFECTS : None NOTES : None ***************************************************/ static int FindProcParameter( SYMBOL_HN *name, EXPRESSION *parameterList, SYMBOL_HN *wildcard) { int i = 1; while (parameterList != NULL) { if (parameterList->value == (void *) name) return(i); i++; parameterList = parameterList->nextArg; } /* =================================================================== Wildcard may not be stored in actual list but know is always at end =================================================================== */ if (name == wildcard) return(i); return(0); } /************************************************************************* NAME : ReplaceProcBinds DESCRIPTION : Examines an expression and replaces calls to the "bind" function which are specially recognized For example, in a message-handler, (bind ?self ) would be illegal and (bind ?self: ) would be replaced with (put ) INPUTS : 1) The actions in which to replace special binds 2) A pointer to a function to handle binds in a special way. The function should accept the bind function call expression and a specialized data buffer (can be NULL) as arguments. If the variable is recognized and treated specially, the function should modify the expression appropriately (including attaching/removing any necessary argument expressions). Return 1 if recognized, 0 if not, -1 on errors. This argument CANNOT be NULL. 3) Specialized user data buffer RETURNS : FALSE if OK, TRUE on errors SIDE EFFECTS : Some binds replaced with specialized calls NOTES : Local variable binds are replaced in ReplaceProcVars (after this routine has had a chance to replace all special binds and remove the names from the parsed bind list) *************************************************************************/ static int ReplaceProcBinds( void *theEnv, EXPRESSION *actions, int (*altbindfunc)(void *,EXPRESSION *,void *), void *userBuffer) { int bcode; SYMBOL_HN *bname; while (actions != NULL) { if (actions->argList != NULL) { if (ReplaceProcBinds(theEnv,actions->argList,altbindfunc,userBuffer)) return(TRUE); if ((actions->value == (void *) FindFunction(theEnv,"bind")) && (actions->argList->type == SYMBOL)) { bname = (SYMBOL_HN *) actions->argList->value; bcode = (*altbindfunc)(theEnv,actions,userBuffer); if (bcode == -1) return(TRUE); if (bcode == 1) RemoveParsedBindName(theEnv,bname); } } actions = actions->nextArg; } return(FALSE); } /***************************************************** NAME : CompactActions DESCRIPTION : Examines a progn expression chain, and if there is only one action, the progn header is deallocated and the action is returned. If there are no actions, the progn expression is modified to be the FALSE symbol and returned. Otherwise, the progn is simply returned. INPUTS : The action expression RETURNS : The compacted expression SIDE EFFECTS : Some expressions possibly deallocated NOTES : Assumes actions is a progn expression and actions->nextArg == NULL *****************************************************/ static EXPRESSION *CompactActions( void *theEnv, EXPRESSION *actions) { register struct expr *tmp; if (actions->argList == NULL) { actions->type = SYMBOL; actions->value = EnvFalseSymbol(theEnv); } else if (actions->argList->nextArg == NULL) { tmp = actions; actions = actions->argList; rtn_struct(theEnv,expr,tmp); } return(actions); } #endif #if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT) /****************************************************** NAME : EvaluateBadCall DESCRIPTION : Default evaluation function for deffunctions and gneric functions in configurations where either capability is not present. INPUTS : 1) The function (ignored) 2) A data object buffer for the result RETURNS : FALSE SIDE EFFECTS : Data object buffer set to the symbol FALSE and evaluation error set NOTES : Used for binary images which contain deffunctions and generic functions which cannot be used ******************************************************/ static intBool EvaluateBadCall( void *theEnv, void *value, DATA_OBJECT *result) { #if MAC_XCD #pragma unused(value) #endif PrintErrorID(theEnv,"PRCCODE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Attempted to call a deffunction/generic function "); EnvPrintRouter(theEnv,WERROR,"which does not exist.\n"); SetEvaluationError(theEnv,TRUE); SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return(FALSE); } #endif clips_core_source_630/core/._modulbin.h0000755000175000017500000000040712373756454016451 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._filecom.c0000755000175000017500000000040712461762345016243 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/facthsh.h0000755000175000017500000000613712373742654016046 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT HASHING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Fact hash table is resizable. */ /* */ /* Changed integer type/precision. */ /* */ /* Added FactWillBeAsserted. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_facthsh #define _H_facthsh struct factHashEntry; #ifndef _H_factmngr #include "factmngr.h" #endif struct factHashEntry { struct fact *theFact; struct factHashEntry *next; }; #define SIZE_FACT_HASH 16231 #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTHSH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void AddHashedFact(void *,struct fact *,unsigned long); LOCALE intBool RemoveHashedFact(void *,struct fact *); LOCALE unsigned long HandleFactDuplication(void *,void *,intBool *); LOCALE intBool EnvGetFactDuplication(void *); LOCALE intBool EnvSetFactDuplication(void *,int); LOCALE void InitializeFactHashTable(void *); LOCALE void ShowFactHashTable(void *); LOCALE unsigned long HashFact(struct fact *); LOCALE intBool FactWillBeAsserted(void *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool GetFactDuplication(void); LOCALE intBool SetFactDuplication(int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_facthsh */ clips_core_source_630/core/._exprnops.h0000755000175000017500000000040712373740001016473 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltbin.h0000755000175000017500000000623012373754242016245 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for deftemplate slot facets. */ /* */ /*************************************************************/ #if (! RUN_TIME) #ifndef _H_tmpltbin #define _H_tmpltbin struct bsaveTemplateSlot { unsigned long slotName; unsigned int multislot : 1; unsigned int noDefault : 1; unsigned int defaultPresent : 1; unsigned int defaultDynamic : 1; long constraints; long defaultList; long facetList; long next; }; struct bsaveDeftemplate; struct bsaveDeftemplateModule; #include "cstrcbin.h" struct bsaveDeftemplate { struct bsaveConstructHeader header; long slotList; unsigned int implied : 1; unsigned int numberOfSlots : 15; long patternNetwork; }; #include "modulbin.h" struct bsaveDeftemplateModule { struct bsaveDefmoduleItemHeader header; }; #define TMPLTBIN_DATA 61 struct deftemplateBinaryData { struct deftemplate *DeftemplateArray; long NumberOfDeftemplates; long NumberOfTemplateSlots; long NumberOfTemplateModules; struct templateSlot *SlotArray; struct deftemplateModule *ModuleArray; }; #define DeftemplateBinaryData(theEnv) ((struct deftemplateBinaryData *) GetEnvironmentData(theEnv,TMPLTBIN_DATA)) #define DeftemplatePointer(i) ((struct deftemplate *) (&DeftemplateBinaryData(theEnv)->DeftemplateArray[i])) #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeftemplateBinarySetup(void *); LOCALE void *BloadDeftemplateModuleReference(void *,int); #endif /* _H_tmpltbin */ #endif /* (! RUN_TIME) */ clips_core_source_630/core/._globlpsr.c0000755000175000017500000000040712373753361016451 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._textpro.h0000755000175000017500000000040712373754246016342 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._expressn.c0000755000175000017500000000040712373740007016465 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrcpsr.c0000755000175000017500000011227212373714226016254 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRUCT PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing routines and utilities for parsing */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Made the construct redefinition message more */ /* prominent. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Added code for capturing errors/warnings. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, MAC_MCW, */ /* and IBM_TBC). */ /* */ /* Changed garbage collection algorithm. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #define _CSTRCPSR_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include #include #include "envrnmnt.h" #include "router.h" #include "watch.h" #include "constrct.h" #include "prcdrpsr.h" #include "exprnpsr.h" #include "memalloc.h" #include "modulutl.h" #include "modulpsr.h" #include "sysdep.h" #include "utility.h" #include "cstrcpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int FindConstructBeginning(void *,const char *,struct token *,int,int *); /************************************************/ /* Load: C access routine for the load command. */ /************************************************/ #if ALLOW_ENVIRONMENT_GLOBALS globle int Load( const char *fileName) { return EnvLoad(GetCurrentEnvironment(),fileName); } #endif /************************************************************/ /* EnvLoad: C access routine for the load command. Returns */ /* 0 if the file couldn't be opened, -1 if the file was */ /* opened but an error occurred while loading constructs, */ /* and 1 if the file was opened and no errors occured */ /* while loading. */ /************************************************************/ globle int EnvLoad( void *theEnv, const char *fileName) { FILE *theFile; char *oldParsingFileName; int noErrorsDetected; /*=======================================*/ /* Open the file specified by file name. */ /*=======================================*/ if ((theFile = GenOpen(theEnv,fileName,"r")) == NULL) return(0); /*===================================================*/ /* Read in the constructs. Enabling fast load allows */ /* the router system to be bypassed for quicker load */ /* times. */ /*===================================================*/ SetFastLoad(theEnv,theFile); oldParsingFileName = CopyString(theEnv,EnvGetParsingFileName(theEnv)); EnvSetParsingFileName(theEnv,fileName); noErrorsDetected = LoadConstructsFromLogicalName(theEnv,(char *) theFile); EnvSetParsingFileName(theEnv,oldParsingFileName); DeleteString(theEnv,oldParsingFileName); SetFastLoad(theEnv,NULL); /*=================*/ /* Close the file. */ /*=================*/ GenClose(theEnv,theFile); /*========================================*/ /* If no errors occurred during the load, */ /* return 1, otherwise return -1. */ /*========================================*/ if (noErrorsDetected) return(1); return(-1); } /*******************************************************/ /* EnvSetParsingFileName: Sets the file name currently */ /* being parsed by the load/batch command. */ /*******************************************************/ globle void EnvSetParsingFileName( void *theEnv, const char *fileName) { char *fileNameCopy = NULL; if (ConstructData(theEnv)->ParserErrorCallback == NULL) return; if (fileName != NULL) { fileNameCopy = (char *) genalloc(theEnv,strlen(fileName) + 1); genstrcpy(fileNameCopy,fileName); } if (ConstructData(theEnv)->ParsingFileName != NULL) { genfree(theEnv,ConstructData(theEnv)->ParsingFileName,strlen(ConstructData(theEnv)->ParsingFileName) + 1); } ConstructData(theEnv)->ParsingFileName = fileNameCopy; } /**********************************************************/ /* EnvGetParsingFileName: Returns the file name currently */ /* being parsed by the load/batch command. */ /**********************************************************/ globle char *EnvGetParsingFileName( void *theEnv) { return ConstructData(theEnv)->ParsingFileName; } /**********************************************/ /* EnvSetErrorFileName: Sets the file name */ /* associated with the last error detected. */ /**********************************************/ globle void EnvSetErrorFileName( void *theEnv, const char *fileName) { char *fileNameCopy = NULL; if (ConstructData(theEnv)->ParserErrorCallback == NULL) return; if (fileName != NULL) { fileNameCopy = (char *) genalloc(theEnv,strlen(fileName) + 1); genstrcpy(fileNameCopy,fileName); } if (ConstructData(theEnv)->ErrorFileName != NULL) { genfree(theEnv,ConstructData(theEnv)->ErrorFileName,strlen(ConstructData(theEnv)->ErrorFileName) + 1); } ConstructData(theEnv)->ErrorFileName = fileNameCopy; } /**********************************************/ /* EnvGetErrorFileName: Returns the file name */ /* associated with the last error detected. */ /**********************************************/ globle char *EnvGetErrorFileName( void *theEnv) { return ConstructData(theEnv)->ErrorFileName; } /************************************************/ /* EnvSetWarningFileName: Sets the file name */ /* associated with the last warning detected. */ /************************************************/ globle void EnvSetWarningFileName( void *theEnv, const char *fileName) { char *fileNameCopy = NULL; if (ConstructData(theEnv)->ParserErrorCallback == NULL) return; if (fileName != NULL) { fileNameCopy = (char *) genalloc(theEnv,strlen(fileName) + 1); genstrcpy(fileNameCopy,fileName); } if (ConstructData(theEnv)->WarningFileName != NULL) { genfree(theEnv,ConstructData(theEnv)->WarningFileName,strlen(ConstructData(theEnv)->WarningFileName) + 1); } ConstructData(theEnv)->WarningFileName = fileNameCopy; } /************************************************/ /* EnvGetWarningFileName: Returns the file name */ /* associated with the last warning detected. */ /************************************************/ globle char *EnvGetWarningFileName( void *theEnv) { return ConstructData(theEnv)->WarningFileName; } /*****************************************************************/ /* LoadConstructsFromLogicalName: Loads a set of constructs into */ /* the current environment from a specified logical name. */ /*****************************************************************/ globle int LoadConstructsFromLogicalName( void *theEnv, const char *readSource) { int constructFlag; struct token theToken; int noErrors = TRUE; int foundConstruct; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; long oldLineCountValue; const char *oldLineCountRouter; /*===================================================*/ /* Create a router to capture the error information. */ /*===================================================*/ CreateErrorCaptureRouter(theEnv); /*==============================*/ /* Initialize the line counter. */ /*==============================*/ oldLineCountValue = SetLineCount(theEnv,1); oldLineCountRouter = RouterData(theEnv)->LineCountRouter; RouterData(theEnv)->LineCountRouter = readSource; /*=========================================*/ /* Reset the halt execution and evaluation */ /* error flags in preparation for parsing. */ /*=========================================*/ if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); /*==========================================*/ /* Set up the frame for garbage collection. */ /*==========================================*/ oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; /*========================================================*/ /* Find the beginning of the first construct in the file. */ /*========================================================*/ GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); /*==================================================*/ /* Parse the file until the end of file is reached. */ /*==================================================*/ while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE)) { /*===========================================================*/ /* Clear the pretty print buffer in preparation for parsing. */ /*===========================================================*/ FlushPPBuffer(theEnv); /*======================*/ /* Parse the construct. */ /*======================*/ constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource); /*==============================================================*/ /* If an error occurred while parsing, then find the beginning */ /* of the next construct (but don't generate any more error */ /* messages--in effect, skip everything until another construct */ /* is found). */ /*==============================================================*/ if (constructFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); FlushParsingMessages(theEnv); noErrors = FALSE; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors); } /*======================================================*/ /* Otherwise, find the beginning of the next construct. */ /*======================================================*/ else { FlushParsingMessages(theEnv); GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); } /*=====================================================*/ /* Yield time if necessary to foreground applications. */ /*=====================================================*/ if (foundConstruct) { IncrementSymbolCount(theToken.value); } CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); YieldTime(theEnv); if (foundConstruct) { DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); } } /*========================================================*/ /* Print a carriage return if a single character is being */ /* printed to indicate constructs are being processed. */ /*========================================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv)) #else if (GetPrintWhileLoading(theEnv)) #endif { EnvPrintRouter(theEnv,WDIALOG,"\n"); } /*=============================================================*/ /* Once the load is complete, destroy the pretty print buffer. */ /* This frees up any memory that was used to create the pretty */ /* print forms for constructs during parsing. Thus calls to */ /* the mem-used function will accurately reflect the amount of */ /* memory being used after a load command. */ /*=============================================================*/ DestroyPPBuffer(theEnv); /*======================================*/ /* Remove the garbage collection frame. */ /*======================================*/ RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); /*==============================*/ /* Deactivate the line counter. */ /*==============================*/ SetLineCount(theEnv,oldLineCountValue); RouterData(theEnv)->LineCountRouter = oldLineCountRouter; /*===========================================*/ /* Invoke the parser error callback function */ /* and delete the error capture router. */ /*===========================================*/ FlushParsingMessages(theEnv); DeleteErrorCaptureRouter(theEnv); /*==========================================================*/ /* Return a boolean flag which indicates whether any errors */ /* were encountered while loading the constructs. */ /*==========================================================*/ return(noErrors); } /********************************************************************/ /* FindConstructBeginning: Searches for a left parenthesis followed */ /* by the name of a valid construct. Used by the load command to */ /* find the next construct to be parsed. Returns TRUE is the */ /* beginning of a construct was found, otherwise FALSE. */ /********************************************************************/ static int FindConstructBeginning( void *theEnv, const char *readSource, struct token *theToken, int errorCorrection, int *noErrors) { int leftParenthesisFound = FALSE; int firstAttempt = TRUE; /*===================================================*/ /* Process tokens until the beginning of a construct */ /* is found or there are no more tokens. */ /*===================================================*/ while (theToken->type != STOP) { /*=====================================================*/ /* Constructs begin with a left parenthesis. Make note */ /* that the opening parenthesis has been found. */ /*=====================================================*/ if (theToken->type == LPAREN) { leftParenthesisFound = TRUE; } /*=================================================================*/ /* The name of the construct follows the opening left parenthesis. */ /* If it is the name of a valid construct, then return TRUE. */ /* Otherwise, reset the flags to look for the beginning of a */ /* construct. If error correction is being performed (i.e. the */ /* last construct parsed had an error in it), then don't bother to */ /* print an error message, otherwise, print an error message. */ /*=================================================================*/ else if ((theToken->type == SYMBOL) && (leftParenthesisFound == TRUE)) { /*===========================================================*/ /* Is this a valid construct name (e.g., defrule, deffacts). */ /*===========================================================*/ if (FindConstruct(theEnv,ValueToString(theToken->value)) != NULL) return(TRUE); /*===============================================*/ /* The construct name is invalid. Print an error */ /* message if one hasn't already been printed. */ /*===============================================*/ if (firstAttempt && (! errorCorrection)) { errorCorrection = TRUE; *noErrors = FALSE; PrintErrorID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n"); } /*======================================================*/ /* Indicate that an error has been found and that we're */ /* looking for a left parenthesis again. */ /*======================================================*/ firstAttempt = FALSE; leftParenthesisFound = FALSE; } /*====================================================================*/ /* Any token encountered other than a left parenthesis or a construct */ /* name following a left parenthesis is illegal. Again, if error */ /* correction is in progress, no error message is printed, otherwise, */ /* an error message is printed. */ /*====================================================================*/ else { if (firstAttempt && (! errorCorrection)) { errorCorrection = TRUE; *noErrors = FALSE; PrintErrorID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n"); } firstAttempt = FALSE; leftParenthesisFound = FALSE; } /*============================================*/ /* Move on to the next token to be processed. */ /*============================================*/ GetToken(theEnv,readSource,theToken); } /*===================================================================*/ /* Couldn't find the beginning of a construct, so FALSE is returned. */ /*===================================================================*/ return(FALSE); } #if (! RUN_TIME) && (! BLOAD_ONLY) /*************************************************/ /* FindError: Find routine for the error router. */ /*************************************************/ static int FindError( void *theEnv, const char *logicalName) { #if MAC_XCD #pragma unused(theEnv) #endif if ( (strcmp(logicalName,WERROR) == 0) || (strcmp(logicalName,WWARNING) == 0) ) { return(TRUE); } return(FALSE); } /***************************************************/ /* PrintError: Print routine for the error router. */ /***************************************************/ static int PrintError( void *theEnv, const char *logicalName, const char *str) { if (strcmp(logicalName,WERROR) == 0) { ConstructData(theEnv)->ErrorString = AppendToString(theEnv,str,ConstructData(theEnv)->ErrorString, &ConstructData(theEnv)->CurErrPos, &ConstructData(theEnv)->MaxErrChars); } else if (strcmp(logicalName,WWARNING) == 0) { ConstructData(theEnv)->WarningString = AppendToString(theEnv,str,ConstructData(theEnv)->WarningString, &ConstructData(theEnv)->CurWrnPos, &ConstructData(theEnv)->MaxWrnChars); } EnvDeactivateRouter(theEnv,"error-capture"); EnvPrintRouter(theEnv,logicalName,str); EnvActivateRouter(theEnv,"error-capture"); return(1); } /***********************************************/ /* CreateErrorCaptureRouter: Creates the error */ /* capture router if it doesn't exists. */ /***********************************************/ globle void CreateErrorCaptureRouter( void *theEnv) { /*===========================================================*/ /* Don't bother creating the error capture router if there's */ /* no parser callback. The implication of this is that the */ /* parser callback should be created before any routines */ /* which could generate errors are called. */ /*===========================================================*/ if (ConstructData(theEnv)->ParserErrorCallback == NULL) return; /*=======================================================*/ /* If the router hasn't already been created, create it. */ /*=======================================================*/ if (ConstructData(theEnv)->errorCaptureRouterCount == 0) { EnvAddRouter(theEnv,"error-capture", 40, FindError, PrintError, NULL, NULL,NULL); } /*==================================================*/ /* Increment the count for the number of references */ /* that want the error capture router functioning. */ /*==================================================*/ ConstructData(theEnv)->errorCaptureRouterCount++; } /***********************************************/ /* DeleteErrorCaptureRouter: Deletes the error */ /* capture router if it exists. */ /***********************************************/ globle void DeleteErrorCaptureRouter( void *theEnv) { /*===========================================================*/ /* Don't bother deleting the error capture router if there's */ /* no parser callback. The implication of this is that the */ /* parser callback should be created before any routines */ /* which could generate errors are called. */ /*===========================================================*/ if (ConstructData(theEnv)->ParserErrorCallback == NULL) return; ConstructData(theEnv)->errorCaptureRouterCount--; if (ConstructData(theEnv)->errorCaptureRouterCount == 0) { EnvDeleteRouter(theEnv,"error-capture"); } } /*******************************************************/ /* FlushParsingMessages: Invokes the callback routines */ /* for any existing warning/error messages. */ /*******************************************************/ globle void FlushParsingMessages( void *theEnv) { /*===========================================================*/ /* Don't bother flushing the error capture router if there's */ /* no parser callback. The implication of this is that the */ /* parser callback should be created before any routines */ /* which could generate errors are called. */ /*===========================================================*/ if (ConstructData(theEnv)->ParserErrorCallback == NULL) return; /*=================================*/ /* If an error occurred invoke the */ /* parser error callback function. */ /*=================================*/ if (ConstructData(theEnv)->ErrorString != NULL) { (*ConstructData(theEnv)->ParserErrorCallback)(theEnv,EnvGetErrorFileName(theEnv), NULL,ConstructData(theEnv)->ErrorString, ConstructData(theEnv)->ErrLineNumber); } if (ConstructData(theEnv)->WarningString != NULL) { (*ConstructData(theEnv)->ParserErrorCallback)(theEnv,EnvGetWarningFileName(theEnv), ConstructData(theEnv)->WarningString,NULL, ConstructData(theEnv)->WrnLineNumber); } /*===================================*/ /* Delete the error capture strings. */ /*===================================*/ EnvSetErrorFileName(theEnv,NULL); if (ConstructData(theEnv)->ErrorString != NULL) { genfree(theEnv,ConstructData(theEnv)->ErrorString,strlen(ConstructData(theEnv)->ErrorString) + 1); } ConstructData(theEnv)->ErrorString = NULL; ConstructData(theEnv)->CurErrPos = 0; ConstructData(theEnv)->MaxErrChars = 0; EnvSetWarningFileName(theEnv,NULL); if (ConstructData(theEnv)->WarningString != NULL) { genfree(theEnv,ConstructData(theEnv)->WarningString,strlen(ConstructData(theEnv)->WarningString) + 1); } ConstructData(theEnv)->WarningString = NULL; ConstructData(theEnv)->CurWrnPos = 0; ConstructData(theEnv)->MaxWrnChars = 0; } #endif /***********************************************************/ /* ParseConstruct: Parses a construct. Returns an integer. */ /* -1 if the construct name has no parsing function, 0 */ /* if the construct was parsed successfully, and 1 if */ /* the construct was parsed unsuccessfully. */ /***********************************************************/ globle int ParseConstruct( void *theEnv, const char *name, const char *logicalName) { struct construct *currentPtr; int rv, ov; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; /*=================================*/ /* Look for a valid construct name */ /* (e.g. defrule, deffacts). */ /*=================================*/ currentPtr = FindConstruct(theEnv,name); if (currentPtr == NULL) return(-1); /*==========================================*/ /* Set up the frame for garbage collection. */ /*==========================================*/ oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; /*==================================*/ /* Prepare the parsing environment. */ /*==================================*/ ov = GetHaltExecution(theEnv); SetEvaluationError(theEnv,FALSE); SetHaltExecution(theEnv,FALSE); ClearParsedBindNames(theEnv); PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; /*=======================================*/ /* Call the construct's parsing routine. */ /*=======================================*/ ConstructData(theEnv)->ParsingConstruct = TRUE; rv = (*currentPtr->parseFunction)(theEnv,logicalName); ConstructData(theEnv)->ParsingConstruct = FALSE; /*===============================*/ /* Restore environment settings. */ /*===============================*/ PopRtnBrkContexts(theEnv); ClearParsedBindNames(theEnv); SetPPBufferStatus(theEnv,OFF); SetHaltExecution(theEnv,ov); /*======================================*/ /* Remove the garbage collection frame. */ /*======================================*/ RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); /*==============================*/ /* Return the status of parsing */ /* the construct. */ /*==============================*/ return(rv); } /*********************************************************/ /* GetConstructNameAndComment: Get the name and comment */ /* field of a construct. Returns name of the construct */ /* if no errors are detected, otherwise returns NULL. */ /*********************************************************/ globle SYMBOL_HN *GetConstructNameAndComment( void *theEnv, const char *readSource, struct token *inputToken, const char *constructName, void *(*findFunction)(void *,const char *), int (*deleteFunction)(void *,void *), const char *constructSymbol, int fullMessageCR, int getComment, int moduleNameAllowed, int ignoreRedefinition) { #if (MAC_XCD) && (! DEBUGGING_FUNCTIONS) #pragma unused(fullMessageCR) #endif SYMBOL_HN *name, *moduleName; int redefining = FALSE; void *theConstruct; unsigned separatorPosition; struct defmodule *theModule; /*==========================*/ /* Next token should be the */ /* name of the construct. */ /*==========================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { PrintErrorID(theEnv,"CSTRCPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing name for "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," construct\n"); return(NULL); } name = (SYMBOL_HN *) inputToken->value; /*===============================*/ /* Determine the current module. */ /*===============================*/ separatorPosition = FindModuleSeparator(ValueToString(name)); if (separatorPosition) { if (moduleNameAllowed == FALSE) { SyntaxErrorMessage(theEnv,"module specifier"); return(NULL); } moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name)); if (moduleName == NULL) { SyntaxErrorMessage(theEnv,"construct name"); return(NULL); } theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName)); return(NULL); } EnvSetCurrentModule(theEnv,(void *) theModule); name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name)); if (name == NULL) { SyntaxErrorMessage(theEnv,"construct name"); return(NULL); } } /*=====================================================*/ /* If the module was not specified, record the current */ /* module name as part of the pretty-print form. */ /*=====================================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (moduleNameAllowed) { PPBackup(theEnv); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule)); SavePPBuffer(theEnv,"::"); SavePPBuffer(theEnv,ValueToString(name)); } } /*==================================================================*/ /* Check for import/export conflicts from the construct definition. */ /*==================================================================*/ #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name))) { ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL); return(NULL); } #endif /*========================================================*/ /* Remove the construct if it is already in the knowledge */ /* base and we're not just checking syntax. */ /*========================================================*/ if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode)) { theConstruct = (*findFunction)(theEnv,ValueToString(name)); if (theConstruct != NULL) { redefining = TRUE; if (deleteFunction != NULL) { if ((*deleteFunction)(theEnv,theConstruct) == FALSE) { PrintErrorID(theEnv,"CSTRCPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot redefine "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,ValueToString(name)); EnvPrintRouter(theEnv,WERROR," while it is in use.\n"); return(NULL); } } } } /*=============================================*/ /* If compilations are being watched, indicate */ /* that a construct is being compiled. */ /*=============================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { const char *outRouter = WDIALOG; if (redefining && (! ignoreRedefinition)) { outRouter = WWARNING; PrintWarningID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,outRouter,"Redefining "); } else EnvPrintRouter(theEnv,outRouter,"Defining "); EnvPrintRouter(theEnv,outRouter,constructName); EnvPrintRouter(theEnv,outRouter,": "); EnvPrintRouter(theEnv,outRouter,ValueToString(name)); if (fullMessageCR) EnvPrintRouter(theEnv,outRouter,"\n"); else EnvPrintRouter(theEnv,outRouter," "); } else #endif { if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); } } /*===============================*/ /* Get the comment if it exists. */ /*===============================*/ GetToken(theEnv,readSource,inputToken); if ((inputToken->type == STRING) && getComment) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,inputToken->printForm); GetToken(theEnv,readSource,inputToken); if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } } else if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } /*===================================*/ /* Return the name of the construct. */ /*===================================*/ return(name); } /****************************************/ /* RemoveConstructFromModule: Removes a */ /* construct from its module's list */ /****************************************/ globle void RemoveConstructFromModule( void *theEnv, struct constructHeader *theConstruct) { struct constructHeader *lastConstruct,*currentConstruct; /*==============================*/ /* Find the specified construct */ /* in the module's list. */ /*==============================*/ lastConstruct = NULL; currentConstruct = theConstruct->whichModule->firstItem; while (currentConstruct != theConstruct) { lastConstruct = currentConstruct; currentConstruct = currentConstruct->next; } /*========================================*/ /* If it wasn't there, something's wrong. */ /*========================================*/ if (currentConstruct == NULL) { SystemError(theEnv,"CSTRCPSR",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*==========================*/ /* Remove it from the list. */ /*==========================*/ if (lastConstruct == NULL) { theConstruct->whichModule->firstItem = theConstruct->next; } else { lastConstruct->next = theConstruct->next; } /*=================================================*/ /* Update the pointer to the last item in the list */ /* if the construct just deleted was at the end. */ /*=================================================*/ if (theConstruct == theConstruct->whichModule->lastItem) { theConstruct->whichModule->lastItem = lastConstruct; } } /******************************************************/ /* ImportExportConflictMessage: Generic error message */ /* for an import/export module conflict detected */ /* when a construct is being defined. */ /******************************************************/ globle void ImportExportConflictMessage( void *theEnv, const char *constructName, const char *itemName, const char *causedByConstruct, const char *causedByName) { PrintErrorID(theEnv,"CSTRCPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot define "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR," because of an import/export conflict"); if (causedByConstruct == NULL) EnvPrintRouter(theEnv,WERROR,".\n"); else { EnvPrintRouter(theEnv,WERROR," caused by the "); EnvPrintRouter(theEnv,WERROR,causedByConstruct); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,causedByName); EnvPrintRouter(theEnv,WERROR,".\n"); } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips_core_source_630/core/._prcdrpsr.h0000755000175000017500000000040712373743657016500 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlpsr.h0000755000175000017500000000476312373753360016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Made the construct redefinition message more */ /* prominent. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Moved WatchGlobals global to defglobalData. */ /* */ /*************************************************************/ #ifndef _H_globlpsr #define _H_globlpsr #ifdef _DEFGLOBL_SOURCE_ struct defglobal; #endif #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ParseDefglobal(void *,const char *); LOCALE intBool ReplaceGlobalVariable(void *,struct expr *); LOCALE void GlobalReferenceErrorMessage(void *,const char *); #endif /* _H_globlpsr */ clips_core_source_630/core/._tmpltlhs.h0000755000175000017500000000040712373754202016474 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dfinsbin.h0000755000175000017500000000040712373731173016423 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulecmp.c0000755000175000017500000006247312375756066016101 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* DEFRULE CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for join network changes. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _RULECMP_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (! RUN_TIME) && CONSTRUCT_COMPILER #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "factbld.h" #include "reteutil.h" #include "rulecmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void JoinToCode(void *,FILE *,struct joinNode *,int,int); static void LinkToCode(void *,FILE *,struct joinLink *,int,int); static void DefruleModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void DefruleToCode(void *,FILE *,struct defrule *,int,int,int); static void CloseDefruleFiles(void *,FILE *,FILE *,FILE *,FILE*,int); static void BeforeDefrulesCode(void *); static void InitDefruleCode(void *,FILE *,int,int); static int RuleCompilerTraverseJoins(void *,struct joinNode *,const char *,const char *,char *,int, FILE *,int,int,FILE **,FILE **, int *,int *,int *,int *,int *); static int TraverseJoinLinks(void *,struct joinLink *,const char *,const char *,char *,int,FILE *, int,int,FILE **,int *,int *, int *); /***********************************************************/ /* DefruleCompilerSetup: Initializes the defrule construct */ /* for use with the constructs-to-c command. */ /***********************************************************/ globle void DefruleCompilerSetup( void *theEnv) { DefruleData(theEnv)->DefruleCodeItem = AddCodeGeneratorItem(theEnv,"defrules",0,BeforeDefrulesCode, InitDefruleCode,ConstructToCode,4); } /**************************************************************/ /* BeforeDefrulesCode: Assigns each defrule and join with a */ /* unique ID which will be used for pointer references when */ /* the data structures are written to a file as C code */ /**************************************************************/ static void BeforeDefrulesCode( void *theEnv) { long int moduleCount, ruleCount, joinCount, linkCount; TagRuleNetwork(theEnv,&moduleCount,&ruleCount,&joinCount,&linkCount); } /*********************************************************/ /* ConstructToCode: Produces defrule code for a run-time */ /* module created using the constructs-to-c function. */ /*********************************************************/ static int ConstructToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct defrule *theDefrule; int joinArrayCount = 0, joinArrayVersion = 1; int linkArrayCount = 0, linkArrayVersion = 1; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int defruleArrayCount = 0, defruleArrayVersion = 1; FILE *joinFile = NULL, *moduleFile = NULL, *defruleFile = NULL, *linkFile = NULL; /*==============================================*/ /* Include the appropriate defrule header file. */ /*==============================================*/ fprintf(headerFP,"#include \"ruledef.h\"\n"); /*======================================*/ /* Save the left and right prime links. */ /*======================================*/ if (! TraverseJoinLinks(theEnv,DefruleData(theEnv)->LeftPrimeJoins,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID, maxIndices,&linkFile,&fileCount,&linkArrayVersion,&linkArrayCount)) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,linkFile,maxIndices); return(0); } if (! TraverseJoinLinks(theEnv,DefruleData(theEnv)->RightPrimeJoins,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID, maxIndices,&linkFile,&fileCount,&linkArrayVersion,&linkArrayCount)) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,linkFile,maxIndices); return(0); } /*=========================================================*/ /* Loop through all the modules, all the defrules, and all */ /* the join nodes writing their C code representation to */ /* the file as they are traversed. */ /*=========================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================*/ /* Set the current module. */ /*=========================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==========================*/ /* Save the defrule module. */ /*==========================*/ moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct defruleModule",ModulePrefix(DefruleData(theEnv)->DefruleCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,linkFile,maxIndices); return(0); } DefruleModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); /*=========================================*/ /* Loop through all of the defrules (and */ /* their disjuncts) in the current module. */ /*=========================================*/ theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (theDefrule != NULL) { /*===================================*/ /* Save the defrule data structures. */ /*===================================*/ defruleFile = OpenFileIfNeeded(theEnv,defruleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, defruleArrayVersion,headerFP, "struct defrule",ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem), FALSE,NULL); if (defruleFile == NULL) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,linkFile,maxIndices); return(0); } DefruleToCode(theEnv,defruleFile,theDefrule,imageID,maxIndices, moduleCount); defruleArrayCount++; defruleFile = CloseFileIfNeeded(theEnv,defruleFile,&defruleArrayCount,&defruleArrayVersion, maxIndices,NULL,NULL); /*================================*/ /* Save the join data structures. */ /*================================*/ if (! RuleCompilerTraverseJoins(theEnv,theDefrule->lastJoin,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID, maxIndices,&joinFile,&linkFile,&fileCount,&joinArrayVersion,&joinArrayCount, &linkArrayVersion,&linkArrayCount)) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,linkFile,maxIndices); return(0); } /*==========================================*/ /* Move on to the next disjunct or defrule. */ /*==========================================*/ if (theDefrule->disjunct != NULL) theDefrule = theDefrule->disjunct; else theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule); } moduleCount++; moduleArrayCount++; } CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,linkFile,maxIndices); return(1); } /*********************************************************************/ /* RuleCompilerTraverseJoins: Traverses the join network for a rule. */ /*********************************************************************/ static int RuleCompilerTraverseJoins( void *theEnv, struct joinNode *joinPtr, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, FILE **joinFile, FILE **linkFile, int *fileCount, int *joinArrayVersion, int *joinArrayCount, int *linkArrayVersion, int *linkArrayCount) { for (; joinPtr != NULL; joinPtr = joinPtr->lastLevel) { if (joinPtr->marked) { *joinFile = OpenFileIfNeeded(theEnv,*joinFile,fileName,pathName,fileNameBuffer,fileID,imageID,fileCount, *joinArrayVersion,headerFP, "struct joinNode",JoinPrefix(),FALSE,NULL); if (*joinFile == NULL) { return(FALSE); } JoinToCode(theEnv,*joinFile,joinPtr,imageID,maxIndices); (*joinArrayCount)++; *joinFile = CloseFileIfNeeded(theEnv,*joinFile,joinArrayCount,joinArrayVersion, maxIndices,NULL,NULL); if (! TraverseJoinLinks(theEnv,joinPtr->nextLinks,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID, maxIndices,linkFile,fileCount,linkArrayVersion,linkArrayCount)) { return(FALSE); } } if (joinPtr->joinFromTheRight) { if (RuleCompilerTraverseJoins(theEnv,(struct joinNode *) joinPtr->rightSideEntryStructure,fileName,pathName, fileNameBuffer,fileID,headerFP,imageID,maxIndices,joinFile,linkFile,fileCount, joinArrayVersion,joinArrayCount, linkArrayVersion,linkArrayCount) == FALSE) { return(FALSE); } } } return(TRUE); } /*******************************************************/ /* TraverseJoinLinks: Writes out a list of join links. */ /*******************************************************/ static int TraverseJoinLinks( void *theEnv, struct joinLink *linkPtr, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, FILE **linkFile, int *fileCount, int *linkArrayVersion, int *linkArrayCount) { for (; linkPtr != NULL; linkPtr = linkPtr->next) { *linkFile = OpenFileIfNeeded(theEnv,*linkFile,fileName,pathName,fileNameBuffer,fileID,imageID,fileCount, *linkArrayVersion,headerFP, "struct joinLink",LinkPrefix(),FALSE,NULL); if (*linkFile == NULL) { return(FALSE); } LinkToCode(theEnv,*linkFile,linkPtr,imageID,maxIndices); (*linkArrayCount)++; *linkFile = CloseFileIfNeeded(theEnv,*linkFile,linkArrayCount,linkArrayVersion, maxIndices,NULL,NULL); } return(TRUE); } /********************************************************/ /* CloseDefruleFiles: Closes all of the C files created */ /* for defrule. Called when an error occurs or when */ /* the defrules have all been written to the files. */ /********************************************************/ static void CloseDefruleFiles( void *theEnv, FILE *moduleFile, FILE *defruleFile, FILE *joinFile, FILE *linkFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (linkFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,linkFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (joinFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,joinFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (defruleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,defruleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*********************************************************/ /* DefruleModuleToCode: Writes the C code representation */ /* of a single defrule module to the specified file. */ /*********************************************************/ static void DefruleModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefruleData(theEnv)->DefruleModuleIndex,ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem)); fprintf(theFile,",NULL}"); } /**********************************************************/ /* DefruleToCode: Writes the C code representation of a */ /* single defrule data structure to the specified file. */ /**********************************************************/ static void DefruleToCode( void *theEnv, FILE *theFile, struct defrule *theDefrule, int imageID, int maxIndices, int moduleCount) { /*==================*/ /* Construct Header */ /*==================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefrule->header,imageID,maxIndices, moduleCount,ModulePrefix(DefruleData(theEnv)->DefruleCodeItem), ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem)); /*==========================*/ /* Flags and Integer Values */ /*==========================*/ fprintf(theFile,",%d,%d,%d,%d,%d,%d,%d,%d,", theDefrule->salience,theDefrule->localVarCnt, theDefrule->complexity,theDefrule->afterBreakpoint, theDefrule->watchActivation,theDefrule->watchFiring, theDefrule->autoFocus,theDefrule->executing); /*==================*/ /* Dynamic Salience */ /*==================*/ ExpressionToCode(theEnv,theFile,theDefrule->dynamicSalience); fprintf(theFile,","); /*=============*/ /* RHS Actions */ /*=============*/ ExpressionToCode(theEnv,theFile,theDefrule->actions); fprintf(theFile,","); /*=========================*/ /* Logical Dependency Join */ /*=========================*/ if (theDefrule->logicalJoin != NULL) { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theDefrule->logicalJoin->bsaveID / maxIndices) + 1, theDefrule->logicalJoin->bsaveID % maxIndices); } else { fprintf(theFile,"NULL,"); } /*===========*/ /* Last Join */ /*===========*/ if (theDefrule->lastJoin != NULL) { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theDefrule->lastJoin->bsaveID / maxIndices) + 1, theDefrule->lastJoin->bsaveID % maxIndices); } else { fprintf(theFile,"NULL,"); } /*===============*/ /* Next Disjunct */ /*===============*/ if (theDefrule->disjunct != NULL) { fprintf(theFile,"&%s%d_%ld[%ld]}",ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem), imageID,(theDefrule->disjunct->header.bsaveID / maxIndices) + 1, theDefrule->disjunct->header.bsaveID % maxIndices); } else { fprintf(theFile,"NULL}"); } } /***************************************************/ /* JoinToCode: Writes the C code representation of */ /* a single join node to the specified file. */ /***************************************************/ static void JoinToCode( void *theEnv, FILE *joinFile, struct joinNode *theJoin, int imageID, int maxIndices) { struct patternParser *theParser; /*===========================*/ /* Mark the join as visited. */ /*===========================*/ theJoin->marked = 0; /*===========================*/ /* Flags and Integer Values. */ /*===========================*/ fprintf(joinFile,"{%d,%d,%d,%d,%d,0,0,%d,%d,0,0,0,0,0,0,", theJoin->firstJoin,theJoin->logicalJoin, theJoin->joinFromTheRight,theJoin->patternIsNegated, theJoin->patternIsExists, // initialize, // marked theJoin->rhsType,theJoin->depth); // bsaveID // memoryLeftAdds // memoryRightAdds // memoryLeftDeletes // memoryRightDeletes // memoryCompares /*==========================*/ /* Left and right Memories. */ /*==========================*/ fprintf(joinFile,"NULL,NULL,"); /*====================*/ /* Network Expression */ /*====================*/ PrintHashedExpressionReference(theEnv,joinFile,theJoin->networkTest,imageID,maxIndices); fprintf(joinFile,","); PrintHashedExpressionReference(theEnv,joinFile,theJoin->secondaryNetworkTest,imageID,maxIndices); fprintf(joinFile,","); PrintHashedExpressionReference(theEnv,joinFile,theJoin->leftHash,imageID,maxIndices); fprintf(joinFile,","); PrintHashedExpressionReference(theEnv,joinFile,theJoin->rightHash,imageID,maxIndices); fprintf(joinFile,","); /*============================*/ /* Right Side Entry Structure */ /*============================*/ if (theJoin->rightSideEntryStructure == NULL) { fprintf(joinFile,"NULL,"); } else if (theJoin->joinFromTheRight == FALSE) { theParser = GetPatternParser(theEnv,(int) theJoin->rhsType); if (theParser->codeReferenceFunction == NULL) fprintf(joinFile,"NULL,"); else { fprintf(joinFile,"VS "); (*theParser->codeReferenceFunction)(theEnv,theJoin->rightSideEntryStructure, joinFile,imageID,maxIndices); fprintf(joinFile,","); } } else { fprintf(joinFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(((struct joinNode *) theJoin->rightSideEntryStructure)->bsaveID / maxIndices) + 1, ((struct joinNode *) theJoin->rightSideEntryStructure)->bsaveID % maxIndices); } /*=================*/ /* Next Join Level */ /*=================*/ if (theJoin->nextLinks == NULL) { fprintf(joinFile,"NULL,"); } else { fprintf(joinFile,"&%s%d_%ld[%ld],",LinkPrefix(), imageID,(theJoin->nextLinks->bsaveID / maxIndices) + 1, theJoin->nextLinks->bsaveID % maxIndices); } /*=================*/ /* Last Join Level */ /*=================*/ if (theJoin->lastLevel == NULL) { fprintf(joinFile,"NULL,"); } else { fprintf(joinFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theJoin->lastLevel->bsaveID / maxIndices) + 1, theJoin->lastLevel->bsaveID % maxIndices); } /*==================*/ /* Right Match Node */ /*==================*/ if (theJoin->rightMatchNode == NULL) { fprintf(joinFile,"NULL,"); } else { fprintf(joinFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theJoin->rightMatchNode->bsaveID / maxIndices) + 1, theJoin->rightMatchNode->bsaveID % maxIndices); } /*==================*/ /* Rule to Activate */ /*==================*/ if (theJoin->ruleToActivate == NULL) { fprintf(joinFile,"NULL}"); } else { fprintf(joinFile,"&%s%d_%ld[%ld]}",ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem),imageID, (theJoin->ruleToActivate->header.bsaveID / maxIndices) + 1, theJoin->ruleToActivate->header.bsaveID % maxIndices); } } /***************************************************/ /* LinkToCode: Writes the C code representation of */ /* a single join node to the specified file. */ /***************************************************/ static void LinkToCode( void *theEnv, FILE *theFile, struct joinLink *theLink, int imageID, int maxIndices) { /*==================*/ /* Enter Direction. */ /*==================*/ fprintf(theFile,"{%d,",theLink->enterDirection); /*======*/ /* Join */ /*======*/ if (theLink->join == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theLink->join->bsaveID / maxIndices) + 1, theLink->join->bsaveID % maxIndices); } /*======*/ /* Next */ /*======*/ if (theLink->next == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",LinkPrefix(), imageID,(theLink->next->bsaveID / maxIndices) + 1, theLink->next->bsaveID % maxIndices); } /*===========*/ /* Bsave ID. */ /*===========*/ fprintf(theFile,"0}"); } /*************************************************************/ /* DefruleCModuleReference: Writes the C code representation */ /* of a reference to a defrule module data structure. */ /*************************************************************/ globle void DefruleCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]",ModulePrefix(DefruleData(theEnv)->DefruleCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /*****************************************************************/ /* InitDefruleCode: Writes out initialization code for defrules. */ /*****************************************************************/ static void InitDefruleCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_XCD #pragma unused(maxIndices) #pragma unused(theEnv) #pragma unused(imageID) #endif fprintf(initFP," DefruleRunTimeInitialize(theEnv,"); if (DefruleData(theEnv)->RightPrimeJoins == NULL) { fprintf(initFP,"NULL,"); } else { fprintf(initFP,"&%s%d_%ld[%ld],",LinkPrefix(), imageID,(DefruleData(theEnv)->RightPrimeJoins->bsaveID / maxIndices) + 1, DefruleData(theEnv)->RightPrimeJoins->bsaveID % maxIndices); } if (DefruleData(theEnv)->LeftPrimeJoins == NULL) { fprintf(initFP,"NULL);\n"); } else { fprintf(initFP,"&%s%d_%ld[%ld]);\n",LinkPrefix(), imageID,(DefruleData(theEnv)->LeftPrimeJoins->bsaveID / maxIndices) + 1, DefruleData(theEnv)->LeftPrimeJoins->bsaveID % maxIndices); } } #endif /* DEFRULE_CONSTRUCT && (! RUN_TIME) && CONSTRUCT_COMPILER */ clips_core_source_630/core/._cstrcbin.h0000755000175000017500000000040712373714231016432 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffctpsr.c0000755000175000017500000000040712461253173016432 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulecom.c0000755000175000017500000000040712375756721016300 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnpsr.c0000755000175000017500000014367412461303660016273 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* CONSTRAINT PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing constraint */ /* declarations. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Slot cardinality bug fix for minimum < 0. */ /* */ /*************************************************************/ #define _CSTRNPSR_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "scanner.h" #include "cstrnutl.h" #include "cstrnchk.h" #include "sysdep.h" #include "cstrnpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static intBool ParseRangeCardinalityAttribute(void *, const char *,CONSTRAINT_RECORD *, CONSTRAINT_PARSE_RECORD *, const char *,int); static intBool ParseTypeAttribute(void *,const char *,CONSTRAINT_RECORD *); static void AddToRestrictionList(void *,int,CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static intBool ParseAllowedValuesAttribute(void *,const char *,const char *, CONSTRAINT_RECORD *, CONSTRAINT_PARSE_RECORD *); static int GetConstraintTypeFromAllowedName(const char *); static int GetConstraintTypeFromTypeName(const char *); static int GetAttributeParseValue(const char *,CONSTRAINT_PARSE_RECORD *); static void SetRestrictionFlag(int,CONSTRAINT_RECORD *,int); static void SetParseFlag(CONSTRAINT_PARSE_RECORD *,const char *); static void NoConjunctiveUseError(void *,const char *,const char *); #endif /********************************************************************/ /* CheckConstraintParseConflicts: Determines if a constraint record */ /* has any conflicts in the attribute specifications. Returns */ /* TRUE if no conflicts were detected, otherwise FALSE. */ /********************************************************************/ globle intBool CheckConstraintParseConflicts( void *theEnv, CONSTRAINT_RECORD *constraints) { /*===================================================*/ /* Check to see if any of the allowed-... attributes */ /* conflict with the type attribute. */ /*===================================================*/ if (constraints->anyAllowed == TRUE) { /* Do Nothing */ } else if (constraints->symbolRestriction && (constraints->symbolsAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-symbols"); return(FALSE); } else if (constraints->stringRestriction && (constraints->stringsAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-strings"); return(FALSE); } else if (constraints->integerRestriction && (constraints->integersAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-integers/numbers"); return(FALSE); } else if (constraints->floatRestriction && (constraints->floatsAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-floats/numbers"); return(FALSE); } else if (constraints->classRestriction && (constraints->instanceAddressesAllowed == FALSE) && (constraints->instanceNamesAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-classes"); return(FALSE); } else if (constraints->instanceNameRestriction && (constraints->instanceNamesAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-instance-names"); return(FALSE); } else if (constraints->anyRestriction) { struct expr *theExp; for (theExp = constraints->restrictionList; theExp != NULL; theExp = theExp->nextArg) { if (ConstraintCheckValue(theEnv,theExp->type,theExp->value,constraints) != NO_VIOLATION) { AttributeConflictErrorMessage(theEnv,"type","allowed-values"); return(FALSE); } } } /*================================================================*/ /* Check to see if range attribute conflicts with type attribute. */ /*================================================================*/ if ((constraints->maxValue != NULL) && (constraints->anyAllowed == FALSE)) { if (((constraints->maxValue->type == INTEGER) && (constraints->integersAllowed == FALSE)) || ((constraints->maxValue->type == FLOAT) && (constraints->floatsAllowed == FALSE))) { AttributeConflictErrorMessage(theEnv,"type","range"); return(FALSE); } } if ((constraints->minValue != NULL) && (constraints->anyAllowed == FALSE)) { if (((constraints->minValue->type == INTEGER) && (constraints->integersAllowed == FALSE)) || ((constraints->minValue->type == FLOAT) && (constraints->floatsAllowed == FALSE))) { AttributeConflictErrorMessage(theEnv,"type","range"); return(FALSE); } } /*=========================================*/ /* Check to see if allowed-class attribute */ /* conflicts with type attribute. */ /*=========================================*/ if ((constraints->classList != NULL) && (constraints->anyAllowed == FALSE) && (constraints->instanceNamesAllowed == FALSE) && (constraints->instanceAddressesAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-class"); return(FALSE); } /*=====================================================*/ /* Return TRUE to indicate no conflicts were detected. */ /*=====================================================*/ return(TRUE); } /********************************************************/ /* AttributeConflictErrorMessage: Generic error message */ /* for a constraint attribute conflict. */ /********************************************************/ globle void AttributeConflictErrorMessage( void *theEnv, const char *attribute1, const char *attribute2) { PrintErrorID(theEnv,"CSTRNPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The "); EnvPrintRouter(theEnv,WERROR,attribute1); EnvPrintRouter(theEnv,WERROR," attribute conflicts with the "); EnvPrintRouter(theEnv,WERROR,attribute2); EnvPrintRouter(theEnv,WERROR," attribute.\n"); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************************************/ /* InitializeConstraintParseRecord: Initializes the values of a constraint */ /* parse record which is used to determine whether one of the standard */ /* constraint specifications has already been parsed. */ /***************************************************************************/ globle void InitializeConstraintParseRecord( CONSTRAINT_PARSE_RECORD *parsedConstraints) { parsedConstraints->type = FALSE; parsedConstraints->range = FALSE; parsedConstraints->allowedSymbols = FALSE; parsedConstraints->allowedStrings = FALSE; parsedConstraints->allowedLexemes = FALSE; parsedConstraints->allowedIntegers = FALSE; parsedConstraints->allowedFloats = FALSE; parsedConstraints->allowedNumbers = FALSE; parsedConstraints->allowedValues = FALSE; parsedConstraints->allowedInstanceNames = FALSE; parsedConstraints->allowedClasses = FALSE; parsedConstraints->cardinality = FALSE; } /************************************************************************/ /* StandardConstraint: Returns TRUE if the specified name is one of the */ /* standard constraints parseable by the routines in this module. */ /************************************************************************/ globle intBool StandardConstraint( const char *constraintName) { if ((strcmp(constraintName,"type") == 0) || (strcmp(constraintName,"range") == 0) || (strcmp(constraintName,"cardinality") == 0) || (strcmp(constraintName,"allowed-symbols") == 0) || (strcmp(constraintName,"allowed-strings") == 0) || (strcmp(constraintName,"allowed-lexemes") == 0) || (strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0) || (strcmp(constraintName,"allowed-numbers") == 0) || (strcmp(constraintName,"allowed-instance-names") == 0) || (strcmp(constraintName,"allowed-classes") == 0) || (strcmp(constraintName,"allowed-values") == 0)) { return(TRUE); } return(FALSE); } /***********************************************************************/ /* ParseStandardConstraint: Parses a standard constraint. Returns TRUE */ /* if the constraint was successfully parsed, otherwise FALSE. */ /***********************************************************************/ globle intBool ParseStandardConstraint( void *theEnv, const char *readSource, const char *constraintName, CONSTRAINT_RECORD *constraints, CONSTRAINT_PARSE_RECORD *parsedConstraints, int multipleValuesAllowed) { int rv = FALSE; /*=====================================================*/ /* Determine if the attribute has already been parsed. */ /*=====================================================*/ if (GetAttributeParseValue(constraintName,parsedConstraints)) { AlreadyParsedErrorMessage(theEnv,constraintName," attribute"); return(FALSE); } /*==========================================*/ /* If specified, parse the range attribute. */ /*==========================================*/ if (strcmp(constraintName,"range") == 0) { rv = ParseRangeCardinalityAttribute(theEnv,readSource,constraints,parsedConstraints, constraintName,multipleValuesAllowed); } /*================================================*/ /* If specified, parse the cardinality attribute. */ /*================================================*/ else if (strcmp(constraintName,"cardinality") == 0) { rv = ParseRangeCardinalityAttribute(theEnv,readSource,constraints,parsedConstraints, constraintName,multipleValuesAllowed); } /*=========================================*/ /* If specified, parse the type attribute. */ /*=========================================*/ else if (strcmp(constraintName,"type") == 0) { rv = ParseTypeAttribute(theEnv,readSource,constraints); } /*================================================*/ /* If specified, parse the allowed-... attribute. */ /*================================================*/ else if ((strcmp(constraintName,"allowed-symbols") == 0) || (strcmp(constraintName,"allowed-strings") == 0) || (strcmp(constraintName,"allowed-lexemes") == 0) || (strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0) || (strcmp(constraintName,"allowed-numbers") == 0) || (strcmp(constraintName,"allowed-instance-names") == 0) || (strcmp(constraintName,"allowed-classes") == 0) || (strcmp(constraintName,"allowed-values") == 0)) { rv = ParseAllowedValuesAttribute(theEnv,readSource,constraintName, constraints,parsedConstraints); } /*=========================================*/ /* Remember which constraint attribute was */ /* parsed and return the error status. */ /*=========================================*/ SetParseFlag(parsedConstraints,constraintName); return(rv); } /***********************************************************/ /* OverlayConstraint: Overlays fields of source constraint */ /* record on destination based on which fields are set in */ /* the parsed constraint record. Assumes AddConstraint has */ /* not yet been called for the destination constraint */ /* record. */ /***********************************************************/ globle void OverlayConstraint( void *theEnv, CONSTRAINT_PARSE_RECORD *pc, CONSTRAINT_RECORD *cdst, CONSTRAINT_RECORD *csrc) { if (pc->type == 0) { cdst->anyAllowed = csrc->anyAllowed; cdst->symbolsAllowed = csrc->symbolsAllowed; cdst->stringsAllowed = csrc->stringsAllowed; cdst->floatsAllowed = csrc->floatsAllowed; cdst->integersAllowed = csrc->integersAllowed; cdst->instanceNamesAllowed = csrc->instanceNamesAllowed; cdst->instanceAddressesAllowed = csrc->instanceAddressesAllowed; cdst->externalAddressesAllowed = csrc->externalAddressesAllowed; cdst->voidAllowed = csrc->voidAllowed; cdst->factAddressesAllowed = csrc->factAddressesAllowed; } if (pc->range == 0) { ReturnExpression(theEnv,cdst->minValue); ReturnExpression(theEnv,cdst->maxValue); cdst->minValue = CopyExpression(theEnv,csrc->minValue); cdst->maxValue = CopyExpression(theEnv,csrc->maxValue); } if (pc->allowedClasses == 0) { ReturnExpression(theEnv,cdst->classList); cdst->classList = CopyExpression(theEnv,csrc->classList); } if (pc->allowedValues == 0) { if ((pc->allowedSymbols == 0) && (pc->allowedStrings == 0) && (pc->allowedLexemes == 0) && (pc->allowedIntegers == 0) && (pc->allowedFloats == 0) && (pc->allowedNumbers == 0) && (pc->allowedInstanceNames == 0)) { cdst->anyRestriction = csrc->anyRestriction; cdst->symbolRestriction = csrc->symbolRestriction; cdst->stringRestriction = csrc->stringRestriction; cdst->floatRestriction = csrc->floatRestriction; cdst->integerRestriction = csrc->integerRestriction; cdst->classRestriction = csrc->classRestriction; cdst->instanceNameRestriction = csrc->instanceNameRestriction; cdst->restrictionList = CopyExpression(theEnv,csrc->restrictionList); } else { if ((pc->allowedSymbols == 0) && csrc->symbolRestriction) { cdst->symbolRestriction = 1; AddToRestrictionList(theEnv,SYMBOL,cdst,csrc); } if ((pc->allowedStrings == 0) && csrc->stringRestriction) { cdst->stringRestriction = 1; AddToRestrictionList(theEnv,STRING,cdst,csrc); } if ((pc->allowedLexemes == 0) && csrc->symbolRestriction && csrc->stringRestriction) { cdst->symbolRestriction = 1; cdst->stringRestriction = 1; AddToRestrictionList(theEnv,SYMBOL,cdst,csrc); AddToRestrictionList(theEnv,STRING,cdst,csrc); } if ((pc->allowedIntegers == 0) && csrc->integerRestriction) { cdst->integerRestriction = 1; AddToRestrictionList(theEnv,INTEGER,cdst,csrc); } if ((pc->allowedFloats == 0) && csrc->floatRestriction) { cdst->floatRestriction = 1; AddToRestrictionList(theEnv,FLOAT,cdst,csrc); } if ((pc->allowedNumbers == 0) && csrc->integerRestriction && csrc->floatRestriction) { cdst->integerRestriction = 1; cdst->floatRestriction = 1; AddToRestrictionList(theEnv,INTEGER,cdst,csrc); AddToRestrictionList(theEnv,FLOAT,cdst,csrc); } if ((pc->allowedInstanceNames == 0) && csrc->instanceNameRestriction) { cdst->instanceNameRestriction = 1; AddToRestrictionList(theEnv,INSTANCE_NAME,cdst,csrc); } } } if (pc->cardinality == 0) { ReturnExpression(theEnv,cdst->minFields); ReturnExpression(theEnv,cdst->maxFields); cdst->minFields = CopyExpression(theEnv,csrc->minFields); cdst->maxFields = CopyExpression(theEnv,csrc->maxFields); } } /**********************************************/ /* OverlayConstraintParseRecord: Performs a */ /* field-wise "or" of the destination parse */ /* record with the source parse record. */ /**********************************************/ globle void OverlayConstraintParseRecord( CONSTRAINT_PARSE_RECORD *dst, CONSTRAINT_PARSE_RECORD *src) { if (src->type) dst->type = TRUE; if (src->range) dst->range = TRUE; if (src->allowedSymbols) dst->allowedSymbols = TRUE; if (src->allowedStrings) dst->allowedStrings = TRUE; if (src->allowedLexemes) dst->allowedLexemes = TRUE; if (src->allowedIntegers) dst->allowedIntegers = TRUE; if (src->allowedFloats) dst->allowedFloats = TRUE; if (src->allowedNumbers) dst->allowedNumbers = TRUE; if (src->allowedValues) dst->allowedValues = TRUE; if (src->allowedInstanceNames) dst->allowedInstanceNames = TRUE; if (src->allowedClasses) dst->allowedClasses = TRUE; if (src->cardinality) dst->cardinality = TRUE; } /************************************************************/ /* AddToRestrictionList: Prepends atoms of the specified */ /* type from the source restriction list to the destination */ /************************************************************/ static void AddToRestrictionList( void *theEnv, int type, CONSTRAINT_RECORD *cdst, CONSTRAINT_RECORD *csrc) { struct expr *theExp,*tmp; for (theExp = csrc->restrictionList; theExp != NULL; theExp = theExp->nextArg) { if (theExp->type == type) { tmp = GenConstant(theEnv,theExp->type,theExp->value); tmp->nextArg = cdst->restrictionList; cdst->restrictionList = tmp; } } } /*******************************************************************/ /* ParseAllowedValuesAttribute: Parses the allowed-... attributes. */ /*******************************************************************/ static intBool ParseAllowedValuesAttribute( void *theEnv, const char *readSource, const char *constraintName, CONSTRAINT_RECORD *constraints, CONSTRAINT_PARSE_RECORD *parsedConstraints) { struct token inputToken; int expectedType, restrictionType, error = FALSE; struct expr *newValue, *lastValue; int constantParsed = FALSE, variableParsed = FALSE; const char *tempPtr = NULL; /*======================================================*/ /* The allowed-values attribute is not allowed if other */ /* allowed-... attributes have already been parsed. */ /*======================================================*/ if ((strcmp(constraintName,"allowed-values") == 0) && ((parsedConstraints->allowedSymbols) || (parsedConstraints->allowedStrings) || (parsedConstraints->allowedLexemes) || (parsedConstraints->allowedIntegers) || (parsedConstraints->allowedFloats) || (parsedConstraints->allowedNumbers) || (parsedConstraints->allowedInstanceNames))) { if (parsedConstraints->allowedSymbols) tempPtr = "allowed-symbols"; else if (parsedConstraints->allowedStrings) tempPtr = "allowed-strings"; else if (parsedConstraints->allowedLexemes) tempPtr = "allowed-lexemes"; else if (parsedConstraints->allowedIntegers) tempPtr = "allowed-integers"; else if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats"; else if (parsedConstraints->allowedNumbers) tempPtr = "allowed-numbers"; else if (parsedConstraints->allowedInstanceNames) tempPtr = "allowed-instance-names"; NoConjunctiveUseError(theEnv,"allowed-values",tempPtr); return(FALSE); } /*=======================================================*/ /* The allowed-values/numbers/integers/floats attributes */ /* are not allowed with the range attribute. */ /*=======================================================*/ if (((strcmp(constraintName,"allowed-values") == 0) || (strcmp(constraintName,"allowed-numbers") == 0) || (strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0)) && (parsedConstraints->range)) { NoConjunctiveUseError(theEnv,constraintName,"range"); return(FALSE); } /*===================================================*/ /* The allowed-... attributes are not allowed if the */ /* allowed-values attribute has already been parsed. */ /*===================================================*/ if ((strcmp(constraintName,"allowed-values") != 0) && (parsedConstraints->allowedValues)) { NoConjunctiveUseError(theEnv,constraintName,"allowed-values"); return(FALSE); } /*==================================================*/ /* The allowed-numbers attribute is not allowed if */ /* the allowed-integers or allowed-floats attribute */ /* has already been parsed. */ /*==================================================*/ if ((strcmp(constraintName,"allowed-numbers") == 0) && ((parsedConstraints->allowedFloats) || (parsedConstraints->allowedIntegers))) { if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats"; else tempPtr = "allowed-integers"; NoConjunctiveUseError(theEnv,"allowed-numbers",tempPtr); return(FALSE); } /*============================================================*/ /* The allowed-integers/floats attributes are not allowed if */ /* the allowed-numbers attribute has already been parsed. */ /*============================================================*/ if (((strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0)) && (parsedConstraints->allowedNumbers)) { NoConjunctiveUseError(theEnv,constraintName,"allowed-number"); return(FALSE); } /*==================================================*/ /* The allowed-lexemes attribute is not allowed if */ /* the allowed-symbols or allowed-strings attribute */ /* has already been parsed. */ /*==================================================*/ if ((strcmp(constraintName,"allowed-lexemes") == 0) && ((parsedConstraints->allowedSymbols) || (parsedConstraints->allowedStrings))) { if (parsedConstraints->allowedSymbols) tempPtr = "allowed-symbols"; else tempPtr = "allowed-strings"; NoConjunctiveUseError(theEnv,"allowed-lexemes",tempPtr); return(FALSE); } /*===========================================================*/ /* The allowed-symbols/strings attributes are not allowed if */ /* the allowed-lexemes attribute has already been parsed. */ /*===========================================================*/ if (((strcmp(constraintName,"allowed-symbols") == 0) || (strcmp(constraintName,"allowed-strings") == 0)) && (parsedConstraints->allowedLexemes)) { NoConjunctiveUseError(theEnv,constraintName,"allowed-lexemes"); return(FALSE); } /*========================*/ /* Get the expected type. */ /*========================*/ restrictionType = GetConstraintTypeFromAllowedName(constraintName); SetRestrictionFlag(restrictionType,constraints,TRUE); if (strcmp(constraintName,"allowed-classes") == 0) { expectedType = SYMBOL; } else { expectedType = restrictionType; } /*=================================================*/ /* Get the last value in the restriction list (the */ /* allowed values will be appended there). */ /*=================================================*/ if (strcmp(constraintName,"allowed-classes") == 0) { lastValue = constraints->classList; } else { lastValue = constraints->restrictionList; } if (lastValue != NULL) { while (lastValue->nextArg != NULL) lastValue = lastValue->nextArg; } /*==================================================*/ /* Read the allowed values and add them to the list */ /* until a right parenthesis is encountered. */ /*==================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); while (inputToken.type != RPAREN) { SavePPBuffer(theEnv," "); /*=============================================*/ /* Determine the type of the token just parsed */ /* and if it is an appropriate value. */ /*=============================================*/ switch(inputToken.type) { case INTEGER: if ((expectedType != UNKNOWN_VALUE) && (expectedType != INTEGER) && (expectedType != INTEGER_OR_FLOAT)) error = TRUE; constantParsed = TRUE; break; case FLOAT: if ((expectedType != UNKNOWN_VALUE) && (expectedType != FLOAT) && (expectedType != INTEGER_OR_FLOAT)) error = TRUE; constantParsed = TRUE; break; case STRING: if ((expectedType != UNKNOWN_VALUE) && (expectedType != STRING) && (expectedType != SYMBOL_OR_STRING)) error = TRUE; constantParsed = TRUE; break; case SYMBOL: if ((expectedType != UNKNOWN_VALUE) && (expectedType != SYMBOL) && (expectedType != SYMBOL_OR_STRING)) error = TRUE; constantParsed = TRUE; break; #if OBJECT_SYSTEM case INSTANCE_NAME: if ((expectedType != UNKNOWN_VALUE) && (expectedType != INSTANCE_NAME)) error = TRUE; constantParsed = TRUE; break; #endif case SF_VARIABLE: if (strcmp(inputToken.printForm,"?VARIABLE") == 0) { variableParsed = TRUE; } else { char tempBuffer[120]; gensprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } break; default: { char tempBuffer[120]; gensprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); } return(FALSE); } /*=====================================*/ /* Signal an error if an inappropriate */ /* value was found. */ /*=====================================*/ if (error) { PrintErrorID(theEnv,"CSTRNPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Value does not match the expected type for the "); EnvPrintRouter(theEnv,WERROR,constraintName); EnvPrintRouter(theEnv,WERROR," attribute\n"); return(FALSE); } /*======================================*/ /* The ?VARIABLE argument can't be used */ /* in conjunction with constants. */ /*======================================*/ if (constantParsed && variableParsed) { char tempBuffer[120]; gensprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*===========================================*/ /* Add the constant to the restriction list. */ /*===========================================*/ newValue = GenConstant(theEnv,inputToken.type,inputToken.value); if (lastValue == NULL) { if (strcmp(constraintName,"allowed-classes") == 0) { constraints->classList = newValue; } else { constraints->restrictionList = newValue; } } else { lastValue->nextArg = newValue; } lastValue = newValue; /*=======================================*/ /* Begin parsing the next allowed value. */ /*=======================================*/ GetToken(theEnv,readSource,&inputToken); } /*======================================================*/ /* There must be at least one value for this attribute. */ /*======================================================*/ if ((! constantParsed) && (! variableParsed)) { char tempBuffer[120]; gensprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*======================================*/ /* If ?VARIABLE was parsed, then remove */ /* the restrictions for the type being */ /* restricted. */ /*======================================*/ if (variableParsed) { switch(restrictionType) { case UNKNOWN_VALUE: constraints->anyRestriction = FALSE; break; case SYMBOL: constraints->symbolRestriction = FALSE; break; case STRING: constraints->stringRestriction = FALSE; break; case INTEGER: constraints->integerRestriction = FALSE; break; case FLOAT: constraints->floatRestriction = FALSE; break; case INTEGER_OR_FLOAT: constraints->floatRestriction = FALSE; constraints->integerRestriction = FALSE; break; case SYMBOL_OR_STRING: constraints->symbolRestriction = FALSE; constraints->stringRestriction = FALSE; break; case INSTANCE_NAME: constraints->instanceNameRestriction = FALSE; break; case INSTANCE_OR_INSTANCE_NAME: constraints->classRestriction = FALSE; break; } } /*=====================================*/ /* Fix up pretty print representation. */ /*=====================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*=======================================*/ /* Return TRUE to indicate the attribute */ /* was successfully parsed. */ /*=======================================*/ return(TRUE); } /***********************************************************/ /* NoConjunctiveUseError: Generic error message indicating */ /* that two attributes can't be used in conjunction. */ /***********************************************************/ static void NoConjunctiveUseError( void *theEnv, const char *attribute1, const char *attribute2) { PrintErrorID(theEnv,"CSTRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"The "); EnvPrintRouter(theEnv,WERROR,attribute1); EnvPrintRouter(theEnv,WERROR," attribute cannot be used\n"); EnvPrintRouter(theEnv,WERROR,"in conjunction with the "); EnvPrintRouter(theEnv,WERROR,attribute2); EnvPrintRouter(theEnv,WERROR," attribute.\n"); } /**************************************************/ /* ParseTypeAttribute: Parses the type attribute. */ /**************************************************/ static intBool ParseTypeAttribute( void *theEnv, const char *readSource, CONSTRAINT_RECORD *constraints) { int typeParsed = FALSE; int variableParsed = FALSE; int theType; struct token inputToken; /*======================================*/ /* Continue parsing types until a right */ /* parenthesis is encountered. */ /*======================================*/ SavePPBuffer(theEnv," "); for (GetToken(theEnv,readSource,&inputToken); inputToken.type != RPAREN; GetToken(theEnv,readSource,&inputToken)) { SavePPBuffer(theEnv," "); /*==================================*/ /* If the token is a symbol then... */ /*==================================*/ if (inputToken.type == SYMBOL) { /*==============================================*/ /* ?VARIABLE can't be used with type constants. */ /*==============================================*/ if (variableParsed == TRUE) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*========================================*/ /* Check for an appropriate type constant */ /* (e.g. SYMBOL, FLOAT, INTEGER, etc.). */ /*========================================*/ theType = GetConstraintTypeFromTypeName(ValueToString(inputToken.value)); if (theType < 0) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*==================================================*/ /* Change the type restriction flags to reflect the */ /* type restriction. If the type restriction was */ /* already specified, then a error is generated. */ /*==================================================*/ if (SetConstraintType(theType,constraints)) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } constraints->anyAllowed = FALSE; /*===========================================*/ /* Remember that a type constant was parsed. */ /*===========================================*/ typeParsed = TRUE; } /*==============================================*/ /* Otherwise if the token is a variable then... */ /*==============================================*/ else if (inputToken.type == SF_VARIABLE) { /*========================================*/ /* The only variable allowd is ?VARIABLE. */ /*========================================*/ if (strcmp(inputToken.printForm,"?VARIABLE") != 0) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*===================================*/ /* ?VARIABLE can't be used more than */ /* once or with type constants. */ /*===================================*/ if (typeParsed || variableParsed) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*======================================*/ /* Remember that a variable was parsed. */ /*======================================*/ variableParsed = TRUE; } /*====================================*/ /* Otherwise this is an invalid value */ /* for the type attribute. */ /*====================================*/ else { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } } /*=====================================*/ /* Fix up pretty print representation. */ /*=====================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*=======================================*/ /* The type attribute must have a value. */ /*=======================================*/ if ((! typeParsed) && (! variableParsed)) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*===========================================*/ /* Return TRUE indicating the type attibuted */ /* was successfully parsed. */ /*===========================================*/ return(TRUE); } /***************************************************************************/ /* ParseRangeCardinalityAttribute: Parses the range/cardinality attribute. */ /***************************************************************************/ static intBool ParseRangeCardinalityAttribute( void *theEnv, const char *readSource, CONSTRAINT_RECORD *constraints, CONSTRAINT_PARSE_RECORD *parsedConstraints, const char *constraintName, int multipleValuesAllowed) { struct token inputToken; int range; const char *tempPtr = NULL; /*=================================*/ /* Determine if we're parsing the */ /* range or cardinality attribute. */ /*=================================*/ if (strcmp(constraintName,"range") == 0) { parsedConstraints->range = TRUE; range = TRUE; } else { parsedConstraints->cardinality = TRUE; range = FALSE; } /*===================================================================*/ /* The cardinality attribute can only be used with multifield slots. */ /*===================================================================*/ if ((range == FALSE) && (multipleValuesAllowed == FALSE)) { PrintErrorID(theEnv,"CSTRNPSR",5,TRUE); EnvPrintRouter(theEnv,WERROR,"The cardinality attribute "); EnvPrintRouter(theEnv,WERROR,"can only be used with multifield slots.\n"); return(FALSE); } /*====================================================*/ /* The range attribute is not allowed with the */ /* allowed-values/numbers/integers/floats attributes. */ /*====================================================*/ if ((range == TRUE) && (parsedConstraints->allowedValues || parsedConstraints->allowedNumbers || parsedConstraints->allowedIntegers || parsedConstraints->allowedFloats)) { if (parsedConstraints->allowedValues) tempPtr = "allowed-values"; else if (parsedConstraints->allowedIntegers) tempPtr = "allowed-integers"; else if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats"; else if (parsedConstraints->allowedNumbers) tempPtr = "allowed-numbers"; NoConjunctiveUseError(theEnv,"range",tempPtr); return(FALSE); } /*==========================*/ /* Parse the minimum value. */ /*==========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); if ((inputToken.type == INTEGER) || ((inputToken.type == FLOAT) && range)) { if (range) { ReturnExpression(theEnv,constraints->minValue); constraints->minValue = GenConstant(theEnv,inputToken.type,inputToken.value); } else { if (ValueToLong(inputToken.value) < 0LL) { PrintErrorID(theEnv,"CSTRNPSR",6,TRUE); EnvPrintRouter(theEnv,WERROR,"Minimum cardinality value must be greater than or equal to zero\n"); return(FALSE); } ReturnExpression(theEnv,constraints->minFields); constraints->minFields = GenConstant(theEnv,inputToken.type,inputToken.value); } } else if ((inputToken.type == SF_VARIABLE) && (strcmp(inputToken.printForm,"?VARIABLE") == 0)) { /* Do nothing. */ } else { char tempBuffer[120]; gensprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*==========================*/ /* Parse the maximum value. */ /*==========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); if ((inputToken.type == INTEGER) || ((inputToken.type == FLOAT) && range)) { if (range) { ReturnExpression(theEnv,constraints->maxValue); constraints->maxValue = GenConstant(theEnv,inputToken.type,inputToken.value); } else { ReturnExpression(theEnv,constraints->maxFields); constraints->maxFields = GenConstant(theEnv,inputToken.type,inputToken.value); } } else if ((inputToken.type == SF_VARIABLE) && (strcmp(inputToken.printForm,"?VARIABLE") == 0)) { /* Do nothing. */ } else { char tempBuffer[120]; gensprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*================================*/ /* Parse the closing parenthesis. */ /*================================*/ GetToken(theEnv,readSource,&inputToken); if (inputToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"range attribute"); return(FALSE); } /*====================================================*/ /* Minimum value must be less than the maximum value. */ /*====================================================*/ if (range) { if (CompareNumbers(theEnv,constraints->minValue->type, constraints->minValue->value, constraints->maxValue->type, constraints->maxValue->value) == GREATER_THAN) { PrintErrorID(theEnv,"CSTRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Minimum range value must be less than\n"); EnvPrintRouter(theEnv,WERROR,"or equal to the maximum range value\n"); return(FALSE); } } else { if (CompareNumbers(theEnv,constraints->minFields->type, constraints->minFields->value, constraints->maxFields->type, constraints->maxFields->value) == GREATER_THAN) { PrintErrorID(theEnv,"CSTRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Minimum cardinality value must be less than\n"); EnvPrintRouter(theEnv,WERROR,"or equal to the maximum cardinality value\n"); return(FALSE); } } /*====================================*/ /* Return TRUE to indicate that the */ /* attribute was successfully parsed. */ /*====================================*/ return(TRUE); } /******************************************************************/ /* GetConstraintTypeFromAllowedName: Returns the type restriction */ /* associated with an allowed-... attribute. */ /******************************************************************/ static int GetConstraintTypeFromAllowedName( const char *constraintName) { if (strcmp(constraintName,"allowed-values") == 0) return(UNKNOWN_VALUE); else if (strcmp(constraintName,"allowed-symbols") == 0) return(SYMBOL); else if (strcmp(constraintName,"allowed-strings") == 0) return(STRING); else if (strcmp(constraintName,"allowed-lexemes") == 0) return(SYMBOL_OR_STRING); else if (strcmp(constraintName,"allowed-integers") == 0) return(INTEGER); else if (strcmp(constraintName,"allowed-numbers") == 0) return(INTEGER_OR_FLOAT); else if (strcmp(constraintName,"allowed-instance-names") == 0) return(INSTANCE_NAME); else if (strcmp(constraintName,"allowed-classes") == 0) return(INSTANCE_OR_INSTANCE_NAME); else if (strcmp(constraintName,"allowed-floats") == 0) return(FLOAT); return(-1); } /*******************************************************/ /* GetConstraintTypeFromTypeName: Converts a type name */ /* to its equivalent integer type restriction. */ /*******************************************************/ static int GetConstraintTypeFromTypeName( const char *constraintName) { if (strcmp(constraintName,"SYMBOL") == 0) return(SYMBOL); else if (strcmp(constraintName,"STRING") == 0) return(STRING); else if (strcmp(constraintName,"LEXEME") == 0) return(SYMBOL_OR_STRING); else if (strcmp(constraintName,"INTEGER") == 0) return(INTEGER); else if (strcmp(constraintName,"FLOAT") == 0) return(FLOAT); else if (strcmp(constraintName,"NUMBER") == 0) return(INTEGER_OR_FLOAT); else if (strcmp(constraintName,"INSTANCE-NAME") == 0) return(INSTANCE_NAME); else if (strcmp(constraintName,"INSTANCE-ADDRESS") == 0) return(INSTANCE_ADDRESS); else if (strcmp(constraintName,"INSTANCE") == 0) return(INSTANCE_OR_INSTANCE_NAME); else if (strcmp(constraintName,"EXTERNAL-ADDRESS") == 0) return(EXTERNAL_ADDRESS); else if (strcmp(constraintName,"FACT-ADDRESS") == 0) return(FACT_ADDRESS); return(-1); } /**************************************************************/ /* GetAttributeParseValue: Returns a boolean value indicating */ /* whether a specific attribute has already been parsed. */ /**************************************************************/ static int GetAttributeParseValue( const char *constraintName, CONSTRAINT_PARSE_RECORD *parsedConstraints) { if (strcmp(constraintName,"type") == 0) { return(parsedConstraints->type); } else if (strcmp(constraintName,"range") == 0) { return(parsedConstraints->range); } else if (strcmp(constraintName,"cardinality") == 0) { return(parsedConstraints->cardinality); } else if (strcmp(constraintName,"allowed-values") == 0) { return(parsedConstraints->allowedValues); } else if (strcmp(constraintName,"allowed-symbols") == 0) { return(parsedConstraints->allowedSymbols); } else if (strcmp(constraintName,"allowed-strings") == 0) { return(parsedConstraints->allowedStrings); } else if (strcmp(constraintName,"allowed-lexemes") == 0) { return(parsedConstraints->allowedLexemes); } else if (strcmp(constraintName,"allowed-instance-names") == 0) { return(parsedConstraints->allowedInstanceNames); } else if (strcmp(constraintName,"allowed-classes") == 0) { return(parsedConstraints->allowedClasses); } else if (strcmp(constraintName,"allowed-integers") == 0) { return(parsedConstraints->allowedIntegers); } else if (strcmp(constraintName,"allowed-floats") == 0) { return(parsedConstraints->allowedFloats); } else if (strcmp(constraintName,"allowed-numbers") == 0) { return(parsedConstraints->allowedNumbers); } return(TRUE); } /**********************************************************/ /* SetRestrictionFlag: Sets the restriction flag of a */ /* constraint record indicating whether a specific */ /* type has an associated allowed-... restriction list. */ /**********************************************************/ static void SetRestrictionFlag( int restriction, CONSTRAINT_RECORD *constraints, int value) { switch (restriction) { case UNKNOWN_VALUE: constraints->anyRestriction = value; break; case SYMBOL: constraints->symbolRestriction = value; break; case STRING: constraints->stringRestriction = value; break; case INTEGER: constraints->integerRestriction = value; break; case FLOAT: constraints->floatRestriction = value; break; case INTEGER_OR_FLOAT: constraints->integerRestriction = value; constraints->floatRestriction = value; break; case SYMBOL_OR_STRING: constraints->symbolRestriction = value; constraints->stringRestriction = value; break; case INSTANCE_NAME: constraints->instanceNameRestriction = value; break; case INSTANCE_OR_INSTANCE_NAME: constraints->classRestriction = value; break; } } /********************************************************************/ /* SetParseFlag: Sets the flag in a parsed constraints data */ /* structure indicating that a specific attribute has been parsed. */ /********************************************************************/ static void SetParseFlag( CONSTRAINT_PARSE_RECORD *parsedConstraints, const char *constraintName) { if (strcmp(constraintName,"range") == 0) { parsedConstraints->range = TRUE; } else if (strcmp(constraintName,"type") == 0) { parsedConstraints->type = TRUE; } else if (strcmp(constraintName,"cardinality") == 0) { parsedConstraints->cardinality = TRUE; } else if (strcmp(constraintName,"allowed-symbols") == 0) { parsedConstraints->allowedSymbols = TRUE; } else if (strcmp(constraintName,"allowed-strings") == 0) { parsedConstraints->allowedStrings = TRUE; } else if (strcmp(constraintName,"allowed-lexemes") == 0) { parsedConstraints->allowedLexemes = TRUE; } else if (strcmp(constraintName,"allowed-integers") == 0) { parsedConstraints->allowedIntegers = TRUE; } else if (strcmp(constraintName,"allowed-floats") == 0) { parsedConstraints->allowedFloats = TRUE; } else if (strcmp(constraintName,"allowed-numbers") == 0) { parsedConstraints->allowedNumbers = TRUE; } else if (strcmp(constraintName,"allowed-values") == 0) { parsedConstraints->allowedValues = TRUE; } else if (strcmp(constraintName,"allowed-classes") == 0) { parsedConstraints->allowedClasses = TRUE; } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips_core_source_630/core/rulecstr.h0000755000175000017500000000502212374024363016250 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE CONSTRAINTS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for detecting constraint */ /* conflicts in the LHS and RHS of rules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /*************************************************************/ #ifndef _H_rulecstr #define _H_rulecstr #ifdef LOCALE #undef LOCALE #endif #ifdef _RULECSTR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct lhsParseNode *GetExpressionVarConstraints(void *,struct lhsParseNode *); LOCALE struct lhsParseNode *DeriveVariableConstraints(void *,struct lhsParseNode *); LOCALE intBool ProcessConnectedConstraints(void *,struct lhsParseNode *,struct lhsParseNode *,struct lhsParseNode *); LOCALE void ConstraintReferenceErrorMessage(void *, struct symbolHashNode *, struct lhsParseNode *, int,int, struct symbolHashNode *, int); LOCALE intBool CheckRHSForConstraintErrors(void *,struct expr *,struct lhsParseNode *); #endif /* _H_rulecstr */ clips_core_source_630/core/._dffctbin.h0000755000175000017500000000040712373730714016406 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/lgcldpnd.h0000755000175000017500000000615012373744000016173 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* LOGICAL DEPENDENCIES HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provide support routines for managing truth */ /* maintenance using the logical conditional element. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /*************************************************************/ #ifndef _H_lgcldpnd #define _H_lgcldpnd struct dependency { void *dPtr; struct dependency *next; }; #ifndef _H_match #include "match.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _LGCLDPND_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool AddLogicalDependencies(void *,struct patternEntity *,int); LOCALE void RemoveEntityDependencies(void *,struct patternEntity *); LOCALE void RemovePMDependencies(void *,struct partialMatch *); LOCALE void DestroyPMDependencies(void *,struct partialMatch *); LOCALE void RemoveLogicalSupport(void *,struct partialMatch *); LOCALE void ForceLogicalRetractions(void *); LOCALE void Dependencies(void *,struct patternEntity *); LOCALE void Dependents(void *,struct patternEntity *); LOCALE void DependenciesCommand(void *); LOCALE void DependentsCommand(void *); LOCALE void ReturnEntityDependencies(void *,struct patternEntity *); LOCALE struct partialMatch *FindLogicalBind(struct joinNode *,struct partialMatch *); #endif /* _H_lgcldpnd */ clips_core_source_630/core/._userfunctions.c0000644000175000017500000000040712424476502017525 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factcom.h0000755000175000017500000001061412464554105016026 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* FACT COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /*************************************************************/ #ifndef _H_factcom #define _H_factcom #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactCommandDefinitions(void *); LOCALE void AssertCommand(void *,DATA_OBJECT_PTR); LOCALE void RetractCommand(void *); LOCALE void AssertStringFunction(void *,DATA_OBJECT_PTR); LOCALE void FactsCommand(void *); LOCALE void EnvFacts(void *,const char *,void *,long long,long long,long long); LOCALE int SetFactDuplicationCommand(void *); LOCALE int GetFactDuplicationCommand(void *); LOCALE int SaveFactsCommand(void *); LOCALE int LoadFactsCommand(void *); LOCALE int EnvSaveFacts(void *,const char *,int); LOCALE int EnvSaveFactsDriver(void *,const char *,int,struct expr *); LOCALE int EnvLoadFacts(void *,const char *); LOCALE int EnvLoadFactsFromString(void *,const char *,long); LOCALE long long FactIndexFunction(void *); #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS LOCALE void Facts(const char *,void *,long long,long long,long long); #endif LOCALE intBool LoadFacts(const char *); LOCALE intBool SaveFacts(const char *,int); LOCALE intBool LoadFactsFromString(const char *,int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_factcom */ clips_core_source_630/core/._dffnxcmp.h0000755000175000017500000000040712373731203016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffnxfun.h0000755000175000017500000000040712461252076016443 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._modulutl.h0000755000175000017500000000040712374017664016477 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulelhs.c0000755000175000017500000012016512365012263016060 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 07/25/14 */ /* */ /* DEFRULE LHS PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Coordinates parsing of the LHS conditional */ /* elements of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _RULELHS_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "agenda.h" #include "argacces.h" #include "constant.h" #include "constrct.h" #include "constrnt.h" #include "cstrnchk.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "pattern.h" #include "reorder.h" #include "router.h" #include "ruledef.h" #include "scanner.h" #include "symbol.h" #include "rulelhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct lhsParseNode *RuleBodyParse(void *,const char *,struct token *,const char *,int *); static void DeclarationParse(void *,const char *,const char *,int *); static struct lhsParseNode *LHSPattern(void *,const char *,int,const char *,int *,int, struct token *,const char *); static struct lhsParseNode *ConnectedPatternParse(void *,const char *,struct token *,int *); static struct lhsParseNode *GroupPatterns(void *,const char *,int,const char *,int *); static struct lhsParseNode *TestPattern(void *,const char *,int *); static struct lhsParseNode *AssignmentParse(void *,const char *,SYMBOL_HN *,int *); static void TagLHSLogicalNodes(struct lhsParseNode *); static struct lhsParseNode *SimplePatternParse(void *,const char *,struct token *,int *); static void ParseSalience(void *,const char *,const char *,int *); static void ParseAutoFocus(void *,const char *,int *); /*******************************************************************/ /* ParseRuleLHS: Coordinates all the actions necessary for parsing */ /* the LHS of a rule including the reordering of pattern */ /* conditional elements to conform with the KB Rete topology. */ /*******************************************************************/ globle struct lhsParseNode *ParseRuleLHS( void *theEnv, const char *readSource, struct token *theToken, const char *ruleName, int *error) { struct lhsParseNode *theLHS; int result; *error = FALSE; /*========================================*/ /* Initialize salience parsing variables. */ /*========================================*/ PatternData(theEnv)->GlobalSalience = 0; PatternData(theEnv)->GlobalAutoFocus = FALSE; PatternData(theEnv)->SalienceExpression = NULL; /*============================*/ /* Set the indentation depth. */ /*============================*/ SetIndentDepth(theEnv,3); /*=====================================================*/ /* Get the raw representation for the LHS of the rule. */ /*=====================================================*/ theLHS = RuleBodyParse(theEnv,readSource,theToken,ruleName,error); if (*error) return(NULL); /*====================================================*/ /* Reorder the raw representation so that it consists */ /* of at most a single top level OR CE containing one */ /* or more AND CEs. */ /*====================================================*/ theLHS = ReorderPatterns(theEnv,theLHS,&result); /*================================*/ /* Return the LHS representation. */ /*================================*/ return(theLHS); } /*********************************************************/ /* RuleBodyParse: Parses the LHS of a rule, but does not */ /* reorder any of the LHS patterns to conform with the */ /* KB Rete Topology. */ /* */ /* ::= [] */ /* * */ /* => */ /*********************************************************/ static struct lhsParseNode *RuleBodyParse( void *theEnv, const char *readSource, struct token *theToken, const char *ruleName, int *error) { struct lhsParseNode *theNode, *otherNodes; /*=============================*/ /* Set the error return value. */ /*=============================*/ *error = FALSE; /*==================================================*/ /* If we're already at the separator, "=>", between */ /* the LHS and RHS, then the LHS is empty. */ /*==================================================*/ if ((theToken->type == SYMBOL) ? (strcmp(ValueToString(theToken->value),"=>") == 0) : FALSE) { return(NULL); } /*===========================================*/ /* Parse the first pattern as a special case */ /* (the declare statement is allowed). */ /*===========================================*/ theNode = LHSPattern(theEnv,readSource,SYMBOL,"=>",error,TRUE,theToken,ruleName); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } PPCRAndIndent(theEnv); /*======================================*/ /* Parse the other patterns in the LHS. */ /*======================================*/ otherNodes = GroupPatterns(theEnv,readSource,SYMBOL,"=>",error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*================================================*/ /* Construct the final LHS by combining the first */ /* pattern with the remaining patterns. */ /*================================================*/ if (theNode == NULL) { theNode = otherNodes; } else { theNode->bottom = otherNodes; } /*=======================*/ /* Return the final LHS. */ /*=======================*/ return(theNode); } /********************************************************/ /* DeclarationParse: Parses a defrule declaration. */ /* */ /* ::= (declare +) */ /* */ /* ::= (salience ) */ /* ::= (auto-focus TRUE | FALSE) */ /********************************************************/ static void DeclarationParse( void *theEnv, const char *readSource, const char *ruleName, int *error) { struct token theToken; struct expr *packPtr; int notDone = TRUE; int salienceParsed = FALSE, autoFocusParsed = FALSE; /*===========================*/ /* Next token must be a '('. */ /*===========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; return; } /*==========================================*/ /* Continue parsing until there are no more */ /* valid rule property declarations. */ /*==========================================*/ while (notDone) { /*=============================================*/ /* The name of a rule property must be symbol. */ /*=============================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; } /*==============================================*/ /* Parse a salience declaration if encountered. */ /*==============================================*/ else if (strcmp(ValueToString(theToken.value),"salience") == 0) { if (salienceParsed) { AlreadyParsedErrorMessage(theEnv,"salience declaration",NULL); *error = TRUE; } else { ParseSalience(theEnv,readSource,ruleName,error); salienceParsed = TRUE; } } /*=================================================*/ /* Parse an auto-focus declaration if encountered. */ /* A global flag is used to indicate if the */ /* auto-focus feature for a rule was parsed. */ /*=================================================*/ else if (strcmp(ValueToString(theToken.value),"auto-focus") == 0) { if (autoFocusParsed) { AlreadyParsedErrorMessage(theEnv,"auto-focus declaration",NULL); *error = TRUE; } else { ParseAutoFocus(theEnv,readSource,error); autoFocusParsed = TRUE; } } /*==========================================*/ /* Otherwise the symbol does not correspond */ /* to a valid rule property. */ /*==========================================*/ else { SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; } /*=====================================*/ /* Return if an error was encountered. */ /*=====================================*/ if (*error) { ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return; } /*=======================================*/ /* Both the salience and auto-focus rule */ /* properties are closed with a ')'. */ /*=======================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; return; } /*=============================================*/ /* The declare statement is closed with a ')'. */ /*=============================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type == RPAREN) notDone = FALSE; else if (theToken.type != LPAREN) { ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; return; } else { PPBackup(theEnv); SavePPBuffer(theEnv," ("); } } /*==========================================*/ /* Return the value of the salience through */ /* the global variable SalienceExpression. */ /*==========================================*/ packPtr = PackExpression(theEnv,PatternData(theEnv)->SalienceExpression); ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = packPtr; return; } /************************************************************/ /* ParseSalience: Parses the rest of a defrule salience */ /* declaration once the salience keyword has been parsed. */ /************************************************************/ static void ParseSalience( void *theEnv, const char *readSource, const char *ruleName, int *error) { int salience; DATA_OBJECT salienceValue; /*==============================*/ /* Get the salience expression. */ /*==============================*/ SavePPBuffer(theEnv," "); PatternData(theEnv)->SalienceExpression = ParseAtomOrExpression(theEnv,readSource,NULL); if (PatternData(theEnv)->SalienceExpression == NULL) { *error = TRUE; return; } /*============================================================*/ /* Evaluate the expression and determine if it is an integer. */ /*============================================================*/ SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,PatternData(theEnv)->SalienceExpression,&salienceValue)) { SalienceInformationError(theEnv,"defrule",ruleName); *error = TRUE; return; } if (salienceValue.type != INTEGER) { SalienceNonIntegerError(theEnv); *error = TRUE; return; } /*=======================================================*/ /* Salience number must be in the range -10000 to 10000. */ /*=======================================================*/ salience = (int) ValueToLong(salienceValue.value); if ((salience > MAX_DEFRULE_SALIENCE) || (salience < MIN_DEFRULE_SALIENCE)) { SalienceRangeError(theEnv,MIN_DEFRULE_SALIENCE,MAX_DEFRULE_SALIENCE); *error = TRUE; return; } /*==========================================*/ /* If the expression is a constant integer, */ /* don't bother storing the expression. */ /*==========================================*/ if (PatternData(theEnv)->SalienceExpression->type == INTEGER) { ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; } PatternData(theEnv)->GlobalSalience = salience; } /**************************************************************/ /* ParseAutoFocus: Parses the rest of a defrule auto-focus */ /* declaration once the auto-focus keyword has been parsed. */ /**************************************************************/ static void ParseAutoFocus( void *theEnv, const char *readSource, int *error) { struct token theToken; /*========================================*/ /* The auto-focus value must be a symbol. */ /*========================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"auto-focus statement"); *error = TRUE; return; } /*====================================================*/ /* The auto-focus value must be either TRUE or FALSE. */ /* If a valid value is parsed, then set the value of */ /* the global variable GlobalAutoFocus. */ /*====================================================*/ if (strcmp(ValueToString(theToken.value),"TRUE") == 0) { PatternData(theEnv)->GlobalAutoFocus = TRUE; } else if (strcmp(ValueToString(theToken.value),"FALSE") == 0) { PatternData(theEnv)->GlobalAutoFocus = FALSE; } else { SyntaxErrorMessage(theEnv,"auto-focus statement"); *error = TRUE; } } /*****************************************************************/ /* LHSPattern: Parses a single conditional element found on the */ /* LHS of a rule. Conditonal element types include pattern CEs */ /* (which may be assigned to a variable), test CEs, not CEs, */ /* logical CEs, and CEs, and or CEs. */ /* */ /* ::= | */ /* | */ /* | | | */ /* | | */ /* | */ /*****************************************************************/ static struct lhsParseNode *LHSPattern( void *theEnv, const char *readSource, int terminator, const char *terminatorString, int *error, int allowDeclaration, struct token *firstToken, const char *ruleName) { struct token theToken; struct lhsParseNode *theNode; /*=========================================================*/ /* Check to see if the first token has already been read. */ /* This should only occur for the first pattern in a rule. */ /*=========================================================*/ if (firstToken == NULL) GetToken(theEnv,readSource,&theToken); else CopyToken(&theToken,firstToken); /*=====================================================*/ /* A left parenthesis begins all CEs and declarations. */ /*=====================================================*/ if (theToken.type == LPAREN) { /*================================================*/ /* The first field of a pattern must be a symbol. */ /*================================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"the first field of a pattern"); *error = TRUE; return(NULL); } /*====================================*/ /* If this is the first CE of a rule, */ /* then a declare statement is valid. */ /*====================================*/ if (allowDeclaration && (strcmp(ValueToString(theToken.value),"declare") == 0)) { if (ruleName == NULL) SystemError(theEnv,"RULELHS",1); DeclarationParse(theEnv,readSource,ruleName,error); theNode = NULL; } /*==================================*/ /* Otherwise check for a *test* CE. */ /*==================================*/ else if (strcmp(ValueToString(theToken.value),"test") == 0) { theNode = TestPattern(theEnv,readSource,error); } /*============================================*/ /* Otherwise check for an *and*, *or*, *not*, */ /* *logical*, *exists*, or *forall* CE. */ /*============================================*/ else if ((strcmp(ValueToString(theToken.value),"and") == 0) || (strcmp(ValueToString(theToken.value),"logical") == 0) || (strcmp(ValueToString(theToken.value),"not") == 0) || (strcmp(ValueToString(theToken.value),"exists") == 0) || (strcmp(ValueToString(theToken.value),"forall") == 0) || (strcmp(ValueToString(theToken.value),"or") == 0)) { theNode = ConnectedPatternParse(theEnv,readSource,&theToken,error); } /*=================================*/ /* Otherwise parse a *pattern* CE. */ /*=================================*/ else { theNode = SimplePatternParse(theEnv,readSource,&theToken,error); } } /*=======================================*/ /* Check for a pattern address variable. */ /*=======================================*/ else if (theToken.type == SF_VARIABLE) { theNode = AssignmentParse(theEnv,readSource,(SYMBOL_HN *) theToken.value,error); } /*=================================================*/ /* Check for the group terminator (either a "=>" */ /* separating the LHS from the RHS or a ")" ending */ /* a CE containing other CEs such as an *and* CE). */ /*=================================================*/ else if ((theToken.type == terminator) ? (strcmp(theToken.printForm,terminatorString) == 0) : FALSE) { return(NULL); } /*====================================*/ /* Otherwise invalid syntax was used. */ /*====================================*/ else { SyntaxErrorMessage(theEnv,"defrule"); *error = TRUE; return(NULL); } /*================================*/ /* If an error occurred, free any */ /* allocated data structures. */ /*================================*/ if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=========================*/ /* Return the LHS pattern. */ /*=========================*/ return(theNode); } /*********************************************************************/ /* ConnectedPatternParse: Handles parsing of the connected */ /* conditional elements (i.e. those conditional elements that may */ /* contain one or more other conditional elements). The connected */ /* conditional elements include the *and*, *or*, *not*, *logical*, */ /* *exists*, and *forall* CEs. This routine is entered with the */ /* parsing pointing to the name of the connected CE. It is exited */ /* with the parser pointing to the closing right parenthesis of */ /* the connected CE. */ /* */ /* ::= (and +) */ /* */ /* ::= (or +) */ /* */ /* ::= (logical +) */ /* */ /* ::= (not ) */ /* */ /* ::= (exists +) */ /* */ /* ::= (forall */ /* +) */ /*********************************************************************/ static struct lhsParseNode *ConnectedPatternParse( void *theEnv, const char *readSource, struct token *theToken, int *error) { unsigned short connectorValue = 0; struct lhsParseNode *theNode, *tempNode, *theGroup; const char *errorCE = NULL; int logical = FALSE; int tempValue; /*==========================================================*/ /* Use appropriate spacing for pretty printing of the rule. */ /*==========================================================*/ IncrementIndentDepth(theEnv,5); if (strcmp(ValueToString(theToken->value),"or") == 0) { connectorValue = OR_CE; errorCE = "the or conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"and") == 0) { connectorValue = AND_CE; errorCE = "the and conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"not") == 0) { connectorValue = NOT_CE; errorCE = "the not conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"exists") == 0) { connectorValue = EXISTS_CE; errorCE = "the exists conditional element"; PPCRAndIndent(theEnv); } else if (strcmp(ValueToString(theToken->value),"forall") == 0) { connectorValue = FORALL_CE; errorCE = "the forall conditional element"; PPCRAndIndent(theEnv); } else if (strcmp(ValueToString(theToken->value),"logical") == 0) { connectorValue = AND_CE; errorCE = "the logical conditional element"; logical = TRUE; PPCRAndIndent(theEnv); } /*=====================================================*/ /* The logical CE cannot be contained within a not CE. */ /*=====================================================*/ if (PatternData(theEnv)->WithinNotCE && logical) { PrintErrorID(theEnv,"RULELHS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The logical CE cannot be used within a not/exists/forall CE.\n"); *error = TRUE; return(NULL); } /*=====================================================*/ /* Remember if we're currently within a *not* CE and */ /* then check to see if we're entering a new *not* CE. */ /*=====================================================*/ tempValue = PatternData(theEnv)->WithinNotCE; if ((connectorValue == NOT_CE) || (connectorValue == EXISTS_CE) || (connectorValue == FORALL_CE)) { PatternData(theEnv)->WithinNotCE = TRUE; } /*===========================================*/ /* Parse all of the CEs contained with the */ /* CE. A ) will terminate the end of the CE. */ /*===========================================*/ theGroup = GroupPatterns(theEnv,readSource,RPAREN,")",error); /*====================================*/ /* Restore the "with a *not* CE" flag */ /* and reset the indentation depth. */ /*====================================*/ PatternData(theEnv)->WithinNotCE = tempValue; DecrementIndentDepth(theEnv,5); /*============================================*/ /* If an error occured while parsing, return. */ /*============================================*/ if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theGroup); return(NULL); } /*=========================================================*/ /* If we parsed a *logical* CE, then mark the logical flag */ /* for all of the CEs contained within the logical CE. */ /*=========================================================*/ if (logical) TagLHSLogicalNodes(theGroup); /*=====================================================*/ /* All the connected CEs must contain at least one CE. */ /*=====================================================*/ if (theGroup == NULL) { SyntaxErrorMessage(theEnv,errorCE); *error = TRUE; return(NULL); } /*============================================*/ /* A not CE may not contain more than one CE. */ /*============================================*/ if ((connectorValue == NOT_CE) && (theGroup->bottom != NULL)) { SyntaxErrorMessage(theEnv,errorCE); ReturnLHSParseNodes(theEnv,theGroup); *error = TRUE; return(NULL); } /*============================================*/ /* A forall CE must contain at least two CEs. */ /*============================================*/ if ((connectorValue == FORALL_CE) && (theGroup->bottom == NULL)) { SyntaxErrorMessage(theEnv,errorCE); ReturnLHSParseNodes(theEnv,theGroup); *error = TRUE; return(NULL); } /*========================================================*/ /* Remove an "and" and "or" CE that only contains one CE. */ /*========================================================*/ if (((connectorValue == AND_CE) || (connectorValue == OR_CE)) && (theGroup->bottom == NULL)) { theGroup->logical = logical; return(theGroup); } /*===========================================================*/ /* Create the top most node which connects the CEs together. */ /*===========================================================*/ theNode = GetLHSParseNode(theEnv); theNode->logical = logical; /*======================================================*/ /* Attach and/or/not CEs directly to the top most node. */ /*======================================================*/ if ((connectorValue == AND_CE) || (connectorValue == OR_CE) || (connectorValue == NOT_CE)) { theNode->type = connectorValue; theNode->right = theGroup; } /*=================================================================*/ /* Wrap two not CEs around the patterns contained in an exists CE. */ /*=================================================================*/ else if (connectorValue == EXISTS_CE) { theNode->type = NOT_CE; theNode->right = GetLHSParseNode(theEnv); theNode->right->type = NOT_CE; theNode->right->logical = logical; if (theGroup->bottom != NULL) { theNode->right->right = GetLHSParseNode(theEnv); theNode->right->right->type = AND_CE; theNode->right->right->logical = logical; theNode->right->right->right = theGroup; } else { theNode->right->right = theGroup; } } /*==================================================*/ /* For a forall CE, wrap a not CE around all of the */ /* CEs and a not CE around the 2nd through nth CEs. */ /*==================================================*/ else if (connectorValue == FORALL_CE) { theNode->type = NOT_CE; tempNode = theGroup->bottom; theGroup->bottom = NULL; theNode->right = GetLHSParseNode(theEnv); theNode->right->type = AND_CE; theNode->right->logical = logical; theNode->right->right = theGroup; theGroup = tempNode; theNode->right->right->bottom = GetLHSParseNode(theEnv); theNode->right->right->bottom->type = NOT_CE; theNode->right->right->bottom->logical = logical; tempNode = theNode->right->right->bottom; if (theGroup->bottom == NULL) { tempNode->right = theGroup; } else { tempNode->right = GetLHSParseNode(theEnv); tempNode->right->type = AND_CE; tempNode->right->logical = logical; tempNode->right->right = theGroup; } } /*================*/ /* Return the CE. */ /*================*/ return(theNode); } /***********************************************/ /* GroupPatterns: Groups a series of connected */ /* conditional elements together. */ /***********************************************/ static struct lhsParseNode *GroupPatterns( void *theEnv, const char *readSource, int terminator, const char *terminatorString, int *error) { struct lhsParseNode *lastNode, *newNode, *theNode; lastNode = theNode = NULL; while (TRUE) { /*==================*/ /* Get the next CE. */ /*==================*/ newNode = LHSPattern(theEnv,readSource,terminator,terminatorString, error,FALSE,NULL,NULL); /*=======================================================*/ /* If an error occurred, release any LHS data structures */ /* previously allocated by this routine. */ /*=======================================================*/ if (*error) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*===============================================*/ /* A NULL value for the CE just parsed indicates */ /* that the terminator for the group of patterns */ /* was encountered (either a "=>" or a ")". */ /*===============================================*/ if (newNode == NULL) { PPBackup(theEnv); PPBackup(theEnv); if (terminator == RPAREN) { SavePPBuffer(theEnv,terminatorString); } else { PPCRAndIndent(theEnv); SavePPBuffer(theEnv,terminatorString); } return(theNode); } /*============================*/ /* Add the new CE to the list */ /* of CEs being grouped. */ /*============================*/ if (lastNode == NULL) { theNode = newNode; } else { lastNode->bottom = newNode; } lastNode = newNode; /*======================================*/ /* Fix the pretty print representation. */ /*======================================*/ PPCRAndIndent(theEnv); } } /**************************************************************/ /* TestPattern: Handles parsing of test conditional elements. */ /* */ /* ::= (test ) */ /**************************************************************/ static struct lhsParseNode *TestPattern( void *theEnv, const char *readSource, int *error) { struct lhsParseNode *theNode; struct token theToken; struct expr *theExpression; /*================================================*/ /* Create the data specification for the test CE. */ /*================================================*/ SavePPBuffer(theEnv," "); theNode = GetLHSParseNode(theEnv); theNode->type = TEST_CE; theExpression = Function0Parse(theEnv,readSource); theNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); if (theNode->expression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=========================================================*/ /* Check for the closing right parenthesis of the test CE. */ /*=========================================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"test conditional element"); *error = TRUE; ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=====================*/ /* Return the test CE. */ /*=====================*/ return(theNode); } /****************************************************************/ /* AssignmentParse: Finishes the parsing of pattern conditional */ /* elements that have been bound to a variable. */ /* */ /* ::= ? <- */ /****************************************************************/ static struct lhsParseNode *AssignmentParse( void *theEnv, const char *readSource, SYMBOL_HN *factAddress, int *error) { struct lhsParseNode *theNode; struct token theToken; /*=====================================================*/ /* Patterns cannot be bound if they are with a not CE. */ /*=====================================================*/ if (PatternData(theEnv)->WithinNotCE) { PrintErrorID(theEnv,"RULELHS",2,TRUE); EnvPrintRouter(theEnv,WERROR,"A pattern CE cannot be bound to a pattern-address within a not CE\n"); *error = TRUE; return(NULL); } /*===============================================*/ /* Check for binder token, "<-", after variable. */ /*===============================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); if ((theToken.type == SYMBOL) ? (strcmp(ValueToString(theToken.value),"<-") != 0) : TRUE) { SyntaxErrorMessage(theEnv,"binding patterns"); *error = TRUE; return(NULL); } SavePPBuffer(theEnv," "); /*================================================*/ /* Check for opening left parenthesis of pattern. */ /*================================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"binding patterns"); *error = TRUE; return(NULL); } /*======================================================*/ /* Parse the pattern and return the data specification. */ /*======================================================*/ GetToken(theEnv,readSource,&theToken); theNode = SimplePatternParse(theEnv,readSource,&theToken,error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=============================================*/ /* Store the name of the variable to which the */ /* pattern is bound and return the pattern. */ /*=============================================*/ theNode->value = (void *) factAddress; return(theNode); } /************************************************************/ /* TagLHSLogicalNodes: Marks all *and*, *or*, and *not* CEs */ /* contained within a logical CE as having the properties */ /* associated with a logical CE. */ /************************************************************/ static void TagLHSLogicalNodes( struct lhsParseNode *nodePtr) { while (nodePtr != NULL) { nodePtr->logical = TRUE; if ((nodePtr->type == AND_CE) || (nodePtr->type == OR_CE) || (nodePtr->type == NOT_CE)) { TagLHSLogicalNodes(nodePtr->right); } nodePtr = nodePtr->bottom; } } /***********************************************************/ /* SimplePatternParse: Parses a simple pattern (an opening */ /* parenthesis followed by one or more fields followed */ /* by a closing parenthesis). */ /* */ /* ::= | */ /* */ /***********************************************************/ static struct lhsParseNode *SimplePatternParse( void *theEnv, const char *readSource, struct token *theToken, int *error) { struct lhsParseNode *theNode; struct patternParser *tempParser; /*=================================================*/ /* The first field of a pattern must be a symbol. */ /* In addition, the symbols ":" and "=" can not */ /* be used because they have special significance. */ /*=================================================*/ if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"the first field of a pattern"); *error = TRUE; return(NULL); } else if ((strcmp(ValueToString(theToken->value),"=") == 0) || (strcmp(ValueToString(theToken->value),":") == 0)) { SyntaxErrorMessage(theEnv,"the field field of a pattern"); *error = TRUE; return(NULL); } /*===============================================*/ /* Construct the topmost node of the pattern CE. */ /*===============================================*/ theNode = GetLHSParseNode(theEnv); theNode->type = PATTERN_CE; theNode->negated = FALSE; theNode->exists = FALSE; /*======================================================*/ /* Search for a pattern parser that claims the pattern. */ /*======================================================*/ for (tempParser = PatternData(theEnv)->ListOfPatternParsers; tempParser != NULL; tempParser = tempParser->next) { if ((*tempParser->recognizeFunction)((SYMBOL_HN *) theToken->value)) { theNode->patternType = tempParser; theNode->right = (*tempParser->parseFunction)(theEnv,readSource,theToken); if (theNode->right == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,theNode); return(NULL); } PropagatePatternType(theNode,tempParser); return(theNode); } } /*=================================*/ /* If a pattern parser couldn't be */ /* found, then signal an error. */ /*=================================*/ *error = TRUE; SyntaxErrorMessage(theEnv,"the field field of a pattern"); ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /**************************************************************/ /* PropagatePatternType: Sets the selfPattern field for all */ /* lhsParseNodes in a linked list of those data structures. */ /**************************************************************/ globle void PropagatePatternType( struct lhsParseNode *theLHS, struct patternParser *theParser) { while (theLHS != NULL) { theLHS->patternType = theParser; if (theLHS->right != NULL) PropagatePatternType(theLHS->right,theParser); if (theLHS->expression != NULL) PropagatePatternType(theLHS->expression,theParser); theLHS = theLHS->bottom; } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips_core_source_630/core/expressn.h0000755000175000017500000001253012373740005016253 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains routines for creating, deleting, */ /* compacting, installing, and hashing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Changed integer type/precision. */ /* */ /* Changed expression hashing value. */ /* */ /*************************************************************/ #ifndef _H_expressn #define _H_expressn struct expr; struct exprHashNode; #ifndef _H_exprnops #include "exprnops.h" #endif /******************************/ /* Expression Data Structures */ /******************************/ struct expr { unsigned short type; void *value; struct expr *argList; struct expr *nextArg; }; #define arg_list argList #define next_arg nextArg typedef struct expr EXPRESSION; typedef struct exprHashNode { unsigned hashval; unsigned count; struct expr *exp; struct exprHashNode *next; long bsaveID; } EXPRESSION_HN; #define EXPRESSION_HASH_SIZE 503 /*************************/ /* Type and Value Macros */ /*************************/ #define GetType(target) ((target).type) #define GetpType(target) ((target)->type) #define SetType(target,val) ((target).type = (unsigned short) (val)) #define SetpType(target,val) ((target)->type = (unsigned short) (val)) #define GetValue(target) ((target).value) #define GetpValue(target) ((target)->value) #define SetValue(target,val) ((target).value = (void *) (val)) #define SetpValue(target,val) ((target)->value = (void *) (val)) #define EnvGetType(theEnv,target) ((target).type) #define EnvGetpType(theEnv,target) ((target)->type) #define EnvSetType(theEnv,target,val) ((target).type = (unsigned short) (val)) #define EnvSetpType(theEnv,target,val) ((target)->type = (unsigned short) (val)) #define EnvGetValue(theEnv,target) ((target).value) #define EnvGetpValue(theEnv,target) ((target)->value) #define EnvSetValue(theEnv,target,val) ((target).value = (void *) (val)) #define EnvSetpValue(theEnv,target,val) ((target)->value = (void *) (val)) /********************/ /* ENVIRONMENT DATA */ /********************/ #ifndef _H_exprnpsr #include "exprnpsr.h" #endif #define EXPRESSION_DATA 45 struct expressionData { void *PTR_AND; void *PTR_OR; void *PTR_EQ; void *PTR_NEQ; void *PTR_NOT; EXPRESSION_HN **ExpressionHashTable; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) long NumberOfExpressions; struct expr *ExpressionArray; long int ExpressionCount; #endif #if (! RUN_TIME) SAVED_CONTEXTS *svContexts; int ReturnContext; int BreakContext; #endif intBool SequenceOpMode; }; #define ExpressionData(theEnv) ((struct expressionData *) GetEnvironmentData(theEnv,EXPRESSION_DATA)) /********************/ /* Global Functions */ /********************/ #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRESSN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ReturnExpression(void *,struct expr *); LOCALE void ExpressionInstall(void *,struct expr *); LOCALE void ExpressionDeinstall(void *,struct expr *); LOCALE struct expr *PackExpression(void *,struct expr *); LOCALE void ReturnPackedExpression(void *,struct expr *); LOCALE void InitExpressionData(void *); LOCALE void InitExpressionPointers(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE EXPRESSION *AddHashedExpression(void *,EXPRESSION *); #endif #if (! RUN_TIME) LOCALE void RemoveHashedExpression(void *,EXPRESSION *); #endif #if BLOAD_AND_BSAVE || BLOAD_ONLY || BLOAD || CONSTRUCT_COMPILER LOCALE long HashedExpressionIndex(void *,EXPRESSION *); #endif #endif clips_core_source_630/core/._constrnt.h0000755000175000017500000000033012374672752016504 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._classinf.c0000755000175000017500000000040712373714502016421 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/multifld.c0000755000175000017500000006542612374717750016247 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/19/14 */ /* */ /* MULTIFIELD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* Moved ImplodeMultifield from multifun.c. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Used DataObjectToString instead of */ /* ValueToString in implode$ to handle */ /* print representation of external addresses. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed issue with StoreInMultifield when */ /* asserting void values in implied deftemplate */ /* facts. */ /* */ /*************************************************************/ #define _MULTIFLD_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "constant.h" #include "memalloc.h" #include "envrnmnt.h" #include "evaluatn.h" #include "scanner.h" #include "router.h" #include "strngrtr.h" #include "utility.h" #if OBJECT_SYSTEM #include "object.h" #endif #include "multifld.h" /**********************/ /* CreateMultifield2: */ /**********************/ globle void *CreateMultifield2( void *theEnv, long size) { struct multifield *theSegment; long newSize = size; if (size <= 0) newSize = 1; theSegment = get_var_struct(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L)); theSegment->multifieldLength = size; theSegment->busyCount = 0; theSegment->next = NULL; return((void *) theSegment); } /*********************/ /* ReturnMultifield: */ /*********************/ globle void ReturnMultifield( void *theEnv, struct multifield *theSegment) { unsigned long newSize; if (theSegment == NULL) return; if (theSegment->multifieldLength == 0) newSize = 1; else newSize = theSegment->multifieldLength; rtn_var_struct(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment); } /**********************/ /* MultifieldInstall: */ /**********************/ globle void MultifieldInstall( void *theEnv, struct multifield *theSegment) { unsigned long length, i; struct field *theFields; if (theSegment == NULL) return; length = theSegment->multifieldLength; theSegment->busyCount++; theFields = theSegment->theFields; for (i = 0 ; i < length ; i++) { AtomInstall(theEnv,theFields[i].type,theFields[i].value); } } /************************/ /* MultifieldDeinstall: */ /************************/ globle void MultifieldDeinstall( void *theEnv, struct multifield *theSegment) { unsigned long length, i; struct field *theFields; if (theSegment == NULL) return; length = theSegment->multifieldLength; theSegment->busyCount--; theFields = theSegment->theFields; for (i = 0 ; i < length ; i++) { AtomDeinstall(theEnv,theFields[i].type,theFields[i].value); } } /*******************************************************/ /* StringToMultifield: Returns a multifield structure */ /* that represents the string sent as the argument. */ /*******************************************************/ globle struct multifield *StringToMultifield( void *theEnv, const char *theString) { struct token theToken; struct multifield *theSegment; struct field *theFields; unsigned long numberOfFields = 0; struct expr *topAtom = NULL, *lastAtom = NULL, *theAtom; /*====================================================*/ /* Open the string as an input source and read in the */ /* list of values to be stored in the multifield. */ /*====================================================*/ OpenStringSource(theEnv,"multifield-str",theString,0); GetToken(theEnv,"multifield-str",&theToken); while (theToken.type != STOP) { if ((theToken.type == SYMBOL) || (theToken.type == STRING) || (theToken.type == FLOAT) || (theToken.type == INTEGER) || (theToken.type == INSTANCE_NAME)) { theAtom = GenConstant(theEnv,theToken.type,theToken.value); } else { theAtom = GenConstant(theEnv,STRING,EnvAddSymbol(theEnv,theToken.printForm)); } numberOfFields++; if (topAtom == NULL) topAtom = theAtom; else lastAtom->nextArg = theAtom; lastAtom = theAtom; GetToken(theEnv,"multifield-str",&theToken); } CloseStringSource(theEnv,"multifield-str"); /*====================================================================*/ /* Create a multifield of the appropriate size for the values parsed. */ /*====================================================================*/ theSegment = (struct multifield *) EnvCreateMultifield(theEnv,numberOfFields); theFields = theSegment->theFields; /*====================================*/ /* Copy the values to the multifield. */ /*====================================*/ theAtom = topAtom; numberOfFields = 0; while (theAtom != NULL) { theFields[numberOfFields].type = theAtom->type; theFields[numberOfFields].value = theAtom->value; numberOfFields++; theAtom = theAtom->nextArg; } /*===========================*/ /* Return the parsed values. */ /*===========================*/ ReturnExpression(theEnv,topAtom); /*============================*/ /* Return the new multifield. */ /*============================*/ return(theSegment); } /**************************************************************/ /* EnvCreateMultifield: Creates a multifield of the specified */ /* size and adds it to the list of segments. */ /**************************************************************/ globle void *EnvCreateMultifield( void *theEnv, long size) { struct multifield *theSegment; long newSize; if (size <= 0) newSize = 1; else newSize = size; theSegment = get_var_struct(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L)); theSegment->multifieldLength = size; theSegment->busyCount = 0; theSegment->next = NULL; theSegment->next = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields; UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = theSegment; UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; if (UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield == NULL) { UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = theSegment; } return((void *) theSegment); } /*******************/ /* DOToMultifield: */ /*******************/ globle void *DOToMultifield( void *theEnv, DATA_OBJECT *theValue) { struct multifield *dst, *src; if (theValue->type != MULTIFIELD) return(NULL); dst = (struct multifield *) CreateMultifield2(theEnv,(unsigned long) GetpDOLength(theValue)); src = (struct multifield *) theValue->value; GenCopyMemory(struct field,dst->multifieldLength, &(dst->theFields[0]),&(src->theFields[GetpDOBegin(theValue) - 1])); return((void *) dst); } /************************/ /* AddToMultifieldList: */ /************************/ globle void AddToMultifieldList( void *theEnv, struct multifield *theSegment) { theSegment->next = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields; UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = theSegment; UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; if (UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield == NULL) { UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = theSegment; } } /*********************/ /* FlushMultifields: */ /*********************/ globle void FlushMultifields( void *theEnv) { struct multifield *theSegment, *nextPtr, *lastPtr = NULL; unsigned long newSize; theSegment = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields; while (theSegment != NULL) { nextPtr = theSegment->next; if (theSegment->busyCount == 0) { if (theSegment->multifieldLength == 0) newSize = 1; else newSize = theSegment->multifieldLength; rtn_var_struct(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment); if (lastPtr == NULL) UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = nextPtr; else lastPtr->next = nextPtr; /*=================================================*/ /* If the multifield deleted was the last in the */ /* list, update the pointer to the last multifield */ /* to the prior multifield. */ /*=================================================*/ if (nextPtr == NULL) { UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = lastPtr; } } else { lastPtr = theSegment; } theSegment = nextPtr; } } /************************************************************************/ /* DuplicateMultifield: Allocates a new segment and copies results from */ /* old value to new. This value is not put on the ListOfMultifields. */ /************************************************************************/ globle void DuplicateMultifield( void *theEnv, DATA_OBJECT_PTR dst, DATA_OBJECT_PTR src) { dst->type = MULTIFIELD; dst->begin = 0; dst->end = src->end - src->begin; dst->value = (void *) CreateMultifield2(theEnv,(unsigned long) dst->end + 1); GenCopyMemory(struct field,dst->end + 1,&((struct multifield *) dst->value)->theFields[0], &((struct multifield *) src->value)->theFields[src->begin]); } /*******************/ /* CopyMultifield: */ /*******************/ globle void *CopyMultifield( void *theEnv, struct multifield *src) { struct multifield *dst; dst = (struct multifield *) CreateMultifield2(theEnv,src->multifieldLength); GenCopyMemory(struct field,src->multifieldLength,&(dst->theFields[0]),&(src->theFields[0])); return((void *) dst); } /*********************************************/ /* PrintMultifield: Prints out a multifield. */ /*********************************************/ globle void PrintMultifield( void *theEnv, const char *fileid, struct multifield *segment, long begin, long end, int printParens) { struct field *theMultifield; int i; theMultifield = segment->theFields; if (printParens) EnvPrintRouter(theEnv,fileid,"("); i = begin; while (i <= end) { PrintAtom(theEnv,fileid,theMultifield[i].type,theMultifield[i].value); i++; if (i <= end) EnvPrintRouter(theEnv,fileid," "); } if (printParens) EnvPrintRouter(theEnv,fileid,")"); } /****************************************************/ /* StoreInMultifield: Append function for segments. */ /****************************************************/ globle void StoreInMultifield( void *theEnv, DATA_OBJECT *returnValue, EXPRESSION *expptr, int garbageSegment) { DATA_OBJECT val_ptr; DATA_OBJECT *val_arr; struct multifield *theMultifield; struct multifield *orig_ptr; long start, end, i,j, k, argCount; unsigned long seg_size; argCount = CountArguments(expptr); /*=========================================*/ /* If no arguments are given return a NULL */ /* multifield of length zero. */ /*=========================================*/ if (argCount == 0) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); return; } else { /*========================================*/ /* Get a new segment with length equal to */ /* the total length of all the arguments. */ /*========================================*/ val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount); seg_size = 0; for (i = 1; i <= argCount; i++, expptr = expptr->nextArg) { EvaluateExpression(theEnv,expptr,&val_ptr); if (EvaluationData(theEnv)->EvaluationError) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } SetpType(val_arr+i-1,GetType(val_ptr)); if (GetType(val_ptr) == MULTIFIELD) { SetpValue(val_arr+i-1,GetpValue(&val_ptr)); start = GetDOBegin(val_ptr); end = GetDOEnd(val_ptr); } else if (GetType(val_ptr) == RVOID) { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = 1; end = 0; } else { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = end = -1; } seg_size += (unsigned long) (end - start + 1); SetpDOBegin(val_arr+i-1,start); SetpDOEnd(val_arr+i-1,end); } if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size); /*========================================*/ /* Copy each argument into new segment. */ /*========================================*/ for (k = 0, j = 1; k < argCount; k++) { if (GetpType(val_arr+k) == MULTIFIELD) { start = GetpDOBegin(val_arr+k); end = GetpDOEnd(val_arr+k); orig_ptr = (struct multifield *) GetpValue(val_arr+k); for (i = start; i < end + 1; i++, j++) { SetMFType(theMultifield,j,(GetMFType(orig_ptr,i))); SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i))); } } else if (GetpType(val_arr+k) != RVOID) { SetMFType(theMultifield,j,(short) (GetpType(val_arr+k))); SetMFValue(theMultifield,j,(GetpValue(val_arr+k))); j++; } } /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) seg_size); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } } /*************************************************************/ /* MultifieldDOsEqual: determines if two segments are equal. */ /*************************************************************/ globle intBool MultifieldDOsEqual( DATA_OBJECT_PTR dobj1, DATA_OBJECT_PTR dobj2) { long extent1,extent2; /* 6.04 Bug Fix */ FIELD_PTR e1,e2; extent1 = GetpDOLength(dobj1); extent2 = GetpDOLength(dobj2); if (extent1 != extent2) { return(FALSE); } e1 = (FIELD_PTR) GetMFPtr(GetpValue(dobj1),GetpDOBegin(dobj1)); e2 = (FIELD_PTR) GetMFPtr(GetpValue(dobj2),GetpDOBegin(dobj2)); while (extent1 != 0) { if (e1->type != e2->type) { return(FALSE); } if (e1->value != e2->value) { return(FALSE); } extent1--; if (extent1 > 0) { e1++; e2++; } } return(TRUE); } /******************************************************************/ /* MultifieldsEqual: Determines if two multifields are identical. */ /******************************************************************/ globle int MultifieldsEqual( struct multifield *segment1, struct multifield *segment2) { struct field *elem1; struct field *elem2; long length, i = 0; length = segment1->multifieldLength; if (length != segment2->multifieldLength) { return(FALSE); } elem1 = segment1->theFields; elem2 = segment2->theFields; /*==================================================*/ /* Compare each field of both facts until the facts */ /* match completely or the facts mismatch. */ /*==================================================*/ while (i < length) { if (elem1[i].type != elem2[i].type) { return(FALSE); } if (elem1[i].type == MULTIFIELD) { if (MultifieldsEqual((struct multifield *) elem1[i].value, (struct multifield *) elem2[i].value) == FALSE) { return(FALSE); } } else if (elem1[i].value != elem2[i].value) { return(FALSE); } i++; } return(TRUE); } /************************************************************/ /* HashMultifield: Returns the hash value for a multifield. */ /************************************************************/ globle unsigned long HashMultifield( struct multifield *theSegment, unsigned long theRange) { unsigned long length, i; unsigned long tvalue; unsigned long count; struct field *fieldPtr; union { double fv; void *vv; unsigned long liv; } fis; /*================================================*/ /* Initialize variables for computing hash value. */ /*================================================*/ count = 0; length = theSegment->multifieldLength; fieldPtr = theSegment->theFields; /*====================================================*/ /* Loop through each value in the multifield, compute */ /* its hash value, and add it to the running total. */ /*====================================================*/ for (i = 0; i < length; i++) { switch(fieldPtr[i].type) { case MULTIFIELD: count += HashMultifield((struct multifield *) fieldPtr[i].value,theRange); break; case FLOAT: fis.liv = 0; fis.fv = ValueToDouble(fieldPtr[i].value); count += (fis.liv * (i + 29)) + (unsigned long) ValueToDouble(fieldPtr[i].value); break; case INTEGER: count += (((unsigned long) ValueToLong(fieldPtr[i].value)) * (i + 29)) + ((unsigned long) ValueToLong(fieldPtr[i].value)); break; case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif fis.liv = 0; fis.vv = fieldPtr[i].value; count += (unsigned long) (fis.liv * (i + 29)); break; case EXTERNAL_ADDRESS: fis.liv = 0; fis.vv = ValueToExternalAddress(fieldPtr[i].value); count += (unsigned long) (fis.liv * (i + 29)); break; case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif tvalue = (unsigned long) HashSymbol(ValueToString(fieldPtr[i].value),theRange); count += (unsigned long) (tvalue * (i + 29)); break; } } /*========================*/ /* Return the hash value. */ /*========================*/ return(count); } /**********************/ /* GetMultifieldList: */ /**********************/ globle struct multifield *GetMultifieldList( void *theEnv) { return(UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields); } /***************************************/ /* ImplodeMultifield: C access routine */ /* for the implode$ function. */ /***************************************/ globle void *ImplodeMultifield( void *theEnv, DATA_OBJECT *value) { size_t strsize = 0; long i, j; const char *tmp_str; char *ret_str; void *rv; struct multifield *theMultifield; DATA_OBJECT tempDO; /*===================================================*/ /* Determine the size of the string to be allocated. */ /*===================================================*/ theMultifield = (struct multifield *) GetpValue(value); for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++) { if (GetMFType(theMultifield,i) == FLOAT) { tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i))); strsize += strlen(tmp_str) + 1; } else if (GetMFType(theMultifield,i) == INTEGER) { tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i))); strsize += strlen(tmp_str) + 1; } else if (GetMFType(theMultifield,i) == STRING) { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; tmp_str = ValueToString(GetMFValue(theMultifield,i)); while(*tmp_str) { if (*tmp_str == '"') { strsize++; } else if (*tmp_str == '\\') /* GDR 111599 #835 */ { strsize++; } /* GDR 111599 #835 */ tmp_str++; } } #if OBJECT_SYSTEM else if (GetMFType(theMultifield,i) == INSTANCE_NAME) { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; } else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS) { strsize += strlen(ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name)) + 3; } #endif else { SetType(tempDO,GetMFType(theMultifield,i)); SetValue(tempDO,GetMFValue(theMultifield,i)); strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1; } } /*=============================================*/ /* Allocate the string and copy all components */ /* of the MULTIFIELD variable to it. */ /*=============================================*/ if (strsize == 0) return(EnvAddSymbol(theEnv,"")); ret_str = (char *) gm2(theEnv,strsize); for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++) { /*============================*/ /* Convert numbers to strings */ /*============================*/ if (GetMFType(theMultifield,i) == FLOAT) { tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i))); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } else if (GetMFType(theMultifield,i) == INTEGER) { tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i))); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } /*=======================================*/ /* Enclose strings in quotes and preceed */ /* imbedded quotes with a backslash */ /*=======================================*/ else if (GetMFType(theMultifield,i) == STRING) { tmp_str = ValueToString(GetMFValue(theMultifield,i)); *(ret_str+j) = '"'; j++; while(*tmp_str) { if (*tmp_str == '"') { *(ret_str+j) = '\\'; j++; } else if (*tmp_str == '\\') /* GDR 111599 #835 */ { /* GDR 111599 #835 */ *(ret_str+j) = '\\'; /* GDR 111599 #835 */ j++; /* GDR 111599 #835 */ } /* GDR 111599 #835 */ *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str+j) = '"'; j++; } #if OBJECT_SYSTEM else if (GetMFType(theMultifield,i) == INSTANCE_NAME) { tmp_str = ValueToString(GetMFValue(theMultifield,i)); *(ret_str + j++) = '['; while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str + j++) = ']'; } else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS) { tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name); *(ret_str + j++) = '['; while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str + j++) = ']'; } #endif else { SetType(tempDO,GetMFType(theMultifield,i)); SetValue(tempDO,GetMFValue(theMultifield,i)); tmp_str = DataObjectToString(theEnv,&tempDO); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } *(ret_str+j) = ' '; j++; } *(ret_str+j-1) = '\0'; /*====================*/ /* Return the string. */ /*====================*/ rv = EnvAddSymbol(theEnv,ret_str); rm(theEnv,ret_str,strsize); return(rv); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void *CreateMultifield( long size) { return EnvCreateMultifield(GetCurrentEnvironment(),size); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/._generate.c0000755000175000017500000000040712373753417016421 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnops.c0000755000175000017500000012330012373713614016256 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT OPERATIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for performing operations on */ /* constraint records including computing the intersection */ /* and union of constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /*************************************************************/ #define _CSTRNOPS_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #if (! RUN_TIME) #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "extnfunc.h" #include "scanner.h" #include "multifld.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnutl.h" #include "cstrnops.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void IntersectNumericExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *,int); static void IntersectAllowedValueExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static void IntersectAllowedClassExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static int FindItemInExpression(int,void *,int,struct expr *); static void UpdateRestrictionFlags(CONSTRAINT_RECORD *); #if (! BLOAD_ONLY) static void UnionRangeMinMaxValueWithList(void *, struct expr *, struct expr *, struct expr **, struct expr **); static void UnionNumericExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *,int); static struct expr *AddToUnionList(void *, struct expr *,struct expr *, CONSTRAINT_RECORD *); static void UnionAllowedValueExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static void UnionAllowedClassExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static int RestrictionOnType(int,CONSTRAINT_RECORD *); #endif /**************************************************************/ /* IntersectConstraints: Creates a new constraint record that */ /* is the intersection of two other constraint records. */ /**************************************************************/ globle struct constraintRecord *IntersectConstraints( void *theEnv, CONSTRAINT_RECORD *c1, CONSTRAINT_RECORD *c2) { struct constraintRecord *rv; int c1Changed = FALSE, c2Changed = FALSE; /*=================================================*/ /* If both constraint records are NULL,then create */ /* a constraint record that allows any value. */ /*=================================================*/ if ((c1 == NULL) && (c2 == NULL)) { rv = GetConstraintRecord(theEnv); rv->multifieldsAllowed = TRUE; return(rv); } /*=================================================*/ /* If one of the constraint records is NULL, then */ /* the intersection is the other constraint record */ /* (a NULL value means no constraints). */ /*=================================================*/ if (c1 == NULL) return(CopyConstraintRecord(theEnv,c2)); if (c2 == NULL) return(CopyConstraintRecord(theEnv,c1)); /*=================================*/ /* Create a new constraint record. */ /*=================================*/ rv = GetConstraintRecord(theEnv); /*==============================*/ /* Intersect the allowed types. */ /*==============================*/ if ((c1->multifieldsAllowed != c2->multifieldsAllowed) && (c1->singlefieldsAllowed != c2->singlefieldsAllowed)) { rv->anyAllowed = FALSE; return(rv); } if (c1->multifieldsAllowed && c2->multifieldsAllowed) { rv->multifieldsAllowed = TRUE; } else { rv->multifieldsAllowed = FALSE; } if (c1->singlefieldsAllowed && c2->singlefieldsAllowed) { rv->singlefieldsAllowed = TRUE; } else { rv->singlefieldsAllowed = FALSE; } if (c1->anyAllowed && c2->anyAllowed) rv->anyAllowed = TRUE; else { if (c1->anyAllowed) { c1Changed = TRUE; SetAnyAllowedFlags(c1,FALSE); } else if (c2->anyAllowed) { c2Changed = TRUE; SetAnyAllowedFlags(c2,FALSE); } rv->anyAllowed = FALSE; rv->symbolsAllowed = (c1->symbolsAllowed && c2->symbolsAllowed); rv->stringsAllowed = (c1->stringsAllowed && c2->stringsAllowed); rv->floatsAllowed = (c1->floatsAllowed && c2->floatsAllowed); rv->integersAllowed = (c1->integersAllowed && c2->integersAllowed); rv->instanceNamesAllowed = (c1->instanceNamesAllowed && c2->instanceNamesAllowed); rv->instanceAddressesAllowed = (c1->instanceAddressesAllowed && c2->instanceAddressesAllowed); rv->externalAddressesAllowed = (c1->externalAddressesAllowed && c2->externalAddressesAllowed); rv->voidAllowed = (c1->voidAllowed && c2->voidAllowed); rv->multifieldsAllowed = (c1->multifieldsAllowed && c2->multifieldsAllowed); rv->factAddressesAllowed = (c1->factAddressesAllowed && c2->factAddressesAllowed); if (c1Changed) SetAnyAllowedFlags(c1,TRUE); if (c2Changed) SetAnyAllowedFlags(c2,TRUE); } /*=====================================*/ /* Intersect the allowed-values flags. */ /*=====================================*/ if (c1->anyRestriction || c2->anyRestriction) rv->anyRestriction = TRUE; else { rv->anyRestriction = FALSE; rv->symbolRestriction = (c1->symbolRestriction || c2->symbolRestriction); rv->stringRestriction = (c1->stringRestriction || c2->stringRestriction); rv->floatRestriction = (c1->floatRestriction || c2->floatRestriction); rv->integerRestriction = (c1->integerRestriction || c2->integerRestriction); rv->classRestriction = (c1->classRestriction || c2->classRestriction); rv->instanceNameRestriction = (c1->instanceNameRestriction || c2->instanceNameRestriction); } /*==================================================*/ /* Intersect the allowed values list, allowed class */ /* list, min and max values, and the range values. */ /*==================================================*/ IntersectAllowedValueExpressions(theEnv,c1,c2,rv); IntersectAllowedClassExpressions(theEnv,c1,c2,rv); IntersectNumericExpressions(theEnv,c1,c2,rv,TRUE); IntersectNumericExpressions(theEnv,c1,c2,rv,FALSE); /*==========================================*/ /* Update the allowed-values flags based on */ /* the previous intersection for allowed, */ /* min and max, and range values. */ /*==========================================*/ UpdateRestrictionFlags(rv); /*============================================*/ /* If multifields are allowed, then intersect */ /* the constraint record for them. */ /*============================================*/ if (rv->multifieldsAllowed) { rv->multifield = IntersectConstraints(theEnv,c1->multifield,c2->multifield); if (UnmatchableConstraint(rv->multifield)) { rv->multifieldsAllowed = FALSE; } } /*========================*/ /* Return the intersected */ /* constraint record. */ /*========================*/ return(rv); } /*************************************************/ /* IntersectAllowedValueExpressions: Creates the */ /* intersection of two allowed-values lists. */ /*************************************************/ static void IntersectAllowedValueExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theList1, *theList2; struct expr *theHead = NULL, *tmpExpr; /*===========================================*/ /* Loop through each value in allowed-values */ /* list of the first constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*===========================================*/ for (theList1 = constraint1->restrictionList; theList1 != NULL; theList1 = theList1->nextArg) { if (CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint1) && CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList1->type,theList1->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*===========================================*/ /* Loop through each value in allowed-values */ /* list of the second constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*===========================================*/ for (theList2 = constraint2->restrictionList; theList2 != NULL; theList2 = theList2->nextArg) { if (FindItemInExpression(theList2->type,theList2->value,TRUE,theHead)) { /* The value is already in the list--Do nothing */ } else if (CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint1) && CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList2->type,theList2->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*================================================*/ /* Set the allowed values list for the constraint */ /* record to the intersected values of the two */ /* other constraint records. */ /*================================================*/ newConstraint->restrictionList = theHead; } /*************************************************/ /* IntersectAllowedClassExpressions: Creates the */ /* intersection of two allowed-classes lists. */ /*************************************************/ static void IntersectAllowedClassExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theList1, *theList2; struct expr *theHead = NULL, *tmpExpr; /*============================================*/ /* Loop through each value in allowed-classes */ /* list of the first constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*============================================*/ for (theList1 = constraint1->classList; theList1 != NULL; theList1 = theList1->nextArg) { if (CheckAllowedClassesConstraint(theEnv,theList1->type,theList1->value,constraint1) && CheckAllowedClassesConstraint(theEnv,theList1->type,theList1->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList1->type,theList1->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*============================================*/ /* Loop through each value in allowed-classes */ /* list of the second constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*============================================*/ for (theList2 = constraint2->classList; theList2 != NULL; theList2 = theList2->nextArg) { if (FindItemInExpression(theList2->type,theList2->value,TRUE,theHead)) { /* The value is already in the list--Do nothing */ } else if (CheckAllowedClassesConstraint(theEnv,theList2->type,theList2->value,constraint1) && CheckAllowedClassesConstraint(theEnv,theList2->type,theList2->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList2->type,theList2->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*=================================================*/ /* Set the allowed classes list for the constraint */ /* record to the intersected values of the two */ /* other constraint records. */ /*=================================================*/ newConstraint->classList = theHead; } /*********************************************************/ /* IntersectNumericExpressions: Creates the intersection */ /* of two range or two min/max-fields constraints. */ /*********************************************************/ static void IntersectNumericExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint, int range) { struct expr *tmpmin1, *tmpmax1, *tmpmin2, *tmpmax2, *theMin, *theMax; struct expr *theMinList, *theMaxList, *lastMin = NULL, *lastMax = NULL; int cmaxmax, cminmin, cmaxmin, cminmax; /*==========================================*/ /* Initialize the new range/min/max values */ /* for the intersection of the constraints. */ /*==========================================*/ theMinList = NULL; theMaxList = NULL; /*=================================*/ /* Determine the min/max values of */ /* the first constraint record. */ /*=================================*/ if (range) { tmpmin1 = constraint1->minValue; tmpmax1 = constraint1->maxValue; } else { tmpmin1 = constraint1->minFields; tmpmax1 = constraint1->maxFields; } /*===========================================*/ /* Loop through each of range/min/max values */ /* from the first constraint record. */ /*===========================================*/ for (; tmpmin1 != NULL; tmpmin1 = tmpmin1->nextArg, tmpmax1 = tmpmax1->nextArg) { /*============================================*/ /* Get the appropriate values from the second */ /* constraint record for comparison. */ /*============================================*/ if (range) { tmpmin2 = constraint2->minValue; tmpmax2 = constraint2->maxValue; } else { tmpmin2 = constraint2->minFields; tmpmax2 = constraint2->maxFields; } /*================================================*/ /* Loop through each of range/min/max values from */ /* the second constraint record comparing it to */ /* the values from the first constraint record. */ /*================================================*/ for (; tmpmin2 != NULL; tmpmin2 = tmpmin2->nextArg, tmpmax2 = tmpmax2->nextArg) { /*==============================================*/ /* Determine the relationship between the four */ /* combinations of min/max values (>, <, or =). */ /*==============================================*/ cmaxmax = CompareNumbers(theEnv,tmpmax1->type,tmpmax1->value, tmpmax2->type,tmpmax2->value); cminmin = CompareNumbers(theEnv,tmpmin1->type,tmpmin1->value, tmpmin2->type,tmpmin2->value); cmaxmin = CompareNumbers(theEnv,tmpmax1->type,tmpmax1->value, tmpmin2->type,tmpmin2->value); cminmax = CompareNumbers(theEnv,tmpmin1->type,tmpmin1->value, tmpmax2->type,tmpmax2->value); /*============================================*/ /* If the range/min/max values don't overlap, */ /* then proceed to the next pair of numbers */ /* to see if they overlap. */ /*============================================*/ if ((cmaxmin == LESS_THAN) || (cminmax == GREATER_THAN)) { continue; } /*=======================================*/ /* Compute the new minimum value for the */ /* intersected range/min/max values. */ /*=======================================*/ if (cminmin == GREATER_THAN) { theMin = GenConstant(theEnv,tmpmin1->type,tmpmin1->value); } else { theMin = GenConstant(theEnv,tmpmin2->type,tmpmin2->value); } /*=======================================*/ /* Compute the new maximum value for the */ /* intersected range/min/max values. */ /*=======================================*/ if (cmaxmax == LESS_THAN) { theMax = GenConstant(theEnv,tmpmax1->type,tmpmax1->value); } else { theMax = GenConstant(theEnv,tmpmax2->type,tmpmax2->value); } /*==================================*/ /* Add the new range/min/max values */ /* to the intersection list. */ /*==================================*/ if (lastMin == NULL) { theMinList = theMin; theMaxList = theMax; } else { lastMin->nextArg = theMin; lastMax->nextArg = theMax; } lastMin = theMin; lastMax = theMax; } } /*============================================================*/ /* If the intersection produced a pair of valid range/min/max */ /* values, then replace the previous values of the constraint */ /* record to the new intersected values. */ /*============================================================*/ if (theMinList != NULL) { if (range) { ReturnExpression(theEnv,newConstraint->minValue); ReturnExpression(theEnv,newConstraint->maxValue); newConstraint->minValue = theMinList; newConstraint->maxValue = theMaxList; } else { ReturnExpression(theEnv,newConstraint->minFields); ReturnExpression(theEnv,newConstraint->maxFields); newConstraint->minFields = theMinList; newConstraint->maxFields = theMaxList; } } /*===============================================================*/ /* Otherwise, the intersection produced no valid range/min/max */ /* values. For the range attribute, this means that no numbers */ /* can satisfy the constraint. For the min/max fields attribute, */ /* it means that no value can satisfy the constraint. */ /*===============================================================*/ else { if (range) { if (newConstraint->anyAllowed) SetAnyAllowedFlags(newConstraint,FALSE); newConstraint->integersAllowed = FALSE; newConstraint->floatsAllowed = FALSE; } else { SetAnyAllowedFlags(newConstraint,TRUE); newConstraint->singlefieldsAllowed = FALSE; newConstraint->multifieldsAllowed = FALSE; newConstraint->anyAllowed = FALSE; } } } /************************************************************/ /* UpdateRestrictionFlags: Updates the types allowed flags */ /* based on the allowed values in a constraint record. */ /* Intended to be called after the allowed values list */ /* has been changed (for example after intersecting the */ /* allowed-values list there may no be any values of a */ /* particular type left even though the type is allowed). */ /************************************************************/ static void UpdateRestrictionFlags( CONSTRAINT_RECORD *rv) { if ((rv->anyRestriction) && (rv->restrictionList == NULL)) { SetAnyAllowedFlags(rv,TRUE); rv->anyAllowed = FALSE; } if ((rv->symbolRestriction) && (rv->symbolsAllowed)) { rv->symbolsAllowed = FindItemInExpression(SYMBOL,NULL,FALSE,rv->restrictionList); } if ((rv->stringRestriction) && (rv->stringsAllowed)) { rv->stringsAllowed = FindItemInExpression(STRING,NULL,FALSE,rv->restrictionList); } if ((rv->floatRestriction) && (rv->floatsAllowed)) { rv->floatsAllowed = FindItemInExpression(FLOAT,NULL,FALSE,rv->restrictionList); } if ((rv->integerRestriction) && (rv->integersAllowed)) { rv->integersAllowed = FindItemInExpression(INTEGER,NULL,FALSE,rv->restrictionList); } if ((rv->instanceNameRestriction) && (rv->instanceNamesAllowed)) { rv->instanceNamesAllowed = FindItemInExpression(INSTANCE_NAME,NULL,FALSE,rv->restrictionList); } } /*************************************************************/ /* FindItemInExpression: Determines if a particular constant */ /* (such as 27) or a class of constants (such as integers) */ /* can be found in a list of constants. Returns TRUE if */ /* such a constant can be found, otherwise FALSE. */ /*************************************************************/ static int FindItemInExpression( int theType, void *theValue, int useValue, struct expr *theList) { while (theList != NULL) { if (theList->type == theType) { if (! useValue) return(TRUE); else if (theList->value == theValue) return(TRUE); } theList = theList->nextArg; } return(FALSE); } #if (! BLOAD_ONLY) /**************************************************/ /* RestrictionOnType: Determines if a restriction */ /* is present for a specific type. Returns TRUE */ /* if there is, otherwise FALSE. */ /**************************************************/ static int RestrictionOnType( int theType, CONSTRAINT_RECORD *theConstraint) { if (theConstraint == NULL) return(FALSE); if ((theConstraint->anyRestriction) || (theConstraint->symbolRestriction && (theType == SYMBOL)) || (theConstraint->stringRestriction && (theType == STRING)) || (theConstraint->floatRestriction && (theType == FLOAT)) || (theConstraint->integerRestriction && (theType == INTEGER)) || (theConstraint->classRestriction && ((theType == INSTANCE_ADDRESS) || (theType == INSTANCE_NAME))) || (theConstraint->instanceNameRestriction && (theType == INSTANCE_NAME))) { return(TRUE); } return(FALSE); } /**********************************************************/ /* UnionConstraints: Creates a new constraint record that */ /* is the union of two other constraint records. */ /**********************************************************/ globle struct constraintRecord *UnionConstraints( void *theEnv, CONSTRAINT_RECORD *c1, CONSTRAINT_RECORD *c2) { struct constraintRecord *rv; int c1Changed = FALSE, c2Changed = FALSE; /*=================================================*/ /* If both constraint records are NULL,then create */ /* a constraint record that allows any value. */ /*=================================================*/ if ((c1 == NULL) && (c2 == NULL)) return(GetConstraintRecord(theEnv)); /*=====================================================*/ /* If one of the constraint records is NULL, then the */ /* union is the other constraint record. Note that */ /* this is different from the way that intersections */ /* were handled (a NULL constraint record implied that */ /* any value was legal which in turn would imply that */ /* the union would allow any value as well). */ /*=====================================================*/ if (c1 == NULL) return(CopyConstraintRecord(theEnv,c2)); if (c2 == NULL) return(CopyConstraintRecord(theEnv,c1)); /*=================================*/ /* Create a new constraint record. */ /*=================================*/ rv = GetConstraintRecord(theEnv); /*==========================*/ /* Union the allowed types. */ /*==========================*/ if (c1->multifieldsAllowed || c2->multifieldsAllowed) { rv->multifieldsAllowed = TRUE; } if (c1->singlefieldsAllowed || c2->singlefieldsAllowed) { rv->singlefieldsAllowed = TRUE; } if (c1->anyAllowed || c2->anyAllowed) rv->anyAllowed = TRUE; else { rv->anyAllowed = FALSE; rv->symbolsAllowed = (c1->symbolsAllowed || c2->symbolsAllowed); rv->stringsAllowed = (c1->stringsAllowed || c2->stringsAllowed); rv->floatsAllowed = (c1->floatsAllowed || c2->floatsAllowed); rv->integersAllowed = (c1->integersAllowed || c2->integersAllowed); rv->instanceNamesAllowed = (c1->instanceNamesAllowed || c2->instanceNamesAllowed); rv->instanceAddressesAllowed = (c1->instanceAddressesAllowed || c2->instanceAddressesAllowed); rv->externalAddressesAllowed = (c1->externalAddressesAllowed || c2->externalAddressesAllowed); rv->voidAllowed = (c1->voidAllowed || c2->voidAllowed); rv->factAddressesAllowed = (c1->factAddressesAllowed || c2->factAddressesAllowed); } /*=================================*/ /* Union the allowed-values flags. */ /*=================================*/ if (c1->anyRestriction && c2->anyRestriction) rv->anyRestriction = TRUE; else { if (c1->anyRestriction) { c1Changed = TRUE; SetAnyRestrictionFlags(c1,FALSE); } else if (c2->anyRestriction) { c2Changed = TRUE; SetAnyRestrictionFlags(c2,FALSE); } rv->anyRestriction = FALSE; rv->symbolRestriction = (c1->symbolRestriction && c2->symbolRestriction); rv->stringRestriction = (c1->stringRestriction && c2->stringRestriction); rv->floatRestriction = (c1->floatRestriction && c2->floatRestriction); rv->integerRestriction = (c1->integerRestriction && c2->integerRestriction); rv->classRestriction = (c1->classRestriction && c2->classRestriction); rv->instanceNameRestriction = (c1->instanceNameRestriction && c2->instanceNameRestriction); if (c1Changed) SetAnyRestrictionFlags(c1,FALSE); else if (c2Changed) SetAnyRestrictionFlags(c2,FALSE); } /*========================================*/ /* Union the allowed values list, the min */ /* and max values, and the range values. */ /*========================================*/ UnionAllowedValueExpressions(theEnv,c1,c2,rv); UnionAllowedClassExpressions(theEnv,c1,c2,rv); UnionNumericExpressions(theEnv,c1,c2,rv,TRUE); UnionNumericExpressions(theEnv,c1,c2,rv,FALSE); /*========================================*/ /* If multifields are allowed, then union */ /* the constraint record for them. */ /*========================================*/ if (rv->multifieldsAllowed) { rv->multifield = UnionConstraints(theEnv,c1->multifield,c2->multifield); } /*====================*/ /* Return the unioned */ /* constraint record. */ /*====================*/ return(rv); } /**************************************************/ /* UnionNumericExpressions: Creates the union of */ /* two range or two min/max-fields constraints. */ /**************************************************/ static void UnionNumericExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint, int range) { struct expr *tmpmin, *tmpmax; struct expr *theMinList, *theMaxList; /*=========================================*/ /* Initialize the new range/min/max values */ /* for the union of the constraints. */ /*=========================================*/ theMinList = NULL; theMaxList = NULL; /*=================================*/ /* Determine the min/max values of */ /* the first constraint record. */ /*=================================*/ if (range) { tmpmin = constraint1->minValue; tmpmax = constraint1->maxValue; } else { tmpmin = constraint1->minFields; tmpmax = constraint1->maxFields; } /*============================================*/ /* Add each range/min/max pair from the first */ /* constraint record to the union list. */ /*============================================*/ for (; tmpmin != NULL; tmpmin = tmpmin->nextArg,tmpmax = tmpmax->nextArg) { UnionRangeMinMaxValueWithList(theEnv,tmpmin,tmpmax,&theMinList,&theMaxList); } /*=================================*/ /* Determine the min/max values of */ /* the second constraint record. */ /*=================================*/ if (range) { tmpmin = constraint2->minValue; tmpmax = constraint2->maxValue; } else { tmpmin = constraint2->minFields; tmpmax = constraint2->maxFields; } /*=============================================*/ /* Add each range/min/max pair from the second */ /* constraint record to the union list. */ /*=============================================*/ for (; tmpmin != NULL; tmpmin = tmpmin->nextArg,tmpmax = tmpmax->nextArg) { UnionRangeMinMaxValueWithList(theEnv,tmpmin,tmpmax,&theMinList,&theMaxList); } /*=====================================================*/ /* If the union produced a pair of valid range/min/max */ /* values, then replace the previous values of the */ /* constraint record to the new unioned values. */ /*=====================================================*/ if (theMinList != NULL) { if (range) { ReturnExpression(theEnv,newConstraint->minValue); ReturnExpression(theEnv,newConstraint->maxValue); newConstraint->minValue = theMinList; newConstraint->maxValue = theMaxList; } else { ReturnExpression(theEnv,newConstraint->minFields); ReturnExpression(theEnv,newConstraint->maxFields); newConstraint->minFields = theMinList; newConstraint->maxFields = theMaxList; } } /*==============================================================*/ /* Otherwise, the union produced no valid range/min/max values. */ /* For the range attribute, this means that no numbers can */ /* satisfy the constraint. For the min/max fields attribute, it */ /* means that no value can satisfy the constraint. */ /*==============================================================*/ else { if (range) { if (newConstraint->anyAllowed) SetAnyAllowedFlags(newConstraint,FALSE); newConstraint->integersAllowed = FALSE; newConstraint->floatsAllowed = FALSE; } else { SetAnyAllowedFlags(newConstraint,TRUE); newConstraint->anyAllowed = TRUE; } } } /*********************************************************/ /* UnionRangeMinMaxValueWithList: Unions a range/min/max */ /* pair of values with a list of such values. */ /*********************************************************/ static void UnionRangeMinMaxValueWithList( void *theEnv, struct expr *addmin, struct expr *addmax, struct expr **theMinList, struct expr **theMaxList) { struct expr *tmpmin, *tmpmax, *lastmin, *lastmax; struct expr *themin, *themax, *nextmin, *nextmax; int cmaxmin, cmaxmax, cminmin, cminmax; /*=========================================================*/ /* If no values are on the lists, then use the new values. */ /*=========================================================*/ if (*theMinList == NULL) { *theMinList = GenConstant(theEnv,addmin->type,addmin->value); *theMaxList = GenConstant(theEnv,addmax->type,addmax->value); return; } lastmin = NULL; lastmax = NULL; tmpmin = (*theMinList); tmpmax = (*theMaxList); while (tmpmin != NULL) { cmaxmax = CompareNumbers(theEnv,addmax->type,addmax->value, tmpmax->type,tmpmax->value); cminmin = CompareNumbers(theEnv,addmin->type,addmin->value, tmpmin->type,tmpmin->value); cmaxmin = CompareNumbers(theEnv,addmax->type,addmax->value, tmpmin->type,tmpmin->value); cminmax = CompareNumbers(theEnv,addmin->type,addmin->value, tmpmax->type,tmpmax->value); /*=================================*/ /* Check to see if the range is */ /* contained within another range. */ /*=================================*/ if (((cmaxmax == LESS_THAN) || (cmaxmax == EQUAL)) && ((cminmin == GREATER_THAN) || (cminmin == EQUAL))) { return; } /*================================*/ /* Extend the greater than range. */ /*================================*/ if ((cmaxmax == GREATER_THAN) && ((cminmax == LESS_THAN) || (cminmax == EQUAL))) { tmpmax->type = addmax->type; tmpmax->value = addmax->value; } /*=============================*/ /* Extend the less than range. */ /*=============================*/ if ((cminmin == LESS_THAN) && ((cmaxmin == GREATER_THAN) || (cmaxmin == EQUAL))) { tmpmin->type = addmin->type; tmpmin->value = addmin->value; } /*====================*/ /* Handle insertions. */ /*====================*/ if (cmaxmin == LESS_THAN) { if (lastmax == NULL) { themin = GenConstant(theEnv,addmin->type,addmin->value); themax = GenConstant(theEnv,addmax->type,addmax->value); themin->nextArg = *theMinList; themax->nextArg = *theMaxList; *theMinList = themin; *theMaxList = themax; return; } if (CompareNumbers(theEnv,addmin->type,addmin->value, lastmax->type,lastmax->value) == GREATER_THAN) { themin = GenConstant(theEnv,addmin->type,addmin->value); themax = GenConstant(theEnv,addmax->type,addmax->value); themin->nextArg = lastmin->nextArg; themax->nextArg = lastmax->nextArg; lastmin->nextArg = themin; lastmax->nextArg = themax; return; } } /*==========================*/ /* Move on to the next one. */ /*==========================*/ tmpmin = tmpmin->nextArg; tmpmax = tmpmax->nextArg; } /*===========================*/ /* Merge overlapping ranges. */ /*===========================*/ tmpmin = (*theMinList); tmpmax = (*theMaxList); while (tmpmin != NULL) { nextmin = tmpmin->nextArg; nextmax = tmpmax->nextArg; if (nextmin != NULL) { cmaxmin = CompareNumbers(theEnv,tmpmax->type,tmpmax->value, nextmin->type,nextmin->value); if ((cmaxmin == GREATER_THAN) || (cmaxmin == EQUAL)) { tmpmax->type = nextmax->type; tmpmax->value = nextmax->value; tmpmax->nextArg = nextmax->nextArg; tmpmin->nextArg = nextmin->nextArg; rtn_struct(theEnv,expr,nextmin); rtn_struct(theEnv,expr,nextmax); } else { tmpmin = tmpmin->nextArg; tmpmax = tmpmax->nextArg; } } else { tmpmin = nextmin; tmpmax = nextmax; } } } /***************************************************/ /* UnionAllowedClassExpressions: Creates the union */ /* of two sets of allowed-classes expressions. */ /***************************************************/ static void UnionAllowedClassExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theHead = NULL; theHead = AddToUnionList(theEnv,constraint1->classList,theHead,newConstraint); theHead = AddToUnionList(theEnv,constraint2->classList,theHead,newConstraint); newConstraint->classList = theHead; } /***************************************************/ /* UnionAllowedValueExpressions: Creates the union */ /* of two sets of allowed value expressions. */ /***************************************************/ static void UnionAllowedValueExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theHead = NULL; theHead = AddToUnionList(theEnv,constraint1->restrictionList,theHead,newConstraint); theHead = AddToUnionList(theEnv,constraint2->restrictionList,theHead,newConstraint); newConstraint->restrictionList = theHead; } /************************************************************/ /* AddToUnionList: Adds a list of values to a unioned list */ /* making sure that duplicates are not added and that any */ /* value added satisfies the constraints for the list. */ /************************************************************/ static struct expr *AddToUnionList( void *theEnv, struct expr *theList1, struct expr *theHead, CONSTRAINT_RECORD *theConstraint) { struct expr *theList2; int flag; /*======================================*/ /* Loop through each value in the list */ /* being added to the unioned set. */ /*======================================*/ for (;theList1 != NULL; theList1 = theList1->nextArg) { /*===================================*/ /* Determine if the value is already */ /* in the unioned list. */ /*===================================*/ flag = TRUE; for (theList2 = theHead; theList2 != NULL; theList2 = theList2->nextArg) { if ((theList1->type == theList2->type) && (theList1->value == theList2->value)) { flag = FALSE; break; } } /*=====================================================*/ /* If the value wasn't in the unioned list and doesn't */ /* violate any of the unioned list's constraints, then */ /* add it to the list. */ /*=====================================================*/ if (flag) { if (RestrictionOnType(theList1->type,theConstraint)) { theList2 = GenConstant(theEnv,theList1->type,theList1->value); theList2->nextArg = theHead; theHead = theList2; } } } /*==============================*/ /* Return the new unioned list. */ /*==============================*/ return(theHead); } /****************************************************/ /* RemoveConstantFromConstraint: Removes a constant */ /* value (including any duplicates) from the */ /* restriction list of a constraint record. */ /****************************************************/ globle void RemoveConstantFromConstraint( void *theEnv, int theType, void *theValue, CONSTRAINT_RECORD *theConstraint) { struct expr *theList, *lastOne = NULL, *tmpList; if (theConstraint == NULL) return; theList = theConstraint->restrictionList; theConstraint->restrictionList = NULL; while (theList != NULL) { if ((theList->type != theType) || (theList->value != theValue)) { if (lastOne == NULL) { theConstraint->restrictionList = theList; } else { lastOne->nextArg = theList; } lastOne = theList; theList = theList->nextArg; lastOne->nextArg = NULL; } else { tmpList = theList; theList = theList->nextArg; tmpList->nextArg = NULL; ReturnExpression(theEnv,tmpList); } } UpdateRestrictionFlags(theConstraint); } #endif /* (! BLOAD_ONLY) */ #endif /* (! RUN_TIME) */ clips_core_source_630/core/._objrtcmp.h0000755000175000017500000000040712374023167016445 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._reteutil.h0000755000175000017500000000040712500146515016454 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlbsc.c0000755000175000017500000003126212373753373016205 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defglobal */ /* construct such as clear, reset, save, undefglobal, */ /* ppdefglobal, list-defglobals, and get-defglobals-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Moved WatchGlobals global to defglobalData. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _GLOBLBSC_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include "constrct.h" #include "extnfunc.h" #include "watch.h" #include "envrnmnt.h" #include "globlcom.h" #include "globldef.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "globlbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "globlcmp.h" #endif #include "globlbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void SaveDefglobals(void *,void *,const char *); static void ResetDefglobalAction(void *,struct constructHeader *,void *); #if DEBUGGING_FUNCTIONS && (! RUN_TIME) static unsigned DefglobalWatchAccess(void *,int,unsigned,struct expr *); static unsigned DefglobalWatchPrint(void *,const char *,int,struct expr *); #endif /*****************************************************************/ /* DefglobalBasicCommands: Initializes basic defglobal commands. */ /*****************************************************************/ globle void DefglobalBasicCommands( void *theEnv) { AddSaveFunction(theEnv,"defglobal",SaveDefglobals,40); EnvAddResetFunction(theEnv,"defglobal",ResetDefglobals,50); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-defglobal-list",'m',PTIEF GetDefglobalListFunction,"GetDefglobalListFunction","01w"); EnvDefineFunction2(theEnv,"undefglobal",'v',PTIEF UndefglobalCommand,"UndefglobalCommand","11w"); EnvDefineFunction2(theEnv,"defglobal-module",'w',PTIEF DefglobalModuleFunction,"DefglobalModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-defglobals",'v', PTIEF ListDefglobalsCommand,"ListDefglobalsCommand","01w"); EnvDefineFunction2(theEnv,"ppdefglobal",'v',PTIEF PPDefglobalCommand,"PPDefglobalCommand","11w"); AddWatchItem(theEnv,"globals",0,&DefglobalData(theEnv)->WatchGlobals,0,DefglobalWatchAccess,DefglobalWatchPrint); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DefglobalBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefglobalCompilerSetup(theEnv); #endif #endif } /*************************************************************/ /* ResetDefglobals: Defglobal reset routine for use with the */ /* reset command. Restores the values of the defglobals. */ /*************************************************************/ globle void ResetDefglobals( void *theEnv) { if (! EnvGetResetGlobals(theEnv)) return; DoForAllConstructs(theEnv,ResetDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,TRUE,NULL); } /******************************************************/ /* ResetDefglobalAction: Action to be applied to each */ /* defglobal construct during a reset command. */ /******************************************************/ static void ResetDefglobalAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct defglobal *theDefglobal = (struct defglobal *) theConstruct; DATA_OBJECT assignValue; if (EvaluateExpression(theEnv,theDefglobal->initial,&assignValue)) { assignValue.type = SYMBOL; assignValue.value = EnvFalseSymbol(theEnv); } QSetDefglobalValue(theEnv,theDefglobal,&assignValue,FALSE); } /******************************************/ /* SaveDefglobals: Defglobal save routine */ /* for use with the save command. */ /******************************************/ static void SaveDefglobals( void *theEnv, void *theModule, const char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DefglobalData(theEnv)->DefglobalConstruct); } /********************************************/ /* UndefglobalCommand: H/L access routine */ /* for the undefglobal command. */ /********************************************/ globle void UndefglobalCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefglobal",DefglobalData(theEnv)->DefglobalConstruct); } /************************************/ /* EnvUndefglobal: C access routine */ /* for the undefglobal command. */ /************************************/ globle intBool EnvUndefglobal( void *theEnv, void *theDefglobal) { return(Undefconstruct(theEnv,theDefglobal,DefglobalData(theEnv)->DefglobalConstruct)); } /**************************************************/ /* GetDefglobalListFunction: H/L access routine */ /* for the get-defglobal-list function. */ /**************************************************/ globle void GetDefglobalListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-defglobal-list",returnValue,DefglobalData(theEnv)->DefglobalConstruct); } /******************************************/ /* EnvGetDefglobalList: C access routine */ /* for the get-defglobal-list function. */ /******************************************/ globle void EnvGetDefglobalList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DefglobalData(theEnv)->DefglobalConstruct,(struct defmodule *) theModule); } /*************************************************/ /* DefglobalModuleFunction: H/L access routine */ /* for the defglobal-module function. */ /*************************************************/ globle void *DefglobalModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defglobal-module",DefglobalData(theEnv)->DefglobalConstruct)); } #if DEBUGGING_FUNCTIONS /********************************************/ /* PPDefglobalCommand: H/L access routine */ /* for the ppdefglobal command. */ /********************************************/ globle void PPDefglobalCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefglobal",DefglobalData(theEnv)->DefglobalConstruct); } /*************************************/ /* PPDefglobal: C access routine for */ /* the ppdefglobal command. */ /*************************************/ globle int PPDefglobal( void *theEnv, const char *defglobalName, const char *logicalName) { return(PPConstruct(theEnv,defglobalName,logicalName,DefglobalData(theEnv)->DefglobalConstruct)); } /***********************************************/ /* ListDefglobalsCommand: H/L access routine */ /* for the list-defglobals command. */ /***********************************************/ globle void ListDefglobalsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defglobals",DefglobalData(theEnv)->DefglobalConstruct); } /***************************************/ /* EnvListDefglobals: C access routine */ /* for the list-defglobals command. */ /***************************************/ globle void EnvListDefglobals( void *theEnv, const char *logicalName, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; ListConstruct(theEnv,DefglobalData(theEnv)->DefglobalConstruct,logicalName,theModule); } /*********************************************************/ /* EnvGetDefglobalWatch: C access routine for retrieving */ /* the current watch value of a defglobal. */ /*********************************************************/ globle unsigned EnvGetDefglobalWatch( void *theEnv, void *theGlobal) { #if MAC_XCD #pragma unused(theEnv) #endif return(((struct defglobal *) theGlobal)->watch); } /********************************************************/ /* EnvSetDeftemplateWatch: C access routine for setting */ /* the current watch value of a deftemplate. */ /********************************************************/ globle void EnvSetDefglobalWatch( void *theEnv, unsigned newState, void *theGlobal) { #if MAC_XCD #pragma unused(theEnv) #endif ((struct defglobal *) theGlobal)->watch = newState; } #if ! RUN_TIME /********************************************************/ /* DefglobalWatchAccess: Access routine for setting the */ /* watch flag of a defglobal via the watch command. */ /********************************************************/ static unsigned DefglobalWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DefglobalData(theEnv)->DefglobalConstruct,newState,argExprs, EnvGetDefglobalWatch,EnvSetDefglobalWatch)); } /*********************************************************************/ /* DefglobalWatchPrint: Access routine for printing which defglobals */ /* have their watch flag set via the list-watch-items command. */ /*********************************************************************/ static unsigned DefglobalWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DefglobalData(theEnv)->DefglobalConstruct,logName,argExprs, EnvGetDefglobalWatch,EnvSetDefglobalWatch)); } #endif /* ! RUN_TIME */ #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void GetDefglobalList( DATA_OBJECT_PTR returnValue, void *theModule) { EnvGetDefglobalList(GetCurrentEnvironment(),returnValue,theModule); } #if DEBUGGING_FUNCTIONS globle unsigned GetDefglobalWatch( void *theGlobal) { return EnvGetDefglobalWatch(GetCurrentEnvironment(),theGlobal); } globle void ListDefglobals( const char *logicalName, void *vTheModule) { EnvListDefglobals(GetCurrentEnvironment(),logicalName,vTheModule); } globle void SetDefglobalWatch( unsigned newState, void *theGlobal) { EnvSetDefglobalWatch(GetCurrentEnvironment(),newState,theGlobal); } #endif /* DEBUGGING_FUNCTIONS */ globle intBool Undefglobal( void *theDefglobal) { return EnvUndefglobal(GetCurrentEnvironment(),theDefglobal); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFGLOBAL_CONSTRUCT */ clips_core_source_630/core/._lgcldpnd.c0000755000175000017500000000040712373744002016404 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._facthsh.c0000755000175000017500000000040712373742654016250 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/classcom.c0000755000175000017500000010221612464554105016211 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* CLASS COMMANDS MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Kernel Interface Commands for Object System */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "argacces.h" #include "classfun.h" #include "classini.h" #include "envrnmnt.h" #include "modulutl.h" #include "msgcom.h" #include "router.h" #define _CLASSCOM_SOURCE_ #include "classcom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS static void SaveDefclass(void *,struct constructHeader *,void *); #endif static const char *GetClassDefaultsModeName(unsigned short); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************************* NAME : EnvFindDefclass DESCRIPTION : Looks up a specified class in the class hash table (Only looks in current or specified module) INPUTS : The name-string of the class (including module) RETURNS : The address of the found class, NULL otherwise SIDE EFFECTS : None NOTES : None ******************************************************************/ globle void *EnvFindDefclass( // TBD Needs to look in imported void *theEnv, const char *classAndModuleName) { SYMBOL_HN *classSymbol = NULL; DEFCLASS *cls; struct defmodule *theModule = NULL; const char *className; SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); if (className != NULL) { classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName)); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } RestoreCurrentModule(theEnv); if (classSymbol == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if (cls->header.name == classSymbol) { if (cls->system || (cls->header.whichModule->theModule == theModule)) return(cls->installed ? (void *) cls : NULL); } cls = cls->nxtHash; } return(NULL); } /******************************************************************* NAME : EnvFindDefclass DESCRIPTION : Looks up a specified class in the class hash table (Only looks in current or specified module) INPUTS : The name-string of the class (including module) RETURNS : The address of the found class, NULL otherwise SIDE EFFECTS : None NOTES : None ******************************************************************/ globle void *EnvFindDefclassInModule( void *theEnv, const char *classAndModuleName) { SYMBOL_HN *classSymbol = NULL; DEFCLASS *cls; struct defmodule *theModule = NULL; const char *className; SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); if (className != NULL) { classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName)); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } RestoreCurrentModule(theEnv); if (classSymbol == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if (cls->header.name == classSymbol) { if (cls->system || (cls->header.whichModule->theModule == theModule)) return(cls->installed ? (void *) cls : NULL); } cls = cls->nxtHash; } return(NULL); } /*************************************************** NAME : LookupDefclassByMdlOrScope DESCRIPTION : Finds a class anywhere (if module is specified) or in current or imported modules INPUTS : The class name RETURNS : The class (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : Assumes no two classes of the same name are ever in the same scope ***************************************************/ globle DEFCLASS *LookupDefclassByMdlOrScope( void *theEnv, const char *classAndModuleName) { DEFCLASS *cls; const char *className; SYMBOL_HN *classSymbol; struct defmodule *theModule; if (FindModuleSeparator(classAndModuleName) == FALSE) return(LookupDefclassInScope(theEnv,classAndModuleName)); SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); RestoreCurrentModule(theEnv); if(className == NULL) return(NULL); if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && (cls->header.whichModule->theModule == theModule)) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); } /**************************************************** NAME : LookupDefclassInScope DESCRIPTION : Finds a class in current or imported modules (module specifier is not allowed) INPUTS : The class name RETURNS : The class (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : Assumes no two classes of the same name are ever in the same scope ****************************************************/ globle DEFCLASS *LookupDefclassInScope( void *theEnv, const char *className) { DEFCLASS *cls; SYMBOL_HN *classSymbol; if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && DefclassInScope(theEnv,cls,NULL)) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); } /****************************************************** NAME : LookupDefclassAnywhere DESCRIPTION : Finds a class in specified (or any) module INPUTS : 1) The module (NULL if don't care) 2) The class name (module specifier in name not allowed) RETURNS : The class (NULL if not found) SIDE EFFECTS : None NOTES : Does *not* generate an error if multiple classes of the same name exist as do the other lookup functions ******************************************************/ globle DEFCLASS *LookupDefclassAnywhere( void *theEnv, struct defmodule *theModule, const char *className) { DEFCLASS *cls; SYMBOL_HN *classSymbol; if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && ((theModule == NULL) || (cls->header.whichModule->theModule == theModule))) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); } /*************************************************** NAME : DefclassInScope DESCRIPTION : Determines if a defclass is in scope of the given module INPUTS : 1) The defclass 2) The module (NULL for current module) RETURNS : TRUE if in scope, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool DefclassInScope( void *theEnv, DEFCLASS *theDefclass, struct defmodule *theModule) { #if DEFMODULE_CONSTRUCT int moduleID; char *scopeMap; scopeMap = (char *) ValueToBitMap(theDefclass->scopeMap); if (theModule == NULL) theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); moduleID = (int) theModule->bsaveID; return(TestBitMap(scopeMap,moduleID) ? TRUE : FALSE); #else #if MAC_XCD #pragma unused(theEnv,theDefclass,theModule) #endif return(TRUE); #endif } /*********************************************************** NAME : EnvGetNextDefclass DESCRIPTION : Finds first or next defclass INPUTS : The address of the current defclass RETURNS : The address of the next defclass (NULL if none) SIDE EFFECTS : None NOTES : If ptr == NULL, the first defclass is returned. ***********************************************************/ globle void *EnvGetNextDefclass( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefclassData(theEnv)->DefclassModuleIndex)); } /*************************************************** NAME : EnvIsDefclassDeletable DESCRIPTION : Determines if a defclass can be deleted INPUTS : Address of the defclass RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvIsDefclassDeletable( void *theEnv, void *ptr) { DEFCLASS *cls; if (! ConstructsDeletable(theEnv)) { return FALSE; } cls = (DEFCLASS *) ptr; if (cls->system == 1) return(FALSE); #if (! BLOAD_ONLY) && (! RUN_TIME) return((IsClassBeingUsed(cls) == FALSE) ? TRUE : FALSE); #else return FALSE; #endif } /************************************************************* NAME : UndefclassCommand DESCRIPTION : Deletes a class and its subclasses, as well as their associated instances INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (undefclass | *) *************************************************************/ globle void UndefclassCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefclass",DefclassData(theEnv)->DefclassConstruct); } /******************************************************** NAME : EnvUndefclass DESCRIPTION : Deletes the named defclass INPUTS : None RETURNS : TRUE if deleted, or FALSE SIDE EFFECTS : Defclass and handlers removed NOTES : Interface for AddConstruct() ********************************************************/ globle intBool EnvUndefclass( void *theEnv, void *theDefclass) { #if RUN_TIME || BLOAD_ONLY return(FALSE); #else DEFCLASS *cls; cls = (DEFCLASS *) theDefclass; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif if (cls == NULL) return(RemoveAllUserClasses(theEnv)); return(DeleteClassUAG(theEnv,cls)); #endif } #if DEBUGGING_FUNCTIONS /********************************************************* NAME : PPDefclassCommand DESCRIPTION : Displays the pretty print form of a class to the wdialog router. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (ppdefclass ) *********************************************************/ globle void PPDefclassCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefclass",DefclassData(theEnv)->DefclassConstruct); } /*************************************************** NAME : ListDefclassesCommand DESCRIPTION : Displays all defclass names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Defclass names printed NOTES : H/L Interface ***************************************************/ globle void ListDefclassesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defclasses",DefclassData(theEnv)->DefclassConstruct); } /*************************************************** NAME : EnvListDefclasses DESCRIPTION : Displays all defclass names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Defclass names printed NOTES : C Interface ***************************************************/ globle void EnvListDefclasses( void *theEnv, const char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DefclassData(theEnv)->DefclassConstruct,logicalName,theModule); } /********************************************************* NAME : EnvGetDefclassWatchInstances DESCRIPTION : Determines if deletions/creations of instances of this class will generate trace messages or not INPUTS : A pointer to the class RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle unsigned EnvGetDefclassWatchInstances( void *theEnv, void *theClass) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) theClass)->traceInstances); } /********************************************************* NAME : EnvSetDefclassWatchInstances DESCRIPTION : Sets the trace to ON/OFF for the creation/deletion of instances of the class INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the class set NOTES : None *********************************************************/ globle void EnvSetDefclassWatchInstances( void *theEnv, unsigned newState, void *theClass) { #if MAC_XCD #pragma unused(theEnv) #endif if (((DEFCLASS *) theClass)->abstract) return; ((DEFCLASS *) theClass)->traceInstances = newState; } /********************************************************* NAME : EnvGetDefclassWatchSlots DESCRIPTION : Determines if changes to slots of instances of this class will generate trace messages or not INPUTS : A pointer to the class RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle unsigned EnvGetDefclassWatchSlots( void *theEnv, void *theClass) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) theClass)->traceSlots); } /********************************************************** NAME : EnvSetDefclassWatchSlots DESCRIPTION : Sets the trace to ON/OFF for the changes to slots of instances of the class INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the class set NOTES : None **********************************************************/ globle void EnvSetDefclassWatchSlots( void *theEnv, unsigned newState, void *theClass) { #if MAC_XCD #pragma unused(theEnv) #endif ((DEFCLASS *) theClass)->traceSlots = newState; } /****************************************************************** NAME : DefclassWatchAccess DESCRIPTION : Parses a list of class names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 2) The value to which to set the trace flags 3) A list of expressions containing the names of the classes for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified classes NOTES : Accessory function for AddWatchItem() ******************************************************************/ globle unsigned DefclassWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { if (code) return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs, EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots)); else return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs, EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances)); } /*********************************************************************** NAME : DefclassWatchPrint DESCRIPTION : Parses a list of class names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 3) A list of expressions containing the names of the classes for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified classes NOTES : Accessory function for AddWatchItem() ***********************************************************************/ globle unsigned DefclassWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { if (code) return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs, EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots)); else return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs, EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances)); } #endif /* DEBUGGING_FUNCTIONS */ /********************************************************* NAME : GetDefclassListFunction DESCRIPTION : Groups names of all defclasses into a multifield variable INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Multifield set to list of classes NOTES : None *********************************************************/ globle void GetDefclassListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-defclass-list",returnValue,DefclassData(theEnv)->DefclassConstruct); } /*************************************************************** NAME : EnvGetDefclassList DESCRIPTION : Groups all defclass names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain defclasses RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDefclassList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DefclassData(theEnv)->DefclassConstruct,theModule); } /***************************************************** NAME : HasSuperclass DESCRIPTION : Determines if class-2 is a superclass of class-1 INPUTS : 1) Class-1 2) Class-2 RETURNS : TRUE if class-2 is a superclass of class-1, FALSE otherwise SIDE EFFECTS : None NOTES : None *****************************************************/ globle int HasSuperclass( DEFCLASS *c1, DEFCLASS *c2) { long i; for (i = 1 ; i < c1->allSuperclasses.classCount ; i++) if (c1->allSuperclasses.classArray[i] == c2) return(TRUE); return(FALSE); } /******************************************************************** NAME : CheckClassAndSlot DESCRIPTION : Checks class and slot argument for various functions INPUTS : 1) Name of the calling function 2) Buffer for class address RETURNS : Slot symbol, NULL on errors SIDE EFFECTS : None NOTES : None ********************************************************************/ globle SYMBOL_HN *CheckClassAndSlot( void *theEnv, const char *func, DEFCLASS **cls) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE) return(NULL); *cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*cls == NULL) { ClassExistError(theEnv,func,DOToString(temp)); return(NULL); } if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE) return(NULL); return((SYMBOL_HN *) GetValue(temp)); } #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : SaveDefclasses DESCRIPTION : Prints pretty print form of defclasses to specified output INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void SaveDefclasses( void *theEnv, void *theModule, const char *logName) { #if DEBUGGING_FUNCTIONS DoForAllConstructsInModule(theEnv,theModule,SaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) logName); #else #if MAC_XCD #pragma unused(theEnv,theModule,logName) #endif #endif } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS /*************************************************** NAME : SaveDefclass DESCRIPTION : Writes out the pretty-print forms of a class and all its handlers INPUTS : 1) The class 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Class and handlers written NOTES : None ***************************************************/ static void SaveDefclass( void *theEnv, struct constructHeader *theDefclass, void *userBuffer) { const char *logName = (const char *) userBuffer; unsigned hnd; const char *ppForm; ppForm = EnvGetDefclassPPForm(theEnv,(void *) theDefclass); if (ppForm != NULL) { PrintInChunks(theEnv,logName,ppForm); EnvPrintRouter(theEnv,logName,"\n"); hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,0); while (hnd != 0) { ppForm = EnvGetDefmessageHandlerPPForm(theEnv,(void *) theDefclass,hnd); if (ppForm != NULL) { PrintInChunks(theEnv,logName,ppForm); EnvPrintRouter(theEnv,logName,"\n"); } hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,hnd); } } } #endif /***********************************************/ /* EnvSetClassDefaultsMode: Allows the setting */ /* of the class defaults mode. */ /***********************************************/ globle unsigned short EnvSetClassDefaultsMode( void *theEnv, unsigned short value) { unsigned short ov; ov = DefclassData(theEnv)->ClassDefaultsMode; DefclassData(theEnv)->ClassDefaultsMode = value; return(ov); } /****************************************/ /* EnvGetClassDefaultsMode: Returns the */ /* value of the class defaults mode. */ /****************************************/ globle unsigned short EnvGetClassDefaultsMode( void *theEnv) { return(DefclassData(theEnv)->ClassDefaultsMode); } /***************************************************/ /* GetClassDefaultsModeCommand: H/L access routine */ /* for the get-class-defaults-mode command. */ /***************************************************/ globle void *GetClassDefaultsModeCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-class-defaults-mode",EXACTLY,0); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } /***************************************************/ /* SetClassDefaultsModeCommand: H/L access routine */ /* for the set-class-defaults-mode command. */ /***************************************************/ globle void *SetClassDefaultsModeCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; unsigned short oldMode; oldMode = DefclassData(theEnv)->ClassDefaultsMode; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"set-class-defaults-mode",EXACTLY,1) == -1) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } if (EnvArgTypeCheck(theEnv,"set-class-defaults-mode",1,SYMBOL,&argPtr) == FALSE) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } argument = DOToString(argPtr); /*=============================================*/ /* Set the strategy to the specified strategy. */ /*=============================================*/ if (strcmp(argument,"conservation") == 0) { EnvSetClassDefaultsMode(theEnv,CONSERVATION_MODE); } else if (strcmp(argument,"convenience") == 0) { EnvSetClassDefaultsMode(theEnv,CONVENIENCE_MODE); } else { ExpectedTypeError1(theEnv,"set-class-defaults-mode",1, "symbol with value conservation or convenience"); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } /*===================================*/ /* Return the old value of the mode. */ /*===================================*/ return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(oldMode))); } /*******************************************************************/ /* GetClassDefaultsModeName: Given the integer value corresponding */ /* to a specified class defaults mode, return a character string */ /* of the class defaults mode's name. */ /*******************************************************************/ static const char *GetClassDefaultsModeName( unsigned short mode) { const char *sname; switch (mode) { case CONSERVATION_MODE: sname = "conservation"; break; case CONVENIENCE_MODE: sname = "convenience"; break; default: sname = "unknown"; break; } return(sname); } /*#############################*/ /* Additional Access Functions */ /*#############################*/ globle SYMBOL_HN *GetDefclassNamePointer( void *theClass) { return GetConstructNamePointer((struct constructHeader *) theClass); } globle void SetNextDefclass( void *theClass, void *targetClass) { SetNextConstruct((struct constructHeader *) theClass, (struct constructHeader *) targetClass); } /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvGetDefclassName( void *theEnv, void *theClass) { return EnvGetConstructNameString(theEnv,(struct constructHeader *) theClass); } globle const char *EnvGetDefclassPPForm( void *theEnv, void *theClass) { return GetConstructPPForm(theEnv,(struct constructHeader *) theClass); } globle struct defmoduleItemHeader *EnvGetDefclassModule( void *theEnv, void *theClass) { return GetConstructModuleItem((struct constructHeader *) theClass); } globle const char *EnvDefclassModule( void *theEnv, void *theClass) { return GetConstructModuleName((struct constructHeader *) theClass); } globle void EnvSetDefclassPPForm( void *theEnv, void *theClass, char *thePPForm) { SetConstructPPForm(theEnv,(struct constructHeader *) theClass,thePPForm); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void *FindDefclass( const char *classAndModuleName) { return EnvFindDefclass(GetCurrentEnvironment(),classAndModuleName); } globle void GetDefclassList( DATA_OBJECT *returnValue, struct defmodule *theModule) { EnvGetDefclassList(GetCurrentEnvironment(),returnValue,theModule); } globle void *GetNextDefclass( void *ptr) { return EnvGetNextDefclass(GetCurrentEnvironment(),ptr); } globle intBool IsDefclassDeletable( void *ptr) { return EnvIsDefclassDeletable(GetCurrentEnvironment(),ptr); } globle intBool Undefclass( void *theDefclass) { return EnvUndefclass(GetCurrentEnvironment(),theDefclass); } globle unsigned short SetClassDefaultsMode( unsigned short value) { return EnvSetClassDefaultsMode(GetCurrentEnvironment(),value); } globle unsigned short GetClassDefaultsMode() { return EnvGetClassDefaultsMode(GetCurrentEnvironment()); } globle const char *GetDefclassName( void *theClass) { return EnvGetDefclassName(GetCurrentEnvironment(),theClass); } globle const char *GetDefclassPPForm( void *theClass) { return EnvGetDefclassPPForm(GetCurrentEnvironment(),theClass); } globle struct defmoduleItemHeader *GetDefclassModule( void *theClass) { return EnvGetDefclassModule(GetCurrentEnvironment(),theClass); } globle const char *DefclassModule( void *theClass) { return EnvDefclassModule(GetCurrentEnvironment(),theClass); } #if DEBUGGING_FUNCTIONS globle unsigned GetDefclassWatchInstances( void *theClass) { return EnvGetDefclassWatchInstances(GetCurrentEnvironment(),theClass); } globle unsigned GetDefclassWatchSlots( void *theClass) { return EnvGetDefclassWatchSlots(GetCurrentEnvironment(),theClass); } globle void ListDefclasses( const char *logicalName, struct defmodule *theModule) { EnvListDefclasses(GetCurrentEnvironment(),logicalName,theModule); } globle void SetDefclassWatchInstances( unsigned newState, void *theClass) { EnvSetDefclassWatchInstances(GetCurrentEnvironment(),newState,theClass); } globle void SetDefclassWatchSlots( unsigned newState, void *theClass) { EnvSetDefclassWatchSlots(GetCurrentEnvironment(),newState,theClass); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* OBJECT_SYSTEM */ clips_core_source_630/core/._msgpsr.c0000755000175000017500000000040712375756074016146 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtbin.h0000755000175000017500000000040712374023202016424 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltbin.h0000755000175000017500000000040712373754242016462 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._memalloc.h0000755000175000017500000000040712500720752016411 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._classfun.c0000755000175000017500000000040712500721260016424 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxfun.h0000755000175000017500000001715212461252076016233 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFFUNCTION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added missing initializer for ENTITY_RECORD. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_dffnxfun #define _H_dffnxfun typedef struct deffunctionStruct DEFFUNCTION; typedef struct deffunctionModule DEFFUNCTION_MODULE; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct deffunctionModule { struct defmoduleItemHeader header; }; struct deffunctionStruct { struct constructHeader header; unsigned busy, executing; unsigned short trace; EXPRESSION *code; int minNumberOfParameters, maxNumberOfParameters, numberOfLocalVars; }; #define DEFFUNCTION_DATA 23 struct deffunctionData { struct construct *DeffunctionConstruct; int DeffunctionModuleIndex; ENTITY_RECORD DeffunctionEntityRecord; #if DEBUGGING_FUNCTIONS unsigned WatchDeffunctions; #endif struct CodeGeneratorItem *DeffunctionCodeItem; DEFFUNCTION *ExecutingDeffunction; #if (! BLOAD_ONLY) && (! RUN_TIME) struct token DFInputToken; #endif }; #define DeffunctionData(theEnv) ((struct deffunctionData *) GetEnvironmentData(theEnv,DEFFUNCTION_DATA)) LOCALE int CheckDeffunctionCall(void *,void *,int); LOCALE void DeffunctionGetBind(DATA_OBJECT *); LOCALE void DFRtnUnknown(DATA_OBJECT *); LOCALE void DFWildargs(DATA_OBJECT *); LOCALE const char *EnvDeffunctionModule(void *,void *); LOCALE void *EnvFindDeffunction(void *,const char *); LOCALE void *EnvFindDeffunctionInModule(void *,const char *); LOCALE void EnvGetDeffunctionList(void *,DATA_OBJECT *,struct defmodule *); LOCALE const char *EnvGetDeffunctionName(void *,void *); LOCALE SYMBOL_HN *EnvGetDeffunctionNamePointer(void *,void *); LOCALE const char *EnvGetDeffunctionPPForm(void *,void *); LOCALE void *EnvGetNextDeffunction(void *,void *); LOCALE int EnvIsDeffunctionDeletable(void *,void *); LOCALE void EnvSetDeffunctionPPForm(void *,void *,const char *); LOCALE intBool EnvUndeffunction(void *,void *); LOCALE void GetDeffunctionListFunction(void *,DATA_OBJECT *); LOCALE void *GetDeffunctionModuleCommand(void *); LOCALE DEFFUNCTION *LookupDeffunctionByMdlOrScope(void *,const char *); LOCALE DEFFUNCTION *LookupDeffunctionInScope(void *,const char *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE void RemoveDeffunction(void *,void *); #endif LOCALE void SetupDeffunctions(void *); LOCALE void UndeffunctionCommand(void *); #if DEBUGGING_FUNCTIONS LOCALE unsigned EnvGetDeffunctionWatch(void *,void *); LOCALE void EnvListDeffunctions(void *,const char *,struct defmodule *); LOCALE void EnvSetDeffunctionWatch(void *,unsigned,void *); LOCALE void ListDeffunctionsCommand(void *); LOCALE void PPDeffunctionCommand(void *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *DeffunctionModule(void *); LOCALE void *FindDeffunction(const char *); LOCALE void GetDeffunctionList(DATA_OBJECT *,struct defmodule *); LOCALE const char *GetDeffunctionName(void *); LOCALE const char *GetDeffunctionPPForm(void *); LOCALE void *GetNextDeffunction(void *); LOCALE intBool IsDeffunctionDeletable(void *); LOCALE intBool Undeffunction(void *); #if DEBUGGING_FUNCTIONS LOCALE unsigned GetDeffunctionWatch(void *); LOCALE void ListDeffunctions(const char *,struct defmodule *); LOCALE void SetDeffunctionWatch(unsigned,void *); #endif #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_dffnxfun */ clips_core_source_630/core/._match.h0000755000175000017500000000040712373755054015727 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrcpsr.c0000755000175000017500000000040712461252076016443 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._clsltpsr.h0000755000175000017500000000040712373714250016472 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._miscfun.c0000755000175000017500000000040712465006171016261 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._strngfun.c0000755000175000017500000000040712461303304016455 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objcmp.h0000755000175000017500000000571212374023212015655 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Object System Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added environment parameter to GenClose. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_objcmp #define _H_objcmp #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_object #include "object.h" #endif #define OBJECT_COMPILER_DATA 36 struct objectCompilerData { #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *ObjectCodeItem; #endif }; #define ObjectCompilerData(theEnv) ((struct objectCompilerData *) GetEnvironmentData(theEnv,OBJECT_COMPILER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectsCompiler(void *); LOCALE void PrintClassReference(void *,FILE *,DEFCLASS *,int,int); LOCALE void DefclassCModuleReference(void *,FILE *,int,int,int); #endif /* _H_objcmp */ clips_core_source_630/core/._default.h0000755000175000017500000000040712373720013016242 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factqpsr.c0000644000175000017500000000040712464742046016444 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factbld.c0000755000175000017500000000040712375756126016230 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._extnfunc.c0000755000175000017500000000040712462771770016462 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltdef.c0000755000175000017500000000040712461252520016431 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/prcdrpsr.c0000755000175000017500000010403112373743660016246 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PROCEDURAL FUNCTIONS PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Local variables set with the bind function */ /* persist until a reset/clear command is issued. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #define _PRCDRPSR_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnops.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "modulutl.h" #include "multifld.h" #include "router.h" #include "scanner.h" #include "utility.h" #include "prcdrpsr.h" #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #include "globlpsr.h" #endif #if ! RUN_TIME #define PRCDRPSR_DATA 12 struct procedureParserData { struct BindInfo *ListOfParsedBindNames; }; #define ProcedureParserData(theEnv) ((struct procedureParserData *) GetEnvironmentData(theEnv,PRCDRPSR_DATA)) #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) static void DeallocateProceduralFunctionData(void *); #if (! BLOAD_ONLY) static struct expr *WhileParse(void *,struct expr *,const char *); static struct expr *LoopForCountParse(void *,struct expr *,const char *); static void ReplaceLoopCountVars(void *,SYMBOL_HN *,EXPRESSION *,int); static struct expr *IfParse(void *,struct expr *,const char *); static struct expr *PrognParse(void *,struct expr *,const char *); static struct expr *BindParse(void *,struct expr *,const char *); static int AddBindName(void *,struct symbolHashNode *,CONSTRAINT_RECORD *); static struct expr *ReturnParse(void *,struct expr *,const char *); static struct expr *BreakParse(void *,struct expr *,const char *); static struct expr *SwitchParse(void *,struct expr *,const char *); #endif #endif #if ! RUN_TIME /*******************************************/ /* ProceduralFunctionParsers */ /*******************************************/ globle void ProceduralFunctionParsers( void *theEnv) { AllocateEnvironmentData(theEnv,PRCDRPSR_DATA,sizeof(struct procedureParserData),DeallocateProceduralFunctionData); #if (! BLOAD_ONLY) AddFunctionParser(theEnv,"bind",BindParse); AddFunctionParser(theEnv,"progn",PrognParse); AddFunctionParser(theEnv,"if",IfParse); AddFunctionParser(theEnv,"while",WhileParse); AddFunctionParser(theEnv,"loop-for-count",LoopForCountParse); AddFunctionParser(theEnv,"return",ReturnParse); AddFunctionParser(theEnv,"break",BreakParse); AddFunctionParser(theEnv,"switch",SwitchParse); #endif } /*************************************************************/ /* DeallocateProceduralFunctionData: Deallocates environment */ /* data for procedural functions. */ /*************************************************************/ static void DeallocateProceduralFunctionData( void *theEnv) { struct BindInfo *temp_bind; while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) { temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next; rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames); ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind; } } /********************************************************/ /* GetParsedBindNames: */ /********************************************************/ globle struct BindInfo *GetParsedBindNames( void *theEnv) { return(ProcedureParserData(theEnv)->ListOfParsedBindNames); } /********************************************************/ /* SetParsedBindNames: */ /********************************************************/ globle void SetParsedBindNames( void *theEnv, struct BindInfo *newValue) { ProcedureParserData(theEnv)->ListOfParsedBindNames = newValue; } /********************************************************/ /* ClearParsedBindNames: */ /********************************************************/ globle void ClearParsedBindNames( void *theEnv) { struct BindInfo *temp_bind; while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) { temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next; RemoveConstraint(theEnv,ProcedureParserData(theEnv)->ListOfParsedBindNames->constraints); rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames); ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind; } } /********************************************************/ /* ParsedBindNamesEmpty: */ /********************************************************/ globle intBool ParsedBindNamesEmpty( void *theEnv) { if (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) return(FALSE); return(TRUE); } #if (! BLOAD_ONLY) /*********************************************************/ /* WhileParse: purpose is to parse the while statement. */ /* The parse of the statement is the return value. */ /* Syntax: (while do +) */ /*********************************************************/ static struct expr *WhileParse( void *theEnv, struct expr *parse, const char *infile) { struct token theToken; int read_first_paren; /*===============================*/ /* Process the while expression. */ /*===============================*/ SavePPBuffer(theEnv," "); parse->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (parse->argList == NULL) { ReturnExpression(theEnv,parse); return(NULL); } /*====================================*/ /* Process the do keyword if present. */ /*====================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0)) { read_first_paren = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); } else if (theToken.type == LPAREN) { read_first_paren = FALSE; PPBackup(theEnv); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); } else { SyntaxErrorMessage(theEnv,"while function"); ReturnExpression(theEnv,parse); return(NULL); } /*============================*/ /* Process the while actions. */ /*============================*/ if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; ExpressionData(theEnv)->BreakContext = TRUE; parse->argList->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*=======================================================*/ /* Check for the closing right parenthesis of the while. */ /*=======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"while function"); ReturnExpression(theEnv,parse); return(NULL); } DecrementIndentDepth(theEnv,3); return(parse); } /******************************************************************************************/ /* LoopForCountParse: purpose is to parse the loop-for-count statement. */ /* The parse of the statement is the return value. */ /* Syntax: (loop-for-count [do] +) */ /* ::= ( [] ) */ /******************************************************************************************/ static struct expr *LoopForCountParse( void *theEnv, struct expr *parse, const char *infile) { struct token theToken; SYMBOL_HN *loopVar = NULL; EXPRESSION *tmpexp; int read_first_paren; struct BindInfo *oldBindList,*newBindList,*prev; /*======================================*/ /* Process the loop counter expression. */ /*======================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); /* ========================================== Simple form: loop-for-count [do] ... ========================================== */ if (theToken.type != LPAREN) { parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL)); parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } } else { GetToken(theEnv,infile,&theToken); if (theToken.type != SF_VARIABLE) { if (theToken.type != SYMBOL) goto LoopForCountParseError; parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL)); parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value)); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } } /* ============================================================= Complex form: loop-for-count ( [] ) [do] ... ============================================================= */ else { loopVar = (SYMBOL_HN *) theToken.value; SavePPBuffer(theEnv," "); parse->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (parse->argList == NULL) { ReturnExpression(theEnv,parse); return(NULL); } if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i')) goto LoopForCountParseError; SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL)); tmpexp->nextArg = parse->argList; parse->argList = tmpexp; } else { parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) goto LoopForCountParseError; } SavePPBuffer(theEnv," "); } } if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i')) goto LoopForCountParseError; /*====================================*/ /* Process the do keyword if present. */ /*====================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0)) { read_first_paren = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); } else if (theToken.type == LPAREN) { read_first_paren = FALSE; PPBackup(theEnv); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); } else goto LoopForCountParseError; /*=====================================*/ /* Process the loop-for-count actions. */ /*=====================================*/ if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; ExpressionData(theEnv)->BreakContext = TRUE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); parse->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE); if (parse->argList->nextArg->nextArg == NULL) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,parse); return(NULL); } newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { if ((loopVar == NULL) ? FALSE : (strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0)) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"PRCDRPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n"); ReturnExpression(theEnv,parse); return(NULL); } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; if (loopVar != NULL) ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*================================================================*/ /* Check for the closing right parenthesis of the loop-for-count. */ /*================================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"loop-for-count function"); ReturnExpression(theEnv,parse); return(NULL); } DecrementIndentDepth(theEnv,3); return(parse); LoopForCountParseError: SyntaxErrorMessage(theEnv,"loop-for-count function"); ReturnExpression(theEnv,parse); return(NULL); } /***************************************************/ /* ReplaceLoopCountVars */ /***************************************************/ static void ReplaceLoopCountVars( void *theEnv, SYMBOL_HN *loopVar, EXPRESSION *theExp, int depth) { while (theExp != NULL) { if ((theExp->type != SF_VARIABLE) ? FALSE : (strcmp(ValueToString(theExp->value),ValueToString(loopVar)) == 0)) { theExp->type = FCALL; theExp->value = (void *) FindFunction(theEnv,"(get-loop-count)"); theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long long) depth)); } else if (theExp->argList != NULL) { if ((theExp->type != FCALL) ? FALSE : (theExp->value == (void *) FindFunction(theEnv,"loop-for-count"))) ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth+1); else ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth); } theExp = theExp->nextArg; } } /*********************************************************/ /* IfParse: purpose is to parse the if statement. The */ /* parse of the statement is the return value. */ /* Syntax: (if then + */ /* [ else + ] ) */ /*********************************************************/ static struct expr *IfParse( void *theEnv, struct expr *top, const char *infile) { struct token theToken; /*============================*/ /* Process the if expression. */ /*============================*/ SavePPBuffer(theEnv," "); top->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } /*========================================*/ /* Keyword 'then' must follow expression. */ /*========================================*/ IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); GetToken(theEnv,infile,&theToken); if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0)) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*==============================*/ /* Process the if then actions. */ /*==============================*/ PPCRAndIndent(theEnv); if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->svContexts->brk == TRUE) ExpressionData(theEnv)->BreakContext = TRUE; top->argList->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,"else",FALSE); if (top->argList->nextArg == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg); /*===========================================*/ /* A ')' signals an if then without an else. */ /*===========================================*/ if (theToken.type == RPAREN) { DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); return(top); } /*=============================================*/ /* Keyword 'else' must follow if then actions. */ /*=============================================*/ if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"else") != 0)) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*==============================*/ /* Process the if else actions. */ /*==============================*/ PPCRAndIndent(theEnv); top->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE); if (top->argList->nextArg->nextArg == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg->nextArg); /*======================================================*/ /* Check for the closing right parenthesis of the if. */ /*======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*===========================================*/ /* A ')' signals an if then without an else. */ /*===========================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); DecrementIndentDepth(theEnv,3); return(top); } /********************************************************/ /* PrognParse: purpose is to parse the progn statement. */ /* The parse of the statement is the return value. */ /* Syntax: (progn *) */ /********************************************************/ static struct expr *PrognParse( void *theEnv, struct expr *top, const char *infile) { struct token tkn; struct expr *tmp; ReturnExpression(theEnv,top); ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); return(tmp); } /***********************************************************/ /* BindParse: purpose is to parse the bind statement. The */ /* parse of the statement is the return value. */ /* Syntax: (bind ?var ) */ /***********************************************************/ static struct expr *BindParse( void *theEnv, struct expr *top, const char *infile) { struct token theToken; SYMBOL_HN *variableName; struct expr *texp; CONSTRAINT_RECORD *theConstraint = NULL; #if DEFGLOBAL_CONSTRUCT struct defglobal *theGlobal; int count; #endif SavePPBuffer(theEnv," "); /*=============================================*/ /* Next token must be the name of the variable */ /* to be bound. */ /*=============================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type != SF_VARIABLE) && (theToken.type != GBL_VARIABLE)) { if ((theToken.type != MF_VARIABLE) || ExpressionData(theEnv)->SequenceOpMode) { SyntaxErrorMessage(theEnv,"bind function"); ReturnExpression(theEnv,top); return(NULL); } } /*==============================*/ /* Process the bind expression. */ /*==============================*/ top->argList = GenConstant(theEnv,SYMBOL,theToken.value); variableName = (SYMBOL_HN *) theToken.value; #if DEFGLOBAL_CONSTRUCT if ((theToken.type == GBL_VARIABLE) ? ((theGlobal = (struct defglobal *) FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(variableName), &count,TRUE,FALSE)) != NULL) : FALSE) { top->argList->type = DEFGLOBAL_PTR; top->argList->value = (void *) theGlobal; } else if (theToken.type == GBL_VARIABLE) { GlobalReferenceErrorMessage(theEnv,ValueToString(variableName)); ReturnExpression(theEnv,top); return(NULL); } #endif texp = get_struct(theEnv,expr); texp->argList = texp->nextArg = NULL; if (CollectArguments(theEnv,texp,infile) == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg = texp->argList; rtn_struct(theEnv,expr,texp); #if DEFGLOBAL_CONSTRUCT if (top->argList->type == DEFGLOBAL_PTR) return(top); #endif if (top->argList->nextArg != NULL) { theConstraint = ExpressionToConstraintRecord(theEnv,top->argList->nextArg); } AddBindName(theEnv,variableName,theConstraint); return(top); } /********************************************/ /* ReturnParse: Parses the return function. */ /********************************************/ static struct expr *ReturnParse( void *theEnv, struct expr *top, const char *infile) { int error_flag = FALSE; struct token theToken; if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->ReturnContext == FALSE) { PrintErrorID(theEnv,"PRCDRPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n"); ReturnExpression(theEnv,top); return(NULL); } ExpressionData(theEnv)->ReturnContext = FALSE; SavePPBuffer(theEnv," "); top->argList = ArgumentParse(theEnv,infile,&error_flag); if (error_flag) { ReturnExpression(theEnv,top); return(NULL); } else if (top->argList == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } else { SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"return function"); ReturnExpression(theEnv,top); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } return(top); } /**********************************************/ /* BreakParse: */ /**********************************************/ static struct expr *BreakParse( void *theEnv, struct expr *top, const char *infile) { struct token theToken; if (ExpressionData(theEnv)->svContexts->brk == FALSE) { PrintErrorID(theEnv,"PRCDRPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n"); ReturnExpression(theEnv,top); return(NULL); } SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"break function"); ReturnExpression(theEnv,top); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(top); } /**********************************************/ /* SwitchParse: */ /**********************************************/ static struct expr *SwitchParse( void *theEnv, struct expr *top, const char *infile) { struct token theToken; EXPRESSION *theExp,*chk; int default_count = 0; /*============================*/ /* Process the switch value */ /*============================*/ IncrementIndentDepth(theEnv,3); SavePPBuffer(theEnv," "); top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL); if (theExp == NULL) goto SwitchParseError; /*========================*/ /* Parse case statements. */ /*========================*/ GetToken(theEnv,infile,&theToken); while (theToken.type != RPAREN) { PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); if (theToken.type != LPAREN) goto SwitchParseErrorAndMessage; GetToken(theEnv,infile,&theToken); SavePPBuffer(theEnv," "); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"case") == 0)) { if (default_count != 0) goto SwitchParseErrorAndMessage; theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL); SavePPBuffer(theEnv," "); if (theExp->nextArg == NULL) goto SwitchParseError; for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg) { if ((chk->type == theExp->nextArg->type) && (chk->value == theExp->nextArg->value) && IdenticalExpression(chk->argList,theExp->nextArg->argList)) { PrintErrorID(theEnv,"PRCDRPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n"); goto SwitchParseError; } } GetToken(theEnv,infile,&theToken); if ((theToken.type != SYMBOL) ? TRUE : (strcmp(ValueToString(theToken.value),"then") != 0)) goto SwitchParseErrorAndMessage; } else if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"default") == 0)) { if (default_count) goto SwitchParseErrorAndMessage; theExp->nextArg = GenConstant(theEnv,RVOID,NULL); default_count = 1; } else goto SwitchParseErrorAndMessage; theExp = theExp->nextArg; if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->svContexts->brk == TRUE) ExpressionData(theEnv)->BreakContext = TRUE; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; if (theExp->nextArg == NULL) goto SwitchParseError; theExp = theExp->nextArg; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); GetToken(theEnv,infile,&theToken); } DecrementIndentDepth(theEnv,3); return(top); SwitchParseErrorAndMessage: SyntaxErrorMessage(theEnv,"switch function"); SwitchParseError: ReturnExpression(theEnv,top); DecrementIndentDepth(theEnv,3); return(NULL); } /********************************************************/ /* SearchParsedBindNames: */ /********************************************************/ globle int SearchParsedBindNames( void *theEnv, SYMBOL_HN *name_sought) { struct BindInfo *var_ptr; int theIndex = 1; var_ptr = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (var_ptr != NULL) { if (var_ptr->name == name_sought) { return(theIndex); } var_ptr = var_ptr->next; theIndex++; } return(0); } /********************************************************/ /* FindBindConstraints: */ /********************************************************/ globle struct constraintRecord *FindBindConstraints( void *theEnv, SYMBOL_HN *nameSought) { struct BindInfo *theVariable; theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (theVariable != NULL) { if (theVariable->name == nameSought) { return(theVariable->constraints); } theVariable = theVariable->next; } return(NULL); } /********************************************************/ /* CountParsedBindNames: Counts the number of variables */ /* names that have been bound using the bind function */ /* in the current context (e.g. the RHS of a rule). */ /********************************************************/ globle int CountParsedBindNames( void *theEnv) { struct BindInfo *theVariable; int theIndex = 0; theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (theVariable != NULL) { theVariable = theVariable->next; theIndex++; } return(theIndex); } /****************************************************************/ /* AddBindName: Adds a variable name used as the first argument */ /* of the bind function to the list of variable names parsed */ /* within the current semantic context (e.g. RHS of a rule). */ /****************************************************************/ static int AddBindName( void *theEnv, SYMBOL_HN *variableName, CONSTRAINT_RECORD *theConstraint) { CONSTRAINT_RECORD *tmpConstraint; struct BindInfo *currentBind, *lastBind; int theIndex = 1; /*=========================================================*/ /* Look for the variable name in the list of bind variable */ /* names already parsed. If it is found, then return the */ /* index to the variable and union the new constraint */ /* information with the old constraint information. */ /*=========================================================*/ lastBind = NULL; currentBind = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (currentBind != NULL) { if (currentBind->name == variableName) { if (theConstraint != NULL) { tmpConstraint = currentBind->constraints; currentBind->constraints = UnionConstraints(theEnv,theConstraint,currentBind->constraints); RemoveConstraint(theEnv,tmpConstraint); RemoveConstraint(theEnv,theConstraint); } return(theIndex); } lastBind = currentBind; currentBind = currentBind->next; theIndex++; } /*===============================================================*/ /* If the variable name wasn't found, then add it to the list of */ /* variable names and store the constraint information with it. */ /*===============================================================*/ currentBind = get_struct(theEnv,BindInfo); currentBind->name = variableName; currentBind->constraints = theConstraint; currentBind->next = NULL; if (lastBind == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = currentBind; else lastBind->next = currentBind; return(theIndex); } /********************************************************/ /* RemoveParsedBindName: */ /********************************************************/ globle void RemoveParsedBindName( void *theEnv, struct symbolHashNode *bname) { struct BindInfo *prv,*tmp; prv = NULL; tmp = ProcedureParserData(theEnv)->ListOfParsedBindNames; while ((tmp != NULL) ? (tmp->name != bname) : FALSE) { prv = tmp; tmp = tmp->next; } if (tmp != NULL) { if (prv == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = tmp->next; else prv->next = tmp->next; RemoveConstraint(theEnv,tmp->constraints); rtn_struct(theEnv,BindInfo,tmp); } } #endif #endif clips_core_source_630/core/._bload.h0000755000175000017500000000040712373706605015712 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._developr.h0000755000175000017500000000040712373721363016447 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insmult.c0000755000175000017500000004677112373756342016123 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INSTANCE MULTIFIELD SLOT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Access routines for Instance Multifield Slots */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "envrnmnt.h" #include "extnfunc.h" #include "insfun.h" #include "msgfun.h" #include "msgpass.h" #include "multifun.h" #include "router.h" #define _INSMULT_SOURCE_ #include "insmult.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define INSERT 0 #define REPLACE 1 #define DELETE_OP 2 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static INSTANCE_TYPE *CheckMultifieldSlotInstance(void *,const char *); static INSTANCE_SLOT *CheckMultifieldSlotModify(void *,int,const char *,INSTANCE_TYPE *, EXPRESSION *,long *,long *,DATA_OBJECT *); static void AssignSlotToDataObject(DATA_OBJECT *,INSTANCE_SLOT *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! RUN_TIME) /*************************************************** NAME : SetupInstanceMultifieldCommands DESCRIPTION : Defines function interfaces for manipulating instance multislots INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions defined to KB NOTES : None ***************************************************/ globle void SetupInstanceMultifieldCommands( void *theEnv) { /* =================================== Old version 5.1 compatibility names =================================== */ EnvDefineFunction2(theEnv,"direct-mv-replace",'b',PTIEF DirectMVReplaceCommand, "DirectMVReplaceCommand","4**wii"); EnvDefineFunction2(theEnv,"direct-mv-insert",'b',PTIEF DirectMVInsertCommand, "DirectMVInsertCommand","3**wi"); EnvDefineFunction2(theEnv,"direct-mv-delete",'b',PTIEF DirectMVDeleteCommand, "DirectMVDeleteCommand","33iw"); EnvDefineFunction2(theEnv,"mv-slot-replace",'u',PTIEF MVSlotReplaceCommand, "MVSlotReplaceCommand","5*uewii"); EnvDefineFunction2(theEnv,"mv-slot-insert",'u',PTIEF MVSlotInsertCommand, "MVSlotInsertCommand","4*uewi"); EnvDefineFunction2(theEnv,"mv-slot-delete",'u',PTIEF MVSlotDeleteCommand, "MVSlotDeleteCommand","44iew"); /* ===================== New version 6.0 names ===================== */ EnvDefineFunction2(theEnv,"slot-direct-replace$",'b',PTIEF DirectMVReplaceCommand, "DirectMVReplaceCommand","4**wii"); EnvDefineFunction2(theEnv,"slot-direct-insert$",'b',PTIEF DirectMVInsertCommand, "DirectMVInsertCommand","3**wi"); EnvDefineFunction2(theEnv,"slot-direct-delete$",'b',PTIEF DirectMVDeleteCommand, "DirectMVDeleteCommand","33iw"); EnvDefineFunction2(theEnv,"slot-replace$",'u',PTIEF MVSlotReplaceCommand, "MVSlotReplaceCommand","5*uewii"); EnvDefineFunction2(theEnv,"slot-insert$",'u',PTIEF MVSlotInsertCommand, "MVSlotInsertCommand","4*uewi"); EnvDefineFunction2(theEnv,"slot-delete$",'u',PTIEF MVSlotDeleteCommand, "MVSlotDeleteCommand","44iew"); } #endif /*********************************************************************************** NAME : MVSlotReplaceCommand DESCRIPTION : Allows user to replace a specified field of a multi-value slot The slot is directly read (w/o a get- message) and the new slot-value is placed via a put- message. This function is not valid for single-value slots. INPUTS : Caller's result buffer RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise SIDE EFFECTS : Put messsage sent for slot NOTES : H/L Syntax : (slot-replace$ ) ***********************************************************************************/ globle void MVSlotReplaceCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT newval,newseg,oldseg; INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; long rb,re; EXPRESSION arg; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ins = CheckMultifieldSlotInstance(theEnv,"slot-replace$"); if (ins == NULL) return; sp = CheckMultifieldSlotModify(theEnv,REPLACE,"slot-replace$",ins, GetFirstArgument()->nextArg,&rb,&re,&newval); if (sp == NULL) return; AssignSlotToDataObject(&oldseg,sp); if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"slot-replace$") == FALSE) return; arg.type = MULTIFIELD; arg.value = (void *) &newseg; arg.nextArg = NULL; arg.argList = NULL; DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg); } /*********************************************************************************** NAME : MVSlotInsertCommand DESCRIPTION : Allows user to insert a specified field of a multi-value slot The slot is directly read (w/o a get- message) and the new slot-value is placed via a put- message. This function is not valid for single-value slots. INPUTS : Caller's result buffer RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise SIDE EFFECTS : Put messsage sent for slot NOTES : H/L Syntax : (slot-insert$ ) ***********************************************************************************/ globle void MVSlotInsertCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT newval,newseg,oldseg; INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; long theIndex; EXPRESSION arg; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ins = CheckMultifieldSlotInstance(theEnv,"slot-insert$"); if (ins == NULL) return; sp = CheckMultifieldSlotModify(theEnv,INSERT,"slot-insert$",ins, GetFirstArgument()->nextArg,&theIndex,NULL,&newval); if (sp == NULL) return; AssignSlotToDataObject(&oldseg,sp); if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"slot-insert$") == FALSE) return; arg.type = MULTIFIELD; arg.value = (void *) &newseg; arg.nextArg = NULL; arg.argList = NULL; DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg); } /*********************************************************************************** NAME : MVSlotDeleteCommand DESCRIPTION : Allows user to delete a specified field of a multi-value slot The slot is directly read (w/o a get- message) and the new slot-value is placed via a put- message. This function is not valid for single-value slots. INPUTS : Caller's result buffer RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise SIDE EFFECTS : Put message sent for slot NOTES : H/L Syntax : (slot-delete$ ) ***********************************************************************************/ globle void MVSlotDeleteCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT newseg,oldseg; INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; long rb,re; EXPRESSION arg; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ins = CheckMultifieldSlotInstance(theEnv,"slot-delete$"); if (ins == NULL) return; sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"slot-delete$",ins, GetFirstArgument()->nextArg,&rb,&re,NULL); if (sp == NULL) return; AssignSlotToDataObject(&oldseg,sp); if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"slot-delete$") == FALSE) return; arg.type = MULTIFIELD; arg.value = (void *) &newseg; arg.nextArg = NULL; arg.argList = NULL; DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg); } /***************************************************************** NAME : DirectMVReplaceCommand DESCRIPTION : Directly replaces a slot's value INPUTS : None RETURNS : TRUE if put OK, FALSE otherwise SIDE EFFECTS : Slot modified NOTES : H/L Syntax: (direct-slot-replace$ ) *****************************************************************/ globle intBool DirectMVReplaceCommand( void *theEnv) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; long rb,re; DATA_OBJECT newval,newseg,oldseg; if (CheckCurrentMessage(theEnv,"direct-slot-replace$",TRUE) == FALSE) return(FALSE); ins = GetActiveInstance(theEnv); sp = CheckMultifieldSlotModify(theEnv,REPLACE,"direct-slot-replace$",ins, GetFirstArgument(),&rb,&re,&newval); if (sp == NULL) return(FALSE); AssignSlotToDataObject(&oldseg,sp); if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"direct-slot-replace$") == FALSE) return(FALSE); if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-replace$")) return(TRUE); return(FALSE); } /************************************************************************ NAME : DirectMVInsertCommand DESCRIPTION : Directly inserts a slot's value INPUTS : None RETURNS : TRUE if put OK, FALSE otherwise SIDE EFFECTS : Slot modified NOTES : H/L Syntax: (direct-slot-insert$ ) ************************************************************************/ globle intBool DirectMVInsertCommand( void *theEnv) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; long theIndex; DATA_OBJECT newval,newseg,oldseg; if (CheckCurrentMessage(theEnv,"direct-slot-insert$",TRUE) == FALSE) return(FALSE); ins = GetActiveInstance(theEnv); sp = CheckMultifieldSlotModify(theEnv,INSERT,"direct-slot-insert$",ins, GetFirstArgument(),&theIndex,NULL,&newval); if (sp == NULL) return(FALSE); AssignSlotToDataObject(&oldseg,sp); if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"direct-slot-insert$") == FALSE) return(FALSE); if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-insert$")) return(TRUE); return(FALSE); } /***************************************************************** NAME : DirectMVDeleteCommand DESCRIPTION : Directly deletes a slot's value INPUTS : None RETURNS : TRUE if put OK, FALSE otherwise SIDE EFFECTS : Slot modified NOTES : H/L Syntax: (direct-slot-delete$ ) *****************************************************************/ globle intBool DirectMVDeleteCommand( void *theEnv) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; long rb,re; DATA_OBJECT newseg,oldseg; if (CheckCurrentMessage(theEnv,"direct-slot-delete$",TRUE) == FALSE) return(FALSE); ins = GetActiveInstance(theEnv); sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"direct-slot-delete$",ins, GetFirstArgument(),&rb,&re,NULL); if (sp == NULL) return(FALSE); AssignSlotToDataObject(&oldseg,sp); if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"direct-slot-delete$") == FALSE) return(FALSE); if (PutSlotValue(theEnv,ins,sp,&newseg,&oldseg,"function direct-slot-delete$")) return(TRUE); return(FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************************** NAME : CheckMultifieldSlotInstance DESCRIPTION : Gets the instance for the functions slot-replace$, insert and delete INPUTS : The function name RETURNS : The instance address, NULL on errors SIDE EFFECTS : None NOTES : None **********************************************************************/ static INSTANCE_TYPE *CheckMultifieldSlotInstance( void *theEnv, const char *func) { INSTANCE_TYPE *ins; DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE) { SetEvaluationError(theEnv,TRUE); return(NULL); } if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return(NULL); } } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) NoInstanceError(theEnv,ValueToString(temp.value),func); } return(ins); } /********************************************************************* NAME : CheckMultifieldSlotModify DESCRIPTION : For the functions slot-replace$, insert, & delete as well as direct-slot-replace$, insert, & delete this function gets the slot, index, and optional field-value for these functions INPUTS : 1) A code indicating the type of operation INSERT (0) : Requires one index REPLACE (1) : Requires two indices DELETE_OP (2) : Requires two indices 2) Function name-string 3) Instance address 4) Argument expression chain 5) Caller's buffer for index (or beginning of range) 6) Caller's buffer for end of range (can be NULL for INSERT) 7) Caller's new-field value buffer (can be NULL for DELETE_OP) RETURNS : The address of the instance-slot, NULL on errors SIDE EFFECTS : Caller's index buffer set Caller's new-field value buffer set (if not NULL) Will allocate an ephemeral segment to store more than 1 new field value EvaluationError set on errors NOTES : Assume the argument chain is at least 2 expressions deep - slot, index, and optional values *********************************************************************/ static INSTANCE_SLOT *CheckMultifieldSlotModify( void *theEnv, int code, const char *func, INSTANCE_TYPE *ins, EXPRESSION *args, long *rb, long *re, DATA_OBJECT *newval) { DATA_OBJECT temp; INSTANCE_SLOT *sp; int start; start = (args == GetFirstArgument()) ? 1 : 2; EvaluationData(theEnv)->EvaluationError = FALSE; EvaluateExpression(theEnv,args,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,func,start,"symbol"); SetEvaluationError(theEnv,TRUE); return(NULL); } sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),func); return(NULL); } if (sp->desc->multiple == 0) { PrintErrorID(theEnv,"INSMULT",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } EvaluateExpression(theEnv,args->nextArg,&temp); if (temp.type != INTEGER) { ExpectedTypeError1(theEnv,func,start+1,"integer"); SetEvaluationError(theEnv,TRUE); return(NULL); } args = args->nextArg->nextArg; *rb = (long) ValueToLong(temp.value); if ((code == REPLACE) || (code == DELETE_OP)) { EvaluateExpression(theEnv,args,&temp); if (temp.type != INTEGER) { ExpectedTypeError1(theEnv,func,start+2,"integer"); SetEvaluationError(theEnv,TRUE); return(NULL); } *re = (long) ValueToLong(temp.value); args = args->nextArg; } if ((code == INSERT) || (code == REPLACE)) { if (EvaluateAndStoreInDataObject(theEnv,1,args,newval,TRUE) == FALSE) return(NULL); } return(sp); } /*************************************************** NAME : AssignSlotToDataObject DESCRIPTION : Assigns the value of a multifield slot to a data object INPUTS : 1) The data object buffer 2) The instance slot RETURNS : Nothing useful SIDE EFFECTS : Data object fields set NOTES : Assumes slot is a multislot ***************************************************/ static void AssignSlotToDataObject( DATA_OBJECT *theDataObject, INSTANCE_SLOT *theSlot) { theDataObject->type = (unsigned short) theSlot->type; theDataObject->value = theSlot->value; theDataObject->begin = 0; SetpDOEnd(theDataObject,GetInstanceSlotLength(theSlot)); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips_core_source_630/core/._retract.c0000755000175000017500000000040712500146515016256 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtbld.h0000755000175000017500000000040712374023174016425 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._userdata.h0000755000175000017500000000040712373740572016442 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/prcdrpsr.h0000755000175000017500000000655112373743657016271 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PROCEDURAL FUNCTIONS PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Local variables set with the bind function */ /* persist until a reset/clear command is issued. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #ifndef _H_prcdrpsr #define _H_prcdrpsr #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _PRCDRPSR_SOURCE #define LOCALE #else #define LOCALE extern #endif struct BindInfo { struct symbolHashNode *name; CONSTRAINT_RECORD *constraints; struct BindInfo *next; }; #if (! RUN_TIME) LOCALE void ProceduralFunctionParsers(void *); LOCALE struct BindInfo *GetParsedBindNames(void *); LOCALE void SetParsedBindNames(void *,struct BindInfo *); LOCALE void ClearParsedBindNames(void *); LOCALE intBool ParsedBindNamesEmpty(void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int SearchParsedBindNames(void *,struct symbolHashNode *); LOCALE int CountParsedBindNames(void *); LOCALE void RemoveParsedBindName(void *,struct symbolHashNode *); LOCALE struct constraintRecord *FindBindConstraints(void *,struct symbolHashNode *); #endif #endif /* _H_prcdrpsr */ clips_core_source_630/core/._cstrcbin.c0000755000175000017500000000040712373714232016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objrtgen.c0000755000175000017500000006452612374023163016225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INFERENCE ENGINE OBJECT PARSING ROUTINES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: RETE Network Parsing Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed memories and other */ /* join network changes. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && (! BLOAD_ONLY) #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #include "classfun.h" #include "envrnmnt.h" #include "objrtfnx.h" #define _OBJRTGEN_SOURCE_ #include "objrtgen.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void GenObjectGetVar(void *,int,EXPRESSION *,struct lhsParseNode *,int); static intBool IsSimpleSlotVariable(struct lhsParseNode *); static EXPRESSION *GenerateSlotComparisonTest(void *,int,int,struct lhsParseNode *,struct lhsParseNode *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************** Build functions used by AddPatternParser() to provide object access to the join nertwork **********************************************/ globle void ReplaceGetJNObjectValue( void *theEnv, EXPRESSION *theItem, struct lhsParseNode *theNode, int side) { GenObjectGetVar(theEnv,TRUE,theItem,theNode,side); } globle EXPRESSION *GenGetJNObjectValue( void *theEnv, struct lhsParseNode *theNode, int side) { EXPRESSION *theItem; theItem = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,TRUE,theItem,theNode,side); return(theItem); } globle EXPRESSION *ObjectJNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode, int isNand) { return(GenerateSlotComparisonTest(theEnv,TRUE,isNand,selfNode,referringNode)); } /********************************************** Build functions used by AddPatternParser() to provide object access to the pattern network **********************************************/ globle EXPRESSION *GenObjectPNConstantCompare( void *theEnv, struct lhsParseNode *theNode) { struct ObjectCmpPNConstant hack; EXPRESSION *theExp; unsigned short tmpType; /* =============================================================== If the value of a single field slot (or relation name) is being compared against a constant, then use specialized routines for doing the comparison. If a constant comparison is being done within a multifield slot and the constant's position has no multifields to the left or no multifields to the right, then use the same routine used for the single field slot case, but include the offset from either the beginning or end of the slot. Otherwise, use a general eq/neq test. =============================================================== */ ClearBitString((void *) &hack,(int) sizeof(struct ObjectCmpPNConstant)); if (theNode->negated) hack.fail = 1; else hack.pass = 1; if (((theNode->withinMultifieldSlot == FALSE) || (theNode->multiFieldsAfter == 0) || (theNode->multiFieldsBefore == 0)) && (theNode->slotNumber != ISA_ID) && (theNode->slotNumber != NAME_ID)) { if (theNode->withinMultifieldSlot == FALSE) hack.fromBeginning = TRUE; else if (theNode->multiFieldsBefore == 0) { hack.fromBeginning = TRUE; hack.offset = theNode->singleFieldsBefore; } else hack.offset = theNode->singleFieldsAfter; theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,EnvAddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectCmpPNConstant))); theExp->argList = GenConstant(theEnv,theNode->type,theNode->value); } else { hack.general = 1; theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,EnvAddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectCmpPNConstant))); theExp->argList = GenConstant(theEnv,0,NULL); tmpType = theNode->type; theNode->type = SF_VARIABLE; GenObjectGetVar(theEnv,FALSE,theExp->argList,theNode,-1); theNode->type = tmpType; theExp->argList->nextArg = GenConstant(theEnv,theNode->type,theNode->value); } return(theExp); } globle void ReplaceGetPNObjectValue( void *theEnv, EXPRESSION *theItem, struct lhsParseNode *theNode) { GenObjectGetVar(theEnv,FALSE,theItem,theNode,-1); } globle EXPRESSION *GenGetPNObjectValue( void *theEnv, struct lhsParseNode *theNode) { EXPRESSION *theItem; theItem = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,FALSE,theItem,theNode,-1); return(theItem); } globle EXPRESSION *ObjectPNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { return(GenerateSlotComparisonTest(theEnv,FALSE,FALSE,selfNode,referringNode)); } /**************************************************** NAME : GenObjectLengthTest DESCRIPTION : Generates a test on the cardinality of a slot matching an object pattern INPUTS : The first lhsParseNode for a slot in an object pattern RETURNS : Nothing useful SIDE EFFECTS : The lhsParseNode network test is modified to include the length test NOTES : None ****************************************************/ globle void GenObjectLengthTest( void *theEnv, struct lhsParseNode *theNode) { struct ObjectMatchLength hack; EXPRESSION *theTest; if ((theNode->singleFieldsAfter == 0) && (theNode->type != SF_VARIABLE) && (theNode->type != SF_WILDCARD)) return; ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength)); if ((theNode->type != MF_VARIABLE) && (theNode->type != MF_WILDCARD) && (theNode->multiFieldsAfter == 0)) hack.exactly = 1; else hack.exactly = 0; if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD)) hack.minLength = 1 + theNode->singleFieldsAfter; else hack.minLength = theNode->singleFieldsAfter; theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,EnvAddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectMatchLength))); if (theNode->constantSelector != NULL) { theNode->constantSelector->nextArg = CopyExpression(theEnv,theTest); } theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest); } /**************************************************** NAME : GenObjectZeroLengthTest DESCRIPTION : Generates a test on the cardinality of a slot matching an object pattern INPUTS : The first lhsParseNode for a slot in an object pattern RETURNS : Nothing useful SIDE EFFECTS : The lhsParseNode network test is modified to include the length test NOTES : None ****************************************************/ globle void GenObjectZeroLengthTest( void *theEnv, struct lhsParseNode *theNode) { struct ObjectMatchLength hack; EXPRESSION *theTest; ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength)); hack.exactly = 1; hack.minLength = 0; theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,EnvAddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectMatchLength))); theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : GenObjectGetVar DESCRIPTION : Generates the expressions necessary to access object pattern variables INPUTS : 1) An integer code indicating if this is a join network reference or a pattern network reference 2) The expression for which to set the type and value 3) The lhsParseNode for the variable reference 4) For a join reference, the side from which the variable must be retrieved. RETURNS : Nothing useful SIDE EFFECTS : The value is a packed long holding pattern index, slot number, field index, etc. NOTES : None ***************************************************/ static void GenObjectGetVar( void *theEnv, int joinReference, EXPRESSION *theItem, struct lhsParseNode *theNode, int side) { struct ObjectMatchVar1 hack1; struct ObjectMatchVar2 hack2; ClearBitString((void *) &hack1,(int) sizeof(struct ObjectMatchVar1)); ClearBitString((void *) &hack2,(int) sizeof(struct ObjectMatchVar2)); if (joinReference) { if (side == LHS) { hack1.lhs = 1; hack2.lhs = 1; hack1.whichPattern = (unsigned short) theNode->joinDepth; hack2.whichPattern = (unsigned short) theNode->joinDepth; } else if (side == RHS) { hack1.rhs = 1; hack2.rhs = 1; hack1.whichPattern = (unsigned short) 0; hack2.whichPattern = (unsigned short) 0; } else if (side == NESTED_RHS) { hack1.rhs = 1; hack2.rhs = 1; hack1.whichPattern = (unsigned short) theNode->joinDepth; hack2.whichPattern = (unsigned short) theNode->joinDepth; } else { hack1.whichPattern = (unsigned short) theNode->joinDepth; hack2.whichPattern = (unsigned short) theNode->joinDepth; } } /* ======================== Access an object address ======================== */ if (theNode->slotNumber < 0) { hack1.objectAddress = 1; SetpType(theItem,(joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1)); theItem->value = EnvAddBitMap(theEnv,(void *) &hack1,(int) sizeof(struct ObjectMatchVar1)); return; } /* ====================================== Access the entire contents of the slot ====================================== */ if ((theNode->singleFieldsBefore == 0) && (theNode->singleFieldsAfter == 0) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0) && ((theNode->withinMultifieldSlot == FALSE) || (theNode->type == MF_VARIABLE) || (theNode->type == MF_WILDCARD))) { hack1.allFields = 1; hack1.whichSlot = (unsigned short) theNode->slotNumber; theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1); theItem->value = EnvAddBitMap(theEnv,(void *) &hack1,(int) sizeof(struct ObjectMatchVar1)); return; } /* ============================================================= Access a particular field(s) in a multifield slot pattern containing at most one multifield variable and at least one (or two if no multifield variables) single-field variable ============================================================= */ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE) || ConstantType(theNode->type)) && ((theNode->multiFieldsBefore == 0) || (theNode->multiFieldsAfter == 0))) { hack2.whichSlot = (unsigned short) theNode->slotNumber; if (theNode->multiFieldsBefore == 0) { hack2.fromBeginning = 1; hack2.beginningOffset = theNode->singleFieldsBefore; } else { hack2.fromEnd = 1; hack2.endOffset = theNode->singleFieldsAfter; } theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR2 : OBJ_GET_SLOT_PNVAR2); theItem->value = EnvAddBitMap(theEnv,(void *) &hack2,sizeof(struct ObjectMatchVar2)); return; } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE) || ConstantType(theNode->type)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { hack2.whichSlot = (unsigned short) theNode->slotNumber; hack2.fromBeginning = 1; hack2.fromEnd = 1; hack2.beginningOffset = theNode->singleFieldsBefore; hack2.endOffset = theNode->singleFieldsAfter; theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR2 : OBJ_GET_SLOT_PNVAR2); theItem->value = EnvAddBitMap(theEnv,(void *) &hack2,sizeof(struct ObjectMatchVar2)); return; } /* ================================================== General slot field access using multifield markers ================================================== */ hack1.whichSlot = (unsigned short) theNode->slotNumber; hack1.whichField = (unsigned short) theNode->index; theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1); theItem->value = EnvAddBitMap(theEnv,(void *) &hack1,sizeof(struct ObjectMatchVar1)); } /**************************************************************** NAME : IsSimpleSlotVariable DESCRIPTION : Determines if a slot pattern variable references a single-field slot or a single-field in a multifield slot which does not require use of multifield markers (Object addresses are not simple variables) INPUTS : The intermediate parse node RETURNS : TRUE if the variable is simple, FALSE otherwise SIDE EFFECTS : None NOTES : None ****************************************************************/ static intBool IsSimpleSlotVariable( struct lhsParseNode *node) { if ((node->type == MF_WILDCARD) || (node->type == MF_VARIABLE)) return(FALSE); if ((node->slotNumber < 0) || (node->slotNumber == ISA_ID) || (node->slotNumber == NAME_ID)) return(FALSE); if (node->withinMultifieldSlot == FALSE) return(TRUE); if (node->multifieldSlot == TRUE) return(FALSE); if ((node->multiFieldsBefore == 0) || (node->multiFieldsAfter == 0)) return(TRUE); return(FALSE); } /*************************************************************** NAME : GenerateSlotComparisonTest DESCRIPTION : Generates pattern and join network expressions for comparing object pattern variables INPUTS : 1) A flag indicating if this is a pattern or join network test 2) For a join test, a flag indicating if it is a nand join 3) The intermediate parse node for the first variable 4) The intermediate parse node for the second variable RETURNS : An expression for comparing the variables SIDE EFFECTS : Expression and bitmaps generated NOTES : The following tests are generated for the following scenarios: SF slot w/ SF slot: PN_1 or JN_1 Example: (foo ?x) with (bar ?xy) SF slot w/ SF reference in MF slot: PN_2 or JN_2 Example: (foo ?x) (bar ? ?x ? ?) SF reference w/ SF reference: PN_3 or JN_3 Example: (foo ? ?x ?) and (bar ? ? ? ?x) All other cases: EQ/NEQ general test Example: (foo $? ?x $?) and (bar ?x) ***************************************************************/ static EXPRESSION *GenerateSlotComparisonTest( void *theEnv, int joinTest, int isNand, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { EXPRESSION *theExp; struct ObjectCmpPNSingleSlotVars1 phack1; struct ObjectCmpPNSingleSlotVars2 phack2; struct ObjectCmpPNSingleSlotVars3 phack3; struct ObjectCmpJoinSingleSlotVars1 jhack1; struct ObjectCmpJoinSingleSlotVars2 jhack2; struct ObjectCmpJoinSingleSlotVars3 jhack3; struct lhsParseNode *firstNode; if (isNand) { firstNode = referringNode; } else { firstNode = selfNode; } /* ========================================================= If we are comparing two single-field slot variables that don't require multifield markers for lookup, use a quick comparison. Otherwise, use a general eq/neq with the pattern variable access routines ========================================================= */ if (IsSimpleSlotVariable(firstNode) && IsSimpleSlotVariable(referringNode)) { /* ============================== Compare two single-field slots ============================== */ if ((firstNode->withinMultifieldSlot == FALSE) && (referringNode->withinMultifieldSlot == FALSE)) { ClearBitString((void *) &phack1,(int) sizeof(struct ObjectCmpPNSingleSlotVars1)); ClearBitString((void *) &jhack1,(int) sizeof(struct ObjectCmpJoinSingleSlotVars1)); if (selfNode->negated) phack1.fail = jhack1.fail = 1; else phack1.pass = jhack1.pass = 1; phack1.firstSlot = jhack1.firstSlot = (unsigned short) firstNode->slotNumber; phack1.secondSlot = jhack1.secondSlot = (unsigned short) referringNode->slotNumber; if (joinTest) { if (isNand) { jhack1.firstPattern = (unsigned short) referringNode->joinDepth; } else { jhack1.firstPattern = 0; } jhack1.firstPatternRHS = TRUE; jhack1.secondPatternLHS = TRUE; jhack1.secondPattern = (unsigned short) referringNode->joinDepth; theExp = GenConstant(theEnv,OBJ_JN_CMP1,EnvAddBitMap(theEnv,(void *) &jhack1, (int) sizeof(struct ObjectCmpJoinSingleSlotVars1))); } else theExp = GenConstant(theEnv,OBJ_PN_CMP1,EnvAddBitMap(theEnv,(void *) &phack1, (int) sizeof(struct ObjectCmpPNSingleSlotVars1))); } /* ============================================ Compare a single-field slot with a single-field in a multifield slot (make sure the multifield slot reference is first ============================================ */ else if ((firstNode->withinMultifieldSlot == FALSE) || (referringNode->withinMultifieldSlot == FALSE)) { ClearBitString((void *) &phack2,(int) sizeof(struct ObjectCmpPNSingleSlotVars2)); ClearBitString((void *) &jhack2,(int) sizeof(struct ObjectCmpJoinSingleSlotVars2)); if (selfNode->negated) phack2.fail = jhack2.fail = 1; else phack2.pass = jhack2.pass = 1; if (firstNode->withinMultifieldSlot == TRUE) { phack2.firstSlot = jhack2.firstSlot = (unsigned short) firstNode->slotNumber; phack2.secondSlot = jhack2.secondSlot = (unsigned short) referringNode->slotNumber; if (joinTest) { if (isNand) { jhack2.firstPattern = (unsigned short) referringNode->joinDepth; } else { jhack2.firstPattern = 0; } jhack2.firstPatternRHS = TRUE; jhack2.secondPatternLHS = TRUE; jhack2.secondPattern = (unsigned short) referringNode->joinDepth; } if (firstNode->multiFieldsBefore == 0) { phack2.fromBeginning = jhack2.fromBeginning = 1; phack2.offset = jhack2.offset = firstNode->singleFieldsBefore; } else phack2.offset = jhack2.offset = firstNode->singleFieldsAfter; } else { phack2.firstSlot = jhack2.firstSlot = (unsigned short) referringNode->slotNumber; phack2.secondSlot = jhack2.secondSlot = (unsigned short) firstNode->slotNumber; if (joinTest) { if (isNand) { jhack2.secondPattern = (unsigned short) firstNode->joinDepth; } else { jhack2.secondPattern = 0; } jhack2.secondPatternRHS = TRUE; jhack2.firstPatternLHS = TRUE; jhack2.firstPattern = (unsigned short) referringNode->joinDepth; } if (referringNode->multiFieldsBefore == 0) { phack2.fromBeginning = jhack2.fromBeginning = 1; phack2.offset = jhack2.offset = referringNode->singleFieldsBefore; } else phack2.offset = jhack2.offset = referringNode->singleFieldsAfter; } if (joinTest) theExp = GenConstant(theEnv,OBJ_JN_CMP2,EnvAddBitMap(theEnv,(void *) &jhack2, (int) sizeof(struct ObjectCmpJoinSingleSlotVars2))); else theExp = GenConstant(theEnv,OBJ_PN_CMP2,EnvAddBitMap(theEnv,(void *) &phack2, (int) sizeof(struct ObjectCmpPNSingleSlotVars2))); } /* =================================== Compare two single-field references within multifield slots =================================== */ else { ClearBitString((void *) &phack3,(int) sizeof(struct ObjectCmpPNSingleSlotVars3)); ClearBitString((void *) &jhack3,(int) sizeof(struct ObjectCmpJoinSingleSlotVars3)); if (selfNode->negated) phack3.fail = jhack3.fail = 1; else phack3.pass = jhack3.pass = 1; phack3.firstSlot = jhack3.firstSlot = (unsigned short) firstNode->slotNumber; phack3.secondSlot = jhack3.secondSlot = (unsigned short) referringNode->slotNumber; if (firstNode->multiFieldsBefore == 0) { phack3.firstFromBeginning = jhack3.firstFromBeginning = 1; phack3.firstOffset = jhack3.firstOffset = firstNode->singleFieldsBefore; } else phack3.firstOffset = jhack3.firstOffset = firstNode->singleFieldsAfter; if (referringNode->multiFieldsBefore == 0) { phack3.secondFromBeginning = jhack3.secondFromBeginning = 1; phack3.secondOffset = jhack3.secondOffset = referringNode->singleFieldsBefore; } else phack3.secondOffset = jhack3.secondOffset = referringNode->singleFieldsAfter; if (joinTest) { if (isNand) { jhack3.firstPattern = (unsigned short) referringNode->joinDepth; } else { jhack3.firstPattern = 0; } jhack3.firstPatternRHS = TRUE; jhack3.secondPatternLHS = TRUE; jhack3.secondPattern = (unsigned short) referringNode->joinDepth; theExp = GenConstant(theEnv,OBJ_JN_CMP3,EnvAddBitMap(theEnv,(void *) &jhack3, (int) sizeof(struct ObjectCmpJoinSingleSlotVars3))); } else theExp = GenConstant(theEnv,OBJ_PN_CMP3,EnvAddBitMap(theEnv,(void *) &phack3, (int) sizeof(struct ObjectCmpPNSingleSlotVars3))); } } /* ================================================== General comparison for multifield slot references, references which require multifield markers, and object addresses ================================================== */ else { theExp = GenConstant(theEnv,FCALL,selfNode->negated ? ExpressionData(theEnv)->PTR_NEQ : ExpressionData(theEnv)->PTR_EQ); theExp->argList = GenConstant(theEnv,0,NULL); if (isNand) { GenObjectGetVar(theEnv,joinTest,theExp->argList,selfNode,NESTED_RHS); } else { GenObjectGetVar(theEnv,joinTest,theExp->argList,selfNode,RHS); } theExp->argList->nextArg = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,joinTest,theExp->argList->nextArg,referringNode,LHS); } return(theExp); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips_core_source_630/core/genrcpsr.h0000755000175000017500000000742012373753377016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* If the last construct in a loaded file is a */ /* deffunction or defmethod with no closing right */ /* parenthesis, an error should be issued, but is */ /* not. DR0872 */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_AND_SAVE */ /* compiler flag is set to 0. */ /* */ /* Fixed typing issue when OBJECT_SYSTEM */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #ifndef _H_genrcpsr #define _H_genrcpsr #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #include "genrcfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ParseDefgeneric(void *,const char *); LOCALE intBool ParseDefmethod(void *,const char *); LOCALE DEFMETHOD *AddMethod(void *,DEFGENERIC *,DEFMETHOD *,int,short,EXPRESSION *, int,int,SYMBOL_HN *,EXPRESSION *,char *,int); LOCALE void PackRestrictionTypes(void *,RESTRICTION *,EXPRESSION *); LOCALE void DeleteTempRestricts(void *,EXPRESSION *); LOCALE DEFMETHOD *FindMethodByRestrictions(DEFGENERIC *,EXPRESSION *,int, SYMBOL_HN *,int *); #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ #endif /* _H_genrcpsr */ clips_core_source_630/core/emathfun.c0000755000175000017500000007012012373740017016210 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXTENDED MATH FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for numerous extended math */ /* functions including cos, sin, tan, sec, csc, cot, acos, */ /* asin, atan, asec, acsc, acot, cosh, sinh, tanh, sech, */ /* csch, coth, acosh, asinh, atanh, asech, acsch, acoth, */ /* mod, exp, log, log10, sqrt, pi, deg-rad, rad-deg, */ /* deg-grad, grad-deg, **, and round. */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Support for long long integers. */ /* */ /* Renamed EX_MATH compiler flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "extnfunc.h" #include "router.h" #include "emathfun.h" #if EXTENDED_MATH_FUNCTIONS #include /***************/ /* DEFINITIONS */ /***************/ #ifndef PI #define PI 3.14159265358979323846 #endif #ifndef PID2 #define PID2 1.57079632679489661923 /* PI divided by 2 */ #endif #define SMALLEST_ALLOWED_NUMBER 1e-15 #define dtrunc(x) (((x) < 0.0) ? ceil(x) : floor(x)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int SingleNumberCheck(void *,const char *,double *); static int TestProximity(double,double); static void DomainErrorMessage(void *,const char *); static void ArgumentOverflowErrorMessage(void *,const char *); static void SingularityErrorMessage(void *,const char *); static double genacosh(double); static double genasinh(double); static double genatanh(double); static double genasech(double); static double genacsch(double); static double genacoth(double); /************************************************/ /* ExtendedMathFunctionDefinitions: Initializes */ /* the extended math functions. */ /************************************************/ globle void ExtendedMathFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"cos", 'd', PTIEF CosFunction, "CosFunction", "11n"); EnvDefineFunction2(theEnv,"sin", 'd', PTIEF SinFunction, "SinFunction", "11n"); EnvDefineFunction2(theEnv,"tan", 'd', PTIEF TanFunction, "TanFunction", "11n"); EnvDefineFunction2(theEnv,"sec", 'd', PTIEF SecFunction, "SecFunction", "11n"); EnvDefineFunction2(theEnv,"csc", 'd', PTIEF CscFunction, "CscFunction", "11n"); EnvDefineFunction2(theEnv,"cot", 'd', PTIEF CotFunction, "CotFunction", "11n"); EnvDefineFunction2(theEnv,"acos", 'd', PTIEF AcosFunction, "AcosFunction", "11n"); EnvDefineFunction2(theEnv,"asin", 'd', PTIEF AsinFunction, "AsinFunction", "11n"); EnvDefineFunction2(theEnv,"atan", 'd', PTIEF AtanFunction, "AtanFunction", "11n"); EnvDefineFunction2(theEnv,"asec", 'd', PTIEF AsecFunction, "AsecFunction", "11n"); EnvDefineFunction2(theEnv,"acsc", 'd', PTIEF AcscFunction, "AcscFunction", "11n"); EnvDefineFunction2(theEnv,"acot", 'd', PTIEF AcotFunction, "AcotFunction", "11n"); EnvDefineFunction2(theEnv,"cosh", 'd', PTIEF CoshFunction, "CoshFunction", "11n"); EnvDefineFunction2(theEnv,"sinh", 'd', PTIEF SinhFunction, "SinhFunction", "11n"); EnvDefineFunction2(theEnv,"tanh", 'd', PTIEF TanhFunction, "TanhFunction", "11n"); EnvDefineFunction2(theEnv,"sech", 'd', PTIEF SechFunction, "SechFunction", "11n"); EnvDefineFunction2(theEnv,"csch", 'd', PTIEF CschFunction, "CschFunction", "11n"); EnvDefineFunction2(theEnv,"coth", 'd', PTIEF CothFunction, "CothFunction", "11n"); EnvDefineFunction2(theEnv,"acosh", 'd', PTIEF AcoshFunction, "AcoshFunction", "11n"); EnvDefineFunction2(theEnv,"asinh", 'd', PTIEF AsinhFunction, "AsinhFunction", "11n"); EnvDefineFunction2(theEnv,"atanh", 'd', PTIEF AtanhFunction, "AtanhFunction", "11n"); EnvDefineFunction2(theEnv,"asech", 'd', PTIEF AsechFunction, "AsechFunction", "11n"); EnvDefineFunction2(theEnv,"acsch", 'd', PTIEF AcschFunction, "AcschFunction", "11n"); EnvDefineFunction2(theEnv,"acoth", 'd', PTIEF AcothFunction, "AcothFunction", "11n"); EnvDefineFunction2(theEnv,"mod", 'n', PTIEF ModFunction, "ModFunction", "22n"); EnvDefineFunction2(theEnv,"exp", 'd', PTIEF ExpFunction, "ExpFunction", "11n"); EnvDefineFunction2(theEnv,"log", 'd', PTIEF LogFunction, "LogFunction", "11n"); EnvDefineFunction2(theEnv,"log10", 'd', PTIEF Log10Function, "Log10Function", "11n"); EnvDefineFunction2(theEnv,"sqrt", 'd', PTIEF SqrtFunction, "SqrtFunction", "11n"); EnvDefineFunction2(theEnv,"pi", 'd', PTIEF PiFunction, "PiFunction", "00"); EnvDefineFunction2(theEnv,"deg-rad", 'd', PTIEF DegRadFunction, "DegRadFunction", "11n"); EnvDefineFunction2(theEnv,"rad-deg", 'd', PTIEF RadDegFunction, "RadDegFunction", "11n"); EnvDefineFunction2(theEnv,"deg-grad", 'd', PTIEF DegGradFunction, "DegGradFunction", "11n"); EnvDefineFunction2(theEnv,"grad-deg", 'd', PTIEF GradDegFunction, "GradDegFunction", "11n"); EnvDefineFunction2(theEnv,"**", 'd', PTIEF PowFunction, "PowFunction", "22n"); EnvDefineFunction2(theEnv,"round", 'g', PTIEF RoundFunction, "RoundFunction", "11n"); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /************************************************************/ /* SingleNumberCheck: Retrieves the numeric argument for */ /* extended math functions which expect a single floating */ /* point argument. */ /************************************************************/ static int SingleNumberCheck( void *theEnv, const char *functionName, double *theNumber) { DATA_OBJECT theValue; if (EnvArgCountCheck(theEnv,functionName,EXACTLY,1) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,functionName,1,FLOAT,&theValue) == FALSE) return(FALSE); *theNumber = DOToDouble(theValue); return(TRUE); } /**************************************************************/ /* TestProximity: Returns TRUE if the specified number falls */ /* within the specified range, otherwise FALSE is returned. */ /**************************************************************/ static int TestProximity( double theNumber, double range) { if ((theNumber >= (- range)) && (theNumber <= range)) return TRUE; else return FALSE; } /********************************************************/ /* DomainErrorMessage: Generic error message used when */ /* a domain error is detected during a call to one of */ /* the extended math functions. */ /********************************************************/ static void DomainErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Domain error for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); } /************************************************************/ /* ArgumentOverflowErrorMessage: Generic error message used */ /* when an argument overflow is detected during a call to */ /* one of the extended math functions. */ /************************************************************/ static void ArgumentOverflowErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Argument overflow for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); } /************************************************************/ /* SingularityErrorMessage: Generic error message used when */ /* a singularity is detected during a call to one of the */ /* extended math functions. */ /************************************************************/ static void SingularityErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Singularity at asymptote in "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); } /*************************************/ /* CosFunction: H/L access routine */ /* for the cos function. */ /*************************************/ globle double CosFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"cos",&num) == FALSE) return(0.0); return(cos(num)); } /*************************************/ /* SinFunction: H/L access routine */ /* for the sin function. */ /*************************************/ globle double SinFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sin",&num) == FALSE) return(0.0); return(sin(num)); } /*************************************/ /* TanFunction: H/L access routine */ /* for the tan function. */ /*************************************/ globle double TanFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"tan",&num) == FALSE) return (0.0); tv = cos(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"tan"); return(0.0); } return(sin(num) / tv); } /*************************************/ /* SecFunction: H/L access routine */ /* for the sec function. */ /*************************************/ globle double SecFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"sec",&num) == FALSE) return(0.0); tv = cos(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"sec"); return(0.0); } return(1.0 / tv); } /*************************************/ /* CscFunction: H/L access routine */ /* for the csc function. */ /*************************************/ globle double CscFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"csc",&num) == FALSE) return(0.0); tv = sin(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"csc"); return(0.0); } return(1.0 / tv); } /*************************************/ /* CotFunction: H/L access routine */ /* for the cot function. */ /*************************************/ globle double CotFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"cot",&num) == FALSE) return(0.0); tv = sin(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"cot"); return(0.0); } return(cos(num) / tv); } /**************************************/ /* AcosFunction: H/L access routine */ /* for the acos function. */ /**************************************/ globle double AcosFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acos",&num) == FALSE) return(0.0); if ((num > 1.0) || (num < -1.0)) { DomainErrorMessage(theEnv,"acos"); return(0.0); } return(acos(num)); } /**************************************/ /* AsinFunction: H/L access routine */ /* for the asin function. */ /**************************************/ globle double AsinFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asin",&num) == FALSE) return(0.0); if ((num > 1.0) || (num < -1.0)) { DomainErrorMessage(theEnv,"asin"); return(0.0); } return(asin(num)); } /**************************************/ /* AtanFunction: H/L access routine */ /* for the atan function. */ /**************************************/ globle double AtanFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"atan",&num) == FALSE) return(0.0); return(atan(num)); } /**************************************/ /* AsecFunction: H/L access routine */ /* for the asec function. */ /**************************************/ globle double AsecFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asec",&num) == FALSE) return(0.0); if ((num < 1.0) && (num > -1.0)) { DomainErrorMessage(theEnv,"asec"); return(0.0); } num = 1.0 / num; return(acos(num)); } /**************************************/ /* AcscFunction: H/L access routine */ /* for the acsc function. */ /**************************************/ globle double AcscFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acsc",&num) == FALSE) return(0.0); if ((num < 1.0) && (num > -1.0)) { DomainErrorMessage(theEnv,"acsc"); return(0.0); } num = 1.0 / num; return(asin(num)); } /**************************************/ /* AcotFunction: H/L access routine */ /* for the acot function. */ /**************************************/ globle double AcotFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acot",&num) == FALSE) return(0.0); if (TestProximity(num,1e-25) == TRUE) return(PID2); num = 1.0 / num; return(atan(num)); } /**************************************/ /* CoshFunction: H/L access routine */ /* for the cosh function. */ /**************************************/ globle double CoshFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"cosh",&num) == FALSE) return(0.0); return(cosh(num)); } /**************************************/ /* SinhFunction: H/L access routine */ /* for the sinh function. */ /**************************************/ globle double SinhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sinh",&num) == FALSE) return(0.0); return(sinh(num)); } /**************************************/ /* TanhFunction: H/L access routine */ /* for the tanh function. */ /**************************************/ globle double TanhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"tanh",&num) == FALSE) return(0.0); return(tanh(num)); } /**************************************/ /* SechFunction: H/L access routine */ /* for the sech function. */ /**************************************/ globle double SechFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sech",&num) == FALSE) return(0.0); return(1.0 / cosh(num)); } /**************************************/ /* CschFunction: H/L access routine */ /* for the csch function. */ /**************************************/ globle double CschFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"csch",&num) == FALSE) return(0.0); if (num == 0.0) { SingularityErrorMessage(theEnv,"csch"); return(0.0); } else if (TestProximity(num,1e-25) == TRUE) { ArgumentOverflowErrorMessage(theEnv,"csch"); return(0.0); } return(1.0 / sinh(num)); } /**************************************/ /* CothFunction: H/L access routine */ /* for the coth function. */ /**************************************/ globle double CothFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"coth",&num) == FALSE) return(0.0); if (num == 0.0) { SingularityErrorMessage(theEnv,"coth"); return(0.0); } else if (TestProximity(num,1e-25) == TRUE) { ArgumentOverflowErrorMessage(theEnv,"coth"); return(0.0); } return(1.0 / tanh(num)); } /***************************************/ /* AcoshFunction: H/L access routine */ /* for the acosh function. */ /***************************************/ globle double AcoshFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acosh",&num) == FALSE) return(0.0); if (num < 1.0) { DomainErrorMessage(theEnv,"acosh"); return(0.0); } return(genacosh(num)); } /***************************************/ /* AsinhFunction: H/L access routine */ /* for the asinh function. */ /***************************************/ globle double AsinhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asinh",&num) == FALSE) return(0.0); return(genasinh(num)); } /***************************************/ /* AtanhFunction: H/L access routine */ /* for the atanh function. */ /***************************************/ globle double AtanhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"atanh",&num) == FALSE) return(0.0); if ((num >= 1.0) || (num <= -1.0)) { DomainErrorMessage(theEnv,"atanh"); return(0.0); } return(genatanh(num)); } /***************************************/ /* AsechFunction: H/L access routine */ /* for the asech function. */ /***************************************/ globle double AsechFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asech",&num) == FALSE) return(0.0); if ((num > 1.0) || (num <= 0.0)) { DomainErrorMessage(theEnv,"asech"); return(0.0); } return(genasech(num)); } /***************************************/ /* AcschFunction: H/L access routine */ /* for the acsch function. */ /***************************************/ globle double AcschFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acsch",&num) == FALSE) return(0.0); if (num == 0.0) { DomainErrorMessage(theEnv,"acsch"); return(0.0); } return(genacsch(num)); } /***************************************/ /* AcothFunction: H/L access routine */ /* for the acoth function. */ /***************************************/ globle double AcothFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acoth",&num) == FALSE) return(0.0); if ((num <= 1.0) && (num >= -1.0)) { DomainErrorMessage(theEnv,"acoth"); return(0.0); } return(genacoth(num)); } /*************************************/ /* ExpFunction: H/L access routine */ /* for the exp function. */ /*************************************/ globle double ExpFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"exp",&num) == FALSE) return(0.0); return(exp(num)); } /*************************************/ /* LogFunction: H/L access routine */ /* for the log function. */ /*************************************/ globle double LogFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"log",&num) == FALSE) return(0.0); if (num < 0.0) { DomainErrorMessage(theEnv,"log"); return(0.0); } else if (num == 0.0) { ArgumentOverflowErrorMessage(theEnv,"log"); return(0.0); } return(log(num)); } /***************************************/ /* Log10Function: H/L access routine */ /* for the log10 function. */ /***************************************/ globle double Log10Function( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"log10",&num) == FALSE) return(0.0); if (num < 0.0) { DomainErrorMessage(theEnv,"log10"); return(0.0); } else if (num == 0.0) { ArgumentOverflowErrorMessage(theEnv,"log10"); return(0.0); } return(log10(num)); } /**************************************/ /* SqrtFunction: H/L access routine */ /* for the sqrt function. */ /**************************************/ globle double SqrtFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sqrt",&num) == FALSE) return(0.0); if (num < 0.00000) { DomainErrorMessage(theEnv,"sqrt"); return(0.0); } return(sqrt(num)); } /*************************************/ /* PowFunction: H/L access routine */ /* for the pow function. */ /*************************************/ globle double PowFunction( void *theEnv) { DATA_OBJECT value1, value2; if (EnvArgCountCheck(theEnv,"**",EXACTLY,2) == -1) return(0.0); if (EnvArgTypeCheck(theEnv,"**",1,FLOAT,&value1) == FALSE) return(0.0); if (EnvArgTypeCheck(theEnv,"**",2,FLOAT,&value2) == FALSE) return(0.0); if (((DOToDouble(value1) == 0.0) && (DOToDouble(value2) <= 0.0)) || ((DOToDouble(value1) < 0.0) && (dtrunc((double) DOToDouble(value2)) != DOToDouble(value2)))) { DomainErrorMessage(theEnv,"**"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(0.0); } return (pow(DOToDouble(value1),DOToDouble(value2))); } /*************************************/ /* ModFunction: H/L access routine */ /* for the mod function. */ /*************************************/ globle void ModFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT item1, item2; double fnum1, fnum2; long long lnum1, lnum2; if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) || ((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE)) { DivideByZeroErrorMessage(theEnv,"mod"); SetEvaluationError(theEnv,TRUE); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if ((item1.type == FLOAT) || (item2.type == FLOAT)) { fnum1 = CoerceToDouble(item1.type,item1.value); fnum2 = CoerceToDouble(item2.type,item2.value); result->type = FLOAT; result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2)); } else { lnum1 = DOToLong(item1); lnum2 = DOToLong(item2); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2); } } /************************************/ /* PiFunction: H/L access routine */ /* for the pi function. */ /************************************/ globle double PiFunction( void *theEnv) { if (EnvArgCountCheck(theEnv,"pi",EXACTLY,0) == -1) return(acos(-1.0)); return(acos(-1.0)); } /****************************************/ /* DegRadFunction: H/L access routine */ /* for the deg-rad function. */ /****************************************/ globle double DegRadFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"deg-rad",&num) == FALSE) return(0.0); return(num * PI / 180.0); } /****************************************/ /* RadDegFunction: H/L access routine */ /* for the rad-deg function. */ /****************************************/ globle double RadDegFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"rad-deg",&num) == FALSE) return(0.0); return(num * 180.0 / PI); } /*****************************************/ /* DegGradFunction: H/L access routine */ /* for the deg-grad function. */ /*****************************************/ globle double DegGradFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"deg-grad",&num) == FALSE) return(0.0); return(num / 0.9); } /*****************************************/ /* GradDegFunction: H/L access routine */ /* for the grad-deg function. */ /*****************************************/ globle double GradDegFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"grad-deg",&num) == FALSE) return(0.0); return(num * 0.9); } /***************************************/ /* RoundFunction: H/L access routine */ /* for the round function. */ /***************************************/ globle long long RoundFunction( void *theEnv) { DATA_OBJECT result; if (EnvArgCountCheck(theEnv,"round",EXACTLY,1) == -1) { return(0LL); } if (EnvArgTypeCheck(theEnv,"round",1,INTEGER_OR_FLOAT,&result) == FALSE) { return(0LL); } if (result.type == INTEGER) { return(ValueToLong(result.value)); } else { return((long long) ceil(ValueToDouble(result.value) - 0.5)); } } /*******************************************/ /* genacosh: Generic routine for computing */ /* the hyperbolic arccosine. */ /*******************************************/ static double genacosh( double num) { return(log(num + sqrt(num * num - 1.0))); } /*******************************************/ /* genasinh: Generic routine for computing */ /* the hyperbolic arcsine. */ /*******************************************/ static double genasinh( double num) { return(log(num + sqrt(num * num + 1.0))); } /*******************************************/ /* genatanh: Generic routine for computing */ /* the hyperbolic arctangent. */ /*******************************************/ static double genatanh( double num) { return((0.5) * log((1.0 + num) / (1.0 - num))); } /*******************************************/ /* genasech: Generic routine for computing */ /* the hyperbolic arcsecant. */ /*******************************************/ static double genasech( double num) { return(log(1.0 / num + sqrt(1.0 / (num * num) - 1.0))); } /*******************************************/ /* genacsch: Generic routine for computing */ /* the hyperbolic arccosecant. */ /*******************************************/ static double genacsch( double num) { return(log(1.0 / num + sqrt(1.0 / (num * num) + 1.0))); } /*******************************************/ /* genacoth: Generic routine for computing */ /* the hyperbolic arccotangent. */ /*******************************************/ static double genacoth( double num) { return((0.5) * log((num + 1.0) / (num - 1.0))); } #endif clips_core_source_630/core/textpro.h0000755000175000017500000000655212373754246016134 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* TEXT PROCESSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modified error messages so that they were */ /* directly printed rather than storing them in */ /* a string buffer which might not be large */ /* enough to contain the entire message. DR0855 */ /* Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added get-region function. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* 6.30: Removed HELP_FUNCTIONS compilation flag and */ /* associated functionality. */ /* */ /* Used genstrcpy and genstrncpy instead of */ /* strcpy and strncpy. */ /* */ /* Support for long long integers. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_textpro #define _H_textpro #ifdef LOCALE #undef LOCALE #endif #ifdef _TEXTPRO_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if TEXTPRO_FUNCTIONS LOCALE void FetchCommand(void *,DATA_OBJECT *); LOCALE int PrintRegionCommand(void *); LOCALE void *GetRegionCommand(void *); int TossCommand(void *); #endif LOCALE void HelpFunctionDefinitions(void *); #endif /* _H_textpro */ clips_core_source_630/core/._insmoddp.c0000755000175000017500000000040712373756345016447 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrcpsr.c0000755000175000017500000000040712373714226016465 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtgen.h0000755000175000017500000000040712374023162016432 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/object.h0000755000175000017500000001330612374023210015645 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* OBJECT SYSTEM DEFINITIONS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /*************************************************************/ #ifndef _H_object #define _H_object typedef struct defclassModule DEFCLASS_MODULE; typedef struct defclass DEFCLASS; typedef struct packedClassLinks PACKED_CLASS_LINKS; typedef struct classLink CLASS_LINK; typedef struct slotName SLOT_NAME; typedef struct slotDescriptor SLOT_DESC; typedef struct messageHandler HANDLER; typedef struct instance INSTANCE_TYPE; typedef struct instanceSlot INSTANCE_SLOT; /* Maximum # of simultaneous class hierarchy traversals should be a multiple of BITS_PER_BYTE and less than MAX_INT */ #define MAX_TRAVERSALS 256 #define TRAVERSAL_BYTES 32 /* (MAX_TRAVERSALS / BITS_PER_BYTE) */ #define VALUE_REQUIRED 0 #define VALUE_PROHIBITED 1 #define VALUE_NOT_REQUIRED 2 #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_multifld #include "multifld.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #define GetInstanceSlotLength(sp) GetMFLength(sp->value) struct packedClassLinks { long classCount; DEFCLASS **classArray; }; struct defclassModule { struct defmoduleItemHeader header; }; struct defclass { struct constructHeader header; unsigned installed : 1; unsigned system : 1; unsigned abstract : 1; unsigned reactive : 1; unsigned traceInstances : 1; unsigned traceSlots : 1; unsigned id; unsigned busy, hashTableIndex; PACKED_CLASS_LINKS directSuperclasses, directSubclasses, allSuperclasses; SLOT_DESC *slots, **instanceTemplate; unsigned *slotNameMap; short slotCount; short localInstanceSlotCount; short instanceSlotCount; short maxSlotNameID; INSTANCE_TYPE *instanceList, *instanceListBottom; HANDLER *handlers; unsigned *handlerOrderMap; short handlerCount; DEFCLASS *nxtHash; BITMAP_HN *scopeMap; char traversalRecord[TRAVERSAL_BYTES]; }; struct classLink { DEFCLASS *cls; struct classLink *nxt; }; struct slotName { unsigned hashTableIndex, use; short id; SYMBOL_HN *name, *putHandlerName; struct slotName *nxt; long bsaveIndex; }; struct instanceSlot { SLOT_DESC *desc; unsigned valueRequired : 1; unsigned override : 1; unsigned short type; void *value; }; struct slotDescriptor { unsigned shared : 1; unsigned multiple : 1; unsigned composite : 1; unsigned noInherit : 1; unsigned noWrite : 1; unsigned initializeOnly : 1; unsigned dynamicDefault : 1; unsigned defaultSpecified : 1; unsigned noDefault : 1; unsigned reactive : 1; unsigned publicVisibility : 1; unsigned createReadAccessor : 1; unsigned createWriteAccessor : 1; unsigned overrideMessageSpecified : 1; DEFCLASS *cls; SLOT_NAME *slotName; SYMBOL_HN *overrideMessage; void *defaultValue; CONSTRAINT_RECORD *constraint; unsigned sharedCount; long bsaveIndex; INSTANCE_SLOT sharedValue; }; struct instance { struct patternEntity header; void *partialMatchList; INSTANCE_SLOT *basisSlots; unsigned installed : 1; unsigned garbage : 1; unsigned initSlotsCalled : 1; unsigned initializeInProgress : 1; unsigned reteSynchronized : 1; SYMBOL_HN *name; unsigned hashTableIndex; unsigned busy; DEFCLASS *cls; INSTANCE_TYPE *prvClass,*nxtClass, *prvHash,*nxtHash, *prvList,*nxtList; INSTANCE_SLOT **slotAddresses, *slots; }; struct messageHandler { unsigned system : 1; unsigned type : 2; unsigned mark : 1; unsigned trace : 1; unsigned busy; SYMBOL_HN *name; DEFCLASS *cls; short minParams; short maxParams; short localVarCount; EXPRESSION *actions; char *ppForm; struct userData *usrData; }; #endif /* _H_object */ clips_core_source_630/core/._objrtmch.c0000755000175000017500000000040712374023161016422 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrccom.h0000755000175000017500000000040712461253173016441 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._lgcldpnd.h0000755000175000017500000000040712373744000016407 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factbld.c0000755000175000017500000012443112375756126016017 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* FACT BUILD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Given a new fact pattern, adds the pattern to */ /* the pattern network of the associated deftemplate. Also */ /* contains routines for deleting a pattern from the fact */ /* pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /*************************************************************/ #define _FACTBLD_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "reteutil.h" #include "router.h" #include "reorder.h" #include "factcmp.h" #include "factmch.h" #include "factgen.h" #include "factmngr.h" #include "factlhs.h" #include "argacces.h" #include "modulutl.h" #include "tmpltdef.h" #include "envrnmnt.h" #include "factbld.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct factPatternNode *FindPatternNode(struct factPatternNode *,struct lhsParseNode *, struct factPatternNode **,unsigned,unsigned); static struct factPatternNode *CreateNewPatternNode(void *,struct lhsParseNode *,struct factPatternNode *, struct factPatternNode *,unsigned,unsigned); static void ClearPatternMatches(void *,struct factPatternNode *); static void DetachFactPattern(void *,struct patternNodeHeader *); static struct patternNodeHeader *PlaceFactPattern(void *,struct lhsParseNode *); static struct lhsParseNode *RemoveUnneededSlots(void *,struct lhsParseNode *); static void FindAndSetDeftemplatePatternNetwork(void *,struct factPatternNode *,struct factPatternNode *); #endif /*********************************************************/ /* InitializeFactPatterns: Adds fact patterns to the set */ /* of patterns recognized by the rule pattern parsing */ /* and pattern/join network integration routines. */ /*********************************************************/ globle void InitializeFactPatterns( void *theEnv) { #if DEFRULE_CONSTRUCT struct patternParser *newPtr; InitializeFactReteFunctions(theEnv); newPtr = get_struct(theEnv,patternParser); newPtr->name = "facts"; newPtr->priority = 0; newPtr->entityType = &FactData(theEnv)->FactInfo; #if (! RUN_TIME) && (! BLOAD_ONLY) newPtr->recognizeFunction = FactPatternParserFind; newPtr->parseFunction = FactPatternParse; newPtr->postAnalysisFunction = NULL; newPtr->addPatternFunction = PlaceFactPattern; newPtr->removePatternFunction = DetachFactPattern; newPtr->genJNConstantFunction = NULL; newPtr->replaceGetJNValueFunction = FactReplaceGetvar; newPtr->genGetJNValueFunction = FactGenGetvar; newPtr->genCompareJNValuesFunction = FactJNVariableComparison; newPtr->genPNConstantFunction = FactGenPNConstant; newPtr->replaceGetPNValueFunction = FactReplaceGetfield; newPtr->genGetPNValueFunction = FactGenGetfield; newPtr->genComparePNValuesFunction = FactPNVariableComparison; newPtr->returnUserDataFunction = NULL; newPtr->copyUserDataFunction = NULL; #else newPtr->recognizeFunction = NULL; newPtr->parseFunction = NULL; newPtr->postAnalysisFunction = NULL; newPtr->addPatternFunction = NULL; newPtr->removePatternFunction = NULL; newPtr->genJNConstantFunction = NULL; newPtr->replaceGetJNValueFunction = NULL; newPtr->genGetJNValueFunction = NULL; newPtr->genCompareJNValuesFunction = NULL; newPtr->genPNConstantFunction = NULL; newPtr->replaceGetPNValueFunction = NULL; newPtr->genGetPNValueFunction = NULL; newPtr->genComparePNValuesFunction = NULL; newPtr->returnUserDataFunction = NULL; newPtr->copyUserDataFunction = NULL; #endif newPtr->markIRPatternFunction = MarkFactPatternForIncrementalReset; newPtr->incrementalResetFunction = FactsIncrementalReset; #if (! RUN_TIME) && (! BLOAD_ONLY) newPtr->initialPatternFunction = CreateInitialFactPattern; #if CONSTRUCT_COMPILER newPtr->codeReferenceFunction = FactPatternNodeReference; #else newPtr->codeReferenceFunction = NULL; #endif #else newPtr->initialPatternFunction = NULL; newPtr->codeReferenceFunction = NULL; #endif AddPatternParser(theEnv,newPtr); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /******************************************************************************/ /* PlaceFactPattern: Integrates a fact pattern into the fact pattern network. */ /******************************************************************************/ static struct patternNodeHeader *PlaceFactPattern( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *tempPattern; struct factPatternNode *currentLevel, *lastLevel; struct factPatternNode *nodeBeforeMatch, *newNode = NULL; unsigned endSlot; int count; const char *deftemplateName; /*======================================================================*/ /* Get the name of the deftemplate associated with the pattern being */ /* added (recall that the first field of any pattern must be a symbol). */ /*======================================================================*/ deftemplateName = ValueToString(thePattern->right->bottom->value); /*=====================================================*/ /* Remove any slot tests that test only for existance. */ /*=====================================================*/ thePattern->right = RemoveUnneededSlots(theEnv,thePattern->right); /*========================================================*/ /* If the constant test for the relation name is the only */ /* pattern network test and there are no other network */ /* tests, then remove the test, but keep the node since */ /* there must be a link from the fact pattern network to */ /* the join network. Otherwise, remove the test for the */ /* relation name since this test has already been done */ /* before entering the pattern network (since each */ /* deftemplate has its own pattern network). */ /*========================================================*/ if (thePattern->right->right == NULL) { ReturnExpression(theEnv,thePattern->right->networkTest); ReturnExpression(theEnv,thePattern->right->constantSelector); ReturnExpression(theEnv,thePattern->right->constantValue); thePattern->right->networkTest = NULL; thePattern->right->constantSelector = NULL; thePattern->right->constantValue = NULL; } else { tempPattern = thePattern->right; thePattern->right = thePattern->right->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); } /*====================================================*/ /* Get the expression for hashing in the alpha memory */ /* and attach it to the last node of the pattern. */ /*====================================================*/ tempPattern = thePattern->right; while (tempPattern->right != NULL) { tempPattern = tempPattern->right; } if ((tempPattern->multifieldSlot) && (tempPattern->bottom != NULL)) { tempPattern = tempPattern->bottom; while (tempPattern->right != NULL) { tempPattern = tempPattern->right; } } tempPattern->rightHash = thePattern->rightHash; thePattern->rightHash = NULL; tempPattern = NULL; /*============================================================*/ /* Get a pointer to the deftemplate data structure associated */ /* with the pattern (use the deftemplate name extracted from */ /* the first field of the pattern). */ /*============================================================*/ FactData(theEnv)->CurrentDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL, deftemplateName,&count, TRUE,NULL); /*================================================*/ /* Initialize some pointers to indicate where the */ /* pattern is being added to the pattern network. */ /*================================================*/ currentLevel = FactData(theEnv)->CurrentDeftemplate->patternNetwork; lastLevel = NULL; thePattern = thePattern->right; /*===========================================*/ /* Loop until all fields in the pattern have */ /* been added to the pattern network. */ /*===========================================*/ while (thePattern != NULL) { /*===========================================================*/ /* If a multifield slot is being processed, then process the */ /* pattern nodes attached to the multifield pattern node. */ /*===========================================================*/ if (thePattern->multifieldSlot) { tempPattern = thePattern; thePattern = thePattern->bottom; } /*============================================*/ /* Determine if the last pattern field within */ /* a multifield slot is being processed. */ /*============================================*/ if ((thePattern->right == NULL) && (tempPattern != NULL)) { endSlot = TRUE; } else { endSlot = FALSE; } /*========================================*/ /* Is there a node in the pattern network */ /* that can be reused (shared)? */ /*========================================*/ newNode = FindPatternNode(currentLevel,thePattern,&nodeBeforeMatch,endSlot,FALSE); /*================================================*/ /* If the pattern node cannot be shared, then add */ /* a new pattern node to the pattern network. */ /*================================================*/ if (newNode == NULL) { newNode = CreateNewPatternNode(theEnv,thePattern,nodeBeforeMatch,lastLevel,endSlot,FALSE); } if (thePattern->constantSelector != NULL) { currentLevel = newNode->nextLevel; lastLevel = newNode; newNode = FindPatternNode(currentLevel,thePattern,&nodeBeforeMatch,endSlot,TRUE); if (newNode == NULL) { newNode = CreateNewPatternNode(theEnv,thePattern,nodeBeforeMatch,lastLevel,endSlot,TRUE); } } /*===========================================================*/ /* Move on to the next field in the new pattern to be added. */ /*===========================================================*/ if ((thePattern->right == NULL) && (tempPattern != NULL)) { thePattern = tempPattern; tempPattern = NULL; } thePattern = thePattern->right; /*==========================================================*/ /* If there are no more pattern nodes to be added to the */ /* pattern network, then mark the last pattern node added */ /* as a stop node (i.e. if you get to this node and the */ /* network test succeeds, then a pattern has been matched). */ /*==========================================================*/ if (thePattern == NULL) newNode->header.stopNode = TRUE; /*================================================*/ /* Update the pointers which indicate where we're */ /* trying to add the new pattern to the currently */ /* existing pattern network. */ /*================================================*/ lastLevel = newNode; currentLevel = newNode->nextLevel; } /*==================================================*/ /* Return the leaf node of the newly added pattern. */ /*==================================================*/ return((struct patternNodeHeader *) newNode); } /*************************************************************/ /* FindPatternNode: Looks for a pattern node at a specified */ /* level in the pattern network that can be reused (shared) */ /* with a pattern field being added to the pattern network. */ /*************************************************************/ static struct factPatternNode *FindPatternNode( struct factPatternNode *listOfNodes, struct lhsParseNode *thePattern, struct factPatternNode **nodeBeforeMatch, unsigned endSlot, unsigned constantSelector) { struct expr *compareTest; *nodeBeforeMatch = NULL; if (constantSelector) { compareTest = thePattern->constantValue; } else if (thePattern->constantSelector != NULL) { compareTest = thePattern->constantSelector; } else { compareTest = thePattern->networkTest; } /*==========================================================*/ /* Loop through the nodes at the given level in the pattern */ /* network looking for a node that can be reused (shared)? */ /*==========================================================*/ while (listOfNodes != NULL) { /*==========================================================*/ /* If the type of the pattern node and the expression being */ /* tested by the pattern node are the same as the type and */ /* expression for the pattern field being added, then */ /* return the pattern node because it can be shared with */ /* the pattern field being added. */ /*==========================================================*/ if ((thePattern->type == SF_WILDCARD) || (thePattern->type == SF_VARIABLE)) { if ((listOfNodes->header.singlefieldNode) && (listOfNodes->header.endSlot == endSlot) && (listOfNodes->whichField == thePattern->index) && (listOfNodes->whichSlot == (thePattern->slotNumber - 1)) && IdenticalExpression(listOfNodes->networkTest,compareTest) && IdenticalExpression(listOfNodes->header.rightHash,thePattern->rightHash)) { return(listOfNodes); } } else if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) { if ((listOfNodes->header.multifieldNode) && (listOfNodes->header.endSlot == endSlot) && (listOfNodes->leaveFields == thePattern->singleFieldsAfter) && (listOfNodes->whichField == thePattern->index) && (listOfNodes->whichSlot == (thePattern->slotNumber - 1)) && IdenticalExpression(listOfNodes->networkTest,compareTest) && IdenticalExpression(listOfNodes->header.rightHash,thePattern->rightHash)) { return(listOfNodes); } } /*==================================*/ /* Move on to the next node at this */ /* level in the pattern network. */ /*==================================*/ *nodeBeforeMatch = listOfNodes; listOfNodes = listOfNodes->rightNode; } /*==============================================*/ /* A shareable pattern node could not be found. */ /*==============================================*/ return(NULL); } /*************************************************************/ /* RemoveUnneededSlots: Removes fact pattern nodes that have */ /* no effect on pattern matching. For example, given the */ /* following deftemplate and a pattern using it, */ /* */ /* (deftemplate foo (slot x) (slot y)) */ /* */ /* (foo (x ?x) (y ?y)) */ /* */ /* The x and y slot pattern nodes can be discarded since */ /* all foo facts will have these two slots in the fact */ /* data structure used to store them. */ /*************************************************************/ static struct lhsParseNode *RemoveUnneededSlots( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *tempPattern = thePattern; struct lhsParseNode *lastPattern = NULL, *head = thePattern; struct expr *theTest; while (tempPattern != NULL) { /*=============================================================*/ /* A single field slot that has no pattern network expression */ /* associated with it can be removed (i.e. any value contained */ /* in this slot will satisfy the pattern being matched). */ /*=============================================================*/ if (((tempPattern->type == SF_WILDCARD) || (tempPattern->type == SF_VARIABLE)) && (tempPattern->networkTest == NULL)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /*=======================================================*/ /* A multifield variable or wildcard within a multifield */ /* slot can be removed if there are no other multifield */ /* variables or wildcards contained in the same slot */ /* (and the multifield has no expressions which must be */ /* evaluated in the fact pattern network). */ /*=======================================================*/ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest == NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /*==================================================================*/ /* A multifield wildcard or variable contained in a multifield slot */ /* that contains no other multifield wildcards or variables, but */ /* does have an expression that must be evaluated, can be changed */ /* to a single field pattern node with the same expression. */ /*==================================================================*/ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest != NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { tempPattern->type = SF_WILDCARD; lastPattern = tempPattern; tempPattern = tempPattern->right; } /*=========================================================*/ /* If we're dealing with a multifield slot with no slot */ /* restrictions, then treat the multfield slot as a single */ /* field slot, but attach a test which verifies that the */ /* slot contains a zero length multifield value. */ /*=========================================================*/ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE) && (tempPattern->bottom == NULL)) { tempPattern->type = SF_WILDCARD; tempPattern->networkTest = FactGenCheckZeroLength(theEnv,tempPattern->slotNumber); tempPattern->multifieldSlot = FALSE; lastPattern = tempPattern; tempPattern = tempPattern->right; } /*===================================================*/ /* Recursively call RemoveUnneededSlots for the slot */ /* restrictions contained within a multifield slot. */ /*===================================================*/ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE)) { /*=======================================================*/ /* Add an expression to the first pattern restriction in */ /* the multifield slot that determines whether or not */ /* the fact's slot value contains the minimum number of */ /* required fields to satisfy the pattern restrictions */ /* for this slot. The length check is place before any */ /* other tests, so that preceeding checks do not have to */ /* determine if there are enough fields in the slot to */ /* safely retrieve a value. */ /*=======================================================*/ theTest = FactGenCheckLength(theEnv,tempPattern->bottom); if (tempPattern->bottom->constantSelector != NULL) { tempPattern->bottom->constantSelector->nextArg = CopyExpression(theEnv,theTest); } theTest = CombineExpressions(theEnv,theTest,tempPattern->bottom->networkTest); tempPattern->bottom->networkTest = theTest; /*=========================================================*/ /* Remove any unneeded pattern restrictions from the slot. */ /*=========================================================*/ tempPattern->bottom = RemoveUnneededSlots(theEnv,tempPattern->bottom); /*===========================================================*/ /* If the slot no longer contains any restrictions, then the */ /* multifield slot can be completely removed. In any case, */ /* move on to the next slot to be examined for removal. */ /*===========================================================*/ if (tempPattern->bottom == NULL) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /*=======================================================*/ /* If none of the other tests for removing slots or slot */ /* restrictions apply, then move on to the next slot or */ /* slot restriction to be tested. */ /*=======================================================*/ else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /*======================================*/ /* Return the pattern with unused slots */ /* and slot restrictions removed. */ /*======================================*/ return(head); } /****************************************************/ /* CreateNewPatternNode: Creates a new pattern node */ /* and initializes all of its values. */ /****************************************************/ static struct factPatternNode *CreateNewPatternNode( void *theEnv, struct lhsParseNode *thePattern, struct factPatternNode *nodeBeforeMatch, struct factPatternNode *upperLevel, unsigned endSlot, unsigned constantSelector) { struct factPatternNode *newNode; /*========================================*/ /* Create the pattern node and initialize */ /* its slots to the default values. */ /*========================================*/ newNode = get_struct(theEnv,factPatternNode); newNode->nextLevel = NULL; newNode->rightNode = NULL; newNode->leftNode = NULL; newNode->leaveFields = thePattern->singleFieldsAfter; InitializePatternHeader(theEnv,(struct patternNodeHeader *) &newNode->header); if (thePattern->index > 0) { newNode->whichField = (unsigned short) thePattern->index; } else newNode->whichField = 0; if (thePattern->slotNumber >= 0) { newNode->whichSlot = (unsigned short) (thePattern->slotNumber - 1); } else { newNode->whichSlot = newNode->whichField; } if ((thePattern->constantSelector != NULL) && (! constantSelector)) { newNode->header.selector = TRUE; } /*=============================================================*/ /* Set the slot values which indicate whether the pattern node */ /* is a single-field, multifield, or end-of-pattern node. */ /*=============================================================*/ if ((thePattern->type == SF_WILDCARD) || (thePattern->type == SF_VARIABLE)) { newNode->header.singlefieldNode = TRUE; } else if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) { newNode->header.multifieldNode = TRUE; } newNode->header.endSlot = endSlot; /*===========================================================*/ /* Install the expression associated with this pattern node. */ /*===========================================================*/ if (constantSelector) { newNode->networkTest = AddHashedExpression(theEnv,thePattern->constantValue); } else if (thePattern->constantSelector != NULL) { newNode->networkTest = AddHashedExpression(theEnv,thePattern->constantSelector); } else { newNode->networkTest = AddHashedExpression(theEnv,thePattern->networkTest); } /*==========================================*/ /* Add the expression used for adding alpha */ /* matches to the alpha memory. */ /*==========================================*/ newNode->header.rightHash = AddHashedExpression(theEnv,thePattern->rightHash); /*===============================================*/ /* Set the upper level pointer for the new node. */ /*===============================================*/ newNode->lastLevel = upperLevel; if ((upperLevel != NULL) && (upperLevel->header.selector)) { AddHashedPatternNode(theEnv,upperLevel,newNode,newNode->networkTest->type,newNode->networkTest->value); } /*======================================================*/ /* If there are no nodes on this level, then attach the */ /* new node to the child pointer of the upper level. */ /*======================================================*/ if (nodeBeforeMatch == NULL) { if (upperLevel == NULL) FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode; else upperLevel->nextLevel = newNode; return(newNode); } /*=====================================================*/ /* If there is an upper level above the new node, then */ /* place the new node as the first child in the upper */ /* level's nextLevel (child) link. */ /*=====================================================*/ if (upperLevel != NULL) { newNode->rightNode = upperLevel->nextLevel; if (upperLevel->nextLevel != NULL) { upperLevel->nextLevel->leftNode = newNode; } upperLevel->nextLevel = newNode; return(newNode); } /*=====================================================*/ /* Since there is no upper level above the new node, */ /* (i.e. the new node is being added to the highest */ /* level in the pattern network), the new node becomes */ /* the first node visited in the pattern network. */ /*=====================================================*/ newNode->rightNode = FactData(theEnv)->CurrentDeftemplate->patternNetwork; if (FactData(theEnv)->CurrentDeftemplate->patternNetwork != NULL) { FactData(theEnv)->CurrentDeftemplate->patternNetwork->leftNode = newNode; } FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode; return(newNode); } /*************************************************************/ /* DetachFactPattern: Removes a pattern node and all of its */ /* parent nodes from the pattern network. Nodes are only */ /* removed if they are no longer shared (i.e. a pattern */ /* node that has more than one child node is shared). A */ /* pattern from a rule is typically removed by removing */ /* the bottom most pattern node used by the pattern and */ /* then removing any parent nodes which are not shared by */ /* other patterns. */ /* */ /* Example: */ /* Patterns (a b c d) and (a b e f) would be represented */ /* by the pattern net shown on the left. If (a b c d) */ /* was detached, the resultant pattern net would be the */ /* one shown on the right. */ /* */ /* a a */ /* | | */ /* b b */ /* | | */ /* c--e e */ /* | | | */ /* d f f */ /* */ /*************************************************************/ static void DetachFactPattern( void *theEnv, struct patternNodeHeader *thePattern) { struct factPatternNode *patternPtr; struct factPatternNode *upperLevel; /*=====================================================*/ /* Get rid of any matches stored in the alpha memory. */ /*=====================================================*/ patternPtr = (struct factPatternNode *) thePattern; ClearPatternMatches(theEnv,patternPtr); /*=======================================================*/ /* If there are no joins entered from this pattern, then */ /* the pattern node is no longer a stop node. Also if */ /* the pattern has a next level pointer, then it can */ /* not be removed since other patterns make use of it. */ /*=======================================================*/ if (patternPtr->header.entryJoin == NULL) patternPtr->header.stopNode = FALSE; if (patternPtr->nextLevel != NULL) return; /*==============================================================*/ /* Loop until all appropriate pattern nodes have been detached. */ /*==============================================================*/ upperLevel = patternPtr; while (upperLevel != NULL) { if ((upperLevel->leftNode == NULL) && (upperLevel->rightNode == NULL)) { /*===============================================*/ /* Pattern node is the only node on this level. */ /* Remove it and continue detaching other nodes */ /* above this one, because no other patterns are */ /* dependent upon this node. */ /*===============================================*/ patternPtr = upperLevel; upperLevel = patternPtr->lastLevel; if (upperLevel == NULL) { FindAndSetDeftemplatePatternNetwork(theEnv,patternPtr,NULL); } else { if (upperLevel->header.selector) { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); } upperLevel->nextLevel = NULL; if (upperLevel->header.stopNode) upperLevel = NULL; } RemoveHashedExpression(theEnv,patternPtr->networkTest); RemoveHashedExpression(theEnv,patternPtr->header.rightHash); rtn_struct(theEnv,factPatternNode,patternPtr); } else if (upperLevel->leftNode != NULL) { /*====================================================*/ /* Pattern node has another pattern node which must */ /* be checked preceding it. Remove the pattern node, */ /* but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; if ((patternPtr->lastLevel != NULL) && (patternPtr->lastLevel->header.selector)) { RemoveHashedPatternNode(theEnv,patternPtr->lastLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); } upperLevel->leftNode->rightNode = upperLevel->rightNode; if (upperLevel->rightNode != NULL) { upperLevel->rightNode->leftNode = upperLevel->leftNode; } RemoveHashedExpression(theEnv,patternPtr->networkTest); RemoveHashedExpression(theEnv,patternPtr->header.rightHash); rtn_struct(theEnv,factPatternNode,patternPtr); upperLevel = NULL; } else { /*====================================================*/ /* Pattern node has no pattern node preceding it, but */ /* does have one succeeding it. Remove the pattern */ /* node, but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; upperLevel = upperLevel->lastLevel; if (upperLevel == NULL) { FindAndSetDeftemplatePatternNetwork(theEnv,patternPtr,patternPtr->rightNode); } else { if (upperLevel->header.selector) { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); } upperLevel->nextLevel = patternPtr->rightNode; } patternPtr->rightNode->leftNode = NULL; RemoveHashedExpression(theEnv,patternPtr->networkTest); RemoveHashedExpression(theEnv,patternPtr->header.rightHash); rtn_struct(theEnv,factPatternNode,patternPtr); upperLevel = NULL; } } } #endif /**************************************************************/ /* DestroyFactPatternNetwork: Deallocates the data structures */ /* associated with a fact pattern network. */ /**************************************************************/ globle void DestroyFactPatternNetwork( void *theEnv, struct factPatternNode *thePattern) { struct factPatternNode *patternPtr; if (thePattern == NULL) return; while (thePattern != NULL) { patternPtr = thePattern->rightNode; DestroyFactPatternNetwork(theEnv,thePattern->nextLevel); DestroyAlphaMemory(theEnv,&thePattern->header,FALSE); if ((thePattern->lastLevel != NULL) && (thePattern->lastLevel->header.selector)) { RemoveHashedPatternNode(theEnv,thePattern->lastLevel,thePattern,thePattern->networkTest->type,thePattern->networkTest->value); } #if (! BLOAD_ONLY) && (! RUN_TIME) rtn_struct(theEnv,factPatternNode,thePattern); #endif thePattern = patternPtr; } } #if (! RUN_TIME) && (! BLOAD_ONLY) /***********************************************************/ /* FindAndSetDeftemplatePatternNetwork: When a deftemplate */ /* pattern is detached from the fact pattern network, it */ /* is not possible to directly detach the link from the */ /* deftemplate to the pattern network (it is a one way */ /* link). Therefore if the top most pointer to a */ /* deftemplates pattern network must be changed, it is */ /* necessary to search the list of deftemplates to find */ /* the appropriate one to modify. */ /***********************************************************/ static void FindAndSetDeftemplatePatternNetwork( void *theEnv, struct factPatternNode *rootNode, struct factPatternNode *newRootNode) { struct deftemplate *theDeftemplate; struct defmodule *theModule; /*=======================================================*/ /* Save the current module since we will be changing it. */ /*=======================================================*/ SaveCurrentModule(theEnv); /*=======================================================*/ /* Loop through every module looking for the deftemplate */ /* associated with the specified root node. */ /*=======================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*======================================================*/ /* Loop through every deftemplate in the current module */ /* searching for the deftemplate associated with the */ /* specified root node. */ /*======================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*===========================================================*/ /* When the associated deftemplate is found, change its root */ /* node from the current value to the new value. Restore the */ /* current module before leaving this routine. */ /*===========================================================*/ if (theDeftemplate->patternNetwork == rootNode) { RestoreCurrentModule(theEnv); theDeftemplate->patternNetwork = newRootNode; return; } } } /*========================================================*/ /* If the deftemplate wasn't found, then we're presumably */ /* we're in the the middle of a clear and the deftemplate */ /* has already been deleted so there's no need to update */ /* the links to the fact pattern network. */ /*========================================================*/ RestoreCurrentModule(theEnv); } /***************************************************************/ /* ClearPatternMatches: Clears the fact list of all pointers */ /* which point to a specific pattern. The pointers are used */ /* to remember which patterns were matched by a fact to */ /* make retraction easier. When a rule is excised, the */ /* pointers need to be removed. */ /***************************************************************/ static void ClearPatternMatches( void *theEnv, struct factPatternNode *patternPtr) { struct fact *theFact; struct patternMatch *lastMatch, *theMatch; /*===========================================*/ /* Loop through every fact in the fact list. */ /*===========================================*/ for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL); theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact)) { /*========================================*/ /* Loop through every match for the fact. */ /*========================================*/ lastMatch = NULL; theMatch = (struct patternMatch *) theFact->list; while (theMatch != NULL) { /*================================================*/ /* If the match is for the pattern being deleted, */ /* then remove the match. */ /*================================================*/ if (theMatch->matchingPattern == (struct patternNodeHeader *) patternPtr) { if (lastMatch == NULL) { /*=====================================*/ /* Remove the first match of the fact. */ /*=====================================*/ theFact->list = (void *) theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = (struct patternMatch *) theFact->list; } else { /*===================================*/ /* Remove a match for the fact which */ /* follows the first match. */ /*===================================*/ lastMatch->next = theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = lastMatch->next; } } /*====================================================*/ /* If the match is not for the pattern being deleted, */ /* then move on to the next match for the fact. */ /*====================================================*/ else { lastMatch = theMatch; theMatch = theMatch->next; } } } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips_core_source_630/core/analysis.h0000755000175000017500000000440512373714503016235 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* ANALYSIS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Analyzes LHS patterns to check for semantic */ /* errors and to determine variable comparisons and other */ /* tests which must be performed either in the pattern or */ /* join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Join network rework and optimizations. */ /* */ /*************************************************************/ #ifndef _H_analysis #define _H_analysis #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _ANALYSIS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /*****************************************************/ /* nandFrame structure: Stores information about the */ /* current position in the nesting of not/and CEs */ /* as the patterns of a rule are analyzed. */ /*****************************************************/ struct nandFrame { int depth; struct lhsParseNode *nandCE; struct nandFrame *next; }; LOCALE intBool VariableAnalysis(void *,struct lhsParseNode *); #endif clips_core_source_630/core/._modulutl.c0000755000175000017500000000040712374017670016467 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/prntutil.c0000755000175000017500000005542512424474566016307 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* PRINT UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for printing various items */ /* and messages. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Added DataObjectToString function. */ /* */ /* Added SlotExistError function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Support for DATA_OBJECT_ARRAY primitive. */ /* */ /* Support for typed EXTERNAL_ADDRESS. */ /* */ /* Used gensprintf and genstrcat instead of */ /* sprintf and strcat. */ /* */ /* Changed integer type/precision. */ /* */ /* Added code for capturing errors/warnings. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #define _PRNTUTIL_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "symbol.h" #include "utility.h" #include "evaluatn.h" #include "argacces.h" #include "router.h" #include "multifun.h" #include "factmngr.h" #include "cstrcpsr.h" #include "inscom.h" #include "insmngr.h" #include "memalloc.h" #include "sysdep.h" #include "prntutil.h" /*****************************************************/ /* InitializePrintUtilityData: Allocates environment */ /* data for print utility routines. */ /*****************************************************/ globle void InitializePrintUtilityData( void *theEnv) { AllocateEnvironmentData(theEnv,PRINT_UTILITY_DATA,sizeof(struct printUtilityData),NULL); } /***********************************************************/ /* PrintInChunks: Prints a string in chunks to accomodate */ /* systems which have a limit on the maximum size of a */ /* string which can be printed. */ /***********************************************************/ globle void PrintInChunks( void *theEnv, const char *logicalName, const char *bigString) { /*=====================================================*/ /* This function was originally added because VMS had */ /* a bug that didn't allow printing a string greater */ /* than 512 bytes. Since this was over 25 years ago, */ /* we'll assume no modern compiler has this limitation */ /* and just print the entire string. */ /*=====================================================*/ EnvPrintRouter(theEnv,logicalName,bigString); /* char tc, *subString; subString = bigString; if (subString == NULL) return; while (((int) strlen(subString)) > 500) { if (EvaluationData(theEnv)->HaltExecution) return; tc = subString[500]; subString[500] = EOS; EnvPrintRouter(theEnv,logicalName,subString); subString[500] = tc; subString += 500; } EnvPrintRouter(theEnv,logicalName,subString); */ } /************************************************************/ /* PrintFloat: Controls printout of floating point numbers. */ /************************************************************/ globle void PrintFloat( void *theEnv, const char *fileid, double number) { const char *theString; theString = FloatToString(theEnv,number); EnvPrintRouter(theEnv,fileid,theString); } /****************************************************/ /* PrintLongInteger: Controls printout of integers. */ /****************************************************/ globle void PrintLongInteger( void *theEnv, const char *logicalName, long long number) { char printBuffer[32]; gensprintf(printBuffer,"%lld",number); EnvPrintRouter(theEnv,logicalName,printBuffer); } /**************************************/ /* PrintAtom: Prints an atomic value. */ /**************************************/ globle void PrintAtom( void *theEnv, const char *logicalName, int type, void *value) { struct externalAddressHashNode *theAddress; char buffer[20]; switch (type) { case FLOAT: PrintFloat(theEnv,logicalName,ValueToDouble(value)); break; case INTEGER: PrintLongInteger(theEnv,logicalName,ValueToLong(value)); break; case SYMBOL: EnvPrintRouter(theEnv,logicalName,ValueToString(value)); break; case STRING: if (PrintUtilityData(theEnv)->PreserveEscapedCharacters) { EnvPrintRouter(theEnv,logicalName,StringPrintForm(theEnv,ValueToString(value))); } else { EnvPrintRouter(theEnv,logicalName,"\""); EnvPrintRouter(theEnv,logicalName,ValueToString(value)); EnvPrintRouter(theEnv,logicalName,"\""); } break; case DATA_OBJECT_ARRAY: if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); EnvPrintRouter(theEnv,logicalName,""); if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); break; case EXTERNAL_ADDRESS: theAddress = (struct externalAddressHashNode *) value; if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); if ((EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type] != NULL) && (EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction != NULL)) { (*EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction)(theEnv,logicalName,value); } else { EnvPrintRouter(theEnv,logicalName,"type); EnvPrintRouter(theEnv,logicalName,buffer); gensprintf(buffer,"%p",ValueToExternalAddress(value)); EnvPrintRouter(theEnv,logicalName,buffer); EnvPrintRouter(theEnv,logicalName,">"); } if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); break; #if OBJECT_SYSTEM case INSTANCE_NAME: EnvPrintRouter(theEnv,logicalName,"["); EnvPrintRouter(theEnv,logicalName,ValueToString(value)); EnvPrintRouter(theEnv,logicalName,"]"); break; #endif case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction == NULL) { EnvPrintRouter(theEnv,logicalName,""); break; } (*EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction)(theEnv,logicalName,value); break; } } /**********************************************************/ /* PrintTally: Prints a tally count indicating the number */ /* of items that have been displayed. Used by functions */ /* such as list-defrules. */ /**********************************************************/ globle void PrintTally( void *theEnv, const char *logicalName, long long count, const char *singular, const char *plural) { if (count == 0) return; EnvPrintRouter(theEnv,logicalName,"For a total of "); PrintLongInteger(theEnv,logicalName,count); EnvPrintRouter(theEnv,logicalName," "); if (count == 1) EnvPrintRouter(theEnv,logicalName,singular); else EnvPrintRouter(theEnv,logicalName,plural); EnvPrintRouter(theEnv,logicalName,".\n"); } /********************************************/ /* PrintErrorID: Prints the module name and */ /* error ID for an error message. */ /********************************************/ globle void PrintErrorID( void *theEnv, const char *module, int errorID, int printCR) { #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); EnvSetErrorFileName(theEnv,EnvGetParsingFileName(theEnv)); ConstructData(theEnv)->ErrLineNumber = GetLineCount(theEnv); #endif if (printCR) EnvPrintRouter(theEnv,WERROR,"\n"); EnvPrintRouter(theEnv,WERROR,"["); EnvPrintRouter(theEnv,WERROR,module); PrintLongInteger(theEnv,WERROR,(long int) errorID); EnvPrintRouter(theEnv,WERROR,"] "); } /**********************************************/ /* PrintWarningID: Prints the module name and */ /* warning ID for a warning message. */ /**********************************************/ globle void PrintWarningID( void *theEnv, const char *module, int warningID, int printCR) { #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); EnvSetWarningFileName(theEnv,EnvGetParsingFileName(theEnv)); ConstructData(theEnv)->WrnLineNumber = GetLineCount(theEnv); #endif if (printCR) EnvPrintRouter(theEnv,WWARNING,"\n"); EnvPrintRouter(theEnv,WWARNING,"["); EnvPrintRouter(theEnv,WWARNING,module); PrintLongInteger(theEnv,WWARNING,(long int) warningID); EnvPrintRouter(theEnv,WWARNING,"] WARNING: "); } /***************************************************/ /* CantFindItemErrorMessage: Generic error message */ /* when an "item" can not be found. */ /***************************************************/ globle void CantFindItemErrorMessage( void *theEnv, const char *itemType, const char *itemName) { PrintErrorID(theEnv,"PRNTUTIL",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find "); EnvPrintRouter(theEnv,WERROR,itemType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR,".\n"); } /*****************************************************/ /* CantFindItemInFunctionErrorMessage: Generic error */ /* message when an "item" can not be found. */ /*****************************************************/ globle void CantFindItemInFunctionErrorMessage( void *theEnv, const char *itemType, const char *itemName, const char *func) { PrintErrorID(theEnv,"PRNTUTIL",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find "); EnvPrintRouter(theEnv,WERROR,itemType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); } /*****************************************************/ /* CantDeleteItemErrorMessage: Generic error message */ /* when an "item" can not be deleted. */ /*****************************************************/ globle void CantDeleteItemErrorMessage( void *theEnv, const char *itemType, const char *itemName) { PrintErrorID(theEnv,"PRNTUTIL",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete "); EnvPrintRouter(theEnv,WERROR,itemType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR,".\n"); } /****************************************************/ /* AlreadyParsedErrorMessage: Generic error message */ /* when an "item" has already been parsed. */ /****************************************************/ globle void AlreadyParsedErrorMessage( void *theEnv, const char *itemType, const char *itemName) { PrintErrorID(theEnv,"PRNTUTIL",5,TRUE); EnvPrintRouter(theEnv,WERROR,"The "); if (itemType != NULL) EnvPrintRouter(theEnv,WERROR,itemType); if (itemName != NULL) EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR," has already been parsed.\n"); } /*********************************************************/ /* SyntaxErrorMessage: Generalized syntax error message. */ /*********************************************************/ globle void SyntaxErrorMessage( void *theEnv, const char *location) { PrintErrorID(theEnv,"PRNTUTIL",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Syntax Error"); if (location != NULL) { EnvPrintRouter(theEnv,WERROR,": Check appropriate syntax for "); EnvPrintRouter(theEnv,WERROR,location); } EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /****************************************************/ /* LocalVariableErrorMessage: Generic error message */ /* when a local variable is accessed by an "item" */ /* which can not access local variables. */ /****************************************************/ globle void LocalVariableErrorMessage( void *theEnv, const char *byWhat) { PrintErrorID(theEnv,"PRNTUTIL",6,TRUE); EnvPrintRouter(theEnv,WERROR,"Local variables can not be accessed by "); EnvPrintRouter(theEnv,WERROR,byWhat); EnvPrintRouter(theEnv,WERROR,".\n"); } /******************************************/ /* SystemError: Generalized error message */ /* for major internal errors. */ /******************************************/ globle void SystemError( void *theEnv, const char *module, int errorID) { PrintErrorID(theEnv,"PRNTUTIL",3,TRUE); EnvPrintRouter(theEnv,WERROR,"\n*** "); EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME); EnvPrintRouter(theEnv,WERROR," SYSTEM ERROR ***\n"); EnvPrintRouter(theEnv,WERROR,"ID = "); EnvPrintRouter(theEnv,WERROR,module); PrintLongInteger(theEnv,WERROR,(long int) errorID); EnvPrintRouter(theEnv,WERROR,"\n"); EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME); EnvPrintRouter(theEnv,WERROR," data structures are in an inconsistent or corrupted state.\n"); EnvPrintRouter(theEnv,WERROR,"This error may have occurred from errors in user defined code.\n"); EnvPrintRouter(theEnv,WERROR,"**************************\n"); } /*******************************************************/ /* DivideByZeroErrorMessage: Generalized error message */ /* for when a function attempts to divide by zero. */ /*******************************************************/ globle void DivideByZeroErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"PRNTUTIL",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Attempt to divide by zero in "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); } /*******************************************************/ /* FloatToString: Converts number to KB string format. */ /*******************************************************/ globle const char *FloatToString( void *theEnv, double number) { char floatString[40]; int i; char x; void *thePtr; gensprintf(floatString,"%.15g",number); for (i = 0; (x = floatString[i]) != '\0'; i++) { if ((x == '.') || (x == 'e')) { thePtr = EnvAddSymbol(theEnv,floatString); return(ValueToString(thePtr)); } } genstrcat(floatString,".0"); thePtr = EnvAddSymbol(theEnv,floatString); return(ValueToString(thePtr)); } /*******************************************************************/ /* LongIntegerToString: Converts long integer to KB string format. */ /*******************************************************************/ globle const char *LongIntegerToString( void *theEnv, long long number) { char buffer[50]; void *thePtr; gensprintf(buffer,"%lld",number); thePtr = EnvAddSymbol(theEnv,buffer); return(ValueToString(thePtr)); } /*******************************************************************/ /* DataObjectToString: Converts a DATA_OBJECT to KB string format. */ /*******************************************************************/ globle const char *DataObjectToString( void *theEnv, DATA_OBJECT *theDO) { void *thePtr; const char *theString; char *newString; const char *prefix, *postfix; size_t length; struct externalAddressHashNode *theAddress; char buffer[30]; switch (GetpType(theDO)) { case MULTIFIELD: prefix = "("; theString = ValueToString(ImplodeMultifield(theEnv,theDO)); postfix = ")"; break; case STRING: prefix = "\""; theString = DOPToString(theDO); postfix = "\""; break; case INSTANCE_NAME: prefix = "["; theString = DOPToString(theDO); postfix = "]"; break; case SYMBOL: return(DOPToString(theDO)); case FLOAT: return(FloatToString(theEnv,DOPToDouble(theDO))); case INTEGER: return(LongIntegerToString(theEnv,DOPToLong(theDO))); case RVOID: return(""); #if OBJECT_SYSTEM case INSTANCE_ADDRESS: thePtr = DOPToPointer(theDO); if (thePtr == (void *) &InstanceData(theEnv)->DummyInstance) { return(""); } if (((struct instance *) thePtr)->garbage) { prefix = "name); postfix = ">"; } else { prefix = "",(int) theAddress->type,DOPToExternalAddress(theDO)); thePtr = EnvAddSymbol(theEnv,buffer); return(ValueToString(thePtr)); #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS: if (DOPToPointer(theDO) == (void *) &FactData(theEnv)->DummyFact) { return(""); } thePtr = DOPToPointer(theDO); gensprintf(buffer,"",((struct fact *) thePtr)->factIndex); thePtr = EnvAddSymbol(theEnv,buffer); return(ValueToString(thePtr)); #endif default: return("UNK"); } length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1; newString = (char *) genalloc(theEnv,length); newString[0] = '\0'; genstrcat(newString,prefix); genstrcat(newString,theString); genstrcat(newString,postfix); thePtr = EnvAddSymbol(theEnv,newString); genfree(theEnv,newString,length); return(ValueToString(thePtr)); } /************************************************************/ /* SalienceInformationError: Error message for errors which */ /* occur during the evaluation of a salience value. */ /************************************************************/ globle void SalienceInformationError( void *theEnv, const char *constructType, const char *constructName) { PrintErrorID(theEnv,"PRNTUTIL",8,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred while evaluating the salience"); if (constructName != NULL) { EnvPrintRouter(theEnv,WERROR," for "); EnvPrintRouter(theEnv,WERROR,constructType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,constructName); } EnvPrintRouter(theEnv,WERROR,".\n"); } /**********************************************************/ /* SalienceRangeError: Error message that is printed when */ /* a salience value does not fall between the minimum */ /* and maximum salience values. */ /**********************************************************/ globle void SalienceRangeError( void *theEnv, int min, int max) { PrintErrorID(theEnv,"PRNTUTIL",9,TRUE); EnvPrintRouter(theEnv,WERROR,"Salience value out of range "); PrintLongInteger(theEnv,WERROR,(long int) min); EnvPrintRouter(theEnv,WERROR," to "); PrintLongInteger(theEnv,WERROR,(long int) max); EnvPrintRouter(theEnv,WERROR,".\n"); } /***************************************************************/ /* SalienceNonIntegerError: Error message that is printed when */ /* a rule's salience does not evaluate to an integer. */ /***************************************************************/ globle void SalienceNonIntegerError( void *theEnv) { PrintErrorID(theEnv,"PRNTUTIL",10,TRUE); EnvPrintRouter(theEnv,WERROR,"Salience value must be an integer value.\n"); } /***************************************************/ /* SlotExistError: Prints out an appropriate error */ /* message when a slot cannot be found for a */ /* function. Input to the function is the slot */ /* name and the function name. */ /***************************************************/ globle void SlotExistError( void *theEnv, const char *sname, const char *func) { PrintErrorID(theEnv,"INSFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"No such slot "); EnvPrintRouter(theEnv,WERROR,sname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } clips_core_source_630/core/._engine.c0000755000175000017500000000040712464554105016066 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulelhs.h0000755000175000017500000000033012365012263016271 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/extnfunc.c0000755000175000017500000005741512462771770016260 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXTERNAL FUNCTION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for adding new user or system defined */ /* functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Added support for passing context information */ /* to user defined functions. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _EXTNFUNC_SOURCE_ #include "setup.h" #include #include #include "constant.h" #include "envrnmnt.h" #include "router.h" #include "memalloc.h" #include "evaluatn.h" #include "extnfunc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void AddHashFunction(void *,struct FunctionDefinition *); static void InitializeFunctionHashTable(void *); static void DeallocateExternalFunctionData(void *); #if (! RUN_TIME) static int RemoveHashFunction(void *,struct FunctionDefinition *); #endif /*********************************************************/ /* InitializeExternalFunctionData: Allocates environment */ /* data for external functions. */ /*********************************************************/ globle void InitializeExternalFunctionData( void *theEnv) { AllocateEnvironmentData(theEnv,EXTERNAL_FUNCTION_DATA,sizeof(struct externalFunctionData),DeallocateExternalFunctionData); } /***********************************************************/ /* DeallocateExternalFunctionData: Deallocates environment */ /* data for external functions. */ /***********************************************************/ static void DeallocateExternalFunctionData( void *theEnv) { struct FunctionHash *fhPtr, *nextFHPtr; int i; #if ! RUN_TIME struct FunctionDefinition *tmpPtr, *nextPtr; tmpPtr = ExternalFunctionData(theEnv)->ListOfFunctions; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,FunctionDefinition,tmpPtr); tmpPtr = nextPtr; } #endif if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL) { return; } for (i = 0; i < SIZE_FUNCTION_HASH; i++) { fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[i]; while (fhPtr != NULL) { nextFHPtr = fhPtr->next; rtn_struct(theEnv,FunctionHash,fhPtr); fhPtr = nextFHPtr; } } genfree(theEnv,ExternalFunctionData(theEnv)->FunctionHashtable, (int) sizeof (struct FunctionHash *) * SIZE_FUNCTION_HASH); } #if (! RUN_TIME) /******************************************************/ /* EnvDefineFunction: Used to define a system or user */ /* external function so that the KB can access it. */ /******************************************************/ globle int EnvDefineFunction( void *theEnv, const char *name, int returnType, int (*pointer)(void *), const char *actualName) { return(DefineFunction3(theEnv,name,returnType,pointer,actualName,NULL,TRUE,NULL)); } /************************************************************/ /* EnvDefineFunctionWithContext: Used to define a system or */ /* user external function so that the KB can access it. */ /************************************************************/ globle int EnvDefineFunctionWithContext( void *theEnv, const char *name, int returnType, int (*pointer)(void *), const char *actualName, void *context) { return(DefineFunction3(theEnv,name,returnType,pointer,actualName,NULL,TRUE,context)); } /*******************************************************/ /* EnvDefineFunction2: Used to define a system or user */ /* external function so that the KB can access it. */ /*******************************************************/ globle int EnvDefineFunction2( void *theEnv, const char *name, int returnType, int (*pointer)(void *), const char *actualName, const char *restrictions) { return(DefineFunction3(theEnv,name,returnType,pointer,actualName,restrictions,TRUE,NULL)); } /*************************************************************/ /* EnvDefineFunction2WithContext: Used to define a system or */ /* user external function so that the KB can access it. */ /*************************************************************/ globle int EnvDefineFunction2WithContext( void *theEnv, const char *name, int returnType, int (*pointer)(void *), const char *actualName, const char *restrictions, void *context) { return(DefineFunction3(theEnv,name,returnType,pointer,actualName,restrictions,TRUE,context)); } /*************************************************************/ /* DefineFunction3: Used to define a system or user external */ /* function so that the KB can access it. Allows argument */ /* restrictions to be attached to the function. */ /* Return types are: */ /* a - external address */ /* b - boolean integer (converted to symbol) */ /* c - character (converted to symbol) */ /* d - double precision float */ /* f - single precision float (converted to double) */ /* g - long long integer */ /* i - integer (converted to long long integer) */ /* j - unknown (symbol, string, */ /* or instance name by convention) */ /* k - unknown (symbol or string by convention) */ /* l - long integer (converted to long long integer) */ /* m - unknown (multifield by convention) */ /* n - unknown (integer or float by convention) */ /* o - instance name */ /* s - string */ /* u - unknown */ /* v - void */ /* w - symbol */ /* x - instance address */ /*************************************************************/ globle int DefineFunction3( void *theEnv, const char *name, int returnType, int (*pointer)(void *), const char *actualName, const char *restrictions, intBool environmentAware, void *context) { struct FunctionDefinition *newFunction; if ( (returnType != 'a') && (returnType != 'b') && (returnType != 'c') && (returnType != 'd') && (returnType != 'f') && (returnType != 'g') && (returnType != 'i') && (returnType != 'j') && (returnType != 'k') && (returnType != 'l') && (returnType != 'm') && (returnType != 'n') && #if OBJECT_SYSTEM (returnType != 'o') && #endif (returnType != 's') && (returnType != 'u') && (returnType != 'v') && #if OBJECT_SYSTEM (returnType != 'x') && #endif #if DEFTEMPLATE_CONSTRUCT (returnType != 'y') && #endif (returnType != 'w') ) { return(0); } newFunction = FindFunction(theEnv,name); if (newFunction == NULL) { newFunction = get_struct(theEnv,FunctionDefinition); newFunction->callFunctionName = (SYMBOL_HN *) EnvAddSymbol(theEnv,name); IncrementSymbolCount(newFunction->callFunctionName); newFunction->next = GetFunctionList(theEnv); ExternalFunctionData(theEnv)->ListOfFunctions = newFunction; AddHashFunction(theEnv,newFunction); } newFunction->returnValueType = (char) returnType; newFunction->functionPointer = (int (*)(void)) pointer; newFunction->actualFunctionName = actualName; if (restrictions != NULL) { if (((int) (strlen(restrictions)) < 2) ? TRUE : ((! isdigit(restrictions[0]) && (restrictions[0] != '*')) || (! isdigit(restrictions[1]) && (restrictions[1] != '*')))) restrictions = NULL; } newFunction->restrictions = restrictions; newFunction->parser = NULL; newFunction->overloadable = TRUE; newFunction->sequenceuseok = TRUE; newFunction->environmentAware = (short) environmentAware; newFunction->usrData = NULL; newFunction->context = context; return(1); } /***********************************************/ /* UndefineFunction: Used to remove a function */ /* definition from the list of functions. */ /***********************************************/ globle int UndefineFunction( void *theEnv, const char *functionName) { SYMBOL_HN *findValue; struct FunctionDefinition *fPtr, *lastPtr = NULL; findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName); for (fPtr = ExternalFunctionData(theEnv)->ListOfFunctions; fPtr != NULL; fPtr = fPtr->next) { if (fPtr->callFunctionName == findValue) { DecrementSymbolCount(theEnv,fPtr->callFunctionName); RemoveHashFunction(theEnv,fPtr); if (lastPtr == NULL) { ExternalFunctionData(theEnv)->ListOfFunctions = fPtr->next; } else { lastPtr->next = fPtr->next; } ClearUserDataList(theEnv,fPtr->usrData); rtn_struct(theEnv,FunctionDefinition,fPtr); return(TRUE); } lastPtr = fPtr; } return(FALSE); } /******************************************/ /* RemoveHashFunction: Removes a function */ /* from the function hash table. */ /******************************************/ static int RemoveHashFunction( void *theEnv, struct FunctionDefinition *fdPtr) { struct FunctionHash *fhPtr, *lastPtr = NULL; unsigned hashValue; hashValue = HashSymbol(ValueToString(fdPtr->callFunctionName),SIZE_FUNCTION_HASH); for (fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[hashValue]; fhPtr != NULL; fhPtr = fhPtr->next) { if (fhPtr->fdPtr == fdPtr) { if (lastPtr == NULL) { ExternalFunctionData(theEnv)->FunctionHashtable[hashValue] = fhPtr->next; } else { lastPtr->next = fhPtr->next; } rtn_struct(theEnv,FunctionHash,fhPtr); return(TRUE); } lastPtr = fhPtr; } return(FALSE); } /***************************************************************************/ /* AddFunctionParser: Associates a specialized expression parsing function */ /* with the function entry for a function which was defined using */ /* DefineFunction. When this function is parsed, the specialized parsing */ /* function will be called to parse the arguments of the function. Only */ /* user and system defined functions can have specialized parsing */ /* routines. Generic functions and deffunctions can not have specialized */ /* parsing routines. */ /***************************************************************************/ globle int AddFunctionParser( void *theEnv, const char *functionName, struct expr *(*fpPtr)(void *,struct expr *,const char *)) { struct FunctionDefinition *fdPtr; fdPtr = FindFunction(theEnv,functionName); if (fdPtr == NULL) { EnvPrintRouter(theEnv,WERROR,"Function parsers can only be added for existing functions.\n"); return(0); } fdPtr->restrictions = NULL; fdPtr->parser = fpPtr; fdPtr->overloadable = FALSE; return(1); } /*********************************************************************/ /* RemoveFunctionParser: Removes a specialized expression parsing */ /* function (if it exists) from the function entry for a function. */ /*********************************************************************/ globle int RemoveFunctionParser( void *theEnv, const char *functionName) { struct FunctionDefinition *fdPtr; fdPtr = FindFunction(theEnv,functionName); if (fdPtr == NULL) { EnvPrintRouter(theEnv,WERROR,"Function parsers can only be removed from existing functions.\n"); return(0); } fdPtr->parser = NULL; return(1); } /*****************************************************************/ /* FuncSeqOvlFlags: Makes a system function overloadable or not, */ /* i.e. can the function be a method for a generic function. */ /*****************************************************************/ globle int FuncSeqOvlFlags( void *theEnv, const char *functionName, int seqp, int ovlp) { struct FunctionDefinition *fdPtr; fdPtr = FindFunction(theEnv,functionName); if (fdPtr == NULL) { EnvPrintRouter(theEnv,WERROR,"Only existing functions can be marked as using sequence expansion arguments/overloadable or not.\n"); return(FALSE); } fdPtr->sequenceuseok = (short) (seqp ? TRUE : FALSE); fdPtr->overloadable = (short) (ovlp ? TRUE : FALSE); return(TRUE); } #endif /*********************************************************/ /* GetArgumentTypeName: Returns a descriptive string for */ /* a function argument type (used by DefineFunction2). */ /*********************************************************/ globle const char *GetArgumentTypeName( int theRestriction) { switch ((char) theRestriction) { case 'a': return("external address"); case 'e': return("instance address, instance name, or symbol"); case 'd': case 'f': return("float"); case 'g': return("integer, float, or symbol"); case 'h': return("instance address, instance name, fact address, integer, or symbol"); case 'j': return("symbol, string, or instance name"); case 'k': return("symbol or string"); case 'i': case 'l': return("integer"); case 'm': return("multifield"); case 'n': return("integer or float"); case 'o': return("instance name"); case 'p': return("instance name or symbol"); case 'q': return("multifield, symbol, or string"); case 's': return("string"); case 'w': return("symbol"); case 'x': return("instance address"); case 'y': return("fact-address"); case 'z': return("fact-address, integer, or symbol"); case 'u': return("non-void return value"); } return("unknown argument type"); } /***************************************************/ /* GetNthRestriction: Returns the restriction type */ /* for the nth parameter of a function. */ /***************************************************/ globle int GetNthRestriction( struct FunctionDefinition *theFunction, int position) { int defaultRestriction = (int) 'u'; size_t theLength; int i = 2; /*===========================================================*/ /* If no restrictions at all are specified for the function, */ /* then return 'u' to indicate that any value is suitable as */ /* an argument to the function. */ /*===========================================================*/ if (theFunction == NULL) return(defaultRestriction); if (theFunction->restrictions == NULL) return(defaultRestriction); /*===========================================================*/ /* If no type restrictions are specified for the function, */ /* then return 'u' to indicate that any value is suitable as */ /* an argument to the function. */ /*===========================================================*/ theLength = strlen(theFunction->restrictions); if (theLength < 3) return(defaultRestriction); /*==============================================*/ /* Determine the functions default restriction. */ /*==============================================*/ defaultRestriction = (int) theFunction->restrictions[i]; if (defaultRestriction == '*') defaultRestriction = (int) 'u'; /*=======================================================*/ /* If the requested position does not have a restriction */ /* specified, then return the default restriction. */ /*=======================================================*/ if (theLength < (size_t) (position + 3)) return(defaultRestriction); /*=========================================================*/ /* Return the restriction specified for the nth parameter. */ /*=========================================================*/ return((int) theFunction->restrictions[position + 2]); } /*************************************************/ /* GetFunctionList: Returns the ListOfFunctions. */ /*************************************************/ globle struct FunctionDefinition *GetFunctionList( void *theEnv) { return(ExternalFunctionData(theEnv)->ListOfFunctions); } /**************************************************************/ /* InstallFunctionList: Sets the ListOfFunctions and adds all */ /* the function entries to the FunctionHashTable. */ /**************************************************************/ globle void InstallFunctionList( void *theEnv, struct FunctionDefinition *value) { int i; struct FunctionHash *fhPtr, *nextPtr; if (ExternalFunctionData(theEnv)->FunctionHashtable != NULL) { for (i = 0; i < SIZE_FUNCTION_HASH; i++) { fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[i]; while (fhPtr != NULL) { nextPtr = fhPtr->next; rtn_struct(theEnv,FunctionHash,fhPtr); fhPtr = nextPtr; } ExternalFunctionData(theEnv)->FunctionHashtable[i] = NULL; } } ExternalFunctionData(theEnv)->ListOfFunctions = value; while (value != NULL) { AddHashFunction(theEnv,value); value = value->next; } } /********************************************************/ /* FindFunction: Returns a pointer to the corresponding */ /* FunctionDefinition structure if a function name is */ /* in the function list, otherwise returns NULL. */ /********************************************************/ globle struct FunctionDefinition *FindFunction( void *theEnv, const char *functionName) { struct FunctionHash *fhPtr; unsigned hashValue; SYMBOL_HN *findValue; if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL) return(NULL); hashValue = HashSymbol(functionName,SIZE_FUNCTION_HASH); findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName); for (fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[hashValue]; fhPtr != NULL; fhPtr = fhPtr->next) { if (fhPtr->fdPtr->callFunctionName == findValue) { return(fhPtr->fdPtr); } } return(NULL); } /*********************************************************/ /* InitializeFunctionHashTable: Purpose is to initialize */ /* the function hash table to NULL. */ /*********************************************************/ static void InitializeFunctionHashTable( void *theEnv) { int i; ExternalFunctionData(theEnv)->FunctionHashtable = (struct FunctionHash **) gm2(theEnv,(int) sizeof (struct FunctionHash *) * SIZE_FUNCTION_HASH); for (i = 0; i < SIZE_FUNCTION_HASH; i++) ExternalFunctionData(theEnv)->FunctionHashtable[i] = NULL; } /****************************************************************/ /* AddHashFunction: Adds a function to the function hash table. */ /****************************************************************/ static void AddHashFunction( void *theEnv, struct FunctionDefinition *fdPtr) { struct FunctionHash *newhash, *temp; unsigned hashValue; if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL) InitializeFunctionHashTable(theEnv); newhash = get_struct(theEnv,FunctionHash); newhash->fdPtr = fdPtr; hashValue = HashSymbol(fdPtr->callFunctionName->contents,SIZE_FUNCTION_HASH); temp = ExternalFunctionData(theEnv)->FunctionHashtable[hashValue]; ExternalFunctionData(theEnv)->FunctionHashtable[hashValue] = newhash; newhash->next = temp; } /*************************************************/ /* GetMinimumArgs: Returns the minimum number of */ /* arguments expected by an external function. */ /*************************************************/ globle int GetMinimumArgs( struct FunctionDefinition *theFunction) { char theChar[2]; const char *restrictions; restrictions = theFunction->restrictions; if (restrictions == NULL) return(-1); theChar[0] = restrictions[0]; theChar[1] = '\0'; if (isdigit(theChar[0])) { return atoi(theChar); } else if (theChar[0] == '*') { return(-1); } return(-1); } /*************************************************/ /* GetMaximumArgs: Returns the maximum number of */ /* arguments expected by an external function. */ /*************************************************/ globle int GetMaximumArgs( struct FunctionDefinition *theFunction) { char theChar[2]; const char *restrictions; restrictions = theFunction->restrictions; if (restrictions == NULL) return(-1); if (restrictions[0] == '\0') return(-1); theChar[0] = restrictions[1]; theChar[1] = '\0'; if (isdigit(theChar[0])) { return atoi(theChar); } else if (theChar[0] == '*') { return(-1); } return(-1); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS #if (! RUN_TIME) globle int DefineFunction( const char *name, int returnType, int (*pointer)(void), const char *actualName) { void *theEnv; theEnv = GetCurrentEnvironment(); return(DefineFunction3(theEnv,name,returnType, (int (*)(void *)) pointer, actualName,NULL,FALSE,NULL)); } globle int DefineFunction2( const char *name, int returnType, int (*pointer)(void), const char *actualName, const char *restrictions) { void *theEnv; theEnv = GetCurrentEnvironment(); return(DefineFunction3(theEnv,name,returnType, (int (*)(void *)) pointer, actualName,restrictions,FALSE,NULL)); } #endif /* (! RUN_TIME) */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/._dffctcmp.h0000755000175000017500000000040712373731206016412 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulecmp.c0000755000175000017500000000040712375756066016303 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._generate.h0000755000175000017500000000040712373753416016425 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulecmp.h0000755000175000017500000000040712374024365016275 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/usrsetup.h0000755000175000017500000000000012365012262016261 0ustar jfsjfsclips_core_source_630/core/cstrnutl.h0000755000175000017500000000445012373714037016272 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for manipulating, initializing, */ /* creating, copying, and comparing constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrnutl #define _H_cstrnutl #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNUTL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif LOCALE struct constraintRecord *GetConstraintRecord(void *); LOCALE int CompareNumbers(void *,int,void *,int,void *); LOCALE struct constraintRecord *CopyConstraintRecord(void *,CONSTRAINT_RECORD *); LOCALE int SetConstraintType(int,CONSTRAINT_RECORD *); LOCALE void SetAnyAllowedFlags(CONSTRAINT_RECORD *,int); LOCALE void SetAnyRestrictionFlags(CONSTRAINT_RECORD *,int); LOCALE CONSTRAINT_RECORD *ArgumentTypeToConstraintRecord(void *,int); LOCALE CONSTRAINT_RECORD *FunctionCallToConstraintRecord(void *,void *); LOCALE CONSTRAINT_RECORD *ExpressionToConstraintRecord(void *,struct expr *); #endif /* _H_cstrnutl */ clips_core_source_630/core/symbol.c0000755000175000017500000017555012464470634015731 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/03/15 */ /* */ /* SYMBOL MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Manages the atomic data value hash tables for */ /* storing symbols, integers, floats, and bit maps. */ /* Contains routines for adding entries, examining the */ /* hash tables, and performing garbage collection to */ /* remove entries no longer in use. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: CLIPS crashing on AMD64 processor in the */ /* function used to generate a hash value for */ /* integers. DR0871 */ /* */ /* Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Corrected code generating compilation */ /* warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for hashing EXTERNAL_ADDRESS data */ /* type. */ /* */ /* Support for long long integers. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Used genstrcpy instead of strcpy. */ /* */ /* Added support for external address hash table */ /* and subtyping. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _SYMBOL_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "utility.h" #include "argacces.h" #include "sysdep.h" #include "symbol.h" /***************/ /* DEFINITIONS */ /***************/ #define FALSE_STRING "FALSE" #define TRUE_STRING "TRUE" #define POSITIVE_INFINITY_STRING "+oo" #define NEGATIVE_INFINITY_STRING "-oo" #define AVERAGE_STRING_SIZE 10 #define AVERAGE_BITMAP_SIZE sizeof(long) #define NUMBER_OF_LONGS_FOR_HASH 25 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void RemoveHashNode(void *,GENERIC_HN *,GENERIC_HN **,int,int); static void AddEphemeralHashNode(void *,GENERIC_HN *,struct ephemeron **, int,int,int); static void RemoveEphemeralHashNodes(void *,struct ephemeron **, GENERIC_HN **, int,int,int); static const char *StringWithinString(const char *,const char *); static size_t CommonPrefixLength(const char *,const char *); static void DeallocateSymbolData(void *); /*******************************************************/ /* InitializeAtomTables: Initializes the SymbolTable, */ /* IntegerTable, and FloatTable. It also initializes */ /* the TrueSymbol and FalseSymbol. */ /*******************************************************/ globle void InitializeAtomTables( void *theEnv, struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable, struct externalAddressHashNode **externalAddressTable) { #if MAC_XCD #pragma unused(symbolTable) #pragma unused(floatTable) #pragma unused(integerTable) #pragma unused(bitmapTable) #pragma unused(externalAddressTable) #endif unsigned long i; AllocateEnvironmentData(theEnv,SYMBOL_DATA,sizeof(struct symbolData),DeallocateSymbolData); #if ! RUN_TIME /*=========================*/ /* Create the hash tables. */ /*=========================*/ SymbolData(theEnv)->SymbolTable = (SYMBOL_HN **) gm3(theEnv,sizeof (SYMBOL_HN *) * SYMBOL_HASH_SIZE); SymbolData(theEnv)->FloatTable = (FLOAT_HN **) gm2(theEnv,(int) sizeof (FLOAT_HN *) * FLOAT_HASH_SIZE); SymbolData(theEnv)->IntegerTable = (INTEGER_HN **) gm2(theEnv,(int) sizeof (INTEGER_HN *) * INTEGER_HASH_SIZE); SymbolData(theEnv)->BitMapTable = (BITMAP_HN **) gm2(theEnv,(int) sizeof (BITMAP_HN *) * BITMAP_HASH_SIZE); SymbolData(theEnv)->ExternalAddressTable = (EXTERNAL_ADDRESS_HN **) gm2(theEnv,(int) sizeof (EXTERNAL_ADDRESS_HN *) * EXTERNAL_ADDRESS_HASH_SIZE); /*===================================================*/ /* Initialize all of the hash table entries to NULL. */ /*===================================================*/ for (i = 0; i < SYMBOL_HASH_SIZE; i++) SymbolData(theEnv)->SymbolTable[i] = NULL; for (i = 0; i < FLOAT_HASH_SIZE; i++) SymbolData(theEnv)->FloatTable[i] = NULL; for (i = 0; i < INTEGER_HASH_SIZE; i++) SymbolData(theEnv)->IntegerTable[i] = NULL; for (i = 0; i < BITMAP_HASH_SIZE; i++) SymbolData(theEnv)->BitMapTable[i] = NULL; for (i = 0; i < EXTERNAL_ADDRESS_HASH_SIZE; i++) SymbolData(theEnv)->ExternalAddressTable[i] = NULL; /*========================*/ /* Predefine some values. */ /*========================*/ SymbolData(theEnv)->TrueSymbolHN = EnvAddSymbol(theEnv,TRUE_STRING); IncrementSymbolCount(SymbolData(theEnv)->TrueSymbolHN); SymbolData(theEnv)->FalseSymbolHN = EnvAddSymbol(theEnv,FALSE_STRING); IncrementSymbolCount(SymbolData(theEnv)->FalseSymbolHN); SymbolData(theEnv)->PositiveInfinity = EnvAddSymbol(theEnv,POSITIVE_INFINITY_STRING); IncrementSymbolCount(SymbolData(theEnv)->PositiveInfinity); SymbolData(theEnv)->NegativeInfinity = EnvAddSymbol(theEnv,NEGATIVE_INFINITY_STRING); IncrementSymbolCount(SymbolData(theEnv)->NegativeInfinity); SymbolData(theEnv)->Zero = EnvAddLong(theEnv,0LL); IncrementIntegerCount(SymbolData(theEnv)->Zero); #else SetSymbolTable(theEnv,symbolTable); SetFloatTable(theEnv,floatTable); SetIntegerTable(theEnv,integerTable); SetBitMapTable(theEnv,bitmapTable); SymbolData(theEnv)->ExternalAddressTable = (EXTERNAL_ADDRESS_HN **) gm2(theEnv,(int) sizeof (EXTERNAL_ADDRESS_HN *) * EXTERNAL_ADDRESS_HASH_SIZE); for (i = 0; i < EXTERNAL_ADDRESS_HASH_SIZE; i++) SymbolData(theEnv)->ExternalAddressTable[i] = NULL; #endif } /*************************************************/ /* DeallocateSymbolData: Deallocates environment */ /* data for symbols. */ /*************************************************/ static void DeallocateSymbolData( void *theEnv) { int i; SYMBOL_HN *shPtr, *nextSHPtr; INTEGER_HN *ihPtr, *nextIHPtr; FLOAT_HN *fhPtr, *nextFHPtr; BITMAP_HN *bmhPtr, *nextBMHPtr; EXTERNAL_ADDRESS_HN *eahPtr, *nextEAHPtr; if ((SymbolData(theEnv)->SymbolTable == NULL) || (SymbolData(theEnv)->FloatTable == NULL) || (SymbolData(theEnv)->IntegerTable == NULL) || (SymbolData(theEnv)->BitMapTable == NULL) || (SymbolData(theEnv)->ExternalAddressTable == NULL)) { return; } for (i = 0; i < SYMBOL_HASH_SIZE; i++) { shPtr = SymbolData(theEnv)->SymbolTable[i]; while (shPtr != NULL) { nextSHPtr = shPtr->next; if (! shPtr->permanent) { rm(theEnv,(void *) shPtr->contents,strlen(shPtr->contents)+1); rtn_struct(theEnv,symbolHashNode,shPtr); } shPtr = nextSHPtr; } } for (i = 0; i < FLOAT_HASH_SIZE; i++) { fhPtr = SymbolData(theEnv)->FloatTable[i]; while (fhPtr != NULL) { nextFHPtr = fhPtr->next; if (! fhPtr->permanent) { rtn_struct(theEnv,floatHashNode,fhPtr); } fhPtr = nextFHPtr; } } for (i = 0; i < INTEGER_HASH_SIZE; i++) { ihPtr = SymbolData(theEnv)->IntegerTable[i]; while (ihPtr != NULL) { nextIHPtr = ihPtr->next; if (! ihPtr->permanent) { rtn_struct(theEnv,integerHashNode,ihPtr); } ihPtr = nextIHPtr; } } for (i = 0; i < BITMAP_HASH_SIZE; i++) { bmhPtr = SymbolData(theEnv)->BitMapTable[i]; while (bmhPtr != NULL) { nextBMHPtr = bmhPtr->next; if (! bmhPtr->permanent) { rm(theEnv,(void *) bmhPtr->contents,bmhPtr->size); rtn_struct(theEnv,bitMapHashNode,bmhPtr); } bmhPtr = nextBMHPtr; } } for (i = 0; i < EXTERNAL_ADDRESS_HASH_SIZE; i++) { eahPtr = SymbolData(theEnv)->ExternalAddressTable[i]; while (eahPtr != NULL) { nextEAHPtr = eahPtr->next; if (! eahPtr->permanent) { rtn_struct(theEnv,externalAddressHashNode,eahPtr); } eahPtr = nextEAHPtr; } } /*================================*/ /* Remove the symbol hash tables. */ /*================================*/ #if ! RUN_TIME rm3(theEnv,SymbolData(theEnv)->SymbolTable,sizeof (SYMBOL_HN *) * SYMBOL_HASH_SIZE); genfree(theEnv,SymbolData(theEnv)->FloatTable,(int) sizeof (FLOAT_HN *) * FLOAT_HASH_SIZE); genfree(theEnv,SymbolData(theEnv)->IntegerTable,(int) sizeof (INTEGER_HN *) * INTEGER_HASH_SIZE); genfree(theEnv,SymbolData(theEnv)->BitMapTable,(int) sizeof (BITMAP_HN *) * BITMAP_HASH_SIZE); #endif genfree(theEnv,SymbolData(theEnv)->ExternalAddressTable,(int) sizeof (EXTERNAL_ADDRESS_HN *) * EXTERNAL_ADDRESS_HASH_SIZE); /*==============================*/ /* Remove binary symbol tables. */ /*==============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES if (SymbolData(theEnv)->SymbolArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->SymbolArray,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols); if (SymbolData(theEnv)->FloatArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->FloatArray,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats); if (SymbolData(theEnv)->IntegerArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->IntegerArray,(long) sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers); if (SymbolData(theEnv)->BitMapArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->BitMapArray,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps); #endif } /*********************************************************************/ /* EnvAddSymbol: Searches for the string in the symbol table. If the */ /* string is already in the symbol table, then the address of the */ /* string's location in the symbol table is returned. Otherwise, */ /* the string is added to the symbol table and then the address */ /* of the string's location in the symbol table is returned. */ /*********************************************************************/ globle void *EnvAddSymbol( void *theEnv, const char *str) { unsigned long tally; size_t length; SYMBOL_HN *past = NULL, *peek; char *buffer; /*====================================*/ /* Get the hash value for the string. */ /*====================================*/ if (str == NULL) { SystemError(theEnv,"SYMBOL",1); EnvExitRouter(theEnv,EXIT_FAILURE); } tally = HashSymbol(str,SYMBOL_HASH_SIZE); peek = SymbolData(theEnv)->SymbolTable[tally]; /*==================================================*/ /* Search for the string in the list of entries for */ /* this symbol table location. If the string is */ /* found, then return the address of the string. */ /*==================================================*/ while (peek != NULL) { if (strcmp(str,peek->contents) == 0) { return((void *) peek); } past = peek; peek = peek->next; } /*==================================================*/ /* Add the string at the end of the list of entries */ /* for this symbol table location. */ /*==================================================*/ peek = get_struct(theEnv,symbolHashNode); if (past == NULL) SymbolData(theEnv)->SymbolTable[tally] = peek; else past->next = peek; length = strlen(str) + 1; buffer = (char *) gm2(theEnv,length); genstrcpy(buffer,str); peek->contents = buffer; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; /*================================================*/ /* Add the string to the list of ephemeral items. */ /*================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralSymbolList, sizeof(SYMBOL_HN),AVERAGE_STRING_SIZE,TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; /*===================================*/ /* Return the address of the symbol. */ /*===================================*/ return((void *) peek); } /*****************************************************************/ /* FindSymbolHN: Searches for the string in the symbol table and */ /* returns a pointer to it if found, otherwise returns NULL. */ /*****************************************************************/ globle SYMBOL_HN *FindSymbolHN( void *theEnv, const char *str) { unsigned long tally; SYMBOL_HN *peek; tally = HashSymbol(str,SYMBOL_HASH_SIZE); for (peek = SymbolData(theEnv)->SymbolTable[tally]; peek != NULL; peek = peek->next) { if (strcmp(str,peek->contents) == 0) { return(peek); } } return(NULL); } /*******************************************************************/ /* EnvAddDouble: Searches for the double in the hash table. If the */ /* double is already in the hash table, then the address of the */ /* double is returned. Otherwise, the double is hashed into the */ /* table and the address of the double is also returned. */ /*******************************************************************/ globle void *EnvAddDouble( void *theEnv, double number) { unsigned long tally; FLOAT_HN *past = NULL, *peek; /*====================================*/ /* Get the hash value for the double. */ /*====================================*/ tally = HashFloat(number,FLOAT_HASH_SIZE); peek = SymbolData(theEnv)->FloatTable[tally]; /*==================================================*/ /* Search for the double in the list of entries for */ /* this hash location. If the double is found, */ /* then return the address of the double. */ /*==================================================*/ while (peek != NULL) { if (number == peek->contents) { return((void *) peek); } past = peek; peek = peek->next; } /*=================================================*/ /* Add the float at the end of the list of entries */ /* for this hash location. */ /*=================================================*/ peek = get_struct(theEnv,floatHashNode); if (past == NULL) SymbolData(theEnv)->FloatTable[tally] = peek; else past->next = peek; peek->contents = number; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; /*===============================================*/ /* Add the float to the list of ephemeral items. */ /*===============================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralFloatList, sizeof(FLOAT_HN),0,TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; /*==================================*/ /* Return the address of the float. */ /*==================================*/ return((void *) peek); } /***************************************************************/ /* EnvAddLong: Searches for the long in the hash table. If the */ /* long is already in the hash table, then the address of */ /* the long is returned. Otherwise, the long is hashed into */ /* the table and the address of the long is also returned. */ /***************************************************************/ globle void *EnvAddLong( void *theEnv, long long number) { unsigned long tally; INTEGER_HN *past = NULL, *peek; /*==================================*/ /* Get the hash value for the long. */ /*==================================*/ tally = HashInteger(number,INTEGER_HASH_SIZE); peek = SymbolData(theEnv)->IntegerTable[tally]; /*================================================*/ /* Search for the long in the list of entries for */ /* this hash location. If the long is found, then */ /* return the address of the long. */ /*================================================*/ while (peek != NULL) { if (number == peek->contents) { return((void *) peek); } past = peek; peek = peek->next; } /*================================================*/ /* Add the long at the end of the list of entries */ /* for this hash location. */ /*================================================*/ peek = get_struct(theEnv,integerHashNode); if (past == NULL) SymbolData(theEnv)->IntegerTable[tally] = peek; else past->next = peek; peek->contents = number; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; /*=================================================*/ /* Add the integer to the list of ephemeral items. */ /*=================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralIntegerList, sizeof(INTEGER_HN),0,TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; /*====================================*/ /* Return the address of the integer. */ /*====================================*/ return((void *) peek); } /*****************************************************************/ /* FindLongHN: Searches for the integer in the integer table and */ /* returns a pointer to it if found, otherwise returns NULL. */ /*****************************************************************/ globle INTEGER_HN *FindLongHN( void *theEnv, long long theLong) { unsigned long tally; INTEGER_HN *peek; tally = HashInteger(theLong,INTEGER_HASH_SIZE); for (peek = SymbolData(theEnv)->IntegerTable[tally]; peek != NULL; peek = peek->next) { if (peek->contents == theLong) return(peek); } return(NULL); } /*******************************************************************/ /* EnvAddBitMap: Searches for the bitmap in the hash table. If the */ /* bitmap is already in the hash table, then the address of the */ /* bitmap is returned. Otherwise, the bitmap is hashed into the */ /* table and the address of the bitmap is also returned. */ /*******************************************************************/ globle void *EnvAddBitMap( void *theEnv, void *vTheBitMap, unsigned size) { char *theBitMap = (char *) vTheBitMap; unsigned long tally; unsigned i; BITMAP_HN *past = NULL, *peek; char *buffer; /*====================================*/ /* Get the hash value for the bitmap. */ /*====================================*/ if (theBitMap == NULL) { SystemError(theEnv,"SYMBOL",2); EnvExitRouter(theEnv,EXIT_FAILURE); } tally = HashBitMap(theBitMap,BITMAP_HASH_SIZE,size); peek = SymbolData(theEnv)->BitMapTable[tally]; /*==================================================*/ /* Search for the bitmap in the list of entries for */ /* this hash table location. If the bitmap is */ /* found, then return the address of the bitmap. */ /*==================================================*/ while (peek != NULL) { if (peek->size == (unsigned short) size) { for (i = 0; i < size ; i++) { if (peek->contents[i] != theBitMap[i]) break; } if (i == size) return((void *) peek); } past = peek; peek = peek->next; } /*==================================================*/ /* Add the bitmap at the end of the list of entries */ /* for this hash table location. Return the */ /*==================================================*/ peek = get_struct(theEnv,bitMapHashNode); if (past == NULL) SymbolData(theEnv)->BitMapTable[tally] = peek; else past->next = peek; buffer = (char *) gm2(theEnv,size); for (i = 0; i < size ; i++) buffer[i] = theBitMap[i]; peek->contents = buffer; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; peek->size = (unsigned short) size; /*================================================*/ /* Add the bitmap to the list of ephemeral items. */ /*================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralBitMapList, sizeof(BITMAP_HN),sizeof(long),TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; /*===================================*/ /* Return the address of the bitmap. */ /*===================================*/ return((void *) peek); } /*******************************************************************/ /* EnvAddExternalAddress: Searches for the external address in the */ /* hash table. If the external address is already in the hash */ /* table, then the address of the external address is returned. */ /* Otherwise, the external address is hashed into the table and */ /* the address of the external address is also returned. */ /*******************************************************************/ globle void *EnvAddExternalAddress( void *theEnv, void *theExternalAddress, unsigned theType) { unsigned long tally; EXTERNAL_ADDRESS_HN *past = NULL, *peek; /*====================================*/ /* Get the hash value for the bitmap. */ /*====================================*/ tally = HashExternalAddress(theExternalAddress,EXTERNAL_ADDRESS_HASH_SIZE); peek = SymbolData(theEnv)->ExternalAddressTable[tally]; /*=============================================================*/ /* Search for the external address in the list of entries for */ /* this hash table location. If the external addressis found, */ /* then return the address of the external address. */ /*=============================================================*/ while (peek != NULL) { if ((peek->type == (unsigned short) theType) && (peek->externalAddress == theExternalAddress)) { return((void *) peek); } past = peek; peek = peek->next; } /*=================================================*/ /* Add the external address at the end of the list */ /* of entries for this hash table location. */ /*=================================================*/ peek = get_struct(theEnv,externalAddressHashNode); if (past == NULL) SymbolData(theEnv)->ExternalAddressTable[tally] = peek; else past->next = peek; peek->externalAddress = theExternalAddress; peek->type = (unsigned short) theType; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; /*================================================*/ /* Add the bitmap to the list of ephemeral items. */ /*================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralExternalAddressList, sizeof(EXTERNAL_ADDRESS_HN),sizeof(long),TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; /*=============================================*/ /* Return the address of the external address. */ /*=============================================*/ return((void *) peek); } /***************************************************/ /* HashSymbol: Computes a hash value for a symbol. */ /***************************************************/ globle unsigned long HashSymbol( const char *word, unsigned long range) { register int i; unsigned long tally = 0; for (i = 0; word[i]; i++) { tally = tally * 127 + word[i]; } if (range == 0) { return tally; } return(tally % range); } /*************************************************/ /* HashFloat: Computes a hash value for a float. */ /*************************************************/ globle unsigned long HashFloat( double number, unsigned long range) { unsigned long tally = 0; char *word; unsigned i; word = (char *) &number; for (i = 0; i < sizeof(double); i++) { tally = tally * 127 + word[i]; } if (range == 0) { return tally; } return(tally % range); } /******************************************************/ /* HashInteger: Computes a hash value for an integer. */ /******************************************************/ globle unsigned long HashInteger( long long number, unsigned long range) { unsigned long tally; #if WIN_MVC if (number < 0) { number = - number; } tally = (((unsigned) number) % range); #else tally = (((unsigned) llabs(number)) % range); #endif if (range == 0) { return tally; } return(tally); } /****************************************/ /* HashExternalAddress: Computes a hash */ /* value for an external address. */ /****************************************/ globle unsigned long HashExternalAddress( void *theExternalAddress, unsigned long range) { unsigned long tally; union { void *vv; unsigned uv; } fis; fis.uv = 0; fis.vv = theExternalAddress; tally = (fis.uv / 256); if (range == 0) { return tally; } return(tally % range); } /***************************************************/ /* HashBitMap: Computes a hash value for a bitmap. */ /***************************************************/ globle unsigned long HashBitMap( const char *word, unsigned long range, unsigned length) { register unsigned k,j,i; unsigned long tally; unsigned longLength; unsigned long count = 0L,tmpLong; char *tmpPtr; tmpPtr = (char *) &tmpLong; /*================================================================ */ /* Add up the first part of the word as unsigned long int values. */ /*================================================================ */ longLength = length / sizeof(unsigned long); for (i = 0 , j = 0 ; i < longLength; i++) { for (k = 0 ; k < sizeof(unsigned long) ; k++ , j++) tmpPtr[k] = word[j]; count += tmpLong; } /*============================================*/ /* Add the remaining characters to the count. */ /*============================================*/ for (; j < length; j++) count += (unsigned long) word[j]; /*========================*/ /* Return the hash value. */ /*========================*/ if (range == 0) { return count; } tally = (count % range); return(tally); } /*****************************************************/ /* DecrementSymbolCount: Decrements the count value */ /* for a SymbolTable entry. Adds the symbol to the */ /* EphemeralSymbolList if the count becomes zero. */ /*****************************************************/ globle void DecrementSymbolCount( void *theEnv, SYMBOL_HN *theValue) { if (theValue->count < 0) { SystemError(theEnv,"SYMBOL",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (theValue->count == 0) { SystemError(theEnv,"SYMBOL",4); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralSymbolList, sizeof(SYMBOL_HN),AVERAGE_STRING_SIZE,TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; } return; } /***************************************************/ /* DecrementFloatCount: Decrements the count value */ /* for a FloatTable entry. Adds the float to the */ /* EphemeralFloatList if the count becomes zero. */ /***************************************************/ globle void DecrementFloatCount( void *theEnv, FLOAT_HN *theValue) { if (theValue->count <= 0) { SystemError(theEnv,"SYMBOL",5); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralFloatList, sizeof(FLOAT_HN),0,TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; } return; } /*********************************************************/ /* DecrementIntegerCount: Decrements the count value for */ /* an IntegerTable entry. Adds the integer to the */ /* EphemeralIntegerList if the count becomes zero. */ /*********************************************************/ globle void DecrementIntegerCount( void *theEnv, INTEGER_HN *theValue) { if (theValue->count <= 0) { SystemError(theEnv,"SYMBOL",6); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralIntegerList, sizeof(INTEGER_HN),0,TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; } return; } /*****************************************************/ /* DecrementBitMapCount: Decrements the count value */ /* for a BitmapTable entry. Adds the bitmap to the */ /* EphemeralBitMapList if the count becomes zero. */ /*****************************************************/ globle void DecrementBitMapCount( void *theEnv, BITMAP_HN *theValue) { if (theValue->count < 0) { SystemError(theEnv,"SYMBOL",7); EnvExitRouter(theEnv,EXIT_FAILURE); } if (theValue->count == 0) { SystemError(theEnv,"SYMBOL",8); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralBitMapList, sizeof(BITMAP_HN),sizeof(long),TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; } return; } /*************************************************************/ /* DecrementExternalAddressCount: Decrements the count value */ /* for an ExternAddressTable entry. Adds the bitmap to the */ /* EphemeralExternalAddressList if the count becomes zero. */ /*************************************************************/ globle void DecrementExternalAddressCount( void *theEnv, EXTERNAL_ADDRESS_HN *theValue) { if (theValue->count < 0) { SystemError(theEnv,"SYMBOL",9); EnvExitRouter(theEnv,EXIT_FAILURE); } if (theValue->count == 0) { SystemError(theEnv,"SYMBOL",10); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&UtilityData(theEnv)->CurrentGarbageFrame->ephemeralExternalAddressList, sizeof(EXTERNAL_ADDRESS_HN),sizeof(long),TRUE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; } return; } /************************************************/ /* RemoveHashNode: Removes a hash node from the */ /* SymbolTable, FloatTable, IntegerTable, */ /* BitMapTable, or ExternalAddressTable. */ /************************************************/ static void RemoveHashNode( void *theEnv, GENERIC_HN *theValue, GENERIC_HN **theTable, int size, int type) { GENERIC_HN *previousNode, *currentNode; struct externalAddressHashNode *theAddress; /*=============================================*/ /* Find the entry in the specified hash table. */ /*=============================================*/ previousNode = NULL; currentNode = theTable[theValue->bucket]; while (currentNode != theValue) { previousNode = currentNode; currentNode = currentNode->next; if (currentNode == NULL) { SystemError(theEnv,"SYMBOL",11); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*===========================================*/ /* Remove the entry from the list of entries */ /* stored in the hash table bucket. */ /*===========================================*/ if (previousNode == NULL) { theTable[theValue->bucket] = theValue->next; } else { previousNode->next = currentNode->next; } /*=================================================*/ /* Symbol and bit map nodes have additional memory */ /* use to store the character or bitmap string. */ /*=================================================*/ if (type == SYMBOL) { rm(theEnv,(void *) ((SYMBOL_HN *) theValue)->contents, strlen(((SYMBOL_HN *) theValue)->contents) + 1); } else if (type == BITMAPARRAY) { rm(theEnv,(void *) ((BITMAP_HN *) theValue)->contents, ((BITMAP_HN *) theValue)->size); } else if (type == EXTERNAL_ADDRESS) { theAddress = (struct externalAddressHashNode *) theValue; if ((EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type] != NULL) && (EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->discardFunction != NULL)) { (*EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->discardFunction)(theEnv,theAddress->externalAddress); } } /*===========================*/ /* Return the table entry to */ /* the pool of free memory. */ /*===========================*/ rtn_sized_struct(theEnv,size,theValue); } /***********************************************************/ /* AddEphemeralHashNode: Adds a symbol, integer, float, or */ /* bit map table entry to the list of ephemeral atomic */ /* values. These entries have a zero count indicating */ /* that no structure is using the data value. */ /***********************************************************/ static void AddEphemeralHashNode( void *theEnv, GENERIC_HN *theHashNode, struct ephemeron **theEphemeralList, int hashNodeSize, int averageContentsSize, int checkCount) { struct ephemeron *temp; /*===========================================*/ /* If the count isn't zero then this routine */ /* should never have been called. */ /*===========================================*/ if (checkCount && (theHashNode->count != 0)) { SystemError(theEnv,"SYMBOL",12); EnvExitRouter(theEnv,EXIT_FAILURE); } /*=====================================*/ /* Mark the atomic value as ephemeral. */ /*=====================================*/ theHashNode->markedEphemeral = TRUE; /*=============================*/ /* Add the atomic value to the */ /* list of ephemeral values. */ /*=============================*/ temp = get_struct(theEnv,ephemeron); temp->associatedValue = theHashNode; temp->next = *theEphemeralList; *theEphemeralList = temp; } /***************************************************/ /* RemoveEphemeralAtoms: Causes the removal of all */ /* ephemeral symbols, integers, floats, and bit */ /* maps that still have a count value of zero, */ /* from their respective storage tables. */ /***************************************************/ globle void RemoveEphemeralAtoms( void *theEnv) { struct garbageFrame *theGarbageFrame; theGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; if (! theGarbageFrame->dirty) return; RemoveEphemeralHashNodes(theEnv,&theGarbageFrame->ephemeralSymbolList,(GENERIC_HN **) SymbolData(theEnv)->SymbolTable, sizeof(SYMBOL_HN),SYMBOL,AVERAGE_STRING_SIZE); RemoveEphemeralHashNodes(theEnv,&theGarbageFrame->ephemeralFloatList,(GENERIC_HN **) SymbolData(theEnv)->FloatTable, sizeof(FLOAT_HN),FLOAT,0); RemoveEphemeralHashNodes(theEnv,&theGarbageFrame->ephemeralIntegerList,(GENERIC_HN **) SymbolData(theEnv)->IntegerTable, sizeof(INTEGER_HN),INTEGER,0); RemoveEphemeralHashNodes(theEnv,&theGarbageFrame->ephemeralBitMapList,(GENERIC_HN **) SymbolData(theEnv)->BitMapTable, sizeof(BITMAP_HN),BITMAPARRAY,AVERAGE_BITMAP_SIZE); RemoveEphemeralHashNodes(theEnv,&theGarbageFrame->ephemeralExternalAddressList,(GENERIC_HN **) SymbolData(theEnv)->ExternalAddressTable, sizeof(EXTERNAL_ADDRESS_HN),EXTERNAL_ADDRESS,0); } /**********************************************************/ /* EphemerateMultifield: Marks the values of a multifield */ /* as ephemeral if they have not already been marker. */ /**********************************************************/ globle void EphemerateMultifield( void *theEnv, struct multifield *theSegment) { unsigned long length, i; struct field *theFields; if (theSegment == NULL) return; length = theSegment->multifieldLength; theFields = theSegment->theFields; for (i = 0 ; i < length ; i++) { EphemerateValue(theEnv,theFields[i].type,theFields[i].value); } } /***********************************************/ /* EphemerateValue: Marks a value as ephemeral */ /* if it is not already marked. */ /***********************************************/ globle void EphemerateValue( void *theEnv, int theType, void *theValue) { SYMBOL_HN *theSymbol; FLOAT_HN *theFloat; INTEGER_HN *theInteger; EXTERNAL_ADDRESS_HN *theExternalAddress; switch (theType) { case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif theSymbol = (SYMBOL_HN *) theValue; if (theSymbol->markedEphemeral) return; AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue, &UtilityData(theEnv)->CurrentGarbageFrame->ephemeralSymbolList, sizeof(SYMBOL_HN),AVERAGE_STRING_SIZE,FALSE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; break; case FLOAT: theFloat = (FLOAT_HN *) theValue; if (theFloat->markedEphemeral) return; AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue, &UtilityData(theEnv)->CurrentGarbageFrame->ephemeralFloatList, sizeof(FLOAT_HN),0,FALSE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; break; case INTEGER: theInteger = (INTEGER_HN *) theValue; if (theInteger->markedEphemeral) return; AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue, &UtilityData(theEnv)->CurrentGarbageFrame->ephemeralIntegerList, sizeof(INTEGER_HN),0,FALSE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; break; case EXTERNAL_ADDRESS: theExternalAddress = (EXTERNAL_ADDRESS_HN *) theValue; if (theExternalAddress->markedEphemeral) return; AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue, &UtilityData(theEnv)->CurrentGarbageFrame->ephemeralExternalAddressList, sizeof(EXTERNAL_ADDRESS_HN),sizeof(long),FALSE); UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; break; case MULTIFIELD: EphemerateMultifield(theEnv,(struct multifield *) theValue); break; } } /****************************************************************/ /* RemoveEphemeralHashNodes: Removes symbols from the ephemeral */ /* symbol list that have a count of zero and were placed on */ /* the list at a higher level than the current evaluation */ /* depth. Since symbols are ordered in the list in descending */ /* order, the removal process can end when a depth is reached */ /* less than the current evaluation depth. Because ephemeral */ /* symbols can be "pulled" up through an evaluation depth, */ /* this routine needs to check through both the previous and */ /* current evaluation depth. */ /****************************************************************/ static void RemoveEphemeralHashNodes( void *theEnv, struct ephemeron **theEphemeralList, GENERIC_HN **theTable, int hashNodeSize, int hashNodeType, int averageContentsSize) { struct ephemeron *edPtr, *lastPtr = NULL, *nextPtr; edPtr = *theEphemeralList; while (edPtr != NULL) { /*======================================================*/ /* Check through previous and current evaluation depth */ /* because these symbols can be interspersed, otherwise */ /* symbols are stored in descending evaluation depth. */ /*======================================================*/ nextPtr = edPtr->next; /*==================================================*/ /* Remove any symbols that have a count of zero and */ /* were added to the ephemeral list at a higher */ /* evaluation depth. */ /*==================================================*/ if (edPtr->associatedValue->count == 0) { RemoveHashNode(theEnv,edPtr->associatedValue,theTable,hashNodeSize,hashNodeType); rtn_struct(theEnv,ephemeron,edPtr); if (lastPtr == NULL) *theEphemeralList = nextPtr; else lastPtr->next = nextPtr; } /*=======================================*/ /* Remove ephemeral status of any symbol */ /* with a count greater than zero. */ /*=======================================*/ else if (edPtr->associatedValue->count > 0) { edPtr->associatedValue->markedEphemeral = FALSE; rtn_struct(theEnv,ephemeron,edPtr); if (lastPtr == NULL) *theEphemeralList = nextPtr; else lastPtr->next = nextPtr; } /*==================================================*/ /* Otherwise keep the symbol in the ephemeral list. */ /*==================================================*/ else { lastPtr = edPtr; } edPtr = nextPtr; } } /*********************************************************/ /* GetSymbolTable: Returns a pointer to the SymbolTable. */ /*********************************************************/ globle SYMBOL_HN **GetSymbolTable( void *theEnv) { return(SymbolData(theEnv)->SymbolTable); } /******************************************************/ /* SetSymbolTable: Sets the value of the SymbolTable. */ /******************************************************/ globle void SetSymbolTable( void *theEnv, SYMBOL_HN **value) { SymbolData(theEnv)->SymbolTable = value; } /*******************************************************/ /* GetFloatTable: Returns a pointer to the FloatTable. */ /*******************************************************/ globle FLOAT_HN **GetFloatTable( void *theEnv) { return(SymbolData(theEnv)->FloatTable); } /****************************************************/ /* SetFloatTable: Sets the value of the FloatTable. */ /****************************************************/ globle void SetFloatTable( void *theEnv, FLOAT_HN **value) { SymbolData(theEnv)->FloatTable = value; } /***********************************************************/ /* GetIntegerTable: Returns a pointer to the IntegerTable. */ /***********************************************************/ globle INTEGER_HN **GetIntegerTable( void *theEnv) { return(SymbolData(theEnv)->IntegerTable); } /********************************************************/ /* SetIntegerTable: Sets the value of the IntegerTable. */ /********************************************************/ globle void SetIntegerTable( void *theEnv, INTEGER_HN **value) { SymbolData(theEnv)->IntegerTable = value; } /*********************************************************/ /* GetBitMapTable: Returns a pointer to the BitMapTable. */ /*********************************************************/ globle BITMAP_HN **GetBitMapTable( void *theEnv) { return(SymbolData(theEnv)->BitMapTable); } /******************************************************/ /* SetBitMapTable: Sets the value of the BitMapTable. */ /******************************************************/ globle void SetBitMapTable( void *theEnv, BITMAP_HN **value) { SymbolData(theEnv)->BitMapTable = value; } /***************************************************************************/ /* GetExternalAddressTable: Returns a pointer to the ExternalAddressTable. */ /***************************************************************************/ globle EXTERNAL_ADDRESS_HN **GetExternalAddressTable( void *theEnv) { return(SymbolData(theEnv)->ExternalAddressTable); } /************************************************************************/ /* SetExternalAddressTable: Sets the value of the ExternalAddressTable. */ /************************************************************************/ globle void SetExternalAddressTable( void *theEnv, EXTERNAL_ADDRESS_HN **value) { SymbolData(theEnv)->ExternalAddressTable = value; } /******************************************************/ /* RefreshSpecialSymbols: Resets the values of the */ /* TrueSymbol, FalseSymbol, Zero, PositiveInfinity, */ /* and NegativeInfinity symbols. */ /******************************************************/ globle void RefreshSpecialSymbols( void *theEnv) { SymbolData(theEnv)->TrueSymbolHN = (void *) FindSymbolHN(theEnv,TRUE_STRING); SymbolData(theEnv)->FalseSymbolHN = (void *) FindSymbolHN(theEnv,FALSE_STRING); SymbolData(theEnv)->PositiveInfinity = (void *) FindSymbolHN(theEnv,POSITIVE_INFINITY_STRING); SymbolData(theEnv)->NegativeInfinity = (void *) FindSymbolHN(theEnv,NEGATIVE_INFINITY_STRING); SymbolData(theEnv)->Zero = (void *) FindLongHN(theEnv,0L); } /***********************************************************/ /* FindSymbolMatches: Finds all symbols in the SymbolTable */ /* which begin with a specified symbol. This function is */ /* used to implement the command completion feature */ /* found in some of the machine specific interfaces. */ /***********************************************************/ globle struct symbolMatch *FindSymbolMatches( void *theEnv, const char *searchString, unsigned *numberOfMatches, size_t *commonPrefixLength) { struct symbolMatch *reply = NULL, *temp; struct symbolHashNode *hashPtr = NULL; size_t searchLength; searchLength = strlen(searchString); *numberOfMatches = 0; while ((hashPtr = GetNextSymbolMatch(theEnv,searchString,searchLength,hashPtr, FALSE,commonPrefixLength)) != NULL) { *numberOfMatches = *numberOfMatches + 1; temp = get_struct(theEnv,symbolMatch); temp->match = hashPtr; temp->next = reply; reply = temp; } return(reply); } /*********************************************************/ /* ReturnSymbolMatches: Returns a set of symbol matches. */ /*********************************************************/ globle void ReturnSymbolMatches( void *theEnv, struct symbolMatch *listOfMatches) { struct symbolMatch *temp; while (listOfMatches != NULL) { temp = listOfMatches->next; rtn_struct(theEnv,symbolMatch,listOfMatches); listOfMatches = temp; } } /***************************************************************/ /* ClearBitString: Initializes the values of a bitmap to zero. */ /***************************************************************/ globle void ClearBitString( void *vTheBitMap, unsigned length) { char *theBitMap = (char *) vTheBitMap; unsigned i; for (i = 0; i < length; i++) theBitMap[i] = '\0'; } /*****************************************************************/ /* GetNextSymbolMatch: Finds the next symbol in the SymbolTable */ /* which begins with a specified symbol. This function is used */ /* to implement the command completion feature found in some */ /* of the machine specific interfaces. */ /*****************************************************************/ globle SYMBOL_HN *GetNextSymbolMatch( void *theEnv, const char *searchString, size_t searchLength, SYMBOL_HN *prevSymbol, int anywhere, size_t *commonPrefixLength) { register unsigned long i; SYMBOL_HN *hashPtr; int flag = TRUE; size_t prefixLength; /*==========================================*/ /* If we're looking anywhere in the string, */ /* then there's no common prefix length. */ /*==========================================*/ if (anywhere && (commonPrefixLength != NULL)) *commonPrefixLength = 0; /*========================================================*/ /* If we're starting the search from the beginning of the */ /* symbol table, the previous symbol argument is NULL. */ /*========================================================*/ if (prevSymbol == NULL) { i = 0; hashPtr = SymbolData(theEnv)->SymbolTable[0]; } /*==========================================*/ /* Otherwise start the search at the symbol */ /* after the last symbol found. */ /*==========================================*/ else { i = prevSymbol->bucket; hashPtr = prevSymbol->next; } /*==============================================*/ /* Search through all the symbol table buckets. */ /*==============================================*/ while (flag) { /*===================================*/ /* Search through all of the entries */ /* in the bucket being examined. */ /*===================================*/ for (; hashPtr != NULL; hashPtr = hashPtr->next) { /*================================================*/ /* Skip symbols that being with ( since these are */ /* typically symbols for internal use. Also skip */ /* any symbols that are marked ephemeral since */ /* these aren't in use. */ /*================================================*/ if ((hashPtr->contents[0] == '(') || (hashPtr->markedEphemeral)) { continue; } /*==================================================*/ /* Two types of matching can be performed: the type */ /* comparing just to the beginning of the string */ /* and the type which looks for the substring */ /* anywhere within the string being examined. */ /*==================================================*/ if (! anywhere) { /*=============================================*/ /* Determine the common prefix length between */ /* the previously found match (if available or */ /* the search string if not) and the symbol */ /* table entry. */ /*=============================================*/ if (prevSymbol != NULL) prefixLength = CommonPrefixLength(prevSymbol->contents,hashPtr->contents); else prefixLength = CommonPrefixLength(searchString,hashPtr->contents); /*===================================================*/ /* If the prefix length is greater than or equal to */ /* the length of the search string, then we've found */ /* a match. If this is the first match, the common */ /* prefix length is set to the length of the first */ /* match, otherwise the common prefix length is the */ /* smallest prefix length found among all matches. */ /*===================================================*/ if (prefixLength >= searchLength) { if (commonPrefixLength != NULL) { if (prevSymbol == NULL) *commonPrefixLength = strlen(hashPtr->contents); else if (prefixLength < *commonPrefixLength) *commonPrefixLength = prefixLength; } return(hashPtr); } } else { if (StringWithinString(hashPtr->contents,searchString) != NULL) { return(hashPtr); } } } /*=================================================*/ /* Move on to the next bucket in the symbol table. */ /*=================================================*/ if (++i >= SYMBOL_HASH_SIZE) flag = FALSE; else hashPtr = SymbolData(theEnv)->SymbolTable[i]; } /*=====================================*/ /* There are no more matching symbols. */ /*=====================================*/ return(NULL); } /**********************************************/ /* StringWithinString: Determines if a string */ /* is contained within another string. */ /**********************************************/ static const char *StringWithinString( const char *cs, const char *ct) { register unsigned i,j,k; for (i = 0 ; cs[i] != '\0' ; i++) { for (j = i , k = 0 ; ct[k] != '\0' && cs[j] == ct[k] ; j++, k++) ; if ((ct[k] == '\0') && (k != 0)) return(cs + i); } return(NULL); } /************************************************/ /* CommonPrefixLength: Determines the length of */ /* the maximumcommon prefix of two strings */ /************************************************/ static size_t CommonPrefixLength( const char *cs, const char *ct) { register unsigned i; for (i = 0 ; (cs[i] != '\0') && (ct[i] != '\0') ; i++) if (cs[i] != ct[i]) break; return(i); } #if BLOAD_AND_BSAVE || CONSTRUCT_COMPILER || BSAVE_INSTANCES /****************************************************************/ /* SetAtomicValueIndices: Sets the bucket values for hash table */ /* entries with an index value that indicates the position of */ /* the hash table in a hash table traversal (e.g. this is the */ /* fifth entry in the hash table. */ /****************************************************************/ globle void SetAtomicValueIndices( void *theEnv, int setAll) { unsigned long count; unsigned long i; SYMBOL_HN *symbolPtr, **symbolArray; FLOAT_HN *floatPtr, **floatArray; INTEGER_HN *integerPtr, **integerArray; BITMAP_HN *bitMapPtr, **bitMapArray; /*===================================*/ /* Set indices for the symbol table. */ /*===================================*/ count = 0; symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { if ((symbolPtr->neededSymbol == TRUE) || setAll) { symbolPtr->bucket = count++; if (symbolPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",13); } } } } /*==================================*/ /* Set indices for the float table. */ /*==================================*/ count = 0; floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { if ((floatPtr->neededFloat == TRUE) || setAll) { floatPtr->bucket = count++; if (floatPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",14); } } } } /*====================================*/ /* Set indices for the integer table. */ /*====================================*/ count = 0; integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { if ((integerPtr->neededInteger == TRUE) || setAll) { integerPtr->bucket = count++; if (integerPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",15); } } } } /*===================================*/ /* Set indices for the bitmap table. */ /*===================================*/ count = 0; bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { if ((bitMapPtr->neededBitMap == TRUE) || setAll) { bitMapPtr->bucket = count++; if (bitMapPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",16); } } } } } /***********************************************************************/ /* RestoreAtomicValueBuckets: Restores the bucket values of hash table */ /* entries to the appropriate values. Normally called to undo the */ /* effects of a call to the SetAtomicValueIndices function. */ /***********************************************************************/ globle void RestoreAtomicValueBuckets( void *theEnv) { unsigned long i; SYMBOL_HN *symbolPtr, **symbolArray; FLOAT_HN *floatPtr, **floatArray; INTEGER_HN *integerPtr, **integerArray; BITMAP_HN *bitMapPtr, **bitMapArray; /*================================================*/ /* Restore the bucket values in the symbol table. */ /*================================================*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { symbolPtr->bucket = i; } } /*===============================================*/ /* Restore the bucket values in the float table. */ /*===============================================*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { floatPtr->bucket = i; } } /*=================================================*/ /* Restore the bucket values in the integer table. */ /*=================================================*/ integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { integerPtr->bucket = i; } } /*================================================*/ /* Restore the bucket values in the bitmap table. */ /*================================================*/ bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { bitMapPtr->bucket = i; } } } #endif /* BLOAD_AND_BSAVE || CONSTRUCT_COMPILER || BSAVE_INSTANCES */ /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle void *EnvFalseSymbol( void *theEnv) { return SymbolData(theEnv)->FalseSymbolHN; } globle void *EnvTrueSymbol( void *theEnv) { return SymbolData(theEnv)->TrueSymbolHN; } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void *AddSymbol( const char *str) { return EnvAddSymbol(GetCurrentEnvironment(),str); } globle void *AddLong( long long number) { return EnvAddLong(GetCurrentEnvironment(),number); } globle void *AddDouble( double number) { return EnvAddDouble(GetCurrentEnvironment(),number); } globle void *FalseSymbol() { return SymbolData(GetCurrentEnvironment())->FalseSymbolHN; } globle void *TrueSymbol() { return SymbolData(GetCurrentEnvironment())->TrueSymbolHN; } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/._tmpltcmp.h0000755000175000017500000000040712373754231016467 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._bsave.c0000755000175000017500000000040712375756163015732 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlbin.c0000755000175000017500000004445512373753376016221 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Moved WatchGlobals global to defglobalData. */ /* */ /*************************************************************/ #define _GLOBLBIN_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT && (BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "multifld.h" #include "globldef.h" #include "bload.h" #include "bsave.h" #include "moduldef.h" #include "globlbsc.h" #include "envrnmnt.h" #include "globlbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorageDefglobals(void *); static void BloadBinaryItem(void *); static void UpdateDefglobalModule(void *,void *,long); static void UpdateDefglobal(void *,void *,long); static void ClearBload(void *); static void DeallocateDefglobalBloadData(void *); /*********************************************/ /* DefglobalBinarySetup: Installs the binary */ /* save/load feature for the defglobals. */ /*********************************************/ globle void DefglobalBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,GLOBLBIN_DATA,sizeof(struct defglobalBinaryData),DeallocateDefglobalBloadData); #if (BLOAD_AND_BSAVE || BLOAD) AddAfterBloadFunction(theEnv,"defglobal",ResetDefglobals,50); #endif #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defglobal",0,BsaveFind,NULL, BsaveStorage,BsaveBinaryItem, BloadStorageDefglobals,BloadBinaryItem, ClearBload); #endif #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"defglobal",0,NULL,NULL,NULL,NULL, BloadStorageDefglobals,BloadBinaryItem, ClearBload); #endif } /*********************************************************/ /* DeallocateDefglobalBloadData: Deallocates environment */ /* data for the defglobal bsave functionality. */ /*********************************************************/ static void DeallocateDefglobalBloadData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) size_t space; long i; for (i = 0; i < DefglobalBinaryData(theEnv)->NumberOfDefglobals; i++) { if (DefglobalBinaryData(theEnv)->DefglobalArray[i].current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) DefglobalBinaryData(theEnv)->DefglobalArray[i].current.value); } } space = DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct defglobal); if (space != 0) { genfree(theEnv,(void *) DefglobalBinaryData(theEnv)->DefglobalArray,space); } space = DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct defglobalModule); if (space != 0) { genfree(theEnv,(void *) DefglobalBinaryData(theEnv)->ModuleArray,space); } #endif } #if BLOAD_AND_BSAVE /****************************************************/ /* BsaveFind: Counts the number of data structures */ /* which must be saved in the binary image for */ /* the defglobals in the current environment. */ /****************************************************/ static void BsaveFind( void *theEnv) { struct defglobal *defglobalPtr; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobalModules); SaveBloadCount(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobals); /*============================================*/ /* Set the count of defglobals and defglobals */ /* module data structures to zero. */ /*============================================*/ DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; DefglobalBinaryData(theEnv)->NumberOfDefglobalModules = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*================================================*/ /* Set the current module to the module being */ /* examined and increment the number of defglobal */ /* modules encountered. */ /*================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); DefglobalBinaryData(theEnv)->NumberOfDefglobalModules++; /*====================================================*/ /* Loop through each defglobal in the current module. */ /*====================================================*/ for (defglobalPtr = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); defglobalPtr != NULL; defglobalPtr = (struct defglobal *) EnvGetNextDefglobal(theEnv,defglobalPtr)) { /*======================================================*/ /* Initialize the construct header for the binary save. */ /*======================================================*/ MarkConstructHeaderNeededItems(&defglobalPtr->header,DefglobalBinaryData(theEnv)->NumberOfDefglobals++); } } } /*****************************************************/ /* BsaveStorage: Writes out storage requirements for */ /* all defglobal structures to the binary file */ /*****************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { size_t space; /*===========================================================*/ /* Only two data structures are saved as part of a defglobal */ /* binary image: the defglobal data structure and the */ /* defglobalModule data structure. */ /*===========================================================*/ space = sizeof(long) * 2; GenWrite(&space,sizeof(size_t),fp); GenWrite(&DefglobalBinaryData(theEnv)->NumberOfDefglobals,sizeof(long int),fp); GenWrite(&DefglobalBinaryData(theEnv)->NumberOfDefglobalModules,sizeof(long int),fp); } /*********************************************/ /* BsaveBinaryItem: Writes out all defglobal */ /* structures to the binary file */ /*********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { size_t space; struct defglobal *theDefglobal; struct bsaveDefglobal newDefglobal; struct defmodule *theModule; struct bsaveDefglobalModule tempDefglobalModule; struct defglobalModule *theModuleItem; /*==========================================================*/ /* Write out the amount of space taken up by the defglobal */ /* and defglobalModule data structures in the binary image. */ /*==========================================================*/ space = DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct bsaveDefglobal) + (DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct bsaveDefglobalModule)); GenWrite(&space,sizeof(size_t),fp); /*=================================================*/ /* Write out each defglobal module data structure. */ /*=================================================*/ DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct defglobalModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&tempDefglobalModule.header, &theModuleItem->header); GenWrite(&tempDefglobalModule,sizeof(struct bsaveDefglobalModule),fp); } /*===========================*/ /* Write out each defglobal. */ /*===========================*/ DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); theDefglobal != NULL; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { AssignBsaveConstructHeaderVals(&newDefglobal.header, &theDefglobal->header); newDefglobal.initial = HashedExpressionIndex(theEnv,theDefglobal->initial); GenWrite(&newDefglobal,sizeof(struct bsaveDefglobal),fp); } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of defglobals and defglobal modules in the binary image */ /* (these were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobalModules); RestoreBloadCount(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobals); } #endif /* BLOAD_AND_BSAVE */ /***********************************************/ /* BloadStorageDefglobals: Allocates space for */ /* the defglobals used by this binary image. */ /***********************************************/ static void BloadStorageDefglobals( void *theEnv) { size_t space; /*=======================================================*/ /* Determine the number of defglobal and defglobalModule */ /* data structures to be read. */ /*=======================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobals,sizeof(long int)); GenReadBinary(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobalModules,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* defglobalModule data structures. */ /*===================================*/ if (DefglobalBinaryData(theEnv)->NumberOfDefglobalModules == 0) { DefglobalBinaryData(theEnv)->DefglobalArray = NULL; DefglobalBinaryData(theEnv)->ModuleArray = NULL; } space = DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct defglobalModule); DefglobalBinaryData(theEnv)->ModuleArray = (struct defglobalModule *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* defglobal data structures. */ /*===================================*/ if (DefglobalBinaryData(theEnv)->NumberOfDefglobals == 0) { DefglobalBinaryData(theEnv)->DefglobalArray = NULL; return; } space = (DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct defglobal)); DefglobalBinaryData(theEnv)->DefglobalArray = (struct defglobal *) genalloc(theEnv,space); } /******************************************************/ /* BloadBinaryItem: Loads and refreshes the defglobal */ /* constructs used by this binary image. */ /******************************************************/ static void BloadBinaryItem( void *theEnv) { size_t space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); /*=============================================*/ /* Read in the defglobalModule data structures */ /* and refresh the pointers. */ /*=============================================*/ BloadandRefresh(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobalModules, sizeof(struct bsaveDefglobalModule), UpdateDefglobalModule); /*=======================================*/ /* Read in the defglobal data structures */ /* and refresh the pointers. */ /*=======================================*/ BloadandRefresh(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobals, sizeof(struct bsaveDefglobal), UpdateDefglobal); } /************************************************/ /* UpdateDefglobalModule: Bload refresh routine */ /* for defglobal module data structures. */ /************************************************/ static void UpdateDefglobalModule( void *theEnv, void *buf, long obji) { struct bsaveDefglobalModule *bdmPtr; bdmPtr = (struct bsaveDefglobalModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DefglobalBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct defglobal), (void *) DefglobalBinaryData(theEnv)->DefglobalArray); } /******************************************/ /* UpdateDefglobal: Bload refresh routine */ /* for defglobal data structures. */ /******************************************/ static void UpdateDefglobal( void *theEnv, void *buf, long obji) { struct bsaveDefglobal *bdp; bdp = (struct bsaveDefglobal *) buf; UpdateConstructHeader(theEnv,&bdp->header,&DefglobalBinaryData(theEnv)->DefglobalArray[obji].header, (int) sizeof(struct defglobalModule),(void *) DefglobalBinaryData(theEnv)->ModuleArray, (int) sizeof(struct defglobal),(void *) DefglobalBinaryData(theEnv)->DefglobalArray); #if DEBUGGING_FUNCTIONS DefglobalBinaryData(theEnv)->DefglobalArray[obji].watch = DefglobalData(theEnv)->WatchGlobals; #endif DefglobalBinaryData(theEnv)->DefglobalArray[obji].initial = HashedExpressionPointer(bdp->initial); DefglobalBinaryData(theEnv)->DefglobalArray[obji].current.type = RVOID; } /***************************************/ /* ClearBload: Defglobal clear routine */ /* when a binary load is in effect. */ /***************************************/ static void ClearBload( void *theEnv) { long i; size_t space; /*=======================================================*/ /* Decrement in use counters for atomic values contained */ /* in the construct headers. Also decrement data */ /* structures used to store the defglobal's value. */ /*=======================================================*/ for (i = 0; i < DefglobalBinaryData(theEnv)->NumberOfDefglobals; i++) { UnmarkConstructHeader(theEnv,&DefglobalBinaryData(theEnv)->DefglobalArray[i].header); ValueDeinstall(theEnv,&(DefglobalBinaryData(theEnv)->DefglobalArray[i].current)); if (DefglobalBinaryData(theEnv)->DefglobalArray[i].current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) DefglobalBinaryData(theEnv)->DefglobalArray[i].current.value); } } /*==============================================================*/ /* Deallocate the space used for the defglobal data structures. */ /*==============================================================*/ space = DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct defglobal); if (space != 0) genfree(theEnv,(void *) DefglobalBinaryData(theEnv)->DefglobalArray,space); DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; /*=====================================================================*/ /* Deallocate the space used for the defglobal module data structures. */ /*=====================================================================*/ space = DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct defglobalModule); if (space != 0) genfree(theEnv,(void *) DefglobalBinaryData(theEnv)->ModuleArray,space); DefglobalBinaryData(theEnv)->NumberOfDefglobalModules = 0; } /********************************************************/ /* BloadDefglobalModuleReference: Returns the defglobal */ /* module pointer for using with the bload function. */ /********************************************************/ globle void *BloadDefglobalModuleReference( void *theEnv, int theIndex) { return ((void *) &DefglobalBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFGLOBAL_CONSTRUCT && (BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY) && (! RUN_TIME) */ clips_core_source_630/core/inscom.c0000755000175000017500000016221412500146515015672 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* INSTANCE COMMAND MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Kernel Interface Commands for Instances */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Loading a binary instance file from a run-time */ /* program caused a bus error. DR0866 */ /* */ /* Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "classinf.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "evaluatn.h" #include "insfile.h" #include "insfun.h" #include "insmngr.h" #include "insmoddp.h" #include "insmult.h" #include "inspsr.h" #include "lgcldpnd.h" #include "memalloc.h" #include "msgcom.h" #include "msgfun.h" #include "router.h" #include "strngrtr.h" #include "sysdep.h" #include "utility.h" #include "commline.h" #define _INSCOM_SOURCE_ #include "inscom.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define ALL_QUALIFIER "inherit" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS static long ListInstancesInModule(void *,int,const char *,const char *,intBool,intBool); static long TabulateInstances(void *,int,const char *,DEFCLASS *,intBool,intBool); #endif static void PrintInstance(void *,const char *,INSTANCE_TYPE *,const char *); static INSTANCE_SLOT *FindISlotByName(void *,INSTANCE_TYPE *,const char *); static void DeallocateInstanceData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************* NAME : SetupInstances DESCRIPTION : Initializes instance Hash Table, Function Parsers, and Data Structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *********************************************************/ globle void SetupInstances( void *theEnv) { struct patternEntityRecord instanceInfo = { { "INSTANCE_ADDRESS", INSTANCE_ADDRESS,0,0,0, PrintInstanceName, PrintInstanceLongForm, EnvUnmakeInstance, NULL, EnvGetNextInstance, EnvDecrementInstanceCount, EnvIncrementInstanceCount, NULL,NULL,NULL,NULL,NULL }, #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM DecrementObjectBasisCount, IncrementObjectBasisCount, MatchObjectFunction, NetworkSynchronized, InstanceIsDeleted #else NULL,NULL,NULL,NULL,NULL #endif }; INSTANCE_TYPE dummyInstance = { { NULL, NULL, 0, 0L }, NULL, NULL, 0, 1, 0, 0, 0, NULL, 0, 0, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL }; AllocateEnvironmentData(theEnv,INSTANCE_DATA,sizeof(struct instanceData),DeallocateInstanceData); InstanceData(theEnv)->MkInsMsgPass = TRUE; memcpy(&InstanceData(theEnv)->InstanceInfo,&instanceInfo,sizeof(struct patternEntityRecord)); dummyInstance.header.theInfo = &InstanceData(theEnv)->InstanceInfo; memcpy(&InstanceData(theEnv)->DummyInstance,&dummyInstance,sizeof(INSTANCE_TYPE)); InitializeInstanceTable(theEnv); InstallPrimitive(theEnv,(struct entityRecord *) &InstanceData(theEnv)->InstanceInfo,INSTANCE_ADDRESS); #if ! RUN_TIME #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM EnvDefineFunction2(theEnv,"initialize-instance",'u', PTIEF InactiveInitializeInstance,"InactiveInitializeInstance",NULL); EnvDefineFunction2(theEnv,"active-initialize-instance",'u', PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL); AddFunctionParser(theEnv,"active-initialize-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF InactiveMakeInstance,"InactiveMakeInstance",NULL); EnvDefineFunction2(theEnv,"active-make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL); AddFunctionParser(theEnv,"active-make-instance",ParseInitializeInstance); #else EnvDefineFunction2(theEnv,"initialize-instance",'u', PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL); EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL); #endif AddFunctionParser(theEnv,"initialize-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"make-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"init-slots",'u',PTIEF InitSlotsCommand,"InitSlotsCommand","00"); EnvDefineFunction2(theEnv,"delete-instance",'b',PTIEF DeleteInstanceCommand, "DeleteInstanceCommand","00"); EnvDefineFunction2(theEnv,"(create-instance)",'b',PTIEF CreateInstanceHandler, "CreateInstanceHandler","00"); EnvDefineFunction2(theEnv,"unmake-instance",'b',PTIEF UnmakeInstanceCommand, "UnmakeInstanceCommand","1*e"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"instances",'v',PTIEF InstancesCommand,"InstancesCommand","*3w"); EnvDefineFunction2(theEnv,"ppinstance",'v',PTIEF PPInstanceCommand,"PPInstanceCommand","00"); #endif EnvDefineFunction2(theEnv,"symbol-to-instance-name",'u', PTIEF SymbolToInstanceName,"SymbolToInstanceName","11w"); EnvDefineFunction2(theEnv,"instance-name-to-symbol",'w', PTIEF InstanceNameToSymbol,"InstanceNameToSymbol","11p"); EnvDefineFunction2(theEnv,"instance-address",'u',PTIEF InstanceAddressCommand, "InstanceAddressCommand","12eep"); EnvDefineFunction2(theEnv,"instance-addressp",'b',PTIEF InstanceAddressPCommand, "InstanceAddressPCommand","11"); EnvDefineFunction2(theEnv,"instance-namep",'b',PTIEF InstanceNamePCommand, "InstanceNamePCommand","11"); EnvDefineFunction2(theEnv,"instance-name",'u',PTIEF InstanceNameCommand, "InstanceNameCommand","11e"); EnvDefineFunction2(theEnv,"instancep",'b',PTIEF InstancePCommand,"InstancePCommand","11"); EnvDefineFunction2(theEnv,"instance-existp",'b',PTIEF InstanceExistPCommand, "InstanceExistPCommand","11e"); EnvDefineFunction2(theEnv,"class",'u',PTIEF ClassCommand,"ClassCommand","11"); SetupInstanceModDupCommands(theEnv); /* SetupInstanceFileCommands(theEnv); DR0866 */ SetupInstanceMultifieldCommands(theEnv); #endif SetupInstanceFileCommands(theEnv); /* DR0866 */ AddCleanupFunction(theEnv,"instances",CleanupInstances,0); EnvAddResetFunction(theEnv,"instances",DestroyAllInstances,60); } /***************************************/ /* DeallocateInstanceData: Deallocates */ /* environment data for instances. */ /***************************************/ static void DeallocateInstanceData( void *theEnv) { INSTANCE_TYPE *tmpIPtr, *nextIPtr; long i; INSTANCE_SLOT *sp; IGARBAGE *tmpGPtr, *nextGPtr; struct patternMatch *theMatch, *tmpMatch; /*=================================*/ /* Remove the instance hash table. */ /*=================================*/ rm(theEnv,InstanceData(theEnv)->InstanceTable, (int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE)); /*=======================*/ /* Return all instances. */ /*=======================*/ tmpIPtr = InstanceData(theEnv)->InstanceList; while (tmpIPtr != NULL) { nextIPtr = tmpIPtr->nxtList; theMatch = (struct patternMatch *) tmpIPtr->partialMatchList; while (theMatch != NULL) { tmpMatch = theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = tmpMatch; } #if DEFRULE_CONSTRUCT ReturnEntityDependencies(theEnv,(struct patternEntity *) tmpIPtr); #endif for (i = 0 ; i < tmpIPtr->cls->instanceSlotCount ; i++) { sp = tmpIPtr->slotAddresses[i]; if ((sp == &sp->desc->sharedValue) ? (--sp->desc->sharedCount == 0) : TRUE) { if (sp->desc->multiple) { ReturnMultifield(theEnv,(MULTIFIELD_PTR) sp->value); } } } if (tmpIPtr->cls->instanceSlotCount != 0) { rm(theEnv,(void *) tmpIPtr->slotAddresses, (tmpIPtr->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *))); if (tmpIPtr->cls->localInstanceSlotCount != 0) { rm(theEnv,(void *) tmpIPtr->slots, (tmpIPtr->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT))); } } rtn_struct(theEnv,instance,tmpIPtr); tmpIPtr = nextIPtr; } /*===============================*/ /* Get rid of garbage instances. */ /*===============================*/ tmpGPtr = InstanceData(theEnv)->InstanceGarbageList; while (tmpGPtr != NULL) { nextGPtr = tmpGPtr->nxt; rtn_struct(theEnv,instance,tmpGPtr->ins); rtn_struct(theEnv,igarbage,tmpGPtr); tmpGPtr = nextGPtr; } } /******************************************************************* NAME : EnvDeleteInstance DESCRIPTION : DIRECTLY removes a named instance from the hash table and its class's instance list INPUTS : The instance address (NULL to delete all instances) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Instance is deallocated NOTES : C interface for deleting instances *******************************************************************/ globle intBool EnvDeleteInstance( void *theEnv, void *iptr) { INSTANCE_TYPE *ins,*itmp; int success = 1; if (iptr != NULL) return(QuashInstance(theEnv,(INSTANCE_TYPE *) iptr)); ins = InstanceData(theEnv)->InstanceList; while (ins != NULL) { itmp = ins; ins = ins->nxtList; if (QuashInstance(theEnv,(INSTANCE_TYPE *) itmp) == 0) success = 0; } if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } return(success); } /******************************************************************* NAME : EnvUnmakeInstance DESCRIPTION : Removes a named instance via message-passing INPUTS : The instance address (NULL to delete all instances) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Instance is deallocated NOTES : C interface for deleting instances *******************************************************************/ globle intBool EnvUnmakeInstance( void *theEnv, void *iptr) { INSTANCE_TYPE *ins; int success = 1,svmaintain; svmaintain = InstanceData(theEnv)->MaintainGarbageInstances; InstanceData(theEnv)->MaintainGarbageInstances = TRUE; ins = (INSTANCE_TYPE *) iptr; if (ins != NULL) { if (ins->garbage) success = 0; else { DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL); if (ins->garbage == 0) success = 0; } } else { ins = InstanceData(theEnv)->InstanceList; while (ins != NULL) { DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL); if (ins->garbage == 0) success = 0; ins = ins->nxtList; while ((ins != NULL) ? ins->garbage : FALSE) ins = ins->nxtList; } } InstanceData(theEnv)->MaintainGarbageInstances = svmaintain; CleanupInstances(theEnv); if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } return(success); } #if DEBUGGING_FUNCTIONS /******************************************************************* NAME : InstancesCommand DESCRIPTION : Lists all instances associated with a particular class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (instances [ [inherit]]) *******************************************************************/ globle void InstancesCommand( void *theEnv) { int argno, inheritFlag = FALSE; void *theDefmodule; const char *className = NULL; DATA_OBJECT temp; theDefmodule = (void *) EnvGetCurrentModule(theEnv); argno = EnvRtnArgCount(theEnv); if (argno > 0) { if (EnvArgTypeCheck(theEnv,"instances",1,SYMBOL,&temp) == FALSE) return; theDefmodule = EnvFindDefmodule(theEnv,DOToString(temp)); if ((theDefmodule != NULL) ? FALSE : (strcmp(DOToString(temp),"*") != 0)) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"instances",1,"defmodule name"); return; } if (argno > 1) { if (EnvArgTypeCheck(theEnv,"instances",2,SYMBOL,&temp) == FALSE) return; className = DOToString(temp); if (LookupDefclassAnywhere(theEnv,(struct defmodule *) theDefmodule,className) == NULL) { if (strcmp(className,"*") == 0) className = NULL; else { ClassExistError(theEnv,"instances",className); return; } } if (argno > 2) { if (EnvArgTypeCheck(theEnv,"instances",3,SYMBOL,&temp) == FALSE) return; if (strcmp(DOToString(temp),ALL_QUALIFIER) != 0) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"instances",3,"keyword \"inherit\""); return; } inheritFlag = TRUE; } } } EnvInstances(theEnv,WDISPLAY,theDefmodule,className,inheritFlag); } /******************************************************** NAME : PPInstanceCommand DESCRIPTION : Displays the current slot-values of an instance INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (ppinstance ) ********************************************************/ globle void PPInstanceCommand( void *theEnv) { INSTANCE_TYPE *ins; if (CheckCurrentMessage(theEnv,"ppinstance",TRUE) == FALSE) return; ins = GetActiveInstance(theEnv); if (ins->garbage == 1) return; PrintInstance(theEnv,WDISPLAY,ins,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } /*************************************************************** NAME : EnvInstances DESCRIPTION : Lists instances of classes INPUTS : 1) The logical name for the output 2) Address of the module (NULL for all classes) 3) Name of the class (NULL for all classes in specified module) 4) A flag indicating whether to print instances of subclasses or not RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None **************************************************************/ globle void EnvInstances( void *theEnv, const char *logicalName, void *theVModule, const char *className, int inheritFlag) { int id; struct defmodule *theModule; long count = 0L; /* =========================================== Grab a traversal id to avoid printing out instances twice due to multiple inheritance =========================================== */ if ((id = GetTraversalID(theEnv)) == -1) return; SaveCurrentModule(theEnv); /* ==================================== For all modules, print out instances of specified class(es) ==================================== */ if (theVModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { if (GetHaltExecution(theEnv) == TRUE) { RestoreCurrentModule(theEnv); ReleaseTraversalID(theEnv); return; } EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); EnvSetCurrentModule(theEnv,(void *) theModule); count += ListInstancesInModule(theEnv,id,logicalName,className,inheritFlag,TRUE); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } } /* ==================================== For the specified module, print out instances of the specified class(es) ==================================== */ else { EnvSetCurrentModule(theEnv,(void *) theVModule); count = ListInstancesInModule(theEnv,id,logicalName,className,inheritFlag,FALSE); } RestoreCurrentModule(theEnv); ReleaseTraversalID(theEnv); if (EvaluationData(theEnv)->HaltExecution == FALSE) PrintTally(theEnv,logicalName,count,"instance","instances"); } #endif /* DEBUGGING_FUNCTIONS */ /********************************************************* NAME : EnvMakeInstance DESCRIPTION : C Interface for creating and initializing a class instance INPUTS : The make-instance call string, e.g. "([bill] of man (age 34))" RETURNS : The instance address if instance created, NULL otherwise SIDE EFFECTS : Creates the instance and returns the result in caller's buffer NOTES : None *********************************************************/ globle void *EnvMakeInstance( void *theEnv, const char *mkstr) { const char *router = "***MKINS***"; struct token tkn; EXPRESSION *top; DATA_OBJECT result; result.type = SYMBOL; result.value = EnvFalseSymbol(theEnv); if (OpenStringSource(theEnv,router,mkstr,0) == 0) return(NULL); GetToken(theEnv,router,&tkn); if (tkn.type == LPAREN) { top = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); if (ParseSimpleInstance(theEnv,top,router) != NULL) { GetToken(theEnv,router,&tkn); if (tkn.type == STOP) { ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,&result); ExpressionDeinstall(theEnv,top); } else SyntaxErrorMessage(theEnv,"instance definition"); ReturnExpression(theEnv,top); } } else SyntaxErrorMessage(theEnv,"instance definition"); CloseStringSource(theEnv,router); if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } if ((result.type == SYMBOL) && (result.value == EnvFalseSymbol(theEnv))) return(NULL); return((void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) result.value)); } /*************************************************************** NAME : EnvCreateRawInstance DESCRIPTION : Creates an empty of instance of the specified class. No slot-overrides or class defaults are applied. INPUTS : 1) Address of class 2) Name of the new instance RETURNS : The instance address if instance created, NULL otherwise SIDE EFFECTS : Old instance of same name deleted (if possible) NOTES : None ***************************************************************/ globle void *EnvCreateRawInstance( void *theEnv, void *cptr, const char *iname) { return((void *) BuildInstance(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,iname),(DEFCLASS *) cptr,FALSE)); } /*************************************************************************** NAME : EnvFindInstance DESCRIPTION : Looks up a specified instance in the instance hash table INPUTS : Name-string of the instance RETURNS : The address of the found instance, NULL otherwise SIDE EFFECTS : None NOTES : None ***************************************************************************/ globle void *EnvFindInstance( void *theEnv, void *theModule, const char *iname, unsigned searchImports) { SYMBOL_HN *isym; isym = FindSymbolHN(theEnv,iname); if (isym == NULL) return(NULL); if (theModule == NULL) theModule = (void *) EnvGetCurrentModule(theEnv); return((void *) FindInstanceInModule(theEnv,isym,(struct defmodule *) theModule, ((struct defmodule *) EnvGetCurrentModule(theEnv)),searchImports)); } /*************************************************************************** NAME : EnvValidInstanceAddress DESCRIPTION : Determines if an instance address is still valid INPUTS : Instance address RETURNS : 1 if the address is still valid, 0 otherwise SIDE EFFECTS : None NOTES : None ***************************************************************************/ globle int EnvValidInstanceAddress( void *theEnv, void *iptr) { #if MAC_XCD #pragma unused(theEnv) #endif return((((INSTANCE_TYPE *) iptr)->garbage == 0) ? 1 : 0); } /*************************************************** NAME : EnvDirectGetSlot DESCRIPTION : Gets a slot value INPUTS : 1) Instance address 2) Slot name 3) Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void EnvDirectGetSlot( void *theEnv, void *ins, const char *sname, DATA_OBJECT *result) { INSTANCE_SLOT *sp; if (((INSTANCE_TYPE *) ins)->garbage == 1) { SetEvaluationError(theEnv,TRUE); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } sp = FindISlotByName(theEnv,(INSTANCE_TYPE *) ins,sname); if (sp == NULL) { SetEvaluationError(theEnv,TRUE); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,result); CallPeriodicTasks(theEnv); } } /********************************************************* NAME : EnvDirectPutSlot DESCRIPTION : Gets a slot value INPUTS : 1) Instance address 2) Slot name 3) Caller's new value buffer RETURNS : TRUE if put successful, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle int EnvDirectPutSlot( void *theEnv, void *ins, const char *sname, DATA_OBJECT *val) { INSTANCE_SLOT *sp; DATA_OBJECT junk; if ((((INSTANCE_TYPE *) ins)->garbage == 1) || (val == NULL)) { SetEvaluationError(theEnv,TRUE); return(FALSE); } sp = FindISlotByName(theEnv,(INSTANCE_TYPE *) ins,sname); if (sp == NULL) { SetEvaluationError(theEnv,TRUE); return(FALSE); } if (PutSlotValue(theEnv,(INSTANCE_TYPE *) ins,sp,val,&junk,"external put")) { if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } return(TRUE); } return(FALSE); } /*************************************************** NAME : GetInstanceName DESCRIPTION : Returns name of instance INPUTS : Pointer to instance RETURNS : Name of instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle const char *EnvGetInstanceName( void *theEnv, void *iptr) { #if MAC_XCD #pragma unused(theEnv) #endif if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return(ValueToString(((INSTANCE_TYPE *) iptr)->name)); } /*************************************************** NAME : EnvGetInstanceClass DESCRIPTION : Returns class of instance INPUTS : Pointer to instance RETURNS : Pointer to class of instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvGetInstanceClass( void *theEnv, void *iptr) { #if MAC_XCD #pragma unused(theEnv) #endif if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return((void *) ((INSTANCE_TYPE *) iptr)->cls); } /*************************************************** NAME : GetGlobalNumberOfInstances DESCRIPTION : Returns the total number of instances in all modules INPUTS : None RETURNS : The instance count SIDE EFFECTS : None NOTES : None ***************************************************/ globle unsigned long GetGlobalNumberOfInstances( void *theEnv) { return(InstanceData(theEnv)->GlobalNumberOfInstances); } /*************************************************** NAME : EnvGetNextInstance DESCRIPTION : Returns next instance in list (or first instance in list) INPUTS : Pointer to previous instance (or NULL to get first instance) RETURNS : The next instance or first instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvGetNextInstance( void *theEnv, void *iptr) { if (iptr == NULL) return((void *) InstanceData(theEnv)->InstanceList); if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return((void *) ((INSTANCE_TYPE *) iptr)->nxtList); } /*************************************************** NAME : GetNextInstanceInScope DESCRIPTION : Returns next instance in list (or first instance in list) which class is in scope INPUTS : Pointer to previous instance (or NULL to get first instance) RETURNS : The next instance or first instance which class is in scope of the current module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *GetNextInstanceInScope( void *theEnv, void *iptr) { INSTANCE_TYPE *ins = (INSTANCE_TYPE *) iptr; if (ins == NULL) ins = InstanceData(theEnv)->InstanceList; else if (ins->garbage) return(NULL); else ins = ins->nxtList; while (ins != NULL) { if (DefclassInScope(theEnv,ins->cls,NULL)) return((void *) ins); ins = ins->nxtList; } return(NULL); } /*************************************************** NAME : EnvGetNextInstanceInClass DESCRIPTION : Finds next instance of class (or first instance of class) INPUTS : 1) Class address 2) Instance address (NULL to get first instance) RETURNS : The next or first class instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvGetNextInstanceInClass( void *theEnv, void *cptr, void *iptr) { #if MAC_XCD #pragma unused(theEnv) #endif if (iptr == NULL) return((void *) ((DEFCLASS *) cptr)->instanceList); if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return((void *) ((INSTANCE_TYPE *) iptr)->nxtClass); } /*************************************************** NAME : EnvGetNextInstanceInClassAndSubclasses DESCRIPTION : Finds next instance of class (or first instance of class) and all of its subclasses INPUTS : 1) Class address 2) Instance address (NULL to get first instance) RETURNS : The next or first class instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvGetNextInstanceInClassAndSubclasses( void *theEnv, void **cptr, void *iptr, DATA_OBJECT *iterationInfo) { INSTANCE_TYPE *nextInstance; DEFCLASS *theClass; theClass = (DEFCLASS *) *cptr; if (iptr == NULL) { ClassSubclassAddresses(theEnv,theClass,iterationInfo,TRUE); nextInstance = theClass->instanceList; } else if (((INSTANCE_TYPE *) iptr)->garbage == 1) { nextInstance = NULL; } else { nextInstance = ((INSTANCE_TYPE *) iptr)->nxtClass; } while ((nextInstance == NULL) && (GetpDOBegin(iterationInfo) <= GetpDOEnd(iterationInfo))) { theClass = (struct defclass *) GetMFValue(DOPToPointer(iterationInfo), GetpDOBegin(iterationInfo)); *cptr = theClass; SetpDOBegin(iterationInfo,GetpDOBegin(iterationInfo) + 1); nextInstance = theClass->instanceList; } return(nextInstance); } /*************************************************** NAME : EnvGetInstancePPForm DESCRIPTION : Writes slot names and values to caller's buffer INPUTS : 1) Caller's buffer 2) Size of buffer (not including space for terminating '\0') 3) Instance address RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer written NOTES : None ***************************************************/ globle void EnvGetInstancePPForm( void *theEnv, char *buf, size_t buflen, void *iptr) { const char *pbuf = "***InstancePPForm***"; if (((INSTANCE_TYPE *) iptr)->garbage == 1) return; if (OpenStringDestination(theEnv,pbuf,buf,buflen+1) == 0) return; PrintInstance(theEnv,pbuf,(INSTANCE_TYPE *) iptr," "); CloseStringDestination(theEnv,pbuf); } /********************************************************* NAME : ClassCommand DESCRIPTION : Returns the class of an instance INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (class ) Can also be called by (type ) if you have generic functions installed *********************************************************/ globle void ClassCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; const char *func; DATA_OBJECT temp; func = ValueToString(((struct FunctionDefinition *) EvaluationData(theEnv)->CurrentExpression->value)->callFunctionName); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return; } result->value = (void *) GetDefclassNamePointer((void *) ins->cls); } else if (temp.type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) { NoInstanceError(theEnv,ValueToString(temp.value),func); return; } result->value = (void *) GetDefclassNamePointer((void *) ins->cls); } else { switch (temp.type) { case INTEGER : case FLOAT : case SYMBOL : case STRING : case MULTIFIELD : case EXTERNAL_ADDRESS : case FACT_ADDRESS : result->value = (void *) GetDefclassNamePointer((void *) DefclassData(theEnv)->PrimitiveClassMap[temp.type]); return; default : PrintErrorID(theEnv,"INSCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Undefined type in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } } } /****************************************************** NAME : CreateInstanceHandler DESCRIPTION : Message handler called after instance creation INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : None NOTES : Does nothing. Provided so it can be overridden. ******************************************************/ globle intBool CreateInstanceHandler( void *theEnv) { #if MAC_XCD #pragma unused(theEnv) #endif return(TRUE); } /****************************************************** NAME : DeleteInstanceCommand DESCRIPTION : Removes a named instance from the hash table and its class's instance list INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Instance is deallocated NOTES : This is an internal function that only be called by a handler ******************************************************/ globle intBool DeleteInstanceCommand( void *theEnv) { if (CheckCurrentMessage(theEnv,"delete-instance",TRUE)) return(QuashInstance(theEnv,GetActiveInstance(theEnv))); return(FALSE); } /******************************************************************** NAME : UnmakeInstanceCommand DESCRIPTION : Uses message-passing to delete the specified instance INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Instance is deallocated NOTES : Syntax: (unmake-instance + | *) ********************************************************************/ globle intBool UnmakeInstanceCommand( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT theResult; INSTANCE_TYPE *ins; int argNumber = 1,rtn = TRUE; theArgument = GetFirstArgument(); while (theArgument != NULL) { EvaluateExpression(theEnv,theArgument,&theResult); if ((theResult.type == INSTANCE_NAME) || (theResult.type == SYMBOL)) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) theResult.value); if ((ins == NULL) ? (strcmp(DOToString(theResult),"*") != 0) : FALSE) { NoInstanceError(theEnv,DOToString(theResult),"unmake-instance"); return(FALSE); } } else if (theResult.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) theResult.value; if (ins->garbage) { StaleInstanceAddress(theEnv,"unmake-instance",0); SetEvaluationError(theEnv,TRUE); return(FALSE); } } else { ExpectedTypeError1(theEnv,"unmake-instance",argNumber,"instance-address, instance-name, or the symbol *"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (EnvUnmakeInstance(theEnv,ins) == FALSE) rtn = FALSE; if (ins == NULL) return(rtn); argNumber++; theArgument = GetNextArgument(theArgument); } return(rtn); } /***************************************************************** NAME : SymbolToInstanceName DESCRIPTION : Converts a symbol from type SYMBOL to type INSTANCE_NAME INPUTS : The address of the value buffer RETURNS : The new INSTANCE_NAME symbol SIDE EFFECTS : None NOTES : H/L Syntax : (symbol-to-instance-name ) *****************************************************************/ globle void SymbolToInstanceName( void *theEnv, DATA_OBJECT *result) { if (EnvArgTypeCheck(theEnv,"symbol-to-instance-name",1,SYMBOL,result) == FALSE) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } SetpType(result,INSTANCE_NAME); } /***************************************************************** NAME : InstanceNameToSymbol DESCRIPTION : Converts a symbol from type INSTANCE_NAME to type SYMBOL INPUTS : None RETURNS : Symbol FALSE on errors - or converted instance name SIDE EFFECTS : None NOTES : H/L Syntax : (instance-name-to-symbol ) *****************************************************************/ globle void *InstanceNameToSymbol( void *theEnv) { DATA_OBJECT result; if (EnvArgTypeCheck(theEnv,"instance-name-to-symbol",1,INSTANCE_NAME,&result) == FALSE) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return((SYMBOL_HN *) result.value); } /********************************************************************************* NAME : InstanceAddressCommand DESCRIPTION : Returns the address of an instance INPUTS : The address of the value buffer RETURNS : Nothing useful SIDE EFFECTS : Stores instance address in caller's buffer NOTES : H/L Syntax : (instance-address [] ) *********************************************************************************/ globle void InstanceAddressCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT temp; struct defmodule *theModule; unsigned searchImports; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvRtnArgCount(theEnv) > 1) { if (EnvArgTypeCheck(theEnv,"instance-address",1,SYMBOL,&temp) == FALSE) return; theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(temp)); if ((theModule == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE) { ExpectedTypeError1(theEnv,"instance-address",1,"module name"); SetEvaluationError(theEnv,TRUE); return; } if (theModule == NULL) { searchImports = TRUE; theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } else searchImports = FALSE; if (EnvArgTypeCheck(theEnv,"instance-address",2,INSTANCE_NAME,&temp) == FALSE) return; ins = FindInstanceInModule(theEnv,(SYMBOL_HN *) temp.value,theModule, ((struct defmodule *) EnvGetCurrentModule(theEnv)),searchImports); if (ins != NULL) { result->type = INSTANCE_ADDRESS; result->value = (void *) ins; } else NoInstanceError(theEnv,ValueToString(temp.value),"instance-address"); } else if (EnvArgTypeCheck(theEnv,"instance-address",1,INSTANCE_OR_INSTANCE_NAME,&temp)) { if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 0) { result->type = INSTANCE_ADDRESS; result->value = temp.value; } else { StaleInstanceAddress(theEnv,"instance-address",0); SetEvaluationError(theEnv,TRUE); } } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins != NULL) { result->type = INSTANCE_ADDRESS; result->value = (void *) ins; } else NoInstanceError(theEnv,ValueToString(temp.value),"instance-address"); } } } /*************************************************************** NAME : InstanceNameCommand DESCRIPTION : Gets the name of an INSTANCE INPUTS : The address of the value buffer RETURNS : The INSTANCE_NAME symbol SIDE EFFECTS : None NOTES : H/L Syntax : (instance-name ) ***************************************************************/ globle void InstanceNameCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT temp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"instance-name",1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE) return; if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,"instance-name",0); SetEvaluationError(theEnv,TRUE); return; } } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) { NoInstanceError(theEnv,ValueToString(temp.value),"instance-name"); return; } } result->type = INSTANCE_NAME; result->value = (void *) ins->name; } /************************************************************** NAME : InstanceAddressPCommand DESCRIPTION : Determines if a value is of type INSTANCE INPUTS : None RETURNS : TRUE if type INSTANCE_ADDRESS, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instance-addressp ) **************************************************************/ globle intBool InstanceAddressPCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); return((GetType(temp) == INSTANCE_ADDRESS) ? TRUE : FALSE); } /************************************************************** NAME : InstanceNamePCommand DESCRIPTION : Determines if a value is of type INSTANCE_NAME INPUTS : None RETURNS : TRUE if type INSTANCE_NAME, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instance-namep ) **************************************************************/ globle intBool InstanceNamePCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); return((GetType(temp) == INSTANCE_NAME) ? TRUE : FALSE); } /***************************************************************** NAME : InstancePCommand DESCRIPTION : Determines if a value is of type INSTANCE_ADDRESS or INSTANCE_NAME INPUTS : None RETURNS : TRUE if type INSTANCE_NAME or INSTANCE_ADDRESS, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instancep ) *****************************************************************/ globle intBool InstancePCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if ((GetType(temp) == INSTANCE_NAME) || (GetType(temp) == INSTANCE_ADDRESS)) return(TRUE); return(FALSE); } /******************************************************** NAME : InstanceExistPCommand DESCRIPTION : Determines if an instance exists INPUTS : None RETURNS : TRUE if instance exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instance-existp ) ********************************************************/ globle intBool InstanceExistPCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type == INSTANCE_ADDRESS) return((((INSTANCE_TYPE *) temp.value)->garbage == 0) ? TRUE : FALSE); if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL)) return((FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value) != NULL) ? TRUE : FALSE); ExpectedTypeError1(theEnv,"instance-existp",1,"instance name, instance address or symbol"); SetEvaluationError(theEnv,TRUE); return(FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /*************************************************** NAME : ListInstancesInModule DESCRIPTION : List instances of specified class(es) in a module INPUTS : 1) Traversal id to avoid multiple passes over same class 2) Logical name of output 3) The name of the class (NULL for all classes) 4) Flag indicating whether to include instances of subclasses 5) A flag indicating whether to indent because of module name RETURNS : The number of instances listed SIDE EFFECTS : Instances listed to logical output NOTES : Assumes defclass scope flags are up to date ***************************************************/ static long ListInstancesInModule( void *theEnv, int id, const char *logicalName, const char *className, intBool inheritFlag, intBool allModulesFlag) { void *theDefclass,*theInstance; long count = 0L; /* =================================== For the specified module, print out instances of all the classes =================================== */ if (className == NULL) { /* ============================================== If instances are being listed for all modules, only list the instances of classes in this module (to avoid listing instances twice) ============================================== */ if (allModulesFlag) { for (theDefclass = EnvGetNextDefclass(theEnv,NULL) ; theDefclass != NULL ; theDefclass = EnvGetNextDefclass(theEnv,theDefclass)) count += TabulateInstances(theEnv,id,logicalName, (DEFCLASS *) theDefclass,FALSE,allModulesFlag); } /* =================================================== If instances are only be listed for one module, list all instances visible to the module (including ones belonging to classes in other modules) =================================================== */ else { theInstance = GetNextInstanceInScope(theEnv,NULL); while (theInstance != NULL) { if (GetHaltExecution(theEnv) == TRUE) { return(count); } count++; PrintInstanceNameAndClass(theEnv,logicalName,(INSTANCE_TYPE *) theInstance,TRUE); theInstance = GetNextInstanceInScope(theEnv,theInstance); } } } /* =================================== For the specified module, print out instances of the specified class =================================== */ else { theDefclass = (void *) LookupDefclassAnywhere(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)),className); if (theDefclass != NULL) { count += TabulateInstances(theEnv,id,logicalName, (DEFCLASS *) theDefclass,inheritFlag,allModulesFlag); } else if (! allModulesFlag) ClassExistError(theEnv,"instances",className); } return(count); } /****************************************************** NAME : TabulateInstances DESCRIPTION : Displays all instances for a class INPUTS : 1) The traversal id for the classes 2) The logical name of the output 3) The class address 4) A flag indicating whether to print out instances of subclasses or not. 5) A flag indicating whether to indent because of module name RETURNS : The number of instances (including subclasses' instances) SIDE EFFECTS : None NOTES : None ******************************************************/ static long TabulateInstances( void *theEnv, int id, const char *logicalName, DEFCLASS *cls, intBool inheritFlag, intBool allModulesFlag) { INSTANCE_TYPE *ins; long i; long count = 0; if (TestTraversalID(cls->traversalRecord,id)) return(0L); SetTraversalID(cls->traversalRecord,id); for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass) { if (EvaluationData(theEnv)->HaltExecution) return(count); if (allModulesFlag) EnvPrintRouter(theEnv,logicalName," "); PrintInstanceNameAndClass(theEnv,logicalName,ins,TRUE); count++; } if (inheritFlag) { for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { if (EvaluationData(theEnv)->HaltExecution) return(count); count += TabulateInstances(theEnv,id,logicalName, cls->directSubclasses.classArray[i],inheritFlag,allModulesFlag); } } return(count); } #endif /*************************************************** NAME : PrintInstance DESCRIPTION : Displays an instance's slots INPUTS : 1) Logical name for output 2) Instance address 3) String used to separate slot printouts RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Assumes instance is valid ***************************************************/ static void PrintInstance( void *theEnv, const char *logicalName, INSTANCE_TYPE *ins, const char *separator) { long i; register INSTANCE_SLOT *sp; PrintInstanceNameAndClass(theEnv,logicalName,ins,FALSE); for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { EnvPrintRouter(theEnv,logicalName,separator); sp = ins->slotAddresses[i]; EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name)); if (sp->type != MULTIFIELD) { EnvPrintRouter(theEnv,logicalName," "); PrintAtom(theEnv,logicalName,(int) sp->type,sp->value); } else if (GetInstanceSlotLength(sp) != 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0, (long) (GetInstanceSlotLength(sp) - 1),FALSE); } EnvPrintRouter(theEnv,logicalName,")"); } } /*************************************************** NAME : FindISlotByName DESCRIPTION : Looks up an instance slot by instance name and slot name INPUTS : 1) Instance address 2) Instance name-string RETURNS : The instance slot address, NULL if does not exist SIDE EFFECTS : None NOTES : None ***************************************************/ static INSTANCE_SLOT *FindISlotByName( void *theEnv, INSTANCE_TYPE *ins, const char *sname) { SYMBOL_HN *ssym; ssym = FindSymbolHN(theEnv,sname); if (ssym == NULL) return(NULL); return(FindInstanceSlot(theEnv,ins,ssym)); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle const char *GetInstanceName( void *iptr) { return EnvGetInstanceName(GetCurrentEnvironment(),iptr); } globle void *CreateRawInstance( void *cptr, const char *iname) { return EnvCreateRawInstance(GetCurrentEnvironment(),cptr,iname); } globle intBool DeleteInstance( void *iptr) { return EnvDeleteInstance(GetCurrentEnvironment(),iptr); } globle void DirectGetSlot( void *ins, const char *sname, DATA_OBJECT *result) { EnvDirectGetSlot(GetCurrentEnvironment(),ins,sname,result); } globle int DirectPutSlot( void *ins, const char *sname, DATA_OBJECT *val) { return EnvDirectPutSlot(GetCurrentEnvironment(),ins,sname,val); } globle void *FindInstance( void *theModule, const char *iname, unsigned searchImports) { return EnvFindInstance(GetCurrentEnvironment(),theModule,iname,searchImports); } globle void *GetInstanceClass( void *iptr) { return EnvGetInstanceClass(GetCurrentEnvironment(),iptr); } globle void GetInstancePPForm( char *buf, unsigned buflen, void *iptr) { EnvGetInstancePPForm(GetCurrentEnvironment(),buf,buflen,iptr); } globle void *GetNextInstance( void *iptr) { return EnvGetNextInstance(GetCurrentEnvironment(),iptr); } globle void *GetNextInstanceInClass( void *cptr, void *iptr) { return EnvGetNextInstanceInClass(GetCurrentEnvironment(),cptr,iptr); } globle void *GetNextInstanceInClassAndSubclasses( void **cptr, void *iptr, DATA_OBJECT *iterationInfo) { return EnvGetNextInstanceInClassAndSubclasses(GetCurrentEnvironment(),cptr,iptr,iterationInfo); } #if DEBUGGING_FUNCTIONS globle void Instances( const char *logicalName, void *theVModule, const char *className, int inheritFlag) { EnvInstances(GetCurrentEnvironment(),logicalName,theVModule,className,inheritFlag); } #endif globle void *MakeInstance( const char *mkstr) { return EnvMakeInstance(GetCurrentEnvironment(),mkstr); } globle intBool UnmakeInstance( void *iptr) { return EnvUnmakeInstance(GetCurrentEnvironment(),iptr); } globle int ValidInstanceAddress( void *iptr) { return EnvValidInstanceAddress(GetCurrentEnvironment(),iptr); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* OBJECT_SYSTEM */ clips_core_source_630/core/symblcmp.c0000755000175000017500000007012512373755527016250 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SYMBOL CONSTRUCT COMPILER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* atomic data values: symbols, integers, floats, and */ /* bit maps. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Barry Cameron */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _SYMBLCMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "symbol.h" #include "memalloc.h" #include "constant.h" #include "exprnpsr.h" #include "cstrccom.h" #include "constrct.h" #include "argacces.h" #include "cstrncmp.h" #include "router.h" #include "conscomp.h" #include "sysdep.h" #include "utility.h" #include "symblcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int SymbolHashNodesToCode(void *,const char *,const char *,char *,int); static int BitMapHashNodesToCode(void *,const char *,const char *,char *,int); static int BitMapValuesToCode(void *,const char *,const char *, char *,int); static int FloatHashNodesToCode(void *,const char *,const char *,char *,int); static int IntegerHashNodesToCode(void *,const char *,const char *,char *,int); static int HashTablesToCode(void *,const char *,const char *,char *); static void PrintCString(FILE *,const char *); /**************************************************************/ /* AtomicValuesToCode: Driver routine for generating the code */ /* used by the symbol, integer, float, and bit map tables. */ /**************************************************************/ globle void AtomicValuesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer) { int version; // TBD Necessary? SetAtomicValueIndices(theEnv,TRUE); HashTablesToCode(theEnv,fileName,pathName,fileNameBuffer); version = SymbolHashNodesToCode(theEnv,fileName,pathName,fileNameBuffer,5); version = FloatHashNodesToCode(theEnv,fileName,pathName,fileNameBuffer,version); version = IntegerHashNodesToCode(theEnv,fileName,pathName,fileNameBuffer,version); version = BitMapHashNodesToCode(theEnv,fileName,pathName,fileNameBuffer,version); BitMapValuesToCode(theEnv,fileName,pathName,fileNameBuffer,version); } /*****************************************************/ /* SymbolHashNodesToCode: Produces the code for the */ /* symbol hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /*****************************************************/ static int SymbolHashNodesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int version) { unsigned long i, j; struct symbolHashNode *hashPtr; int count; int numberOfEntries; struct symbolHashNode **symbolTable; int newHeader = TRUE; int arrayVersion = 1; FILE *fp; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ symbolTable = GetSymbolTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (hashPtr = symbolTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (unsigned long) (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct symbolHashNode S%d_%ld[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (hashPtr = symbolTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct symbolHashNode S%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= (unsigned long) ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&S%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&S%d_%d[%ld],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,1,0,0,%ld,",hashPtr->count + 1,i); PrintCString(fp,hashPtr->contents); count++; j++; if ((count == numberOfEntries) || (j >= (unsigned) ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; arrayVersion++; version++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /******************************************************/ /* BitMapHashNodesToCode: Produces the code for the */ /* bit map hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /******************************************************/ static int BitMapHashNodesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int version) { int i, j; struct bitMapHashNode *hashPtr; int count; int numberOfEntries; struct bitMapHashNode **bitMapTable; int newHeader = TRUE; int arrayVersion = 1; FILE *fp; int longsReqdPartition = 1,longsReqdPartitionCount = 0; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ bitMapTable = GetBitMapTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct bitMapHashNode B%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct bitMapHashNode B%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&B%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&B%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,1,0,0,%d,(char *) &L%d_%d[%d],%d", hashPtr->count + 1,i, ConstructCompilerData(theEnv)->ImageID,longsReqdPartition,longsReqdPartitionCount, hashPtr->size); longsReqdPartitionCount += (int) (hashPtr->size / sizeof(unsigned long)); if ((hashPtr->size % sizeof(unsigned long)) != 0) longsReqdPartitionCount++; if (longsReqdPartitionCount >= ConstructCompilerData(theEnv)->MaxIndices) { longsReqdPartitionCount = 0; longsReqdPartition++; } count++; j++; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; arrayVersion++; version++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /*****************************************************/ /* BitMapValuesToCode: Produces the code for the bit */ /* map strings for a run-time module created using */ /* the constructs-to-c function. */ /*****************************************************/ static int BitMapValuesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int version) { int i, j, k; unsigned l; struct bitMapHashNode *hashPtr; int count; int numberOfEntries; struct bitMapHashNode **bitMapTable; int newHeader = TRUE; int arrayVersion = 1; FILE *fp; unsigned long tmpLong; int longsReqd; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ bitMapTable = GetBitMapTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries += (int) (hashPtr->size / sizeof(unsigned long)); if ((hashPtr->size % sizeof(unsigned long)) != 0) { numberOfEntries++; } } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern unsigned long L%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"unsigned long L%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } longsReqd = (int) (hashPtr->size / sizeof(unsigned long)); if ((hashPtr->size % sizeof(unsigned long)) != 0) longsReqd++; for (k = 0 ; k < longsReqd ; k++) { if (k > 0) fprintf(fp,","); tmpLong = 0L; for (l = 0 ; ((l < sizeof(unsigned long)) && (((k * sizeof(unsigned long)) + l) < (size_t) hashPtr->size)) ; l++) ((char *) &tmpLong)[l] = hashPtr->contents[(k * sizeof(unsigned long)) + l]; fprintf(fp,"0x%lxL",tmpLong); } count += longsReqd; j += longsReqd; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"};\n"); GenClose(theEnv,fp); j = 0; arrayVersion++; version++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,",\n"); } } } return(version); } /****************************************************/ /* FloatHashNodesToCode: Produces the code for the */ /* float hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /****************************************************/ static int FloatHashNodesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int version) { int i, j; struct floatHashNode *hashPtr; int count; int numberOfEntries; struct floatHashNode **floatTable; int newHeader = TRUE; FILE *fp; int arrayVersion = 1; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ floatTable = GetFloatTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (hashPtr = floatTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct floatHashNode F%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (hashPtr = floatTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct floatHashNode F%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&F%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&F%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,1,0,0,%d,",hashPtr->count + 1,i); fprintf(fp,"%s",FloatToString(theEnv,hashPtr->contents)); count++; j++; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; version++; arrayVersion++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /******************************************************/ /* IntegerHashNodesToCode: Produces the code for the */ /* integer hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /******************************************************/ static int IntegerHashNodesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int version) { int i, j; struct integerHashNode *hashPtr; int count; int numberOfEntries; struct integerHashNode **integerTable; int newHeader = TRUE; FILE *fp; int arrayVersion = 1; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ integerTable = GetIntegerTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (hashPtr = integerTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct integerHashNode I%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (hashPtr = integerTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct integerHashNode I%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&I%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&I%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,1,0,0,%d,",hashPtr->count + 1,i); fprintf(fp,"%lldLL",hashPtr->contents); count++; j++; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; version++; arrayVersion++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /****************************************************************/ /* HashTablesToCode: Produces the code for the symbol, integer, */ /* float, and bitmap hash tables for a run-time module */ /* created using the constructs-to-c function. */ /****************************************************************/ static int HashTablesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer) { unsigned long i; FILE *fp; struct symbolHashNode **symbolTable; struct floatHashNode **floatTable; struct integerHashNode **integerTable; struct bitMapHashNode **bitMapTable; /*======================================*/ /* Write the code for the symbol table. */ /*======================================*/ symbolTable = GetSymbolTable(theEnv); if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,1,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct symbolHashNode *sht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct symbolHashNode *sht%d[%ld] = {\n",ConstructCompilerData(theEnv)->ImageID,SYMBOL_HASH_SIZE); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { PrintSymbolReference(theEnv,fp,symbolTable[i]); if (i + 1 != SYMBOL_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); /*=====================================*/ /* Write the code for the float table. */ /*=====================================*/ floatTable = GetFloatTable(theEnv); if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,2,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct floatHashNode *fht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct floatHashNode *fht%d[%d] = {\n",ConstructCompilerData(theEnv)->ImageID,FLOAT_HASH_SIZE); for (i = 0; i < FLOAT_HASH_SIZE; i++) { if (floatTable[i] == NULL) { fprintf(fp,"NULL"); } else PrintFloatReference(theEnv,fp,floatTable[i]); if (i + 1 != FLOAT_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); /*=======================================*/ /* Write the code for the integer table. */ /*=======================================*/ integerTable = GetIntegerTable(theEnv); if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,3,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct integerHashNode *iht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct integerHashNode *iht%d[%d] = {\n",ConstructCompilerData(theEnv)->ImageID,INTEGER_HASH_SIZE); for (i = 0; i < INTEGER_HASH_SIZE; i++) { if (integerTable[i] == NULL) { fprintf(fp,"NULL"); } else PrintIntegerReference(theEnv,fp,integerTable[i]); if (i + 1 != INTEGER_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); /*======================================*/ /* Write the code for the bitmap table. */ /*======================================*/ bitMapTable = GetBitMapTable(theEnv); if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,1,4,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct bitMapHashNode *bmht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct bitMapHashNode *bmht%d[%d] = {\n",ConstructCompilerData(theEnv)->ImageID,BITMAP_HASH_SIZE); for (i = 0; i < BITMAP_HASH_SIZE; i++) { PrintBitMapReference(theEnv,fp,bitMapTable[i]); if (i + 1 != BITMAP_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); return(1); } /*****************************************************/ /* PrintSymbolReference: Prints the C code reference */ /* address to the specified symbol (also used for */ /* strings and instance names). */ /*****************************************************/ globle void PrintSymbolReference( void *theEnv, FILE *theFile, struct symbolHashNode *theSymbol) { if (theSymbol == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"&S%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theSymbol->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theSymbol->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /****************************************************/ /* PrintFloatReference: Prints the C code reference */ /* address to the specified float. */ /****************************************************/ globle void PrintFloatReference( void *theEnv, FILE *theFile, struct floatHashNode *theFloat) { fprintf(theFile,"&F%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theFloat->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theFloat->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /******************************************************/ /* PrintIntegerReference: Prints the C code reference */ /* address to the specified integer. */ /******************************************************/ globle void PrintIntegerReference( void *theEnv, FILE *theFile, struct integerHashNode *theInteger) { fprintf(theFile,"&I%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theInteger->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theInteger->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /*****************************************************/ /* PrintBitMapReference: Prints the C code reference */ /* address to the specified bit map. */ /*****************************************************/ globle void PrintBitMapReference( void *theEnv, FILE *theFile, struct bitMapHashNode *theBitMap) { if (theBitMap == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"&B%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theBitMap->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theBitMap->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /*********************************************************/ /* PrintCString: Prints KB strings in the appropriate */ /* format for C (the " and \ characters are preceeded */ /* by a \ and carriage returns are replaced with \n). */ /*********************************************************/ static void PrintCString( FILE *theFile, const char *str) { unsigned i; size_t slen; /*============================================*/ /* Print the string's opening quotation mark. */ /*============================================*/ fprintf(theFile,"\""); /*===============================================*/ /* Convert and write each character to the file. */ /*===============================================*/ slen = strlen(str); for (i = 0 ; i < slen ; i++) { /*====================================*/ /* Preceed " and \ with the \ escape. */ /*====================================*/ if ((str[i] == '"') || (str[i] == '\\')) { fputc('\\',theFile); fputc(str[i],theFile); } /*====================================*/ /* Replace a carriage return with \n. */ /*====================================*/ else if (str[i] == '\n') { fputc('\\',theFile); fputc('n',theFile); } /*===============================*/ /* All other characters can be */ /* printed without modification. */ /*===============================*/ else { fputc(str[i],theFile); } } /*============================================*/ /* Print the string's closing quotation mark. */ /*============================================*/ fprintf(theFile,"\""); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/default.h0000755000175000017500000000434612373720013016033 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFAULT ATTRIBUTE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing the default */ /* attribute and determining default values based on */ /* slot constraints. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Support for deftemplate-slot-default-value */ /* function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_default #define _H_default #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DEFAULT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeriveDefaultFromConstraints(void *,CONSTRAINT_RECORD *,DATA_OBJECT *,int,int); LOCALE struct expr *ParseDefault(void *,const char *,int,int,int,int *,int *,int *); #endif /* _H_default */ clips_core_source_630/core/exprnbin.h0000755000175000017500000000452212373740004016232 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION BLOAD/BSAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* expression data structure. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_exprnbin #define _H_exprnbin #ifndef _H_expressn #include "expressn.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRNBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define ExpressionPointer(i) ((struct expr *) (((i) == -1L) ? NULL : &ExpressionData(theEnv)->ExpressionArray[i])) #define HashedExpressionPointer(i) ExpressionPointer(i) LOCALE void AllocateExpressions(void *); LOCALE void RefreshExpressions(void *); LOCALE void ClearBloadedExpressions(void *); LOCALE void FindHashedExpressions(void *); LOCALE void BsaveHashedExpressions(void *,FILE *); LOCALE void BsaveConstructExpressions(void *,FILE *); LOCALE void BsaveExpression(void *,struct expr *,FILE *); #endif /* _H_exprnbin */ clips_core_source_630/core/tmpltdef.h0000755000175000017500000001513212461253173016227 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFTEMPLATE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Added code for deftemplate run time */ /* initialization of hashed comparisons to */ /* constants. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for deftemplate slot facets. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_tmpltdef #define _H_tmpltdef struct deftemplate; struct templateSlot; struct deftemplateModule; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #include "factbld.h" #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif struct deftemplate { struct constructHeader header; struct templateSlot *slotList; unsigned int implied : 1; unsigned int watch : 1; unsigned int inScope : 1; unsigned short numberOfSlots; long busyCount; struct factPatternNode *patternNetwork; struct fact *factList; struct fact *lastFact; }; struct templateSlot { struct symbolHashNode *slotName; unsigned int multislot : 1; unsigned int noDefault : 1; unsigned int defaultPresent : 1; unsigned int defaultDynamic : 1; CONSTRAINT_RECORD *constraints; struct expr *defaultList; struct expr *facetList; struct templateSlot *next; }; struct deftemplateModule { struct defmoduleItemHeader header; }; #define DEFTEMPLATE_DATA 5 struct deftemplateData { struct construct *DeftemplateConstruct; int DeftemplateModuleIndex; struct entityRecord DeftemplatePtrRecord; #if DEBUGGING_FUNCTIONS int DeletedTemplateDebugFlags; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DeftemplateCodeItem; #endif #if (! RUN_TIME) && (! BLOAD_ONLY) int DeftemplateError; #endif }; #define DeftemplateData(theEnv) ((struct deftemplateData *) GetEnvironmentData(theEnv,DEFTEMPLATE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeDeftemplates(void *); LOCALE void *EnvFindDeftemplate(void *,const char *); LOCALE void *EnvFindDeftemplateInModule(void *,const char *); LOCALE void *EnvGetNextDeftemplate(void *,void *); LOCALE intBool EnvIsDeftemplateDeletable(void *,void *); LOCALE void *EnvGetNextFactInTemplate(void *,void *,void *); LOCALE struct deftemplateModule *GetDeftemplateModuleItem(void *,struct defmodule *); LOCALE void ReturnSlots(void *,struct templateSlot *); LOCALE void IncrementDeftemplateBusyCount(void *,void *); LOCALE void DecrementDeftemplateBusyCount(void *,void *); LOCALE void *CreateDeftemplateScopeMap(void *,struct deftemplate *); #if RUN_TIME LOCALE void DeftemplateRunTimeInitialize(void *); #endif LOCALE const char *EnvDeftemplateModule(void *,void *); LOCALE const char *EnvGetDeftemplateName(void *,void *); LOCALE const char *EnvGetDeftemplatePPForm(void *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *DeftemplateModule(void *); LOCALE void *FindDeftemplate(const char *); LOCALE const char *GetDeftemplateName(void *); LOCALE const char *GetDeftemplatePPForm(void *); LOCALE void *GetNextDeftemplate(void *); LOCALE intBool IsDeftemplateDeletable(void *); LOCALE void *GetNextFactInTemplate(void *,void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_tmpltdef */ clips_core_source_630/core/incrrset.c0000755000175000017500000005637612500146515016246 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INCREMENTAL RESET MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality for the incremental */ /* reset of the pattern and join networks when a new */ /* rule is added. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed alpha memories and */ /* other join network changes. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Modified EnvSetIncrementalReset to check for */ /* the existance of rules. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _INCRRSET_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #if DEFRULE_CONSTRUCT #include "agenda.h" #include "argacces.h" #include "constant.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "evaluatn.h" #include "pattern.h" #include "router.h" #include "reteutil.h" #include "incrrset.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void MarkNetworkForIncrementalReset(void *,struct defrule *,int); static void MarkJoinsForIncrementalReset(void *,struct joinNode *,int); static void CheckForPrimableJoins(void *,struct defrule *,struct joinNode *); static void PrimeJoinFromLeftMemory(void *,struct joinNode *); static void PrimeJoinFromRightMemory(void *,struct joinNode *); static void MarkPatternForIncrementalReset(void *,int,struct patternNodeHeader *,int); #endif /**************************************************************/ /* IncrementalReset: Incrementally resets the specified rule. */ /**************************************************************/ globle void IncrementalReset( void *theEnv, struct defrule *tempRule) { #if (! RUN_TIME) && (! BLOAD_ONLY) struct defrule *tempPtr; struct patternParser *theParser; /*================================================*/ /* If incremental reset is disabled, then return. */ /*================================================*/ if (! EnvGetIncrementalReset(theEnv)) return; /*=====================================================*/ /* Mark the pattern and join network data structures */ /* associated with the rule being incrementally reset. */ /*=====================================================*/ MarkNetworkForIncrementalReset(theEnv,tempRule,TRUE); /*==========================*/ /* Begin incremental reset. */ /*==========================*/ EngineData(theEnv)->IncrementalResetInProgress = TRUE; /*============================================================*/ /* If the new rule shares patterns or joins with other rules, */ /* then it is necessary to update its join network based on */ /* existing partial matches it shares with other rules. */ /*============================================================*/ for (tempPtr = tempRule; tempPtr != NULL; tempPtr = tempPtr->disjunct) { CheckForPrimableJoins(theEnv,tempPtr,tempPtr->lastJoin); } /*===============================================*/ /* Filter existing data entities through the new */ /* portions of the pattern and join networks. */ /*===============================================*/ for (theParser = PatternData(theEnv)->ListOfPatternParsers; theParser != NULL; theParser = theParser->next) { if (theParser->incrementalResetFunction != NULL) { (*theParser->incrementalResetFunction)(theEnv); } } /*========================*/ /* End incremental reset. */ /*========================*/ EngineData(theEnv)->IncrementalResetInProgress = FALSE; /*====================================================*/ /* Remove the marks in the pattern and join networks. */ /*====================================================*/ MarkNetworkForIncrementalReset(theEnv,tempRule,FALSE); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /**********************************************************************/ /* MarkNetworkForIncrementalReset: Coordinates marking the initialize */ /* flags in the pattern and join networks both before and after an */ /* incremental reset. */ /**********************************************************************/ static void MarkNetworkForIncrementalReset( void *theEnv, struct defrule *tempRule, int value) { /*============================================*/ /* Loop through each of the rule's disjuncts. */ /*============================================*/ for (; tempRule != NULL; tempRule = tempRule->disjunct) { MarkJoinsForIncrementalReset(theEnv,tempRule->lastJoin,value); } } /**********************************************************************/ /* MarkJoinsForIncrementalReset: Coordinates marking the initialize */ /* flags in the pattern and join networks both before and after an */ /* incremental reset. */ /**********************************************************************/ static void MarkJoinsForIncrementalReset( void *theEnv, struct joinNode *joinPtr, int value) { struct patternNodeHeader *patternPtr; for (; joinPtr != NULL; joinPtr = joinPtr->lastLevel) { if (joinPtr->ruleToActivate != NULL) { joinPtr->marked = FALSE; joinPtr->initialize = value; continue; } if (joinPtr->joinFromTheRight) { MarkJoinsForIncrementalReset(theEnv,(struct joinNode *) joinPtr->rightSideEntryStructure,value); } /*================*/ /* Mark the join. */ /*================*/ joinPtr->marked = FALSE; /* GDR 6.05 */ if (joinPtr->initialize) { joinPtr->initialize = value; if (joinPtr->joinFromTheRight == FALSE) { patternPtr = (struct patternNodeHeader *) GetPatternForJoin(joinPtr); if (patternPtr != NULL) { MarkPatternForIncrementalReset(theEnv,(int) joinPtr->rhsType,patternPtr,value); } } } } } /*******************************************************************************/ /* CheckForPrimableJoins: Updates the joins of a rule for an incremental reset */ /* if portions of that rule are shared with other rules that have already */ /* been incrementally reset. A join for a new rule will be updated if it is */ /* marked for initialization and either its parent join or its associated */ /* entry pattern node has not been marked for initialization. The function */ /* PrimeJoin is used to update joins which meet these criteria. */ /*******************************************************************************/ static void CheckForPrimableJoins( void *theEnv, struct defrule *tempRule, struct joinNode *joinPtr) { /*========================================*/ /* Loop through each of the rule's joins. */ /*========================================*/ for (; joinPtr != NULL; joinPtr = joinPtr->lastLevel) { /*===============================*/ /* Update the join if necessary. */ /*===============================*/ if ((joinPtr->initialize) && (! joinPtr->marked)) { if (joinPtr->firstJoin == TRUE) { if (joinPtr->joinFromTheRight == FALSE) { if ((joinPtr->rightSideEntryStructure == NULL) || (joinPtr->patternIsNegated) || (((struct patternNodeHeader *) joinPtr->rightSideEntryStructure)->initialize == FALSE)) { PrimeJoinFromLeftMemory(theEnv,joinPtr); joinPtr->marked = TRUE; } } else { PrimeJoinFromRightMemory(theEnv,joinPtr); joinPtr->marked = TRUE; } } else if (joinPtr->lastLevel->initialize == FALSE) { PrimeJoinFromLeftMemory(theEnv,joinPtr); joinPtr->marked = TRUE; } else if ((joinPtr->joinFromTheRight) && (((struct joinNode *) joinPtr->rightSideEntryStructure)->initialize == FALSE)) { PrimeJoinFromRightMemory(theEnv,joinPtr); joinPtr->marked = TRUE; } } if (joinPtr->joinFromTheRight) { CheckForPrimableJoins(theEnv,tempRule,(struct joinNode *) joinPtr->rightSideEntryStructure); } } } /****************************************************************************/ /* PrimeJoinFromLeftMemory: Updates a join in a rule for an incremental */ /* reset. Joins are updated by "priming" them only if the join (or its */ /* associated pattern) is shared with other rules that have already been */ /* incrementally reset. A join for a new rule will be updated if it is */ /* marked for initialization and either its parent join or its associated */ /* entry pattern node has not been marked for initialization. */ /****************************************************************************/ static void PrimeJoinFromLeftMemory( void *theEnv, struct joinNode *joinPtr) { struct partialMatch *theList, *linker; struct alphaMemoryHash *listOfHashNodes; unsigned long b; unsigned long hashValue; struct betaMemory *theMemory; struct partialMatch *notParent; struct joinLink *tempLink; /*===========================================================*/ /* If the join is the first join of a rule, then send all of */ /* the partial matches from the alpha memory of the pattern */ /* associated with this join to the join for processing and */ /* the priming process is then complete. */ /*===========================================================*/ if (joinPtr->firstJoin == TRUE) { if (joinPtr->rightSideEntryStructure == NULL) { NetworkAssert(theEnv,joinPtr->rightMemory->beta[0],joinPtr); } else if (joinPtr->patternIsNegated) { notParent = joinPtr->leftMemory->beta[0]; if (joinPtr->secondaryNetworkTest != NULL) { if (EvaluateSecondaryNetworkTest(theEnv,notParent,joinPtr) == FALSE) { return; } } for (listOfHashNodes = ((struct patternNodeHeader *) joinPtr->rightSideEntryStructure)->firstHash; listOfHashNodes != NULL; listOfHashNodes = listOfHashNodes->nextHash) { if (listOfHashNodes->alphaMemory != NULL) { AddBlockedLink(notParent,listOfHashNodes->alphaMemory); return; } } EPMDrive(theEnv,notParent,joinPtr,NETWORK_ASSERT); } else { for (listOfHashNodes = ((struct patternNodeHeader *) joinPtr->rightSideEntryStructure)->firstHash; listOfHashNodes != NULL; listOfHashNodes = listOfHashNodes->nextHash) { for (theList = listOfHashNodes->alphaMemory; theList != NULL; theList = theList->nextInMemory) { NetworkAssert(theEnv,theList,joinPtr); } } } return; } /*========================================*/ /* Find another beta memory from which we */ /* can retrieve the partial matches. */ /*========================================*/ tempLink = joinPtr->lastLevel->nextLinks; while (tempLink != NULL) { if ((tempLink->join != joinPtr) && (tempLink->join->initialize == FALSE)) { break; } tempLink = tempLink->next; } if (tempLink == NULL) return; if (tempLink->enterDirection == LHS) { theMemory = tempLink->join->leftMemory; } else { theMemory = tempLink->join->rightMemory; } /*============================================*/ /* Send all partial matches from the selected */ /* beta memory to the new join. */ /*============================================*/ for (b = 0; b < theMemory->size; b++) { for (theList = theMemory->beta[b]; theList != NULL; theList = theList->nextInMemory) { linker = CopyPartialMatch(theEnv,theList); if (joinPtr->leftHash != NULL) { hashValue = BetaMemoryHashValue(theEnv,joinPtr->leftHash,linker,NULL,joinPtr); } else { hashValue = 0; } UpdateBetaPMLinks(theEnv,linker,theList->leftParent,theList->rightParent,joinPtr,hashValue,LHS); NetworkAssertLeft(theEnv,linker,joinPtr,NETWORK_ASSERT); } } } /****************************************************************************/ /* PrimeJoinFromRightMemory: Updates a join in a rule for an incremental */ /* reset. Joins are updated by "priming" them only if the join (or its */ /* associated pattern) is shared with other rules that have already been */ /* incrementally reset. A join for a new rule will be updated if it is */ /* marked for initialization and either its parent join or its associated */ /* entry pattern node has not been marked for initialization. */ /****************************************************************************/ static void PrimeJoinFromRightMemory( void *theEnv, struct joinNode *joinPtr) { struct partialMatch *theList, *linker; unsigned long b; struct betaMemory *theMemory; unsigned long hashValue; struct joinLink *tempLink; struct partialMatch *notParent; /*=======================================*/ /* This should be a join from the right. */ /*=======================================*/ if (joinPtr->joinFromTheRight == FALSE) { return; } /*========================================*/ /* Find another beta memory from which we */ /* can retrieve the partial matches. */ /*========================================*/ tempLink = ((struct joinNode *) joinPtr->rightSideEntryStructure)->nextLinks; while (tempLink != NULL) { if ((tempLink->join != joinPtr) && (tempLink->join->initialize == FALSE)) { break; } tempLink = tempLink->next; } if (tempLink == NULL) { if (joinPtr->firstJoin && (joinPtr->rightMemory->beta[0] == NULL) && (! joinPtr->patternIsExists)) { notParent = joinPtr->leftMemory->beta[0]; if (joinPtr->secondaryNetworkTest != NULL) { if (EvaluateSecondaryNetworkTest(theEnv,notParent,joinPtr) == FALSE) { return; } } EPMDrive(theEnv,notParent,joinPtr,NETWORK_ASSERT); } return; } if (tempLink->enterDirection == LHS) { theMemory = tempLink->join->leftMemory; } else { theMemory = tempLink->join->rightMemory; } /*============================================*/ /* Send all partial matches from the selected */ /* beta memory to the new join. */ /*============================================*/ for (b = 0; b < theMemory->size; b++) { for (theList = theMemory->beta[b]; theList != NULL; theList = theList->nextInMemory) { linker = CopyPartialMatch(theEnv,theList); if (joinPtr->rightHash != NULL) { hashValue = BetaMemoryHashValue(theEnv,joinPtr->rightHash,linker,NULL,joinPtr); } else { hashValue = 0; } UpdateBetaPMLinks(theEnv,linker,theList->leftParent,theList->rightParent,joinPtr,hashValue,RHS); NetworkAssert(theEnv,linker,joinPtr); } } if (joinPtr->firstJoin && (joinPtr->rightMemory->beta[0] == NULL) && (! joinPtr->patternIsExists)) { notParent = joinPtr->leftMemory->beta[0]; if (joinPtr->secondaryNetworkTest != NULL) { if (EvaluateSecondaryNetworkTest(theEnv,notParent,joinPtr) == FALSE) { return; } } EPMDrive(theEnv,notParent,joinPtr,NETWORK_ASSERT); } } /*********************************************************************/ /* MarkPatternForIncrementalReset: Given a pattern node and its type */ /* (fact, instance, etc.), calls the appropriate function to mark */ /* the pattern for an incremental reset. Used to mark the pattern */ /* nodes both before and after an incremental reset. */ /*********************************************************************/ static void MarkPatternForIncrementalReset( void *theEnv, int rhsType, struct patternNodeHeader *theHeader, int value) { struct patternParser *tempParser; tempParser = GetPatternParser(theEnv,rhsType); if (tempParser != NULL) { if (tempParser->markIRPatternFunction != NULL) { (*tempParser->markIRPatternFunction)(theEnv,theHeader,value); } } } #endif /********************************************/ /* EnvGetIncrementalReset: C access routine */ /* for the get-incremental-reset command. */ /********************************************/ globle intBool EnvGetIncrementalReset( void *theEnv) { return(EngineData(theEnv)->IncrementalResetFlag); } /********************************************/ /* EnvSetIncrementalReset: C access routine */ /* for the set-incremental-reset command. */ /********************************************/ globle intBool EnvSetIncrementalReset( void *theEnv, int value) { int ov; struct defmodule *theModule; /*============================================*/ /* The incremental reset behavior can only be */ /* changed if there are no existing rules. */ /*============================================*/ SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); if (EnvGetNextDefrule(theEnv,NULL) != NULL) { RestoreCurrentModule(theEnv); return(-1); } } RestoreCurrentModule(theEnv); /*====================================*/ /* Change the incremental reset flag. */ /*====================================*/ ov = EngineData(theEnv)->IncrementalResetFlag; EngineData(theEnv)->IncrementalResetFlag = value; return(ov); } /****************************************************/ /* SetIncrementalResetCommand: H/L access routine */ /* for the set-incremental-reset command. */ /****************************************************/ globle int SetIncrementalResetCommand( void *theEnv) { int oldValue; DATA_OBJECT argPtr; struct defmodule *theModule; oldValue = EnvGetIncrementalReset(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-incremental-reset",EXACTLY,1) == -1) { return(oldValue); } /*=========================================*/ /* The incremental reset behavior can't be */ /* changed when rules are loaded. */ /*=========================================*/ SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); if (EnvGetNextDefrule(theEnv,NULL) != NULL) { RestoreCurrentModule(theEnv); PrintErrorID(theEnv,"INCRRSET",1,FALSE); EnvPrintRouter(theEnv,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n"); SetEvaluationError(theEnv,TRUE); return(oldValue); } } RestoreCurrentModule(theEnv); /*==================================================*/ /* The symbol FALSE disables incremental reset. Any */ /* other value enables incremental reset. */ /*==================================================*/ EnvRtnUnknown(theEnv,1,&argPtr); if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL)) { EnvSetIncrementalReset(theEnv,FALSE); } else { EnvSetIncrementalReset(theEnv,TRUE); } /*=======================*/ /* Return the old value. */ /*=======================*/ return(oldValue); } /****************************************************/ /* GetIncrementalResetCommand: H/L access routine */ /* for the get-incremental-reset command. */ /****************************************************/ globle int GetIncrementalResetCommand( void *theEnv) { int oldValue; oldValue = EnvGetIncrementalReset(theEnv); if (EnvArgCountCheck(theEnv,"get-incremental-reset",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool GetIncrementalReset() { return EnvGetIncrementalReset(GetCurrentEnvironment()); } globle intBool SetIncrementalReset( int value) { return EnvSetIncrementalReset(GetCurrentEnvironment(),value); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/main.c0000755000175000017500000001041512424476503015331 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* MAIN MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Moved UserFunctions and EnvUserFunctions to */ /* the new userfunctions.c file. */ /* */ /*************************************************************/ /***************************************************************************/ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this software and associated documentation files (the */ /* "Software"), to deal in the Software without restriction, including */ /* without limitation the rights to use, copy, modify, merge, publish, */ /* distribute, and/or sell copies of the Software, and to permit persons */ /* to whom the Software is furnished to do so. */ /* */ /* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS */ /* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF */ /* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT */ /* OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY */ /* CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES */ /* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN */ /* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF */ /* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* */ /***************************************************************************/ #include "clips.h" /****************************************/ /* main: Starts execution of the expert */ /* system development environment. */ /****************************************/ int main( int argc, char *argv[]) { void *theEnv; theEnv = CreateEnvironment(); RerouteStdin(theEnv,argc,argv); CommandLoop(theEnv); /*==================================================================*/ /* Control does not normally return from the CommandLoop function. */ /* However if you are embedding CLIPS, have replaced CommandLoop */ /* with your own embedded calls that will return to this point, and */ /* are running software that helps detect memory leaks, you need to */ /* add function calls here to deallocate memory still being used by */ /* CLIPS. If you have a multi-threaded application, no environments */ /* can be currently executing. If the ALLOW_ENVIRONMENT_GLOBALS */ /* flag in setup.h has been set to TRUE (the default value), you */ /* call the DeallocateEnvironmentData function which will call */ /* DestroyEnvironment for each existing environment and then */ /* deallocate the remaining data used to keep track of allocated */ /* environments. Otherwise, you must explicitly call */ /* DestroyEnvironment for each environment you create. */ /*==================================================================*/ /* DeallocateEnvironmentData(); */ /* DestroyEnvironment(theEnv); */ return(-1); } clips_core_source_630/core/symblbin.c0000755000175000017500000005013212373755531016230 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SYMBOL BSAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* atomic data values. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /*************************************************************/ #define _BSAVE_SOURCE_ #include "setup.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES #include "argacces.h" #include "bload.h" #include "bsave.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "moduldef.h" #include "router.h" #include "symblbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ReadNeededBitMaps(void *); #if BLOAD_AND_BSAVE || BSAVE_INSTANCES static void WriteNeededBitMaps(void *,FILE *); #endif #if BLOAD_AND_BSAVE || BSAVE_INSTANCES /**********************************************/ /* WriteNeededAtomicValues: Save all symbols, */ /* floats, integers, and bitmaps needed by */ /* this binary image to the binary file. */ /**********************************************/ globle void WriteNeededAtomicValues( void *theEnv, FILE *fp) { WriteNeededSymbols(theEnv,fp); WriteNeededFloats(theEnv,fp); WriteNeededIntegers(theEnv,fp); WriteNeededBitMaps(theEnv,fp); } /********************************************************/ /* InitAtomicValueNeededFlags: Initializes all symbols, */ /* floats, integers, and bitmaps as being unneeded by */ /* the binary image being saved. */ /********************************************************/ globle void InitAtomicValueNeededFlags( void *theEnv) { unsigned long i; SYMBOL_HN *symbolPtr, **symbolArray; FLOAT_HN *floatPtr, **floatArray; INTEGER_HN *integerPtr, **integerArray; BITMAP_HN *bitMapPtr, **bitMapArray; /*===============*/ /* Mark symbols. */ /*===============*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { symbolPtr = symbolArray[i]; while (symbolPtr != NULL) { symbolPtr->neededSymbol = FALSE; symbolPtr = symbolPtr->next; } } /*==============*/ /* Mark floats. */ /*==============*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { floatPtr = floatArray[i]; while (floatPtr != NULL) { floatPtr->neededFloat = FALSE; floatPtr = floatPtr->next; } } /*================*/ /* Mark integers. */ /*================*/ integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { integerPtr = integerArray[i]; while (integerPtr != NULL) { integerPtr->neededInteger = FALSE; integerPtr = integerPtr->next; } } /*===============*/ /* Mark bitmaps. */ /*===============*/ bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { bitMapPtr = bitMapArray[i]; while (bitMapPtr != NULL) { bitMapPtr->neededBitMap = FALSE; bitMapPtr = bitMapPtr->next; } } } /*****************************************************************/ /* WriteNeededSymbols: Stores all of the symbols in the symbol */ /* table needed for this binary image in the binary save file. */ /*****************************************************************/ globle void WriteNeededSymbols( void *theEnv, FILE *fp) { unsigned long i; size_t length; SYMBOL_HN **symbolArray; SYMBOL_HN *symbolPtr; unsigned long int numberOfUsedSymbols = 0; size_t size = 0; /*=================================*/ /* Get a copy of the symbol table. */ /*=================================*/ symbolArray = GetSymbolTable(theEnv); /*======================================================*/ /* Get the number of symbols and the total string size. */ /*======================================================*/ for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { if (symbolPtr->neededSymbol) { numberOfUsedSymbols++; size += strlen(symbolPtr->contents) + 1; } } } /*=============================================*/ /* Write out the symbols and the string sizes. */ /*=============================================*/ GenWrite((void *) &numberOfUsedSymbols,(unsigned long) sizeof(unsigned long int),fp); GenWrite((void *) &size,(unsigned long) sizeof(unsigned long int),fp); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { if (symbolPtr->neededSymbol) { length = strlen(symbolPtr->contents) + 1; GenWrite((void *) symbolPtr->contents,(unsigned long) length,fp); } } } } /*****************************************************************/ /* WriteNeededFloats: Stores all of the floats in the float */ /* table needed for this binary image in the binary save file. */ /*****************************************************************/ globle void WriteNeededFloats( void *theEnv, FILE *fp) { int i; FLOAT_HN **floatArray; FLOAT_HN *floatPtr; unsigned long int numberOfUsedFloats = 0; /*================================*/ /* Get a copy of the float table. */ /*================================*/ floatArray = GetFloatTable(theEnv); /*===========================*/ /* Get the number of floats. */ /*===========================*/ for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { if (floatPtr->neededFloat) numberOfUsedFloats++; } } /*======================================================*/ /* Write out the number of floats and the float values. */ /*======================================================*/ GenWrite(&numberOfUsedFloats,(unsigned long) sizeof(unsigned long int),fp); for (i = 0 ; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { if (floatPtr->neededFloat) { GenWrite(&floatPtr->contents, (unsigned long) sizeof(floatPtr->contents),fp); } } } } /******************************************************************/ /* WriteNeededIntegers: Stores all of the integers in the integer */ /* table needed for this binary image in the binary save file. */ /******************************************************************/ globle void WriteNeededIntegers( void *theEnv, FILE *fp) { int i; INTEGER_HN **integerArray; INTEGER_HN *integerPtr; unsigned long int numberOfUsedIntegers = 0; /*==================================*/ /* Get a copy of the integer table. */ /*==================================*/ integerArray = GetIntegerTable(theEnv); /*=============================*/ /* Get the number of integers. */ /*=============================*/ for (i = 0 ; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { if (integerPtr->neededInteger) numberOfUsedIntegers++; } } /*==========================================================*/ /* Write out the number of integers and the integer values. */ /*==========================================================*/ GenWrite(&numberOfUsedIntegers,(unsigned long) sizeof(unsigned long int),fp); for (i = 0 ; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { if (integerPtr->neededInteger) { GenWrite(&integerPtr->contents, (unsigned long) sizeof(integerPtr->contents),fp); } } } } /*****************************************************************/ /* WriteNeededBitMaps: Stores all of the bitmaps in the bitmap */ /* table needed for this binary image in the binary save file. */ /*****************************************************************/ static void WriteNeededBitMaps( void *theEnv, FILE *fp) { int i; BITMAP_HN **bitMapArray; BITMAP_HN *bitMapPtr; unsigned long int numberOfUsedBitMaps = 0, size = 0; unsigned short tempSize; /*=================================*/ /* Get a copy of the bitmap table. */ /*=================================*/ bitMapArray = GetBitMapTable(theEnv); /*======================================================*/ /* Get the number of bitmaps and the total bitmap size. */ /*======================================================*/ for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { if (bitMapPtr->neededBitMap) { numberOfUsedBitMaps++; size += (unsigned long) (bitMapPtr->size + sizeof(unsigned short)); } } } /*========================================*/ /* Write out the bitmaps and their sizes. */ /*========================================*/ GenWrite((void *) &numberOfUsedBitMaps,(unsigned long) sizeof(unsigned long int),fp); GenWrite((void *) &size,(unsigned long) sizeof(unsigned long int),fp); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { if (bitMapPtr->neededBitMap) { tempSize = (unsigned short) bitMapPtr->size; GenWrite((void *) &tempSize,(unsigned long) sizeof(unsigned short),fp); GenWrite((void *) bitMapPtr->contents,(unsigned long) bitMapPtr->size,fp); } } } } #endif /* BLOAD_AND_BSAVE || BSAVE_INSTANCES */ /*********************************************/ /* ReadNeededAtomicValues: Read all symbols, */ /* floats, integers, and bitmaps needed by */ /* this binary image from the binary file. */ /*********************************************/ globle void ReadNeededAtomicValues( void *theEnv) { ReadNeededSymbols(theEnv); ReadNeededFloats(theEnv); ReadNeededIntegers(theEnv); ReadNeededBitMaps(theEnv); } /*******************************************/ /* ReadNeededSymbols: Reads in the symbols */ /* used by the binary image. */ /*******************************************/ globle void ReadNeededSymbols( void *theEnv) { char *symbolNames, *namePtr; unsigned long space; long i; /*=================================================*/ /* Determine the number of symbol names to be read */ /* and space required for them. */ /*=================================================*/ GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfSymbols,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (SymbolData(theEnv)->NumberOfSymbols == 0) { SymbolData(theEnv)->SymbolArray = NULL; return; } /*=======================================*/ /* Allocate area for strings to be read. */ /*=======================================*/ symbolNames = (char *) gm3(theEnv,(long) space); GenReadBinary(theEnv,(void *) symbolNames,space); /*================================================*/ /* Store the symbol pointers in the symbol array. */ /*================================================*/ SymbolData(theEnv)->SymbolArray = (SYMBOL_HN **) gm3(theEnv,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols); namePtr = symbolNames; for (i = 0; i < SymbolData(theEnv)->NumberOfSymbols; i++) { SymbolData(theEnv)->SymbolArray[i] = (SYMBOL_HN *) EnvAddSymbol(theEnv,namePtr); namePtr += strlen(namePtr) + 1; } /*=======================*/ /* Free the name buffer. */ /*=======================*/ rm3(theEnv,(void *) symbolNames,(long) space); } /*****************************************/ /* ReadNeededFloats: Reads in the floats */ /* used by the binary image. */ /*****************************************/ globle void ReadNeededFloats( void *theEnv) { double *floatValues; long i; /*============================================*/ /* Determine the number of floats to be read. */ /*============================================*/ GenReadBinary(theEnv,&SymbolData(theEnv)->NumberOfFloats,(unsigned long) sizeof(long int)); if (SymbolData(theEnv)->NumberOfFloats == 0) { SymbolData(theEnv)->FloatArray = NULL; return; } /*===============================*/ /* Allocate area for the floats. */ /*===============================*/ floatValues = (double *) gm3(theEnv,(long) sizeof(double) * SymbolData(theEnv)->NumberOfFloats); GenReadBinary(theEnv,(void *) floatValues,(unsigned long) (sizeof(double) * SymbolData(theEnv)->NumberOfFloats)); /*======================================*/ /* Store the floats in the float array. */ /*======================================*/ SymbolData(theEnv)->FloatArray = (FLOAT_HN **) gm3(theEnv,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats); for (i = 0; i < SymbolData(theEnv)->NumberOfFloats; i++) { SymbolData(theEnv)->FloatArray[i] = (FLOAT_HN *) EnvAddDouble(theEnv,floatValues[i]); } /*========================*/ /* Free the float buffer. */ /*========================*/ rm3(theEnv,(void *) floatValues,(long) (sizeof(double) * SymbolData(theEnv)->NumberOfFloats)); } /*********************************************/ /* ReadNeededIntegers: Reads in the integers */ /* used by the binary image. */ /*********************************************/ globle void ReadNeededIntegers( void *theEnv) { long long *integerValues; long i; /*==============================================*/ /* Determine the number of integers to be read. */ /*==============================================*/ GenReadBinary(theEnv,&SymbolData(theEnv)->NumberOfIntegers,(unsigned long) sizeof(unsigned long int)); if (SymbolData(theEnv)->NumberOfIntegers == 0) { SymbolData(theEnv)->IntegerArray = NULL; return; } /*=================================*/ /* Allocate area for the integers. */ /*=================================*/ integerValues = (long long *) gm3(theEnv,(long) (sizeof(long long) * SymbolData(theEnv)->NumberOfIntegers)); GenReadBinary(theEnv,(void *) integerValues,(unsigned long) (sizeof(long long) * SymbolData(theEnv)->NumberOfIntegers)); /*==========================================*/ /* Store the integers in the integer array. */ /*==========================================*/ SymbolData(theEnv)->IntegerArray = (INTEGER_HN **) gm3(theEnv,(long) (sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers)); for (i = 0; i < SymbolData(theEnv)->NumberOfIntegers; i++) { SymbolData(theEnv)->IntegerArray[i] = (INTEGER_HN *) EnvAddLong(theEnv,integerValues[i]); } /*==========================*/ /* Free the integer buffer. */ /*==========================*/ rm3(theEnv,(void *) integerValues,(long) (sizeof(long long) * SymbolData(theEnv)->NumberOfIntegers)); } /*******************************************/ /* ReadNeededBitMaps: Reads in the bitmaps */ /* used by the binary image. */ /*******************************************/ static void ReadNeededBitMaps( void *theEnv) { char *bitMapStorage, *bitMapPtr; unsigned long space; long i; unsigned short *tempSize; /*=======================================*/ /* Determine the number of bitmaps to be */ /* read and space required for them. */ /*=======================================*/ GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfBitMaps,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (SymbolData(theEnv)->NumberOfBitMaps == 0) { SymbolData(theEnv)->BitMapArray = NULL; return; } /*=======================================*/ /* Allocate area for bitmaps to be read. */ /*=======================================*/ bitMapStorage = (char *) gm3(theEnv,(long) space); GenReadBinary(theEnv,(void *) bitMapStorage,space); /*================================================*/ /* Store the bitMap pointers in the bitmap array. */ /*================================================*/ SymbolData(theEnv)->BitMapArray = (BITMAP_HN **) gm3(theEnv,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps); bitMapPtr = bitMapStorage; for (i = 0; i < SymbolData(theEnv)->NumberOfBitMaps; i++) { tempSize = (unsigned short *) bitMapPtr; SymbolData(theEnv)->BitMapArray[i] = (BITMAP_HN *) EnvAddBitMap(theEnv,bitMapPtr+sizeof(unsigned short),*tempSize); bitMapPtr += *tempSize + sizeof(unsigned short); } /*=========================*/ /* Free the bitmap buffer. */ /*=========================*/ rm3(theEnv,(void *) bitMapStorage,(long) space); } /**********************************************************/ /* FreeAtomicValueStorage: Returns the memory allocated */ /* for storing the pointers to atomic data values used */ /* in refreshing expressions and other data structures. */ /**********************************************************/ globle void FreeAtomicValueStorage( void *theEnv) { if (SymbolData(theEnv)->SymbolArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->SymbolArray,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols); if (SymbolData(theEnv)->FloatArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->FloatArray,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats); if (SymbolData(theEnv)->IntegerArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->IntegerArray,(long) sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers); if (SymbolData(theEnv)->BitMapArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->BitMapArray,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps); SymbolData(theEnv)->SymbolArray = NULL; SymbolData(theEnv)->FloatArray = NULL; SymbolData(theEnv)->IntegerArray = NULL; SymbolData(theEnv)->BitMapArray = NULL; SymbolData(theEnv)->NumberOfSymbols = 0; SymbolData(theEnv)->NumberOfFloats = 0; SymbolData(theEnv)->NumberOfIntegers = 0; SymbolData(theEnv)->NumberOfBitMaps = 0; } #endif /* BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES */ clips_core_source_630/core/tmpltfun.c0000755000175000017500000023006712375756705016277 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* DEFTEMPLATE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the modify and duplicate functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added deftemplate-slot-names, */ /* deftemplate-slot-default-value, */ /* deftemplate-slot-cardinality, */ /* deftemplate-slot-allowed-values, */ /* deftemplate-slot-range, */ /* deftemplate-slot-types, */ /* deftemplate-slot-multip, */ /* deftemplate-slot-singlep, */ /* deftemplate-slot-existp, and */ /* deftemplate-slot-defaultp functions. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for deftemplate slot facets. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added deftemplate-slot-facet-existp and */ /* deftemplate-slot-facet-value functions. */ /* */ /* Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Support for modify callback function. */ /* */ /* Added additional argument to function */ /* CheckDeftemplateAndSlotArguments to specify */ /* the expected number of arguments. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /*************************************************************/ #define _TMPLTFUN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "memalloc.h" #include "symbol.h" #include "scanner.h" #include "exprnpsr.h" #include "envrnmnt.h" #include "argacces.h" #include "router.h" #include "cstrnchk.h" #include "default.h" #include "factmngr.h" #include "commline.h" #include "factrhs.h" #include "modulutl.h" #include "reorder.h" #include "sysdep.h" #include "tmpltdef.h" #include "tmpltlhs.h" #include "tmpltutl.h" #include "tmpltrhs.h" #include "tmpltfun.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DuplicateModifyCommand(void *,int,DATA_OBJECT_PTR); static SYMBOL_HN *CheckDeftemplateAndSlotArguments(void *,const char *,struct deftemplate **,int); #if (! RUN_TIME) && (! BLOAD_ONLY) static struct expr *ModAndDupParse(void *,struct expr *,const char *,const char *); static SYMBOL_HN *FindTemplateForFactAddress(SYMBOL_HN *,struct lhsParseNode *); #endif /****************************************************************/ /* DeftemplateFunctions: Initializes the deftemplate functions. */ /****************************************************************/ globle void DeftemplateFunctions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction(theEnv,"modify",'u', PTIEF ModifyCommand,"ModifyCommand"); EnvDefineFunction(theEnv,"duplicate",'u', PTIEF DuplicateCommand,"DuplicateCommand"); EnvDefineFunction2(theEnv,"deftemplate-slot-names",'u', PTIEF DeftemplateSlotNamesFunction, "DeftemplateSlotNamesFunction", "11z"); EnvDefineFunction2(theEnv,"deftemplate-slot-default-value",'u',PTIEF DeftemplateSlotDefaultValueFunction, "DeftemplateSlotDefaultValueFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-cardinality",'u',PTIEF DeftemplateSlotCardinalityFunction, "DeftemplateSlotCardinalityFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-allowed-values",'u',PTIEF DeftemplateSlotAllowedValuesFunction, "DeftemplateSlotAllowedValuesFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-range",'u',PTIEF DeftemplateSlotRangeFunction, "DeftemplateSlotRangeFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-types",'u',PTIEF DeftemplateSlotTypesFunction, "DeftemplateSlotTypesFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-multip",'b',PTIEF DeftemplateSlotMultiPFunction, "DeftemplateSlotMultiPFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-singlep",'b',PTIEF DeftemplateSlotSinglePFunction, "DeftemplateSlotSinglePFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-existp",'b',PTIEF DeftemplateSlotExistPFunction, "DeftemplateSlotExistPFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-defaultp",'w',PTIEF DeftemplateSlotDefaultPFunction, "DeftemplateSlotDefaultPFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-facet-existp",'b',PTIEF DeftemplateSlotFacetExistPFunction, "DeftemplateSlotFacetExistPFunction","33w"); EnvDefineFunction2(theEnv,"deftemplate-slot-facet-value",'u',PTIEF DeftemplateSlotFacetValueFunction, "DeftemplateSlotFacetValueFunction","33w"); #if (! BLOAD_ONLY) AddFunctionParser(theEnv,"modify",ModifyParse); AddFunctionParser(theEnv,"duplicate",DuplicateParse); #endif FuncSeqOvlFlags(theEnv,"modify",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"duplicate",FALSE,FALSE); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /*********************************************************************/ /* ModifyCommand: H/L access routine for the modify command. Calls */ /* the DuplicateModifyCommand function to perform the actual work. */ /*********************************************************************/ globle void ModifyCommand( void *theEnv, DATA_OBJECT_PTR returnValue) { DuplicateModifyCommand(theEnv,TRUE,returnValue); } /***************************************************************************/ /* DuplicateCommand: H/L access routine for the duplicate command. Calls */ /* the DuplicateModifyCommand function to perform the actual work. */ /***************************************************************************/ globle void DuplicateCommand( void *theEnv, DATA_OBJECT_PTR returnValue) { DuplicateModifyCommand(theEnv,FALSE,returnValue); } /***************************************************************/ /* DuplicateModifyCommand: Implements the duplicate and modify */ /* commands. The fact being duplicated or modified is first */ /* copied to a new fact. Replacements to the fields of the */ /* new fact are then made. If a modify command is being */ /* performed, the original fact is retracted. Lastly, the */ /* new fact is asserted. */ /***************************************************************/ static void DuplicateModifyCommand( void *theEnv, int retractIt, DATA_OBJECT_PTR returnValue) { long long factNum; struct fact *oldFact, *newFact, *theFact; struct expr *testPtr; DATA_OBJECT computeResult; struct deftemplate *templatePtr; struct templateSlot *slotPtr; int i, position, found; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*==================================================*/ /* Evaluate the first argument which is used to get */ /* a pointer to the fact to be modified/duplicated. */ /*==================================================*/ testPtr = GetFirstArgument(); EnvIncrementClearReadyLocks(theEnv); EvaluateExpression(theEnv,testPtr,&computeResult); EnvDecrementClearReadyLocks(theEnv); /*==============================================================*/ /* If an integer is supplied, then treat it as a fact-index and */ /* search the fact-list for the fact with that fact-index. */ /*==============================================================*/ if (computeResult.type == INTEGER) { factNum = ValueToLong(computeResult.value); if (factNum < 0) { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL); while (oldFact != NULL) { if (oldFact->factIndex == factNum) { break; } else { oldFact = oldFact->nextFact; } } if (oldFact == NULL) { char tempBuffer[20]; gensprintf(tempBuffer,"f-%lld",factNum); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return; } } /*==========================================*/ /* Otherwise, if a pointer is supplied then */ /* no lookup is required. */ /*==========================================*/ else if (computeResult.type == FACT_ADDRESS) { oldFact = (struct fact *) computeResult.value; } /*===========================================*/ /* Otherwise, the first argument is invalid. */ /*===========================================*/ else { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } /*==================================*/ /* See if it is a deftemplate fact. */ /*==================================*/ templatePtr = oldFact->whichDeftemplate; if (templatePtr->implied) return; /*================================================================*/ /* Duplicate the values from the old fact (skipping multifields). */ /*================================================================*/ newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength); newFact->whichDeftemplate = templatePtr; for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type; if (newFact->theProposition.theFields[i].type != MULTIFIELD) { newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; } else { newFact->theProposition.theFields[i].value = NULL; } } /*========================*/ /* Start replacing slots. */ /*========================*/ testPtr = testPtr->nextArg; while (testPtr != NULL) { /*============================================================*/ /* If the slot identifier is an integer, then the slot was */ /* previously identified and its position within the template */ /* was stored. Otherwise, the position of the slot within the */ /* deftemplate has to be determined by comparing the name of */ /* the slot against the list of slots for the deftemplate. */ /*============================================================*/ if (testPtr->type == INTEGER) { position = (int) ValueToLong(testPtr->value); } else { found = FALSE; position = 0; slotPtr = templatePtr->slotList; while (slotPtr != NULL) { if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value) { found = TRUE; slotPtr = NULL; } else { slotPtr = slotPtr->next; position++; } } if (! found) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value), ValueToString(templatePtr->header.name),TRUE); SetEvaluationError(theEnv,TRUE); ReturnFact(theEnv,newFact); return; } } /*===================================================*/ /* If a single field slot is being replaced, then... */ /*===================================================*/ if (newFact->theProposition.theFields[position].type != MULTIFIELD) { /*======================================================*/ /* If the list of values to store in the slot is empty */ /* or contains more than one member than an error has */ /* occured because a single field slot can only contain */ /* a single value. */ /*======================================================*/ if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL)) { MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); ReturnFact(theEnv,newFact); return; } /*===================================================*/ /* Evaluate the expression to be stored in the slot. */ /*===================================================*/ EnvIncrementClearReadyLocks(theEnv); EvaluateExpression(theEnv,testPtr->argList,&computeResult); SetEvaluationError(theEnv,FALSE); EnvDecrementClearReadyLocks(theEnv); /*====================================================*/ /* If the expression evaluated to a multifield value, */ /* then an error occured since a multifield value can */ /* not be stored in a single field slot. */ /*====================================================*/ if (computeResult.type == MULTIFIELD) { ReturnFact(theEnv,newFact); MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); return; } /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } /*=================================*/ /* Else replace a multifield slot. */ /*=================================*/ else { /*======================================*/ /* Determine the new value of the slot. */ /*======================================*/ EnvIncrementClearReadyLocks(theEnv); StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE); SetEvaluationError(theEnv,FALSE); EnvDecrementClearReadyLocks(theEnv); /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } testPtr = testPtr->nextArg; } /*=====================================*/ /* Copy the multifield values from the */ /* old fact that were not replaced. */ /*=====================================*/ for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { if ((newFact->theProposition.theFields[i].type == MULTIFIELD) && (newFact->theProposition.theFields[i].value == NULL)) { newFact->theProposition.theFields[i].value = CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value); } } /*================================================*/ /* Call registered modify notification functions. */ /*================================================*/ if (retractIt && (FactData(theEnv)->ListOfModifyFunctions != NULL)) { struct callFunctionItemWithArg *theModifyFunction; struct fact *replacement = newFact; /*==================================================================*/ /* If the fact already exists, determine if it's the fact we're */ /* modifying. If so it will be retracted and reasserted. If not, */ /* it will just be retracted, so pass NULL as the replacement fact. */ /*==================================================================*/ if (! FactWillBeAsserted(theEnv,newFact)) { if (! MultifieldsEqual(&oldFact->theProposition, &newFact->theProposition)) { replacement = NULL; } } /*=========================================================*/ /* Preassign the factIndex and timeTag so the notification */ /* function will see the correct values. */ /*=========================================================*/ if (replacement != NULL) { replacement->factIndex = FactData(theEnv)->NextFactIndex; replacement->factHeader.timeTag = DefruleData(theEnv)->CurrentEntityTimeTag; } /*=========================================*/ /* Call each modify notification function. */ /*=========================================*/ for (theModifyFunction = FactData(theEnv)->ListOfModifyFunctions; theModifyFunction != NULL; theModifyFunction = theModifyFunction->next) { SetEnvironmentCallbackContext(theEnv,theModifyFunction->context); if (theModifyFunction->environmentAware) { ((void (*)(void *,void *,void *))(*theModifyFunction->func))(theEnv,oldFact,replacement); } else { ((void (*)(void *,void *))(*theModifyFunction->func))(oldFact,replacement); } } } /*======================================*/ /* Perform the duplicate/modify action. */ /*======================================*/ if (retractIt) EnvRetract(theEnv,oldFact); theFact = (struct fact *) EnvAssert(theEnv,newFact); /*========================================*/ /* The asserted fact is the return value. */ /*========================================*/ if (theFact != NULL) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,theFact->theProposition.multifieldLength); SetpType(returnValue,FACT_ADDRESS); SetpValue(returnValue,(void *) theFact); } return; } /****************************************************/ /* DeftemplateSlotNamesFunction: H/L access routine */ /* for the deftemplate-slot-names function. */ /****************************************************/ globle void DeftemplateSlotNamesFunction( void *theEnv, DATA_OBJECT *returnValue) { const char *deftemplateName; struct deftemplate *theDeftemplate; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"deftemplate-slot-names",EXACTLY,1) == -1) return; /*=======================================*/ /* Get the reference to the deftemplate. */ /*=======================================*/ deftemplateName = GetConstructName(theEnv,"deftemplate-slot-names","deftemplate name"); if (deftemplateName == NULL) return; theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,deftemplateName); if (theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",deftemplateName); return; } /*=====================*/ /* Get the slot names. */ /*=====================*/ EnvDeftemplateSlotNames(theEnv,theDeftemplate,returnValue); } /**********************************************/ /* EnvDeftemplateSlotNames: C access routine */ /* for the deftemplate-slot-names function. */ /**********************************************/ globle void EnvDeftemplateSlotNames( void *theEnv, void *vTheDeftemplate, DATA_OBJECT *returnValue) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct multifield *theList; struct templateSlot *theSlot; unsigned long count; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,1); theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1); SetMFType(theList,1,SYMBOL); SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied")); SetpValue(returnValue,(void *) theList); return; } /*=================================*/ /* Count the number of slot names. */ /*=================================*/ for (count = 0, theSlot = theDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { /* Do Nothing */ } /*=============================================================*/ /* Create a multifield value in which to store the slot names. */ /*=============================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===============================================*/ /* Store the slot names in the multifield value. */ /*===============================================*/ for (count = 1, theSlot = theDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theSlot->slotName); } } /*******************************************************/ /* DeftemplateSlotDefaultPFunction: H/L access routine */ /* for the deftemplate-slot-defaultp function. */ /*******************************************************/ globle void *DeftemplateSlotDefaultPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; int defaultType; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-existp",&theDeftemplate,2); if (slotName == NULL) { return(EnvFalseSymbol(theEnv)); } /*===============================*/ /* Does the slot have a default? */ /*===============================*/ defaultType = EnvDeftemplateSlotDefaultP(theEnv,theDeftemplate,ValueToString(slotName)); if (defaultType == STATIC_DEFAULT) { return(EnvAddSymbol(theEnv,"static")); } else if (defaultType == DYNAMIC_DEFAULT) { return(EnvAddSymbol(theEnv,"dynamic")); } return(EnvFalseSymbol(theEnv)); } /*************************************************/ /* EnvDeftemplateSlotDefaultP: C access routine */ /* for the deftemplate-slot-defaultp function. */ /*************************************************/ globle int EnvDeftemplateSlotDefaultP( void *theEnv, void *vTheDeftemplate, const char *slotName) { short position; struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct templateSlot *theSlot; /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(STATIC_DEFAULT); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(NO_DEFAULT); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(NO_DEFAULT); } /*======================================*/ /* Return the default type of the slot. */ /*======================================*/ if (theSlot->noDefault) { return(NO_DEFAULT); } else if (theSlot->defaultDynamic) { return(DYNAMIC_DEFAULT); } return(STATIC_DEFAULT); } /*************************************************************/ /* DeftemplateSlotDefaultValueFunction: H/L access routine */ /* for the deftemplate-slot-default-value function. */ /*************************************************************/ globle void DeftemplateSlotDefaultValueFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-default-value",&theDeftemplate,2); if (slotName == NULL) { theValue->type = SYMBOL; theValue->value = EnvFalseSymbol(theEnv); return; } /*=========================================*/ /* Get the deftemplate slot default value. */ /*=========================================*/ EnvDeftemplateSlotDefaultValue(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /******************************************************/ /* EnvDeftemplateSlotDefaultValue: C access routine */ /* for the deftemplate-slot-default-value function. */ /******************************************************/ globle intBool EnvDeftemplateSlotDefaultValue( void *theEnv, void *vTheDeftemplate, const char *slotName, DATA_OBJECT_PTR theValue) { short position; struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct templateSlot *theSlot; DATA_OBJECT tempDO; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ SetpType(theValue,SYMBOL); SetpValue(theValue,EnvFalseSymbol(theEnv)); /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { theValue->type = MULTIFIELD; theValue->value = EnvCreateMultifield(theEnv,0L); theValue->begin = 1; theValue->end = 0; return(TRUE); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } /*=======================================*/ /* Return the default value of the slot. */ /*=======================================*/ if (theSlot->noDefault) { SetpType(theValue,SYMBOL); SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE")); } else if (DeftemplateSlotDefault(theEnv,theDeftemplate,theSlot,&tempDO,TRUE)) { SetpDOBegin(theValue,GetDOBegin(tempDO)); SetpDOEnd(theValue,GetDOEnd(tempDO)); SetpType(theValue,tempDO.type); SetpValue(theValue,tempDO.value); } else { return (FALSE); } return(TRUE); } /**********************************************************/ /* DeftemplateSlotCardinalityFunction: H/L access routine */ /* for the deftemplate-slot-cardinality function. */ /**********************************************************/ globle void DeftemplateSlotCardinalityFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-cardinality",&theDeftemplate,2); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*=======================================*/ /* Get the deftemplate slot cardinality. */ /*=======================================*/ EnvDeftemplateSlotCardinality(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /****************************************************/ /* EnvDeftemplateSlotCardinality: C access routine */ /* for the deftemplate-slot-cardinality function. */ /****************************************************/ globle void EnvDeftemplateSlotCardinality( void *theEnv, void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); return; } else { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*=====================================*/ /* Return the cardinality of the slot. */ /*=====================================*/ if (theSlot->multislot == 0) { EnvSetMultifieldErrorValue(theEnv,result); return; } result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); if (theSlot->constraints != NULL) { SetMFType(result->value,1,theSlot->constraints->minFields->type); SetMFValue(result->value,1,theSlot->constraints->minFields->value); SetMFType(result->value,2,theSlot->constraints->maxFields->type); SetMFValue(result->value,2,theSlot->constraints->maxFields->value); } else { SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); } } /************************************************************/ /* DeftemplateSlotAllowedValuesFunction: H/L access routine */ /* for the deftemplate-slot-allowed-values function. */ /************************************************************/ globle void DeftemplateSlotAllowedValuesFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-allowed-values",&theDeftemplate,2); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*==========================================*/ /* Get the deftemplate slot allowed values. */ /*==========================================*/ EnvDeftemplateSlotAllowedValues(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /*******************************************************/ /* EnvDeftemplateSlotAllowedValues: C access routine */ /* for the deftemplate-slot-allowed-values function. */ /*******************************************************/ globle void EnvDeftemplateSlotAllowedValues( void *theEnv, void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; int i; EXPRESSION *theExp; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } else { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*========================================*/ /* Return the allowed values of the slot. */ /*========================================*/ if ((theSlot->constraints != NULL) ? (theSlot->constraints->restrictionList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->type = MULTIFIELD; result->begin = 0; result->end = ExpressionSize(theSlot->constraints->restrictionList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = theSlot->constraints->restrictionList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } } /****************************************************/ /* DeftemplateSlotRangeFunction: H/L access routine */ /* for the deftemplate-slot-range function. */ /****************************************************/ globle void DeftemplateSlotRangeFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-range",&theDeftemplate,2); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*=================================*/ /* Get the deftemplate slot range. */ /*=================================*/ EnvDeftemplateSlotRange(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /**********************************************/ /* EnvDeftemplateSlotRange: C access routine */ /* for the deftemplate-slot-range function. */ /**********************************************/ globle void EnvDeftemplateSlotRange( void *theEnv, void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,SYMBOL); SetMFValue(result->value,1,SymbolData(theEnv)->NegativeInfinity); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); return; } else { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*===============================*/ /* Return the range of the slot. */ /*===============================*/ if ((theSlot->constraints == NULL) ? FALSE : (theSlot->constraints->anyAllowed || theSlot->constraints->floatsAllowed || theSlot->constraints->integersAllowed)) { result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,theSlot->constraints->minValue->type); SetMFValue(result->value,1,theSlot->constraints->minValue->value); SetMFType(result->value,2,theSlot->constraints->maxValue->type); SetMFValue(result->value,2,theSlot->constraints->maxValue->value); } else { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } } /****************************************************/ /* DeftemplateSlotTypesFunction: H/L access routine */ /* for the deftemplate-slot-types function. */ /****************************************************/ globle void DeftemplateSlotTypesFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-types",&theDeftemplate,2); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*=================================*/ /* Get the deftemplate slot types. */ /*=================================*/ EnvDeftemplateSlotTypes(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /**********************************************/ /* EnvDeftemplateSlotTypes: C access routine */ /* for the deftemplate-slot-types function. */ /**********************************************/ globle void EnvDeftemplateSlotTypes( void *theEnv, void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot = NULL; int numTypes, i, allTypes = FALSE; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot name is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") != 0) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*==============================================*/ /* If the slot has no constraint information or */ /* there is no type restriction, then all types */ /* are allowed for the slot. */ /*==============================================*/ if ((theDeftemplate->implied) || ((theSlot->constraints != NULL) ? theSlot->constraints->anyAllowed : TRUE)) { #if OBJECT_SYSTEM numTypes = 8; #else numTypes = 6; #endif allTypes = TRUE; } /*==============================================*/ /* Otherwise count the number of types allowed. */ /*==============================================*/ else { numTypes = theSlot->constraints->symbolsAllowed + theSlot->constraints->stringsAllowed + theSlot->constraints->floatsAllowed + theSlot->constraints->integersAllowed + theSlot->constraints->instanceNamesAllowed + theSlot->constraints->instanceAddressesAllowed + theSlot->constraints->externalAddressesAllowed + theSlot->constraints->factAddressesAllowed; } /*========================================*/ /* Return the allowed types for the slot. */ /*========================================*/ result->type = MULTIFIELD; result->begin = 0; result->end = numTypes - 1; result->value = EnvCreateMultifield(theEnv,(long) numTypes); i = 1; if (allTypes || theSlot->constraints->floatsAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"FLOAT")); } if (allTypes || theSlot->constraints->integersAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"INTEGER")); } if (allTypes || theSlot->constraints->symbolsAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"SYMBOL")); } if (allTypes || theSlot->constraints->stringsAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"STRING")); } if (allTypes || theSlot->constraints->externalAddressesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"EXTERNAL-ADDRESS")); } if (allTypes || theSlot->constraints->factAddressesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"FACT-ADDRESS")); } #if OBJECT_SYSTEM if (allTypes || theSlot->constraints->instanceAddressesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"INSTANCE-ADDRESS")); } if (allTypes || theSlot->constraints->instanceNamesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i,EnvAddSymbol(theEnv,"INSTANCE-NAME")); } #endif } /*****************************************************/ /* DeftemplateSlotMultiPFunction: H/L access routine */ /* for the deftemplate-slot-multip function. */ /*****************************************************/ globle int DeftemplateSlotMultiPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-multip",&theDeftemplate,2); if (slotName == NULL) { return(FALSE); } /*================================*/ /* Is the slot a multifield slot? */ /*================================*/ return EnvDeftemplateSlotMultiP(theEnv,theDeftemplate,ValueToString(slotName)); } /***********************************************/ /* EnvDeftemplateSlotMultiP: C access routine */ /* for the deftemplate-slot-multip function. */ /***********************************************/ globle int EnvDeftemplateSlotMultiP( void *theEnv, void *vTheDeftemplate, const char *slotName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(TRUE); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } /*================================*/ /* Is the slot a multifield slot? */ /*================================*/ return(theSlot->multislot); } /******************************************************/ /* DeftemplateSlotSinglePFunction: H/L access routine */ /* for the deftemplate-slot-singlep function. */ /******************************************************/ globle int DeftemplateSlotSinglePFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-singlep",&theDeftemplate,2); if (slotName == NULL) { return(FALSE); } /*==================================*/ /* Is the slot a single field slot? */ /*==================================*/ return EnvDeftemplateSlotSingleP(theEnv,theDeftemplate,ValueToString(slotName)); } /************************************************/ /* EnvDeftemplateSlotSingleP: C access routine */ /* for the deftemplate-slot-singlep function. */ /************************************************/ globle int EnvDeftemplateSlotSingleP( void *theEnv, void *vTheDeftemplate, const char *slotName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(FALSE); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } /*==================================*/ /* Is the slot a single field slot? */ /*==================================*/ return(! theSlot->multislot); } /*****************************************************/ /* DeftemplateSlotExistPFunction: H/L access routine */ /* for the deftemplate-slot-existp function. */ /*****************************************************/ globle int DeftemplateSlotExistPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-existp",&theDeftemplate,2); if (slotName == NULL) { return(FALSE); } /*======================*/ /* Does the slot exist? */ /*======================*/ return EnvDeftemplateSlotExistP(theEnv,theDeftemplate,ValueToString(slotName)); } /************************************************/ /* EnvDeftemplateSlotExistP: C access routine */ /* for the deftemplate-slot-existp function. */ /************************************************/ globle int EnvDeftemplateSlotExistP( void *theEnv, void *vTheDeftemplate, const char *slotName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(TRUE); } else { return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if (FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position) == NULL) { return(FALSE); } /*==================*/ /* The slot exists. */ /*==================*/ return(TRUE); } /**********************************************************/ /* DeftemplateSlotFacetExistPFunction: H/L access routine */ /* for the deftemplate-slot-facet-existp function. */ /**********************************************************/ globle int DeftemplateSlotFacetExistPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; DATA_OBJECT facetName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-facet-existp",&theDeftemplate,3); if (slotName == NULL) { return(FALSE); } /*============================*/ /* Get the name of the facet. */ /*============================*/ if (EnvArgTypeCheck(theEnv,"deftemplate-slot-facet-existp",3,SYMBOL,&facetName) == FALSE) { return(FALSE); } /*======================*/ /* Does the slot exist? */ /*======================*/ return EnvDeftemplateSlotFacetExistP(theEnv,theDeftemplate,ValueToString(slotName),DOToString(facetName)); } /*****************************************************/ /* EnvDeftemplateSlotFacetExistP: C access routine */ /* for the deftemplate-slot-facet-existp function. */ /*****************************************************/ globle int EnvDeftemplateSlotFacetExistP( void *theEnv, void *vTheDeftemplate, const char *slotName, const char *facetName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; SYMBOL_HN *facetHN; struct expr *tempFacet; /*=================================================*/ /* An implied deftemplate doesn't have any facets. */ /*=================================================*/ if (theDeftemplate->implied) { return(FALSE); } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { return(FALSE); } /*=======================*/ /* Search for the facet. */ /*=======================*/ facetHN = FindSymbolHN(theEnv,facetName); for (tempFacet = theSlot->facetList; tempFacet != NULL; tempFacet = tempFacet->nextArg) { if (tempFacet->value == facetHN) { return(TRUE); } } /*===========================*/ /* The facet does not exist. */ /*===========================*/ return(FALSE); } /*********************************************************/ /* DeftemplateSlotFacetValueFunction: H/L access routine */ /* for the deftemplate-slot-facet-value function. */ /*********************************************************/ globle void DeftemplateSlotFacetValueFunction( void *theEnv, DATA_OBJECT *returnValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; DATA_OBJECT facetName; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-facet-existp",&theDeftemplate,3); if (slotName == NULL) { return; } /*============================*/ /* Get the name of the facet. */ /*============================*/ if (EnvArgTypeCheck(theEnv,"deftemplate-slot-facet-existp",3,SYMBOL,&facetName) == FALSE) { return; } /*===========================*/ /* Retrieve the facet value. */ /*===========================*/ EnvDeftemplateSlotFacetValue(theEnv,theDeftemplate,ValueToString(slotName),DOToString(facetName),returnValue); } /****************************************************/ /* EnvDeftemplateSlotFacetValue: C access routine */ /* for the deftemplate-slot-facet-value function. */ /****************************************************/ globle int EnvDeftemplateSlotFacetValue( void *theEnv, void *vTheDeftemplate, const char *slotName, const char *facetName, DATA_OBJECT *rv) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; SYMBOL_HN *facetHN; struct expr *tempFacet; /*=================================================*/ /* An implied deftemplate doesn't have any facets. */ /*=================================================*/ if (theDeftemplate->implied) { return(FALSE); } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { return(FALSE); } /*=======================*/ /* Search for the facet. */ /*=======================*/ facetHN = FindSymbolHN(theEnv,facetName); for (tempFacet = theSlot->facetList; tempFacet != NULL; tempFacet = tempFacet->nextArg) { if (tempFacet->value == facetHN) { EvaluateExpression(theEnv,tempFacet->argList,rv); return(TRUE); } } /*===========================*/ /* The facet does not exist. */ /*===========================*/ return(FALSE); } /************************************************************/ /* CheckDeftemplateAndSlotArguments: Checks the deftemplate */ /* and slot arguments for various functions. */ /************************************************************/ static SYMBOL_HN *CheckDeftemplateAndSlotArguments( void *theEnv, const char *functionName, struct deftemplate **theDeftemplate, int expectedArgs) { DATA_OBJECT tempDO; const char *deftemplateName; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,functionName,EXACTLY,expectedArgs) == -1) { return(NULL); } /*=====================================*/ /* There must be at least 2 arguments. */ /*=====================================*/ if (EnvArgCountCheck(theEnv,functionName,AT_LEAST,2) == -1) { return(NULL); } /*=======================================*/ /* Get the reference to the deftemplate. */ /*=======================================*/ EnvRtnUnknown(theEnv,1,&tempDO); if (GetType(tempDO) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,1,"deftemplate name"); return(NULL); } deftemplateName = DOToString(tempDO); *theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,deftemplateName); if (*theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",deftemplateName); return(NULL); } /*===========================*/ /* Get the name of the slot. */ /*===========================*/ if (EnvArgTypeCheck(theEnv,functionName,2,SYMBOL,&tempDO) == FALSE) { return(NULL); } return((SYMBOL_HN *) GetValue(tempDO)); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************************/ /* UpdateModifyDuplicate: Changes the modify/duplicate command */ /* found on the RHS of a rule such that the positions of the */ /* slots for replacement are stored rather than the slot */ /* name which allows quicker replacement of slots. This */ /* substitution can only take place when the deftemplate */ /* type is known (i.e. if a fact-index is used you don't */ /* know which type of deftemplate is going to be replaced */ /* until you actually do the replacement of slots). */ /***************************************************************/ globle intBool UpdateModifyDuplicate( void *theEnv, struct expr *top, const char *name, void *vTheLHS) { struct expr *functionArgs, *tempArg; SYMBOL_HN *templateName; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; short position; /*========================================*/ /* Determine the fact-address or index to */ /* be retracted by the modify command. */ /*========================================*/ functionArgs = top->argList; if (functionArgs->type == SF_VARIABLE) { templateName = FindTemplateForFactAddress((SYMBOL_HN *) functionArgs->value, (struct lhsParseNode *) vTheLHS); if (templateName == NULL) return(TRUE); } else { return(TRUE); } /*========================================*/ /* Make sure that the fact being modified */ /* has a corresponding deftemplate. */ /*========================================*/ theDeftemplate = (struct deftemplate *) LookupConstruct(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct, ValueToString(templateName), FALSE); if (theDeftemplate == NULL) return(TRUE); if (theDeftemplate->implied) return(TRUE); /*=============================================================*/ /* Make sure all the slot names are valid for the deftemplate. */ /*=============================================================*/ tempArg = functionArgs->nextArg; while (tempArg != NULL) { /*======================*/ /* Does the slot exist? */ /*======================*/ if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempArg->value,&position)) == NULL) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempArg->value), ValueToString(theDeftemplate->header.name),TRUE); return(FALSE); } /*=========================================================*/ /* Is a multifield value being put in a single field slot? */ /*=========================================================*/ if (slotPtr->multislot == FALSE) { if (tempArg->argList == NULL) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(FALSE); } else if (tempArg->argList->nextArg != NULL) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(FALSE); } else if ((tempArg->argList->type == MF_VARIABLE) || ((tempArg->argList->type == FCALL) ? (((struct FunctionDefinition *) tempArg->argList->value)->returnValueType == 'm') : FALSE)) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(FALSE); } } /*======================================*/ /* Are the slot restrictions satisfied? */ /*======================================*/ if (CheckRHSSlotTypes(theEnv,tempArg->argList,slotPtr,name) == 0) return(FALSE); /*=============================================*/ /* Replace the slot with the integer position. */ /*=============================================*/ tempArg->type = INTEGER; tempArg->value = (void *) EnvAddLong(theEnv,(long long) (FindSlotPosition(theDeftemplate,(SYMBOL_HN *) tempArg->value) - 1)); tempArg = tempArg->nextArg; } return(TRUE); } /**************************************************/ /* FindTemplateForFactAddress: Searches for the */ /* deftemplate name associated with the pattern */ /* to which a fact address has been bound. */ /**************************************************/ static SYMBOL_HN *FindTemplateForFactAddress( SYMBOL_HN *factAddress, struct lhsParseNode *theLHS) { struct lhsParseNode *thePattern = NULL; /*===============================================*/ /* Look through the LHS patterns for the pattern */ /* which is bound to the fact address used by */ /* the modify/duplicate function. */ /*===============================================*/ while (theLHS != NULL) { if (theLHS->value == (void *) factAddress) { thePattern = theLHS; theLHS = NULL; } else { theLHS = theLHS->bottom; } } if (thePattern == NULL) return(NULL); /*=====================================*/ /* Verify that just a symbol is stored */ /* as the first field of the pattern. */ /*=====================================*/ thePattern = thePattern->right; if ((thePattern->type != SF_WILDCARD) || (thePattern->bottom == NULL)) { return(NULL); } thePattern = thePattern->bottom; if ((thePattern->type != SYMBOL) || (thePattern->right != NULL) || (thePattern->bottom != NULL)) { return(NULL); } /*==============================*/ /* Return the deftemplate name. */ /*==============================*/ return((SYMBOL_HN *) thePattern->value); } /*******************************************/ /* ModifyParse: Parses the modify command. */ /*******************************************/ globle struct expr *ModifyParse( void *theEnv, struct expr *top, const char *logicalName) { return(ModAndDupParse(theEnv,top,logicalName,"modify")); } /*************************************************/ /* DuplicateParse: Parses the duplicate command. */ /*************************************************/ globle struct expr *DuplicateParse( void *theEnv, struct expr *top, const char *logicalName) { return(ModAndDupParse(theEnv,top,logicalName,"duplicate")); } /*************************************************************/ /* ModAndDupParse: Parses the modify and duplicate commands. */ /*************************************************************/ static struct expr *ModAndDupParse( void *theEnv, struct expr *top, const char *logicalName, const char *name) { int error = FALSE; struct token theToken; struct expr *nextOne, *tempSlot; struct expr *newField, *firstField, *lastField; int printError; short done; /*==================================================================*/ /* Parse the fact-address or index to the modify/duplicate command. */ /*==================================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,logicalName,&theToken); if ((theToken.type == SF_VARIABLE) || (theToken.type == GBL_VARIABLE)) { nextOne = GenConstant(theEnv,theToken.type,theToken.value); } else if (theToken.type == INTEGER) { if (! TopLevelCommand(theEnv)) { PrintErrorID(theEnv,"TMPLTFUN",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Fact-indexes can only be used by "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR," as a top level command.\n"); ReturnExpression(theEnv,top); return(NULL); } nextOne = GenConstant(theEnv,INTEGER,theToken.value); } else { ExpectedTypeError2(theEnv,name,1); ReturnExpression(theEnv,top); return(NULL); } nextOne->nextArg = NULL; nextOne->argList = NULL; top->argList = nextOne; nextOne = top->argList; /*=======================================================*/ /* Parse the remaining modify/duplicate slot specifiers. */ /*=======================================================*/ GetToken(theEnv,logicalName,&theToken); while (theToken.type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); /*=================================================*/ /* Slot definition begins with a left parenthesis. */ /*=================================================*/ if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); return(NULL); } /*=================================*/ /* The slot name must be a symbol. */ /*=================================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); return(NULL); } /*=================================*/ /* Check for duplicate slot names. */ /*=================================*/ for (tempSlot = top->argList->nextArg; tempSlot != NULL; tempSlot = tempSlot->nextArg) { if (tempSlot->value == theToken.value) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(theToken.value)); ReturnExpression(theEnv,top); return(NULL); } } /*=========================================*/ /* Add the slot name to the list of slots. */ /*=========================================*/ nextOne->nextArg = GenConstant(theEnv,SYMBOL,theToken.value); nextOne = nextOne->nextArg; /*====================================================*/ /* Get the values to be stored in the specified slot. */ /*====================================================*/ firstField = NULL; lastField = NULL; done = FALSE; while (! done) { SavePPBuffer(theEnv," "); newField = GetAssertArgument(theEnv,logicalName,&theToken,&error, RPAREN,FALSE,&printError); if (error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); ReturnExpression(theEnv,top); return(NULL); } if (newField == NULL) { done = TRUE; } if (lastField == NULL) { firstField = newField; } else { lastField->nextArg = newField; } lastField = newField; } /*================================================*/ /* Slot definition ends with a right parenthesis. */ /*================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,firstField); return(NULL); } else { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } nextOne->argList = firstField; GetToken(theEnv,logicalName,&theToken); } /*================================================*/ /* Return the parsed modify/duplicate expression. */ /*================================================*/ return(top); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void DeftemplateSlotNames( void *vTheDeftemplate, DATA_OBJECT *returnValue) { EnvDeftemplateSlotNames(GetCurrentEnvironment(),vTheDeftemplate,returnValue); } globle intBool DeftemplateSlotDefaultValue( void *vTheDeftemplate, const char *slotName, DATA_OBJECT_PTR theValue) { return EnvDeftemplateSlotDefaultValue(GetCurrentEnvironment(),vTheDeftemplate,slotName,theValue); } globle void DeftemplateSlotCardinality( void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { EnvDeftemplateSlotCardinality(GetCurrentEnvironment(),vTheDeftemplate,slotName,result); } globle void DeftemplateSlotAllowedValues( void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { EnvDeftemplateSlotAllowedValues(GetCurrentEnvironment(),vTheDeftemplate,slotName,result); } globle void DeftemplateSlotRange( void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { EnvDeftemplateSlotRange(GetCurrentEnvironment(),vTheDeftemplate,slotName,result); } globle void DeftemplateSlotTypes( void *vTheDeftemplate, const char *slotName, DATA_OBJECT *result) { EnvDeftemplateSlotTypes(GetCurrentEnvironment(),vTheDeftemplate,slotName,result); } globle int DeftemplateSlotMultiP( void *vTheDeftemplate, const char *slotName) { return EnvDeftemplateSlotMultiP(GetCurrentEnvironment(),vTheDeftemplate,slotName); } globle int DeftemplateSlotSingleP( void *vTheDeftemplate, const char *slotName) { return EnvDeftemplateSlotSingleP(GetCurrentEnvironment(),vTheDeftemplate,slotName); } globle int DeftemplateSlotExistP( void *vTheDeftemplate, const char *slotName) { return EnvDeftemplateSlotExistP(GetCurrentEnvironment(),vTheDeftemplate,slotName); } globle int DeftemplateSlotDefaultP( void *vTheDeftemplate, const char *slotName) { return EnvDeftemplateSlotDefaultP(GetCurrentEnvironment(),vTheDeftemplate,slotName); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/._objrtbld.c0000755000175000017500000000040712500721260016410 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/classexm.c0000755000175000017500000013637412373714265016244 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CLASS EXAMINATION MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Class browsing and examination commands */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Modified the slot-writablep function to return */ /* FALSE for slots having initialize-only access. */ /* DR0860 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* The slot-default-value function crashes when no */ /* default exists for a slot (the ?NONE value was */ /* specified). DR0870 */ /* */ /* 6.30: Used %zd for printing size_t arguments. */ /* */ /* Added EnvSlotDefaultP function. */ /* */ /* Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Used gensprintf and genstrcat instead of */ /* sprintf and strcat. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "classini.h" #include "envrnmnt.h" #include "insfun.h" #include "memalloc.h" #include "msgcom.h" #include "msgfun.h" #include "router.h" #include "strngrtr.h" #include "sysdep.h" #define _CLASSEXM_SOURCE_ #include "classexm.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static int CheckTwoClasses(void *,const char *,DEFCLASS **,DEFCLASS **); static SLOT_DESC *CheckSlotExists(void *,const char *,DEFCLASS **,intBool,intBool); static SLOT_DESC *LookupSlot(void *,DEFCLASS *,const char *,intBool); #if DEBUGGING_FUNCTIONS static DEFCLASS *CheckClass(void *,const char *,const char *); static const char *GetClassNameArgument(void *,const char *); static void PrintClassBrowse(void *,const char *,DEFCLASS *,long); static void DisplaySeparator(void *,const char *,char *,int,int); static void DisplaySlotBasicInfo(void *,const char *,const char *,const char *,char *,DEFCLASS *); static intBool PrintSlotSources(void *,const char *,SYMBOL_HN *,PACKED_CLASS_LINKS *,long,int); static void DisplaySlotConstraintInfo(void *,const char *,const char *,char *,unsigned,DEFCLASS *); static const char *ConstraintCode(CONSTRAINT_RECORD *,unsigned,unsigned); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /**************************************************************** NAME : BrowseClassesCommand DESCRIPTION : Displays a "graph" of the class hierarchy INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (browse-classes []) ****************************************************************/ globle void BrowseClassesCommand( void *theEnv) { register DEFCLASS *cls; if (EnvRtnArgCount(theEnv) == 0) /* ================================================ Find the OBJECT root class (has no superclasses) ================================================ */ cls = LookupDefclassByMdlOrScope(theEnv,OBJECT_TYPE_NAME); else { DATA_OBJECT tmp; if (EnvArgTypeCheck(theEnv,"browse-classes",1,SYMBOL,&tmp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"browse-classes",DOToString(tmp)); return; } } EnvBrowseClasses(theEnv,WDISPLAY,(void *) cls); } /**************************************************************** NAME : EnvBrowseClasses DESCRIPTION : Displays a "graph" of the class hierarchy INPUTS : 1) The logical name of the output 2) Class pointer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ****************************************************************/ globle void EnvBrowseClasses( void *theEnv, const char *logicalName, void *clsptr) { PrintClassBrowse(theEnv,logicalName,(DEFCLASS *) clsptr,0); } /**************************************************************** NAME : DescribeClassCommand DESCRIPTION : Displays direct superclasses and subclasses and the entire precedence list for a class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (describe-class ) ****************************************************************/ globle void DescribeClassCommand( void *theEnv) { const char *cname; DEFCLASS *cls; cname = GetClassNameArgument(theEnv,"describe-class"); if (cname == NULL) return; cls = CheckClass(theEnv,"describe-class",cname); if (cls == NULL) return; EnvDescribeClass(theEnv,WDISPLAY,(void *) cls); } /****************************************************** NAME : EnvDescribeClass DESCRIPTION : Displays direct superclasses and subclasses and the entire precedence list for a class INPUTS : 1) The logical name of the output 2) Class pointer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ******************************************************/ globle void EnvDescribeClass( void *theEnv, const char *logicalName, void *clsptr) { DEFCLASS *cls; char buf[83], slotNamePrintFormat[12], overrideMessagePrintFormat[12]; int messageBanner; long i; size_t slotNameLength, maxSlotNameLength; size_t overrideMessageLength, maxOverrideMessageLength; cls = (DEFCLASS *) clsptr; DisplaySeparator(theEnv,logicalName,buf,82,'='); DisplaySeparator(theEnv,logicalName,buf,82,'*'); if (cls->abstract) EnvPrintRouter(theEnv,logicalName,"Abstract: direct instances of this class cannot be created.\n\n"); else { EnvPrintRouter(theEnv,logicalName,"Concrete: direct instances of this class can be created.\n"); #if DEFRULE_CONSTRUCT if (cls->reactive) EnvPrintRouter(theEnv,logicalName,"Reactive: direct instances of this class can match defrule patterns.\n\n"); else EnvPrintRouter(theEnv,logicalName,"Non-reactive: direct instances of this class cannot match defrule patterns.\n\n"); #else EnvPrintRouter(theEnv,logicalName,"\n"); #endif } PrintPackedClassLinks(theEnv,logicalName,"Direct Superclasses:",&cls->directSuperclasses); PrintPackedClassLinks(theEnv,logicalName,"Inheritance Precedence:",&cls->allSuperclasses); PrintPackedClassLinks(theEnv,logicalName,"Direct Subclasses:",&cls->directSubclasses); if (cls->instanceTemplate != NULL) { DisplaySeparator(theEnv,logicalName,buf,82,'-'); maxSlotNameLength = 5; maxOverrideMessageLength = 8; for (i = 0 ; i < cls->instanceSlotCount ; i++) { slotNameLength = strlen(ValueToString(cls->instanceTemplate[i]->slotName->name)); if (slotNameLength > maxSlotNameLength) maxSlotNameLength = slotNameLength; if (cls->instanceTemplate[i]->noWrite == 0) { overrideMessageLength = strlen(ValueToString(cls->instanceTemplate[i]->overrideMessage)); if (overrideMessageLength > maxOverrideMessageLength) maxOverrideMessageLength = overrideMessageLength; } } if (maxSlotNameLength > 16) maxSlotNameLength = 16; if (maxOverrideMessageLength > 12) maxOverrideMessageLength = 12; #if WIN_MVC gensprintf(slotNamePrintFormat,"%%-%Id.%Ids : ",maxSlotNameLength,maxSlotNameLength); gensprintf(overrideMessagePrintFormat,"%%-%Id.%Ids ",maxOverrideMessageLength, maxOverrideMessageLength); #elif WIN_GCC gensprintf(slotNamePrintFormat,"%%-%ld.%lds : ",(long) maxSlotNameLength,(long) maxSlotNameLength); gensprintf(overrideMessagePrintFormat,"%%-%ld.%lds ",(long) maxOverrideMessageLength, (long) maxOverrideMessageLength); #else gensprintf(slotNamePrintFormat,"%%-%zd.%zds : ",maxSlotNameLength,maxSlotNameLength); gensprintf(overrideMessagePrintFormat,"%%-%zd.%zds ",maxOverrideMessageLength, maxOverrideMessageLength); #endif DisplaySlotBasicInfo(theEnv,logicalName,slotNamePrintFormat,overrideMessagePrintFormat,buf,cls); EnvPrintRouter(theEnv,logicalName,"\nConstraint information for slots:\n\n"); DisplaySlotConstraintInfo(theEnv,logicalName,slotNamePrintFormat,buf,82,cls); } if (cls->handlerCount > 0) messageBanner = TRUE; else { messageBanner = FALSE; for (i = 1 ; i < cls->allSuperclasses.classCount ; i++) if (cls->allSuperclasses.classArray[i]->handlerCount > 0) { messageBanner = TRUE; break; } } if (messageBanner) { DisplaySeparator(theEnv,logicalName,buf,82,'-'); EnvPrintRouter(theEnv,logicalName,"Recognized message-handlers:\n"); DisplayHandlersInLinks(theEnv,logicalName,&cls->allSuperclasses,0); } DisplaySeparator(theEnv,logicalName,buf,82,'*'); DisplaySeparator(theEnv,logicalName,buf,82,'='); } #endif /* DEBUGGING_FUNCTIONS */ /********************************************************** NAME : GetCreateAccessorString DESCRIPTION : Gets a string describing which accessors are implicitly created for a slot: R, W, RW or NIL INPUTS : The slot descriptor RETURNS : The string description SIDE EFFECTS : None NOTES : Used by (describe-class) and (slot-facets) **********************************************************/ globle const char *GetCreateAccessorString( void *vsd) { SLOT_DESC *sd = (SLOT_DESC *) vsd; if (sd->createReadAccessor && sd->createWriteAccessor) return("RW"); if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0)) return("NIL"); else { if (sd->createReadAccessor) return "R"; else return "W"; } } /************************************************************ NAME : GetDefclassModuleCommand DESCRIPTION : Determines to which module a class belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (defclass-module ) ************************************************************/ globle void *GetDefclassModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defclass-module",DefclassData(theEnv)->DefclassConstruct)); } /********************************************************************* NAME : SuperclassPCommand DESCRIPTION : Determines if a class is a superclass of another INPUTS : None RETURNS : TRUE if class-1 is a superclass of class-2 SIDE EFFECTS : None NOTES : H/L Syntax : (superclassp ) *********************************************************************/ globle intBool SuperclassPCommand( void *theEnv) { DEFCLASS *c1,*c2; if (CheckTwoClasses(theEnv,"superclassp",&c1,&c2) == FALSE) return(FALSE); return(EnvSuperclassP(theEnv,(void *) c1,(void *) c2)); } /*************************************************** NAME : EnvSuperclassP DESCRIPTION : Determines if the first class is a superclass of the other INPUTS : 1) First class 2) Second class RETURNS : TRUE if first class is a superclass of the first, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSuperclassP( void *theEnv, void *firstClass, void *secondClass) { #if MAC_XCD #pragma unused(theEnv) #endif return(HasSuperclass((DEFCLASS *) secondClass,(DEFCLASS *) firstClass)); } /********************************************************************* NAME : SubclassPCommand DESCRIPTION : Determines if a class is a subclass of another INPUTS : None RETURNS : TRUE if class-1 is a subclass of class-2 SIDE EFFECTS : None NOTES : H/L Syntax : (subclassp ) *********************************************************************/ globle intBool SubclassPCommand( void *theEnv) { DEFCLASS *c1,*c2; if (CheckTwoClasses(theEnv,"subclassp",&c1,&c2) == FALSE) return(FALSE); return(EnvSubclassP(theEnv,(void *) c1,(void *) c2)); } /*************************************************** NAME : EnvSubclassP DESCRIPTION : Determines if the first class is a subclass of the other INPUTS : 1) First class 2) Second class RETURNS : TRUE if first class is a subclass of the first, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSubclassP( void *theEnv, void *firstClass, void *secondClass) { #if MAC_XCD #pragma unused(theEnv) #endif return(HasSuperclass((DEFCLASS *) firstClass,(DEFCLASS *) secondClass)); } /********************************************************************* NAME : SlotExistPCommand DESCRIPTION : Determines if a slot is present in a class INPUTS : None RETURNS : TRUE if the slot exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-existp [inherit]) *********************************************************************/ globle int SlotExistPCommand( void *theEnv) { DEFCLASS *cls; SLOT_DESC *sd; int inheritFlag = FALSE; DATA_OBJECT dobj; sd = CheckSlotExists(theEnv,"slot-existp",&cls,FALSE,TRUE); if (sd == NULL) return(FALSE); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"slot-existp",3,SYMBOL,&dobj) == FALSE) return(FALSE); if (strcmp(DOToString(dobj),"inherit") != 0) { ExpectedTypeError1(theEnv,"slot-existp",3,"keyword \"inherit\""); SetEvaluationError(theEnv,TRUE); return(FALSE); } inheritFlag = TRUE; } return((sd->cls == cls) ? TRUE : inheritFlag); } /*************************************************** NAME : EnvSlotExistP DESCRIPTION : Determines if a slot exists INPUTS : 1) The class 2) The slot name 3) A flag indicating if the slot can be inherited or not RETURNS : TRUE if slot exists, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotExistP( void *theEnv, void *theDefclass, const char *slotName, intBool inheritFlag) { return((LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,inheritFlag) != NULL) ? TRUE : FALSE); } /************************************************************************************ NAME : MessageHandlerExistPCommand DESCRIPTION : Determines if a message-handler is present in a class INPUTS : None RETURNS : TRUE if the message header is present, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (message-handler-existp []) ************************************************************************************/ globle int MessageHandlerExistPCommand( void *theEnv) { DEFCLASS *cls; SYMBOL_HN *mname; DATA_OBJECT temp; unsigned mtype = MPRIMARY; if (EnvArgTypeCheck(theEnv,"message-handler-existp",1,SYMBOL,&temp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,"message-handler-existp",DOToString(temp)); return(FALSE); } if (EnvArgTypeCheck(theEnv,"message-handler-existp",2,SYMBOL,&temp) == FALSE) return(FALSE); mname = (SYMBOL_HN *) GetValue(temp); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"message-handler-existp",3,SYMBOL,&temp) == FALSE) return(FALSE); mtype = HandlerType(theEnv,"message-handler-existp",DOToString(temp)); if (mtype == MERROR) { SetEvaluationError(theEnv,TRUE); return(FALSE); } } if (FindHandlerByAddress(cls,mname,mtype) != NULL) return(TRUE); return(FALSE); } /********************************************************************** NAME : SlotWritablePCommand DESCRIPTION : Determines if an existing slot can be written to INPUTS : None RETURNS : TRUE if the slot is writable, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-writablep ) **********************************************************************/ globle intBool SlotWritablePCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-writablep",&theDefclass,TRUE,TRUE); if (sd == NULL) return(FALSE); return((sd->noWrite || sd->initializeOnly) ? FALSE : TRUE); } /*************************************************** NAME : EnvSlotWritableP DESCRIPTION : Determines if a slot is writable INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is writable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotWritableP( void *theEnv, void *theDefclass, const char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); return((sd->noWrite || sd->initializeOnly) ? FALSE : TRUE); } /********************************************************************** NAME : SlotInitablePCommand DESCRIPTION : Determines if an existing slot can be initialized via an init message-handler or slot-override INPUTS : None RETURNS : TRUE if the slot is writable, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-initablep ) **********************************************************************/ globle intBool SlotInitablePCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-initablep",&theDefclass,TRUE,TRUE); if (sd == NULL) return(FALSE); return((sd->noWrite && (sd->initializeOnly == 0)) ? FALSE : TRUE); } /*************************************************** NAME : EnvSlotInitableP DESCRIPTION : Determines if a slot is initable INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is initable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotInitableP( void *theEnv, void *theDefclass, const char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); return((sd->noWrite && (sd->initializeOnly == 0)) ? FALSE : TRUE); } /********************************************************************** NAME : SlotPublicPCommand DESCRIPTION : Determines if an existing slot is publicly visible for direct reference by subclasses INPUTS : None RETURNS : TRUE if the slot is public, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-publicp ) **********************************************************************/ globle intBool SlotPublicPCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-publicp",&theDefclass,TRUE,FALSE); if (sd == NULL) return(FALSE); return(sd->publicVisibility ? TRUE : FALSE); } /*************************************************** NAME : EnvSlotPublicP DESCRIPTION : Determines if a slot is public INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is public, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotPublicP( void *theEnv, void *theDefclass, const char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,FALSE)) == NULL) return(FALSE); return(sd->publicVisibility ? TRUE : FALSE); } /*************************************************** NAME : EnvSlotDefaultP DESCRIPTION : Determines if a slot has a default value INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is public, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvSlotDefaultP( void *theEnv, void *theDefclass, const char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,FALSE)) == NULL) return(NO_DEFAULT); if (sd->noDefault) { return(NO_DEFAULT); } else if (sd->dynamicDefault) { return(DYNAMIC_DEFAULT); } return(STATIC_DEFAULT); } /********************************************************************** NAME : SlotDirectAccessPCommand DESCRIPTION : Determines if an existing slot can be directly referenced by the class - i.e., if the slot is private, is the slot defined in the class INPUTS : None RETURNS : TRUE if the slot is private, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-direct-accessp ) **********************************************************************/ globle intBool SlotDirectAccessPCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-direct-accessp",&theDefclass,TRUE,TRUE); if (sd == NULL) return(FALSE); return((sd->publicVisibility || (sd->cls == theDefclass)) ? TRUE : FALSE); } /*************************************************** NAME : EnvSlotDirectAccessP DESCRIPTION : Determines if a slot is directly accessible from message-handlers on class INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is directly accessible, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotDirectAccessP( void *theEnv, void *theDefclass, const char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); return((sd->publicVisibility || (sd->cls == (DEFCLASS *) theDefclass)) ? TRUE : FALSE); } /********************************************************************** NAME : SlotDefaultValueCommand DESCRIPTION : Determines the default avlue for the specified slot of the specified class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (slot-default-value ) **********************************************************************/ globle void SlotDefaultValueCommand( void *theEnv, DATA_OBJECT_PTR theValue) { DEFCLASS *theDefclass; SLOT_DESC *sd; SetpType(theValue,SYMBOL); SetpValue(theValue,EnvFalseSymbol(theEnv)); sd = CheckSlotExists(theEnv,"slot-default-value",&theDefclass,TRUE,TRUE); if (sd == NULL) return; if (sd->noDefault) { SetpType(theValue,SYMBOL); SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE")); return; } if (sd->dynamicDefault) EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple, (EXPRESSION *) sd->defaultValue, theValue,TRUE); else GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue); } /********************************************************* NAME : SlotDefaultValue DESCRIPTION : Determines the default value for the specified slot of the specified class INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot default value is set, FALSE otherwise SIDE EFFECTS : Slot default value evaluated - dynamic defaults will cause any side effects NOTES : None *********************************************************/ globle intBool EnvSlotDefaultValue( void *theEnv, void *theDefclass, const char *slotName, DATA_OBJECT_PTR theValue) { SLOT_DESC *sd; SetpType(theValue,SYMBOL); SetpValue(theValue,EnvFalseSymbol(theEnv)); if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); if (sd->noDefault) { SetpType(theValue,SYMBOL); SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE")); return(TRUE); } if (sd->dynamicDefault) return(EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple, (EXPRESSION *) sd->defaultValue, theValue,TRUE)); GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue); return(TRUE); } /******************************************************** NAME : ClassExistPCommand DESCRIPTION : Determines if a class exists INPUTS : None RETURNS : TRUE if class exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (class-existp ) ********************************************************/ globle intBool ClassExistPCommand( void *theEnv) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,"class-existp",1,SYMBOL,&temp) == FALSE) return(FALSE); return((LookupDefclassByMdlOrScope(theEnv,DOToString(temp)) != NULL) ? TRUE : FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /****************************************************** NAME : CheckTwoClasses DESCRIPTION : Checks for exactly two class arguments for a H/L function INPUTS : 1) The function name 2) Caller's buffer for first class 3) Caller's buffer for second class RETURNS : TRUE if both found, FALSE otherwise SIDE EFFECTS : Caller's buffers set NOTES : Assumes exactly 2 arguments ******************************************************/ static int CheckTwoClasses( void *theEnv, const char *func, DEFCLASS **c1, DEFCLASS **c2) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE) return(FALSE); *c1 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*c1 == NULL) { ClassExistError(theEnv,func,ValueToString(temp.value)); return(FALSE); } if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE) return(FALSE); *c2 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*c2 == NULL) { ClassExistError(theEnv,func,ValueToString(temp.value)); return(FALSE); } return(TRUE); } /*************************************************** NAME : CheckSlotExists DESCRIPTION : Checks first two arguments of a function for a valid class and (inherited) slot INPUTS : 1) The name of the function 2) A buffer to hold the found class 3) A flag indicating whether the non-existence of the slot should be an error 4) A flag indicating if the slot can be inherited or not RETURNS : NULL if slot not found, slot descriptor otherwise SIDE EFFECTS : Class buffer set if no errors, NULL on errors NOTES : None ***************************************************/ static SLOT_DESC *CheckSlotExists( void *theEnv, const char *func, DEFCLASS **classBuffer, intBool existsErrorFlag, intBool inheritFlag) { SYMBOL_HN *ssym; int slotIndex; SLOT_DESC *sd; ssym = CheckClassAndSlot(theEnv,func,classBuffer); if (ssym == NULL) return(NULL); slotIndex = FindInstanceTemplateSlot(theEnv,*classBuffer,ssym); if (slotIndex == -1) { if (existsErrorFlag) { SlotExistError(theEnv,ValueToString(ssym),func); SetEvaluationError(theEnv,TRUE); } return(NULL); } sd = (*classBuffer)->instanceTemplate[slotIndex]; if ((sd->cls == *classBuffer) || inheritFlag) return(sd); PrintErrorID(theEnv,"CLASSEXM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Inherited slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(ssym)); EnvPrintRouter(theEnv,WERROR," from class "); PrintClassName(theEnv,WERROR,sd->cls,FALSE); EnvPrintRouter(theEnv,WERROR," is not valid for function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,"\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } /*************************************************** NAME : LookupSlot DESCRIPTION : Finds a slot in a class INPUTS : 1) The class 2) The slot name 3) A flag indicating if inherited slots are OK or not RETURNS : The slot descriptor address, or NULL if not found SIDE EFFECTS : None NOTES : None ***************************************************/ static SLOT_DESC *LookupSlot( void *theEnv, DEFCLASS *theDefclass, const char *slotName, intBool inheritFlag) { SYMBOL_HN *slotSymbol; int slotIndex; SLOT_DESC *sd; slotSymbol = FindSymbolHN(theEnv,slotName); if (slotSymbol == NULL) return(NULL); slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,slotSymbol); if (slotIndex == -1) return(NULL); sd = theDefclass->instanceTemplate[slotIndex]; if ((sd->cls != theDefclass) && (inheritFlag == FALSE)) return(NULL); return(sd); } #if DEBUGGING_FUNCTIONS /***************************************************** NAME : CheckClass DESCRIPTION : Used for to check class name for class accessor functions such as ppdefclass and undefclass INPUTS : 1) The name of the H/L function 2) Name of the class RETURNS : The class address, or NULL if ther was an error SIDE EFFECTS : None NOTES : None ******************************************************/ static DEFCLASS *CheckClass( void *theEnv, const char *func, const char *cname) { DEFCLASS *cls; cls = LookupDefclassByMdlOrScope(theEnv,cname); if (cls == NULL) ClassExistError(theEnv,func,cname); return(cls); } /********************************************************* NAME : GetClassNameArgument DESCRIPTION : Gets a class name-string INPUTS : Calling function name RETURNS : Class name (NULL on errors) SIDE EFFECTS : None NOTES : Assumes only 1 argument *********************************************************/ static const char *GetClassNameArgument( void *theEnv, const char *fname) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,fname,1,SYMBOL,&temp) == FALSE) return(NULL); return(DOToString(temp)); } /**************************************************************** NAME : PrintClassBrowse DESCRIPTION : Displays a "graph" of class and subclasses INPUTS : 1) The logical name of the output 2) The class address 3) The depth of the graph RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ****************************************************************/ static void PrintClassBrowse( void *theEnv, const char *logicalName, DEFCLASS *cls, long depth) { long i; for (i = 0 ; i < depth ; i++) EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,EnvGetDefclassName(theEnv,(void *) cls)); if (cls->directSuperclasses.classCount > 1) EnvPrintRouter(theEnv,logicalName," *"); EnvPrintRouter(theEnv,logicalName,"\n"); for (i = 0 ;i < cls->directSubclasses.classCount ; i++) PrintClassBrowse(theEnv,logicalName,cls->directSubclasses.classArray[i],depth+1); } /********************************************************* NAME : DisplaySeparator DESCRIPTION : Prints a separator line for DescribeClass INPUTS : 1) The logical name of the output 2) The buffer to use for the line 3) The buffer size 4) The character to use RETURNS : Nothing useful SIDE EFFECTS : Buffer overwritten and displayed NOTES : None *********************************************************/ static void DisplaySeparator( void *theEnv, const char *logicalName, char *buf, int maxlen, int sepchar) { register int i; for (i = 0 ; i < maxlen-2 ; i++) buf[i] = (char) sepchar; buf[i++] = '\n'; buf[i] = '\0'; EnvPrintRouter(theEnv,logicalName,buf); } /************************************************************* NAME : DisplaySlotBasicInfo DESCRIPTION : Displays a table summary of basic facets for the slots of a class including: single/multiple default/no-default/default-dynamic inherit/no-inherit read-write/initialize-only/read-only local/shared composite/exclusive reactive/non-reactive public/private create-accessor read/write override-message The function also displays the source class(es) for the facets INPUTS : 1) The logical name of the output 2) A format string for use in sprintf (for printing slot names) 3) A format string for use in sprintf (for printing slot override message names) 4) A buffer to store the display in 5) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Buffer written to and displayed NOTES : None *************************************************************/ static void DisplaySlotBasicInfo( void *theEnv, const char *logicalName, const char *slotNamePrintFormat, const char *overrideMessagePrintFormat, char *buf, DEFCLASS *cls) { long i; SLOT_DESC *sp; const char *createString; gensprintf(buf,slotNamePrintFormat,"SLOTS"); #if DEFRULE_CONSTRUCT genstrcat(buf,"FLD DEF PRP ACC STO MCH SRC VIS CRT "); #else genstrcat(buf,"FLD DEF PRP ACC STO SRC VIS CRT "); #endif EnvPrintRouter(theEnv,logicalName,buf); gensprintf(buf,overrideMessagePrintFormat,"OVRD-MSG"); EnvPrintRouter(theEnv,logicalName,buf); EnvPrintRouter(theEnv,logicalName,"SOURCE(S)\n"); for (i = 0 ; i < cls->instanceSlotCount ; i++) { sp = cls->instanceTemplate[i]; gensprintf(buf,slotNamePrintFormat,ValueToString(sp->slotName->name)); genstrcat(buf,sp->multiple ? "MLT " : "SGL "); if (sp->noDefault) genstrcat(buf,"NIL "); else genstrcat(buf,sp->dynamicDefault ? "DYN " : "STC "); genstrcat(buf,sp->noInherit ? "NIL " : "INH "); if (sp->initializeOnly) genstrcat(buf,"INT "); else if (sp->noWrite) genstrcat(buf," R "); else genstrcat(buf,"RW "); genstrcat(buf,sp->shared ? "SHR " : "LCL "); #if DEFRULE_CONSTRUCT genstrcat(buf,sp->reactive ? "RCT " : "NIL "); #endif genstrcat(buf,sp->composite ? "CMP " : "EXC "); genstrcat(buf,sp->publicVisibility ? "PUB " : "PRV "); createString = GetCreateAccessorString(sp); if (createString[1] == '\0') genstrcat(buf," "); genstrcat(buf,createString); if ((createString[1] == '\0') ? TRUE : (createString[2] == '\0')) genstrcat(buf," "); genstrcat(buf," "); EnvPrintRouter(theEnv,logicalName,buf); gensprintf(buf,overrideMessagePrintFormat, sp->noWrite ? "NIL" : ValueToString(sp->overrideMessage)); EnvPrintRouter(theEnv,logicalName,buf); PrintSlotSources(theEnv,logicalName,sp->slotName->name,&sp->cls->allSuperclasses,0,TRUE); EnvPrintRouter(theEnv,logicalName,"\n"); } } /*************************************************** NAME : PrintSlotSources DESCRIPTION : Displays a list of source classes for a composite class (in order of most general to specific) INPUTS : 1) The logical name of the output 2) The name of the slot 3) The precedence list of the class of the slot (the source class shold be first in the list) 4) The index into the packed links array 5) Flag indicating whether to disregard noniherit facet RETURNS : TRUE if a class is printed, FALSE otherwise SIDE EFFECTS : Recursively prints out appropriate memebers from list in reverse order NOTES : None ***************************************************/ static intBool PrintSlotSources( void *theEnv, const char *logicalName, SYMBOL_HN *sname, PACKED_CLASS_LINKS *sprec, long theIndex, int inhp) { SLOT_DESC *csp; if (theIndex == sprec->classCount) return(FALSE); csp = FindClassSlot(sprec->classArray[theIndex],sname); if ((csp != NULL) ? ((csp->noInherit == 0) || inhp) : FALSE) { if (csp->composite) { if (PrintSlotSources(theEnv,logicalName,sname,sprec,theIndex+1,FALSE)) EnvPrintRouter(theEnv,logicalName," "); } PrintClassName(theEnv,logicalName,sprec->classArray[theIndex],FALSE); return(TRUE); } else return(PrintSlotSources(theEnv,logicalName,sname,sprec,theIndex+1,FALSE)); } /********************************************************* NAME : DisplaySlotConstraintInfo DESCRIPTION : Displays a table summary of type-checking facets for the slots of a class including: type allowed-symbols allowed-integers allowed-floats allowed-values allowed-instance-names range min-number-of-elements max-number-of-elements The function also displays the source class(es) for the facets INPUTS : 1) A format string for use in sprintf 2) A buffer to store the display in 3) Maximum buffer size 4) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Buffer written to and displayed NOTES : None *********************************************************/ static void DisplaySlotConstraintInfo( void *theEnv, const char *logicalName, const char *slotNamePrintFormat, char *buf, unsigned maxlen, DEFCLASS *cls) { long i; CONSTRAINT_RECORD *cr; const char *strdest = "***describe-class***"; gensprintf(buf,slotNamePrintFormat,"SLOTS"); genstrcat(buf,"SYM STR INN INA EXA FTA INT FLT\n"); EnvPrintRouter(theEnv,logicalName,buf); for (i = 0 ; i < cls->instanceSlotCount ; i++) { cr = cls->instanceTemplate[i]->constraint; gensprintf(buf,slotNamePrintFormat,ValueToString(cls->instanceTemplate[i]->slotName->name)); if (cr != NULL) { genstrcat(buf,ConstraintCode(cr,(unsigned) cr->symbolsAllowed, (unsigned) cr->symbolRestriction)); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->stringsAllowed, (unsigned) cr->stringRestriction)); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->instanceNamesAllowed, (unsigned) (cr->instanceNameRestriction || cr->classRestriction))); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->instanceAddressesAllowed, (unsigned) cr->classRestriction)); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->externalAddressesAllowed,0)); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->factAddressesAllowed,0)); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->integersAllowed, (unsigned) cr->integerRestriction)); genstrcat(buf,ConstraintCode(cr,(unsigned) cr->floatsAllowed, (unsigned) cr->floatRestriction)); OpenStringDestination(theEnv,strdest,buf + strlen(buf),(maxlen - strlen(buf) - 1)); if (cr->integersAllowed || cr->floatsAllowed || cr->anyAllowed) { EnvPrintRouter(theEnv,strdest,"RNG:["); PrintExpression(theEnv,strdest,cr->minValue); EnvPrintRouter(theEnv,strdest,".."); PrintExpression(theEnv,strdest,cr->maxValue); EnvPrintRouter(theEnv,strdest,"] "); } if (cls->instanceTemplate[i]->multiple) { EnvPrintRouter(theEnv,strdest,"CRD:["); PrintExpression(theEnv,strdest,cr->minFields); EnvPrintRouter(theEnv,strdest,".."); PrintExpression(theEnv,strdest,cr->maxFields); EnvPrintRouter(theEnv,strdest,"]"); } } else { OpenStringDestination(theEnv,strdest,buf,maxlen); EnvPrintRouter(theEnv,strdest," + + + + + + + + RNG:[-oo..+oo]"); if (cls->instanceTemplate[i]->multiple) EnvPrintRouter(theEnv,strdest," CRD:[0..+oo]"); } EnvPrintRouter(theEnv,strdest,"\n"); CloseStringDestination(theEnv,strdest); EnvPrintRouter(theEnv,logicalName,buf); } } /****************************************************** NAME : ConstraintCode DESCRIPTION : Gives a string code representing the type of constraint INPUTS : 1) The constraint record 2) Allowed Flag 3) Restricted Values flag RETURNS : " " for type not allowed " + " for any value of type allowed " # " for some values of type allowed SIDE EFFECTS : None NOTES : Used by DisplaySlotConstraintInfo ******************************************************/ static const char *ConstraintCode( CONSTRAINT_RECORD *cr, unsigned allow, unsigned restrictValues) { if (allow || cr->anyAllowed) { if (restrictValues || cr->anyRestriction) return " # "; else return " + "; } return(" "); } #endif /*##################################*/ /* Additional Environment Functions */ /*##################################*/ #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS globle void BrowseClasses( const char *logicalName, void *clsptr) { EnvBrowseClasses(GetCurrentEnvironment(),logicalName,clsptr); } globle void DescribeClass( const char *logicalName, void *clsptr) { EnvDescribeClass(GetCurrentEnvironment(),logicalName,clsptr); } #endif globle intBool SlotDirectAccessP( void *theDefclass, const char *slotName) { return EnvSlotDirectAccessP(GetCurrentEnvironment(),theDefclass,slotName); } globle intBool SlotExistP( void *theDefclass, const char *slotName, intBool inheritFlag) { return EnvSlotExistP(GetCurrentEnvironment(),theDefclass,slotName,inheritFlag); } globle intBool SlotInitableP( void *theDefclass, const char *slotName) { return EnvSlotInitableP(GetCurrentEnvironment(),theDefclass,slotName); } globle intBool SlotPublicP( void *theDefclass, const char *slotName) { return EnvSlotPublicP(GetCurrentEnvironment(),theDefclass,slotName); } globle int SlotDefaultP( void *theDefclass, const char *slotName) { return EnvSlotDefaultP(GetCurrentEnvironment(),theDefclass,slotName); } globle intBool SlotWritableP( void *theDefclass, const char *slotName) { return EnvSlotWritableP(GetCurrentEnvironment(),theDefclass,slotName); } globle intBool SubclassP( void *firstClass, void *secondClass) { return EnvSubclassP(GetCurrentEnvironment(),firstClass,secondClass); } globle intBool SuperclassP( void *firstClass, void *secondClass) { return EnvSuperclassP(GetCurrentEnvironment(),firstClass,secondClass); } globle intBool SlotDefaultValue( void *theDefclass, const char *slotName, DATA_OBJECT_PTR theValue) { return EnvSlotDefaultValue(GetCurrentEnvironment(),theDefclass,slotName,theValue); } #endif #endif clips_core_source_630/core/dffctbin.h0000755000175000017500000000434712373730714016200 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFFACTS BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #if (! RUN_TIME) #ifndef _H_dffctbin #define _H_dffctbin #include "modulbin.h" #include "cstrcbin.h" #ifndef _H_constrct #include "constrct.h" #endif struct bsaveDeffacts { struct bsaveConstructHeader header; long assertList; }; struct bsaveDeffactsModule { struct bsaveDefmoduleItemHeader header; }; #define DFFCTBIN_DATA 26 struct deffactsBinaryData { struct deffacts *DeffactsArray; long NumberOfDeffacts; struct deffactsModule *ModuleArray; long NumberOfDeffactsModules; }; #define DeffactsBinaryData(theEnv) ((struct deffactsBinaryData *) GetEnvironmentData(theEnv,DFFCTBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeffactsBinarySetup(void *); LOCALE void *BloadDeffactsModuleReference(void *,int); #endif /* _H_dffctbin */ #endif /* (! RUN_TIME) */ clips_core_source_630/core/rulebld.h0000755000175000017500000000457012374024065016044 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE BUILD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines to ntegrates a set of pattern */ /* and join tests associated with a rule into the pattern */ /* and join networks. The joins are integrated into the */ /* join network by routines in this module. The pattern */ /* is integrated by calling the external routine */ /* associated with the pattern parser that originally */ /* parsed the pattern. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Changes to constructing join network. */ /* */ /* Added support for hashed memories. */ /* */ /*************************************************************/ #ifndef _H_rulebld #define _H_rulebld #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEBLD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct joinNode *ConstructJoins(void *,int,struct lhsParseNode *,int,struct joinNode *,int,int); #endif /* _H_rulebld */ clips_core_source_630/core/._cstrnpsr.h0000755000175000017500000000040712374023223016474 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtbin.c0000755000175000017500000000040712374023204016421 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._memalloc.c0000755000175000017500000000040712512771563016415 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/utility.c0000755000175000017500000011350712464470634016121 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/03/15 */ /* */ /* UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. Primarily these are the functions for */ /* handling periodic garbage collection and appending */ /* string data. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* Jeff Bezanson */ /* www.cprogramming.com/tutorial/unicode.html */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added CopyString, DeleteString, */ /* InsertInString,and EnlargeString functions. */ /* */ /* Used genstrncpy function instead of strncpy */ /* function. */ /* */ /* Support for typed EXTERNAL_ADDRESS. */ /* */ /* Support for tracked memory (allows memory to */ /* be freed if CLIPS is exited while executing). */ /* */ /* Added UTF-8 routines. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _UTILITY_SOURCE_ #include "setup.h" #include #include #include #define _STDIO_INCLUDED_ #include #include "commline.h" #include "envrnmnt.h" #include "evaluatn.h" #include "facthsh.h" #include "memalloc.h" #include "multifld.h" #include "prntutil.h" #include "sysdep.h" #include "utility.h" #define MAX_EPHEMERAL_COUNT 1000L #define MAX_EPHEMERAL_SIZE 10240L #define COUNT_INCREMENT 1000L #define SIZE_INCREMENT 10240L /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocateUtilityData(void *); /************************************************/ /* InitializeUtilityData: Allocates environment */ /* data for utility routines. */ /************************************************/ globle void InitializeUtilityData( void *theEnv) { AllocateEnvironmentData(theEnv,UTILITY_DATA,sizeof(struct utilityData),DeallocateUtilityData); UtilityData(theEnv)->CurrentGarbageFrame = &UtilityData(theEnv)->MasterGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame->topLevel = TRUE; UtilityData(theEnv)->GarbageCollectionLocks = 0; UtilityData(theEnv)->PeriodicFunctionsEnabled = TRUE; UtilityData(theEnv)->YieldFunctionEnabled = TRUE; } /**************************************************/ /* DeallocateUtilityData: Deallocates environment */ /* data for utility routines. */ /**************************************************/ static void DeallocateUtilityData( void *theEnv) { struct callFunctionItem *tmpPtr, *nextPtr; struct trackedMemory *tmpTM, *nextTM; struct garbageFrame *theGarbageFrame; struct ephemeron *edPtr, *nextEDPtr; struct multifield *tmpMFPtr, *nextMFPtr; /*======================*/ /* Free tracked memory. */ /*======================*/ tmpTM = UtilityData(theEnv)->trackList; while (tmpTM != NULL) { nextTM = tmpTM->next; genfree(theEnv,tmpTM->theMemory,tmpTM->memSize); rtn_struct(theEnv,trackedMemory,tmpTM); tmpTM = nextTM; } /*==========================*/ /* Free callback functions. */ /*==========================*/ tmpPtr = UtilityData(theEnv)->ListOfPeriodicFunctions; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,callFunctionItem,tmpPtr); tmpPtr = nextPtr; } tmpPtr = UtilityData(theEnv)->ListOfCleanupFunctions; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,callFunctionItem,tmpPtr); tmpPtr = nextPtr; } /*=========================================*/ /* Free the ephemerons tracking data which */ /* needs to be garbage collected. */ /*=========================================*/ while (UtilityData(theEnv)->CurrentGarbageFrame != NULL) { theGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; edPtr = theGarbageFrame->ephemeralSymbolList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = theGarbageFrame->ephemeralFloatList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = theGarbageFrame->ephemeralIntegerList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = theGarbageFrame->ephemeralBitMapList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = theGarbageFrame->ephemeralExternalAddressList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } /*==========================*/ /* Free up multifield data. */ /*==========================*/ tmpMFPtr = theGarbageFrame->ListOfMultifields; while (tmpMFPtr != NULL) { nextMFPtr = tmpMFPtr->next; ReturnMultifield(theEnv,tmpMFPtr); tmpMFPtr = nextMFPtr; } UtilityData(theEnv)->CurrentGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame->priorFrame; } } /*****************************/ /* CleanCurrentGarbageFrame: */ /*****************************/ globle void CleanCurrentGarbageFrame( void *theEnv, DATA_OBJECT *returnValue) { struct garbageFrame *currentGarbageFrame; currentGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; if (! currentGarbageFrame->dirty) return; if (returnValue != NULL) { ValueInstall(theEnv,returnValue); } CallCleanupFunctions(theEnv); RemoveEphemeralAtoms(theEnv); FlushMultifields(theEnv); if (returnValue != NULL) { ValueDeinstall(theEnv,returnValue); } if ((currentGarbageFrame->ephemeralFloatList == NULL) && (currentGarbageFrame->ephemeralIntegerList == NULL) && (currentGarbageFrame->ephemeralSymbolList == NULL) && (currentGarbageFrame->ephemeralBitMapList == NULL) && (currentGarbageFrame->ephemeralExternalAddressList == NULL) && (currentGarbageFrame->LastMultifield == NULL)) { currentGarbageFrame->dirty = FALSE; } } /*****************************/ /* RestorePriorGarbageFrame: */ /*****************************/ globle void RestorePriorGarbageFrame( void *theEnv, struct garbageFrame *newGarbageFrame, struct garbageFrame *oldGarbageFrame, DATA_OBJECT *returnValue) { if (newGarbageFrame->dirty) { if (returnValue != NULL) ValueInstall(theEnv,returnValue); CallCleanupFunctions(theEnv); RemoveEphemeralAtoms(theEnv); FlushMultifields(theEnv); } UtilityData(theEnv)->CurrentGarbageFrame = oldGarbageFrame; if (newGarbageFrame->dirty) { if (newGarbageFrame->ListOfMultifields != NULL) { if (oldGarbageFrame->ListOfMultifields == NULL) { oldGarbageFrame->ListOfMultifields = newGarbageFrame->ListOfMultifields; } else { oldGarbageFrame->LastMultifield->next = newGarbageFrame->ListOfMultifields; } oldGarbageFrame->LastMultifield = newGarbageFrame->LastMultifield; oldGarbageFrame->dirty = TRUE; } if (returnValue != NULL) ValueDeinstall(theEnv,returnValue); } if (returnValue != NULL) { EphemerateValue(theEnv,returnValue->type,returnValue->value); } } /*************************/ /* CallCleanupFunctions: */ /*************************/ globle void CallCleanupFunctions( void *theEnv) { struct callFunctionItem *cleanupPtr; for (cleanupPtr = UtilityData(theEnv)->ListOfCleanupFunctions; cleanupPtr != NULL; cleanupPtr = cleanupPtr->next) { if (cleanupPtr->environmentAware) { (*cleanupPtr->func)(theEnv); } else { (* (void (*)(void)) cleanupPtr->func)(); } } } /**************************************************/ /* CallPeriodicTasks: Calls the list of functions */ /* for handling periodic tasks. */ /**************************************************/ globle void CallPeriodicTasks( void *theEnv) { struct callFunctionItem *periodPtr; if (UtilityData(theEnv)->PeriodicFunctionsEnabled) { for (periodPtr = UtilityData(theEnv)->ListOfPeriodicFunctions; periodPtr != NULL; periodPtr = periodPtr->next) { if (periodPtr->environmentAware) { (*periodPtr->func)(theEnv); } else { (* (void (*)(void)) periodPtr->func)(); } } } } /***************************************************/ /* AddCleanupFunction: Adds a function to the list */ /* of functions called to perform cleanup such */ /* as returning free memory to the memory pool. */ /***************************************************/ globle intBool AddCleanupFunction( void *theEnv, const char *name, void (*theFunction)(void *), int priority) { UtilityData(theEnv)->ListOfCleanupFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) theFunction, UtilityData(theEnv)->ListOfCleanupFunctions,TRUE); return(1); } #if ALLOW_ENVIRONMENT_GLOBALS /****************************************************/ /* AddPeriodicFunction: Adds a function to the list */ /* of functions called to handle periodic tasks. */ /****************************************************/ globle intBool AddPeriodicFunction( const char *name, void (*theFunction)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); UtilityData(theEnv)->ListOfPeriodicFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) theFunction, UtilityData(theEnv)->ListOfPeriodicFunctions,FALSE); return(1); } #endif /*******************************************************/ /* EnvAddPeriodicFunction: Adds a function to the list */ /* of functions called to handle periodic tasks. */ /*******************************************************/ globle intBool EnvAddPeriodicFunction( void *theEnv, const char *name, void (*theFunction)(void *), int priority) { UtilityData(theEnv)->ListOfPeriodicFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) theFunction, UtilityData(theEnv)->ListOfPeriodicFunctions,TRUE); return(1); } /*******************************************************/ /* RemoveCleanupFunction: Removes a function from the */ /* list of functions called to perform cleanup such */ /* as returning free memory to the memory pool. */ /*******************************************************/ globle intBool RemoveCleanupFunction( void *theEnv, const char *name) { intBool found; UtilityData(theEnv)->ListOfCleanupFunctions = RemoveFunctionFromCallList(theEnv,name,UtilityData(theEnv)->ListOfCleanupFunctions,&found); return found; } /**********************************************************/ /* EnvRemovePeriodicFunction: Removes a function from the */ /* list of functions called to handle periodic tasks. */ /**********************************************************/ globle intBool EnvRemovePeriodicFunction( void *theEnv, const char *name) { intBool found; UtilityData(theEnv)->ListOfPeriodicFunctions = RemoveFunctionFromCallList(theEnv,name,UtilityData(theEnv)->ListOfPeriodicFunctions,&found); return found; } /*****************************************************/ /* StringPrintForm: Generates printed representation */ /* of a string. Replaces / with // and " with /". */ /*****************************************************/ globle const char *StringPrintForm( void *theEnv, const char *str) { int i = 0; size_t pos = 0; size_t max = 0; char *theString = NULL; void *thePtr; theString = ExpandStringWithChar(theEnv,'"',theString,&pos,&max,max+80); while (str[i] != EOS) { if ((str[i] == '"') || (str[i] == '\\')) { theString = ExpandStringWithChar(theEnv,'\\',theString,&pos,&max,max+80); theString = ExpandStringWithChar(theEnv,str[i],theString,&pos,&max,max+80); } else { theString = ExpandStringWithChar(theEnv,str[i],theString,&pos,&max,max+80); } i++; } theString = ExpandStringWithChar(theEnv,'"',theString,&pos,&max,max+80); thePtr = EnvAddSymbol(theEnv,theString); rm(theEnv,theString,max); return(ValueToString(thePtr)); } /**************************************************************/ /* CopyString: Copies a string using CLIPS memory management. */ /**************************************************************/ globle char *CopyString( void *theEnv, const char *theString) { char *stringCopy = NULL; if (theString != NULL) { stringCopy = (char *) genalloc(theEnv,strlen(theString) + 1); genstrcpy(stringCopy,theString); } return stringCopy; } /*****************************************************************/ /* DeleteString: Deletes a string using CLIPS memory management. */ /*****************************************************************/ globle void DeleteString( void *theEnv, char *theString) { if (theString != NULL) { genfree(theEnv,theString,strlen(theString) + 1); } } /***********************************************************/ /* AppendStrings: Appends two strings together. The string */ /* created is added to the SymbolTable, so it is not */ /* necessary to deallocate the string returned. */ /***********************************************************/ globle const char *AppendStrings( void *theEnv, const char *str1, const char *str2) { size_t pos = 0; size_t max = 0; char *theString = NULL; void *thePtr; theString = AppendToString(theEnv,str1,theString,&pos,&max); theString = AppendToString(theEnv,str2,theString,&pos,&max); thePtr = EnvAddSymbol(theEnv,theString); rm(theEnv,theString,max); return(ValueToString(thePtr)); } /******************************************************/ /* AppendToString: Appends a string to another string */ /* (expanding the other string if necessary). */ /******************************************************/ globle char *AppendToString( void *theEnv, const char *appendStr, char *oldStr, size_t *oldPos, size_t *oldMax) { size_t length; /*=========================================*/ /* Expand the old string so it can contain */ /* the new string (if necessary). */ /*=========================================*/ length = strlen(appendStr); /*==============================================================*/ /* Return NULL if the old string was not successfully expanded. */ /*==============================================================*/ if ((oldStr = EnlargeString(theEnv,length,oldStr,oldPos,oldMax)) == NULL) { return(NULL); } /*===============================================*/ /* Append the new string to the expanded string. */ /*===============================================*/ genstrcpy(&oldStr[*oldPos],appendStr); *oldPos += (int) length; /*============================================================*/ /* Return the expanded string containing the appended string. */ /*============================================================*/ return(oldStr); } /**********************************************************/ /* InsertInString: Inserts a string within another string */ /* (expanding the other string if necessary). */ /**********************************************************/ globle char *InsertInString( void *theEnv, const char *insertStr, size_t position, char *oldStr, size_t *oldPos, size_t *oldMax) { size_t length; /*=========================================*/ /* Expand the old string so it can contain */ /* the new string (if necessary). */ /*=========================================*/ length = strlen(insertStr); /*==============================================================*/ /* Return NULL if the old string was not successfully expanded. */ /*==============================================================*/ if ((oldStr = EnlargeString(theEnv,length,oldStr,oldPos,oldMax)) == NULL) { return(NULL); } /*================================================================*/ /* Shift the contents to the right of insertion point so that the */ /* new text does not overwrite what is currently in the string. */ /*================================================================*/ memmove(&oldStr[position],&oldStr[position+length],*oldPos - position); /*===============================================*/ /* Insert the new string in the expanded string. */ /*===============================================*/ genstrncpy(&oldStr[*oldPos],insertStr,length); *oldPos += (int) length; /*============================================================*/ /* Return the expanded string containing the appended string. */ /*============================================================*/ return(oldStr); } /*******************************************************************/ /* EnlargeString: Enlarges a string by the specified amount. */ /*******************************************************************/ globle char *EnlargeString( void *theEnv, size_t length, char *oldStr, size_t *oldPos, size_t *oldMax) { /*=========================================*/ /* Expand the old string so it can contain */ /* the new string (if necessary). */ /*=========================================*/ if (length + *oldPos + 1 > *oldMax) { oldStr = (char *) genrealloc(theEnv,oldStr,*oldMax,length + *oldPos + 1); *oldMax = length + *oldPos + 1; } /*==============================================================*/ /* Return NULL if the old string was not successfully expanded. */ /*==============================================================*/ if (oldStr == NULL) { return(NULL); } return(oldStr); } /*******************************************************/ /* AppendNToString: Appends a string to another string */ /* (expanding the other string if necessary). Only a */ /* specified number of characters are appended from */ /* the string. */ /*******************************************************/ globle char *AppendNToString( void *theEnv, const char *appendStr, char *oldStr, size_t length, size_t *oldPos, size_t *oldMax) { size_t lengthWithEOS; /*====================================*/ /* Determine the number of characters */ /* to be appended from the string. */ /*====================================*/ if (appendStr[length-1] != '\0') lengthWithEOS = length + 1; else lengthWithEOS = length; /*=========================================*/ /* Expand the old string so it can contain */ /* the new string (if necessary). */ /*=========================================*/ if (lengthWithEOS + *oldPos > *oldMax) { oldStr = (char *) genrealloc(theEnv,oldStr,*oldMax,*oldPos + lengthWithEOS); *oldMax = *oldPos + lengthWithEOS; } /*==============================================================*/ /* Return NULL if the old string was not successfully expanded. */ /*==============================================================*/ if (oldStr == NULL) { return(NULL); } /*==================================*/ /* Append N characters from the new */ /* string to the expanded string. */ /*==================================*/ genstrncpy(&oldStr[*oldPos],appendStr,length); *oldPos += (lengthWithEOS - 1); oldStr[*oldPos] = '\0'; /*============================================================*/ /* Return the expanded string containing the appended string. */ /*============================================================*/ return(oldStr); } /*******************************************************/ /* ExpandStringWithChar: Adds a character to a string, */ /* reallocating space for the string if it needs to */ /* be enlarged. The backspace character causes the */ /* size of the string to reduced if it is "added" to */ /* the string. */ /*******************************************************/ globle char *ExpandStringWithChar( void *theEnv, int inchar, char *str, size_t *pos, size_t *max, size_t newSize) { if ((*pos + 1) >= *max) { str = (char *) genrealloc(theEnv,str,*max,newSize); *max = newSize; } if (inchar != '\b') { str[*pos] = (char) inchar; (*pos)++; str[*pos] = '\0'; } else { /*===========================================================*/ /* First delete any UTF-8 multibyte continuation characters. */ /*===========================================================*/ while ((*pos > 1) && IsUTF8MultiByteContinuation(str[*pos - 1])) { (*pos)--; } /*===================================================*/ /* Now delete the first byte of the UTF-8 character. */ /*===================================================*/ if (*pos > 0) (*pos)--; str[*pos] = '\0'; } return(str); } /*****************************************************************/ /* AddFunctionToCallList: Adds a function to a list of functions */ /* which are called to perform certain operations (e.g. clear, */ /* reset, and bload functions). */ /*****************************************************************/ globle struct callFunctionItem *AddFunctionToCallList( void *theEnv, const char *name, int priority, void (*func)(void *), struct callFunctionItem *head, intBool environmentAware) { return AddFunctionToCallListWithContext(theEnv,name,priority,func,head,environmentAware,NULL); } /***********************************************************/ /* AddFunctionToCallListWithContext: Adds a function to a */ /* list of functions which are called to perform certain */ /* operations (e.g. clear, reset, and bload functions). */ /***********************************************************/ globle struct callFunctionItem *AddFunctionToCallListWithContext( void *theEnv, const char *name, int priority, void (*func)(void *), struct callFunctionItem *head, intBool environmentAware, void *context) { struct callFunctionItem *newPtr, *currentPtr, *lastPtr = NULL; newPtr = get_struct(theEnv,callFunctionItem); newPtr->name = name; newPtr->func = func; newPtr->priority = priority; newPtr->environmentAware = (short) environmentAware; newPtr->context = context; if (head == NULL) { newPtr->next = NULL; return(newPtr); } currentPtr = head; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = head; head = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(head); } /*****************************************************************/ /* RemoveFunctionFromCallList: Removes a function from a list of */ /* functions which are called to perform certain operations */ /* (e.g. clear, reset, and bload functions). */ /*****************************************************************/ globle struct callFunctionItem *RemoveFunctionFromCallList( void *theEnv, const char *name, struct callFunctionItem *head, int *found) { struct callFunctionItem *currentPtr, *lastPtr; *found = FALSE; lastPtr = NULL; currentPtr = head; while (currentPtr != NULL) { if (strcmp(name,currentPtr->name) == 0) { *found = TRUE; if (lastPtr == NULL) { head = currentPtr->next; } else { lastPtr->next = currentPtr->next; } rtn_struct(theEnv,callFunctionItem,currentPtr); return(head); } lastPtr = currentPtr; currentPtr = currentPtr->next; } return(head); } /**************************************************************/ /* DeallocateCallList: Removes all functions from a list of */ /* functions which are called to perform certain operations */ /* (e.g. clear, reset, and bload functions). */ /**************************************************************/ globle void DeallocateCallList( void *theEnv, struct callFunctionItem *theList) { struct callFunctionItem *tmpPtr, *nextPtr; tmpPtr = theList; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,callFunctionItem,tmpPtr); tmpPtr = nextPtr; } } /***************************************************************/ /* AddFunctionToCallListWithArg: Adds a function to a list of */ /* functions which are called to perform certain operations */ /* (e.g. clear,reset, and bload functions). */ /***************************************************************/ globle struct callFunctionItemWithArg *AddFunctionToCallListWithArg( void *theEnv, const char *name, int priority, void (*func)(void *, void *), struct callFunctionItemWithArg *head, intBool environmentAware) { return AddFunctionToCallListWithArgWithContext(theEnv,name,priority,func,head,environmentAware,NULL); } /***************************************************************/ /* AddFunctionToCallListWithArgWithContext: Adds a function to */ /* a list of functions which are called to perform certain */ /* operations (e.g. clear, reset, and bload functions). */ /***************************************************************/ globle struct callFunctionItemWithArg *AddFunctionToCallListWithArgWithContext( void *theEnv, const char *name, int priority, void (*func)(void *, void *), struct callFunctionItemWithArg *head, intBool environmentAware, void *context) { struct callFunctionItemWithArg *newPtr, *currentPtr, *lastPtr = NULL; newPtr = get_struct(theEnv,callFunctionItemWithArg); newPtr->name = name; newPtr->func = func; newPtr->priority = priority; newPtr->environmentAware = (short) environmentAware; newPtr->context = context; if (head == NULL) { newPtr->next = NULL; return(newPtr); } currentPtr = head; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = head; head = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(head); } /**************************************************************/ /* RemoveFunctionFromCallListWithArg: Removes a function from */ /* a list of functions which are called to perform certain */ /* operations (e.g. clear, reset, and bload functions). */ /**************************************************************/ globle struct callFunctionItemWithArg *RemoveFunctionFromCallListWithArg( void *theEnv, const char *name, struct callFunctionItemWithArg *head, int *found) { struct callFunctionItemWithArg *currentPtr, *lastPtr; *found = FALSE; lastPtr = NULL; currentPtr = head; while (currentPtr != NULL) { if (strcmp(name,currentPtr->name) == 0) { *found = TRUE; if (lastPtr == NULL) { head = currentPtr->next; } else { lastPtr->next = currentPtr->next; } rtn_struct(theEnv,callFunctionItemWithArg,currentPtr); return(head); } lastPtr = currentPtr; currentPtr = currentPtr->next; } return(head); } /**************************************************************/ /* DeallocateCallListWithArg: Removes all functions from a list of */ /* functions which are called to perform certain operations */ /* (e.g. clear, reset, and bload functions). */ /**************************************************************/ globle void DeallocateCallListWithArg( void *theEnv, struct callFunctionItemWithArg *theList) { struct callFunctionItemWithArg *tmpPtr, *nextPtr; tmpPtr = theList; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,callFunctionItemWithArg,tmpPtr); tmpPtr = nextPtr; } } /*****************************************/ /* ItemHashValue: Returns the hash value */ /* for the specified value. */ /*****************************************/ globle unsigned long ItemHashValue( void *theEnv, unsigned short theType, void *theValue, unsigned long theRange) { union { void *vv; unsigned uv; } fis; switch(theType) { case FLOAT: return(HashFloat(ValueToDouble(theValue),theRange)); case INTEGER: return(HashInteger(ValueToLong(theValue),theRange)); case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif return(HashSymbol(ValueToString(theValue),theRange)); case MULTIFIELD: return(HashMultifield((struct multifield *) theValue,theRange)); #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS: return(((struct fact *) theValue)->hashValue % theRange); #endif case EXTERNAL_ADDRESS: return(HashExternalAddress(ValueToExternalAddress(theValue),theRange)); #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif fis.uv = 0; fis.vv = theValue; return(fis.uv % theRange); } SystemError(theEnv,"UTILITY",1); return(0); } /********************************************/ /* YieldTime: Yields time to a user-defined */ /* function. Intended to allow foreground */ /* application responsiveness when CLIPS */ /* is running in the background. */ /********************************************/ globle void YieldTime( void *theEnv) { if ((UtilityData(theEnv)->YieldTimeFunction != NULL) && UtilityData(theEnv)->YieldFunctionEnabled) { (*UtilityData(theEnv)->YieldTimeFunction)(); } } /**********************************************/ /* EnvIncrementGCLocks: Increments the number */ /* of garbage collection locks. */ /**********************************************/ globle void EnvIncrementGCLocks( void *theEnv) { UtilityData(theEnv)->GarbageCollectionLocks++; } /**********************************************/ /* EnvDecrementGCLocks: Decrements the number */ /* of garbage collection locks. */ /**********************************************/ globle void EnvDecrementGCLocks( void *theEnv) { if (UtilityData(theEnv)->GarbageCollectionLocks > 0) { UtilityData(theEnv)->GarbageCollectionLocks--; } if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } } /********************************************/ /* EnablePeriodicFunctions: */ /********************************************/ globle short EnablePeriodicFunctions( void *theEnv, short value) { short oldValue; oldValue = UtilityData(theEnv)->PeriodicFunctionsEnabled; UtilityData(theEnv)->PeriodicFunctionsEnabled = value; return(oldValue); } /************************/ /* EnableYieldFunction: */ /************************/ globle short EnableYieldFunction( void *theEnv, short value) { short oldValue; oldValue = UtilityData(theEnv)->YieldFunctionEnabled; UtilityData(theEnv)->YieldFunctionEnabled = value; return(oldValue); } /*************************************************************************/ /* AddTrackedMemory: Tracked memory is memory allocated by CLIPS that's */ /* referenced by a variable on the stack, but not by any environment */ /* data structure. An example would be the storage for local variables */ /* allocated when a deffunction is executed. Tracking this memory */ /* allows it to be removed later when using longjmp as the code that */ /* would normally deallocate the memory would be bypassed. */ /*************************************************************************/ globle struct trackedMemory *AddTrackedMemory( void *theEnv, void *theMemory, size_t theSize) { struct trackedMemory *newPtr; newPtr = get_struct(theEnv,trackedMemory); newPtr->prev = NULL; newPtr->theMemory = theMemory; newPtr->memSize = theSize; newPtr->next = UtilityData(theEnv)->trackList; UtilityData(theEnv)->trackList = newPtr; return newPtr; } /************************/ /* RemoveTrackedMemory: */ /************************/ globle void RemoveTrackedMemory( void *theEnv, struct trackedMemory *theTracker) { if (theTracker->prev == NULL) { UtilityData(theEnv)->trackList = theTracker->next; } else { theTracker->prev->next = theTracker->next; } if (theTracker->next != NULL) { theTracker->next->prev = theTracker->prev; } rtn_struct(theEnv,trackedMemory,theTracker); } /******************************************/ /* UTF8Length: Returns the logical number */ /* of characters in a UTF8 string. */ /******************************************/ globle size_t UTF8Length( const char *s) { size_t i = 0, length = 0; while (s[i] != '\0') { UTF8Increment(s,&i); length++; } return(length); } /*********************************************/ /* UTF8Increment: Finds the beginning of the */ /* next character in a UTF8 string. */ /*********************************************/ globle void UTF8Increment( const char *s, size_t *i) { (void) (IsUTF8Start(s[++(*i)]) || IsUTF8Start(s[++(*i)]) || IsUTF8Start(s[++(*i)]) || ++(*i)); } /****************************************************/ /* UTF8Offset: Converts the logical character index */ /* in a UTF8 string to the actual byte offset. */ /****************************************************/ globle size_t UTF8Offset( const char *str, size_t charnum) { size_t offs = 0; while ((charnum > 0) && (str[offs])) { (void) (IsUTF8Start(str[++offs]) || IsUTF8Start(str[++offs]) || IsUTF8Start(str[++offs]) || ++offs); charnum--; } return offs; } /*************************************************/ /* UTF8CharNum: Converts the UTF8 character byte */ /* offset to the logical character index. */ /*************************************************/ globle size_t UTF8CharNum( const char *s, size_t offset) { size_t charnum = 0, offs=0; while ((offs < offset) && (s[offs])) { (void) (IsUTF8Start(s[++offs]) || IsUTF8Start(s[++offs]) || IsUTF8Start(s[++offs]) || ++offs); charnum++; } return charnum; } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void IncrementGCLocks() { EnvIncrementGCLocks(GetCurrentEnvironment()); } globle void DecrementGCLocks() { EnvDecrementGCLocks(GetCurrentEnvironment()); } globle intBool RemovePeriodicFunction( const char *name) { return EnvRemovePeriodicFunction(GetCurrentEnvironment(),name); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/modulpsr.h0000755000175000017500000000544612374020224016254 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when DEFMODULE_CONSTRUCT */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #ifndef _H_modulpsr #define _H_modulpsr struct portConstructItem { const char *constructName; int typeExpected; struct portConstructItem *next; }; #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE long GetNumberOfDefmodules(void *); LOCALE void SetNumberOfDefmodules(void *,long); LOCALE void AddAfterModuleDefinedFunction(void *,const char *,void (*)(void *),int); LOCALE int ParseDefmodule(void *,const char *); LOCALE void AddPortConstructItem(void *,const char *,int); LOCALE struct portConstructItem *ValidPortConstructItem(void *,const char *); LOCALE int FindImportExportConflict(void *,const char *,struct defmodule *,const char *); #endif /* _H_modulpsr */ clips_core_source_630/core/._defins.c0000755000175000017500000000040712464554105016071 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/userfunctions.c0000644000175000017500000001054212424476502017311 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* USER FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Created file to seperate UserFunctions and */ /* EnvUserFunctions from main.c. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /*************************************************************/ /***************************************************************************/ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this software and associated documentation files (the */ /* "Software"), to deal in the Software without restriction, including */ /* without limitation the rights to use, copy, modify, merge, publish, */ /* distribute, and/or sell copies of the Software, and to permit persons */ /* to whom the Software is furnished to do so. */ /* */ /* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS */ /* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF */ /* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT */ /* OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY */ /* CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES */ /* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN */ /* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF */ /* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* */ /***************************************************************************/ #include "clips.h" void UserFunctions(void); void EnvUserFunctions(void *); /*********************************************************/ /* UserFunctions: Informs the expert system environment */ /* of any user defined functions. In the default case, */ /* there are no user defined functions. To define */ /* functions, either this function must be replaced by */ /* a function with the same name within this file, or */ /* this function can be deleted from this file and */ /* included in another file. */ /*********************************************************/ void UserFunctions() { // Use of UserFunctions is deprecated. // Use EnvUserFunctions instead. } /***********************************************************/ /* EnvUserFunctions: Informs the expert system environment */ /* of any user defined functions. In the default case, */ /* there are no user defined functions. To define */ /* functions, either this function must be replaced by */ /* a function with the same name within this file, or */ /* this function can be deleted from this file and */ /* included in another file. */ /***********************************************************/ void EnvUserFunctions( void *environment) { #if MAC_XCD #pragma unused(environment) #endif } clips_core_source_630/core/objrtcmp.h0000755000175000017500000000507012374023167016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Added environment parameter to GenClose. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_objrtcmp #define _H_objrtcmp #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && CONSTRUCT_COMPILER #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ObjectPatternsCompilerSetup(void *); LOCALE void ObjectPatternNodeReference(void *,void *,FILE *,int,int); #endif /* DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && CONSTRUCT_COMPILER */ #endif /* _H_objrtcmp */ clips_core_source_630/core/dfinscmp.c0000755000175000017500000003005112373731172016205 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Definstances Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFINSTANCES_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include "conscomp.h" #include "envrnmnt.h" #include "defins.h" #define _DFINSCMP_SOURCE_ #include "dfinscmp.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyDefinstancesForCode(void *); static int DefinstancesToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void CloseDefinstancesFiles(void *,FILE *,FILE *,int); static void DefinstancesModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDefinstancesToCode(void *,FILE *,DEFINSTANCES *,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDefinstancesCompiler DESCRIPTION : Initializes the construct compiler item for definstances INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupDefinstancesCompiler( void *theEnv) { DefinstancesData(theEnv)->DefinstancesCodeItem = AddCodeGeneratorItem(theEnv,"definstances",0,ReadyDefinstancesForCode, NULL,DefinstancesToCode,2); } /**************************************************** NAME : DefinstancesCModuleReference DESCRIPTION : Prints out a reference to a definstances module INPUTS : 1) The output file 2) The id of the module item 3) The id of the image 4) The maximum number of elements allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Definstances module reference printed NOTES : None ****************************************************/ globle void DefinstancesCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReadyDefinstancesForCode DESCRIPTION : Sets index of deffunctions for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None ***************************************************/ static void ReadyDefinstancesForCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DefinstancesData(theEnv)->DefinstancesModuleIndex); } /******************************************************* NAME : DefinstancesToCode DESCRIPTION : Writes out static array code for definstances INPUTS : 1) The base name of the construct set 2) The base id for this construct 3) The file pointer for the header file 4) The base id for the construct set 5) The max number of indices allowed in an array RETURNS : -1 if no definstances, 0 on errors, 1 if definstances written SIDE EFFECTS : Code written to files NOTES : None *******************************************************/ static int DefinstancesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFINSTANCES *theDefinstances; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int definstancesArrayCount = 0, definstancesArrayVersion = 1; FILE *moduleFile = NULL, *definstancesFile = NULL; /* ================================================ Include the appropriate definstances header file ================================================ */ fprintf(headerFP,"#include \"defins.h\"\n"); /* ============================================================= Loop through all the modules and all the definstances writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "DEFINSTANCES_MODULE",ModulePrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDefinstancesFiles(theEnv,moduleFile,definstancesFile,maxIndices); return(0); } DefinstancesModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); theDefinstances = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL); while (theDefinstances != NULL) { definstancesFile = OpenFileIfNeeded(theEnv,definstancesFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, definstancesArrayVersion,headerFP, "DEFINSTANCES",ConstructPrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), FALSE,NULL); if (definstancesFile == NULL) { CloseDefinstancesFiles(theEnv,moduleFile,definstancesFile,maxIndices); return(0); } SingleDefinstancesToCode(theEnv,definstancesFile,theDefinstances,imageID, maxIndices,moduleCount); definstancesArrayCount++; definstancesFile = CloseFileIfNeeded(theEnv,definstancesFile,&definstancesArrayCount, &definstancesArrayVersion,maxIndices,NULL,NULL); theDefinstances = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,theDefinstances); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; moduleArrayCount++; } CloseDefinstancesFiles(theEnv,moduleFile,definstancesFile,maxIndices); return(1); } /*************************************************** NAME : CloseDefinstancesFiles DESCRIPTION : Closes construct compiler files for definstances structures INPUTS : 1) The definstances module file 2) The definstances structure file 3) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None ***************************************************/ static void CloseDefinstancesFiles( void *theEnv, FILE *moduleFile, FILE *definstancesFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (definstancesFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,definstancesFile,&count,&arrayVersion, maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*************************************************** NAME : DefinstancesModuleToCode DESCRIPTION : Writes out the C values for a definstances module item INPUTS : 1) The output file 2) The module for the definstances 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Definstances module item written NOTES : None ***************************************************/ static void DefinstancesModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefinstancesData(theEnv)->DefinstancesModuleIndex,ConstructPrefix(DefinstancesData(theEnv)->DefinstancesCodeItem)); fprintf(theFile,"}"); } /*************************************************** NAME : SingleDefinstancesToCode DESCRIPTION : Writes out a single definstances' data to the file INPUTS : 1) The output file 2) The definstances 3) The compile image id 4) The maximum number of elements in an array 5) The module index RETURNS : Nothing useful SIDE EFFECTS : Definstances data written NOTES : None ***************************************************/ static void SingleDefinstancesToCode( void *theEnv, FILE *theFile, DEFINSTANCES *theDefinstances, int imageID, int maxIndices, int moduleCount) { /* =================== Definstances Header =================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefinstances->header,imageID,maxIndices,moduleCount, ModulePrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), ConstructPrefix(DefinstancesData(theEnv)->DefinstancesCodeItem)); /* ========================== Definstances specific data ========================== */ fprintf(theFile,",0,"); ExpressionToCode(theEnv,theFile,theDefinstances->mkinstance); fprintf(theFile,"}"); } #endif clips_core_source_630/core/msgcom.c0000755000175000017500000012346412424473403015677 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* OBJECT MESSAGE COMMANDS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added DeallocateMessageHandlerData to */ /* deallocate message handler environment data. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "classinf.h" #include "envrnmnt.h" #include "insfun.h" #include "insmoddp.h" #include "msgfun.h" #include "msgpass.h" #include "memalloc.h" #include "prccode.h" #include "router.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if ! RUN_TIME #include "extnfunc.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "constrct.h" #include "msgpsr.h" #endif #if DEBUGGING_FUNCTIONS #include "watch.h" #endif #define _MSGCOM_SOURCE_ #include "msgcom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if ! RUN_TIME static void CreateSystemHandlers(void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) static int WildDeleteHandler(void *,DEFCLASS *,SYMBOL_HN *,const char *); #endif #if DEBUGGING_FUNCTIONS static unsigned DefmessageHandlerWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DefmessageHandlerWatchPrint(void *,const char *,int,EXPRESSION *); static unsigned DefmessageHandlerWatchSupport(void *,const char *,const char *,int, void (*)(void *,const char *,void *,int), void (*)(void *,int,void *,int), EXPRESSION *); static unsigned WatchClassHandlers(void *,void *,const char *,int,const char *,int,int, void (*)(void *,const char *,void *,int), void (*)(void *,int,void *,int)); static void PrintHandlerWatchFlag(void *,const char *,void *,int); #endif static void DeallocateMessageHandlerData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupMessageHandlers DESCRIPTION : Sets up internal symbols and fucntion definitions pertaining to message-handlers. Also creates system handlers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions and data structures initialized NOTES : Should be called before SetupInstanceModDupCommands() in INSMODDP.C ***************************************************/ globle void SetupMessageHandlers( void *theEnv) { ENTITY_RECORD handlerGetInfo = { "HANDLER_GET", HANDLER_GET,0,1,1, PrintHandlerSlotGetFunction, PrintHandlerSlotGetFunction,NULL, HandlerSlotGetFunction, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }, handlerPutInfo = { "HANDLER_PUT", HANDLER_PUT,0,1,1, PrintHandlerSlotPutFunction, PrintHandlerSlotPutFunction,NULL, HandlerSlotPutFunction, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,MESSAGE_HANDLER_DATA,sizeof(struct messageHandlerData),DeallocateMessageHandlerData); memcpy(&MessageHandlerData(theEnv)->HandlerGetInfo,&handlerGetInfo,sizeof(struct entityRecord)); memcpy(&MessageHandlerData(theEnv)->HandlerPutInfo,&handlerPutInfo,sizeof(struct entityRecord)); MessageHandlerData(theEnv)->hndquals[0] = "around"; MessageHandlerData(theEnv)->hndquals[1] = "before"; MessageHandlerData(theEnv)->hndquals[2] = "primary"; MessageHandlerData(theEnv)->hndquals[3] = "after"; InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerGetInfo,HANDLER_GET); InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerPutInfo,HANDLER_PUT); #if ! RUN_TIME MessageHandlerData(theEnv)->INIT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INIT_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->INIT_SYMBOL); MessageHandlerData(theEnv)->DELETE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,DELETE_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->DELETE_SYMBOL); MessageHandlerData(theEnv)->CREATE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,CREATE_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->CREATE_SYMBOL); EnvAddClearFunction(theEnv,"defclass",CreateSystemHandlers,-100); #if ! BLOAD_ONLY MessageHandlerData(theEnv)->SELF_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SELF_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->SELF_SYMBOL); AddConstruct(theEnv,"defmessage-handler","defmessage-handlers", ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL); EnvDefineFunction2(theEnv,"undefmessage-handler",'v',PTIEF UndefmessageHandlerCommand, "UndefmessageHandlerCommand","23w"); #endif EnvDefineFunction2(theEnv,"send",'u',PTIEF SendCommand,"SendCommand","2*uuw"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"preview-send",'v',PTIEF PreviewSendCommand,"PreviewSendCommand","22w"); EnvDefineFunction2(theEnv,"ppdefmessage-handler",'v',PTIEF PPDefmessageHandlerCommand, "PPDefmessageHandlerCommand","23w"); EnvDefineFunction2(theEnv,"list-defmessage-handlers",'v',PTIEF ListDefmessageHandlersCommand, "ListDefmessageHandlersCommand","02w"); #endif EnvDefineFunction2(theEnv,"next-handlerp",'b',PTIEF NextHandlerAvailable,"NextHandlerAvailable","00"); FuncSeqOvlFlags(theEnv,"next-handlerp",TRUE,FALSE); EnvDefineFunction2(theEnv,"call-next-handler",'u', PTIEF CallNextHandler,"CallNextHandler","00"); FuncSeqOvlFlags(theEnv,"call-next-handler",TRUE,FALSE); EnvDefineFunction2(theEnv,"override-next-handler",'u', PTIEF CallNextHandler,"CallNextHandler",NULL); FuncSeqOvlFlags(theEnv,"override-next-handler",TRUE,FALSE); EnvDefineFunction2(theEnv,"dynamic-get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); EnvDefineFunction2(theEnv,"dynamic-put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); EnvDefineFunction2(theEnv,"get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); EnvDefineFunction2(theEnv,"put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"messages",0,&MessageHandlerData(theEnv)->WatchMessages,36,NULL,NULL); AddWatchItem(theEnv,"message-handlers",0,&MessageHandlerData(theEnv)->WatchHandlers,35, DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint); #endif } /*******************************************************/ /* DeallocateMessageHandlerData: Deallocates environment */ /* data for the message handler functionality. */ /******************************************************/ static void DeallocateMessageHandlerData( void *theEnv) { HANDLER_LINK *tmp, *mhead, *chead; mhead = MessageHandlerData(theEnv)->TopOfCore; while (mhead != NULL) { tmp = mhead; mhead = mhead->nxt; rtn_struct(theEnv,messageHandlerLink,tmp); } chead = MessageHandlerData(theEnv)->OldCore; while (chead != NULL) { mhead = chead; chead = chead->nxtInStack; while (mhead != NULL) { tmp = mhead; mhead = mhead->nxt; rtn_struct(theEnv,messageHandlerLink,tmp); } } } /***************************************************** NAME : EnvGetDefmessageHandlerName DESCRIPTION : Gets the name of a message-handler INPUTS : 1) Pointer to a class 2) Array index of handler in class's message-handler array (+1) RETURNS : Name-string of message-handler SIDE EFFECTS : None NOTES : None *****************************************************/ globle const char *EnvGetDefmessageHandlerName( void *theEnv, void *ptr, int theIndex) { #if MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(((DEFCLASS *) ptr)->handlers[theIndex-1].name)); } /***************************************************** NAME : EnvGetDefmessageHandlerType DESCRIPTION : Gets the type of a message-handler INPUTS : 1) Pointer to a class 2) Array index of handler in class's message-handler array (+1) RETURNS : Type-string of message-handler SIDE EFFECTS : None NOTES : None *****************************************************/ globle const char *EnvGetDefmessageHandlerType( void *theEnv, void *ptr, int theIndex) { return(MessageHandlerData(theEnv)->hndquals[((DEFCLASS *) ptr)->handlers[theIndex-1].type]); } /************************************************************** NAME : EnvGetNextDefmessageHandler DESCRIPTION : Finds first or next handler for a class INPUTS : 1) The address of the handler's class 2) The array index of the current handler (+1) RETURNS : The array index (+1) of the next handler, or 0 if there is none SIDE EFFECTS : None NOTES : If index == 0, the first handler array index (i.e. 1) returned **************************************************************/ globle int EnvGetNextDefmessageHandler( void *theEnv, void *ptr, int theIndex) { DEFCLASS *cls; #if MAC_XCD #pragma unused(theEnv) #endif cls = (DEFCLASS *) ptr; if (theIndex == 0) return((cls->handlers != NULL) ? 1 : 0); if (theIndex == cls->handlerCount) return(0); return(theIndex+1); } /***************************************************** NAME : GetDefmessageHandlerPointer DESCRIPTION : Returns a pointer to a handler INPUTS : 1) Pointer to a class 2) Array index of handler in class's message-handler array (+1) RETURNS : Pointer to the handler. SIDE EFFECTS : None NOTES : None *****************************************************/ globle HANDLER *GetDefmessageHandlerPointer( void *ptr, int theIndex) { return(&((DEFCLASS *) ptr)->handlers[theIndex-1]); } #if DEBUGGING_FUNCTIONS /********************************************************* NAME : EnvGetDefmessageHandlerWatch DESCRIPTION : Determines if trace messages for calls to this handler will be generated or not INPUTS : 1) A pointer to the class 2) The index of the handler RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle unsigned EnvGetDefmessageHandlerWatch( void *theEnv, void *theClass, int theIndex) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) theClass)->handlers[theIndex-1].trace); } /********************************************************* NAME : EnvSetDefmessageHandlerWatch DESCRIPTION : Sets the trace to ON/OFF for the calling of the handler INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the class 3) The index of the handler RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the handler set NOTES : None *********************************************************/ globle void EnvSetDefmessageHandlerWatch( void *theEnv, int newState, void *theClass, int theIndex) { #if MAC_XCD #pragma unused(theEnv) #endif ((DEFCLASS *) theClass)->handlers[theIndex-1].trace = newState; } #endif /*************************************************** NAME : EnvFindDefmessageHandler DESCRIPTION : Determines the index of a specfied message-handler INPUTS : 1) A pointer to the class 2) Name-string of the handler 3) Handler-type: "around","before", "primary", or "after" RETURNS : The index of the handler (0 if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle unsigned EnvFindDefmessageHandler( void *theEnv, void *ptr, const char *hname, const char *htypestr) { unsigned htype; SYMBOL_HN *hsym; DEFCLASS *cls; int theIndex; htype = HandlerType(theEnv,"handler-lookup",htypestr); if (htype == MERROR) return(0); hsym = FindSymbolHN(theEnv,hname); if (hsym == NULL) return(0); cls = (DEFCLASS *) ptr; theIndex = FindHandlerByIndex(cls,hsym,(unsigned) htype); return((unsigned) (theIndex+1)); } /*************************************************** NAME : EnvIsDefmessageHandlerDeletable DESCRIPTION : Determines if a message-handler can be deleted INPUTS : 1) Address of the handler's class 2) Index of the handler RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefmessageHandlerDeletable( void *theEnv, void *ptr, int theIndex) { DEFCLASS *cls; if (! ConstructsDeletable(theEnv)) { return FALSE; } cls = (DEFCLASS *) ptr; if (cls->handlers[theIndex-1].system == 1) return(FALSE); #if (! BLOAD_ONLY) && (! RUN_TIME) return((HandlersExecuting(cls) == FALSE) ? TRUE : FALSE); #else return FALSE; #endif } /****************************************************************************** NAME : UndefmessageHandlerCommand DESCRIPTION : Deletes a handler from a class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Handler deleted if possible NOTES : H/L Syntax: (undefmessage-handler []) ******************************************************************************/ globle void UndefmessageHandlerCommand( void *theEnv) { #if RUN_TIME || BLOAD_ONLY PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); #else SYMBOL_HN *mname; const char *tname; DATA_OBJECT tmp; DEFCLASS *cls; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) { PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return; } #endif if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE) { ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp)); return; } if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE) return; mname = (SYMBOL_HN *) tmp.value; if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE) return; tname = DOToString(tmp); if (strcmp(tname,"*") == 0) tname = NULL; } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; WildDeleteHandler(theEnv,cls,mname,tname); #endif } /*********************************************************** NAME : EnvUndefmessageHandler DESCRIPTION : Deletes a handler from a class INPUTS : 1) Class address (Can be NULL) 2) Handler index (can be 0) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handler deleted if possible NOTES : None ***********************************************************/ globle int EnvUndefmessageHandler( void *theEnv, void *vptr, int mhi) { #if RUN_TIME || BLOAD_ONLY PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return(0); #else DEFCLASS *cls; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) { PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return(0); } #endif if (vptr == NULL) { if (mhi != 0) { PrintErrorID(theEnv,"MSGCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Incomplete message-handler specification for deletion.\n"); return(0); } return(WildDeleteHandler(theEnv,NULL,NULL,NULL)); } if (mhi == 0) return(WildDeleteHandler(theEnv,(DEFCLASS *) vptr,NULL,NULL)); cls = (DEFCLASS *) vptr; if (HandlersExecuting(cls)) { HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); return(0); } cls->handlers[mhi-1].mark = 1; DeallocateMarkedHandlers(theEnv,cls); return(1); #endif } #if DEBUGGING_FUNCTIONS /******************************************************************************* NAME : PPDefmessageHandlerCommand DESCRIPTION : Displays the pretty-print form (if any) for a handler INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefmessage-handler []) *******************************************************************************/ globle void PPDefmessageHandlerCommand( void *theEnv) { DATA_OBJECT temp; SYMBOL_HN *csym,*msym; const char *tname; DEFCLASS *cls = NULL; unsigned mtype; HANDLER *hnd; if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE) return; csym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE) return; msym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE) return; tname = DOToString(temp); } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; mtype = HandlerType(theEnv,"ppdefmessage-handler",tname); if (mtype == MERROR) { SetEvaluationError(theEnv,TRUE); return; } if (csym != NULL) cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym)); if (((cls == NULL) || (msym == NULL)) ? TRUE : ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL)) { PrintErrorID(theEnv,"MSGCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler "); EnvPrintRouter(theEnv,WERROR,ValueToString(msym)); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,tname); EnvPrintRouter(theEnv,WERROR," for class "); EnvPrintRouter(theEnv,WERROR,ValueToString(csym)); EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n"); SetEvaluationError(theEnv,TRUE); return; } if (hnd->ppForm != NULL) PrintInChunks(theEnv,WDISPLAY,hnd->ppForm); } /***************************************************************************** NAME : ListDefmessageHandlersCommand DESCRIPTION : Depending on arguments, does lists handlers which match restrictions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (list-defmessage-handlers [ [inherit]])) *****************************************************************************/ globle void ListDefmessageHandlersCommand( void *theEnv) { int inhp; void *clsptr; if (EnvRtnArgCount(theEnv) == 0) EnvListDefmessageHandlers(theEnv,WDISPLAY,NULL,0); else { clsptr = ClassInfoFnxArgs(theEnv,"list-defmessage-handlers",&inhp); if (clsptr == NULL) return; EnvListDefmessageHandlers(theEnv,WDISPLAY,clsptr,inhp); } } /******************************************************************** NAME : PreviewSendCommand DESCRIPTION : Displays a list of the core for a message describing shadows,etc. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Temporary core created and destroyed NOTES : H/L Syntax: (preview-send ) ********************************************************************/ globle void PreviewSendCommand( void *theEnv) { DEFCLASS *cls; DATA_OBJECT temp; /* ============================= Get the class for the message ============================= */ if (EnvArgTypeCheck(theEnv,"preview-send",1,SYMBOL,&temp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,"preview-send",ValueToString(temp.value)); return; } if (EnvArgTypeCheck(theEnv,"preview-send",2,SYMBOL,&temp) == FALSE) return; EnvPreviewSend(theEnv,WDISPLAY,(void *) cls,DOToString(temp)); } /******************************************************** NAME : EnvGetDefmessageHandlerPPForm DESCRIPTION : Gets a message-handler pretty print form INPUTS : 1) Address of the handler's class 2) Index of the handler RETURNS : TRUE if printable, FALSE otherwise SIDE EFFECTS : None NOTES : None ********************************************************/ globle const char *EnvGetDefmessageHandlerPPForm( void *theEnv, void *ptr, int theIndex) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) ptr)->handlers[theIndex-1].ppForm); } /******************************************************************* NAME : EnvListDefmessageHandlers DESCRIPTION : Lists message-handlers for a class INPUTS : 1) The logical name of the output 2) Class name (NULL to display all handlers) 3) A flag indicating whether to list inherited handlers or not RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *******************************************************************/ globle void EnvListDefmessageHandlers( void *theEnv, const char *logName, void *vptr, int inhp) { DEFCLASS *cls; long cnt; PACKED_CLASS_LINKS plinks; if (vptr != NULL) { cls = (DEFCLASS *) vptr; if (inhp) cnt = DisplayHandlersInLinks(theEnv,logName,&cls->allSuperclasses,0); else { plinks.classCount = 1; plinks.classArray = &cls; cnt = DisplayHandlersInLinks(theEnv,logName,&plinks,0); } } else { plinks.classCount = 1; cnt = 0L; for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { plinks.classArray = &cls; cnt += DisplayHandlersInLinks(theEnv,logName,&plinks,0); } } PrintTally(theEnv,logName,cnt,"message-handler","message-handlers"); } /******************************************************************** NAME : EnvPreviewSend DESCRIPTION : Displays a list of the core for a message describing shadows,etc. INPUTS : 1) Logical name of output 2) Class pointer 3) Message name-string RETURNS : Nothing useful SIDE EFFECTS : Temporary core created and destroyed NOTES : None ********************************************************************/ globle void EnvPreviewSend( void *theEnv, const char *logicalName, void *clsptr, const char *msgname) { HANDLER_LINK *core; SYMBOL_HN *msym; msym = FindSymbolHN(theEnv,msgname); if (msym == NULL) return; core = FindPreviewApplicableHandlers(theEnv,(DEFCLASS *) clsptr,msym); if (core != NULL) { DisplayCore(theEnv,logicalName,core,0); DestroyHandlerLinks(theEnv,core); } } /**************************************************** NAME : DisplayHandlersInLinks DESCRIPTION : Recursively displays all handlers for an array of classes INPUTS : 1) The logical name of the output 2) The packed class links 3) The index to print from the links RETURNS : The number of handlers printed SIDE EFFECTS : None NOTES : Used by DescribeClass() ****************************************************/ globle long DisplayHandlersInLinks( void *theEnv, const char *logName, PACKED_CLASS_LINKS *plinks, int theIndex) { long i; long cnt; cnt = (long) plinks->classArray[theIndex]->handlerCount; if (((int) theIndex) < (plinks->classCount - 1)) cnt += DisplayHandlersInLinks(theEnv,logName,plinks,theIndex + 1); for (i = 0 ; i < plinks->classArray[theIndex]->handlerCount ; i++) PrintHandler(theEnv,logName,&plinks->classArray[theIndex]->handlers[i],TRUE); return(cnt); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! RUN_TIME /********************************************************** NAME : CreateSystemHandlers DESCRIPTION : Attachess the system message-handlers after a (clear) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : System handlers created NOTES : Must be called after CreateSystemClasses() **********************************************************/ static void CreateSystemHandlers( void *theEnv) { NewSystemHandler(theEnv,USER_TYPE_NAME,INIT_STRING,"init-slots",0); NewSystemHandler(theEnv,USER_TYPE_NAME,DELETE_STRING,"delete-instance",0); NewSystemHandler(theEnv,USER_TYPE_NAME,CREATE_STRING,"(create-instance)",0); #if DEBUGGING_FUNCTIONS NewSystemHandler(theEnv,USER_TYPE_NAME,PRINT_STRING,"ppinstance",0); #endif NewSystemHandler(theEnv,USER_TYPE_NAME,DIRECT_MODIFY_STRING,"(direct-modify)",1); NewSystemHandler(theEnv,USER_TYPE_NAME,MSG_MODIFY_STRING,"(message-modify)",1); NewSystemHandler(theEnv,USER_TYPE_NAME,DIRECT_DUPLICATE_STRING,"(direct-duplicate)",2); NewSystemHandler(theEnv,USER_TYPE_NAME,MSG_DUPLICATE_STRING,"(message-duplicate)",2); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /************************************************************ NAME : WildDeleteHandler DESCRIPTION : Deletes a handler from a class INPUTS : 1) Class address (Can be NULL) 2) Message Handler Name (Can be NULL) 3) Type name ("primary", etc.) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handler deleted if possible NOTES : None ************************************************************/ static int WildDeleteHandler( void *theEnv, DEFCLASS *cls, SYMBOL_HN *msym, const char *tname) { int mtype; if (msym == NULL) msym = (SYMBOL_HN *) EnvAddSymbol(theEnv,"*"); if (tname != NULL) { mtype = (int) HandlerType(theEnv,"undefmessage-handler",tname); if (mtype == MERROR) return(0); } else mtype = -1; if (cls == NULL) { int success = 1; for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) if (DeleteHandler(theEnv,cls,msym,mtype,FALSE) == 0) success = 0; return(success); } return(DeleteHandler(theEnv,cls,msym,mtype,TRUE)); } #endif #if DEBUGGING_FUNCTIONS /****************************************************************** NAME : DefmessageHandlerWatchAccess DESCRIPTION : Parses a list of class names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 2) The value to which to set the trace flags 3) A list of expressions containing the names of the classes for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified classes NOTES : Accessory function for AddWatchItem() ******************************************************************/ static unsigned DefmessageHandlerWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif if (newState) return(DefmessageHandlerWatchSupport(theEnv,"watch",NULL,newState, NULL,EnvSetDefmessageHandlerWatch,argExprs)); else return(DefmessageHandlerWatchSupport(theEnv,"unwatch",NULL,newState, NULL,EnvSetDefmessageHandlerWatch,argExprs)); } /*********************************************************************** NAME : DefmessageHandlerWatchPrint DESCRIPTION : Parses a list of class names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 3) A list of expressions containing the names of the classes for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified classes NOTES : Accessory function for AddWatchItem() ***********************************************************************/ static unsigned DefmessageHandlerWatchPrint( void *theEnv, const char *logName, int code, EXPRESSION *argExprs) { #if MAC_XCD #pragma unused(code) #endif return(DefmessageHandlerWatchSupport(theEnv,"list-watch-items",logName,-1, PrintHandlerWatchFlag,NULL,argExprs)); } /******************************************************* NAME : DefmessageHandlerWatchSupport DESCRIPTION : Sets or displays handlers specified INPUTS : 1) The calling function name 2) The logical output name for displays (can be NULL) 4) The new set state (can be -1) 5) The print function (can be NULL) 6) The trace function (can be NULL) 7) The handlers expression list RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler trace flags set or displayed NOTES : None *******************************************************/ static unsigned DefmessageHandlerWatchSupport( void *theEnv, const char *funcName, const char *logName, int newState, void (*printFunc)(void *,const char *,void *,int), void (*traceFunc)(void *,int,void *,int), EXPRESSION *argExprs) { struct defmodule *theModule; void *theClass; const char *theHandlerStr; int theType; int argIndex = 2; DATA_OBJECT tmpData; /* =============================== If no handlers are specified, show the trace for all handlers in all handlers =============================== */ if (argExprs == NULL) { SaveCurrentModule(theEnv); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); if (traceFunc == NULL) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } theClass = EnvGetNextDefclass(theEnv,NULL); while (theClass != NULL) { if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState, TRUE,printFunc,traceFunc) == FALSE) return(FALSE); theClass = EnvGetNextDefclass(theEnv,theClass); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } RestoreCurrentModule(theEnv); return(TRUE); } /* ================================================ Set or show the traces for the specified handler ================================================ */ while (argExprs != NULL) { if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"class name"); return(FALSE); } theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData)); if (theClass == NULL) { ExpectedTypeError1(theEnv,funcName,argIndex,"class name"); return(FALSE); } if (GetNextArgument(argExprs) != NULL) { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler name"); return(FALSE); } theHandlerStr = DOToString(tmpData); if (GetNextArgument(argExprs) != NULL) { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler type"); return(FALSE); } if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR) return(FALSE); } else theType = -1; } else { theHandlerStr = NULL; theType = -1; } if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName, newState,FALSE,printFunc,traceFunc) == FALSE) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler"); return(FALSE); } argIndex++; argExprs = GetNextArgument(argExprs); } return(TRUE); } /******************************************************* NAME : WatchClassHandlers DESCRIPTION : Sets or displays handlers specified INPUTS : 1) The class 2) The handler name (or NULL wildcard) 3) The handler type (or -1 wildcard) 4) The logical output name for displays (can be NULL) 5) The new set state (can be -1) 6) The print function (can be NULL) 7) The trace function (can be NULL) RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler trace flags set or displayed NOTES : None *******************************************************/ static unsigned WatchClassHandlers( void *theEnv, void *theClass, const char *theHandlerStr, int theType, const char *logName, int newState, int indentp, void (*printFunc)(void *,const char *,void *,int), void (*traceFunc)(void *,int,void *,int)) { unsigned theHandler; int found = FALSE; theHandler = EnvGetNextDefmessageHandler(theEnv,theClass,0); while (theHandler != 0) { if ((theType == -1) ? TRUE : (theType == (int) ((DEFCLASS *) theClass)->handlers[theHandler-1].type)) { if ((theHandlerStr == NULL) ? TRUE : (strcmp(theHandlerStr,EnvGetDefmessageHandlerName(theEnv,theClass,theHandler)) == 0)) { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theClass,theHandler); else { if (indentp) EnvPrintRouter(theEnv,logName," "); (*printFunc)(theEnv,logName,theClass,theHandler); } found = TRUE; } } theHandler = EnvGetNextDefmessageHandler(theEnv,theClass,theHandler); } if ((theHandlerStr != NULL) && (theType != -1) && (found == FALSE)) return(FALSE); return(TRUE); } /*************************************************** NAME : PrintHandlerWatchFlag DESCRIPTION : Displays trace value for handler INPUTS : 1) The logical name of the output 2) The class 3) The handler index RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintHandlerWatchFlag( void *theEnv, const char *logName, void *theClass, int theHandler) { EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,theClass)); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,EnvGetDefmessageHandlerName(theEnv,theClass,theHandler)); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,EnvGetDefmessageHandlerType(theEnv,theClass,theHandler)); if (EnvGetDefmessageHandlerWatch(theEnv,theClass,theHandler)) EnvPrintRouter(theEnv,logName," = on\n"); else EnvPrintRouter(theEnv,logName," = off\n"); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle unsigned FindDefmessageHandler( void *ptr, const char *hname, const char *htypestr) { return EnvFindDefmessageHandler(GetCurrentEnvironment(),ptr,hname,htypestr); } globle const char *GetDefmessageHandlerName( void *ptr, int theIndex) { return EnvGetDefmessageHandlerName(GetCurrentEnvironment(),ptr,theIndex); } globle const char *GetDefmessageHandlerType( void *ptr, int theIndex) { return EnvGetDefmessageHandlerType(GetCurrentEnvironment(),ptr,theIndex); } globle int GetNextDefmessageHandler( void *ptr, int theIndex) { return EnvGetNextDefmessageHandler(GetCurrentEnvironment(),ptr,theIndex); } globle int IsDefmessageHandlerDeletable( void *ptr, int theIndex) { return EnvIsDefmessageHandlerDeletable(GetCurrentEnvironment(),ptr,theIndex); } globle int UndefmessageHandler( void *vptr, int mhi) { return EnvUndefmessageHandler(GetCurrentEnvironment(),vptr,mhi); } #if DEBUGGING_FUNCTIONS globle const char *GetDefmessageHandlerPPForm( void *ptr, int theIndex) { return EnvGetDefmessageHandlerPPForm(GetCurrentEnvironment(),ptr,theIndex); } globle unsigned GetDefmessageHandlerWatch( void *theClass, int theIndex) { return EnvGetDefmessageHandlerWatch(GetCurrentEnvironment(),theClass,theIndex); } globle void ListDefmessageHandlers( const char *logName, void *vptr, int inhp) { EnvListDefmessageHandlers(GetCurrentEnvironment(),logName,vptr,inhp); } globle void PreviewSend( const char *logicalName, void *clsptr, const char *msgname) { EnvPreviewSend(GetCurrentEnvironment(),logicalName,clsptr,msgname); } globle void SetDefmessageHandlerWatch( int newState, void *theClass, int theIndex) { EnvSetDefmessageHandlerWatch(GetCurrentEnvironment(),newState,theClass,theIndex); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* OBJECT_SYSTEM */ clips_core_source_630/core/rulebsc.c0000755000175000017500000004355212500146515016044 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* DEFRULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defrule */ /* construct such as clear, reset, save, undefrule, */ /* ppdefrule, list-defrules, and */ /* get-defrule-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for join network changes. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* JoinOperationInProgress mechanism. */ /* */ /*************************************************************/ #define _RULEBSC_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "argacces.h" #include "constrct.h" #include "envrnmnt.h" #include "router.h" #include "watch.h" #include "extnfunc.h" #include "ruledef.h" #include "engine.h" #include "drive.h" #include "reteutil.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "rulebin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "rulecmp.h" #endif #include "rulebsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ResetDefrules(void *); static void ResetDefrulesPrime(void *); static void SaveDefrules(void *,void *,const char *); #if (! RUN_TIME) static int ClearDefrulesReady(void *); static void ClearDefrules(void *); #endif /*************************************************************/ /* DefruleBasicCommands: Initializes basic defrule commands. */ /*************************************************************/ globle void DefruleBasicCommands( void *theEnv) { EnvAddResetFunction(theEnv,"defrule",ResetDefrules,70); EnvAddResetFunction(theEnv,"defrule",ResetDefrulesPrime,10); AddSaveFunction(theEnv,"defrule",SaveDefrules,0); #if (! RUN_TIME) AddClearReadyFunction(theEnv,"defrule",ClearDefrulesReady,0); EnvAddClearFunction(theEnv,"defrule",ClearDefrules,0); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"rules",0,&DefruleData(theEnv)->WatchRules,70,DefruleWatchAccess,DefruleWatchPrint); #endif #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-defrule-list",'m',PTIEF GetDefruleListFunction,"GetDefruleListFunction","01w"); EnvDefineFunction2(theEnv,"undefrule",'v',PTIEF UndefruleCommand,"UndefruleCommand","11w"); EnvDefineFunction2(theEnv,"defrule-module",'w',PTIEF DefruleModuleFunction,"DefruleModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"rules",'v', PTIEF ListDefrulesCommand,"ListDefrulesCommand","01w"); EnvDefineFunction2(theEnv,"list-defrules",'v', PTIEF ListDefrulesCommand,"ListDefrulesCommand","01w"); EnvDefineFunction2(theEnv,"ppdefrule",'v',PTIEF PPDefruleCommand,"PPDefruleCommand","11w"); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DefruleBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefruleCompilerSetup(theEnv); #endif #endif } /*****************************************************/ /* ResetDefrules: Defrule reset routine for use with */ /* the reset command. Sets the current entity time */ /* tag (used by the conflict resolution strategies */ /* for recency) to zero. The focus stack is also */ /* cleared. */ /*****************************************************/ static void ResetDefrules( void *theEnv) { struct defmodule *theModule; struct joinLink *theLink; struct partialMatch *notParent; DefruleData(theEnv)->CurrentEntityTimeTag = 1L; EnvClearFocusStack(theEnv); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,(void *) theModule); for (theLink = DefruleData(theEnv)->RightPrimeJoins; theLink != NULL; theLink = theLink->next) { PosEntryRetractAlpha(theEnv,theLink->join->rightMemory->beta[0],NETWORK_ASSERT); } for (theLink = DefruleData(theEnv)->LeftPrimeJoins; theLink != NULL; theLink = theLink->next) { if ((theLink->join->patternIsNegated || theLink->join->joinFromTheRight) && (! theLink->join->patternIsExists)) { notParent = theLink->join->leftMemory->beta[0]; if (notParent->marker) { RemoveBlockedLink(notParent); } /*==========================================================*/ /* Prevent any retractions from generating partial matches. */ /*==========================================================*/ notParent->marker = notParent; if (notParent->children != NULL) { PosEntryRetractBeta(theEnv,notParent,notParent->children,NETWORK_ASSERT); } /* if (notParent->dependents != NULL) { RemoveLogicalSupport(theEnv,notParent); } */ } } } /*****************************************************/ /* ResetDefrulesPrime: */ /*****************************************************/ static void ResetDefrulesPrime( void *theEnv) { struct joinLink *theLink; struct partialMatch *notParent; for (theLink = DefruleData(theEnv)->RightPrimeJoins; theLink != NULL; theLink = theLink->next) { NetworkAssert(theEnv,theLink->join->rightMemory->beta[0],theLink->join); } for (theLink = DefruleData(theEnv)->LeftPrimeJoins; theLink != NULL; theLink = theLink->next) { if ((theLink->join->patternIsNegated || theLink->join->joinFromTheRight) && (! theLink->join->patternIsExists)) { notParent = theLink->join->leftMemory->beta[0]; if (theLink->join->secondaryNetworkTest != NULL) { if (EvaluateSecondaryNetworkTest(theEnv,notParent,theLink->join) == FALSE) { continue; } } notParent->marker = NULL; EPMDrive(theEnv,notParent,theLink->join,NETWORK_ASSERT); } } } #if (! RUN_TIME) /******************************************************************/ /* ClearDefrulesReady: Indicates whether defrules can be cleared. */ /******************************************************************/ static int ClearDefrulesReady( void *theEnv) { if (EngineData(theEnv)->ExecutingRule != NULL) return(FALSE); if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE); EnvClearFocusStack(theEnv); if (EnvGetCurrentModule(theEnv) == NULL) return(FALSE); DefruleData(theEnv)->CurrentEntityTimeTag = 1L; return(TRUE); } /***************************************************************/ /* ClearDefrules: Pushes the MAIN module as the current focus. */ /***************************************************************/ static void ClearDefrules( void *theEnv) { struct defmodule *theModule; theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,(void *) theModule); } #endif /**************************************/ /* SaveDefrules: Defrule save routine */ /* for use with the save command. */ /**************************************/ static void SaveDefrules( void *theEnv, void *theModule, const char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DefruleData(theEnv)->DefruleConstruct); } /******************************************/ /* UndefruleCommand: H/L access routine */ /* for the undefrule command. */ /******************************************/ globle void UndefruleCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefrule",DefruleData(theEnv)->DefruleConstruct); } /**********************************/ /* EnvUndefrule: C access routine */ /* for the undefrule command. */ /**********************************/ globle intBool EnvUndefrule( void *theEnv, void *theDefrule) { return(Undefconstruct(theEnv,theDefrule,DefruleData(theEnv)->DefruleConstruct)); } /************************************************/ /* GetDefruleListFunction: H/L access routine */ /* for the get-defrule-list function. */ /************************************************/ globle void GetDefruleListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-defrule-list",returnValue,DefruleData(theEnv)->DefruleConstruct); } /****************************************/ /* EnvGetDefruleList: C access routine */ /* for the get-defrule-list function. */ /****************************************/ globle void EnvGetDefruleList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DefruleData(theEnv)->DefruleConstruct,(struct defmodule *) theModule); } /*********************************************/ /* DefruleModuleFunction: H/L access routine */ /* for the defrule-module function. */ /*********************************************/ globle void *DefruleModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defrule-module",DefruleData(theEnv)->DefruleConstruct)); } #if DEBUGGING_FUNCTIONS /******************************************/ /* PPDefruleCommand: H/L access routine */ /* for the ppdefrule command. */ /******************************************/ globle void PPDefruleCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefrule",DefruleData(theEnv)->DefruleConstruct); } /***********************************/ /* PPDefrule: C access routine for */ /* the ppdefrule command. */ /***********************************/ globle int PPDefrule( void *theEnv, const char *defruleName, const char *logicalName) { return(PPConstruct(theEnv,defruleName,logicalName,DefruleData(theEnv)->DefruleConstruct)); } /*********************************************/ /* ListDefrulesCommand: H/L access routine */ /* for the list-defrules command. */ /*********************************************/ globle void ListDefrulesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defrules",DefruleData(theEnv)->DefruleConstruct); } /*************************************/ /* EnvListDefrules: C access routine */ /* for the list-defrules command. */ /*************************************/ globle void EnvListDefrules( void *theEnv, const char *logicalName, void *theModule) { ListConstruct(theEnv,DefruleData(theEnv)->DefruleConstruct,logicalName,(struct defmodule *) theModule); } /*******************************************************/ /* EnvGetDefruleWatchActivations: C access routine for */ /* retrieving the current watch value of a defrule's */ /* activations. */ /*******************************************************/ globle unsigned EnvGetDefruleWatchActivations( void *theEnv, void *rulePtr) { struct defrule *thePtr; #if MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { if (thePtr->watchActivation) return(TRUE); } return(FALSE); } /***********************************************/ /* EnvGetDefruleWatchFirings: C access routine */ /* for retrieving the current watch value of */ /* a defrule's firings. */ /***********************************************/ globle unsigned EnvGetDefruleWatchFirings( void *theEnv, void *rulePtr) { struct defrule *thePtr; #if MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { if (thePtr->watchFiring) return(TRUE); } return(FALSE); } /***************************************************/ /* EnvSetDefruleWatchActivations: C access routine */ /* for setting the current watch value of a */ /* defrule's activations. */ /***************************************************/ globle void EnvSetDefruleWatchActivations( void *theEnv, unsigned newState, void *rulePtr) { struct defrule *thePtr; #if MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { thePtr->watchActivation = newState; } } /****************************************************/ /* EnvSetDefruleWatchFirings: C access routine for */ /* setting the current watch value of a defrule's */ /* firings. */ /****************************************************/ globle void EnvSetDefruleWatchFirings( void *theEnv, unsigned newState, void *rulePtr) { struct defrule *thePtr; #if MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { thePtr->watchFiring = newState; } } /*******************************************************************/ /* DefruleWatchAccess: Access function for setting the watch flags */ /* associated with rules (activations and rule firings). */ /*******************************************************************/ globle unsigned DefruleWatchAccess( void *theEnv, int code, unsigned newState, struct expr *argExprs) { if (code) return(ConstructSetWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,newState,argExprs, EnvGetDefruleWatchActivations,EnvSetDefruleWatchActivations)); else return(ConstructSetWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,newState,argExprs, EnvGetDefruleWatchFirings,EnvSetDefruleWatchFirings)); } /*****************************************************************/ /* DefruleWatchPrint: Access routine for printing which defrules */ /* have their watch flag set via the list-watch-items command. */ /*****************************************************************/ globle unsigned DefruleWatchPrint( void *theEnv, const char *logName, int code, struct expr *argExprs) { if (code) return(ConstructPrintWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,logName,argExprs, EnvGetDefruleWatchActivations,EnvSetDefruleWatchActivations)); else return(ConstructPrintWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,logName,argExprs, EnvGetDefruleWatchActivations,EnvSetDefruleWatchActivations)); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void GetDefruleList( DATA_OBJECT_PTR returnValue, void *theModule) { EnvGetDefruleList(GetCurrentEnvironment(),returnValue,theModule); } #if DEBUGGING_FUNCTIONS globle unsigned GetDefruleWatchActivations( void *rulePtr) { return EnvGetDefruleWatchActivations(GetCurrentEnvironment(),rulePtr); } globle unsigned GetDefruleWatchFirings( void *rulePtr) { return EnvGetDefruleWatchFirings(GetCurrentEnvironment(),rulePtr); } globle void ListDefrules( const char *logicalName, void *theModule) { EnvListDefrules(GetCurrentEnvironment(),logicalName,theModule); } globle void SetDefruleWatchActivations( unsigned newState, void *rulePtr) { EnvSetDefruleWatchActivations(GetCurrentEnvironment(),newState,rulePtr); } globle void SetDefruleWatchFirings( unsigned newState, void *rulePtr) { EnvSetDefruleWatchFirings(GetCurrentEnvironment(),newState,rulePtr); } #endif globle intBool Undefrule( void *theDefrule) { return EnvUndefrule(GetCurrentEnvironment(),theDefrule); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/classini.h0000755000175000017500000000562612373714502016224 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_classini #define _H_classini #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_object #include "object.h" #endif #if OBJECT_SYSTEM #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSINI_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectSystem(void *); #if RUN_TIME LOCALE void ObjectsRunTimeInitialize(void *,DEFCLASS *[],SLOT_NAME *[],DEFCLASS *[],unsigned); #else LOCALE void CreateSystemClasses(void *); #endif #endif #endif clips_core_source_630/core/inspsr.h0000755000175000017500000000470012373756335015737 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed ParseSlotOverrides memory release issue. */ /* */ /*************************************************************/ #ifndef _H_inspsr #define _H_inspsr #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ! RUN_TIME LOCALE EXPRESSION *ParseInitializeInstance(void *,EXPRESSION *,const char *); LOCALE EXPRESSION *ParseSlotOverrides(void *,const char *,int *); #endif LOCALE EXPRESSION *ParseSimpleInstance(void *,EXPRESSION *,const char *); #endif /* _H_inspsr */ clips_core_source_630/core/._msgfun.c0000755000175000017500000000040712374017657016126 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltutl.h0000755000175000017500000000732112373754171016304 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE UTILITIES HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added additional arguments to */ /* InvalidDeftemplateSlotMessage function. */ /* */ /* Added additional arguments to */ /* PrintTemplateFact function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_tmpltutl #define _H_tmpltutl #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTUTL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InvalidDeftemplateSlotMessage(void *,const char *,const char *,int); LOCALE void SingleFieldSlotCardinalityError(void *,const char *); LOCALE void MultiIntoSingleFieldSlotError(void *,struct templateSlot *,struct deftemplate *); LOCALE void CheckTemplateFact(void *,struct fact *); LOCALE intBool CheckRHSSlotTypes(void *,struct expr *,struct templateSlot *,const char *); LOCALE struct templateSlot *GetNthSlot(struct deftemplate *,int); LOCALE int FindSlotPosition(struct deftemplate *,struct symbolHashNode *); LOCALE void PrintTemplateFact(void *,const char *,struct fact *,int,int); LOCALE void UpdateDeftemplateScope(void *); LOCALE struct templateSlot *FindSlot(struct deftemplate *,struct symbolHashNode *,short *); LOCALE struct deftemplate *CreateImpliedDeftemplate(void *,SYMBOL_HN *,int); #endif /* _H_tmpltutl */ clips_core_source_630/core/clips.h0000755000175000017500000000646212424476504015534 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* API HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added filertr.h and tmpltfun.h to include */ /* list. */ /* */ /* 6.30: Added classpsr.h, iofun.h, and strngrtr.h to */ /* include list. */ /* */ /*************************************************************/ #ifndef _H_API #define _H_API #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "setup.h" #ifndef _H_argacces #include "argacces.h" #endif #include "constant.h" #include "memalloc.h" #include "cstrcpsr.h" #include "filecom.h" #include "strngfun.h" #include "envrnmnt.h" #include "commline.h" #ifndef _H_symbol #include "symbol.h" #endif #include "router.h" #include "filertr.h" #include "strngrtr.h" #include "iofun.h" #include "sysdep.h" #include "bmathfun.h" #ifndef _H_expressn #include "expressn.h" #endif #include "exprnpsr.h" #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #include "utility.h" #include "watch.h" #include "modulbsc.h" #if BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if BLOAD_AND_BSAVE #include "bsave.h" #endif #if DEFRULE_CONSTRUCT #ifndef _H_ruledef #include "ruledef.h" #endif #include "rulebsc.h" #include "engine.h" #include "drive.h" #include "incrrset.h" #include "rulecom.h" #include "crstrtgy.h" #endif #if DEFFACTS_CONSTRUCT #include "dffctdef.h" #include "dffctbsc.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltdef.h" #include "tmpltbsc.h" #include "tmpltfun.h" #include "factcom.h" #include "factfun.h" #ifndef _H_factmngr #include "factmngr.h" #endif #include "facthsh.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #include "globlbsc.h" #include "globlcom.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #include "genrcfun.h" #endif #if OBJECT_SYSTEM #include "classcom.h" #include "classexm.h" #include "classinf.h" #include "classini.h" #include "classpsr.h" #include "defins.h" #include "inscom.h" #include "insfile.h" #include "insfun.h" #include "msgcom.h" #include "msgpass.h" #include "objrtmch.h" #endif #endif clips_core_source_630/core/modulcmp.c0000755000175000017500000004672512374017710016235 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _MODULCMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "moduldef.h" #include "sysdep.h" #include "envrnmnt.h" #include "modulcmp.h" /***************/ /* DEFINITIONS */ /***************/ #define ItemPrefix() ArbitraryPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem,0) #define DefmodulePrefix() ArbitraryPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem,1) #define PortPrefix() ArbitraryPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem,2) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void InitDefmoduleCode(void *,FILE *,int,int); static struct portItem *GetNextPortItem(void *,struct defmodule **,struct portItem **, int *,int *); static int PortItemsToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int *); static void BeforeDefmodulesToCode(void *); /***************************************************************/ /* DefmoduleCompilerSetup: Initializes the defmodule construct */ /* for use with the constructs-to-c command. */ /***************************************************************/ globle void DefmoduleCompilerSetup( void *theEnv) { DefmoduleData(theEnv)->DefmoduleCodeItem = AddCodeGeneratorItem(theEnv,"defmodule",200,BeforeDefmodulesToCode, InitDefmoduleCode,ConstructToCode,3); } /***********************************************************/ /* BeforeDefmodulesToCode: Assigns each defmodule a unique */ /* ID which will be used for pointer references when the */ /* data structures are written to a file as C code */ /***********************************************************/ static void BeforeDefmodulesToCode( void *theEnv) { int value = 0; struct defmodule *theModule; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { theModule->bsaveID = value++; } } /*************************************************************/ /* PrintDefmoduleReference: Writes the C code representation */ /* of a reference to a defmodule data structure. */ /*************************************************************/ globle void PrintDefmoduleReference( void *theEnv, FILE *theFile, struct defmodule *theModule) { if (theModule == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"&%s%d_%ld[%ld]",DefmodulePrefix(),ConstructCompilerData(theEnv)->ImageID, (long) ((theModule->bsaveID / ConstructCompilerData(theEnv)->MaxIndices) + 1), (long) (theModule->bsaveID % ConstructCompilerData(theEnv)->MaxIndices)); } /************************************************/ /* InitDefmoduleCode: Writes out initialization */ /* code for defmodules for a run-time module. */ /************************************************/ static void InitDefmoduleCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_XCD #pragma unused(maxIndices) #endif if (EnvGetNextDefmodule(theEnv,NULL) != NULL) { fprintf(initFP," SetListOfDefmodules(theEnv,(void *) %s%d_1);\n",DefmodulePrefix(),imageID); } else { fprintf(initFP," SetListOfDefmodules(theEnv,NULL);\n"); } fprintf(initFP," EnvSetCurrentModule(theEnv,(void *) EnvGetNextDefmodule(theEnv,NULL));\n"); } /***********************************************************/ /* ConstructToCode: Produces defmodule code for a run-time */ /* module created using the constructs-to-c function. */ /***********************************************************/ static int ConstructToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { struct defmodule *theConstruct; FILE *moduleFile = NULL, *itemsFile; int portItemCount = 0; struct portItem *portItemPtr; int mihCount = 0, moduleCount = 0; int j; struct moduleItem *theItem; int moduleArrayVersion = 1; int fileCount = 2; /*================================================*/ /* Include the appropriate defmodule header file. */ /*================================================*/ fprintf(headerFP,"#include \"moduldef.h\"\n"); /*============================================*/ /* Open up the items file for the defmodules. */ /* Only one file of this type is created so */ /* the maximum number of indices is ignored. */ /*============================================*/ if ((itemsFile = NewCFile(theEnv,fileName,pathName,fileNameBuffer,fileID,1,FALSE)) == NULL) { return(FALSE); } fprintf(itemsFile,"struct defmoduleItemHeader *%s%d_%d[] = {\n",ItemPrefix(),imageID,1); fprintf(headerFP,"extern struct defmoduleItemHeader *%s%d_%d[];\n",ItemPrefix(),imageID,1); /*======================================================*/ /* Loop through all the defmodules writing their C code */ /* representation to the file as they are traversed. */ /*======================================================*/ for (theConstruct = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theConstruct != NULL; theConstruct = (struct defmodule *) EnvGetNextDefmodule(theEnv,theConstruct)) { /*===========================================*/ /* Open a new file to write to if necessary. */ /*===========================================*/ moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID, &fileCount,moduleArrayVersion,headerFP, "struct defmodule",DefmodulePrefix(), FALSE,NULL); if (moduleFile == NULL) { moduleCount = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&moduleCount, &moduleArrayVersion,maxIndices,NULL,NULL); GenClose(theEnv,itemsFile); return(FALSE); } /*======================================*/ /* Write the construct name and ppform. */ /*======================================*/ fprintf(moduleFile,"{"); PrintSymbolReference(theEnv,moduleFile,theConstruct->name); fprintf(moduleFile,",NULL,"); /*=====================================================*/ /* Write the items array pointers to other constructs. */ /*=====================================================*/ fprintf(moduleFile,"&%s%d_1[%d],",ItemPrefix(),imageID,mihCount); for (j = 0, theItem = GetListOfModuleItems(theEnv); (j < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ; j++, theItem = theItem->next) { mihCount++; if (theItem->constructsToCModuleReference == NULL) { fprintf(itemsFile,"NULL"); } else { (*theItem->constructsToCModuleReference)(theEnv,itemsFile,(int) theConstruct->bsaveID,imageID,maxIndices); } if ((j + 1) < GetNumberOfModuleItems(theEnv)) fprintf(itemsFile,","); else if (theConstruct->next != NULL) fprintf(itemsFile,",\n"); } /*=================================*/ /* Write the importList reference. */ /*=================================*/ if (theConstruct->importList == NULL) { fprintf(moduleFile,"NULL,"); } else { fprintf(moduleFile,"&%s%d_%d[%d],",PortPrefix(),imageID, (portItemCount / maxIndices) + 1, portItemCount % maxIndices); for (portItemPtr = theConstruct->importList; portItemPtr != NULL; portItemPtr = portItemPtr->next) { portItemCount++; } } /*=================================*/ /* Write the exportList reference. */ /*=================================*/ if (theConstruct->exportList == NULL) { fprintf(moduleFile,"NULL,"); } else { fprintf(moduleFile,"&%s%d_%d[%d],",PortPrefix(),imageID, (portItemCount / maxIndices) + 1, portItemCount % maxIndices); for (portItemPtr = theConstruct->exportList; portItemPtr != NULL; portItemPtr = portItemPtr->next) { portItemCount++; } } /*=====================*/ /* Write the bsave id. */ /*=====================*/ fprintf(moduleFile,"0,%ld,",theConstruct->bsaveID); /*======================*/ /* Write the user data. */ /*======================*/ fprintf(moduleFile,"NULL,"); /*===========================*/ /* Write the next reference. */ /*===========================*/ if (theConstruct->next == NULL) { fprintf(moduleFile,"NULL}"); } else { fprintf(moduleFile,"&%s%d_%d[%d]}",ConstructPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem),imageID, (int) (theConstruct->next->bsaveID / maxIndices) + 1, (int) theConstruct->next->bsaveID % maxIndices); } /*===================================================*/ /* Increment the number of defmodule data structures */ /* written and close the output file if necessary. */ /*===================================================*/ moduleCount++; moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleCount,&moduleArrayVersion, maxIndices,NULL,NULL); } /*=========================*/ /* Close the output files. */ /*=========================*/ moduleCount = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&moduleCount, &moduleArrayVersion,maxIndices,NULL,NULL); fprintf(itemsFile,"};\n"); GenClose(theEnv,itemsFile); /*=========================================*/ /* Write out the portItem data structures. */ /*=========================================*/ if (portItemCount == 0) return(TRUE); return(PortItemsToCode(theEnv,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID,maxIndices,&fileCount)); } /************************************************************/ /* PortItemsToCode: Writes the C code representation of all */ /* portItem data structure nodes the specified file. */ /************************************************************/ static int PortItemsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { struct defmodule *theDefmodule = NULL; struct portItem *thePortItem = NULL; int portItemCount = 0; int importChecked = FALSE; int exportChecked = FALSE; FILE *portItemsFile = NULL; int portItemArrayVersion = 1; /*=================================================================*/ /* Loop through each of the portItem data structures writing their */ /* C code representation to the file as they are traversed. */ /*=================================================================*/ for (thePortItem = GetNextPortItem(theEnv,&theDefmodule,&thePortItem,&importChecked,&exportChecked); thePortItem != NULL; thePortItem = GetNextPortItem(theEnv,&theDefmodule,&thePortItem,&importChecked,&exportChecked)) { /*===========================================*/ /* Open a new file to write to if necessary. */ /*===========================================*/ portItemsFile = OpenFileIfNeeded(theEnv,portItemsFile,fileName,pathName,fileNameBuffer,fileID,imageID, fileCount,portItemArrayVersion,headerFP, "struct portItem",PortPrefix(), FALSE,NULL); if (portItemsFile == NULL) { portItemCount = maxIndices; CloseFileIfNeeded(theEnv,portItemsFile,&portItemCount, &portItemArrayVersion,maxIndices,NULL,NULL); return(FALSE); } /*================================================*/ /* Write the portItem data structure to the file. */ /*================================================*/ fprintf(portItemsFile,"{"); PrintSymbolReference(theEnv,portItemsFile,thePortItem->moduleName); fprintf(portItemsFile,","); PrintSymbolReference(theEnv,portItemsFile,thePortItem->constructType); fprintf(portItemsFile,","); PrintSymbolReference(theEnv,portItemsFile,thePortItem->constructName); fprintf(portItemsFile,","); if (thePortItem->next == NULL) { fprintf(portItemsFile,"NULL}"); } else { fprintf(portItemsFile,"&%s%d_%d[%d]}",PortPrefix(),imageID, ((portItemCount+1) / maxIndices) + 1, (portItemCount+1) % maxIndices); } /*==================================================*/ /* Increment the number of portItem data structures */ /* written and close the output file if necessary. */ /*==================================================*/ portItemCount++; CloseFileIfNeeded(theEnv,portItemsFile,&portItemCount,&portItemArrayVersion, maxIndices,NULL,NULL); } /*===================================================*/ /* Close the output file and return TRUE to indicate */ /* the data structures were successfully written. */ /*===================================================*/ portItemCount = maxIndices; CloseFileIfNeeded(theEnv,portItemsFile,&portItemCount, &portItemArrayVersion,maxIndices,NULL,NULL); return(TRUE); } /*********************************************************************/ /* GetNextPortItem: Given a pointer to a portItem data structure */ /* and its defmodule, returns the "next" portItem data structure. */ /* If passed a NULL value for both the defmodule and portItem */ /* data structure, it returns the "first" portItem data structure. */ /*********************************************************************/ static struct portItem *GetNextPortItem( void *theEnv, struct defmodule **theDefmodule, struct portItem **thePortItem, int *importChecked, int *exportChecked) { /*====================================================*/ /* If the defmodule pointer is NULL, then the "first" */ /* portItem data structure should be returned. Start */ /* the search in the "first" defmodule. */ /*====================================================*/ if (*theDefmodule == NULL) { *theDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); *thePortItem = NULL; *importChecked = FALSE; *exportChecked = FALSE; } /*==============================================*/ /* Loop through all of the defmodules until the */ /* "next" portItem data structure is found. */ /*==============================================*/ while (*theDefmodule != NULL) { /*==========================================*/ /* Check to see if there's another portItem */ /* in the import/export list that's being */ /* checked in the module being examined. */ /*==========================================*/ if (*thePortItem != NULL) *thePortItem = (*thePortItem)->next; if (*thePortItem != NULL) return(*thePortItem); /*==================================================*/ /* If we haven't checked the import list yet, begin */ /* checking it. If there aren't any items in the */ /* import list, then check the export list. */ /*==================================================*/ if (! (*importChecked)) { *thePortItem = (*theDefmodule)->importList; *importChecked = TRUE; if (*thePortItem == NULL) { *thePortItem = (*theDefmodule)->exportList; *exportChecked = TRUE; } } /*======================================*/ /* Otherwise, if we haven't checked the */ /* export list yet, begin checking it. */ /*======================================*/ else if (! (*exportChecked)) { *exportChecked = TRUE; *thePortItem = (*theDefmodule)->exportList; } /*==========================================*/ /* If the import or export list contained a */ /* portItem data structure, then return it. */ /*==========================================*/ if (*thePortItem != NULL) return(*thePortItem); /*==================================*/ /* Otherwise, check the next module */ /* for a portItem data structure. */ /*==================================*/ *theDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,*theDefmodule); *importChecked = FALSE; *exportChecked = FALSE; } /*=======================================================*/ /* All the portItem data structures have been traversed. */ /* Return NULL to indicate that none are left. */ /*=======================================================*/ return(NULL); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/sortfun.c0000755000175000017500000003431712375756716016130 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* SORT FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for sorting functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: The sort function leaks memory when called */ /* with a multifield value of length zero. */ /* DR0864 */ /* */ /* 6.30: Added environment cleanup call function */ /* DeallocateSortFunctionData. */ /* */ /*************************************************************/ #define _SORTFUN_SOURCE_ #include "setup.h" #include "argacces.h" #include "dffnxfun.h" #include "envrnmnt.h" #include "evaluatn.h" #include "extnfunc.h" #include "memalloc.h" #include "multifld.h" #include "sysdep.h" #include "sortfun.h" #define SORTFUN_DATA 7 struct sortFunctionData { struct expr *SortComparisonFunction; }; #define SortFunctionData(theEnv) ((struct sortFunctionData *) GetEnvironmentData(theEnv,SORTFUN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DoMergeSort(void *,DATA_OBJECT *,DATA_OBJECT *,unsigned long, unsigned long,unsigned long,unsigned long, int (*)(void *,DATA_OBJECT *,DATA_OBJECT *)); static int DefaultCompareSwapFunction(void *,DATA_OBJECT *,DATA_OBJECT *); static void DeallocateSortFunctionData(void *); /****************************************/ /* SortFunctionDefinitions: Initializes */ /* the sorting functions. */ /****************************************/ globle void SortFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,SORTFUN_DATA,sizeof(struct sortFunctionData),DeallocateSortFunctionData); #if ! RUN_TIME EnvDefineFunction2(theEnv,"sort",'u', PTIEF SortFunction,"SortFunction","1**w"); #endif } /*******************************************************/ /* DeallocateSortFunctionData: Deallocates environment */ /* data for the sort function. */ /*******************************************************/ static void DeallocateSortFunctionData( void *theEnv) { ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); } /**************************************/ /* DefaultCompareSwapFunction: */ /**************************************/ static int DefaultCompareSwapFunction( void *theEnv, DATA_OBJECT *item1, DATA_OBJECT *item2) { DATA_OBJECT returnValue; SortFunctionData(theEnv)->SortComparisonFunction->argList = GenConstant(theEnv,item1->type,item1->value); SortFunctionData(theEnv)->SortComparisonFunction->argList->nextArg = GenConstant(theEnv,item2->type,item2->value); ExpressionInstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); EvaluateExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction,&returnValue); ExpressionDeinstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction->argList); SortFunctionData(theEnv)->SortComparisonFunction->argList = NULL; if ((GetType(returnValue) == SYMBOL) && (GetValue(returnValue) == EnvFalseSymbol(theEnv))) { return(FALSE); } return(TRUE); } /**************************************/ /* SortFunction: H/L access routine */ /* for the rest$ function. */ /**************************************/ globle void SortFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { long argumentCount, i, j, k = 0; DATA_OBJECT *theArguments, *theArguments2; DATA_OBJECT theArg; struct multifield *theMultifield, *tempMultifield; const char *functionName; struct expr *functionReference; int argumentSize = 0; struct FunctionDefinition *fptr; #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *dptr; #endif /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=============================================*/ /* The function expects at least one argument. */ /*=============================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1) { return; } /*=============================================*/ /* Verify that the comparison function exists. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE) { return; } functionName = DOToString(theArg); functionReference = FunctionReferenceExpression(theEnv,functionName); if (functionReference == NULL) { ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name"); return; } /*======================================*/ /* For an external function, verify the */ /* correct number of arguments. */ /*======================================*/ if (functionReference->type == FCALL) { fptr = (struct FunctionDefinition *) functionReference->value; if ((GetMinimumArgs(fptr) > 2) || (GetMaximumArgs(fptr) == 0) || (GetMaximumArgs(fptr) == 1)) { ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments"); ReturnExpression(theEnv,functionReference); return; } } /*=======================================*/ /* For a deffunction, verify the correct */ /* number of arguments. */ /*=======================================*/ #if DEFFUNCTION_CONSTRUCT if (functionReference->type == PCALL) { dptr = (DEFFUNCTION *) functionReference->value; if ((dptr->minNumberOfParameters > 2) || (dptr->maxNumberOfParameters == 0) || (dptr->maxNumberOfParameters == 1)) { ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments"); ReturnExpression(theEnv,functionReference); return; } } #endif /*=====================================*/ /* If there are no items to be sorted, */ /* then return an empty multifield. */ /*=====================================*/ if (argumentCount == 1) { EnvSetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*=====================================*/ /* Retrieve the arguments to be sorted */ /* and determine how many there are. */ /*=====================================*/ theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT)); for (i = 2; i <= argumentCount; i++) { EnvRtnUnknown(theEnv,i,&theArguments[i-2]); if (GetType(theArguments[i-2]) == MULTIFIELD) { argumentSize += GetpDOLength(&theArguments[i-2]); } else { argumentSize++; } } if (argumentSize == 0) { genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */ EnvSetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*====================================*/ /* Pack all of the items to be sorted */ /* into a data object array. */ /*====================================*/ theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT)); for (i = 2; i <= argumentCount; i++) { if (GetType(theArguments[i-2]) == MULTIFIELD) { tempMultifield = (struct multifield *) GetValue(theArguments[i-2]); for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++) { SetType(theArguments2[k],GetMFType(tempMultifield,j)); SetValue(theArguments2[k],GetMFValue(tempMultifield,j)); } } else { SetType(theArguments2[k],GetType(theArguments[i-2])); SetValue(theArguments2[k],GetValue(theArguments[i-2])); k++; } } genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction; SortFunctionData(theEnv)->SortComparisonFunction = functionReference; for (i = 0; i < argumentSize; i++) { ValueInstall(theEnv,&theArguments2[i]); } MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction); for (i = 0; i < argumentSize; i++) { ValueDeinstall(theEnv,&theArguments2[i]); } SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg; functionReference->nextArg = NULL; ReturnExpression(theEnv,functionReference); theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize); for (i = 0; i < argumentSize; i++) { SetMFType(theMultifield,i+1,GetType(theArguments2[i])); SetMFValue(theMultifield,i+1,GetValue(theArguments2[i])); } genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT)); SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,argumentSize); SetpValue(returnValue,(void *) theMultifield); } /*******************************************/ /* MergeSort: Sorts a list of fields */ /* according to user specified criteria. */ /*******************************************/ void MergeSort( void *theEnv, unsigned long listSize, DATA_OBJECT *theList, int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT *)) { DATA_OBJECT *tempList; unsigned long middle; if (listSize <= 1) return; /*==============================*/ /* Create the temporary storage */ /* needed for the merge sort. */ /*==============================*/ tempList = (DATA_OBJECT *) genalloc(theEnv,listSize * sizeof(DATA_OBJECT)); /*=====================================*/ /* Call the merge sort driver routine. */ /*=====================================*/ middle = (listSize + 1) / 2; DoMergeSort(theEnv,theList,tempList,0,middle-1,middle,listSize - 1,swapFunction); /*==================================*/ /* Deallocate the temporary storage */ /* needed by the merge sort. */ /*==================================*/ genfree(theEnv,tempList,listSize * sizeof(DATA_OBJECT)); } /******************************************************/ /* DoMergeSort: Driver routine for performing a merge */ /* sort on an array of DATA_OBJECT structures. */ /******************************************************/ static void DoMergeSort( void *theEnv, DATA_OBJECT *theList, DATA_OBJECT *tempList, unsigned long s1, unsigned long e1, unsigned long s2, unsigned long e2, int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT *)) { DATA_OBJECT temp; unsigned long middle, size; unsigned long c1, c2, mergePoint; /* Sort the two subareas before merging them. */ if (s1 == e1) { /* List doesn't need to be merged. */ } else if ((s1 + 1) == e1) { if ((*swapFunction)(theEnv,&theList[s1],&theList[e1])) { TransferDataObjectValues(&temp,&theList[s1]); TransferDataObjectValues(&theList[s1],&theList[e1]); TransferDataObjectValues(&theList[e1],&temp); } } else { size = ((e1 - s1) + 1); middle = s1 + ((size + 1) / 2); DoMergeSort(theEnv,theList,tempList,s1,middle-1,middle,e1,swapFunction); } if (s2 == e2) { /* List doesn't need to be merged. */ } else if ((s2 + 1) == e2) { if ((*swapFunction)(theEnv,&theList[s2],&theList[e2])) { TransferDataObjectValues(&temp,&theList[s2]); TransferDataObjectValues(&theList[s2],&theList[e2]); TransferDataObjectValues(&theList[e2],&temp); } } else { size = ((e2 - s2) + 1); middle = s2 + ((size + 1) / 2); DoMergeSort(theEnv,theList,tempList,s2,middle-1,middle,e2,swapFunction); } /*======================*/ /* Merge the two areas. */ /*======================*/ mergePoint = s1; c1 = s1; c2 = s2; while (mergePoint <= e2) { if (c1 > e1) { TransferDataObjectValues(&tempList[mergePoint],&theList[c2]); c2++; mergePoint++; } else if (c2 > e2) { TransferDataObjectValues(&tempList[mergePoint],&theList[c1]); c1++; mergePoint++; } else if ((*swapFunction)(theEnv,&theList[c1],&theList[c2])) { TransferDataObjectValues(&tempList[mergePoint],&theList[c2]); c2++; mergePoint++; } else { TransferDataObjectValues(&tempList[mergePoint],&theList[c1]); c1++; mergePoint++; } } /*=======================================*/ /* Copy them back to the original array. */ /*=======================================*/ for (c1 = s1; c1 <= e2; c1++) { TransferDataObjectValues(&theList[c1],&tempList[c1]); } } clips_core_source_630/core/._insfun.h0000755000175000017500000000040712500146515016121 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/parsefun.h0000755000175000017500000000532212373743671016244 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PARSING FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several parsing related */ /* functions including... */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed function declaration issue when */ /* BLOAD_ONLY compiler flag is set to 1. */ /* */ /*************************************************************/ #ifndef _H_parsefun #define _H_parsefun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _PARSEFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ParseFunctionDefinitions(void *); LOCALE void CheckSyntaxFunction(void *,DATA_OBJECT *); LOCALE int CheckSyntax(void *,const char *,DATA_OBJECT_PTR); #endif /* _H_parsefun */ clips_core_source_630/core/filecom.h0000755000175000017500000001070312373742633016033 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FILE COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for file commands including */ /* batch, dribble-on, dribble-off, save, load, bsave, and */ /* bload. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added code for capturing errors/warnings. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #ifndef _H_filecom #define _H_filecom #ifdef LOCALE #undef LOCALE #endif #ifdef _FILECOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FileCommandDefinitions(void *); LOCALE intBool EnvDribbleOn(void *,const char *); LOCALE intBool EnvDribbleActive(void *); LOCALE intBool EnvDribbleOff(void *); LOCALE void SetDribbleStatusFunction(void *,int (*)(void *,int)); LOCALE int LLGetcBatch(void *,const char *,int); LOCALE int Batch(void *,const char *); LOCALE int OpenBatch(void *,const char *,int); LOCALE int OpenStringBatch(void *,const char *,const char *,int); LOCALE int RemoveBatch(void *); LOCALE intBool BatchActive(void *); LOCALE void CloseAllBatchSources(void *); LOCALE int BatchCommand(void *); LOCALE int BatchStarCommand(void *); LOCALE int EnvBatchStar(void *,const char *); LOCALE int LoadCommand(void *); LOCALE int LoadStarCommand(void *); LOCALE int SaveCommand(void *); LOCALE int DribbleOnCommand(void *); LOCALE int DribbleOffCommand(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool DribbleActive(void); LOCALE intBool DribbleOn(const char *); LOCALE intBool DribbleOff(void); LOCALE int BatchStar(const char *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_filecom */ clips_core_source_630/core/._insqypsr.h0000755000175000017500000000040712373756327016527 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._reorder.c0000755000175000017500000000040712461264174016264 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltrhs.h0000755000175000017500000000427112373754175016301 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE RHS PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added additional argument required for */ /* DeriveDefaultFromConstraints. */ /* */ /* Added additional argument required for */ /* InvalidDeftemplateSlotMessage. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_tmpltrhs #define _H_tmpltrhs #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTRHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct expr *ParseAssertTemplate(void *,const char *,struct token *,int *, int,int,struct deftemplate *); #endif /* _H_tmpltrhs */ clips_core_source_630/core/tmpltdef.c0000755000175000017500000005363312461252520016225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFTEMPLATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic deftemplate primitive functions */ /* such as allocating and deallocating, traversing, and */ /* finding deftemplate data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Added code for deftemplate run time */ /* initialization of hashed comparisons to */ /* constants. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for deftemplate slot facets. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _TMPLTDEF_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "exprnops.h" #include "cstrccom.h" #include "network.h" #include "tmpltpsr.h" #include "tmpltbsc.h" #include "tmpltutl.h" #include "tmpltfun.h" #include "router.h" #include "modulpsr.h" #include "modulutl.h" #include "cstrnchk.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "tmpltbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "tmpltcmp.h" #endif #include "tmpltdef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void ReturnDeftemplate(void *,void *); static void InitializeDeftemplateModules(void *); static void DeallocateDeftemplateData(void *); static void DestroyDeftemplateAction(void *,struct constructHeader *,void *); static void DestroyDeftemplate(void *,void *); #if RUN_TIME static void RuntimeDeftemplateAction(void *,struct constructHeader *,void *); static void SearchForHashedPatternNodes(void *,struct factPatternNode *); #endif /******************************************************************/ /* InitializeDeftemplates: Initializes the deftemplate construct. */ /******************************************************************/ globle void InitializeDeftemplates( void *theEnv) { globle struct entityRecord deftemplatePtrRecord = { "DEFTEMPLATE_PTR", DEFTEMPLATE_PTR,1,0,0, NULL, NULL,NULL, NULL, NULL, DecrementDeftemplateBusyCount, IncrementDeftemplateBusyCount, NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFTEMPLATE_DATA,sizeof(struct deftemplateData),DeallocateDeftemplateData); memcpy(&DeftemplateData(theEnv)->DeftemplatePtrRecord,&deftemplatePtrRecord,sizeof(struct entityRecord)); InitializeFacts(theEnv); InitializeDeftemplateModules(theEnv); DeftemplateBasicCommands(theEnv); DeftemplateFunctions(theEnv); DeftemplateData(theEnv)->DeftemplateConstruct = AddConstruct(theEnv,"deftemplate","deftemplates",ParseDeftemplate,EnvFindDeftemplate, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDeftemplate,SetNextConstruct, EnvIsDeftemplateDeletable,EnvUndeftemplate,ReturnDeftemplate); InstallPrimitive(theEnv,(ENTITY_RECORD_PTR) &DeftemplateData(theEnv)->DeftemplatePtrRecord,DEFTEMPLATE_PTR); } /******************************************************/ /* DeallocateDeftemplateData: Deallocates environment */ /* data for the deftemplate construct. */ /******************************************************/ static void DeallocateDeftemplateData( void *theEnv) { #if ! RUN_TIME struct deftemplateModule *theModuleItem; void *theModule; #endif #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDeftemplateAction,DeftemplateData(theEnv)->DeftemplateModuleIndex,FALSE,NULL); #if ! RUN_TIME for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct deftemplateModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DeftemplateData(theEnv)->DeftemplateModuleIndex); rtn_struct(theEnv,deftemplateModule,theModuleItem); } #endif } /*****************************************************/ /* DestroyDeftemplateAction: Action used to remove */ /* deftemplates as a result of DestroyEnvironment. */ /*****************************************************/ static void DestroyDeftemplateAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct deftemplate *theDeftemplate = (struct deftemplate *) theConstruct; if (theDeftemplate == NULL) return; DestroyDeftemplate(theEnv,theDeftemplate); } /*************************************************************/ /* InitializeDeftemplateModules: Initializes the deftemplate */ /* construct for use with the defmodule construct. */ /*************************************************************/ static void InitializeDeftemplateModules( void *theEnv) { DeftemplateData(theEnv)->DeftemplateModuleIndex = RegisterModuleItem(theEnv,"deftemplate", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDeftemplateModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeftemplateCModuleReference, #else NULL, #endif EnvFindDeftemplateInModule); #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"deftemplate",SYMBOL); #endif } /***************************************************/ /* AllocateModule: Allocates a deftemplate module. */ /***************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,deftemplateModule)); } /*************************************************/ /* ReturnModule: Deallocates a deftemplate module. */ /*************************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeftemplateData(theEnv)->DeftemplateConstruct); rtn_struct(theEnv,deftemplateModule,theItem); } /****************************************************************/ /* GetDeftemplateModuleItem: Returns a pointer to the defmodule */ /* item for the specified deftemplate or defmodule. */ /****************************************************************/ globle struct deftemplateModule *GetDeftemplateModuleItem( void *theEnv, struct defmodule *theModule) { return((struct deftemplateModule *) GetConstructModuleItemByIndex(theEnv,theModule,DeftemplateData(theEnv)->DeftemplateModuleIndex)); } /*****************************************************/ /* EnvFindDeftemplate: Searches for a deftemplate in */ /* the list of deftemplates. Returns a pointer to */ /* the deftemplate if found, otherwise NULL. */ /*****************************************************/ globle void *EnvFindDeftemplate( void *theEnv, const char *deftemplateName) { return(FindNamedConstructInModuleOrImports(theEnv,deftemplateName,DeftemplateData(theEnv)->DeftemplateConstruct)); } /*****************************************************/ /* EnvFindDeftemplateInModule: Searches for a deftemplate in */ /* the list of deftemplates. Returns a pointer to */ /* the deftemplate if found, otherwise NULL. */ /*****************************************************/ globle void *EnvFindDeftemplateInModule( void *theEnv, const char *deftemplateName) { return(FindNamedConstructInModule(theEnv,deftemplateName,DeftemplateData(theEnv)->DeftemplateConstruct)); } /***********************************************************************/ /* EnvGetNextDeftemplate: If passed a NULL pointer, returns the first */ /* deftemplate in the ListOfDeftemplates. Otherwise returns the next */ /* deftemplate following the deftemplate passed as an argument. */ /***********************************************************************/ globle void *EnvGetNextDeftemplate( void *theEnv, void *deftemplatePtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) deftemplatePtr,DeftemplateData(theEnv)->DeftemplateModuleIndex)); } /***********************************************************/ /* EnvIsDeftemplateDeletable: Returns TRUE if a particular */ /* deftemplate can be deleted, otherwise returns FALSE. */ /***********************************************************/ globle intBool EnvIsDeftemplateDeletable( void *theEnv, void *vTheDeftemplate) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; if (! ConstructsDeletable(theEnv)) { return FALSE; } if (theDeftemplate->busyCount > 0) return(FALSE); if (theDeftemplate->patternNetwork != NULL) return(FALSE); return(TRUE); } /**************************************************************/ /* ReturnDeftemplate: Returns the data structures associated */ /* with a deftemplate construct to the pool of free memory. */ /**************************************************************/ static void ReturnDeftemplate( void *theEnv, void *vTheConstruct) { #if (! BLOAD_ONLY) && (! RUN_TIME) struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct; struct templateSlot *slotPtr; if (theConstruct == NULL) return; /*====================================================================*/ /* If a template is redefined, then we want to save its debug status. */ /*====================================================================*/ #if DEBUGGING_FUNCTIONS DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0; if (theConstruct->watch) BitwiseSet(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0); #endif /*===========================================*/ /* Free storage used by the templates slots. */ /*===========================================*/ slotPtr = theConstruct->slotList; while (slotPtr != NULL) { DecrementSymbolCount(theEnv,slotPtr->slotName); RemoveHashedExpression(theEnv,slotPtr->defaultList); slotPtr->defaultList = NULL; RemoveHashedExpression(theEnv,slotPtr->facetList); slotPtr->facetList = NULL; RemoveConstraint(theEnv,slotPtr->constraints); slotPtr->constraints = NULL; slotPtr = slotPtr->next; } ReturnSlots(theEnv,theConstruct->slotList); /*==================================*/ /* Free storage used by the header. */ /*==================================*/ DeinstallConstructHeader(theEnv,&theConstruct->header); rtn_struct(theEnv,deftemplate,theConstruct); #endif } /**************************************************************/ /* DestroyDeftemplate: Returns the data structures associated */ /* with a deftemplate construct to the pool of free memory. */ /**************************************************************/ static void DestroyDeftemplate( void *theEnv, void *vTheConstruct) { struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct; #if (! BLOAD_ONLY) && (! RUN_TIME) struct templateSlot *slotPtr, *nextSlot; #endif if (theConstruct == NULL) return; #if (! BLOAD_ONLY) && (! RUN_TIME) slotPtr = theConstruct->slotList; while (slotPtr != NULL) { nextSlot = slotPtr->next; rtn_struct(theEnv,templateSlot,slotPtr); slotPtr = nextSlot; } #endif DestroyFactPatternNetwork(theEnv,theConstruct->patternNetwork); /*==================================*/ /* Free storage used by the header. */ /*==================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) DeinstallConstructHeader(theEnv,&theConstruct->header); rtn_struct(theEnv,deftemplate,theConstruct); #endif } /***********************************************/ /* ReturnSlots: Returns the slot structures of */ /* a deftemplate to free memory. */ /***********************************************/ globle void ReturnSlots( void *theEnv, struct templateSlot *slotPtr) { #if (! BLOAD_ONLY) && (! RUN_TIME) struct templateSlot *nextSlot; while (slotPtr != NULL) { nextSlot = slotPtr->next; ReturnExpression(theEnv,slotPtr->defaultList); ReturnExpression(theEnv,slotPtr->facetList); RemoveConstraint(theEnv,slotPtr->constraints); rtn_struct(theEnv,templateSlot,slotPtr); slotPtr = nextSlot; } #endif } /*************************************************/ /* DecrementDeftemplateBusyCount: Decrements the */ /* busy count of a deftemplate data structure. */ /*************************************************/ globle void DecrementDeftemplateBusyCount( void *theEnv, void *vTheTemplate) { struct deftemplate *theTemplate = (struct deftemplate *) vTheTemplate; if (! ConstructData(theEnv)->ClearInProgress) theTemplate->busyCount--; } /*************************************************/ /* IncrementDeftemplateBusyCount: Increments the */ /* busy count of a deftemplate data structure. */ /*************************************************/ globle void IncrementDeftemplateBusyCount( void *theEnv, void *vTheTemplate) { struct deftemplate *theTemplate = (struct deftemplate *) vTheTemplate; #if MAC_XCD #pragma unused(theEnv) #endif theTemplate->busyCount++; } /*******************************************************************/ /* EnvGetNextFactInTemplate: If passed a NULL pointer, returns the */ /* first fact in the template's fact-list. Otherwise returns the */ /* next template fact following the fact passed as an argument. */ /*******************************************************************/ globle void *EnvGetNextFactInTemplate( void *theEnv, void *theTemplate, void *factPtr) { #if MAC_XCD #pragma unused(theEnv) #endif if (factPtr == NULL) { return((void *) ((struct deftemplate *) theTemplate)->factList); } if (((struct fact *) factPtr)->garbage) return(NULL); return((void *) ((struct fact *) factPtr)->nextTemplateFact); } #if ! RUN_TIME /******************************/ /* CreateDeftemplateScopeMap: */ /******************************/ globle void *CreateDeftemplateScopeMap( void *theEnv, struct deftemplate *theDeftemplate) { unsigned scopeMapSize; char *scopeMap; const char *templateName; struct defmodule *matchModule, *theModule; int moduleID,count; void *theBitMap; templateName = ValueToString(theDeftemplate->header.name); matchModule = theDeftemplate->header.whichModule->theModule; scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1)); scopeMap = (char *) gm2(theEnv,scopeMapSize); ClearBitString((void *) scopeMap,scopeMapSize); SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL) ; theModule != NULL ; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleID = (int) theModule->bsaveID; if (FindImportedConstruct(theEnv,"deftemplate",matchModule, templateName,&count,TRUE,NULL) != NULL) SetBitMap(scopeMap,moduleID); } RestoreCurrentModule(theEnv); theBitMap = EnvAddBitMap(theEnv,scopeMap,scopeMapSize); IncrementBitMapCount(theBitMap); rm(theEnv,(void *) scopeMap,scopeMapSize); return(theBitMap); } #endif #if RUN_TIME /**************************************************/ /* RuntimeDeftemplateAction: Action to be applied */ /* to each deftemplate construct when a runtime */ /* initialization occurs. */ /**************************************************/ static void RuntimeDeftemplateAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif struct deftemplate *theDeftemplate = (struct deftemplate *) theConstruct; SearchForHashedPatternNodes(theEnv,theDeftemplate->patternNetwork); } /*******************************************************************/ /* SearchForHashedPatternNodes: */ /*******************************************************************/ static void SearchForHashedPatternNodes( void *theEnv, struct factPatternNode *theNode) { while (theNode != NULL) { if ((theNode->lastLevel != NULL) && (theNode->lastLevel->header.selector)) { AddHashedPatternNode(theEnv,theNode->lastLevel,theNode,theNode->networkTest->type,theNode->networkTest->value); } SearchForHashedPatternNodes(theEnv,theNode->nextLevel); theNode = theNode->rightNode; } } /*******************************************************************/ /* DeftemplateRunTimeInitialize: */ /*******************************************************************/ globle void DeftemplateRunTimeInitialize( void *theEnv) { DoForAllConstructs(theEnv,RuntimeDeftemplateAction,DeftemplateData(theEnv)->DeftemplateModuleIndex,TRUE,NULL); } #endif /* RUN_TIME */ /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvDeftemplateModule( void *theEnv, void *theDeftemplate) { return GetConstructModuleName((struct constructHeader *) theDeftemplate); } globle const char *EnvGetDeftemplateName( void *theEnv, void *theDeftemplate) { return GetConstructNameString((struct constructHeader *) theDeftemplate); } globle const char *EnvGetDeftemplatePPForm( void *theEnv, void *theDeftemplate) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDeftemplate); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle const char *DeftemplateModule( void *theDeftemplate) { return EnvDeftemplateModule(GetCurrentEnvironment(),theDeftemplate); } globle void *FindDeftemplate( const char *deftemplateName) { return EnvFindDeftemplate(GetCurrentEnvironment(),deftemplateName); } globle const char *GetDeftemplateName( void *theDeftemplate) { return EnvGetDeftemplateName(GetCurrentEnvironment(),theDeftemplate); } globle const char *GetDeftemplatePPForm( void *theDeftemplate) { return EnvGetDeftemplatePPForm(GetCurrentEnvironment(),theDeftemplate); } globle void *GetNextDeftemplate( void *deftemplatePtr) { return EnvGetNextDeftemplate(GetCurrentEnvironment(),deftemplatePtr); } globle intBool IsDeftemplateDeletable( void *vTheDeftemplate) { return EnvIsDeftemplateDeletable(GetCurrentEnvironment(),vTheDeftemplate); } globle void *GetNextFactInTemplate( void *theTemplate, void *factPtr) { return EnvGetNextFactInTemplate(GetCurrentEnvironment(),theTemplate,factPtr); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/._analysis.c0000755000175000017500000000033012374672752016450 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/exprnbin.c0000755000175000017500000004113412373740005016226 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* expression data structure. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #define _EXPRNBIN_SOURCE_ #include "setup.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "dffctdef.h" #include "moduldef.h" #include "constrct.h" #include "extnfunc.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrcbin.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxbin.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltbin.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globlbin.h" #endif #if OBJECT_SYSTEM #include "objbin.h" #include "insfun.h" #include "inscom.h" #endif #include "exprnbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void UpdateExpression(void *,void *,long); /***********************************************************/ /* AllocateExpressions: Determines the amount of space */ /* required for loading the binary image of expressions */ /* and allocates that amount of space. */ /***********************************************************/ globle void AllocateExpressions( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &ExpressionData(theEnv)->NumberOfExpressions,sizeof(long)); if (ExpressionData(theEnv)->NumberOfExpressions == 0L) ExpressionData(theEnv)->ExpressionArray = NULL; else { space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr); ExpressionData(theEnv)->ExpressionArray = (struct expr *) genalloc(theEnv,space); } } /**********************************************/ /* RefreshExpressions: Refreshes the pointers */ /* used by the expression binary image. */ /**********************************************/ globle void RefreshExpressions( void *theEnv) { if (ExpressionData(theEnv)->ExpressionArray == NULL) return; BloadandRefresh(theEnv,ExpressionData(theEnv)->NumberOfExpressions, (unsigned) sizeof(BSAVE_EXPRESSION),UpdateExpression); } /********************************************************* NAME : UpdateExpression DESCRIPTION : Given a bloaded expression buffer, this routine refreshes the pointers in the expression array INPUTS : 1) a bloaded expression buffer 2) the index of the expression to refresh RETURNS : Nothing useful SIDE EFFECTS : Expression updated NOTES : None *********************************************************/ static void UpdateExpression( void *theEnv, void *buf, long obji) { BSAVE_EXPRESSION *bexp; long theIndex; bexp = (BSAVE_EXPRESSION *) buf; ExpressionData(theEnv)->ExpressionArray[obji].type = bexp->type; switch(bexp->type) { case FCALL: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) BloadData(theEnv)->FunctionArray[bexp->value]; break; case GCALL: #if DEFGENERIC_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) GenericPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case PCALL: #if DEFFUNCTION_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DeffunctionPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case DEFTEMPLATE_PTR: #if DEFTEMPLATE_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DeftemplatePointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case DEFCLASS_PTR: #if OBJECT_SYSTEM ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DefclassPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case DEFGLOBAL_PTR: #if DEFGLOBAL_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DefglobalPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case INTEGER: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->IntegerArray[bexp->value]; IncrementIntegerCount((INTEGER_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); break; case FLOAT: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->FloatArray[bexp->value]; IncrementFloatCount((FLOAT_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); break; case INSTANCE_NAME: #if ! OBJECT_SYSTEM ExpressionData(theEnv)->ExpressionArray[obji].type = SYMBOL; #endif case GBL_VARIABLE: case SYMBOL: case STRING: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->SymbolArray[bexp->value]; IncrementSymbolCount((SYMBOL_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); break; #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) &FactData(theEnv)->DummyFact; EnvIncrementFactCount(theEnv,ExpressionData(theEnv)->ExpressionArray[obji].value); break; #endif #if OBJECT_SYSTEM case INSTANCE_ADDRESS: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) &InstanceData(theEnv)->DummyInstance; EnvIncrementInstanceCount(theEnv,ExpressionData(theEnv)->ExpressionArray[obji].value); break; #endif case EXTERNAL_ADDRESS: ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[bexp->type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[bexp->type]->bitMap) { ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->BitMapArray[bexp->value]; IncrementBitMapCount((BITMAP_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); } break; } theIndex = (long int) bexp->nextArg; if (theIndex == -1L) { ExpressionData(theEnv)->ExpressionArray[obji].nextArg = NULL; } else { ExpressionData(theEnv)->ExpressionArray[obji].nextArg = (struct expr *) &ExpressionData(theEnv)->ExpressionArray[theIndex]; } theIndex = (long int) bexp->argList; if (theIndex == -1L) { ExpressionData(theEnv)->ExpressionArray[obji].argList = NULL; } else { ExpressionData(theEnv)->ExpressionArray[obji].argList = (struct expr *) &ExpressionData(theEnv)->ExpressionArray[theIndex]; } } /*********************************************/ /* ClearBloadedExpressions: Clears the space */ /* utilized by an expression binary image. */ /*********************************************/ globle void ClearBloadedExpressions( void *theEnv) { unsigned long int i; size_t space; /*===============================================*/ /* Update the busy counts of atomic data values. */ /*===============================================*/ for (i = 0; i < (unsigned long) ExpressionData(theEnv)->NumberOfExpressions; i++) { switch (ExpressionData(theEnv)->ExpressionArray[i].type) { case SYMBOL : case STRING : case INSTANCE_NAME : case GBL_VARIABLE : DecrementSymbolCount(theEnv,(SYMBOL_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); break; case FLOAT : DecrementFloatCount(theEnv,(FLOAT_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); break; case INTEGER : DecrementIntegerCount(theEnv,(INTEGER_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); break; #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS : EnvDecrementFactCount(theEnv,ExpressionData(theEnv)->ExpressionArray[i].value); break; #endif #if OBJECT_SYSTEM case INSTANCE_ADDRESS : EnvDecrementInstanceCount(theEnv,ExpressionData(theEnv)->ExpressionArray[i].value); break; #endif case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[ExpressionData(theEnv)->ExpressionArray[i].type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[ExpressionData(theEnv)->ExpressionArray[i].type]->bitMap) { DecrementBitMapCount(theEnv,(BITMAP_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); } break; } } /*===================================*/ /* Free the binary expression array. */ /*===================================*/ space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr); if (space != 0) genfree(theEnv,(void *) ExpressionData(theEnv)->ExpressionArray,space); ExpressionData(theEnv)->ExpressionArray = 0; } #if BLOAD_AND_BSAVE /*************************************************** NAME : FindHashedExpressions DESCRIPTION : Sets the bsave expression array indices for hashed expression nodes and marks the items needed by these expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Atoms marked and ids set NOTES : None ***************************************************/ globle void FindHashedExpressions( void *theEnv) { register unsigned i; EXPRESSION_HN *exphash; for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++) for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next) { MarkNeededItems(theEnv,exphash->exp); exphash->bsaveID = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(exphash->exp); } } /*************************************************** NAME : BsaveHashedExpressions DESCRIPTION : Writes out hashed expressions INPUTS : Bsave file stream pointer RETURNS : Nothing useful SIDE EFFECTS : Expressions written NOTES : None ***************************************************/ globle void BsaveHashedExpressions( void *theEnv, FILE *fp) { register unsigned i; EXPRESSION_HN *exphash; for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++) for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next) BsaveExpression(theEnv,exphash->exp,fp); } /***************************************************************/ /* BsaveConstructExpressions: Writes all expression needed by */ /* constructs for this binary image to the binary save file. */ /***************************************************************/ globle void BsaveConstructExpressions( void *theEnv, FILE *fp) { struct BinaryItem *biPtr; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->expressionFunction != NULL) { (*biPtr->expressionFunction)(theEnv,fp); } } } /***************************************/ /* BsaveExpression: Recursively saves */ /* an expression to the binary file. */ /***************************************/ globle void BsaveExpression( void *theEnv, struct expr *testPtr, FILE *fp) { BSAVE_EXPRESSION newTest; long int newIndex; while (testPtr != NULL) { ExpressionData(theEnv)->ExpressionCount++; /*================*/ /* Copy the type. */ /*================*/ newTest.type = testPtr->type; /*=======================================*/ /* Convert the argList slot to an index. */ /*=======================================*/ if (testPtr->argList == NULL) { newTest.argList = -1L; } else { newTest.argList = ExpressionData(theEnv)->ExpressionCount; } /*========================================*/ /* Convert the nextArg slot to an index. */ /*========================================*/ if (testPtr->nextArg == NULL) { newTest.nextArg = -1L; } else { newIndex = ExpressionData(theEnv)->ExpressionCount + ExpressionSize(testPtr->argList); newTest.nextArg = newIndex; } /*=========================*/ /* Convert the value slot. */ /*=========================*/ switch(testPtr->type) { case FLOAT: newTest.value = (long) ((FLOAT_HN *) testPtr->value)->bucket; break; case INTEGER: newTest.value = (long) ((INTEGER_HN *) testPtr->value)->bucket; break; case FCALL: newTest.value = (long) ((struct FunctionDefinition *) testPtr->value)->bsaveIndex; break; case GCALL: #if DEFGENERIC_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case PCALL: #if DEFFUNCTION_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case DEFTEMPLATE_PTR: #if DEFTEMPLATE_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case DEFCLASS_PTR: #if OBJECT_SYSTEM if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case DEFGLOBAL_PTR: #if DEFGLOBAL_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct defglobal *) testPtr->value)->header.bsaveID; else #endif newTest.value = -1L; break; #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: case GBL_VARIABLE: case STRING: newTest.value = (long) ((SYMBOL_HN *) testPtr->value)->bucket; break; case FACT_ADDRESS: case INSTANCE_ADDRESS: case EXTERNAL_ADDRESS: newTest.value = -1L; break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type]->bitMap) { newTest.value = (long) ((BITMAP_HN *) testPtr->value)->bucket; } break; } /*===========================*/ /* Write out the expression. */ /*===========================*/ GenWrite(&newTest,(unsigned long) sizeof(BSAVE_EXPRESSION),fp); /*==========================*/ /* Write out argument list. */ /*==========================*/ if (testPtr->argList != NULL) { BsaveExpression(theEnv,testPtr->argList,fp); } testPtr = testPtr->nextArg; } } #endif /* BLOAD_AND_BSAVE */ #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) */ clips_core_source_630/core/._exprnbin.h0000755000175000017500000000040712373740004016445 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/sysdep.h0000755000175000017500000001772012464554105015726 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* SYSTEM DEPENDENT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Isolation of system dependent routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modified GenOpen to check the file length */ /* against the system constant FILENAME_MAX. */ /* */ /* 6.24: Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Made gensystem functional for Xcode. */ /* */ /* Added BeforeOpenFunction and AfterOpenFunction */ /* hooks. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Updated UNIX_V gentime functionality. */ /* */ /* Removed GenOpen check against FILENAME_MAX. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, IBM_ICB, IBM_TBC, IBM_ZTC, and */ /* IBM_SC). */ /* */ /* Renamed IBM_MSC and WIN_MVC compiler flags */ /* and IBM_GCC to WIN_GCC. */ /* */ /* Added LINUX and DARWIN compiler flags. */ /* */ /* Removed HELP_FUNCTIONS compilation flag and */ /* associated functionality. */ /* */ /* Removed EMACS_EDITOR compilation flag and */ /* associated functionality. */ /* */ /* Combined BASIC_IO and EXT_IO compilation */ /* flags into the single IO_FUNCTIONS flag. */ /* */ /* Changed the EX_MATH compilation flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Support for typed EXTERNAL_ADDRESS. */ /* */ /* GenOpen function checks for UTF-8 Byte Order */ /* Marker. */ /* */ /* Added gengetchar, genungetchar, genprintfile, */ /* genstrcpy, genstrncpy, genstrcat, genstrncat, */ /* and gensprintf functions. */ /* */ /* Added SetJmpBuffer function. */ /* */ /* Added environment argument to genexit. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_sysdep #define _H_sysdep #ifndef _H_symbol #include "symbol.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include #if WIN_MVC #include #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SYSDEP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void InitializeEnvironment(void); #endif LOCALE void EnvInitializeEnvironment(void *,struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **, struct externalAddressHashNode **); LOCALE void SetRedrawFunction(void *,void (*)(void *)); LOCALE void SetPauseEnvFunction(void *,void (*)(void *)); LOCALE void SetContinueEnvFunction(void *,void (*)(void *,int)); LOCALE void (*GetRedrawFunction(void *))(void *); LOCALE void (*GetPauseEnvFunction(void *))(void *); LOCALE void (*GetContinueEnvFunction(void *))(void *,int); LOCALE void RerouteStdin(void *,int,char *[]); LOCALE double gentime(void); LOCALE void gensystem(void *theEnv); LOCALE void VMSSystem(char *); LOCALE int GenOpenReadBinary(void *,const char *,const char *); LOCALE void GetSeekCurBinary(void *,long); LOCALE void GetSeekSetBinary(void *,long); LOCALE void GenTellBinary(void *,long *); LOCALE void GenCloseBinary(void *); LOCALE void GenReadBinary(void *,void *,size_t); LOCALE FILE *GenOpen(void *,const char *,const char *); LOCALE int GenClose(void *,FILE *); LOCALE void genexit(void *,int); LOCALE int genrand(void); LOCALE void genseed(int); LOCALE int genremove(const char *); LOCALE int genrename(const char *,const char *); LOCALE char *gengetcwd(char *,int); LOCALE void GenWrite(void *,size_t,FILE *); LOCALE int (*EnvSetBeforeOpenFunction(void *,int (*)(void *)))(void *); LOCALE int (*EnvSetAfterOpenFunction(void *,int (*)(void *)))(void *); LOCALE int gensprintf(char *,const char *,...); LOCALE char *genstrcpy(char *,const char *); LOCALE char *genstrncpy(char *,const char *,size_t); LOCALE char *genstrcat(char *,const char *); LOCALE char *genstrncat(char *,const char *,size_t); LOCALE void SetJmpBuffer(void *,jmp_buf *); LOCALE void genprintfile(void *,FILE *,const char *); LOCALE int gengetchar(void *); LOCALE int genungetchar(void *,int); #endif /* _H_sysdep */ clips_core_source_630/core/insmoddp.c0000755000175000017500000011160112373756345016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INSTANCE MODIFY AND DUPLICATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Instance modify and duplicate support routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* 6.30: Added DATA_OBJECT_ARRAY primitive type. */ /* */ /* Changed integer type/precision. */ /* */ /* The return value of DirectMessage indicates */ /* whether an execution error has occurred. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #if DEFRULE_CONSTRUCT #include "network.h" #include "objrtmch.h" #endif #include "argacces.h" #include "memalloc.h" #include "envrnmnt.h" #include "extnfunc.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "inspsr.h" #include "miscfun.h" #include "msgcom.h" #include "msgfun.h" #include "msgpass.h" #include "prccode.h" #include "router.h" #define _INSMODDP_SOURCE_ #include "insmoddp.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static DATA_OBJECT *EvaluateSlotOverrides(void *,EXPRESSION *,int *,int *); static void DeleteSlotOverrideEvaluations(void *,DATA_OBJECT *,int); static void ModifyMsgHandlerSupport(void *,DATA_OBJECT *,int); static void DuplicateMsgHandlerSupport(void *,DATA_OBJECT *,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! RUN_TIME) /*************************************************** NAME : SetupInstanceModDupCommands DESCRIPTION : Defines function interfaces for modify- and duplicate- instance functions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions defined to KB NOTES : None ***************************************************/ globle void SetupInstanceModDupCommands( void *theEnv) { #if DEFRULE_CONSTRUCT EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF InactiveModifyInstance,"InactiveModifyInstance",NULL); EnvDefineFunction2(theEnv,"active-modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL); AddFunctionParser(theEnv,"active-modify-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF InactiveMsgModifyInstance, "InactiveMsgModifyInstance",NULL); EnvDefineFunction2(theEnv,"active-message-modify-instance",'u',PTIEF MsgModifyInstance, "MsgModifyInstance",NULL); AddFunctionParser(theEnv,"active-message-modify-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"duplicate-instance",'u', PTIEF InactiveDuplicateInstance,"InactiveDuplicateInstance",NULL); EnvDefineFunction2(theEnv,"active-duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL); AddFunctionParser(theEnv,"active-duplicate-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF InactiveMsgDuplicateInstance, "InactiveMsgDuplicateInstance",NULL); EnvDefineFunction2(theEnv,"active-message-duplicate-instance",'u',PTIEF MsgDuplicateInstance, "MsgDuplicateInstance",NULL); AddFunctionParser(theEnv,"active-message-duplicate-instance",ParseInitializeInstance); #else EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL); EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF MsgModifyInstance, "MsgModifyInstance",NULL); EnvDefineFunction2(theEnv,"duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL); EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF MsgDuplicateInstance, "MsgDuplicateInstance",NULL); #endif EnvDefineFunction2(theEnv,"(direct-modify)",'u',PTIEF DirectModifyMsgHandler,"DirectModifyMsgHandler",NULL); EnvDefineFunction2(theEnv,"(message-modify)",'u',PTIEF MsgModifyMsgHandler,"MsgModifyMsgHandler",NULL); EnvDefineFunction2(theEnv,"(direct-duplicate)",'u',PTIEF DirectDuplicateMsgHandler,"DirectDuplicateMsgHandler",NULL); EnvDefineFunction2(theEnv,"(message-duplicate)",'u',PTIEF MsgDuplicateMsgHandler,"MsgDuplicateMsgHandler",NULL); AddFunctionParser(theEnv,"modify-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"message-modify-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"duplicate-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"message-duplicate-instance",ParseInitializeInstance); } #endif /************************************************************* NAME : ModifyInstance DESCRIPTION : Modifies slots of an instance via the direct-modify message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (modify-instance *) *************************************************************/ globle void ModifyInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; EXPRESSION theExp; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the modify ====================================== */ theExp.type = DATA_OBJECT_ARRAY; theExp.value = (void *) overrides; theExp.argList = NULL; theExp.nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_MODIFY_STRING),ins,result,&theExp); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } /************************************************************* NAME : MsgModifyInstance DESCRIPTION : Modifies slots of an instance via the direct-modify message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed with put- messages NOTES : H/L Syntax: (message-modify-instance *) *************************************************************/ globle void MsgModifyInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; EXPRESSION theExp; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the modify ====================================== */ theExp.type = DATA_OBJECT_ARRAY; theExp.value = (void *) overrides; theExp.argList = NULL; theExp.nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_MODIFY_STRING),ins,result,&theExp); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } /************************************************************* NAME : DuplicateInstance DESCRIPTION : Duplicates an instance via the direct-duplicate message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (duplicate-instance [to ] *) *************************************************************/ globle void DuplicateInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT newName; EXPRESSION theExp[2]; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), 2,INSTANCE_NAME,&newName) == FALSE) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the duplicate ====================================== */ theExp[0].type = INSTANCE_NAME; theExp[0].value = newName.value; theExp[0].argList = NULL; theExp[0].nextArg = &theExp[1]; theExp[1].type = DATA_OBJECT_ARRAY; theExp[1].value = (void *) overrides; theExp[1].argList = NULL; theExp[1].nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_DUPLICATE_STRING),ins,result,&theExp[0]); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } /************************************************************* NAME : MsgDuplicateInstance DESCRIPTION : Duplicates an instance via the message-duplicate message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed w/ int & put- messages NOTES : H/L Syntax: (duplicate-instance [to ] *) *************************************************************/ globle void MsgDuplicateInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT newName; EXPRESSION theExp[2]; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), 2,INSTANCE_NAME,&newName) == FALSE) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the duplicate ====================================== */ theExp[0].type = INSTANCE_NAME; theExp[0].value = newName.value; theExp[0].argList = NULL; theExp[0].nextArg = &theExp[1]; theExp[1].type = DATA_OBJECT_ARRAY; theExp[1].value = (void *) overrides; theExp[1].argList = NULL; theExp[1].nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_DUPLICATE_STRING),ins,result,&theExp[0]); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } #if DEFRULE_CONSTRUCT /************************************************************** NAME : InactiveModifyInstance DESCRIPTION : Modifies slots of an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (modify-instance *) **************************************************************/ globle void InactiveModifyInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); ModifyInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /************************************************************** NAME : InactiveMsgModifyInstance DESCRIPTION : Modifies slots of an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed with put- messages NOTES : H/L Syntax: (message-modify-instance *) **************************************************************/ globle void InactiveMsgModifyInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); MsgModifyInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /******************************************************************* NAME : InactiveDuplicateInstance DESCRIPTION : Duplicates an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (duplicate-instance [to ] *) *******************************************************************/ globle void InactiveDuplicateInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); DuplicateInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /************************************************************** NAME : InactiveMsgDuplicateInstance DESCRIPTION : Duplicates an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed with put- messages NOTES : H/L Syntax: (message-duplicate-instance [to ] *) **************************************************************/ globle void InactiveMsgDuplicateInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); MsgDuplicateInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } #endif /***************************************************** NAME : DirectDuplicateMsgHandler DESCRIPTION : Implementation for the USER class handler direct-duplicate Implements duplicate-instance message with a series of direct slot placements INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None *****************************************************/ globle void DirectDuplicateMsgHandler( void *theEnv, DATA_OBJECT *result) { DuplicateMsgHandlerSupport(theEnv,result,FALSE); } /***************************************************** NAME : MsgDuplicateMsgHandler DESCRIPTION : Implementation for the USER class handler message-duplicate Implements duplicate-instance message with a series of put- messages INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None *****************************************************/ globle void MsgDuplicateMsgHandler( void *theEnv, DATA_OBJECT *result) { DuplicateMsgHandlerSupport(theEnv,result,TRUE); } /*************************************************** NAME : DirectModifyMsgHandler DESCRIPTION : Implementation for the USER class handler direct-modify Implements modify-instance message with a series of direct slot placements INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None ***************************************************/ globle void DirectModifyMsgHandler( void *theEnv, DATA_OBJECT *result) { ModifyMsgHandlerSupport(theEnv,result,FALSE); } /*************************************************** NAME : MsgModifyMsgHandler DESCRIPTION : Implementation for the USER class handler message-modify Implements modify-instance message with a series of put- messages INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None ***************************************************/ globle void MsgModifyMsgHandler( void *theEnv, DATA_OBJECT *result) { ModifyMsgHandlerSupport(theEnv,result,TRUE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : EvaluateSlotOverrides DESCRIPTION : Evaluates the slot-override expressions for modify-instance and duplicate-instance Evaluations are stored in an array of data objects, where the supplementalInfo field points at the name of the slot The data object next fields are used to link the array as well. INPUTS : 1) The slot override expressions 2) A buffer to hold the number of slot overrides 3) A buffer to hold an error flag RETURNS : The slot override data object array SIDE EFFECTS : Data object array allocated and initialized override count and error buffers set NOTES : Slot overrides must be evaluated before calling supporting message-handlers for modify- and duplicate-instance in the event that the overrides contain variable references to an outer frame ***********************************************************/ static DATA_OBJECT *EvaluateSlotOverrides( void *theEnv, EXPRESSION *ovExprs, int *ovCnt, int *error) { DATA_OBJECT *ovs; int ovi; void *slotName; *error = FALSE; /* ========================================== There are two expressions chains for every slot override: one for the slot name and one for the slot value ========================================== */ *ovCnt = CountArguments(ovExprs) / 2; if (*ovCnt == 0) return(NULL); /* =============================================== Evaluate all the slot override names and values and store them in a contiguous array =============================================== */ ovs = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * (*ovCnt))); ovi = 0; while (ovExprs != NULL) { if (EvaluateExpression(theEnv,ovExprs,&ovs[ovi])) goto EvaluateOverridesError; if (ovs[ovi].type != SYMBOL) { ExpectedTypeError1(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), ovi+1,"slot name"); SetEvaluationError(theEnv,TRUE); goto EvaluateOverridesError; } slotName = ovs[ovi].value; if (ovExprs->nextArg->argList) { if (EvaluateAndStoreInDataObject(theEnv,FALSE,ovExprs->nextArg->argList, &ovs[ovi],TRUE) == FALSE) goto EvaluateOverridesError; } else { SetpDOBegin(&ovs[ovi],1); SetpDOEnd(&ovs[ovi],0); SetpType(&ovs[ovi],MULTIFIELD); SetpValue(&ovs[ovi],ProceduralPrimitiveData(theEnv)->NoParamValue); } ovs[ovi].supplementalInfo = slotName; ovExprs = ovExprs->nextArg->nextArg; ovs[ovi].next = (ovExprs != NULL) ? &ovs[ovi+1] : NULL; ovi++; } return(ovs); EvaluateOverridesError: rm(theEnv,(void *) ovs,(sizeof(DATA_OBJECT) * (*ovCnt))); *error = TRUE; return(NULL); } /********************************************************** NAME : DeleteSlotOverrideEvaluations DESCRIPTION : Deallocates slot override evaluation array INPUTS : 1) The data object array 2) The number of elements RETURNS : Nothing useful SIDE EFFECTS : Deallocates slot override data object array for modify- and duplicate- instance NOTES : None **********************************************************/ static void DeleteSlotOverrideEvaluations( void *theEnv, DATA_OBJECT *ovEvals, int ovCnt) { if (ovEvals != NULL) rm(theEnv,(void *) ovEvals,(sizeof(DATA_OBJECT) * ovCnt)); } /********************************************************** NAME : ModifyMsgHandlerSupport DESCRIPTION : Support routine for DirectModifyMsgHandler and MsgModifyMsgHandler Performs a series of slot updates directly or with messages INPUTS : 1) A data object buffer to hold the result 2) A flag indicating whether to use put- messages or direct placement RETURNS : Nothing useful SIDE EFFECTS : Slots updated (messages sent) NOTES : None **********************************************************/ static void ModifyMsgHandlerSupport( void *theEnv, DATA_OBJECT *result, int msgpass) { DATA_OBJECT *slotOverrides,*newval,temp,junk; EXPRESSION msgExp; INSTANCE_TYPE *ins; INSTANCE_SLOT *insSlot; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE) { PrintErrorID(theEnv,"INSMODDP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Direct/message-modify message valid only in modify-instance.\n"); SetEvaluationError(theEnv,TRUE); return; } InstanceData(theEnv)->ObjectModDupMsgValid = FALSE; ins = GetActiveInstance(theEnv); if (ins->garbage) { StaleInstanceAddress(theEnv,"modify-instance",0); SetEvaluationError(theEnv,TRUE); return; } /* ======================================= Retrieve the slot override data objects passed from ModifyInstance - the slot name is stored in the supplementalInfo field - and the next fields are links ======================================= */ slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,1)->value; while (slotOverrides != NULL) { /* =========================================================== No evaluation or error checking needs to be done since this has already been done by EvaluateSlotOverrides() =========================================================== */ insSlot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) slotOverrides->supplementalInfo); if (insSlot == NULL) { SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo),"modify-instance"); SetEvaluationError(theEnv,TRUE); return; } if (msgpass) { msgExp.type = slotOverrides->type; if (msgExp.type != MULTIFIELD) msgExp.value = slotOverrides->value; else msgExp.value = (void *) slotOverrides; msgExp.argList = NULL; msgExp.nextArg = NULL; if (! DirectMessage(theEnv,insSlot->desc->overrideMessage,ins,&temp,&msgExp)) return; } else { if (insSlot->desc->multiple && (slotOverrides->type != MULTIFIELD)) { temp.type = MULTIFIELD; temp.value = EnvCreateMultifield(theEnv,1L); SetDOBegin(temp,1); SetDOEnd(temp,1); SetMFType(temp.value,1,(short) slotOverrides->type); SetMFValue(temp.value,1,slotOverrides->value); newval = &temp; } else newval = slotOverrides; if (PutSlotValue(theEnv,ins,insSlot,newval,&junk,"modify-instance") == FALSE) return; } slotOverrides = slotOverrides->next; } result->value = EnvTrueSymbol(theEnv); } /************************************************************* NAME : DuplicateMsgHandlerSupport DESCRIPTION : Support routine for DirectDuplicateMsgHandler and MsgDuplicateMsgHandler Performs a series of slot updates directly or with messages INPUTS : 1) A data object buffer to hold the result 2) A flag indicating whether to use put- messages or direct placement RETURNS : Nothing useful SIDE EFFECTS : Slots updated (messages sent) NOTES : None *************************************************************/ static void DuplicateMsgHandlerSupport( void *theEnv, DATA_OBJECT *result, int msgpass) { INSTANCE_TYPE *srcins,*dstins; SYMBOL_HN *newName; DATA_OBJECT *slotOverrides; EXPRESSION *valArg,msgExp; long i; int oldMkInsMsgPass; INSTANCE_SLOT *dstInsSlot; DATA_OBJECT temp,junk,*newval; intBool success; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE) { PrintErrorID(theEnv,"INSMODDP",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Direct/message-duplicate message valid only in duplicate-instance.\n"); SetEvaluationError(theEnv,TRUE); return; } InstanceData(theEnv)->ObjectModDupMsgValid = FALSE; /* ================================== Grab the slot override expressions and determine the source instance and the name of the new instance ================================== */ srcins = GetActiveInstance(theEnv); newName = (SYMBOL_HN *) GetNthMessageArgument(theEnv,1)->value; slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,2)->value; if (srcins->garbage) { StaleInstanceAddress(theEnv,"duplicate-instance",0); SetEvaluationError(theEnv,TRUE); return; } if (newName == srcins->name) { PrintErrorID(theEnv,"INSMODDP",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Instance copy must have a different name in duplicate-instance.\n"); SetEvaluationError(theEnv,TRUE); return; } /* ========================================== Create an uninitialized new instance of the new name (delete old version - if any) ========================================== */ oldMkInsMsgPass = InstanceData(theEnv)->MkInsMsgPass; InstanceData(theEnv)->MkInsMsgPass = msgpass; dstins = BuildInstance(theEnv,newName,srcins->cls,TRUE); InstanceData(theEnv)->MkInsMsgPass = oldMkInsMsgPass; if (dstins == NULL) return; dstins->busy++; /* ================================ Place slot overrides directly or with put- messages ================================ */ while (slotOverrides != NULL) { /* =========================================================== No evaluation or error checking needs to be done since this has already been done by EvaluateSlotOverrides() =========================================================== */ dstInsSlot = FindInstanceSlot(theEnv,dstins,(SYMBOL_HN *) slotOverrides->supplementalInfo); if (dstInsSlot == NULL) { SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo), "duplicate-instance"); goto DuplicateError; } if (msgpass) { msgExp.type = slotOverrides->type; if (msgExp.type != MULTIFIELD) msgExp.value = slotOverrides->value; else msgExp.value = (void *) slotOverrides; msgExp.argList = NULL; msgExp.nextArg = NULL; if (! DirectMessage(theEnv,dstInsSlot->desc->overrideMessage,dstins,&temp,&msgExp)) goto DuplicateError; } else { if (dstInsSlot->desc->multiple && (slotOverrides->type != MULTIFIELD)) { temp.type = MULTIFIELD; temp.value = EnvCreateMultifield(theEnv,1L); SetDOBegin(temp,1); SetDOEnd(temp,1); SetMFType(temp.value,1,(short) slotOverrides->type); SetMFValue(temp.value,1,slotOverrides->value); newval = &temp; } else newval = slotOverrides; if (PutSlotValue(theEnv,dstins,dstInsSlot,newval,&junk,"duplicate-instance") == FALSE) goto DuplicateError; } dstInsSlot->override = TRUE; slotOverrides = slotOverrides->next; } /* ======================================= Copy values from source instance to new directly or with put- messages ======================================= */ for (i = 0 ; i < dstins->cls->localInstanceSlotCount ; i++) { if (dstins->slots[i].override == FALSE) { if (msgpass) { temp.type = (unsigned short) srcins->slots[i].type; temp.value = srcins->slots[i].value; if (temp.type == MULTIFIELD) { SetDOBegin(temp,1); SetDOEnd(temp,GetMFLength(temp.value)); } valArg = ConvertValueToExpression(theEnv,&temp); success = DirectMessage(theEnv,dstins->slots[i].desc->overrideMessage, dstins,&temp,valArg); ReturnExpression(theEnv,valArg); if (! success) goto DuplicateError; } else { temp.type = (unsigned short) srcins->slots[i].type; temp.value = srcins->slots[i].value; if (srcins->slots[i].type == MULTIFIELD) { SetDOBegin(temp,1); SetDOEnd(temp,GetMFLength(srcins->slots[i].value)); } if (PutSlotValue(theEnv,dstins,&dstins->slots[i],&temp,&junk,"duplicate-instance") == FALSE) goto DuplicateError; } } } /* ======================================= Send init message for message-duplicate ======================================= */ if (msgpass) { for (i = 0 ; i < dstins->cls->instanceSlotCount ; i++) dstins->slotAddresses[i]->override = TRUE; dstins->initializeInProgress = 1; DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,dstins,result,NULL); } dstins->busy--; if (dstins->garbage) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); } else { result->type = INSTANCE_NAME; result->value = (void *) GetFullInstanceName(theEnv,dstins); } return; DuplicateError: dstins->busy--; QuashInstance(theEnv,dstins); SetEvaluationError(theEnv,TRUE); } #endif clips_core_source_630/core/._factbin.h0000755000175000017500000000040712373742664016244 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrccmp.h0000755000175000017500000000040712373714472016450 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltfun.h0000755000175000017500000000040712375261535016502 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrccmp.h0000755000175000017500000000040712373753411016424 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrnchk.c0000755000175000017500000000040712462771770016447 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/constrct.h0000755000175000017500000002367512461254362016263 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* CONSTRUCT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added code for capturing errors/warnings */ /* (EnvSetParserErrorCallback). */ /* */ /* Fixed issue with save function when multiple */ /* defmodules exist. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ #ifndef _H_constrct #define _H_constrct struct constructHeader; struct construct; #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #include "userdata.h" struct constructHeader { struct symbolHashNode *name; const char *ppForm; struct defmoduleItemHeader *whichModule; long bsaveID; struct constructHeader *next; struct userData *usrData; }; #define CHS (struct constructHeader *) struct construct { const char *constructName; const char *pluralName; int (*parseFunction)(void *,const char *); void *(*findFunction)(void *,const char *); struct symbolHashNode *(*getConstructNameFunction)(struct constructHeader *); const char *(*getPPFormFunction)(void *,struct constructHeader *); struct defmoduleItemHeader *(*getModuleItemFunction)(struct constructHeader *); void *(*getNextItemFunction)(void *,void *); void (*setNextItemFunction)(struct constructHeader *,struct constructHeader *); intBool (*isConstructDeletableFunction)(void *,void *); int (*deleteFunction)(void *,void *); void (*freeFunction)(void *,void *); struct construct *next; }; #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #define CONSTRUCT_DATA 42 struct constructData { int ClearReadyInProgress; int ClearInProgress; int ResetReadyInProgress; int ResetInProgress; short ClearReadyLocks; int DanglingConstructs; #if (! RUN_TIME) && (! BLOAD_ONLY) struct callFunctionItem *ListOfSaveFunctions; intBool PrintWhileLoading; unsigned WatchCompilations; int CheckSyntaxMode; int ParsingConstruct; char *ErrorString; char *WarningString; char *ParsingFileName; char *ErrorFileName; char *WarningFileName; long ErrLineNumber; long WrnLineNumber; int errorCaptureRouterCount; size_t MaxErrChars; size_t CurErrPos; size_t MaxWrnChars; size_t CurWrnPos; void (*ParserErrorCallback)(void *,const char *,const char *,const char *,long); #endif struct construct *ListOfConstructs; struct callFunctionItem *ListOfResetFunctions; struct callFunctionItem *ListOfClearFunctions; struct callFunctionItem *ListOfClearReadyFunctions; int Executing; int (*BeforeResetFunction)(void *); }; #define ConstructData(theEnv) ((struct constructData *) GetEnvironmentData(theEnv,CONSTRUCT_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _CONSTRCT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void EnvClear(void *); LOCALE void EnvReset(void *); LOCALE int EnvSave(void *,const char *); LOCALE void InitializeConstructData(void *); LOCALE intBool AddSaveFunction(void *,const char *,void (*)(void *,void *,const char *),int); LOCALE intBool RemoveSaveFunction(void *,const char *); LOCALE intBool EnvAddResetFunction(void *,const char *,void (*)(void *),int); LOCALE intBool EnvRemoveResetFunction(void *,const char *); LOCALE intBool AddClearReadyFunction(void *,const char *,int (*)(void *),int); LOCALE intBool RemoveClearReadyFunction(void *,const char *); LOCALE intBool EnvAddClearFunction(void *,const char *,void (*)(void *),int); LOCALE intBool EnvRemoveClearFunction(void *,const char *); LOCALE void EnvIncrementClearReadyLocks(void *); LOCALE void EnvDecrementClearReadyLocks(void *); LOCALE struct construct *AddConstruct(void *,const char *,const char *, int (*)(void *,const char *), void *(*)(void *,const char *), SYMBOL_HN *(*)(struct constructHeader *), const char *(*)(void *,struct constructHeader *), struct defmoduleItemHeader *(*)(struct constructHeader *), void *(*)(void *,void *), void (*)(struct constructHeader *,struct constructHeader *), intBool (*)(void *,void *), int (*)(void *,void *), void (*)(void *,void *)); LOCALE int RemoveConstruct(void *,const char *); LOCALE void SetCompilationsWatch(void *,unsigned); LOCALE unsigned GetCompilationsWatch(void *); LOCALE void SetPrintWhileLoading(void *,intBool); LOCALE intBool GetPrintWhileLoading(void *); LOCALE int ExecutingConstruct(void *); LOCALE void SetExecutingConstruct(void *,int); LOCALE void InitializeConstructs(void *); LOCALE int (*SetBeforeResetFunction(void *,int (*)(void *)))(void *); LOCALE void ResetCommand(void *); LOCALE void ClearCommand(void *); LOCALE intBool ClearReady(void *); LOCALE struct construct *FindConstruct(void *,const char *); LOCALE void DeinstallConstructHeader(void *,struct constructHeader *); LOCALE void DestroyConstructHeader(void *,struct constructHeader *); LOCALE void (*EnvSetParserErrorCallback(void *theEnv, void (*functionPtr)(void *,const char *,const char *, const char *,long))) (void *,const char *,const char *,const char*,long); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool AddClearFunction(const char *,void (*)(void),int); LOCALE intBool AddResetFunction(const char *,void (*)(void),int); LOCALE void Clear(void); LOCALE void Reset(void); LOCALE intBool RemoveClearFunction(const char *); LOCALE intBool RemoveResetFunction(const char *); #if (! RUN_TIME) && (! BLOAD_ONLY) LOCALE int Save(const char *); #endif #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_constrct */ clips_core_source_630/core/._dffctcmp.c0000755000175000017500000000040712373721213016402 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._symblcmp.c0000755000175000017500000000040712373755527016461 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._exprnops.c0000755000175000017500000000040712373740003016470 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factgen.c0000755000175000017500000014537012373742657016036 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT RETE FUNCTION GENERATION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Creates expressions used by the fact pattern */ /* matcher and the join network. The expressions created */ /* are used to extract and compare values from facts as */ /* needed by the Rete pattern matching algorithm. These */ /* expressions are also used to extract values from facts */ /* needed by expressions on the RHS of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Support for performance optimizations. */ /* */ /* Increased maximum values for pattern/slot */ /* indices. */ /* */ /*************************************************************/ #define _FACTGEN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "constant.h" #include "memalloc.h" #include "router.h" #include "scanner.h" #include "exprnpsr.h" #include "constrct.h" #include "network.h" #include "reteutil.h" #include "factmch.h" #include "factrete.h" #include "factmngr.h" #include "pattern.h" #include "factprt.h" #include "envrnmnt.h" #include "tmpltdef.h" #include "tmpltlhs.h" #include "factgen.h" #define FACTGEN_DATA 2 struct factgenData { globle struct entityRecord FactJNGV1Info; globle struct entityRecord FactJNGV2Info; globle struct entityRecord FactJNGV3Info; globle struct entityRecord FactPNGV1Info; globle struct entityRecord FactPNGV2Info; globle struct entityRecord FactPNGV3Info; globle struct entityRecord FactJNCV1Info; globle struct entityRecord FactJNCV2Info; globle struct entityRecord FactPNCV1Info; globle struct entityRecord FactStoreMFInfo; globle struct entityRecord FactSlotLengthInfo; globle struct entityRecord FactPNConstant1Info; globle struct entityRecord FactPNConstant2Info; }; #define FactgenData(theEnv) ((struct factgenData *) GetEnvironmentData(theEnv,FACTGEN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void *FactGetVarJN1(void *,struct lhsParseNode *,int); static void *FactGetVarJN2(void *,struct lhsParseNode *,int); static void *FactGetVarJN3(void *,struct lhsParseNode *,int); static void *FactGetVarPN1(void *,struct lhsParseNode *); static void *FactGetVarPN2(void *,struct lhsParseNode *); static void *FactGetVarPN3(void *,struct lhsParseNode *); #endif /*******************************************************************/ /* InitializeFactReteFunctions: Installs the fact pattern matching */ /* and value access routines as primitive operations. */ /*******************************************************************/ globle void InitializeFactReteFunctions( void *theEnv) { #if DEFRULE_CONSTRUCT struct entityRecord factJNGV1Info = { "FACT_JN_VAR1", FACT_JN_VAR1,0,1,0, PrintFactJNGetVar1, PrintFactJNGetVar1,NULL, FactJNGetVar1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNGV2Info = { "FACT_JN_VAR2", FACT_JN_VAR2,0,1,0, PrintFactJNGetVar2, PrintFactJNGetVar2,NULL, FactJNGetVar2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNGV3Info = { "FACT_JN_VAR3", FACT_JN_VAR3,0,1,0, PrintFactJNGetVar3, PrintFactJNGetVar3,NULL, FactJNGetVar3, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNGV1Info = { "FACT_PN_VAR1", FACT_PN_VAR1,0,1,0, PrintFactPNGetVar1, PrintFactPNGetVar1,NULL, FactPNGetVar1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNGV2Info = { "FACT_PN_VAR2", FACT_PN_VAR2,0,1,0, PrintFactPNGetVar2, PrintFactPNGetVar2,NULL, FactPNGetVar2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNGV3Info = { "FACT_PN_VAR3", FACT_PN_VAR3,0,1,0, PrintFactPNGetVar3, PrintFactPNGetVar3,NULL, FactPNGetVar3, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNCV1Info = { "FACT_JN_CMP1", FACT_JN_CMP1,0,1,1, PrintFactJNCompVars1, PrintFactJNCompVars1,NULL, FactJNCompVars1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNCV2Info = { "FACT_JN_CMP2", FACT_JN_CMP2,0,1,1, PrintFactJNCompVars2, PrintFactJNCompVars2,NULL, FactJNCompVars2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNCV1Info = { "FACT_PN_CMP1", FACT_PN_CMP1,0,1,1, PrintFactPNCompVars1, PrintFactPNCompVars1,NULL, FactPNCompVars1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factStoreMFInfo = { "FACT_STORE_MULTIFIELD", FACT_STORE_MULTIFIELD,0,1,0, NULL,NULL,NULL, FactStoreMultifield, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factSlotLengthInfo = { "FACT_SLOT_LENGTH", FACT_SLOT_LENGTH,0,1,0, PrintFactSlotLength, PrintFactSlotLength,NULL, FactSlotLength, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNConstant1Info = { "FACT_PN_CONSTANT1", FACT_PN_CONSTANT1,0,1,1, PrintFactPNConstant1, PrintFactPNConstant1,NULL, FactPNConstant1, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNConstant2Info = { "FACT_PN_CONSTANT2", FACT_PN_CONSTANT2,0,1,1, PrintFactPNConstant2, PrintFactPNConstant2,NULL, FactPNConstant2, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,FACTGEN_DATA,sizeof(struct factgenData),NULL); memcpy(&FactgenData(theEnv)->FactJNGV1Info,&factJNGV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNGV2Info,&factJNGV2Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNGV3Info,&factJNGV3Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNGV1Info,&factPNGV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNGV2Info,&factPNGV2Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNGV3Info,&factPNGV3Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNCV1Info,&factJNCV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNCV2Info,&factJNCV2Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNCV1Info,&factPNCV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactStoreMFInfo,&factStoreMFInfo,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactSlotLengthInfo,&factSlotLengthInfo,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNConstant1Info,&factPNConstant1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNConstant2Info,&factPNConstant2Info,sizeof(struct entityRecord)); InstallPrimitive(theEnv,(ENTITY_RECORD_PTR) &FactData(theEnv)->FactInfo,FACT_ADDRESS); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNGV1Info,FACT_JN_VAR1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNGV2Info,FACT_JN_VAR2); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNGV3Info,FACT_JN_VAR3); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNGV1Info,FACT_PN_VAR1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNGV2Info,FACT_PN_VAR2); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNGV3Info,FACT_PN_VAR3); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNCV1Info,FACT_JN_CMP1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNCV2Info,FACT_JN_CMP2); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNCV1Info,FACT_PN_CMP1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactStoreMFInfo,FACT_STORE_MULTIFIELD); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactSlotLengthInfo,FACT_SLOT_LENGTH); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNConstant1Info,FACT_PN_CONSTANT1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNConstant2Info,FACT_PN_CONSTANT2); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /******************************************************************/ /* FactGenPNConstant: Generates an expression for use in the fact */ /* pattern network that compares a field from a single field or */ /* multifield slot against a constant. */ /******************************************************************/ globle struct expr *FactGenPNConstant( void *theEnv, struct lhsParseNode *theField) { struct expr *top; unsigned short tempValue; struct factConstantPN1Call hack1; struct factConstantPN2Call hack2; /*=================================================================*/ /* If the value of a single field slot (or relation name) is being */ /* compared against a constant, then use specialized routines for */ /* doing the comparison. */ /*=================================================================*/ if (theField->withinMultifieldSlot == FALSE) { ClearBitString(&hack1,sizeof(struct factConstantPN1Call)); if (theField->negated) hack1.testForEquality = FALSE; else hack1.testForEquality = TRUE; hack1.whichSlot = (unsigned short) (theField->slotNumber - 1); top = GenConstant(theEnv,FACT_PN_CONSTANT1,EnvAddBitMap(theEnv,&hack1,sizeof(struct factConstantPN1Call))); top->argList = GenConstant(theEnv,theField->type,theField->value); return(top); } /*=================================================================*/ /* If a constant comparison is being done within a multifield slot */ /* and the constant's position has no multifields to the left, */ /* then use the same routine used for the single field slot case, */ /* but include the offset from the beginning of the slot. */ /*=================================================================*/ else if ((theField->multiFieldsBefore == 0) || ((theField->multiFieldsBefore == 1) && (theField->multiFieldsAfter == 0))) { ClearBitString(&hack2,sizeof(struct factConstantPN2Call)); if (theField->negated) hack2.testForEquality = FALSE; else hack2.testForEquality = TRUE; hack2.whichSlot = (unsigned short) (theField->slotNumber - 1); if (theField->multiFieldsBefore == 0) { hack2.fromBeginning = TRUE; hack2.offset = theField->singleFieldsBefore; } else { hack2.fromBeginning = FALSE; hack2.offset = theField->singleFieldsAfter; } top = GenConstant(theEnv,FACT_PN_CONSTANT2,EnvAddBitMap(theEnv,&hack2,sizeof(struct factConstantPN2Call))); top->argList = GenConstant(theEnv,theField->type,theField->value); return(top); } /*===============================================================*/ /* Otherwise, use the equality or inequality function to compare */ /* the constant against the value returned by the appropriate */ /* pattern network variable retrieval function call. */ /*===============================================================*/ else { if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } tempValue = theField->type; theField->type = SF_VARIABLE; top->argList = FactGenGetfield(theEnv,theField); theField->type = tempValue; top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value); } /*===============================================================*/ /* Return the expression for performing the constant comparison. */ /*===============================================================*/ return(top); } /*******************************************************/ /* FactGenGetfield: Generates an expression for use in */ /* the fact pattern network that retrieves a value */ /* from a single or multifield slot. */ /*******************************************************/ globle struct expr *FactGenGetfield( void *theEnv, struct lhsParseNode *theNode) { /*===================================================*/ /* Generate call to retrieve single field slot value */ /* or the fact relation name. */ /*===================================================*/ if ((theNode->slotNumber > 0) && (theNode->withinMultifieldSlot == FALSE)) { return(GenConstant(theEnv,FACT_PN_VAR2,FactGetVarPN2(theEnv,theNode))); } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE) || ConstantType(theNode->type)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { return(GenConstant(theEnv,FACT_PN_VAR3,FactGetVarPN3(theEnv,theNode))); } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { return(GenConstant(theEnv,FACT_PN_VAR3,FactGetVarPN3(theEnv,theNode))); } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ return(GenConstant(theEnv,FACT_PN_VAR1,FactGetVarPN1(theEnv,theNode))); } /**************************************************/ /* FactGenGetvar: Generates an expression for use */ /* in the join network that retrieves a value */ /* from a single or multifield slot of a fact. */ /**************************************************/ globle struct expr *FactGenGetvar( void *theEnv, struct lhsParseNode *theNode, int side) { /*====================================================*/ /* Generate call to retrieve single field slot value. */ /*====================================================*/ if ((theNode->slotNumber > 0) && (theNode->withinMultifieldSlot == FALSE)) { return(GenConstant(theEnv,FACT_JN_VAR2,FactGetVarJN2(theEnv,theNode,side))); } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { return(GenConstant(theEnv,FACT_JN_VAR3,FactGetVarJN3(theEnv,theNode,side))); } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { return(GenConstant(theEnv,FACT_JN_VAR3,FactGetVarJN3(theEnv,theNode,side))); } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ return(GenConstant(theEnv,FACT_JN_VAR1,FactGetVarJN1(theEnv,theNode,side))); } /**************************************************************/ /* FactGenCheckLength: Generates an expression for use in the */ /* fact pattern network that determines if the value of a */ /* multifield slot contains enough fields to satisfy the */ /* number of pattern matching constaints. For example, the */ /* slot constraints (foo ?x a $? ?y) couldn't be matched */ /* unless the foo slot contained at least 3 fields. */ /**************************************************************/ globle struct expr *FactGenCheckLength( void *theEnv, struct lhsParseNode *theNode) { struct factCheckLengthPNCall hack; /*===================================================*/ /* If the slot contains no single field constraints, */ /* then a length test is not necessary. */ /*===================================================*/ if ((theNode->singleFieldsAfter == 0) && (theNode->type != SF_VARIABLE) && (theNode->type != SF_WILDCARD)) { return(NULL); } /*=======================================*/ /* Initialize the length test arguments. */ /*=======================================*/ ClearBitString(&hack,sizeof(struct factCheckLengthPNCall)); hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); /*============================================*/ /* If the slot has no multifield constraints, */ /* then the length must match exactly. */ /*============================================*/ if ((theNode->type != MF_VARIABLE) && (theNode->type != MF_WILDCARD) && (theNode->multiFieldsAfter == 0)) { hack.exactly = 1; } else { hack.exactly = 0; } /*============================================*/ /* The minimum length is the number of single */ /* field constraints contained in the slot. */ /*============================================*/ if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD)) { hack.minLength = (unsigned short) (1 + theNode->singleFieldsAfter); } else { hack.minLength = theNode->singleFieldsAfter; } /*========================================================*/ /* Generate call to test the length of a multifield slot. */ /*========================================================*/ return(GenConstant(theEnv,FACT_SLOT_LENGTH,EnvAddBitMap(theEnv,&hack,sizeof(struct factCheckLengthPNCall)))); } /**************************************************************/ /* FactGenCheckZeroLength: Generates an expression for use in */ /* the fact pattern network that determines if the value of */ /* a multifield slot is a zero length multifield value. */ /**************************************************************/ globle struct expr *FactGenCheckZeroLength( void *theEnv, unsigned theSlot) { struct factCheckLengthPNCall hack; ClearBitString(&hack,sizeof(struct factCheckLengthPNCall)); hack.whichSlot = (unsigned short) (theSlot - 1); hack.exactly = 1; hack.minLength = 0; return(GenConstant(theEnv,FACT_SLOT_LENGTH,EnvAddBitMap(theEnv,&hack,sizeof(struct factCheckLengthPNCall)))); } /*********************************************************************/ /* FactReplaceGetvar: Replaces a variable reference in an expression */ /* with a function call to retrieve the variable using the join */ /* network variable access functions for facts. */ /*********************************************************************/ globle void FactReplaceGetvar( void *theEnv, struct expr *theItem, struct lhsParseNode *theNode, int side) { /*====================================================*/ /* Generate call to retrieve single field slot value. */ /*====================================================*/ if ((theNode->slotNumber > 0) && (theNode->withinMultifieldSlot == FALSE)) { theItem->type = FACT_JN_VAR2; theItem->value = FactGetVarJN2(theEnv,theNode,side); return; } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { theItem->type = FACT_JN_VAR3; theItem->value = FactGetVarJN3(theEnv,theNode,side); return; } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { theItem->type = FACT_JN_VAR3; theItem->value = FactGetVarJN3(theEnv,theNode,side); return; } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ theItem->type = FACT_JN_VAR1; theItem->value = FactGetVarJN1(theEnv,theNode,side); } /***********************************************************************/ /* FactReplaceGetfield: Replaces a variable reference in an expression */ /* with a function call to retrieve the variable using the pattern */ /* network variable access functions for facts. */ /***********************************************************************/ globle void FactReplaceGetfield( void *theEnv, struct expr *theItem, struct lhsParseNode *theNode) { /*====================================================*/ /* Generate call to retrieve single field slot value. */ /*====================================================*/ if (theNode->withinMultifieldSlot == FALSE) { theItem->type = FACT_PN_VAR2; theItem->value = FactGetVarPN2(theEnv,theNode); return; } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { theItem->type = FACT_PN_VAR3; theItem->value = FactGetVarPN3(theEnv,theNode); return; } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { theItem->type = FACT_PN_VAR3; theItem->value = FactGetVarPN3(theEnv,theNode); return; } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ theItem->type = FACT_PN_VAR1; theItem->value = FactGetVarPN1(theEnv,theNode); } /*************************************************************/ /* FactGetVarJN1: Creates the arguments for the most general */ /* routine for retrieving a variable's value from the slot */ /* of a fact. The retrieval relies on information stored */ /* in a partial match, so this retrieval mechanism is used */ /* by expressions in the join network or from the RHS of a */ /* rule. */ /*************************************************************/ static void *FactGetVarJN1( void *theEnv, struct lhsParseNode *theNode, int side) { struct factGetVarJN1Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarJN1Call)); /*=========================================*/ /* Store the position in the partial match */ /* from which the fact will be retrieved. */ /*=========================================*/ if (side == LHS) { hack.lhs = 1; hack.whichPattern = (unsigned short) theNode->joinDepth; } else if (side == RHS) { hack.rhs = 1; hack.whichPattern = (unsigned short) 0; } else if (side == NESTED_RHS) { hack.rhs = 1; hack.whichPattern = (unsigned short) theNode->joinDepth; } else { hack.whichPattern = (unsigned short) theNode->joinDepth; } /*========================================*/ /* A slot value of zero indicates that we */ /* want the pattern address returned. */ /*========================================*/ if (theNode->slotNumber <= 0) { hack.factAddress = 1; hack.allFields = 0; hack.whichSlot = 0; hack.whichField = 0; } /*=====================================================*/ /* A slot value greater than zero and a field value of */ /* zero indicate that we want the entire contents of */ /* the slot whether it is a single field or multifield */ /* slot. */ /*=====================================================*/ else if (theNode->index <= 0) { hack.factAddress = 0; hack.allFields = 1; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = 0; } /*=====================================================*/ /* A slot value, m, and a field value, n, both greater */ /* than zero indicate that we want the nth field of */ /* the mth slot. */ /*=====================================================*/ else { hack.factAddress = 0; hack.allFields = 0; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = (unsigned short) (theNode->index - 1); } /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarJN1Call))); } /**************************************************************/ /* FactGetVarJN2: Creates the arguments for the routine which */ /* retrieves a variable's value from a single field slot of */ /* a fact. The retrieval relies on information stored in a */ /* partial match, so this retrieval mechanism is used by */ /* expressions in the join network or from the RHS of a */ /* rule. */ /**************************************************************/ static void *FactGetVarJN2( void *theEnv, struct lhsParseNode *theNode, int side) { struct factGetVarJN2Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarJN2Call)); /*=====================================================*/ /* Store the position in the partial match from which */ /* the fact will be retrieved and the slot in the fact */ /* from which the value will be retrieved. */ /*=====================================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); if (side == LHS) { hack.lhs = 1; hack.whichPattern = (unsigned short) theNode->joinDepth; } else if (side == RHS) { hack.rhs = 1; hack.whichPattern = (unsigned short) 0; } else if (side == NESTED_RHS) { hack.rhs = 1; hack.whichPattern = (unsigned short) theNode->joinDepth; } else { hack.whichPattern = (unsigned short) theNode->joinDepth; } /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarJN2Call))); } /*************************************************************/ /* FactGetVarJN3: Creates the arguments for the routine for */ /* retrieving a variable's value from a multifield slot of */ /* a fact. For this routine, the variable's value must be */ /* from a multifield slot that contains at most one */ /* multifield variable or contains no multifield variables */ /* before the variable's value to be retrieved. The */ /* retrieval relies on information stored in a partial */ /* match, so this retrieval mechanism is used by */ /* expressions in the join network or from the RHS of a */ /* rule. */ /*************************************************************/ static void *FactGetVarJN3( void *theEnv, struct lhsParseNode *theNode, int side) { struct factGetVarJN3Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarJN3Call)); /*=====================================================*/ /* Store the position in the partial match from which */ /* the fact will be retrieved and the slot in the fact */ /* from which the value will be retrieved. */ /*=====================================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); if (side == LHS) { hack.lhs = 1; hack.whichPattern = (unsigned short) theNode->joinDepth; } else if (side == RHS) { hack.rhs = 1; hack.whichPattern = (unsigned short) 0; } else if (side == NESTED_RHS) { hack.rhs = 1; hack.whichPattern = (unsigned short) theNode->joinDepth; } else { hack.whichPattern = (unsigned short) theNode->joinDepth; } /*==============================================================*/ /* If a single field variable value is being retrieved, then... */ /*==============================================================*/ if ((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) { /*=========================================================*/ /* If no multifield values occur before the variable, then */ /* the variable's value can be retrieved based on its */ /* offset from the beginning of the slot's value */ /* regardless of the number of multifield variables or */ /* wildcards following the variable being retrieved. */ /*=========================================================*/ if (theNode->multiFieldsBefore == 0) { hack.fromBeginning = 1; hack.fromEnd = 0; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = 0; } /*===============================================*/ /* Otherwise the variable is retrieved based its */ /* position relative to the end of the slot. */ /*===============================================*/ else { hack.fromBeginning = 0; hack.fromEnd = 1; hack.beginOffset = 0; hack.endOffset = theNode->singleFieldsAfter; } /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarJN3Call))); } /*============================================================*/ /* A multifield variable value is being retrieved. This means */ /* that there are no other multifield variables or wildcards */ /* in the slot. The multifield value is retrieved by storing */ /* the number of single field values which come before and */ /* after the multifield value. The multifield value can then */ /* be retrieved based on the length of the value in the slot */ /* and the number of single field values which must occur */ /* before and after the multifield value. */ /*============================================================*/ hack.fromBeginning = 1; hack.fromEnd = 1; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = theNode->singleFieldsAfter; /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarJN3Call))); } /**************************************************************/ /* FactGetVarPN1: Creates the arguments for the most general */ /* routine for retrieving a variable's value from the slot */ /* of a fact. The retrieval relies on information stored */ /* during fact pattern matching, so this retrieval */ /* mechanism is only used by expressions in the pattern */ /* network. */ /**************************************************************/ static void *FactGetVarPN1( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarPN1Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarPN1Call)); /*========================================*/ /* A slot value of zero indicates that we */ /* want the pattern address returned. */ /*========================================*/ if (theNode->slotNumber <= 0) { hack.factAddress = 1; hack.allFields = 0; hack.whichSlot = 0; hack.whichField = 0; } /*=====================================================*/ /* A slot value greater than zero and a field value of */ /* zero indicate that we want the entire contents of */ /* the slot whether it is a single field or multifield */ /* slot. */ /*=====================================================*/ else if (theNode->index <= 0) { hack.factAddress = 0; hack.allFields = 1; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = 0; } /*=============================================*/ /* A slot value, m, and a field value, n, both */ /* greater than zero indicate that we want the */ /* nth field of the mth slot. */ /*=============================================*/ else { hack.factAddress = 0; hack.allFields = 0; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = (unsigned short) (theNode->index - 1); } /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarPN1Call))); } /***************************************************************/ /* FactGetVarPN2: Creates the arguments for the routine which */ /* retrieves a variable's value from a single field slot of */ /* a fact. The retrieval relies on information stored during */ /* fact pattern matching, so this retrieval mechanism is */ /* only used by expressions in the pattern network. */ /***************************************************************/ static void *FactGetVarPN2( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarPN2Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarPN2Call)); /*=======================================*/ /* Store the slot in the fact from which */ /* the value will be retrieved. */ /*=======================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarPN2Call))); } /*************************************************************/ /* FactGetVarPN3: Creates the arguments for the routine for */ /* retrieving a variable's value from a multifield slot of */ /* a fact. For this routine, the variable's value must be */ /* from a multifield slot that contains at most one */ /* multifield variable or contains no multifield variables */ /* before the variable's value to be retrieved. The */ /* retrieval relies on information stored during fact */ /* pattern matching, so this retrieval mechanism is only */ /* used by expressions in the pattern network. */ /*************************************************************/ static void *FactGetVarPN3( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarPN3Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarPN3Call)); /*=======================================*/ /* Store the slot in the fact from which */ /* the value will be retrieved. */ /*=======================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); /*==============================================================*/ /* If a single field variable value is being retrieved, then... */ /*==============================================================*/ if ((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE) || ConstantType(theNode->type)) { /*=========================================================*/ /* If no multifield values occur before the variable, then */ /* the variable's value can be retrieved based on its */ /* offset from the beginning of the slot's value */ /* regardless of the number of multifield variables or */ /* wildcards following the variable being retrieved. */ /*=========================================================*/ if (theNode->multiFieldsBefore == 0) { hack.fromBeginning = 1; hack.fromEnd = 0; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = 0; } /*===============================================*/ /* Otherwise the variable is retrieved based its */ /* position relative to the end of the slot. */ /*===============================================*/ else { hack.fromBeginning = 0; hack.fromEnd = 1; hack.beginOffset = 0; hack.endOffset = theNode->singleFieldsAfter; } return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarPN3Call))); } /*============================================================*/ /* A multifield variable value is being retrieved. This means */ /* that there are no other multifield variables or wildcards */ /* in the slot. The multifield value is retrieved by storing */ /* the number of single field values which come before and */ /* after the multifield value. The multifield value can then */ /* be retrieved based on the length of the value in the slot */ /* and the number of single field values which must occur */ /* before and after the multifield value. */ /*============================================================*/ hack.fromBeginning = 1; hack.fromEnd = 1; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = theNode->singleFieldsAfter; /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(EnvAddBitMap(theEnv,&hack,sizeof(struct factGetVarPN3Call))); } /*************************************************************/ /* FactPNVariableComparison: Generates an expression for use */ /* in the fact pattern network to compare two variables of */ /* the same name found in the same pattern. */ /*************************************************************/ globle struct expr *FactPNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { struct expr *top; struct factCompVarsPN1Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factCompVarsPN1Call)); /*================================================================*/ /* If two single field slots of a deftemplate are being compared, */ /* then use the following specified variable comparison routine. */ /*================================================================*/ if ((selfNode->withinMultifieldSlot == FALSE) && (selfNode->slotNumber > 0) && (referringNode->withinMultifieldSlot == FALSE) && (referringNode->slotNumber > 0)) { hack.pass = 0; hack.fail = 0; hack.field1 = (unsigned short) (selfNode->slotNumber - 1); hack.field2 = (unsigned short) (referringNode->slotNumber - 1); if (selfNode->negated) hack.fail = 1; else hack.pass = 1; top = GenConstant(theEnv,FACT_PN_CMP1,EnvAddBitMap(theEnv,&hack,sizeof(struct factCompVarsPN1Call))); } /*================================================================*/ /* Otherwise, use the eq function to compare the values retrieved */ /* by the appropriate get variable value functions. */ /*================================================================*/ else { if (selfNode->negated) top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); else top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); top->argList = FactGenGetfield(theEnv,selfNode); top->argList->nextArg = FactGenGetfield(theEnv,referringNode); } /*======================================*/ /* Return the expression for performing */ /* the variable comparison. */ /*======================================*/ return(top); } /*********************************************************/ /* FactJNVariableComparison: Generates an expression for */ /* use in the join network to compare two variables of */ /* the same name found in different patterns. */ /*********************************************************/ globle struct expr *FactJNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode, int nandJoin) { struct expr *top; struct factCompVarsJN1Call hack1; struct factCompVarsJN2Call hack2; struct lhsParseNode *firstNode; /*================================================================*/ /* If two single field slots of a deftemplate are being compared, */ /* then use the following specified variable comparison routine. */ /*================================================================*/ if ((selfNode->withinMultifieldSlot == FALSE) && (selfNode->slotNumber > 0) && (referringNode->withinMultifieldSlot == FALSE) && (referringNode->slotNumber > 0)) { ClearBitString(&hack1,sizeof(struct factCompVarsJN1Call)); hack1.pass = 0; hack1.fail = 0; if (nandJoin) { firstNode = referringNode; } else { firstNode = selfNode; } hack1.slot1 = (unsigned short) (firstNode->slotNumber - 1); if (nandJoin) { hack1.pattern1 = (unsigned short) referringNode->joinDepth; } else { hack1.pattern1 = 0; } hack1.p1rhs = TRUE; hack1.p2lhs = TRUE; hack1.pattern2 = (unsigned short) referringNode->joinDepth; if (referringNode->index < 0) hack1.slot2 = 0; else hack1.slot2 = (unsigned short) (referringNode->slotNumber - 1); if (selfNode->negated) hack1.fail = 1; else hack1.pass = 1; top = GenConstant(theEnv,FACT_JN_CMP1,EnvAddBitMap(theEnv,&hack1,sizeof(struct factCompVarsJN1Call))); } /*===============================================================*/ /* If two single field values are compared and either or both of */ /* them are contained in multifield slots (and the value can be */ /* accessed relative to either the beginning or end of the slot */ /* with no intervening multifield variables), then use the */ /* following specified variable comparison routine. */ /*===============================================================*/ else if ((selfNode->slotNumber > 0) && (selfNode->type == SF_VARIABLE) && ((selfNode->multiFieldsBefore == 0) || ((selfNode->multiFieldsBefore == 1) && (selfNode->multiFieldsAfter == 0))) && (referringNode->slotNumber > 0) && (referringNode->type == SF_VARIABLE) && ((referringNode->multiFieldsBefore == 0) || (referringNode->multiFieldsAfter == 0))) { ClearBitString(&hack2,sizeof(struct factCompVarsJN2Call)); hack2.pass = 0; hack2.fail = 0; if (nandJoin) { firstNode = referringNode; } else { firstNode = selfNode; } hack2.slot1 = (unsigned short) (firstNode->slotNumber - 1); if (nandJoin) { hack2.pattern1 = (unsigned short) referringNode->joinDepth; } else { hack2.pattern1 = 0; } hack2.p1rhs = TRUE; hack2.p2lhs = TRUE; hack2.pattern2 = (unsigned short) referringNode->joinDepth; hack2.slot2 = (unsigned short) (referringNode->slotNumber - 1); if (firstNode->multiFieldsBefore == 0) { hack2.fromBeginning1 = 1; hack2.offset1 = firstNode->singleFieldsBefore; } else { hack2.fromBeginning1 = 0; hack2.offset1 = firstNode->singleFieldsAfter; } if (referringNode->multiFieldsBefore == 0) { hack2.fromBeginning2 = 1; hack2.offset2 = referringNode->singleFieldsBefore; } else { hack2.fromBeginning2 = 0; hack2.offset2 = referringNode->singleFieldsAfter; } if (selfNode->negated) hack2.fail = 1; else hack2.pass = 1; top = GenConstant(theEnv,FACT_JN_CMP2,EnvAddBitMap(theEnv,&hack2,sizeof(struct factCompVarsJN2Call))); } /*===============================================================*/ /* Otherwise, use the equality or inequality function to compare */ /* the values returned by the appropriate join network variable */ /* retrieval function call. */ /*===============================================================*/ else { if (selfNode->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } if (nandJoin) { top->argList = FactGenGetvar(theEnv,selfNode,NESTED_RHS); } else { top->argList = FactGenGetvar(theEnv,selfNode,RHS); } top->argList->nextArg = FactGenGetvar(theEnv,referringNode,LHS); } /*======================================*/ /* Return the expression for performing */ /* the variable comparison. */ /*======================================*/ return(top); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips_core_source_630/core/engine.c0000755000175000017500000015050312464554105015654 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* ENGINE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality primarily associated with */ /* the run and focus commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Bebe Ly */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* and LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added access functions to the HaltRules flag. */ /* */ /* Added EnvGetNextFocus, EnvGetFocusChanged, and */ /* EnvSetFocusChanged functions. */ /* */ /* 6.30: Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Removed pseudo-facts used in not CEs. */ /* */ /* Added context information for run functions. */ /* */ /* Added before rule firing callback function. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Changed integer type/precision. */ /* */ /* Added EnvHalt function. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _ENGINE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "agenda.h" #include "argacces.h" #include "constant.h" #include "envrnmnt.h" #include "factmngr.h" #include "inscom.h" #include "memalloc.h" #include "modulutl.h" #include "prccode.h" #include "prcdrfun.h" #include "proflfun.h" #include "reteutil.h" #include "retract.h" #include "router.h" #include "ruledlt.h" #include "sysdep.h" #include "utility.h" #include "watch.h" #include "engine.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct defmodule *RemoveFocus(void *,struct defmodule *); static void DeallocateEngineData(void *); /*****************************************************************************/ /* InitializeEngine: Initializes the activations and statistics watch items. */ /*****************************************************************************/ globle void InitializeEngine( void *theEnv) { AllocateEnvironmentData(theEnv,ENGINE_DATA,sizeof(struct engineData),DeallocateEngineData); EngineData(theEnv)->IncrementalResetFlag = TRUE; #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"statistics",0,&EngineData(theEnv)->WatchStatistics,20,NULL,NULL); AddWatchItem(theEnv,"focus",0,&EngineData(theEnv)->WatchFocus,0,NULL,NULL); #endif } /*************************************************/ /* DeallocateEngineData: Deallocates environment */ /* data for engine functionality. */ /*************************************************/ static void DeallocateEngineData( void *theEnv) { struct focus *tmpPtr, *nextPtr; DeallocateCallList(theEnv,EngineData(theEnv)->ListOfRunFunctions); DeallocateCallListWithArg(theEnv,EngineData(theEnv)->ListOfBeforeRunFunctions); tmpPtr = EngineData(theEnv)->CurrentFocus; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,focus,tmpPtr); tmpPtr = nextPtr; } } /*************************************************/ /* EnvRun: C access routine for the run command. */ /*************************************************/ globle long long EnvRun( void *theEnv, long long runLimit) { long long rulesFired = 0; DATA_OBJECT result; struct callFunctionItemWithArg *theBeforeRunFunction; struct callFunctionItem *theRunFunction; #if DEBUGGING_FUNCTIONS unsigned long maxActivations = 0, sumActivations = 0; #if DEFTEMPLATE_CONSTRUCT unsigned long maxFacts = 0, sumFacts = 0; #endif #if OBJECT_SYSTEM unsigned long maxInstances = 0, sumInstances = 0; #endif double endTime, startTime = 0.0; unsigned long tempValue; #endif unsigned short i; struct patternEntity *theMatchingItem; struct partialMatch *theBasis; ACTIVATION *theActivation; const char *ruleFiring; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif struct trackedMemory *theTM; struct garbageFrame newGarbageFrame, *oldGarbageFrame; /*=====================================================*/ /* Make sure the run command is not already executing. */ /*=====================================================*/ if (EngineData(theEnv)->AlreadyRunning) return(0); EngineData(theEnv)->AlreadyRunning = TRUE; /*========================================*/ /* Set up the frame for tracking garbage. */ /*========================================*/ oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; /*================================*/ /* Set up statistics information. */ /*================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchStatistics) { #if DEFTEMPLATE_CONSTRUCT maxFacts = GetNumberOfFacts(theEnv); sumFacts = maxFacts; #endif #if OBJECT_SYSTEM maxInstances = GetGlobalNumberOfInstances(theEnv); sumInstances = maxInstances; #endif maxActivations = GetNumberOfActivations(theEnv); sumActivations = maxActivations; startTime = gentime(); } #endif /*=============================*/ /* Set up execution variables. */ /*=============================*/ if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE); EngineData(theEnv)->HaltRules = FALSE; #if DEVELOPER EngineData(theEnv)->leftToRightComparisons = 0; EngineData(theEnv)->rightToLeftComparisons = 0; EngineData(theEnv)->leftToRightSucceeds = 0; EngineData(theEnv)->rightToLeftSucceeds = 0; EngineData(theEnv)->leftToRightLoops = 0; EngineData(theEnv)->rightToLeftLoops = 0; EngineData(theEnv)->findNextConflictingComparisons = 0; EngineData(theEnv)->betaHashListSkips = 0; EngineData(theEnv)->betaHashHTSkips = 0; EngineData(theEnv)->unneededMarkerCompare = 0; #endif /*=====================================================*/ /* Fire rules until the agenda is empty, the run limit */ /* has been reached, or a rule execution error occurs. */ /*=====================================================*/ theActivation = NextActivationToFire(theEnv); while ((theActivation != NULL) && (runLimit != 0) && (EvaluationData(theEnv)->HaltExecution == FALSE) && (EngineData(theEnv)->HaltRules == FALSE)) { /*========================================*/ /* Execute the list of functions that are */ /* to be called before each rule firing. */ /*========================================*/ for (theBeforeRunFunction = EngineData(theEnv)->ListOfBeforeRunFunctions; theBeforeRunFunction != NULL; theBeforeRunFunction = theBeforeRunFunction->next) { SetEnvironmentCallbackContext(theEnv,theBeforeRunFunction->context); if (theBeforeRunFunction->environmentAware) { (*theBeforeRunFunction->func)(theEnv,theActivation); } else { ((void (*)(void *))(*theBeforeRunFunction->func))(theActivation); } } /*===========================================*/ /* Detach the activation from the agenda and */ /* determine which rule is firing. */ /*===========================================*/ DetachActivation(theEnv,theActivation); theTM = AddTrackedMemory(theEnv,theActivation,sizeof(struct activation)); ruleFiring = EnvGetActivationName(theEnv,theActivation); theBasis = (struct partialMatch *) EnvGetActivationBasis(theEnv,theActivation); EngineData(theEnv)->ExecutingRule = (struct defrule *) EnvGetActivationRule(theEnv,theActivation); /*=============================================*/ /* Update the number of rules that have fired. */ /*=============================================*/ rulesFired++; if (runLimit > 0) { runLimit--; } /*==================================*/ /* If rules are being watched, then */ /* print an information message. */ /*==================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->ExecutingRule->watchFiring) { char printSpace[60]; gensprintf(printSpace,"FIRE %4lld ",rulesFired); EnvPrintRouter(theEnv,WTRACE,printSpace); EnvPrintRouter(theEnv,WTRACE,ruleFiring); EnvPrintRouter(theEnv,WTRACE,": "); PrintPartialMatch(theEnv,WTRACE,theBasis); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=================================================*/ /* Remove the link between the activation and the */ /* completed match for the rule. Set the busy flag */ /* for the completed match to TRUE (so the match */ /* upon which our RHS variables are dependent is */ /* not deleted while our rule is firing). Set up */ /* the global pointers to the completed match for */ /* routines which do variable extractions. */ /*=================================================*/ theBasis->marker = NULL; theBasis->busy = TRUE; EngineData(theEnv)->GlobalLHSBinds = theBasis; EngineData(theEnv)->GlobalRHSBinds = NULL; /*===================================================================*/ /* Increment the count for each of the facts/objects associated with */ /* the rule activation so that the facts/objects cannot be deleted */ /* by garbage collection while the rule is executing. */ /*===================================================================*/ for (i = 0; i < theBasis->bcount; i++) { if (theBasis->binds[i].gm.theMatch == NULL) continue; theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem; if (theMatchingItem != NULL) { (*theMatchingItem->theInfo->incrementBasisCount)(theEnv,theMatchingItem); } } /*====================================================*/ /* If the rule has logical CEs, set up the pointer to */ /* the rules logical join so the assert command will */ /* attach the appropriate dependencies to the facts. */ /*====================================================*/ EngineData(theEnv)->TheLogicalJoin = EngineData(theEnv)->ExecutingRule->logicalJoin; if (EngineData(theEnv)->TheLogicalJoin != NULL) { EngineData(theEnv)->TheLogicalBind = FindLogicalBind(EngineData(theEnv)->TheLogicalJoin,EngineData(theEnv)->GlobalLHSBinds); EngineData(theEnv)->TheLogicalBind->busy = TRUE; } else { EngineData(theEnv)->TheLogicalBind = NULL; } /*=============================================*/ /* Execute the rule's right hand side actions. */ /*=============================================*/ EvaluationData(theEnv)->CurrentEvaluationDepth++; SetEvaluationError(theEnv,FALSE); EngineData(theEnv)->ExecutingRule->executing = TRUE; #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &EngineData(theEnv)->ExecutingRule->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule, EngineData(theEnv)->ExecutingRule->actions,EngineData(theEnv)->ExecutingRule->localVarCnt, &result,NULL); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif EngineData(theEnv)->ExecutingRule->executing = FALSE; SetEvaluationError(theEnv,FALSE); EvaluationData(theEnv)->CurrentEvaluationDepth--; /*=====================================*/ /* Remove information for logical CEs. */ /*=====================================*/ EngineData(theEnv)->TheLogicalJoin = NULL; if (EngineData(theEnv)->TheLogicalBind != NULL) { EngineData(theEnv)->TheLogicalBind->busy = FALSE; EngineData(theEnv)->TheLogicalBind = NULL; } /*=====================================================*/ /* If rule execution was halted, then print a message. */ /*=====================================================*/ #if DEBUGGING_FUNCTIONS if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules && EngineData(theEnv)->ExecutingRule->watchFiring)) #else if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules)) #endif { PrintErrorID(theEnv,"PRCCODE",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of defrule "); EnvPrintRouter(theEnv,WERROR,ruleFiring); EnvPrintRouter(theEnv,WERROR,".\n"); } /*===================================================*/ /* Decrement the count for each of the facts/objects */ /* associated with the rule activation. */ /*===================================================*/ theBasis->busy = FALSE; for (i = 0; i < (theBasis->bcount); i++) { if (theBasis->binds[i].gm.theMatch == NULL) continue; theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem; if (theMatchingItem != NULL) { (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); } } /*========================================*/ /* Return the agenda node to free memory. */ /*========================================*/ RemoveTrackedMemory(theEnv,theTM); RemoveActivation(theEnv,theActivation,FALSE,FALSE); /*======================================*/ /* Get rid of partial matches discarded */ /* while executing the rule's RHS. */ /*======================================*/ FlushGarbagePartialMatches(theEnv); /*==================================*/ /* Get rid of other garbage created */ /* while executing the rule's RHS. */ /*==================================*/ CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); /*==========================*/ /* Keep up with statistics. */ /*==========================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchStatistics) { #if DEFTEMPLATE_CONSTRUCT tempValue = GetNumberOfFacts(theEnv); if (tempValue > maxFacts) maxFacts = tempValue; sumFacts += tempValue; #endif #if OBJECT_SYSTEM tempValue = GetGlobalNumberOfInstances(theEnv); if (tempValue > maxInstances) maxInstances = tempValue; sumInstances += tempValue; #endif tempValue = GetNumberOfActivations(theEnv); if (tempValue > maxActivations) maxActivations = tempValue; sumActivations += tempValue; } #endif /*==================================*/ /* Update saliences if appropriate. */ /*==================================*/ if (EnvGetSalienceEvaluation(theEnv) == EVERY_CYCLE) EnvRefreshAgenda(theEnv,NULL); /*========================================*/ /* Execute the list of functions that are */ /* to be called after each rule firing. */ /*========================================*/ for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions; theRunFunction != NULL; theRunFunction = theRunFunction->next) { SetEnvironmentCallbackContext(theEnv,theRunFunction->context); if (theRunFunction->environmentAware) { (*theRunFunction->func)(theEnv); } else { ((void (*)(void))(*theRunFunction->func))(); } } /*========================================*/ /* If a return was issued on the RHS of a */ /* rule, then remove *that* rule's module */ /* from the focus stack */ /*========================================*/ if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { RemoveFocus(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule); } ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; /*========================================*/ /* Determine the next activation to fire. */ /*========================================*/ theActivation = (struct activation *) NextActivationToFire(theEnv); /*==============================*/ /* Check for a rule breakpoint. */ /*==============================*/ if (theActivation != NULL) { if (((struct defrule *) EnvGetActivationRule(theEnv,theActivation))->afterBreakpoint) { EngineData(theEnv)->HaltRules = TRUE; EnvPrintRouter(theEnv,WDIALOG,"Breaking on rule "); EnvPrintRouter(theEnv,WDIALOG,EnvGetActivationName(theEnv,theActivation)); EnvPrintRouter(theEnv,WDIALOG,".\n"); } } } /*=====================================================*/ /* Make sure run functions are executed at least once. */ /*=====================================================*/ if (rulesFired == 0) { for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions; theRunFunction != NULL; theRunFunction = theRunFunction->next) { if (theRunFunction->environmentAware) { (*theRunFunction->func)(theEnv); } else { ((void (*)(void))(*theRunFunction->func))(); } } } /*======================================================*/ /* If rule execution was halted because the rule firing */ /* limit was reached, then print a message. */ /*======================================================*/ if (runLimit == rulesFired) { EnvPrintRouter(theEnv,WDIALOG,"rule firing limit reached\n"); } /*==============================*/ /* Restore execution variables. */ /*==============================*/ EngineData(theEnv)->ExecutingRule = NULL; EngineData(theEnv)->HaltRules = FALSE; /*=================================================*/ /* Print out statistics if they are being watched. */ /*=================================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchStatistics) { char printSpace[60]; endTime = gentime(); PrintLongInteger(theEnv,WDIALOG,rulesFired); EnvPrintRouter(theEnv,WDIALOG," rules fired"); #if (! GENERIC) if (startTime != endTime) { EnvPrintRouter(theEnv,WDIALOG," Run time is "); PrintFloat(theEnv,WDIALOG,endTime - startTime); EnvPrintRouter(theEnv,WDIALOG," seconds.\n"); PrintFloat(theEnv,WDIALOG,(double) rulesFired / (endTime - startTime)); EnvPrintRouter(theEnv,WDIALOG," rules per second.\n"); } else { EnvPrintRouter(theEnv,WDIALOG,"\n"); } #else EnvPrintRouter(theEnv,WDIALOG,"\n"); #endif #if DEFTEMPLATE_CONSTRUCT gensprintf(printSpace,"%ld mean number of facts (%ld maximum).\n", (long) (((double) sumFacts / (rulesFired + 1)) + 0.5), maxFacts); EnvPrintRouter(theEnv,WDIALOG,printSpace); #endif #if OBJECT_SYSTEM gensprintf(printSpace,"%ld mean number of instances (%ld maximum).\n", (long) (((double) sumInstances / (rulesFired + 1)) + 0.5), maxInstances); EnvPrintRouter(theEnv,WDIALOG,printSpace); #endif gensprintf(printSpace,"%ld mean number of activations (%ld maximum).\n", (long) (((double) sumActivations / (rulesFired + 1)) + 0.5), maxActivations); EnvPrintRouter(theEnv,WDIALOG,printSpace); #if DEVELOPER gensprintf(printSpace,"%9ld left to right comparisons.\n", EngineData(theEnv)->leftToRightComparisons); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld left to right succeeds.\n", EngineData(theEnv)->leftToRightSucceeds); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld left to right loops.\n", EngineData(theEnv)->leftToRightLoops); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld right to left comparisons.\n", EngineData(theEnv)->rightToLeftComparisons); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld right to left succeeds.\n", EngineData(theEnv)->rightToLeftSucceeds); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld right to left loops.\n", EngineData(theEnv)->rightToLeftLoops); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld find next conflicting comparisons.\n", EngineData(theEnv)->findNextConflictingComparisons); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld beta hash list skips.\n", EngineData(theEnv)->betaHashListSkips); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld beta hash hash table skips.\n", EngineData(theEnv)->betaHashHTSkips); EnvPrintRouter(theEnv,WDIALOG,printSpace); gensprintf(printSpace,"%9ld unneeded marker compare.\n", EngineData(theEnv)->unneededMarkerCompare); EnvPrintRouter(theEnv,WDIALOG,printSpace); #endif } #endif /*==========================================*/ /* The current module should be the current */ /* focus when the run finishes. */ /*==========================================*/ if (EngineData(theEnv)->CurrentFocus != NULL) { if (EngineData(theEnv)->CurrentFocus->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvSetCurrentModule(theEnv,(void *) EngineData(theEnv)->CurrentFocus->theModule); } } /*================================*/ /* Restore the old garbage frame. */ /*================================*/ RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); /*===================================*/ /* Return the number of rules fired. */ /*===================================*/ EngineData(theEnv)->AlreadyRunning = FALSE; return(rulesFired); } /***********************************************************/ /* NextActivationToFire: Returns the next activation which */ /* should be executed based on the current focus. */ /***********************************************************/ globle struct activation *NextActivationToFire( void *theEnv) { struct activation *theActivation; struct defmodule *theModule; /*====================================*/ /* If there is no current focus, then */ /* focus on the MAIN module. */ /*====================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,theModule); } /*===========================================================*/ /* Determine the top activation on the agenda of the current */ /* focus. If the current focus has no activations on its */ /* agenda, then pop the focus off the focus stack until */ /* a focus that has an activation on its agenda is found. */ /*===========================================================*/ theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda; while ((theActivation == NULL) && (EngineData(theEnv)->CurrentFocus != NULL)) { if (EngineData(theEnv)->CurrentFocus != NULL) EnvPopFocus(theEnv); if (EngineData(theEnv)->CurrentFocus != NULL) theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda; } /*=========================================*/ /* Return the next activation to be fired. */ /*=========================================*/ return(theActivation); } /***************************************************/ /* RemoveFocus: Removes the first occurence of the */ /* specified module from the focus stack. */ /***************************************************/ static struct defmodule *RemoveFocus( void *theEnv, struct defmodule *theModule) { struct focus *tempFocus,*prevFocus, *nextFocus; int found = FALSE; int currentFocusRemoved = FALSE; /*====================================*/ /* Return NULL if there is nothing on */ /* the focus stack to remove. */ /*====================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) return(NULL); /*=============================================*/ /* Remove the first occurence of the specified */ /* module from the focus stack. */ /*=============================================*/ prevFocus = NULL; tempFocus = EngineData(theEnv)->CurrentFocus; while ((tempFocus != NULL) && (! found)) { if (tempFocus->theModule == theModule) { found = TRUE; nextFocus = tempFocus->next; rtn_struct(theEnv,focus,tempFocus); tempFocus = nextFocus; if (prevFocus == NULL) { currentFocusRemoved = TRUE; EngineData(theEnv)->CurrentFocus = tempFocus; } else { prevFocus->next = tempFocus; } } else { prevFocus = tempFocus; tempFocus = tempFocus->next; } } /*=========================================*/ /* If the given module is not in the focus */ /* stack, simply return the current focus */ /*=========================================*/ if (! found) return(EngineData(theEnv)->CurrentFocus->theModule); /*========================================*/ /* If the current focus is being watched, */ /* then print an informational message. */ /*========================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchFocus) { EnvPrintRouter(theEnv,WTRACE,"<== Focus "); EnvPrintRouter(theEnv,WTRACE,ValueToString(theModule->name)); if ((EngineData(theEnv)->CurrentFocus != NULL) && currentFocusRemoved) { EnvPrintRouter(theEnv,WTRACE," to "); EnvPrintRouter(theEnv,WTRACE,ValueToString(EngineData(theEnv)->CurrentFocus->theModule->name)); } EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*======================================================*/ /* Set the current module to the module associated with */ /* the current focus (if it changed) and set a boolean */ /* flag indicating that the focus has changed. */ /*======================================================*/ if ((EngineData(theEnv)->CurrentFocus != NULL) && currentFocusRemoved) { EnvSetCurrentModule(theEnv,(void *) EngineData(theEnv)->CurrentFocus->theModule); } EngineData(theEnv)->FocusChanged = TRUE; /*====================================*/ /* Return the module that was removed */ /* from the focus stack. */ /*====================================*/ return(theModule); } /*************************************************************/ /* EnvPopFocus: C access routine for the pop-focus function. */ /*************************************************************/ globle void *EnvPopFocus( void *theEnv) { if (EngineData(theEnv)->CurrentFocus == NULL) return(NULL); return((void *) RemoveFocus(theEnv,EngineData(theEnv)->CurrentFocus->theModule)); } /***************************************************************/ /* EnvGetNextFocus: Returns the next focus on the focus stack. */ /***************************************************************/ globle void *EnvGetNextFocus( void *theEnv, void *theFocus) { /*==================================================*/ /* If NULL is passed as an argument, return the top */ /* focus on the focus stack (the current focus). */ /*==================================================*/ if (theFocus == NULL) return((void *) EngineData(theEnv)->CurrentFocus); /*=======================================*/ /* Otherwise, return the focus following */ /* the focus passed as an argument. */ /*=======================================*/ return((void *) ((struct focus *) theFocus)->next); } /******************************************************/ /* EnvFocus: C access routine for the focus function. */ /******************************************************/ globle void EnvFocus( void *theEnv, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; struct focus *tempFocus; /*==================================================*/ /* Make the specified module be the current module. */ /* If the specified module is the current focus, */ /* then no further action is needed. */ /*==================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); if (EngineData(theEnv)->CurrentFocus != NULL) { if (EngineData(theEnv)->CurrentFocus->theModule == theModule) return; } /*=====================================*/ /* If the focus is being watched, then */ /* print an information message. */ /*=====================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchFocus) { EnvPrintRouter(theEnv,WTRACE,"==> Focus "); EnvPrintRouter(theEnv,WTRACE,ValueToString(theModule->name)); if (EngineData(theEnv)->CurrentFocus != NULL) { EnvPrintRouter(theEnv,WTRACE," from "); EnvPrintRouter(theEnv,WTRACE,ValueToString(EngineData(theEnv)->CurrentFocus->theModule->name)); } EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=======================================*/ /* Add the new focus to the focus stack. */ /*=======================================*/ tempFocus = get_struct(theEnv,focus); tempFocus->theModule = theModule; tempFocus->theDefruleModule = GetDefruleModuleItem(theEnv,theModule); tempFocus->next = EngineData(theEnv)->CurrentFocus; EngineData(theEnv)->CurrentFocus = tempFocus; EngineData(theEnv)->FocusChanged = TRUE; } /************************************************/ /* ClearFocusStackCommand: H/L access routine */ /* for the clear-focus-stack command. */ /************************************************/ globle void ClearFocusStackCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"list-focus-stack",EXACTLY,0) == -1) return; EnvClearFocusStack(theEnv); } /****************************************/ /* EnvClearFocusStack: C access routine */ /* for the clear-focus-stack command. */ /****************************************/ globle void EnvClearFocusStack( void *theEnv) { while (EngineData(theEnv)->CurrentFocus != NULL) EnvPopFocus(theEnv); EngineData(theEnv)->FocusChanged = TRUE; } /**************************************/ /* EnvAddRunFunction: Adds a function */ /* to the ListOfRunFunctions. */ /**************************************/ globle intBool EnvAddRunFunction( void *theEnv, const char *name, void (*functionPtr)(void *), int priority) { EngineData(theEnv)->ListOfRunFunctions = AddFunctionToCallList(theEnv,name,priority, functionPtr, EngineData(theEnv)->ListOfRunFunctions,TRUE); return(1); } /********************************************/ /* EnvAddBeforeRunFunction: Adds a function */ /* to the ListOfBeforeRunFunctions. */ /********************************************/ globle intBool EnvAddBeforeRunFunction( void *theEnv, const char *name, void (*functionPtr)(void *, void *), int priority) { EngineData(theEnv)->ListOfBeforeRunFunctions = AddFunctionToCallListWithArg(theEnv,name,priority, functionPtr, EngineData(theEnv)->ListOfBeforeRunFunctions,TRUE); return(1); } /*****************************************/ /* EnvAddRunFunctionWithContext: Adds a */ /* function to the ListOfRunFunctions. */ /*****************************************/ globle intBool EnvAddRunFunctionWithContext( void *theEnv, const char *name, void (*functionPtr)(void *), int priority, void *context) { EngineData(theEnv)->ListOfRunFunctions = AddFunctionToCallListWithContext(theEnv,name,priority,functionPtr, EngineData(theEnv)->ListOfRunFunctions, TRUE,context); return(1); } /***********************************************/ /* EnvAddBeforeRunFunctionWithContext: Adds a */ /* function to the ListOfBeforeRunFunctions. */ /***********************************************/ globle intBool EnvAddBeforeRunFunctionWithContext( void *theEnv, const char *name, void (*functionPtr)(void *, void *), int priority, void *context) { EngineData(theEnv)->ListOfBeforeRunFunctions = AddFunctionToCallListWithArgWithContext(theEnv,name,priority,functionPtr, EngineData(theEnv)->ListOfBeforeRunFunctions, TRUE,context); return(1); } /********************************************/ /* EnvRemoveRunFunction: Removes a function */ /* from the ListOfRunFunctions. */ /********************************************/ globle intBool EnvRemoveRunFunction( void *theEnv, const char *name) { int found; EngineData(theEnv)->ListOfRunFunctions = RemoveFunctionFromCallList(theEnv,name,EngineData(theEnv)->ListOfRunFunctions,&found); if (found) return(TRUE); return(FALSE); } /**************************************************/ /* EnvRemoveBeforeRunFunction: Removes a function */ /* from the ListOfBeforeRunFunctions. */ /**************************************************/ globle intBool EnvRemoveBeforeRunFunction( void *theEnv, const char *name) { int found; EngineData(theEnv)->ListOfBeforeRunFunctions = RemoveFunctionFromCallListWithArg(theEnv,name,EngineData(theEnv)->ListOfBeforeRunFunctions,&found); if (found) return(TRUE); return(FALSE); } /*********************************************************/ /* RunCommand: H/L access routine for the run command. */ /*********************************************************/ globle void RunCommand( void *theEnv) { int numArgs; long long runLimit = -1LL; DATA_OBJECT argPtr; if ((numArgs = EnvArgCountCheck(theEnv,"run",NO_MORE_THAN,1)) == -1) return; if (numArgs == 0) { runLimit = -1LL; } else if (numArgs == 1) { if (EnvArgTypeCheck(theEnv,"run",1,INTEGER,&argPtr) == FALSE) return; runLimit = DOToLong(argPtr); } EnvRun(theEnv,runLimit); return; } /***********************************************/ /* HaltCommand: Causes rule execution to halt. */ /***********************************************/ globle void HaltCommand( void *theEnv) { EnvArgCountCheck(theEnv,"halt",EXACTLY,0); EnvHalt(theEnv); } /*****************************/ /* EnvHalt: C access routine */ /* for the halt command. */ /*****************************/ globle void EnvHalt( void *theEnv) { EngineData(theEnv)->HaltRules = TRUE; } #if DEBUGGING_FUNCTIONS /*********************************/ /* EnvSetBreak: C access routine */ /* for the set-break command. */ /*********************************/ globle void EnvSetBreak( void *theEnv, void *theRule) { #if MAC_XCD #pragma unused(theEnv) #endif struct defrule *thePtr; for (thePtr = (struct defrule *) theRule; thePtr != NULL; thePtr = thePtr->disjunct) { thePtr->afterBreakpoint = 1; } } /************************************/ /* EnvRemoveBreak: C access routine */ /* for the remove-break command. */ /************************************/ globle intBool EnvRemoveBreak( void *theEnv, void *theRule) { #if MAC_XCD #pragma unused(theEnv) #endif struct defrule *thePtr; int rv = FALSE; for (thePtr = (struct defrule *) theRule; thePtr != NULL; thePtr = thePtr->disjunct) { if (thePtr->afterBreakpoint == 1) { thePtr->afterBreakpoint = 0; rv = TRUE; } } return(rv); } /**************************************************/ /* RemoveAllBreakpoints: Removes all breakpoints. */ /**************************************************/ globle void RemoveAllBreakpoints( void *theEnv) { void *theRule; void *theDefmodule = NULL; while ((theDefmodule = EnvGetNextDefmodule(theEnv,theDefmodule)) != NULL) { theRule = NULL; while ((theRule = EnvGetNextDefrule(theEnv,theRule)) != NULL) { EnvRemoveBreak(theEnv,theRule); } } } /***********************************/ /* EnvShowBreaks: C access routine */ /* for the show-breaks command. */ /***********************************/ globle void EnvShowBreaks( void *theEnv, const char *logicalName, void *vTheModule) { ListItemsDriver(theEnv,logicalName,(struct defmodule *) vTheModule, NULL,NULL, EnvGetNextDefrule,(const char *(*)(void *)) GetConstructNameString, NULL,EnvDefruleHasBreakpoint); } /**********************************************/ /* EnvDefruleHasBreakpoint: Indicates whether */ /* the specified rule has a breakpoint set. */ /**********************************************/ globle intBool EnvDefruleHasBreakpoint( void *theEnv, void *theRule) { #if MAC_XCD #pragma unused(theEnv) #endif return(((struct defrule *) theRule)->afterBreakpoint); } /*****************************************/ /* SetBreakCommand: H/L access routine */ /* for the set-break command. */ /*****************************************/ globle void SetBreakCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; void *defrulePtr; if (EnvArgCountCheck(theEnv,"set-break",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"set-break",1,SYMBOL,&argPtr) == FALSE) return; argument = DOToString(argPtr); if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL) { CantFindItemErrorMessage(theEnv,"defrule",argument); return; } EnvSetBreak(theEnv,defrulePtr); } /********************************************/ /* RemoveBreakCommand: H/L access routine */ /* for the remove-break command. */ /********************************************/ globle void RemoveBreakCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; int nargs; void *defrulePtr; if ((nargs = EnvArgCountCheck(theEnv,"remove-break",NO_MORE_THAN,1)) == -1) { return; } if (nargs == 0) { RemoveAllBreakpoints(theEnv); return; } if (EnvArgTypeCheck(theEnv,"remove-break",1,SYMBOL,&argPtr) == FALSE) return; argument = DOToString(argPtr); if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL) { CantFindItemErrorMessage(theEnv,"defrule",argument); return; } if (EnvRemoveBreak(theEnv,defrulePtr) == FALSE) { EnvPrintRouter(theEnv,WERROR,"Rule "); EnvPrintRouter(theEnv,WERROR,argument); EnvPrintRouter(theEnv,WERROR," does not have a breakpoint set.\n"); } } /*******************************************/ /* ShowBreaksCommand: H/L access routine */ /* for the show-breaks command. */ /*******************************************/ globle void ShowBreaksCommand( void *theEnv) { int numArgs, error; struct defmodule *theModule; if ((numArgs = EnvArgCountCheck(theEnv,"show-breaks",NO_MORE_THAN,1)) == -1) return; if (numArgs == 1) { theModule = GetModuleName(theEnv,"show-breaks",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } EnvShowBreaks(theEnv,WDISPLAY,theModule); } /***********************************************/ /* ListFocusStackCommand: H/L access routine */ /* for the list-focus-stack command. */ /***********************************************/ globle void ListFocusStackCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"list-focus-stack",EXACTLY,0) == -1) return; EnvListFocusStack(theEnv,WDISPLAY); } /***************************************/ /* EnvListFocusStack: C access routine */ /* for the list-focus-stack command. */ /***************************************/ globle void EnvListFocusStack( void *theEnv, const char *logicalName) { struct focus *theFocus; for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theFocus->theModule)); EnvPrintRouter(theEnv,logicalName,"\n"); } } #endif /* DEBUGGING_FUNCTIONS */ /***********************************************/ /* GetFocusStackFunction: H/L access routine */ /* for the get-focus-stack function. */ /***********************************************/ globle void GetFocusStackFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { if (EnvArgCountCheck(theEnv,"get-focus-stack",EXACTLY,0) == -1) return; EnvGetFocusStack(theEnv,returnValue); } /***************************************/ /* EnvGetFocusStack: C access routine */ /* for the get-focus-stack function. */ /***************************************/ globle void EnvGetFocusStack( void *theEnv, DATA_OBJECT_PTR returnValue) { struct focus *theFocus; struct multifield *theList; unsigned long count = 0; /*===========================================*/ /* If there is no current focus, then return */ /* a multifield value of length zero. */ /*===========================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); SetpValue(returnValue,(void *) EnvCreateMultifield(theEnv,0L)); return; } /*=====================================================*/ /* Determine the number of modules on the focus stack. */ /*=====================================================*/ for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next) { count++; } /*=============================================*/ /* Create a multifield of the appropriate size */ /* in which to store the module names. */ /*=============================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*=================================================*/ /* Store the module names in the multifield value. */ /*=================================================*/ for (theFocus = EngineData(theEnv)->CurrentFocus, count = 1; theFocus != NULL; theFocus = theFocus->next, count++) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theFocus->theModule->name); } } /******************************************/ /* PopFocusFunction: H/L access routine */ /* for the pop-focus function. */ /******************************************/ globle void *PopFocusFunction( void *theEnv) { struct defmodule *theModule; EnvArgCountCheck(theEnv,"pop-focus",EXACTLY,0); theModule = (struct defmodule *) EnvPopFocus(theEnv); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return(theModule->name); } /******************************************/ /* GetFocusFunction: H/L access routine */ /* for the get-focus function. */ /******************************************/ globle void *GetFocusFunction( void *theEnv) { struct defmodule *rv; EnvArgCountCheck(theEnv,"get-focus",EXACTLY,0); rv = (struct defmodule *) EnvGetFocus(theEnv); if (rv == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return(rv->name); } /*********************************/ /* EnvGetFocus: C access routine */ /* for the get-focus function. */ /*********************************/ globle void *EnvGetFocus( void *theEnv) { if (EngineData(theEnv)->CurrentFocus == NULL) return(NULL); return((void *) EngineData(theEnv)->CurrentFocus->theModule); } /**************************************/ /* FocusCommand: H/L access routine */ /* for the focus function. */ /**************************************/ globle int FocusCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; struct defmodule *theModule; int argCount, i; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"focus",AT_LEAST,1)) == -1) { return(FALSE); } /*===========================================*/ /* Focus on the specified defrule module(s). */ /*===========================================*/ for (i = argCount; i > 0; i--) { if (EnvArgTypeCheck(theEnv,"focus",i,SYMBOL,&argPtr) == FALSE) { return(FALSE); } argument = DOToString(argPtr); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument); return(FALSE); } EnvFocus(theEnv,(void *) theModule); } /*===================================================*/ /* Return TRUE to indicate success of focus command. */ /*===================================================*/ return(TRUE); } /***********************************************************************/ /* EnvGetFocusChanged: Returns the value of the variable FocusChanged. */ /***********************************************************************/ globle int EnvGetFocusChanged( void *theEnv) { return(EngineData(theEnv)->FocusChanged); } /********************************************************************/ /* EnvSetFocusChanged: Sets the value of the variable FocusChanged. */ /********************************************************************/ globle void EnvSetFocusChanged( void *theEnv, int value) { EngineData(theEnv)->FocusChanged = value; } /*********************************************/ /* EnvSetHaltRules: Sets the HaltRules flag. */ /*********************************************/ globle void EnvSetHaltRules( void *theEnv, intBool value) { EngineData(theEnv)->HaltRules = value; } /****************************************************/ /* EnvGetHaltRules: Returns the HaltExecution flag. */ /****************************************************/ globle intBool EnvGetHaltRules( void *theEnv) { return(EngineData(theEnv)->HaltRules); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool AddBeforeRunFunction( const char *name, void (*functionPtr)(void *), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); EngineData(theEnv)->ListOfBeforeRunFunctions = AddFunctionToCallListWithArg(theEnv,name,priority,(void (*)(void *,void *)) functionPtr, EngineData(theEnv)->ListOfBeforeRunFunctions,TRUE); return(1); } globle intBool AddRunFunction( const char *name, void (*functionPtr)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); EngineData(theEnv)->ListOfRunFunctions = AddFunctionToCallList(theEnv,name,priority,(void (*)(void *)) functionPtr, EngineData(theEnv)->ListOfRunFunctions,TRUE); return(1); } globle void ClearFocusStack() { EnvClearFocusStack(GetCurrentEnvironment()); } globle void Focus( void *vTheModule) { EnvFocus(GetCurrentEnvironment(),vTheModule); } globle void GetFocusStack( DATA_OBJECT_PTR returnValue) { EnvGetFocusStack(GetCurrentEnvironment(),returnValue); } globle void *GetFocus() { return EnvGetFocus(GetCurrentEnvironment()); } globle int GetFocusChanged() { return EnvGetFocusChanged(GetCurrentEnvironment()); } globle void *GetNextFocus( void *theFocus) { return EnvGetNextFocus(GetCurrentEnvironment(),theFocus); } globle void Halt() { EnvHalt(GetCurrentEnvironment()); } globle void *PopFocus() { return EnvPopFocus(GetCurrentEnvironment()); } globle intBool RemoveRunFunction( const char *name) { return EnvRemoveRunFunction(GetCurrentEnvironment(),name); } globle long long Run( long long runLimit) { return EnvRun(GetCurrentEnvironment(),runLimit); } globle void SetFocusChanged( int value) { EnvSetFocusChanged(GetCurrentEnvironment(),value); } #if DEBUGGING_FUNCTIONS globle void ListFocusStack( const char *logicalName) { EnvListFocusStack(GetCurrentEnvironment(),logicalName); } globle intBool DefruleHasBreakpoint( void *theRule) { return EnvDefruleHasBreakpoint(GetCurrentEnvironment(),theRule); } globle intBool RemoveBreak( void *theRule) { return EnvRemoveBreak(GetCurrentEnvironment(),theRule); } globle void SetBreak( void *theRule) { EnvSetBreak(GetCurrentEnvironment(),theRule); } globle void ShowBreaks( const char *logicalName, void *vTheModule) { EnvShowBreaks(GetCurrentEnvironment(),logicalName,vTheModule); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/insfun.h0000755000175000017500000001577512500146515015722 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INSTANCE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved EvaluateAndStoreInDataObject to */ /* evaluatn.c */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed slot override default ?NONE bug. */ /* */ //*************************************************************/ #ifndef _H_insfun #define _H_insfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_pattern #include "pattern.h" #endif typedef struct igarbage { INSTANCE_TYPE *ins; struct igarbage *nxt; } IGARBAGE; #define INSTANCE_TABLE_HASH_SIZE 8191 #define InstanceSizeHeuristic(ins) sizeof(INSTANCE_TYPE) #ifdef LOCALE #undef LOCALE #endif #ifdef _INSFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void EnvIncrementInstanceCount(void *,void *); LOCALE void EnvDecrementInstanceCount(void *,void *); LOCALE void InitializeInstanceTable(void *); LOCALE void CleanupInstances(void *); LOCALE unsigned HashInstance(SYMBOL_HN *); LOCALE void DestroyAllInstances(void *); LOCALE void RemoveInstanceData(void *,INSTANCE_TYPE *); LOCALE INSTANCE_TYPE *FindInstanceBySymbol(void *,SYMBOL_HN *); LOCALE INSTANCE_TYPE *FindInstanceInModule(void *,SYMBOL_HN *,struct defmodule *, struct defmodule *,unsigned); LOCALE INSTANCE_SLOT *FindInstanceSlot(void *,INSTANCE_TYPE *,SYMBOL_HN *); LOCALE int FindInstanceTemplateSlot(void *,DEFCLASS *,SYMBOL_HN *); LOCALE int PutSlotValue(void *,INSTANCE_TYPE *,INSTANCE_SLOT *,DATA_OBJECT *,DATA_OBJECT *,const char *); LOCALE int DirectPutSlotValue(void *,INSTANCE_TYPE *,INSTANCE_SLOT *,DATA_OBJECT *,DATA_OBJECT *); LOCALE intBool ValidSlotValue(void *,DATA_OBJECT *,SLOT_DESC *,INSTANCE_TYPE *,const char *); LOCALE INSTANCE_TYPE *CheckInstance(void *,const char *); LOCALE void NoInstanceError(void *,const char *,const char *); LOCALE void StaleInstanceAddress(void *,const char *,int); LOCALE int EnvGetInstancesChanged(void *); LOCALE void EnvSetInstancesChanged(void *,int); LOCALE void PrintSlot(void *,const char *,SLOT_DESC *,INSTANCE_TYPE *,const char *); LOCALE void PrintInstanceNameAndClass(void *,const char *,INSTANCE_TYPE *,intBool); LOCALE void PrintInstanceName(void *,const char *,void *); LOCALE void PrintInstanceLongForm(void *,const char *,void *); #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void DecrementObjectBasisCount(void *,void *); LOCALE void IncrementObjectBasisCount(void *,void *); LOCALE void MatchObjectFunction(void *,void *); LOCALE intBool NetworkSynchronized(void *,void *); LOCALE intBool InstanceIsDeleted(void *,void *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void DecrementInstanceCount(void *); LOCALE int GetInstancesChanged(void); LOCALE void IncrementInstanceCount(void *); LOCALE void SetInstancesChanged(int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_insfun */ clips_core_source_630/core/._pprint.c0000755000175000017500000000040712373743667016151 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._sysdep.h0000755000175000017500000000040712464554105016135 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/retract.c0000755000175000017500000006255412500146515016054 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RETRACT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the removal of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /* Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Removed pseudo-facts used in not CEs. */ /* */ /*************************************************************/ #define _RETRACT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "agenda.h" #include "argacces.h" #include "constant.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "lgcldpnd.h" #include "match.h" #include "memalloc.h" #include "network.h" #include "reteutil.h" #include "router.h" #include "symbol.h" #include "retract.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ReturnMarkers(void *,struct multifieldMarker *); static intBool FindNextConflictingMatch(void *,struct partialMatch *, struct partialMatch *, struct joinNode *,struct partialMatch *,int); static intBool PartialMatchDefunct(void *,struct partialMatch *); static void NegEntryRetractAlpha(void *,struct partialMatch *,int); static void NegEntryRetractBeta(void *,struct joinNode *,struct partialMatch *, struct partialMatch *,int); /************************************************************/ /* NetworkRetract: Retracts a data entity (such as a fact */ /* or instance) from the pattern and join networks given */ /* a pointer to the list of patterns which the data */ /* entity matched. */ /************************************************************/ globle void NetworkRetract( void *theEnv, struct patternMatch *listOfMatchedPatterns) { struct patternMatch *tempMatch, *nextMatch; tempMatch = listOfMatchedPatterns; while (tempMatch != NULL) { nextMatch = tempMatch->next; if (tempMatch->theMatch->children != NULL) { PosEntryRetractAlpha(theEnv,tempMatch->theMatch,NETWORK_RETRACT); } if (tempMatch->theMatch->blockList != NULL) { NegEntryRetractAlpha(theEnv,tempMatch->theMatch,NETWORK_RETRACT); } /*===================================================*/ /* Remove from the alpha memory of the pattern node. */ /*===================================================*/ RemoveAlphaMemoryMatches(theEnv,tempMatch->matchingPattern, tempMatch->theMatch, tempMatch->theMatch->binds[0].gm.theMatch); rtn_struct(theEnv,patternMatch,tempMatch); tempMatch = nextMatch; } } /***************************************************************/ /* PosEntryRetractAlpha: */ /***************************************************************/ globle void PosEntryRetractAlpha( void *theEnv, struct partialMatch *alphaMatch, int operation) { struct partialMatch *betaMatch, *tempMatch; struct joinNode *joinPtr; betaMatch = alphaMatch->children; while (betaMatch != NULL) { joinPtr = (struct joinNode *) betaMatch->owner; if (betaMatch->children != NULL) { PosEntryRetractBeta(theEnv,betaMatch,betaMatch->children,operation); } if (betaMatch->rhsMemory) { NegEntryRetractAlpha(theEnv,betaMatch,operation); } /* Remove the beta match. */ if ((joinPtr->ruleToActivate != NULL) ? (betaMatch->marker != NULL) : FALSE) { RemoveActivation(theEnv,(struct activation *) betaMatch->marker,TRUE,TRUE); } tempMatch = betaMatch->nextRightChild; if (betaMatch->rhsMemory) { UnlinkBetaPMFromNodeAndLineage(theEnv,joinPtr,betaMatch,RHS); } else { UnlinkBetaPMFromNodeAndLineage(theEnv,joinPtr,betaMatch,LHS); } DeletePartialMatches(theEnv,betaMatch); betaMatch = tempMatch; } } /***************************************************************/ /* NegEntryRetractAlpha: */ /***************************************************************/ static void NegEntryRetractAlpha( void *theEnv, struct partialMatch *alphaMatch, int operation) { struct partialMatch *betaMatch; struct joinNode *joinPtr; betaMatch = alphaMatch->blockList; while (betaMatch != NULL) { joinPtr = (struct joinNode *) betaMatch->owner; if ((! joinPtr->patternIsNegated) && (! joinPtr->patternIsExists) && (! joinPtr->joinFromTheRight)) { SystemError(theEnv,"RETRACT",117); betaMatch = betaMatch->nextBlocked; continue; } NegEntryRetractBeta(theEnv,joinPtr,alphaMatch,betaMatch,operation); betaMatch = alphaMatch->blockList; } } /***************************************************************/ /* NegEntryRetractBeta: */ /***************************************************************/ static void NegEntryRetractBeta( void *theEnv, struct joinNode *joinPtr, struct partialMatch *alphaMatch, struct partialMatch *betaMatch, int operation) { /*======================================================*/ /* Try to find another RHS partial match which prevents */ /* the LHS partial match from being satisifed. */ /*======================================================*/ RemoveBlockedLink(betaMatch); if (FindNextConflictingMatch(theEnv,betaMatch,alphaMatch->nextInMemory,joinPtr,alphaMatch,operation)) { return; } else if (joinPtr->patternIsExists) { if (betaMatch->children != NULL) { PosEntryRetractBeta(theEnv,betaMatch,betaMatch->children,operation); } return; } else if (joinPtr->firstJoin && (joinPtr->patternIsNegated || joinPtr->joinFromTheRight) && (! joinPtr->patternIsExists)) { if (joinPtr->secondaryNetworkTest != NULL) { if (EvaluateSecondaryNetworkTest(theEnv,betaMatch,joinPtr) == FALSE) { return; } } EPMDrive(theEnv,betaMatch,joinPtr,operation); return; } if (joinPtr->secondaryNetworkTest != NULL) { if (EvaluateSecondaryNetworkTest(theEnv,betaMatch,joinPtr) == FALSE) { return; } } /*=========================================================*/ /* If the LHS partial match now has no RHS partial matches */ /* that conflict with it, then it satisfies the conditions */ /* of the RHS not CE. Create a partial match and send it */ /* to the joins below. */ /*=========================================================*/ /*===============================*/ /* Create the new partial match. */ /*===============================*/ if ((operation == NETWORK_RETRACT) && PartialMatchWillBeDeleted(theEnv,betaMatch)) { return; } PPDrive(theEnv,betaMatch,NULL,joinPtr,operation); } /***************************************************************/ /* PosEntryRetractBeta: */ /***************************************************************/ globle void PosEntryRetractBeta( void *theEnv, struct partialMatch *parentMatch, struct partialMatch *betaMatch, int operation) { struct partialMatch *tempMatch; while (betaMatch != NULL) { if (betaMatch->children != NULL) { betaMatch = betaMatch->children; continue; } if (betaMatch->nextLeftChild != NULL) { tempMatch = betaMatch->nextLeftChild; } else { tempMatch = betaMatch->leftParent; betaMatch->leftParent->children = NULL; } if (betaMatch->blockList != NULL) { NegEntryRetractAlpha(theEnv,betaMatch,operation); } else if ((((struct joinNode *) betaMatch->owner)->ruleToActivate != NULL) ? (betaMatch->marker != NULL) : FALSE) { RemoveActivation(theEnv,(struct activation *) betaMatch->marker,TRUE,TRUE); } if (betaMatch->rhsMemory) { UnlinkNonLeftLineage(theEnv,(struct joinNode *) betaMatch->owner,betaMatch,RHS); } else { UnlinkNonLeftLineage(theEnv,(struct joinNode *) betaMatch->owner,betaMatch,LHS); } if (betaMatch->dependents != NULL) RemoveLogicalSupport(theEnv,betaMatch); ReturnPartialMatch(theEnv,betaMatch); if (tempMatch == parentMatch) return; betaMatch = tempMatch; } } /******************************************************************/ /* FindNextConflictingMatch: Finds the next conflicting partial */ /* match in the right memory of a join that prevents a partial */ /* match in the beta memory of the join from being satisfied. */ /******************************************************************/ static intBool FindNextConflictingMatch( void *theEnv, struct partialMatch *theBind, struct partialMatch *possibleConflicts, struct joinNode *theJoin, struct partialMatch *skipMatch, int operation) { int result, restore = FALSE; struct partialMatch *oldLHSBinds = NULL; struct partialMatch *oldRHSBinds = NULL; struct joinNode *oldJoin = NULL; /*====================================*/ /* Check each of the possible partial */ /* matches which could conflict. */ /*====================================*/ #if DEVELOPER if (possibleConflicts != NULL) { EngineData(theEnv)->leftToRightLoops++; } #endif /*====================================*/ /* Set up the evaluation environment. */ /*====================================*/ if (possibleConflicts != NULL) { oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = theBind; EngineData(theEnv)->GlobalJoin = theJoin; restore = TRUE; } for (; possibleConflicts != NULL; possibleConflicts = possibleConflicts->nextInMemory) { theJoin->memoryCompares++; /*=====================================*/ /* Initially indicate that the partial */ /* match doesn't conflict. */ /*=====================================*/ result = FALSE; if (skipMatch == possibleConflicts) { /* Do Nothing */ } /*======================================================*/ /* 6.05 Bug Fix. It is possible that a pattern entity */ /* (e.g. instance) in a partial match is 'out of date' */ /* with respect to the lazy evaluation scheme use by */ /* negated patterns. In other words, the object may */ /* have changed since it was last pushed through the */ /* network, and thus the partial match may be invalid. */ /* If so, the partial match must be ignored here. */ /*======================================================*/ else if (PartialMatchDefunct(theEnv,possibleConflicts)) { /* Do Nothing */ } else if ((operation == NETWORK_RETRACT) && PartialMatchWillBeDeleted(theEnv,possibleConflicts)) { /* Do Nothing */ } /*================================================*/ /* If the join doesn't have a network expression */ /* to be evaluated, then partial match conflicts. */ /*================================================*/ else if (theJoin->networkTest == NULL) { result = TRUE; } /*=================================================*/ /* Otherwise, if the join has a network expression */ /* to evaluate, then evaluate it. */ /*=================================================*/ else { #if DEVELOPER if (theJoin->networkTest) { EngineData(theEnv)->leftToRightComparisons++; EngineData(theEnv)->findNextConflictingComparisons++; } #endif EngineData(theEnv)->GlobalRHSBinds = possibleConflicts; result = EvaluateJoinExpression(theEnv,theJoin->networkTest,theJoin); if (EvaluationData(theEnv)->EvaluationError) { result = TRUE; EvaluationData(theEnv)->EvaluationError = FALSE; } #if DEVELOPER if (result != FALSE) { EngineData(theEnv)->leftToRightSucceeds++; } #endif } /*==============================================*/ /* If the network expression evaluated to TRUE, */ /* then partial match being examined conflicts. */ /* Point the beta memory partial match to the */ /* conflicting partial match and return TRUE to */ /* indicate a conflict was found. */ /*==============================================*/ if (result != FALSE) { AddBlockedLink(theBind,possibleConflicts); EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(TRUE); } } if (restore) { EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; } /*========================*/ /* No conflict was found. */ /*========================*/ return(FALSE); } /***********************************************************/ /* PartialMatchDefunct: Determines if any pattern entities */ /* contained within the partial match have changed since */ /* this partial match was generated. Assumes counterf is */ /* FALSE. */ /***********************************************************/ static intBool PartialMatchDefunct( void *theEnv, struct partialMatch *thePM) { register unsigned short i; register struct patternEntity * thePE; for (i = 0 ; i < thePM->bcount ; i++) { if (thePM->binds[i].gm.theMatch == NULL) continue; thePE = thePM->binds[i].gm.theMatch->matchingItem; if (thePE && thePE->theInfo->synchronized && !(*thePE->theInfo->synchronized)(theEnv,thePE)) return(TRUE); } return(FALSE); } /*****************************************************************/ /* PartialMatchWillBeDeleted: Determines if any pattern entities */ /* contained within the partial match were deleted as part of */ /* a retraction/deletion. When rules have multiple patterns */ /* that can be matched by the same fact it's possible that a */ /* partial match encountered in the join network has not yet */ /* deleted and so should not be considered as valid. */ /*****************************************************************/ intBool PartialMatchWillBeDeleted( void *theEnv, struct partialMatch *thePM) { register unsigned short i; register struct patternEntity * thePE; if (thePM == NULL) return FALSE; for (i = 0 ; i < thePM->bcount ; i++) { if (thePM->binds[i].gm.theMatch == NULL) continue; thePE = thePM->binds[i].gm.theMatch->matchingItem; if (thePE && thePE->theInfo->isDeleted && (*thePE->theInfo->isDeleted)(theEnv,thePE)) return(TRUE); } return(FALSE); } /***************************************************/ /* DeletePartialMatches: Returns a list of partial */ /* matches to the pool of free memory. */ /***************************************************/ void DeletePartialMatches( void *theEnv, struct partialMatch *listOfPMs) { struct partialMatch *nextPM; while (listOfPMs != NULL) { /*============================================*/ /* Remember the next partial match to delete. */ /*============================================*/ nextPM = listOfPMs->nextInMemory; /*================================================*/ /* Remove the links between the partial match and */ /* any data entities that it is attached to as a */ /* result of a logical CE. */ /*================================================*/ if (listOfPMs->dependents != NULL) RemoveLogicalSupport(theEnv,listOfPMs); /*==========================================================*/ /* If the partial match is being deleted from a beta memory */ /* and the partial match isn't associated with a satisfied */ /* not CE, then it can be immediately returned to the pool */ /* of free memory. Otherwise, it's could be in use (either */ /* to retrieve variables from the LHS or by the activation */ /* of the rule). Since a not CE creates a "pseudo" data */ /* entity, the beta partial match which stores this pseudo */ /* data entity can not be deleted immediately (for the same */ /* reason an alpha memory partial match can't be deleted */ /* immediately). */ /*==========================================================*/ ReturnPartialMatch(theEnv,listOfPMs); /*====================================*/ /* Move on to the next partial match. */ /*====================================*/ listOfPMs = nextPM; } } /**************************************************************/ /* ReturnPartialMatch: Returns the data structures associated */ /* with a partial match to the pool of free memory. */ /**************************************************************/ globle void ReturnPartialMatch( void *theEnv, struct partialMatch *waste) { /*==============================================*/ /* If the partial match is in use, then put it */ /* on a garbage list to be processed later when */ /* the partial match is not in use. */ /*==============================================*/ if (waste->busy) { waste->nextInMemory = EngineData(theEnv)->GarbagePartialMatches; EngineData(theEnv)->GarbagePartialMatches = waste; return; } /*======================================================*/ /* If we're dealing with an alpha memory partial match, */ /* then return the multifield markers associated with */ /* the partial match (if any) along with the alphaMatch */ /* data structure. */ /*======================================================*/ if (waste->betaMemory == FALSE) { if (waste->binds[0].gm.theMatch->markers != NULL) { ReturnMarkers(theEnv,waste->binds[0].gm.theMatch->markers); } rm(theEnv,waste->binds[0].gm.theMatch,(int) sizeof(struct alphaMatch)); } /*=================================================*/ /* Remove any links between the partial match and */ /* a data entity that were created with the use of */ /* the logical CE. */ /*=================================================*/ if (waste->dependents != NULL) RemovePMDependencies(theEnv,waste); /*======================================================*/ /* Return the partial match to the pool of free memory. */ /*======================================================*/ rtn_var_struct(theEnv,partialMatch,(int) sizeof(struct genericMatch *) * (waste->bcount - 1), waste); } /***************************************************************/ /* DestroyPartialMatch: Returns the data structures associated */ /* with a partial match to the pool of free memory. */ /***************************************************************/ globle void DestroyPartialMatch( void *theEnv, struct partialMatch *waste) { /*======================================================*/ /* If we're dealing with an alpha memory partial match, */ /* then return the multifield markers associated with */ /* the partial match (if any) along with the alphaMatch */ /* data structure. */ /*======================================================*/ if (waste->betaMemory == FALSE) { if (waste->binds[0].gm.theMatch->markers != NULL) { ReturnMarkers(theEnv,waste->binds[0].gm.theMatch->markers); } rm(theEnv,waste->binds[0].gm.theMatch,(int) sizeof(struct alphaMatch)); } /*=================================================*/ /* Remove any links between the partial match and */ /* a data entity that were created with the use of */ /* the logical CE. */ /*=================================================*/ if (waste->dependents != NULL) DestroyPMDependencies(theEnv,waste); /*======================================================*/ /* Return the partial match to the pool of free memory. */ /*======================================================*/ rtn_var_struct(theEnv,partialMatch,(int) sizeof(struct genericMatch *) * (waste->bcount - 1), waste); } /******************************************************/ /* ReturnMarkers: Returns a linked list of multifield */ /* markers associated with a data entity matching a */ /* pattern to the pool of free memory. */ /******************************************************/ static void ReturnMarkers( void *theEnv, struct multifieldMarker *waste) { struct multifieldMarker *temp; while (waste != NULL) { temp = waste->next; rtn_struct(theEnv,multifieldMarker,waste); waste = temp; } } /*************************************************************/ /* FlushGarbagePartialMatches: Returns partial matches and */ /* associated structures that were removed as part of a */ /* retraction. It is necessary to postpone returning these */ /* structures to memory because RHS actions retrieve their */ /* variable bindings directly from the fact and instance */ /* data structures through the alpha memory bindings. */ /*************************************************************/ globle void FlushGarbagePartialMatches( void *theEnv) { struct partialMatch *pmPtr; struct alphaMatch *amPtr; /*===================================================*/ /* Return the garbage partial matches collected from */ /* the alpha memories of the pattern networks. */ /*===================================================*/ while (EngineData(theEnv)->GarbageAlphaMatches != NULL) { amPtr = EngineData(theEnv)->GarbageAlphaMatches->next; rtn_struct(theEnv,alphaMatch,EngineData(theEnv)->GarbageAlphaMatches); EngineData(theEnv)->GarbageAlphaMatches = amPtr; } /*==============================================*/ /* Return the garbage partial matches collected */ /* from the beta memories of the join networks. */ /*==============================================*/ while (EngineData(theEnv)->GarbagePartialMatches != NULL) { /*=====================================================*/ /* Remember the next garbage partial match to process. */ /*=====================================================*/ pmPtr = EngineData(theEnv)->GarbagePartialMatches->nextInMemory; /*============================================*/ /* Dispose of the garbage partial match being */ /* examined and move on to the next one. */ /*============================================*/ EngineData(theEnv)->GarbagePartialMatches->busy = FALSE; ReturnPartialMatch(theEnv,EngineData(theEnv)->GarbagePartialMatches); EngineData(theEnv)->GarbagePartialMatches = pmPtr; } } #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/miscfun.c0000755000175000017500000014513012465006171016047 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.39 01/29/15 */ /* */ /* MISCELLANEOUS FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* LOGICAL_DEPENDENCIES, IMPERATIVE_METHODS */ /* INSTANCE_PATTERN_MATCHING, */ /* IMPERATIVE_MESSAGE_HANDLERS, and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems. */ /* */ /* Renamed EX_MATH compiler flag to */ /* EXTENDED_MATH_FUNCTIONS. */ /* */ /* Combined BASIC_IO and EXT_IO compilation */ /* flags into the IO_FUNCTIONS compilation flag. */ /* */ /* Removed code associated with HELP_FUNCTIONS */ /* and EMACS_EDITOR compiler flags. */ /* */ /* Added operating-system function. */ /* */ /* Added new function (for future use). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Removed deallocating message parameter from */ /* EnvReleaseMem. */ /* */ /* Removed support for BLOCK_MEMORY. */ /* */ /*************************************************************/ #define _MISCFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "multifld.h" #include "router.h" #include "sysdep.h" #include "utility.h" #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #include "miscfun.h" #define MISCFUN_DATA 9 struct miscFunctionData { long long GensymNumber; }; #define MiscFunctionData(theEnv) ((struct miscFunctionData *) GetEnvironmentData(theEnv,MISCFUN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ExpandFuncMultifield(void *,DATA_OBJECT *,EXPRESSION *, EXPRESSION **,void *); static int FindLanguageType(void *,const char *); /*****************************************************************/ /* MiscFunctionDefinitions: Initializes miscellaneous functions. */ /*****************************************************************/ globle void MiscFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,MISCFUN_DATA,sizeof(struct miscFunctionData),NULL); MiscFunctionData(theEnv)->GensymNumber = 1; #if ! RUN_TIME EnvDefineFunction2(theEnv,"gensym", 'w', PTIEF GensymFunction, "GensymFunction", "00"); EnvDefineFunction2(theEnv,"gensym*", 'w', PTIEF GensymStarFunction, "GensymStarFunction", "00"); EnvDefineFunction2(theEnv,"setgen", 'g', PTIEF SetgenFunction, "SetgenFunction", "11i"); EnvDefineFunction2(theEnv,"system", 'v', PTIEF gensystem, "gensystem", "1*k"); EnvDefineFunction2(theEnv,"length", 'g', PTIEF LengthFunction, "LengthFunction", "11q"); EnvDefineFunction2(theEnv,"length$", 'g', PTIEF LengthFunction, "LengthFunction", "11q"); EnvDefineFunction2(theEnv,"time", 'd', PTIEF TimeFunction, "TimeFunction", "00"); EnvDefineFunction2(theEnv,"random", 'g', PTIEF RandomFunction, "RandomFunction", "02i"); EnvDefineFunction2(theEnv,"seed", 'v', PTIEF SeedFunction, "SeedFunction", "11i"); EnvDefineFunction2(theEnv,"conserve-mem", 'v', PTIEF ConserveMemCommand, "ConserveMemCommand", "11w"); EnvDefineFunction2(theEnv,"release-mem", 'g', PTIEF ReleaseMemCommand, "ReleaseMemCommand", "00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"mem-used", 'g', PTIEF MemUsedCommand, "MemUsedCommand", "00"); EnvDefineFunction2(theEnv,"mem-requests", 'g', PTIEF MemRequestsCommand, "MemRequestsCommand", "00"); #endif EnvDefineFunction2(theEnv,"options", 'v', PTIEF OptionsCommand, "OptionsCommand", "00"); EnvDefineFunction2(theEnv,"operating-system", 'w', PTIEF OperatingSystemFunction,"OperatingSystemFunction", "00"); EnvDefineFunction2(theEnv,"(expansion-call)", 'u', PTIEF ExpandFuncCall, "ExpandFuncCall",NULL); EnvDefineFunction2(theEnv,"expand$",'u', PTIEF DummyExpandFuncMultifield, "DummyExpandFuncMultifield","11m"); FuncSeqOvlFlags(theEnv,"expand$",FALSE,FALSE); EnvDefineFunction2(theEnv,"(set-evaluation-error)", 'w', PTIEF CauseEvaluationError,"CauseEvaluationError",NULL); EnvDefineFunction2(theEnv,"set-sequence-operator-recognition", 'b', PTIEF SetSORCommand,"SetSORCommand","11w"); EnvDefineFunction2(theEnv,"get-sequence-operator-recognition",'b', PTIEF EnvGetSequenceOperatorRecognition,"EnvGetSequenceOperatorRecognition","00"); EnvDefineFunction2(theEnv,"get-function-restrictions",'s', PTIEF GetFunctionRestrictions,"GetFunctionRestrictions","11w"); EnvDefineFunction2(theEnv,"create$", 'm', PTIEF CreateFunction, "CreateFunction", NULL); EnvDefineFunction2(theEnv,"mv-append", 'm', PTIEF CreateFunction, "CreateFunction", NULL); EnvDefineFunction2(theEnv,"apropos", 'v', PTIEF AproposCommand, "AproposCommand", "11w"); EnvDefineFunction2(theEnv,"get-function-list", 'm', PTIEF GetFunctionListFunction, "GetFunctionListFunction", "00"); EnvDefineFunction2(theEnv,"funcall",'u', PTIEF FuncallFunction,"FuncallFunction","1**k"); EnvDefineFunction2(theEnv,"new",'u', PTIEF NewFunction,"NewFunction","1*uw"); EnvDefineFunction2(theEnv,"call",'u', PTIEF CallFunction,"CallFunction","1*u"); EnvDefineFunction2(theEnv,"timer",'d', PTIEF TimerFunction,"TimerFunction","**"); #endif } /******************************************************************/ /* CreateFunction: H/L access routine for the create$ function. */ /******************************************************************/ globle void CreateFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StoreInMultifield(theEnv,returnValue,GetFirstArgument(),TRUE); } /*****************************************************************/ /* SetgenFunction: H/L access routine for the setgen function. */ /*****************************************************************/ globle long long SetgenFunction( void *theEnv) { long long theLong; DATA_OBJECT theValue; /*==========================================================*/ /* Check to see that a single integer argument is provided. */ /*==========================================================*/ if (EnvArgCountCheck(theEnv,"setgen",EXACTLY,1) == -1) return(MiscFunctionData(theEnv)->GensymNumber); if (EnvArgTypeCheck(theEnv,"setgen",1,INTEGER,&theValue) == FALSE) return(MiscFunctionData(theEnv)->GensymNumber); /*========================================*/ /* The integer must be greater than zero. */ /*========================================*/ theLong = ValueToLong(theValue.value); if (theLong < 1LL) { ExpectedTypeError1(theEnv,"setgen",1,"number (greater than or equal to 1)"); return(MiscFunctionData(theEnv)->GensymNumber); } /*====================================*/ /* Set the gensym index to the number */ /* provided and return this value. */ /*====================================*/ MiscFunctionData(theEnv)->GensymNumber = theLong; return(theLong); } /****************************************/ /* GensymFunction: H/L access routine */ /* for the gensym function. */ /****************************************/ globle void *GensymFunction( void *theEnv) { char genstring[128]; /*===========================================*/ /* The gensym function accepts no arguments. */ /*===========================================*/ EnvArgCountCheck(theEnv,"gensym",EXACTLY,0); /*================================================*/ /* Create a symbol using the current gensym index */ /* as the postfix. */ /*================================================*/ gensprintf(genstring,"gen%lld",MiscFunctionData(theEnv)->GensymNumber); MiscFunctionData(theEnv)->GensymNumber++; /*====================*/ /* Return the symbol. */ /*====================*/ return(EnvAddSymbol(theEnv,genstring)); } /************************************************/ /* GensymStarFunction: H/L access routine for */ /* the gensym* function. */ /************************************************/ globle void *GensymStarFunction( void *theEnv) { /*============================================*/ /* The gensym* function accepts no arguments. */ /*============================================*/ EnvArgCountCheck(theEnv,"gensym*",EXACTLY,0); /*====================*/ /* Return the symbol. */ /*====================*/ return(GensymStar(theEnv)); } /************************************/ /* GensymStar: C access routine for */ /* the gensym* function. */ /************************************/ globle void *GensymStar( void *theEnv) { char genstring[128]; /*=======================================================*/ /* Create a symbol using the current gensym index as the */ /* postfix. If the symbol is already present in the */ /* symbol table, then continue generating symbols until */ /* a unique symbol is found. */ /*=======================================================*/ do { gensprintf(genstring,"gen%lld",MiscFunctionData(theEnv)->GensymNumber); MiscFunctionData(theEnv)->GensymNumber++; } while (FindSymbolHN(theEnv,genstring) != NULL); /*====================*/ /* Return the symbol. */ /*====================*/ return(EnvAddSymbol(theEnv,genstring)); } /********************************************/ /* RandomFunction: H/L access routine for */ /* the random function. */ /********************************************/ globle long long RandomFunction( void *theEnv) { int argCount; long long rv; DATA_OBJECT theValue; long long begin, end; /*====================================*/ /* The random function accepts either */ /* zero or two arguments. */ /*====================================*/ argCount = EnvRtnArgCount(theEnv); if ((argCount != 0) && (argCount != 2)) { PrintErrorID(theEnv,"MISCFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Function random expected either 0 or 2 arguments\n"); } /*========================================*/ /* Return the randomly generated integer. */ /*========================================*/ rv = genrand(); if (argCount == 2) { if (EnvArgTypeCheck(theEnv,"random",1,INTEGER,&theValue) == FALSE) return(rv); begin = DOToLong(theValue); if (EnvArgTypeCheck(theEnv,"random",2,INTEGER,&theValue) == FALSE) return(rv); end = DOToLong(theValue); if (end < begin) { PrintErrorID(theEnv,"MISCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Function random expected argument #1 to be less than argument #2\n"); return(rv); } rv = begin + (rv % ((end - begin) + 1)); } return(rv); } /******************************************/ /* SeedFunction: H/L access routine for */ /* the seed function. */ /******************************************/ globle void SeedFunction( void *theEnv) { DATA_OBJECT theValue; /*==========================================================*/ /* Check to see that a single integer argument is provided. */ /*==========================================================*/ if (EnvArgCountCheck(theEnv,"seed",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"seed",1,INTEGER,&theValue) == FALSE) return; /*=============================================================*/ /* Seed the random number generator with the provided integer. */ /*=============================================================*/ genseed((int) DOToLong(theValue)); } /********************************************/ /* LengthFunction: H/L access routine for */ /* the length$ function. */ /********************************************/ globle long long LengthFunction( void *theEnv) { DATA_OBJECT item; /*====================================================*/ /* The length$ function expects exactly one argument. */ /*====================================================*/ if (EnvArgCountCheck(theEnv,"length$",EXACTLY,1) == -1) return(-1L); EnvRtnUnknown(theEnv,1,&item); /*====================================================*/ /* If the argument is a string or symbol, then return */ /* the number of characters in the argument. */ /*====================================================*/ if ((GetType(item) == STRING) || (GetType(item) == SYMBOL)) { return( (long) strlen(DOToString(item))); } /*====================================================*/ /* If the argument is a multifield value, then return */ /* the number of fields in the argument. */ /*====================================================*/ if (GetType(item) == MULTIFIELD) { return ( (long) GetDOLength(item)); } /*=============================================*/ /* If the argument wasn't a string, symbol, or */ /* multifield value, then generate an error. */ /*=============================================*/ SetEvaluationError(theEnv,TRUE); ExpectedTypeError2(theEnv,"length$",1); return(-1L); } /*******************************************/ /* ReleaseMemCommand: H/L access routine */ /* for the release-mem function. */ /*******************************************/ globle long long ReleaseMemCommand( void *theEnv) { /*================================================*/ /* The release-mem function accepts no arguments. */ /*================================================*/ if (EnvArgCountCheck(theEnv,"release-mem",EXACTLY,0) == -1) return(0LL); /*========================================*/ /* Release memory to the operating system */ /* and return the amount of memory freed. */ /*========================================*/ return(EnvReleaseMem(theEnv,-1L)); } /******************************************/ /* ConserveMemCommand: H/L access routine */ /* for the conserve-mem command. */ /******************************************/ globle void ConserveMemCommand( void *theEnv) { const char *argument; DATA_OBJECT theValue; /*===================================*/ /* The conserve-mem function expects */ /* a single symbol argument. */ /*===================================*/ if (EnvArgCountCheck(theEnv,"conserve-mem",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"conserve-mem",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); /*====================================================*/ /* If the argument is the symbol "on", then store the */ /* pretty print representation of a construct when it */ /* is defined. */ /*====================================================*/ if (strcmp(argument,"on") == 0) { EnvSetConserveMemory(theEnv,TRUE); } /*======================================================*/ /* Otherwise, if the argument is the symbol "off", then */ /* don't store the pretty print representation of a */ /* construct when it is defined. */ /*======================================================*/ else if (strcmp(argument,"off") == 0) { EnvSetConserveMemory(theEnv,FALSE); } /*=====================================================*/ /* Otherwise, generate an error since the only allowed */ /* arguments are "on" or "off." */ /*=====================================================*/ else { ExpectedTypeError1(theEnv,"conserve-mem",1,"symbol with value on or off"); return; } return; } #if DEBUGGING_FUNCTIONS /****************************************/ /* MemUsedCommand: H/L access routine */ /* for the mem-used command. */ /****************************************/ globle long long MemUsedCommand( void *theEnv) { /*=============================================*/ /* The mem-used function accepts no arguments. */ /*=============================================*/ if (EnvArgCountCheck(theEnv,"mem-used",EXACTLY,0) == -1) return(0); /*============================================*/ /* Return the amount of memory currently held */ /* (both for current use and for later use). */ /*============================================*/ return(EnvMemUsed(theEnv)); } /********************************************/ /* MemRequestsCommand: H/L access routine */ /* for the mem-requests command. */ /********************************************/ globle long long MemRequestsCommand( void *theEnv) { /*=================================================*/ /* The mem-requests function accepts no arguments. */ /*=================================================*/ if (EnvArgCountCheck(theEnv,"mem-requests",EXACTLY,0) == -1) return(0); /*==================================*/ /* Return the number of outstanding */ /* memory requests. */ /*==================================*/ return(EnvMemRequests(theEnv)); } #endif /****************************************/ /* AproposCommand: H/L access routine */ /* for the apropos command. */ /****************************************/ globle void AproposCommand( void *theEnv) { const char *argument; DATA_OBJECT argPtr; struct symbolHashNode *hashPtr = NULL; size_t theLength; /*=======================================================*/ /* The apropos command expects a single symbol argument. */ /*=======================================================*/ if (EnvArgCountCheck(theEnv,"apropos",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"apropos",1,SYMBOL,&argPtr) == FALSE) return; /*=======================================*/ /* Determine the length of the argument. */ /*=======================================*/ argument = DOToString(argPtr); theLength = strlen(argument); /*====================================================================*/ /* Print each entry in the symbol table that contains the argument as */ /* a substring. When using a non-ANSI compiler, only those strings */ /* that contain the substring starting at the beginning of the string */ /* are printed. */ /*====================================================================*/ while ((hashPtr = GetNextSymbolMatch(theEnv,argument,theLength,hashPtr,TRUE,NULL)) != NULL) { EnvPrintRouter(theEnv,WDISPLAY,ValueToString(hashPtr)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } /****************************************/ /* OptionsCommand: H/L access routine */ /* for the options command. */ /****************************************/ globle void OptionsCommand( void *theEnv) { /*===========================================*/ /* The options command accepts no arguments. */ /*===========================================*/ if (EnvArgCountCheck(theEnv,"options",EXACTLY,0) == -1) return; /*=================================*/ /* Print the state of the compiler */ /* flags for this executable. */ /*=================================*/ EnvPrintRouter(theEnv,WDISPLAY,"Machine type: "); #if GENERIC EnvPrintRouter(theEnv,WDISPLAY,"Generic "); #endif #if VAX_VMS EnvPrintRouter(theEnv,WDISPLAY,"VAX VMS "); #endif #if UNIX_V EnvPrintRouter(theEnv,WDISPLAY,"UNIX System V or 4.2BSD "); #endif #if DARWIN EnvPrintRouter(theEnv,WDISPLAY,"Darwin "); #endif #if LINUX EnvPrintRouter(theEnv,WDISPLAY,"Linux "); #endif #if UNIX_7 EnvPrintRouter(theEnv,WDISPLAY,"UNIX System III Version 7 or Sun Unix "); #endif #if MAC_XCD EnvPrintRouter(theEnv,WDISPLAY,"Apple Macintosh with Xcode"); #endif #if WIN_MVC EnvPrintRouter(theEnv,WDISPLAY,"Microsoft Windows with Microsoft Visual C++"); #endif #if WIN_GCC EnvPrintRouter(theEnv,WDISPLAY,"Microsoft Windows with DJGPP"); #endif EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Defrule construct is "); #if DEFRULE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Defmodule construct is "); #if DEFMODULE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Deftemplate construct is "); #if DEFTEMPLATE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Fact-set queries are "); #if FACT_SET_QUERIES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #if DEFTEMPLATE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY," Deffacts construct is "); #if DEFFACTS_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #endif EnvPrintRouter(theEnv,WDISPLAY,"Defglobal construct is "); #if DEFGLOBAL_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Deffunction construct is "); #if DEFFUNCTION_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Defgeneric/Defmethod constructs are "); #if DEFGENERIC_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Object System is "); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WDISPLAY," Definstances construct is "); #if DEFINSTANCES_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Instance-set queries are "); #if INSTANCE_SET_QUERIES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Binary loading of instances is "); #if BLOAD_INSTANCES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Binary saving of instances is "); #if BSAVE_INSTANCES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #endif EnvPrintRouter(theEnv,WDISPLAY,"Extended math function package is "); #if EXTENDED_MATH_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Text processing function package is "); #if TEXTPRO_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Bload capability is "); #if BLOAD_ONLY EnvPrintRouter(theEnv,WDISPLAY,"BLOAD ONLY"); #endif #if BLOAD EnvPrintRouter(theEnv,WDISPLAY,"BLOAD"); #endif #if BLOAD_AND_BSAVE EnvPrintRouter(theEnv,WDISPLAY,"BLOAD AND BSAVE"); #endif #if (! BLOAD_ONLY) && (! BLOAD) && (! BLOAD_AND_BSAVE) EnvPrintRouter(theEnv,WDISPLAY,"OFF "); #endif EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Construct compiler is "); #if CONSTRUCT_COMPILER EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"I/O function package is "); #if IO_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"String function package is "); #if STRING_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Multifield function package is "); #if MULTIFIELD_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Debugging function package is "); #if DEBUGGING_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Window Interface flag is "); #if WINDOW_INTERFACE EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Developer flag is "); #if DEVELOPER EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Run time module is "); #if RUN_TIME EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif } /***********************************************/ /* OperatingSystemFunction: H/L access routine */ /* for the operating system function. */ /***********************************************/ globle void *OperatingSystemFunction( void *theEnv) { EnvArgCountCheck(theEnv,"operating-system",EXACTLY,0); #if GENERIC return(EnvAddSymbol(theEnv,"UNKNOWN")); #endif #if VAX_VMS return(EnvAddSymbol(theEnv,"VMS")); #endif #if UNIX_V return(EnvAddSymbol(theEnv,"UNIX-V")); #endif #if UNIX_7 return(EnvAddSymbol(theEnv,"UNIX-7")); #endif #if LINUX return(EnvAddSymbol(theEnv,"LINUX")); #endif #if DARWIN return(EnvAddSymbol(theEnv,"DARWIN")); #endif #if MAC_XCD return(EnvAddSymbol(theEnv,"MAC-OS-X")); #endif #if IBM && (! WINDOW_INTERFACE) return(EnvAddSymbol(theEnv,"DOS")); #endif #if IBM && WINDOW_INTERFACE return(EnvAddSymbol(theEnv,"WINDOWS")); #endif return(EnvAddSymbol(theEnv,"UNKNOWN")); } /******************************************************************** NAME : ExpandFuncCall DESCRIPTION : This function is a wrap-around for a normal function call. It preexamines the argument expression list and expands any references to the sequence operator. It builds a copy of the function call expression with these new arguments inserted and evaluates the function call. INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Expressions alloctaed/deallocated Function called and arguments evaluated EvaluationError set on errors NOTES : None *******************************************************************/ globle void ExpandFuncCall( void *theEnv, DATA_OBJECT *result) { EXPRESSION *newargexp,*fcallexp; struct FunctionDefinition *func; /* ====================================================================== Copy the original function call's argument expression list. Look for expand$ function callsexpressions and replace those with the equivalent expressions of the expansions of evaluations of the arguments. ====================================================================== */ newargexp = CopyExpression(theEnv,GetFirstArgument()->argList); ExpandFuncMultifield(theEnv,result,newargexp,&newargexp, (void *) FindFunction(theEnv,"expand$")); /* =================================================================== Build the new function call expression with the expanded arguments. Check the number of arguments, if necessary, and call the thing. =================================================================== */ fcallexp = get_struct(theEnv,expr); fcallexp->type = GetFirstArgument()->type; fcallexp->value = GetFirstArgument()->value; fcallexp->nextArg = NULL; fcallexp->argList = newargexp; if (fcallexp->type == FCALL) { func = (struct FunctionDefinition *) fcallexp->value; if (CheckFunctionArgCount(theEnv,ValueToString(func->callFunctionName), func->restrictions,CountArguments(newargexp)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); return; } } #if DEFFUNCTION_CONSTRUCT else if (fcallexp->type == PCALL) { if (CheckDeffunctionCall(theEnv,fcallexp->value, CountArguments(fcallexp->argList)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); SetEvaluationError(theEnv,TRUE); return; } } #endif EvaluateExpression(theEnv,fcallexp,result); ReturnExpression(theEnv,fcallexp); } /*********************************************************************** NAME : DummyExpandFuncMultifield DESCRIPTION : The expansion of multifield arguments is valid only when done for a function call. All these expansions are handled by the H/L wrap-around function (expansion-call) - see ExpandFuncCall. If the H/L function, epand-multifield is ever called directly, it is an error. INPUTS : Data object buffer RETURNS : Nothing useful SIDE EFFECTS : EvaluationError set NOTES : None **********************************************************************/ globle void DummyExpandFuncMultifield( void *theEnv, DATA_OBJECT *result) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"MISCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n"); } /*********************************************************************** NAME : ExpandFuncMultifield DESCRIPTION : Recursively examines an expression and replaces PROC_EXPAND_MULTIFIELD expressions with the expanded evaluation expression of its argument INPUTS : 1) A data object result buffer 2) The expression to modify 3) The address of the expression, in case it is deleted entirely 4) The address of the H/L function expand$ RETURNS : Nothing useful SIDE EFFECTS : Expressions allocated/deallocated as necessary Evaluations performed On errors, argument expression set to call a function which causes an evaluation error when evaluated a second time by actual caller. NOTES : THIS ROUTINE MODIFIES EXPRESSIONS AT RUNTIME!! MAKE SURE THAT THE EXPRESSION PASSED IS SAFE TO CHANGE!! **********************************************************************/ static void ExpandFuncMultifield( void *theEnv, DATA_OBJECT *result, EXPRESSION *theExp, EXPRESSION **sto, void *expmult) { EXPRESSION *newexp,*top,*bot; register long i; /* 6.04 Bug Fix */ while (theExp != NULL) { if (theExp->value == expmult) { EvaluateExpression(theEnv,theExp->argList,result); ReturnExpression(theEnv,theExp->argList); if ((EvaluationData(theEnv)->EvaluationError) || (result->type != MULTIFIELD)) { theExp->argList = NULL; if ((EvaluationData(theEnv)->EvaluationError == FALSE) && (result->type != MULTIFIELD)) ExpectedTypeError2(theEnv,"expand$",1); theExp->value = (void *) FindFunction(theEnv,"(set-evaluation-error)"); EvaluationData(theEnv)->EvaluationError = FALSE; EvaluationData(theEnv)->HaltExecution = FALSE; return; } top = bot = NULL; for (i = GetpDOBegin(result) ; i <= GetpDOEnd(result) ; i++) { newexp = get_struct(theEnv,expr); newexp->type = GetMFType(result->value,i); newexp->value = GetMFValue(result->value,i); newexp->argList = NULL; newexp->nextArg = NULL; if (top == NULL) top = newexp; else bot->nextArg = newexp; bot = newexp; } if (top == NULL) { *sto = theExp->nextArg; rtn_struct(theEnv,expr,theExp); theExp = *sto; } else { bot->nextArg = theExp->nextArg; *sto = top; rtn_struct(theEnv,expr,theExp); sto = &bot->nextArg; theExp = bot->nextArg; } } else { if (theExp->argList != NULL) ExpandFuncMultifield(theEnv,result,theExp->argList,&theExp->argList,expmult); sto = &theExp->nextArg; theExp = theExp->nextArg; } } } /**************************************************************** NAME : CauseEvaluationError DESCRIPTION : Dummy function use to cause evaluation errors on a function call to generate error messages INPUTS : None RETURNS : A pointer to the FalseSymbol SIDE EFFECTS : EvaluationError set NOTES : None ****************************************************************/ globle void *CauseEvaluationError( void *theEnv) { SetEvaluationError(theEnv,TRUE); return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); } /**************************************************************** NAME : SetSORCommand DESCRIPTION : Toggles SequenceOpMode - if TRUE, multifield references are replaced with sequence expansion operators INPUTS : None RETURNS : The old value of SequenceOpMode SIDE EFFECTS : SequenceOpMode toggled NOTES : None ****************************************************************/ globle intBool SetSORCommand( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) DATA_OBJECT arg; if (EnvArgTypeCheck(theEnv,"set-sequence-operator-recognition",1,SYMBOL,&arg) == FALSE) return(ExpressionData(theEnv)->SequenceOpMode); return(EnvSetSequenceOperatorRecognition(theEnv,(arg.value == EnvFalseSymbol(theEnv)) ? FALSE : TRUE)); #else return(ExpressionData(theEnv)->SequenceOpMode); #endif } /******************************************************************** NAME : GetFunctionRestrictions DESCRIPTION : Gets DefineFunction2() restriction list for function INPUTS : None RETURNS : A string containing the function restriction codes SIDE EFFECTS : EvaluationError set on errors NOTES : None ********************************************************************/ globle void *GetFunctionRestrictions( void *theEnv) { DATA_OBJECT temp; struct FunctionDefinition *fptr; if (EnvArgTypeCheck(theEnv,"get-function-restrictions",1,SYMBOL,&temp) == FALSE) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"")); fptr = FindFunction(theEnv,DOToString(temp)); if (fptr == NULL) { CantFindItemErrorMessage(theEnv,"function",DOToString(temp)); SetEvaluationError(theEnv,TRUE); return((SYMBOL_HN *) EnvAddSymbol(theEnv,"")); } if (fptr->restrictions == NULL) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"0**")); return((SYMBOL_HN *) EnvAddSymbol(theEnv,fptr->restrictions)); } /*************************************************/ /* GetFunctionListFunction: H/L access routine */ /* for the get-function-list function. */ /*************************************************/ globle void GetFunctionListFunction( void *theEnv, DATA_OBJECT *returnValue) { struct FunctionDefinition *theFunction; struct multifield *theList; unsigned long functionCount = 0; if (EnvArgCountCheck(theEnv,"get-function-list",EXACTLY,0) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { functionCount++; } SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,functionCount); theList = (struct multifield *) EnvCreateMultifield(theEnv,functionCount); SetpValue(returnValue,(void *) theList); for (theFunction = GetFunctionList(theEnv), functionCount = 1; theFunction != NULL; theFunction = theFunction->next, functionCount++) { SetMFType(theList,functionCount,SYMBOL); SetMFValue(theList,functionCount,theFunction->callFunctionName); } } /***************************************/ /* FuncallFunction: H/L access routine */ /* for the funcall function. */ /***************************************/ globle void FuncallFunction( void *theEnv, DATA_OBJECT *returnValue) { int argCount, i, j; DATA_OBJECT theValue; FUNCTION_REFERENCE theReference; const char *name; struct multifield *theMultifield; struct expr *lastAdd = NULL, *nextAdd, *multiAdd; struct FunctionDefinition *theFunction; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=================================================*/ /* The funcall function has at least one argument: */ /* the name of the function being called. */ /*=================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return; /*============================================*/ /* Get the name of the function to be called. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE) { return; } /*====================*/ /* Find the function. */ /*====================*/ name = DOToString(theValue); if (! GetFunctionReference(theEnv,name,&theReference)) { ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name"); return; } /*====================================*/ /* Functions with specialized parsers */ /* cannot be used with funcall. */ /*====================================*/ if (theReference.type == FCALL) { theFunction = FindFunction(theEnv,name); if (theFunction->parser != NULL) { ExpectedTypeError1(theEnv,"funcall",1,"function without specialized parser"); return; } } /*======================================*/ /* Add the arguments to the expression. */ /*======================================*/ ExpressionInstall(theEnv,&theReference); for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theValue); if (GetEvaluationError(theEnv)) { ExpressionDeinstall(theEnv,&theReference); return; } switch(GetType(theValue)) { case MULTIFIELD: nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; multiAdd = NULL; theMultifield = (struct multifield *) GetValue(theValue); for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++) { nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j)); if (multiAdd == NULL) { lastAdd->argList = nextAdd; } else { multiAdd->nextArg = nextAdd; } multiAdd = nextAdd; } ExpressionInstall(theEnv,lastAdd); break; default: nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue)); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; ExpressionInstall(theEnv,lastAdd); break; } } /*===========================================================*/ /* Verify a deffunction has the correct number of arguments. */ /*===========================================================*/ #if DEFFUNCTION_CONSTRUCT if (theReference.type == PCALL) { if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE) { PrintErrorID(theEnv,"MISCFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value)); EnvPrintRouter(theEnv,WERROR,"\n"); ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); return; } } #endif /*======================*/ /* Call the expression. */ /*======================*/ EvaluateExpression(theEnv,&theReference,returnValue); /*========================================*/ /* Return the expression data structures. */ /*========================================*/ ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); } /***********************************/ /* NewFunction: H/L access routine */ /* for the new function. */ /***********************************/ globle void NewFunction( void *theEnv, DATA_OBJECT *returnValue) { int theType; DATA_OBJECT theValue; const char *name; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*================================================================*/ /* The new function has at least two arguments: the language type */ /* of the class (e.g. java, .net, c++) and the name of the class. */ /*================================================================*/ if (EnvArgCountCheck(theEnv,"new",AT_LEAST,1) == -1) return; /*====================================*/ /* Get the name of the language type. */ /*====================================*/ if (EnvArgTypeCheck(theEnv,"new",1,SYMBOL,&theValue) == FALSE) { return; } /*=========================*/ /* Find the language type. */ /*=========================*/ name = DOToString(theValue); theType = FindLanguageType(theEnv,name); if (theType == -1) { ExpectedTypeError1(theEnv,"new",1,"external language"); return; } /*====================================================*/ /* Invoke the new function for the specific language. */ /*====================================================*/ if ((EvaluationData(theEnv)->ExternalAddressTypes[theType] != NULL) && (EvaluationData(theEnv)->ExternalAddressTypes[theType]->newFunction != NULL)) { (*EvaluationData(theEnv)->ExternalAddressTypes[theType]->newFunction)(theEnv,returnValue); } } /************************************/ /* CallFunction: H/L access routine */ /* for the new function. */ /************************************/ globle void CallFunction( void *theEnv, DATA_OBJECT *returnValue) { int theType; DATA_OBJECT theValue; const char *name; int argumentCount; struct externalAddressHashNode *theEA; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=====================================================*/ /* The call function has at least one argument: either */ /* an external address or the language type of the */ /* method being called (e.g. java, .net, c++). */ /*=====================================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"call",AT_LEAST,1)) == -1) return; /*=========================*/ /* Get the first argument. */ /*=========================*/ EnvRtnUnknown(theEnv,1,&theValue); /*============================================*/ /* If the first argument is a symbol, then it */ /* should be an external language type. */ /*============================================*/ if (GetType(theValue) == SYMBOL) { name = DOToString(theValue); theType = FindLanguageType(theEnv,name); if (theType == -1) { ExpectedTypeError1(theEnv,"call",1,"external language symbol or external address"); return; } /*====================================================================*/ /* Invoke the call function for the specific language. Typically this */ /* will invoke a static method of a class (specified with the third */ /* and second arguments to the call function. */ /*====================================================================*/ if ((EvaluationData(theEnv)->ExternalAddressTypes[theType] != NULL) && (EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction != NULL)) { (*EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction)(theEnv,&theValue,returnValue); } return; } /*===============================================*/ /* If the first argument is an external address, */ /* then we can determine the external language */ /* type be examining the pointer. */ /*===============================================*/ if (GetType(theValue) == EXTERNAL_ADDRESS) { theEA = (struct externalAddressHashNode *) GetValue(theValue); theType = theEA->type; if ((EvaluationData(theEnv)->ExternalAddressTypes[theType] != NULL) && (EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction != NULL)) { (*EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction)(theEnv,&theValue,returnValue); } return; } ExpectedTypeError1(theEnv,"call",1,"external language symbol or external address"); } /************************************/ /* FindLanguageType: */ /************************************/ static int FindLanguageType( void *theEnv, const char *languageName) { int theType; for (theType = 0; theType < EvaluationData(theEnv)->numberOfAddressTypes; theType++) { if (strcmp(EvaluationData(theEnv)->ExternalAddressTypes[theType]->name,languageName) == 0) { return(theType); } } return -1; } /************************************/ /* TimeFunction: H/L access routine */ /* for the time function. */ /************************************/ globle double TimeFunction( void *theEnv) { /*=========================================*/ /* The time function accepts no arguments. */ /*=========================================*/ EnvArgCountCheck(theEnv,"time",EXACTLY,0); /*==================*/ /* Return the time. */ /*==================*/ return(gentime()); } /***************************************/ /* TimerFunction: H/L access routine */ /* for the timer function. */ /***************************************/ globle double TimerFunction( void *theEnv) { int numa, i; double startTime; DATA_OBJECT returnValue; startTime = gentime(); numa = EnvRtnArgCount(theEnv); i = 1; while ((i <= numa) && (GetHaltExecution(theEnv) != TRUE)) { EnvRtnUnknown(theEnv,i,&returnValue); i++; } return(gentime() - startTime); } clips_core_source_630/core/genrcexe.c0000755000175000017500000006554212373753405016222 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Execution Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Support for long long integers. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT #include #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #include "insfun.h" #endif #include "argacces.h" #include "constrct.h" #include "envrnmnt.h" #include "genrccom.h" #include "prcdrfun.h" #include "prccode.h" #include "proflfun.h" #include "router.h" #include "utility.h" #define _GENRCEXE_SOURCE_ #include "genrcexe.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BEGIN_TRACE ">>" #define END_TRACE "<<" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static DEFMETHOD *FindApplicableMethod(void *,DEFGENERIC *,DEFMETHOD *); #if DEBUGGING_FUNCTIONS static void WatchGeneric(void *,const char *); static void WatchMethod(void *,const char *); #endif #if OBJECT_SYSTEM static DEFCLASS *DetermineRestrictionClass(void *,DATA_OBJECT *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************************** NAME : GenericDispatch DESCRIPTION : Executes the most specific applicable method INPUTS : 1) The generic function 2) The method to start after in the search for an applicable method (ignored if arg #3 is not NULL). 3) A specific method to call (NULL if want highest precedence method to be called) 4) The generic function argument expressions 5) The caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments Any side-effects of evaluating query functions on method parameter restrictions when determining the core (see warning #1) Any side-effects of actual execution of methods (see warning #2) Caller's buffer set to the result of the generic function call In case of errors, the result is FALSE, otherwise it is the result returned by the most specific method (which can choose to ignore or return the values of more general methods) NOTES : WARNING #1: Query functions on method parameter restrictions should not have side-effects, for they might be evaluated even for methods that aren't applicable to the generic function call. WARNING #2: Side-effects of method execution should not always rely on only being executed once per generic function call. Every time a method calls (shadow-call) the same next-most-specific method is executed. Thus, it is possible for a method to be executed multiple times per generic function call. ***********************************************************************************/ globle void GenericDispatch( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *prevmeth, DEFMETHOD *meth, EXPRESSION *params, DATA_OBJECT *result) { DEFGENERIC *previousGeneric; DEFMETHOD *previousMethod; int oldce; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; previousMethod = DefgenericData(theEnv)->CurrentMethod; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; gfunc->busy++; PushProcParameters(theEnv,params,CountArguments(params), EnvGetDefgenericName(theEnv,(void *) gfunc), "generic function",UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { gfunc->busy--; DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } if (meth != NULL) { if (IsMethodApplicable(theEnv,meth)) { meth->busy++; DefgenericData(theEnv)->CurrentMethod = meth; } else { PrintErrorID(theEnv,"GENRCEXE",4,FALSE); SetEvaluationError(theEnv,TRUE); DefgenericData(theEnv)->CurrentMethod = NULL; EnvPrintRouter(theEnv,WERROR,"Generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long long) meth->index); EnvPrintRouter(theEnv,WERROR," is not applicable to the given arguments.\n"); } } else DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth); if (DefgenericData(theEnv)->CurrentMethod != NULL) { #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,BEGIN_TRACE); if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { EXPRESSION fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,result); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentMethod->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, result,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,END_TRACE); #endif } else if (! EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"GENRCEXE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No applicable methods for "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } gfunc->busy--; ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); } /******************************************************* NAME : UnboundMethodErr DESCRIPTION : Print out a synopis of the currently executing method for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None *******************************************************/ globle void UnboundMethodErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long long) DefgenericData(theEnv)->CurrentMethod->index); EnvPrintRouter(theEnv,WERROR,".\n"); } /*********************************************************************** NAME : IsMethodApplicable DESCRIPTION : Tests to see if a method satsifies the arguments of a generic function A method is applicable if all its restrictions are satisfied by the corresponding arguments INPUTS : The method address RETURNS : TRUE if method is applicable, FALSE otherwise SIDE EFFECTS : Any query functions are evaluated NOTES : Uses globals ProcParamArraySize and ProcParamArray ***********************************************************************/ globle intBool IsMethodApplicable( void *theEnv, DEFMETHOD *meth) { DATA_OBJECT temp; short i,j,k; register RESTRICTION *rp; #if OBJECT_SYSTEM void *type; #else int type; #endif if ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize < meth->minRestrictions) || ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize > meth->minRestrictions) && (meth->maxRestrictions != -1))) return(FALSE); for (i = 0 , k = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { rp = &meth->restrictions[k]; if (rp->tcnt != 0) { #if OBJECT_SYSTEM type = (void *) DetermineRestrictionClass(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]); if (type == NULL) return(FALSE); for (j = 0 ; j < rp->tcnt ; j++) { if (type == rp->types[j]) break; if (HasSuperclass((DEFCLASS *) type,(DEFCLASS *) rp->types[j])) break; if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS) break; } else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME) break; } else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]) { if ((ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME) || (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS)) break; } } #else type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type; for (j = 0 ; j < rp->tcnt ; j++) { if (type == ValueToInteger(rp->types[j])) break; if (SubsumeType(type,ValueToInteger(rp->types[j]))) break; } #endif if (j == rp->tcnt) return(FALSE); } if (rp->query != NULL) { DefgenericData(theEnv)->GenericCurrentArgument = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i]; EvaluateExpression(theEnv,rp->query,&temp); if ((temp.type != SYMBOL) ? FALSE : (temp.value == EnvFalseSymbol(theEnv))) return(FALSE); } if (((int) k) != meth->restrictionCount-1) k++; } return(TRUE); } /*************************************************** NAME : NextMethodP DESCRIPTION : Determines if a shadowed generic function method is available for execution INPUTS : None RETURNS : TRUE if there is a method available, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax: (next-methodp) ***************************************************/ globle int NextMethodP( void *theEnv) { register DEFMETHOD *meth; if (DefgenericData(theEnv)->CurrentMethod == NULL) return(FALSE); meth = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod); if (meth != NULL) { meth->busy--; return(TRUE); } return(FALSE); } /**************************************************** NAME : CallNextMethod DESCRIPTION : Executes the next available method in the core for a generic function INPUTS : Caller's buffer for the result RETURNS : Nothing useful SIDE EFFECTS : Side effects of execution of shadow EvaluationError set if no method is available to execute. NOTES : H/L Syntax: (call-next-method) ****************************************************/ globle void CallNextMethod( void *theEnv, DATA_OBJECT *result) { DEFMETHOD *oldMethod; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EvaluationData(theEnv)->HaltExecution) return; oldMethod = DefgenericData(theEnv)->CurrentMethod; if (DefgenericData(theEnv)->CurrentMethod != NULL) DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod); if (DefgenericData(theEnv)->CurrentMethod == NULL) { DefgenericData(theEnv)->CurrentMethod = oldMethod; PrintErrorID(theEnv,"GENRCEXE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n"); SetEvaluationError(theEnv,TRUE); return; } #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { EXPRESSION fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,result); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentGeneric->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, result,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); #endif DefgenericData(theEnv)->CurrentMethod = oldMethod; ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; } /************************************************************************** NAME : CallSpecificMethod DESCRIPTION : Allows a specific method to be called without regards to higher precedence methods which might also be applicable However, shadowed methods can still be called. INPUTS : A data object buffer to hold the method evaluation result RETURNS : Nothing useful SIDE EFFECTS : Side-effects of method applicability tests and the evaluation of methods NOTES : H/L Syntax: (call-specific-method ) **************************************************************************/ globle void CallSpecificMethod( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT temp; DEFGENERIC *gfunc; int mi; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"call-specific-method",1,SYMBOL,&temp) == FALSE) return; gfunc = CheckGenericExists(theEnv,"call-specific-method",DOToString(temp)); if (gfunc == NULL) return; if (EnvArgTypeCheck(theEnv,"call-specific-method",2,INTEGER,&temp) == FALSE) return; mi = CheckMethodExists(theEnv,"call-specific-method",gfunc,(long) DOToLong(temp)); if (mi == -1) return; gfunc->methods[mi].busy++; GenericDispatch(theEnv,gfunc,NULL,&gfunc->methods[mi], GetFirstArgument()->nextArg->nextArg,result); gfunc->methods[mi].busy--; } /*********************************************************************** NAME : OverrideNextMethod DESCRIPTION : Changes the arguments to shadowed methods, thus the set of applicable methods to this call may change INPUTS : A buffer to hold the result of the call RETURNS : Nothing useful SIDE EFFECTS : Any of evaluating method restrictions and bodies NOTES : H/L Syntax: (override-next-method ) ***********************************************************************/ globle void OverrideNextMethod( void *theEnv, DATA_OBJECT *result) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EvaluationData(theEnv)->HaltExecution) return; if (DefgenericData(theEnv)->CurrentMethod == NULL) { PrintErrorID(theEnv,"GENRCEXE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n"); SetEvaluationError(theEnv,TRUE); return; } GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL, GetFirstArgument(),result); } /*********************************************************** NAME : GetGenericCurrentArgument DESCRIPTION : Returns the value of the generic function argument being tested in the method applicability determination process INPUTS : A data-object buffer RETURNS : Nothing useful SIDE EFFECTS : Data-object set NOTES : Useful for queries in wildcard restrictions ***********************************************************/ globle void GetGenericCurrentArgument( void *theEnv, DATA_OBJECT *result) { result->type = DefgenericData(theEnv)->GenericCurrentArgument->type; result->value = DefgenericData(theEnv)->GenericCurrentArgument->value; result->begin = DefgenericData(theEnv)->GenericCurrentArgument->begin; result->end = DefgenericData(theEnv)->GenericCurrentArgument->end; } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************ NAME : FindApplicableMethod DESCRIPTION : Finds the first/next applicable method for a generic function call INPUTS : 1) The generic function pointer 2) The address of the current method (NULL to find the first) RETURNS : The address of the first/next applicable method (NULL on errors) SIDE EFFECTS : Any from evaluating query restrictions Methoid busy count incremented if applicable NOTES : None ************************************************************/ static DEFMETHOD *FindApplicableMethod( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { if (meth != NULL) meth++; else meth = gfunc->methods; for ( ; meth < &gfunc->methods[gfunc->mcnt] ; meth++) { meth->busy++; if (IsMethodApplicable(theEnv,meth)) return(meth); meth->busy--; } return(NULL); } #if DEBUGGING_FUNCTIONS /********************************************************************** NAME : WatchGeneric DESCRIPTION : Prints out a trace of the beginning or end of the execution of a generic function INPUTS : A string to indicate beginning or end of execution RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the globals CurrentGeneric, ProcParamArraySize and ProcParamArray for other trace info **********************************************************************/ static void WatchGeneric( void *theEnv, const char *tstring) { EnvPrintRouter(theEnv,WTRACE,"GNC "); EnvPrintRouter(theEnv,WTRACE,tstring); EnvPrintRouter(theEnv,WTRACE," "); if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule)); EnvPrintRouter(theEnv,WTRACE,"::"); } EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name)); EnvPrintRouter(theEnv,WTRACE," "); EnvPrintRouter(theEnv,WTRACE," ED:"); PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,WTRACE); } /********************************************************************** NAME : WatchMethod DESCRIPTION : Prints out a trace of the beginning or end of the execution of a generic function method INPUTS : A string to indicate beginning or end of execution RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the globals CurrentGeneric, CurrentMethod, ProcParamArraySize and ProcParamArray for other trace info **********************************************************************/ static void WatchMethod( void *theEnv, const char *tstring) { EnvPrintRouter(theEnv,WTRACE,"MTH "); EnvPrintRouter(theEnv,WTRACE,tstring); EnvPrintRouter(theEnv,WTRACE," "); if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule)); EnvPrintRouter(theEnv,WTRACE,"::"); } EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name)); EnvPrintRouter(theEnv,WTRACE,":#"); if (DefgenericData(theEnv)->CurrentMethod->system) EnvPrintRouter(theEnv,WTRACE,"SYS"); PrintLongInteger(theEnv,WTRACE,(long long) DefgenericData(theEnv)->CurrentMethod->index); EnvPrintRouter(theEnv,WTRACE," "); EnvPrintRouter(theEnv,WTRACE," ED:"); PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,WTRACE); } #endif #if OBJECT_SYSTEM /*************************************************** NAME : DetermineRestrictionClass DESCRIPTION : Finds the class of an argument in the ProcParamArray INPUTS : The argument data object RETURNS : The class address, NULL if error SIDE EFFECTS : EvaluationError set on errors NOTES : None ***************************************************/ static DEFCLASS *DetermineRestrictionClass( void *theEnv, DATA_OBJECT *dobj) { INSTANCE_TYPE *ins; DEFCLASS *cls; if (dobj->type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) dobj->value); cls = (ins != NULL) ? ins->cls : NULL; } else if (dobj->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) dobj->value; cls = (ins->garbage == 0) ? ins->cls : NULL; } else return(DefclassData(theEnv)->PrimitiveClassMap[dobj->type]); if (cls == NULL) { SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"GENRCEXE",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to determine class of "); PrintDataObject(theEnv,WERROR,dobj); EnvPrintRouter(theEnv,WERROR," in generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric)); EnvPrintRouter(theEnv,WERROR,".\n"); } return(cls); } #endif #endif clips_core_source_630/core/factgen.h0000755000175000017500000002026212373742656016032 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT RETE FUNCTION GENERATION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Support for performance optimizations. */ /* */ /* Increased maximum values for pattern/slot */ /* indices. */ /* */ /*************************************************************/ #ifndef _H_factgen #define _H_factgen #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTGEN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /**********************************************************/ /* factGetVarPN1Call: This structure is used to store the */ /* arguments to the most general extraction routine for */ /* retrieving a variable from the fact pattern network. */ /**********************************************************/ struct factGetVarPN1Call { unsigned int factAddress : 1; unsigned int allFields : 1; unsigned short whichField; unsigned short whichSlot; }; /***********************************************************/ /* factGetVarPN2Call: This structure is used to store the */ /* arguments to the most specific extraction routine for */ /* retrieving a variable from the fact pattern network. */ /* It is used for retrieving the single value stored in */ /* a single field slot (the slot index can be used to */ /* directly to retrieve the value from the fact array). */ /***********************************************************/ struct factGetVarPN2Call { unsigned short whichSlot; }; /**********************************************************/ /* factGetVarPN3Call: */ /**********************************************************/ struct factGetVarPN3Call { unsigned int fromBeginning : 1; unsigned int fromEnd : 1; unsigned short beginOffset; unsigned short endOffset; unsigned short whichSlot; }; /**************************************************************/ /* factConstantPN1Call: Used for testing for a constant value */ /* in the fact pattern network. Compare the value of a */ /* single field slot to a constant. */ /**************************************************************/ struct factConstantPN1Call { unsigned int testForEquality : 1; unsigned short whichSlot; }; /******************************************************************/ /* factConstantPN2Call: Used for testing for a constant value in */ /* the fact pattern network. Compare the value of a multifield */ /* slot to a constant (where the value retrieved for comparison */ /* from the slot contains no multifields before or only one */ /* multifield before and none after). */ /******************************************************************/ struct factConstantPN2Call { unsigned int testForEquality : 1; unsigned int fromBeginning : 1; unsigned short offset; unsigned short whichSlot; }; /**********************************************************/ /* factGetVarJN1Call: This structure is used to store the */ /* arguments to the most general extraction routine for */ /* retrieving a fact variable from the join network. */ /**********************************************************/ struct factGetVarJN1Call { unsigned int factAddress : 1; unsigned int allFields : 1; unsigned int lhs : 1; unsigned int rhs : 1; unsigned short whichPattern; unsigned short whichSlot; unsigned short whichField; }; /**********************************************************/ /* factGetVarJN2Call: */ /**********************************************************/ struct factGetVarJN2Call { unsigned int lhs : 1; unsigned int rhs : 1; unsigned short whichPattern; unsigned short whichSlot; }; /**********************************************************/ /* factGetVarJN3Call: */ /**********************************************************/ struct factGetVarJN3Call { unsigned int fromBeginning : 1; unsigned int fromEnd : 1; unsigned int lhs : 1; unsigned int rhs : 1; unsigned short beginOffset; unsigned short endOffset; unsigned short whichPattern; unsigned short whichSlot; }; /**********************************************************/ /* factCompVarsPN1Call: */ /**********************************************************/ struct factCompVarsPN1Call { unsigned int pass : 1; unsigned int fail : 1; unsigned short field1; unsigned short field2; }; /**********************************************************/ /* factCompVarsJN1Call: */ /**********************************************************/ struct factCompVarsJN1Call { unsigned int pass : 1; unsigned int fail : 1; unsigned int p1lhs: 1; unsigned int p1rhs: 1; unsigned int p2lhs: 1; unsigned int p2rhs: 1; unsigned short pattern1; unsigned short pattern2; unsigned short slot1; unsigned short slot2; }; /**********************************************************/ /* factCompVarsJN2Call: */ /**********************************************************/ struct factCompVarsJN2Call { unsigned int pass : 1; unsigned int fail : 1; unsigned int p1lhs: 1; unsigned int p1rhs: 1; unsigned int p2lhs: 1; unsigned int p2rhs: 1; unsigned int fromBeginning1 : 1; unsigned int fromBeginning2 : 1; unsigned short offset1; unsigned short offset2; unsigned short pattern1; unsigned short pattern2; unsigned short slot1; unsigned short slot2; }; /**********************************************************/ /* factCheckLengthPNCall: This structure is used to store */ /* the arguments to the routine for determining if the */ /* length of a multifield slot is equal or greater than */ /* a specified value. */ /**********************************************************/ struct factCheckLengthPNCall { unsigned int exactly : 1; unsigned short minLength; unsigned short whichSlot; }; /****************************************/ /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */ /****************************************/ LOCALE void InitializeFactReteFunctions(void *); LOCALE struct expr *FactPNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *); LOCALE struct expr *FactJNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *,int); LOCALE void FactReplaceGetvar(void *,struct expr *,struct lhsParseNode *,int); LOCALE void FactReplaceGetfield(void *,struct expr *,struct lhsParseNode *); LOCALE struct expr *FactGenPNConstant(void *,struct lhsParseNode *); LOCALE struct expr *FactGenGetfield(void *,struct lhsParseNode *); LOCALE struct expr *FactGenGetvar(void *,struct lhsParseNode *,int); LOCALE struct expr *FactGenCheckLength(void *,struct lhsParseNode *); LOCALE struct expr *FactGenCheckZeroLength(void *,unsigned); #endif /* _H_factgen */ clips_core_source_630/core/tmpltbsc.h0000755000175000017500000001106112373754237016246 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deftemplate */ /* construct such as clear, reset, save, undeftemplate, */ /* ppdeftemplate, list-deftemplates, and */ /* get-deftemplate-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings */ /* when ENVIRONMENT_API_ONLY flag is set. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_tmpltbsc #define _H_tmpltbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeftemplateBasicCommands(void *); LOCALE void UndeftemplateCommand(void *); LOCALE intBool EnvUndeftemplate(void *,void *); LOCALE void GetDeftemplateListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDeftemplateList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DeftemplateModuleFunction(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDeftemplateCommand(void *); LOCALE int PPDeftemplate(void *,const char *,const char *); LOCALE void ListDeftemplatesCommand(void *); LOCALE void EnvListDeftemplates(void *,const char *,void *); LOCALE unsigned EnvGetDeftemplateWatch(void *,void *); LOCALE void EnvSetDeftemplateWatch(void *,unsigned,void *); LOCALE unsigned DeftemplateWatchAccess(void *,int,unsigned,struct expr *); LOCALE unsigned DeftemplateWatchPrint(void *,const char *,int,struct expr *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void GetDeftemplateList(DATA_OBJECT_PTR,void *); #if DEBUGGING_FUNCTIONS LOCALE unsigned GetDeftemplateWatch(void *); LOCALE void ListDeftemplates(const char *,void *); LOCALE void SetDeftemplateWatch(unsigned,void *); #endif LOCALE intBool Undeftemplate(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_tmpltbsc */ clips_core_source_630/core/._genrcbin.c0000755000175000017500000000040712373753415016414 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/genrcexe.h0000755000175000017500000000547712373753404016227 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Support for long long integers. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_genrcexe #define _H_genrcexe #if DEFGENERIC_CONSTRUCT #include "genrcfun.h" #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCEXE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void GenericDispatch(void *,DEFGENERIC *,DEFMETHOD *,DEFMETHOD *,EXPRESSION *,DATA_OBJECT *); LOCALE void UnboundMethodErr(void *); LOCALE intBool IsMethodApplicable(void *,DEFMETHOD *); LOCALE int NextMethodP(void *); LOCALE void CallNextMethod(void *,DATA_OBJECT *); LOCALE void CallSpecificMethod(void *,DATA_OBJECT *); LOCALE void OverrideNextMethod(void *,DATA_OBJECT *); LOCALE void GetGenericCurrentArgument(void *,DATA_OBJECT *); #endif /* DEFGENERIC_CONSTRUCT */ #endif /* _H_genrcexe */ clips_core_source_630/core/crstrtgy.c0000755000175000017500000011253012375756151016274 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* CONFLICT RESOLUTION STRATEGY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Used to determine where a new activation is */ /* placed on the agenda based on the current conflict */ /* resolution strategy (depth, breadth, mea, lex, */ /* simplicity, or complexity). Also provides the */ /* set-strategy and get-strategy commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /* 6.30: Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /* Removed pseudo-facts used for not CEs. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _CRSTRTGY_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "constant.h" #include "pattern.h" #include "reteutil.h" #include "argacces.h" #include "agenda.h" #include "envrnmnt.h" #include "memalloc.h" #include "crstrtgy.h" #define GetMatchingItem(x,i) ((x->basis->binds[i].gm.theMatch != NULL) ? \ (x->basis->binds[i].gm.theMatch->matchingItem) : NULL) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static ACTIVATION *PlaceDepthActivation(ACTIVATION *,struct salienceGroup *); static ACTIVATION *PlaceBreadthActivation(ACTIVATION *,struct salienceGroup *); static ACTIVATION *PlaceLEXActivation(void *,ACTIVATION *,struct salienceGroup *); static ACTIVATION *PlaceMEAActivation(void *,ACTIVATION *,struct salienceGroup *); static ACTIVATION *PlaceComplexityActivation(ACTIVATION *,struct salienceGroup *); static ACTIVATION *PlaceSimplicityActivation(ACTIVATION *,struct salienceGroup *); static ACTIVATION *PlaceRandomActivation(ACTIVATION *,struct salienceGroup *); static int ComparePartialMatches(void *,ACTIVATION *,ACTIVATION *); static const char *GetStrategyName(int); static unsigned long long *SortPartialMatch(void *,struct partialMatch *); /******************************************************************/ /* PlaceActivation: Coordinates placement of an activation on the */ /* Agenda based on the current conflict resolution strategy. */ /******************************************************************/ globle void PlaceActivation( void *theEnv, ACTIVATION **whichAgenda, ACTIVATION *newActivation, struct salienceGroup *theGroup) { ACTIVATION *placeAfter = NULL; /*================================================*/ /* Set the flag which indicates that a change has */ /* been made to the agenda. */ /*================================================*/ EnvSetAgendaChanged(theEnv,TRUE); /*=============================================*/ /* Determine the location where the activation */ /* should be placed in the agenda based on the */ /* current conflict resolution strategy. */ /*==============================================*/ if (*whichAgenda != NULL) { switch (AgendaData(theEnv)->Strategy) { case DEPTH_STRATEGY: placeAfter = PlaceDepthActivation(newActivation,theGroup); break; case BREADTH_STRATEGY: placeAfter = PlaceBreadthActivation(newActivation,theGroup); break; case LEX_STRATEGY: placeAfter = PlaceLEXActivation(theEnv,newActivation,theGroup); break; case MEA_STRATEGY: placeAfter = PlaceMEAActivation(theEnv,newActivation,theGroup); break; case COMPLEXITY_STRATEGY: placeAfter = PlaceComplexityActivation(newActivation,theGroup); break; case SIMPLICITY_STRATEGY: placeAfter = PlaceSimplicityActivation(newActivation,theGroup); break; case RANDOM_STRATEGY: placeAfter = PlaceRandomActivation(newActivation,theGroup); break; } } else { theGroup->first = newActivation; theGroup->last = newActivation; } /*==============================================================*/ /* Place the activation at the appropriate place in the agenda. */ /*==============================================================*/ if (placeAfter == NULL) /* then place it at the beginning of then agenda. */ { newActivation->next = *whichAgenda; *whichAgenda = newActivation; if (newActivation->next != NULL) newActivation->next->prev = newActivation; } else /* insert it in the agenda. */ { newActivation->next = placeAfter->next; newActivation->prev = placeAfter; placeAfter->next = newActivation; if (newActivation->next != NULL) { newActivation->next->prev = newActivation; } } } /*******************************************************************/ /* PlaceDepthActivation: Determines the location in the agenda */ /* where a new activation should be placed for the depth */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceDepthActivation( ACTIVATION *newActivation, struct salienceGroup *theGroup) { ACTIVATION *lastAct, *actPtr; unsigned long long timetag; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed before */ /* activations with an equal or lower timetag (yielding */ /* depth first traversal). */ /*=========================================================*/ actPtr = theGroup->first; while (actPtr != NULL) { if (timetag < actPtr->timetag) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else { break; } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceBreadthActivation: Determines the location in the agenda */ /* where a new activation should be placed for the breadth */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceBreadthActivation( ACTIVATION *newActivation, struct salienceGroup *theGroup) { unsigned long long timetag; ACTIVATION *lastAct, *actPtr; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; if (theGroup->last == NULL) { if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } } else { lastAct = theGroup->last; } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed after */ /* activations with a lessor timetag (yielding breadth */ /* first traversal). */ /*=========================================================*/ actPtr = theGroup->last; while (actPtr != NULL) { if (timetag < actPtr->timetag) { if (actPtr == theGroup->first) { if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } break; } else { actPtr = actPtr->prev; } } else { lastAct = actPtr; break; } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceLEXActivation: Determines the location in the agenda */ /* where a new activation should be placed for the lex */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceLEXActivation( void *theEnv, ACTIVATION *newActivation, struct salienceGroup *theGroup) { unsigned long long timetag; ACTIVATION *lastAct, *actPtr; int flag; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } /*================================================*/ /* Look first at the very end of the group to see */ /* if the activation should be placed there. */ /*================================================*/ actPtr = theGroup->last; if (actPtr != NULL) { flag = ComparePartialMatches(theEnv,actPtr,newActivation); if ((flag == LESS_THAN) || ((flag == EQUAL) && (timetag > actPtr->timetag))) { theGroup->last = newActivation; return(actPtr); } } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the OPS5 lex strategy is used for */ /* determining placement. */ /*=========================================================*/ actPtr = theGroup->first; while (actPtr != NULL) { flag = ComparePartialMatches(theEnv,actPtr,newActivation); if (flag == LESS_THAN) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else if (flag == GREATER_THAN) { break; } else /* flag == EQUAL */ { if (timetag > actPtr->timetag) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else { break; } } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceMEAActivation: Determines the location in the agenda */ /* where a new activation should be placed for the mea */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceMEAActivation( void *theEnv, ACTIVATION *newActivation, struct salienceGroup *theGroup) { unsigned long long timetag; ACTIVATION *lastAct, *actPtr; int flag; long long cWhoset = 0, oWhoset = 0; intBool cSet, oSet; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } /*================================================*/ /* Look first at the very end of the group to see */ /* if the activation should be placed there. */ /*================================================*/ actPtr = theGroup->last; if (actPtr != NULL) { if (GetMatchingItem(newActivation,0) != NULL) { cWhoset = GetMatchingItem(newActivation,0)->timeTag; cSet = TRUE; } else { cSet = FALSE; } if (GetMatchingItem(actPtr,0) != NULL) { oWhoset = GetMatchingItem(actPtr,0)->timeTag; oSet = TRUE; } else { oSet = FALSE; } if ((cSet == FALSE) && (oSet == FALSE)) { flag = ComparePartialMatches(theEnv,actPtr,newActivation); } else if ((cSet == TRUE) && (oSet == FALSE)) { flag = GREATER_THAN; } else if ((cSet == FALSE) && (oSet == TRUE)) { flag = LESS_THAN; } else if (oWhoset < cWhoset) { flag = GREATER_THAN; } else if (oWhoset > cWhoset) { flag = LESS_THAN; } else { flag = ComparePartialMatches(theEnv,actPtr,newActivation); } if ((flag == LESS_THAN) || ((flag == EQUAL) && (timetag > actPtr->timetag))) { theGroup->last = newActivation; return(actPtr); } } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the OPS5 mea strategy is used for */ /* determining placement. */ /*=========================================================*/ actPtr = theGroup->first; while (actPtr != NULL) { cWhoset = -1; oWhoset = -1; if (GetMatchingItem(newActivation,0) != NULL) { cWhoset = GetMatchingItem(newActivation,0)->timeTag; } if (GetMatchingItem(actPtr,0) != NULL) { oWhoset = GetMatchingItem(actPtr,0)->timeTag; } if (oWhoset < cWhoset) { if (cWhoset > 0) flag = GREATER_THAN; else flag = LESS_THAN; } else if (oWhoset > cWhoset) { if (oWhoset > 0) flag = LESS_THAN; else flag = GREATER_THAN; } else { flag = ComparePartialMatches(theEnv,actPtr,newActivation); } if (flag == LESS_THAN) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else if (flag == GREATER_THAN) { break; } else /* flag == EQUAL */ { if (timetag > actPtr->timetag) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else { break; } } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*********************************************************************/ /* PlaceComplexityActivation: Determines the location in the agenda */ /* where a new activation should be placed for the complexity */ /* strategy. Returns a pointer to the activation after which the */ /* new activation should be placed (or NULL if the activation */ /* should be placed at the beginning of the agenda). */ /*********************************************************************/ static ACTIVATION *PlaceComplexityActivation( ACTIVATION *newActivation, struct salienceGroup *theGroup) { int complexity; unsigned long long timetag; ACTIVATION *lastAct, *actPtr; /*========================================*/ /* Set up initial information for search. */ /*========================================*/ timetag = newActivation->timetag; complexity = newActivation->theRule->complexity; if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed before */ /* activations of equal or lessor complexity. */ /*=========================================================*/ actPtr = theGroup->first; while (actPtr != NULL) { if (complexity < (int) actPtr->theRule->complexity) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else if (complexity > (int) actPtr->theRule->complexity) { break; } else if (timetag > actPtr->timetag) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else { break; } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*********************************************************************/ /* PlaceSimplicityActivation: Determines the location in the agenda */ /* where a new activation should be placed for the simplicity */ /* strategy. Returns a pointer to the activation after which the */ /* new activation should be placed (or NULL if the activation */ /* should be placed at the beginning of the agenda). */ /*********************************************************************/ static ACTIVATION *PlaceSimplicityActivation( ACTIVATION *newActivation, struct salienceGroup *theGroup) { int complexity; unsigned long long timetag; ACTIVATION *lastAct, *actPtr; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; complexity = newActivation->theRule->complexity; if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed after */ /* activations of equal or greater complexity. */ /*=========================================================*/ actPtr = theGroup->first; while (actPtr != NULL) { if (complexity > (int) actPtr->theRule->complexity) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else if (complexity < (int) actPtr->theRule->complexity) { break; } else if (timetag > actPtr->timetag) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else { break; } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceRandomActivation: Determines the location in the agenda */ /* where a new activation should be placed for the random */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceRandomActivation( ACTIVATION *newActivation, struct salienceGroup *theGroup) { int randomID; unsigned long long timetag; ACTIVATION *lastAct, *actPtr; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; randomID = newActivation->randomID; if (theGroup->prev == NULL) { lastAct = NULL; } else { lastAct = theGroup->prev->last; } /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the placement of the activation is */ /* determined through the generation of a random number. */ /*=========================================================*/ actPtr = theGroup->first; while (actPtr != NULL) { if (randomID > actPtr->randomID) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else if (randomID < actPtr->randomID) { break; } else if (timetag > actPtr->timetag) { lastAct = actPtr; if (actPtr == theGroup->last) { break; } else { actPtr = actPtr->next; } } else { break; } } /*========================================*/ /* Update the salience group information. */ /*========================================*/ if ((lastAct == NULL) || ((theGroup->prev != NULL) && (theGroup->prev->last == lastAct))) { theGroup->first = newActivation; } if ((theGroup->last == NULL) || (theGroup->last == lastAct)) { theGroup->last = newActivation; } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*********************************************************/ /* SortPartialMatch: Creates an array of sorted timetags */ /* in ascending order from a partial match. */ /*********************************************************/ static unsigned long long *SortPartialMatch( void *theEnv, struct partialMatch *binds) { unsigned long long *nbinds; unsigned long long temp; int flag; unsigned j, k; /*====================================================*/ /* Copy the array. Use 0 to represent the timetags of */ /* negated patterns. Patterns matching fact/instances */ /* should have timetags greater than 0. */ /*====================================================*/ nbinds = (unsigned long long *) get_mem(theEnv,sizeof(long long) * binds->bcount); for (j = 0; j < (unsigned) binds->bcount; j++) { if ((binds->binds[j].gm.theMatch != NULL) && (binds->binds[j].gm.theMatch->matchingItem != NULL)) { nbinds[j] = binds->binds[j].gm.theMatch->matchingItem->timeTag; } else { nbinds[j] = 0; } } /*=================*/ /* Sort the array. */ /*=================*/ for (flag = TRUE, k = binds->bcount - 1; flag == TRUE; k--) { flag = FALSE; for (j = 0 ; j < k ; j++) { if (nbinds[j] < nbinds[j + 1]) { temp = nbinds[j]; nbinds[j] = nbinds[j+1]; nbinds[j+1] = temp; flag = TRUE; } } } /*===================*/ /* Return the array. */ /*===================*/ return(nbinds); } /**************************************************************************/ /* ComparePartialMatches: Compares two activations using the lex conflict */ /* resolution strategy to determine which activation should be placed */ /* first on the agenda. This lexicographic comparison function is used */ /* for both the lex and mea strategies. */ /**************************************************************************/ static int ComparePartialMatches( void *theEnv, ACTIVATION *actPtr, ACTIVATION *newActivation) { int cCount, oCount, mCount, i; unsigned long long *basis1, *basis2; /*=================================================*/ /* If the activation already on the agenda doesn't */ /* have a set of sorted timetags, then create one. */ /*=================================================*/ basis1 = SortPartialMatch(theEnv,newActivation->basis); basis2 = SortPartialMatch(theEnv,actPtr->basis); /*==============================================================*/ /* Determine the number of timetags in each of the activations. */ /* The number of timetags to be compared is the lessor of these */ /* two numbers. */ /*==============================================================*/ cCount = newActivation->basis->bcount; oCount = actPtr->basis->bcount; if (oCount > cCount) mCount = cCount; else mCount = oCount; /*===========================================================*/ /* Compare the sorted timetags one by one until there are no */ /* more timetags to compare or the timetags being compared */ /* are not equal. If the timetags aren't equal, then the */ /* activation containing the larger timetag is placed before */ /* the activation containing the smaller timetag. */ /*===========================================================*/ for (i = 0 ; i < mCount ; i++) { if (basis1[i] < basis2[i]) { rtn_mem(theEnv,sizeof(long long) * cCount,basis1); rtn_mem(theEnv,sizeof(long long) * oCount,basis2); return(LESS_THAN); } else if (basis1[i] > basis2[i]) { rtn_mem(theEnv,sizeof(long long) * cCount,basis1); rtn_mem(theEnv,sizeof(long long) * oCount,basis2); return(GREATER_THAN); } } rtn_mem(theEnv,sizeof(long long) * cCount,basis1); rtn_mem(theEnv,sizeof(long long) * oCount,basis2); /*==========================================================*/ /* If the sorted timetags are identical up to the number of */ /* timetags contained in the smaller partial match, then */ /* the activation containing more timetags should be */ /* placed before the activation containing fewer timetags. */ /*==========================================================*/ if (cCount < oCount) return(LESS_THAN); else if (cCount > oCount) return(GREATER_THAN); /*=========================================================*/ /* If the sorted partial matches for both activations are */ /* identical (containing the same number and values of */ /* timetags), then the activation associated with the rule */ /* having the highest complexity is placed before the */ /* other partial match. */ /*=========================================================*/ if (newActivation->theRule->complexity < actPtr->theRule->complexity) { return(LESS_THAN); } else if (newActivation->theRule->complexity > actPtr->theRule->complexity) { return(GREATER_THAN); } /*================================================*/ /* The two partial matches are equal for purposes */ /* of placement on the agenda for the lex and mea */ /* conflict resolution strategies. */ /*================================================*/ return(EQUAL); } /************************************/ /* EnvSetStrategy: C access routine */ /* for the set-strategy command. */ /************************************/ globle int EnvSetStrategy( void *theEnv, int value) { int oldStrategy; oldStrategy = AgendaData(theEnv)->Strategy; AgendaData(theEnv)->Strategy = value; if (oldStrategy != AgendaData(theEnv)->Strategy) EnvReorderAgenda(theEnv,NULL); return(oldStrategy); } /************************************/ /* EnvGetStrategy: C access routine */ /* for the get-strategy command. */ /************************************/ globle int EnvGetStrategy( void *theEnv) { return(AgendaData(theEnv)->Strategy); } /********************************************/ /* GetStrategyCommand: H/L access routine */ /* for the get-strategy command. */ /********************************************/ globle void *GetStrategyCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-strategy",EXACTLY,0); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } /********************************************/ /* SetStrategyCommand: H/L access routine */ /* for the set-strategy command. */ /********************************************/ globle void *SetStrategyCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; int oldStrategy; oldStrategy = AgendaData(theEnv)->Strategy; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"set-strategy",EXACTLY,1) == -1) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } if (EnvArgTypeCheck(theEnv,"set-strategy",1,SYMBOL,&argPtr) == FALSE) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } argument = DOToString(argPtr); /*=============================================*/ /* Set the strategy to the specified strategy. */ /*=============================================*/ if (strcmp(argument,"depth") == 0) { EnvSetStrategy(theEnv,DEPTH_STRATEGY); } else if (strcmp(argument,"breadth") == 0) { EnvSetStrategy(theEnv,BREADTH_STRATEGY); } else if (strcmp(argument,"lex") == 0) { EnvSetStrategy(theEnv,LEX_STRATEGY); } else if (strcmp(argument,"mea") == 0) { EnvSetStrategy(theEnv,MEA_STRATEGY); } else if (strcmp(argument,"complexity") == 0) { EnvSetStrategy(theEnv,COMPLEXITY_STRATEGY); } else if (strcmp(argument,"simplicity") == 0) { EnvSetStrategy(theEnv,SIMPLICITY_STRATEGY); } else if (strcmp(argument,"random") == 0) { EnvSetStrategy(theEnv,RANDOM_STRATEGY); } else { ExpectedTypeError1(theEnv,"set-strategy",1, "symbol with value depth, breadth, lex, mea, complexity, simplicity, or random"); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } /*=======================================*/ /* Return the old value of the strategy. */ /*=======================================*/ return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(oldStrategy))); } /**********************************************************/ /* GetStrategyName: Given the integer value corresponding */ /* to a specified strategy, return a character string */ /* of the strategy's name. */ /**********************************************************/ static const char *GetStrategyName( int strategy) { const char *sname; switch (strategy) { case DEPTH_STRATEGY: sname = "depth"; break; case BREADTH_STRATEGY: sname = "breadth"; break; case LEX_STRATEGY: sname = "lex"; break; case MEA_STRATEGY: sname = "mea"; break; case COMPLEXITY_STRATEGY: sname = "complexity"; break; case SIMPLICITY_STRATEGY: sname = "simplicity"; break; case RANDOM_STRATEGY: sname = "random"; break; default: sname = "unknown"; break; } return(sname); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle int SetStrategy( int value) { return EnvSetStrategy(GetCurrentEnvironment(),value); } globle int GetStrategy() { return EnvGetStrategy(GetCurrentEnvironment()); } #endif #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/._utility.h0000755000175000017500000000040712375756703016342 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._router.h0000755000175000017500000000041312461762345016147 0ustar jfsjfsMac OS X  2Ù ATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objrtbin.h0000755000175000017500000000506712374023202016216 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* ResetObjectMatchTimeTags did not pass in the */ /* environment argument when BLOAD_ONLY was set. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Added support for hashed alpha memories. */ /* */ /*************************************************************/ #ifndef _H_objrtbin #define _H_objrtbin #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #define OBJECTRETEBIN_DATA 34 struct objectReteBinaryData { long AlphaNodeCount; long PatternNodeCount; OBJECT_ALPHA_NODE *AlphaArray; OBJECT_PATTERN_NODE *PatternArray; }; #define ObjectReteBinaryData(theEnv) ((struct objectReteBinaryData *) GetEnvironmentData(theEnv,OBJECTRETEBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectPatternsBload(void *); #endif /* DEFRULE_CONSTRUCT && OBJECT_SYSTEM */ #endif /* _H_objrtbin */ clips_core_source_630/core/._modulbin.c0000755000175000017500000000040712373755047016441 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factbin.c0000755000175000017500000000040712373742000016217 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulebsc.h0000755000175000017500000001202712464554105016051 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* DEFRULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defrule */ /* construct such as clear, reset, save, undefrule, */ /* ppdefrule, list-defrules, and */ /* get-defrule-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for join network changes. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* JoinOperationInProgress mechanism. */ /* */ /*************************************************************/ #ifndef _H_rulebsc #define _H_rulebsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefruleBasicCommands(void *); LOCALE void UndefruleCommand(void *); LOCALE intBool EnvUndefrule(void *,void *); LOCALE void GetDefruleListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDefruleList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DefruleModuleFunction(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDefruleCommand(void *); LOCALE int PPDefrule(void *,const char *,const char *); LOCALE void ListDefrulesCommand(void *); LOCALE void EnvListDefrules(void *,const char *,void *); LOCALE unsigned EnvGetDefruleWatchFirings(void *,void *); LOCALE unsigned EnvGetDefruleWatchActivations(void *,void *); LOCALE void EnvSetDefruleWatchFirings(void *,unsigned,void *); LOCALE void EnvSetDefruleWatchActivations(void *,unsigned,void *); LOCALE unsigned DefruleWatchAccess(void *,int,unsigned,struct expr *); LOCALE unsigned DefruleWatchPrint(void *,const char *,int,struct expr *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void GetDefruleList(DATA_OBJECT_PTR,void *); #if DEBUGGING_FUNCTIONS LOCALE unsigned GetDefruleWatchActivations(void *); LOCALE unsigned GetDefruleWatchFirings(void *); LOCALE void ListDefrules(const char *,void *); LOCALE void SetDefruleWatchActivations(unsigned,void *); LOCALE void SetDefruleWatchFirings(unsigned,void *); #endif LOCALE intBool Undefrule(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_rulebsc */ clips_core_source_630/core/._insmult.c0000755000175000017500000000040712373756342016322 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._symbol.c0000755000175000017500000000040712464470634016132 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrncmp.c0000755000175000017500000000040712373714216016452 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._modulbsc.h0000755000175000017500000000040712373755044016442 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/prdctfun.c0000755000175000017500000006364112373743656016254 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PREDICATE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several predicate */ /* functions including not, and, or, eq, neq, <=, >=, <, */ /* >, =, <>, symbolp, stringp, lexemep, numberp, integerp, */ /* floatp, oddp, evenp, multifieldp, sequencep, and */ /* pointerp. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /*************************************************************/ #define _PRDCTFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "argacces.h" #include "multifld.h" #include "router.h" #include "prdctfun.h" /**************************************************/ /* PredicateFunctionDefinitions: Defines standard */ /* math and predicate functions. */ /**************************************************/ globle void PredicateFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"not", 'b', NotFunction, "NotFunction", "11"); EnvDefineFunction2(theEnv,"and", 'b', AndFunction, "AndFunction", "2*"); EnvDefineFunction2(theEnv,"or", 'b', OrFunction, "OrFunction", "2*"); EnvDefineFunction2(theEnv,"eq", 'b', EqFunction, "EqFunction", "2*"); EnvDefineFunction2(theEnv,"neq", 'b', NeqFunction, "NeqFunction", "2*"); EnvDefineFunction2(theEnv,"<=", 'b', LessThanOrEqualFunction, "LessThanOrEqualFunction", "2*n"); EnvDefineFunction2(theEnv,">=", 'b', GreaterThanOrEqualFunction, "GreaterThanOrEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"<", 'b', LessThanFunction, "LessThanFunction", "2*n"); EnvDefineFunction2(theEnv,">", 'b', GreaterThanFunction, "GreaterThanFunction", "2*n"); EnvDefineFunction2(theEnv,"=", 'b', NumericEqualFunction, "NumericEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"<>", 'b', NumericNotEqualFunction, "NumericNotEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"!=", 'b', NumericNotEqualFunction, "NumericNotEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"symbolp", 'b', SymbolpFunction, "SymbolpFunction", "11"); EnvDefineFunction2(theEnv,"wordp", 'b', SymbolpFunction, "SymbolpFunction", "11"); EnvDefineFunction2(theEnv,"stringp", 'b', StringpFunction, "StringpFunction", "11"); EnvDefineFunction2(theEnv,"lexemep", 'b', LexemepFunction, "LexemepFunction", "11"); EnvDefineFunction2(theEnv,"numberp", 'b', NumberpFunction, "NumberpFunction", "11"); EnvDefineFunction2(theEnv,"integerp", 'b', IntegerpFunction, "IntegerpFunction", "11"); EnvDefineFunction2(theEnv,"floatp", 'b', FloatpFunction, "FloatpFunction", "11"); EnvDefineFunction2(theEnv,"oddp", 'b', OddpFunction, "OddpFunction", "11i"); EnvDefineFunction2(theEnv,"evenp", 'b', EvenpFunction, "EvenpFunction", "11i"); EnvDefineFunction2(theEnv,"multifieldp",'b', MultifieldpFunction, "MultifieldpFunction", "11"); EnvDefineFunction2(theEnv,"sequencep",'b', MultifieldpFunction, "MultifieldpFunction", "11"); EnvDefineFunction2(theEnv,"pointerp", 'b', PointerpFunction, "PointerpFunction", "11"); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /************************************/ /* EqFunction: H/L access routine */ /* for the eq function. */ /************************************/ globle intBool EqFunction( void *theEnv) { DATA_OBJECT item, nextItem; int numArgs, i; struct expr *theExpression; /*====================================*/ /* Determine the number of arguments. */ /*====================================*/ numArgs = EnvRtnArgCount(theEnv); if (numArgs == 0) return(FALSE); /*==============================================*/ /* Get the value of the first argument against */ /* which subsequent arguments will be compared. */ /*==============================================*/ theExpression = GetFirstArgument(); EvaluateExpression(theEnv,theExpression,&item); /*=====================================*/ /* Compare all arguments to the first. */ /* If any are the same, return FALSE. */ /*=====================================*/ theExpression = GetNextArgument(theExpression); for (i = 2 ; i <= numArgs ; i++) { EvaluateExpression(theEnv,theExpression,&nextItem); if (GetType(nextItem) != GetType(item)) { return(FALSE); } if (GetType(nextItem) == MULTIFIELD) { if (MultifieldDOsEqual(&nextItem,&item) == FALSE) { return(FALSE); } } else if (nextItem.value != item.value) { return(FALSE); } theExpression = GetNextArgument(theExpression); } /*=====================================*/ /* All of the arguments were different */ /* from the first. Return TRUE. */ /*=====================================*/ return(TRUE); } /*************************************/ /* NeqFunction: H/L access routine */ /* for the neq function. */ /*************************************/ globle intBool NeqFunction( void *theEnv) { DATA_OBJECT item, nextItem; int numArgs, i; struct expr *theExpression; /*====================================*/ /* Determine the number of arguments. */ /*====================================*/ numArgs = EnvRtnArgCount(theEnv); if (numArgs == 0) return(FALSE); /*==============================================*/ /* Get the value of the first argument against */ /* which subsequent arguments will be compared. */ /*==============================================*/ theExpression = GetFirstArgument(); EvaluateExpression(theEnv,theExpression,&item); /*=====================================*/ /* Compare all arguments to the first. */ /* If any are different, return FALSE. */ /*=====================================*/ for (i = 2, theExpression = GetNextArgument(theExpression); i <= numArgs; i++, theExpression = GetNextArgument(theExpression)) { EvaluateExpression(theEnv,theExpression,&nextItem); if (GetType(nextItem) != GetType(item)) { continue; } else if (nextItem.type == MULTIFIELD) { if (MultifieldDOsEqual(&nextItem,&item) == TRUE) { return(FALSE); } } else if (nextItem.value == item.value) { return(FALSE); } } /*=====================================*/ /* All of the arguments were identical */ /* to the first. Return TRUE. */ /*=====================================*/ return(TRUE); } /*****************************************/ /* StringpFunction: H/L access routine */ /* for the stringp function. */ /*****************************************/ globle intBool StringpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"stringp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) == STRING) { return(TRUE); } else { return(FALSE); } } /*****************************************/ /* SymbolpFunction: H/L access routine */ /* for the symbolp function. */ /*****************************************/ globle intBool SymbolpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"symbolp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) == SYMBOL) { return(TRUE); } else { return(FALSE); } } /*****************************************/ /* LexemepFunction: H/L access routine */ /* for the lexemep function. */ /*****************************************/ globle intBool LexemepFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"lexemep",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if ((GetType(item) == SYMBOL) || (GetType(item) == STRING)) { return(TRUE); } else { return(FALSE); } } /*****************************************/ /* NumberpFunction: H/L access routine */ /* for the numberp function. */ /*****************************************/ globle intBool NumberpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"numberp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if ((GetType(item) == FLOAT) || (GetType(item) == INTEGER)) { return(TRUE); } else { return(FALSE); } } /****************************************/ /* FloatpFunction: H/L access routine */ /* for the floatp function. */ /****************************************/ globle intBool FloatpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"floatp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) == FLOAT) { return(TRUE); } else { return(FALSE); } } /******************************************/ /* IntegerpFunction: H/L access routine */ /* for the integerp function. */ /******************************************/ globle intBool IntegerpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"integerp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) != INTEGER) return(FALSE); return(TRUE); } /*********************************************/ /* MultifieldpFunction: H/L access routine */ /* for the multifieldp function. */ /*********************************************/ globle intBool MultifieldpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"multifieldp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) != MULTIFIELD) return(FALSE); return(TRUE); } /******************************************/ /* PointerpFunction: H/L access routine */ /* for the pointerp function. */ /******************************************/ globle intBool PointerpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"pointerp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) != EXTERNAL_ADDRESS) return(FALSE); return(TRUE); } /*************************************/ /* NotFunction: H/L access routine */ /* for the not function. */ /*************************************/ globle intBool NotFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT result; theArgument = GetFirstArgument(); if (theArgument == NULL) { return(FALSE); } if (EvaluateExpression(theEnv,theArgument,&result)) return(FALSE); if ((result.value == EnvFalseSymbol(theEnv)) && (result.type == SYMBOL)) { return(TRUE); } return(FALSE); } /*************************************/ /* AndFunction: H/L access routine */ /* for the and function. */ /*************************************/ globle intBool AndFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT result; for (theArgument = GetFirstArgument(); theArgument != NULL; theArgument = GetNextArgument(theArgument)) { if (EvaluateExpression(theEnv,theArgument,&result)) return(FALSE); if ((result.value == EnvFalseSymbol(theEnv)) && (result.type == SYMBOL)) { return(FALSE); } } return(TRUE); } /************************************/ /* OrFunction: H/L access routine */ /* for the or function. */ /************************************/ globle intBool OrFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT result; for (theArgument = GetFirstArgument(); theArgument != NULL; theArgument = GetNextArgument(theArgument)) { if (EvaluateExpression(theEnv,theArgument,&result)) return(FALSE); if ((result.value != EnvFalseSymbol(theEnv)) || (result.type != SYMBOL)) { return(TRUE); } } return(FALSE); } /*****************************************/ /* LessThanOrEqualFunction: H/L access */ /* routine for the <= function. */ /*****************************************/ globle intBool LessThanOrEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"<=",&rv1,FALSE,pos)) return(FALSE); pos++; /*====================================================*/ /* Compare each of the subsequent arguments to its */ /* predecessor. If any is greater, then return FALSE. */ /*====================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"<=",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) > ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) > ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) > (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) > ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*======================================*/ /* Each argument was less than or equal */ /* to it predecessor. Return TRUE. */ /*======================================*/ return(TRUE); } /********************************************/ /* GreaterThanOrEqualFunction: H/L access */ /* routine for the >= function. */ /********************************************/ globle intBool GreaterThanOrEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,">=",&rv1,FALSE,pos)) return(FALSE); pos++; /*===================================================*/ /* Compare each of the subsequent arguments to its */ /* predecessor. If any is lesser, then return FALSE. */ /*===================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,">=",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) < ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) < ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) < (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) < ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*=========================================*/ /* Each argument was greater than or equal */ /* to its predecessor. Return TRUE. */ /*=========================================*/ return(TRUE); } /**********************************/ /* LessThanFunction: H/L access */ /* routine for the < function. */ /**********************************/ globle intBool LessThanFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"<",&rv1,FALSE,pos)) return(FALSE); pos++; /*==========================================*/ /* Compare each of the subsequent arguments */ /* to its predecessor. If any is greater or */ /* equal, then return FALSE. */ /*==========================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"<",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) >= ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) >= ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) >= (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) >= ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*=================================*/ /* Each argument was less than its */ /* predecessor. Return TRUE. */ /*=================================*/ return(TRUE); } /*************************************/ /* GreaterThanFunction: H/L access */ /* routine for the > function. */ /*************************************/ globle intBool GreaterThanFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,">",&rv1,FALSE,pos)) return(FALSE); pos++; /*==========================================*/ /* Compare each of the subsequent arguments */ /* to its predecessor. If any is lesser or */ /* equal, then return FALSE. */ /*==========================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,">",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) <= ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) <= ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) <= (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) <= ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*================================*/ /* Each argument was greater than */ /* its predecessor. Return TRUE. */ /*================================*/ return(TRUE); } /**************************************/ /* NumericEqualFunction: H/L access */ /* routine for the = function. */ /**************************************/ globle intBool NumericEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"=",&rv1,FALSE,pos)) return(FALSE); pos++; /*=================================================*/ /* Compare each of the subsequent arguments to the */ /* first. If any is unequal, then return FALSE. */ /*=================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"=",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) != ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) != ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) != (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) != ValueToDouble(rv2.value)) { return(FALSE); } } } } /*=================================*/ /* All arguments were equal to the */ /* first argument. Return TRUE. */ /*=================================*/ return(TRUE); } /*****************************************/ /* NumericNotEqualFunction: H/L access */ /* routine for the <> function. */ /*****************************************/ globle intBool NumericNotEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"<>",&rv1,FALSE,pos)) return(FALSE); pos++; /*=================================================*/ /* Compare each of the subsequent arguments to the */ /* first. If any is equal, then return FALSE. */ /*=================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"<>",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) == ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) == ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) == (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) == ValueToDouble(rv2.value)) { return(FALSE); } } } } /*===================================*/ /* All arguments were unequal to the */ /* first argument. Return TRUE. */ /*===================================*/ return(TRUE); } /**************************************/ /* OddpFunction: H/L access routine */ /* for the oddp function. */ /**************************************/ globle intBool OddpFunction( void *theEnv) { DATA_OBJECT item; long long num, halfnum; if (EnvArgCountCheck(theEnv,"oddp",EXACTLY,1) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,"oddp",1,INTEGER,&item) == FALSE) return(FALSE); num = DOToLong(item); halfnum = (num / 2) * 2; if (num == halfnum) return(FALSE); return(TRUE); } /***************************************/ /* EvenpFunction: H/L access routine */ /* for the evenp function. */ /***************************************/ globle intBool EvenpFunction( void *theEnv) { DATA_OBJECT item; long long num, halfnum; if (EnvArgCountCheck(theEnv,"evenp",EXACTLY,1) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,"evenp",1,INTEGER,&item) == FALSE) return(FALSE); num = DOToLong(item); halfnum = (num / 2) * 2; if (num != halfnum) return(FALSE); return(TRUE); } clips_core_source_630/core/modulbsc.c0000755000175000017500000002152212424473406016215 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* DEFMODULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defmodule */ /* construct such as clear, reset, save, ppdefmodule */ /* list-defmodules, and get-defmodule-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _MODULBSC_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include "constrct.h" #include "extnfunc.h" #include "modulbin.h" #include "prntutil.h" #include "modulcmp.h" #include "router.h" #include "argacces.h" #include "bload.h" #include "multifld.h" #include "envrnmnt.h" #include "modulbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ClearDefmodules(void *); #if DEFMODULE_CONSTRUCT static void SaveDefmodules(void *,void *,const char *); #endif /*****************************************************************/ /* DefmoduleBasicCommands: Initializes basic defmodule commands. */ /*****************************************************************/ globle void DefmoduleBasicCommands( void *theEnv) { EnvAddClearFunction(theEnv,"defmodule",ClearDefmodules,2000); #if DEFMODULE_CONSTRUCT AddSaveFunction(theEnv,"defmodule",SaveDefmodules,1100); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-defmodule-list",'m',PTIEF EnvGetDefmoduleList,"EnvGetDefmoduleList","00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-defmodules",'v', PTIEF ListDefmodulesCommand,"ListDefmodulesCommand","00"); EnvDefineFunction2(theEnv,"ppdefmodule",'v',PTIEF PPDefmoduleCommand,"PPDefmoduleCommand","11w"); #endif #endif #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DefmoduleBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefmoduleCompilerSetup(theEnv); #endif } /*********************************************************/ /* ClearDefmodules: Defmodule clear routine for use with */ /* the clear command. Creates the MAIN module. */ /*********************************************************/ static void ClearDefmodules( void *theEnv) { #if (BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY) && (! RUN_TIME) if (Bloaded(theEnv) == TRUE) return; #endif #if (! RUN_TIME) RemoveAllDefmodules(theEnv); CreateMainModule(theEnv); DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if DEFMODULE_CONSTRUCT /******************************************/ /* SaveDefmodules: Defmodule save routine */ /* for use with the save command. */ /******************************************/ static void SaveDefmodules( void *theEnv, void *theModule, const char *logicalName) { const char *ppform; ppform = EnvGetDefmodulePPForm(theEnv,theModule); if (ppform != NULL) { PrintInChunks(theEnv,logicalName,ppform); EnvPrintRouter(theEnv,logicalName,"\n"); } } /*************************************************/ /* EnvGetDefmoduleList: H/L and C access routine */ /* for the get-defmodule-list function. */ /*************************************************/ globle void EnvGetDefmoduleList( void *theEnv, DATA_OBJECT_PTR returnValue) { void *theConstruct; unsigned long count = 0; struct multifield *theList; /*====================================*/ /* Determine the number of constructs */ /* of the specified type. */ /*====================================*/ for (theConstruct = EnvGetNextDefmodule(theEnv,NULL); theConstruct != NULL; theConstruct = EnvGetNextDefmodule(theEnv,theConstruct)) { count++; } /*===========================*/ /* Create a multifield large */ /* enough to store the list. */ /*===========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*====================================*/ /* Store the names in the multifield. */ /*====================================*/ for (theConstruct = EnvGetNextDefmodule(theEnv,NULL), count = 1; theConstruct != NULL; theConstruct = EnvGetNextDefmodule(theEnv,theConstruct), count++) { if (EvaluationData(theEnv)->HaltExecution == TRUE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,EnvAddSymbol(theEnv,EnvGetDefmoduleName(theEnv,theConstruct))); } } #if DEBUGGING_FUNCTIONS /********************************************/ /* PPDefmoduleCommand: H/L access routine */ /* for the ppdefmodule command. */ /********************************************/ globle void PPDefmoduleCommand( void *theEnv) { const char *defmoduleName; defmoduleName = GetConstructName(theEnv,"ppdefmodule","defmodule name"); if (defmoduleName == NULL) return; PPDefmodule(theEnv,defmoduleName,WDISPLAY); return; } /*************************************/ /* PPDefmodule: C access routine for */ /* the ppdefmodule command. */ /*************************************/ globle int PPDefmodule( void *theEnv, const char *defmoduleName, const char *logicalName) { void *defmodulePtr; defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName); if (defmodulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName); return(FALSE); } if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(TRUE); PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr)); return(TRUE); } /***********************************************/ /* ListDefmodulesCommand: H/L access routine */ /* for the list-defmodules command. */ /***********************************************/ globle void ListDefmodulesCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"list-defmodules",EXACTLY,0) == -1) return; EnvListDefmodules(theEnv,WDISPLAY); } /***************************************/ /* EnvListDefmodules: C access routine */ /* for the list-defmodules command. */ /***************************************/ globle void EnvListDefmodules( void *theEnv, const char *logicalName) { void *theModule; int count = 0; for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,"\n"); count++; } PrintTally(theEnv,logicalName,count,"defmodule","defmodules"); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void GetDefmoduleList( DATA_OBJECT_PTR returnValue) { EnvGetDefmoduleList(GetCurrentEnvironment(),returnValue); } #if DEBUGGING_FUNCTIONS globle void ListDefmodules( const char *logicalName) { EnvListDefmodules(GetCurrentEnvironment(),logicalName); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFMODULE_CONSTRUCT */ clips_core_source_630/core/._rulecstr.h0000755000175000017500000000040712374024363016467 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factcom.c0000755000175000017500000013125412462743521016025 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* FACT COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the facts, assert, retract, save-facts, */ /* load-facts, set-fact-duplication, get-fact-duplication, */ /* assert-string, and fact-index commands and functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #define _FACTCOM_SOURCE_ #include "memalloc.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "factmngr.h" #include "argacces.h" #include "match.h" #include "router.h" #include "scanner.h" #include "constant.h" #include "factrhs.h" #include "factmch.h" #include "extnfunc.h" #include "tmpltpsr.h" #include "tmpltutl.h" #include "facthsh.h" #include "modulutl.h" #include "strngrtr.h" #include "tmpltdef.h" #include "tmpltfun.h" #include "sysdep.h" #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "bload.h" #endif #include "factcom.h" #define INVALID -2L #define UNSPECIFIED -1L /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) static struct expr *AssertParse(void *,struct expr *,const char *); #endif #if DEBUGGING_FUNCTIONS static long long GetFactsArgument(void *,int,int); #endif static struct expr *StandardLoadFact(void *,const char *,struct token *); static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames(void *,struct expr *,int,int *,int *); /***************************************/ /* FactCommandDefinitions: Initializes */ /* fact commands and functions. */ /***************************************/ globle void FactCommandDefinitions( void *theEnv) { #if ! RUN_TIME #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"facts", 'v', PTIEF FactsCommand, "FactsCommand", "*4iu"); #endif EnvDefineFunction(theEnv,"assert", 'u', PTIEF AssertCommand, "AssertCommand"); EnvDefineFunction2(theEnv,"retract", 'v', PTIEF RetractCommand, "RetractCommand","1*z"); EnvDefineFunction2(theEnv,"assert-string", 'u', PTIEF AssertStringFunction, "AssertStringFunction", "11s"); EnvDefineFunction2(theEnv,"str-assert", 'u', PTIEF AssertStringFunction, "AssertStringFunction", "11s"); EnvDefineFunction2(theEnv,"get-fact-duplication",'b', GetFactDuplicationCommand,"GetFactDuplicationCommand", "00"); EnvDefineFunction2(theEnv,"set-fact-duplication",'b', SetFactDuplicationCommand,"SetFactDuplicationCommand", "11"); EnvDefineFunction2(theEnv,"save-facts", 'b', PTIEF SaveFactsCommand, "SaveFactsCommand", "1*wk"); EnvDefineFunction2(theEnv,"load-facts", 'b', PTIEF LoadFactsCommand, "LoadFactsCommand", "11k"); EnvDefineFunction2(theEnv,"fact-index", 'g', PTIEF FactIndexFunction,"FactIndexFunction", "11y"); AddFunctionParser(theEnv,"assert",AssertParse); FuncSeqOvlFlags(theEnv,"assert",FALSE,FALSE); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /***************************************/ /* AssertCommand: H/L access routine */ /* for the assert function. */ /***************************************/ globle void AssertCommand( void *theEnv, DATA_OBJECT_PTR rv) { struct deftemplate *theDeftemplate; struct field *theField; DATA_OBJECT theValue; struct expr *theExpression; struct templateSlot *slotPtr; struct fact *newFact; int error = FALSE; int i; struct fact *theFact; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(rv,SYMBOL); SetpValue(rv,EnvFalseSymbol(theEnv)); /*================================*/ /* Get the deftemplate associated */ /* with the fact being asserted. */ /*================================*/ theExpression = GetFirstArgument(); theDeftemplate = (struct deftemplate *) theExpression->value; /*=======================================*/ /* Create the fact and store the name of */ /* the deftemplate as the 1st field. */ /*=======================================*/ if (theDeftemplate->implied == FALSE) { newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots); slotPtr = theDeftemplate->slotList; } else { newFact = CreateFactBySize(theEnv,1); if (theExpression->nextArg == NULL) { newFact->theProposition.theFields[0].type = MULTIFIELD; newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L); } slotPtr = NULL; } newFact->whichDeftemplate = theDeftemplate; /*===================================================*/ /* Evaluate the expression associated with each slot */ /* and store the result in the appropriate slot of */ /* the newly created fact. */ /*===================================================*/ EnvIncrementClearReadyLocks(theEnv); theField = newFact->theProposition.theFields; for (theExpression = theExpression->nextArg, i = 0; theExpression != NULL; theExpression = theExpression->nextArg, i++) { /*===================================================*/ /* Evaluate the expression to be stored in the slot. */ /*===================================================*/ EvaluateExpression(theEnv,theExpression,&theValue); /*============================================================*/ /* A multifield value can't be stored in a single field slot. */ /*============================================================*/ if ((slotPtr != NULL) ? (slotPtr->multislot == FALSE) && (theValue.type == MULTIFIELD) : FALSE) { MultiIntoSingleFieldSlotError(theEnv,slotPtr,theDeftemplate); theValue.type = SYMBOL; theValue.value = EnvFalseSymbol(theEnv); error = TRUE; } /*==============================*/ /* Store the value in the slot. */ /*==============================*/ theField[i].type = theValue.type; theField[i].value = theValue.value; /*========================================*/ /* Get the information for the next slot. */ /*========================================*/ if (slotPtr != NULL) slotPtr = slotPtr->next; } EnvDecrementClearReadyLocks(theEnv); /*============================================*/ /* If an error occured while generating the */ /* fact's slot values, then abort the assert. */ /*============================================*/ if (error) { ReturnFact(theEnv,newFact); return; } /*================================*/ /* Add the fact to the fact-list. */ /*================================*/ theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact); /*========================================*/ /* The asserted fact is the return value. */ /*========================================*/ if (theFact != NULL) { SetpType(rv,FACT_ADDRESS); SetpValue(rv,(void *) theFact); } return; } /****************************************/ /* RetractCommand: H/L access routine */ /* for the retract command. */ /****************************************/ globle void RetractCommand( void *theEnv) { long long factIndex; struct fact *ptr; struct expr *theArgument; DATA_OBJECT theResult; int argNumber; /*================================*/ /* Iterate through each argument. */ /*================================*/ for (theArgument = GetFirstArgument(), argNumber = 1; theArgument != NULL; theArgument = GetNextArgument(theArgument), argNumber++) { /*========================*/ /* Evaluate the argument. */ /*========================*/ EvaluateExpression(theEnv,theArgument,&theResult); /*===============================================*/ /* If the argument evaluates to an integer, then */ /* it's assumed to be the fact index of the fact */ /* to be retracted. */ /*===============================================*/ if (theResult.type == INTEGER) { /*==========================================*/ /* A fact index must be a positive integer. */ /*==========================================*/ factIndex = ValueToLong(theResult.value); if (factIndex < 0) { ExpectedTypeError1(theEnv,"retract",argNumber,"fact-address, fact-index, or the symbol *"); return; } /*================================================*/ /* See if a fact with the specified index exists. */ /*================================================*/ ptr = FindIndexedFact(theEnv,factIndex); /*=====================================*/ /* If the fact exists then retract it, */ /* otherwise print an error message. */ /*=====================================*/ if (ptr != NULL) { EnvRetract(theEnv,(void *) ptr); } else { char tempBuffer[20]; gensprintf(tempBuffer,"f-%lld",factIndex); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); } } /*===============================================*/ /* Otherwise if the argument evaluates to a fact */ /* address, we can directly retract it. */ /*===============================================*/ else if (theResult.type == FACT_ADDRESS) { EnvRetract(theEnv,theResult.value); } /*============================================*/ /* Otherwise if the argument evaluates to the */ /* symbol *, then all facts are retracted. */ /*============================================*/ else if ((theResult.type == SYMBOL) ? (strcmp(ValueToString(theResult.value),"*") == 0) : FALSE) { RemoveAllFacts(theEnv); return; } /*============================================*/ /* Otherwise the argument has evaluated to an */ /* illegal value for the retract command. */ /*============================================*/ else { ExpectedTypeError1(theEnv,"retract",argNumber,"fact-address, fact-index, or the symbol *"); SetEvaluationError(theEnv,TRUE); } } } /***************************************************/ /* SetFactDuplicationCommand: H/L access routine */ /* for the set-fact-duplication command. */ /***************************************************/ globle int SetFactDuplicationCommand( void *theEnv) { int oldValue; DATA_OBJECT theValue; /*=====================================================*/ /* Get the old value of the fact duplication behavior. */ /*=====================================================*/ oldValue = EnvGetFactDuplication(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-fact-duplication",EXACTLY,1) == -1) { return(oldValue); } /*========================*/ /* Evaluate the argument. */ /*========================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================================*/ /* If the argument evaluated to FALSE, then the fact duplication */ /* behavior is disabled, otherwise it is enabled. */ /*===============================================================*/ if ((theValue.value == EnvFalseSymbol(theEnv)) && (theValue.type == SYMBOL)) { EnvSetFactDuplication(theEnv,FALSE); } else { EnvSetFactDuplication(theEnv,TRUE); } /*========================================================*/ /* Return the old value of the fact duplication behavior. */ /*========================================================*/ return(oldValue); } /***************************************************/ /* GetFactDuplicationCommand: H/L access routine */ /* for the get-fact-duplication command. */ /***************************************************/ globle int GetFactDuplicationCommand( void *theEnv) { int currentValue; /*=========================================================*/ /* Get the current value of the fact duplication behavior. */ /*=========================================================*/ currentValue = EnvGetFactDuplication(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"get-fact-duplication",EXACTLY,0) == -1) { return(currentValue); } /*============================================================*/ /* Return the current value of the fact duplication behavior. */ /*============================================================*/ return(currentValue); } /*******************************************/ /* FactIndexFunction: H/L access routine */ /* for the fact-index function. */ /*******************************************/ globle long long FactIndexFunction( void *theEnv) { DATA_OBJECT item; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"fact-index",EXACTLY,1) == -1) return(-1LL); /*========================*/ /* Evaluate the argument. */ /*========================*/ EnvRtnUnknown(theEnv,1,&item); /*======================================*/ /* The argument must be a fact address. */ /*======================================*/ if (GetType(item) != FACT_ADDRESS) { ExpectedTypeError1(theEnv,"fact-index",1,"fact-address"); return(-1L); } /*================================================*/ /* Return the fact index associated with the fact */ /* address. If the fact has been retracted, then */ /* return -1 for the fact index. */ /*================================================*/ if (((struct fact *) GetValue(item))->garbage) return(-1LL); return (EnvFactIndex(theEnv,GetValue(item))); } #if DEBUGGING_FUNCTIONS /**************************************/ /* FactsCommand: H/L access routine */ /* for the facts command. */ /**************************************/ globle void FactsCommand( void *theEnv) { int argumentCount; long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED; struct defmodule *theModule; DATA_OBJECT theValue; int argOffset; /*=========================================================*/ /* Determine the number of arguments to the facts command. */ /*=========================================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"facts",NO_MORE_THAN,4)) == -1) return; /*==================================*/ /* The default module for the facts */ /* command is the current module. */ /*==================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*==========================================*/ /* If no arguments were specified, then use */ /* the default values to list the facts. */ /*==========================================*/ if (argumentCount == 0) { EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); return; } /*========================================================*/ /* Since there are one or more arguments, see if a module */ /* or start index was specified as the first argument. */ /*========================================================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================*/ /* If the first argument is a symbol, then check */ /* to see that a valid module was specified. */ /*===============================================*/ if (theValue.type == SYMBOL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value)); if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0)) { SetEvaluationError(theEnv,TRUE); CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theValue.value)); return; } if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return; argOffset = 1; } /*================================================*/ /* Otherwise if the first argument is an integer, */ /* check to see that a valid index was specified. */ /*================================================*/ else if (theValue.type == INTEGER) { start = DOToLong(theValue); if (start < 0) { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } argOffset = 0; } /*==========================================*/ /* Otherwise the first argument is invalid. */ /*==========================================*/ else { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } /*==========================*/ /* Get the other arguments. */ /*==========================*/ if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return; if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return; /*=================*/ /* List the facts. */ /*=================*/ EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); } /*****************************************************/ /* EnvFacts: C access routine for the facts command. */ /*****************************************************/ globle void EnvFacts( void *theEnv, const char *logicalName, void *vTheModule, long long start, long long end, long long max) { struct fact *factPtr; long count = 0; struct defmodule *oldModule, *theModule = (struct defmodule *) vTheModule; int allModules = FALSE; /*==========================*/ /* Save the current module. */ /*==========================*/ oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*=========================================================*/ /* Determine if facts from all modules are to be displayed */ /* or just facts from the current module. */ /*=========================================================*/ if (theModule == NULL) allModules = TRUE; else EnvSetCurrentModule(theEnv,(void *) theModule); /*=====================================*/ /* Get the first fact to be displayed. */ /*=====================================*/ if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,NULL); else factPtr = (struct fact *) GetNextFactInScope(theEnv,NULL); /*===============================*/ /* Display facts until there are */ /* no more facts to display. */ /*===============================*/ while (factPtr != NULL) { /*==================================================*/ /* Abort the display of facts if the Halt Execution */ /* flag has been set (normally by user action). */ /*==================================================*/ if (GetHaltExecution(theEnv) == TRUE) { EnvSetCurrentModule(theEnv,(void *) oldModule); return; } /*===============================================*/ /* If the maximum fact index of facts to display */ /* has been reached, then stop displaying facts. */ /*===============================================*/ if ((factPtr->factIndex > end) && (end != UNSPECIFIED)) { PrintTally(theEnv,logicalName,count,"fact","facts"); EnvSetCurrentModule(theEnv,(void *) oldModule); return; } /*================================================*/ /* If the maximum number of facts to be displayed */ /* has been reached, then stop displaying facts. */ /*================================================*/ if (max == 0) { PrintTally(theEnv,logicalName,count,"fact","facts"); EnvSetCurrentModule(theEnv,(void *) oldModule); return; } /*======================================================*/ /* If the index of the fact is greater than the minimum */ /* starting fact index, then display the fact. */ /*======================================================*/ if (factPtr->factIndex >= start) { PrintFactWithIdentifier(theEnv,logicalName,factPtr); EnvPrintRouter(theEnv,logicalName,"\n"); count++; if (max > 0) max--; } /*========================================*/ /* Proceed to the next fact to be listed. */ /*========================================*/ if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,factPtr); else factPtr = (struct fact *) GetNextFactInScope(theEnv,factPtr); } /*===================================================*/ /* Print the total of the number of facts displayed. */ /*===================================================*/ PrintTally(theEnv,logicalName,count,"fact","facts"); /*=============================*/ /* Restore the current module. */ /*=============================*/ EnvSetCurrentModule(theEnv,(void *) oldModule); } /****************************************************************/ /* GetFactsArgument: Returns an argument for the facts command. */ /* A return value of -1 indicates that no value was specified. */ /* A return value of -2 indicates that the value specified is */ /* invalid. */ /****************************************************************/ static long long GetFactsArgument( void *theEnv, int whichOne, int argumentCount) { long long factIndex; DATA_OBJECT theValue; if (whichOne > argumentCount) return(UNSPECIFIED); if (EnvArgTypeCheck(theEnv,"facts",whichOne,INTEGER,&theValue) == FALSE) return(INVALID); factIndex = DOToLong(theValue); if (factIndex < 0) { ExpectedTypeError1(theEnv,"facts",whichOne,"positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(INVALID); } return(factIndex); } #endif /* DEBUGGING_FUNCTIONS */ /**********************************************/ /* AssertStringFunction: H/L access routine */ /* for the assert-string function. */ /**********************************************/ globle void AssertStringFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT argPtr; struct fact *theFact; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"assert-string",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"assert-string",1,STRING,&argPtr) == FALSE) { return; } /*==========================================*/ /* Call the driver routine for converting a */ /* string to a fact and then assert it. */ /*==========================================*/ theFact = (struct fact *) EnvAssertString(theEnv,DOToString(argPtr)); if (theFact != NULL) { SetpType(returnValue,FACT_ADDRESS); SetpValue(returnValue,(void *) theFact); } return; } /******************************************/ /* SaveFactsCommand: H/L access routine */ /* for the save-facts command. */ /******************************************/ globle int SaveFactsCommand( void *theEnv) { const char *fileName; int numArgs, saveCode = LOCAL_SAVE; const char *argument; DATA_OBJECT theValue; struct expr *theList = NULL; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"save-facts",AT_LEAST,1)) == -1) return(FALSE); /*=================================================*/ /* Get the file name to which facts will be saved. */ /*=================================================*/ if ((fileName = GetFileName(theEnv,"save-facts",1)) == NULL) return(FALSE); /*=============================================================*/ /* If specified, the second argument to save-facts indicates */ /* whether just facts local to the current module or all facts */ /* visible to the current module will be saved. */ /*=============================================================*/ if (numArgs > 1) { if (EnvArgTypeCheck(theEnv,"save-facts",2,SYMBOL,&theValue) == FALSE) return(FALSE); argument = DOToString(theValue); if (strcmp(argument,"local") == 0) { saveCode = LOCAL_SAVE; } else if (strcmp(argument,"visible") == 0) { saveCode = VISIBLE_SAVE; } else { ExpectedTypeError1(theEnv,"save-facts",2,"symbol with value local or visible"); return(FALSE); } } /*======================================================*/ /* Subsequent arguments indicate that only those facts */ /* associated with the specified deftemplates should be */ /* saved to the file. */ /*======================================================*/ if (numArgs > 2) theList = GetFirstArgument()->nextArg->nextArg; /*====================================*/ /* Call the SaveFacts driver routine. */ /*====================================*/ if (EnvSaveFactsDriver(theEnv,fileName,saveCode,theList) == FALSE) { return(FALSE); } return(TRUE); } /******************************************/ /* LoadFactsCommand: H/L access routine */ /* for the load-facts command. */ /******************************************/ globle int LoadFactsCommand( void *theEnv) { const char *fileName; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"load-facts",EXACTLY,1) == -1) return(FALSE); /*====================================================*/ /* Get the file name from which facts will be loaded. */ /*====================================================*/ if ((fileName = GetFileName(theEnv,"load-facts",1)) == NULL) return(FALSE); /*====================================*/ /* Call the LoadFacts driver routine. */ /*====================================*/ if (EnvLoadFacts(theEnv,fileName) == FALSE) return(FALSE); return(TRUE); } /**************************************************************/ /* EnvSaveFacts: C access routine for the save-facts command. */ /**************************************************************/ globle intBool EnvSaveFacts( void *theEnv, const char *fileName, int saveCode) { return EnvSaveFactsDriver(theEnv,fileName,saveCode,NULL); } /********************************************************************/ /* EnvSaveFactsDriver: C access routine for the save-facts command. */ /********************************************************************/ globle intBool EnvSaveFactsDriver( void *theEnv, const char *fileName, int saveCode, struct expr *theList) { int tempValue1, tempValue2, tempValue3; struct fact *theFact; FILE *filePtr; struct defmodule *theModule; DATA_OBJECT_PTR theDOArray; int count, i, printFact, error; /*======================================================*/ /* Open the file. Use either "fast save" or I/O Router. */ /*======================================================*/ if ((filePtr = GenOpen(theEnv,fileName,"w")) == NULL) { OpenErrorMessage(theEnv,"save-facts",fileName); return(FALSE); } SetFastSave(theEnv,filePtr); /*===========================================*/ /* Set the print flags so that addresses and */ /* strings are printed properly to the file. */ /*===========================================*/ tempValue1 = PrintUtilityData(theEnv)->PreserveEscapedCharacters; PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE; tempValue2 = PrintUtilityData(theEnv)->AddressesToStrings; PrintUtilityData(theEnv)->AddressesToStrings = TRUE; tempValue3 = PrintUtilityData(theEnv)->InstanceAddressesToNames; PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE; /*===================================================*/ /* Determine the list of specific facts to be saved. */ /*===================================================*/ theDOArray = GetSaveFactsDeftemplateNames(theEnv,theList,saveCode,&count,&error); if (error) { PrintUtilityData(theEnv)->PreserveEscapedCharacters = tempValue1; PrintUtilityData(theEnv)->AddressesToStrings = tempValue2; PrintUtilityData(theEnv)->InstanceAddressesToNames = tempValue3; GenClose(theEnv,filePtr); SetFastSave(theEnv,NULL); return(FALSE); } /*=================*/ /* Save the facts. */ /*=================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL); theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact)) { /*===========================================================*/ /* If we're doing a local save and the facts's corresponding */ /* deftemplate isn't in the current module, then don't save */ /* the fact. */ /*===========================================================*/ if ((saveCode == LOCAL_SAVE) && (theFact->whichDeftemplate->header.whichModule->theModule != theModule)) { printFact = FALSE; } /*=====================================================*/ /* Otherwise, if the list of facts to be printed isn't */ /* restricted, then set the print flag to TRUE. */ /*=====================================================*/ else if (theList == NULL) { printFact = TRUE; } /*=======================================================*/ /* Otherwise see if the fact's corresponding deftemplate */ /* is in the list of deftemplates whose facts are to be */ /* saved. If it's in the list, then set the print flag */ /* to TRUE, otherwise set it to FALSE. */ /*=======================================================*/ else { printFact = FALSE; for (i = 0; i < count; i++) { if (theDOArray[i].value == (void *) theFact->whichDeftemplate) { printFact = TRUE; break; } } } /*===================================*/ /* If the print flag is set to TRUE, */ /* then save the fact to the file. */ /*===================================*/ if (printFact) { PrintFact(theEnv,(char *) filePtr,theFact,FALSE,FALSE); EnvPrintRouter(theEnv,(char *) filePtr,"\n"); } } /*==========================*/ /* Restore the print flags. */ /*==========================*/ PrintUtilityData(theEnv)->PreserveEscapedCharacters = tempValue1; PrintUtilityData(theEnv)->AddressesToStrings = tempValue2; PrintUtilityData(theEnv)->InstanceAddressesToNames = tempValue3; /*=================*/ /* Close the file. */ /*=================*/ GenClose(theEnv,filePtr); SetFastSave(theEnv,NULL); /*==================================*/ /* Free the deftemplate name array. */ /*==================================*/ if (theList != NULL) rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * count); /*===================================*/ /* Return TRUE to indicate no errors */ /* occurred while saving the facts. */ /*===================================*/ return(TRUE); } /*******************************************************************/ /* GetSaveFactsDeftemplateNames: Retrieves the list of deftemplate */ /* names for saving specific facts with the save-facts command. */ /*******************************************************************/ static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames( void *theEnv, struct expr *theList, int saveCode, int *count, int *error) { struct expr *tempList; DATA_OBJECT_PTR theDOArray; int i, tempCount; struct deftemplate *theDeftemplate = NULL; /*=============================*/ /* Initialize the error state. */ /*=============================*/ *error = FALSE; /*=====================================================*/ /* If no deftemplate names were specified as arguments */ /* then the deftemplate name list is empty. */ /*=====================================================*/ if (theList == NULL) { *count = 0; return(NULL); } /*======================================*/ /* Determine the number of deftemplate */ /* names to be stored in the name list. */ /*======================================*/ for (tempList = theList, *count = 0; tempList != NULL; tempList = tempList->nextArg, (*count)++) { /* Do Nothing */ } /*=========================================*/ /* Allocate the storage for the name list. */ /*=========================================*/ theDOArray = (DATA_OBJECT_PTR) gm3(theEnv,(long) sizeof(DATA_OBJECT) * *count); /*=====================================*/ /* Loop through each of the arguments. */ /*=====================================*/ for (tempList = theList, i = 0; i < *count; tempList = tempList->nextArg, i++) { /*========================*/ /* Evaluate the argument. */ /*========================*/ EvaluateExpression(theEnv,tempList,&theDOArray[i]); if (EvaluationData(theEnv)->EvaluationError) { *error = TRUE; rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } /*======================================*/ /* A deftemplate name must be a symbol. */ /*======================================*/ if (theDOArray[i].type != SYMBOL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"symbol"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } /*===================================================*/ /* Find the deftemplate. For a local save, look only */ /* in the current module. For a visible save, look */ /* in all visible modules. */ /*===================================================*/ if (saveCode == LOCAL_SAVE) { theDeftemplate = (struct deftemplate *) EnvFindDeftemplateInModule(theEnv,ValueToString(theDOArray[i].value)); if (theDeftemplate == NULL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"local deftemplate name"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } } else if (saveCode == VISIBLE_SAVE) { theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL, ValueToString(theDOArray[i].value), &tempCount,TRUE,NULL); if (theDeftemplate == NULL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"visible deftemplate name"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } } /*==================================*/ /* Add a pointer to the deftemplate */ /* to the array being created. */ /*==================================*/ theDOArray[i].type = DEFTEMPLATE_PTR; theDOArray[i].value = (void *) theDeftemplate; } /*===================================*/ /* Return the array of deftemplates. */ /*===================================*/ return(theDOArray); } /**************************************************************/ /* EnvLoadFacts: C access routine for the load-facts command. */ /**************************************************************/ globle intBool EnvLoadFacts( void *theEnv, const char *fileName) { FILE *filePtr; struct token theToken; struct expr *testPtr; DATA_OBJECT rv; /*======================================================*/ /* Open the file. Use either "fast save" or I/O Router. */ /*======================================================*/ if ((filePtr = GenOpen(theEnv,fileName,"r")) == NULL) { OpenErrorMessage(theEnv,"load-facts",fileName); return(FALSE); } SetFastLoad(theEnv,filePtr); /*=================*/ /* Load the facts. */ /*=================*/ theToken.type = LPAREN; while (theToken.type != STOP) { testPtr = StandardLoadFact(theEnv,(char *) filePtr,&theToken); if (testPtr == NULL) theToken.type = STOP; else EvaluateExpression(theEnv,testPtr,&rv); ReturnExpression(theEnv,testPtr); } /*=================*/ /* Close the file. */ /*=================*/ SetFastLoad(theEnv,NULL); GenClose(theEnv,filePtr); /*================================================*/ /* Return TRUE if no error occurred while loading */ /* the facts, otherwise return FALSE. */ /*================================================*/ if (EvaluationData(theEnv)->EvaluationError) return(FALSE); return(TRUE); } /*********************************************/ /* EnvLoadFactsFromString: C access routine. */ /*********************************************/ globle intBool EnvLoadFactsFromString( void *theEnv, const char *theString, long theMax) { const char *theStrRouter = "*** load-facts-from-string ***"; struct token theToken; struct expr *testPtr; DATA_OBJECT rv; /*==========================*/ /* Initialize string router */ /*==========================*/ if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) : (!OpenTextSource(theEnv,theStrRouter,theString,0,(size_t) theMax))) return(FALSE); /*=================*/ /* Load the facts. */ /*=================*/ theToken.type = LPAREN; while (theToken.type != STOP) { testPtr = StandardLoadFact(theEnv,theStrRouter,&theToken); if (testPtr == NULL) theToken.type = STOP; else EvaluateExpression(theEnv,testPtr,&rv); ReturnExpression(theEnv,testPtr); } /*=================*/ /* Close router. */ /*=================*/ CloseStringSource(theEnv,theStrRouter); /*================================================*/ /* Return TRUE if no error occurred while loading */ /* the facts, otherwise return FALSE. */ /*================================================*/ if (EvaluationData(theEnv)->EvaluationError) return(FALSE); return(TRUE); } /**************************************************************************/ /* StandardLoadFact: Loads a single fact from the specified logical name. */ /**************************************************************************/ static struct expr *StandardLoadFact( void *theEnv, const char *logicalName, struct token *theToken) { int error = FALSE; struct expr *temp; GetToken(theEnv,logicalName,theToken); if (theToken->type != LPAREN) return(NULL); temp = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert")); temp->argList = GetRHSPattern(theEnv,logicalName,theToken,&error, TRUE,FALSE,TRUE,RPAREN); if (error == TRUE) { EnvPrintRouter(theEnv,WERROR,"Function load-facts encountered an error\n"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,temp); return(NULL); } if (ExpressionContainsVariables(temp,TRUE)) { ReturnExpression(theEnv,temp); return(NULL); } return(temp); } #if (! RUN_TIME) /****************************************************************/ /* AssertParse: Driver routine for parsing the assert function. */ /****************************************************************/ static struct expr *AssertParse( void *theEnv, struct expr *top, const char *logicalName) { int error; struct expr *rv; struct token theToken; ReturnExpression(theEnv,top); SavePPBuffer(theEnv," "); IncrementIndentDepth(theEnv,8); rv = BuildRHSAssert(theEnv,logicalName,&theToken,&error,TRUE,TRUE,"assert command"); DecrementIndentDepth(theEnv,8); return(rv); } #endif /* (! RUN_TIME) */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS globle void Facts( const char *logicalName, void *vTheModule, long long start, long long end, long long max) { EnvFacts(GetCurrentEnvironment(),logicalName,vTheModule,start,end,max); } #endif /* DEBUGGING_FUNCTIONS */ globle intBool LoadFacts( const char *fileName) { return EnvLoadFacts(GetCurrentEnvironment(),fileName); } globle intBool SaveFacts( const char *fileName, int saveCode) { return EnvSaveFacts(GetCurrentEnvironment(),fileName,saveCode); } globle intBool LoadFactsFromString( const char *theString, int theMax) { return EnvLoadFactsFromString(GetCurrentEnvironment(),theString,theMax); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/objrtmch.h0000755000175000017500000001263412374023157016224 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Modified the QueueObjectMatchAction function */ /* so that instance retract actions always occur */ /* before instance assert and modify actions. */ /* This prevents the pattern matching process */ /* from attempting the evaluation of a join */ /* expression that accesses the slots of a */ /* retracted instance. */ /* */ /* Added support for hashed alpha memories. */ /* */ /* Support for long long integers. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /*************************************************************/ #ifndef _H_objrtmch #define _H_objrtmch #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #define OBJECT_ASSERT 1 #define OBJECT_RETRACT 2 #define OBJECT_MODIFY 3 #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_symbol #include "symbol.h" #endif typedef struct classBitMap { unsigned short maxid; char map[1]; } CLASS_BITMAP; #define ClassBitMapSize(bmp) ((sizeof(CLASS_BITMAP) + \ (sizeof(char) * (bmp->maxid / BITS_PER_BYTE)))) typedef struct slotBitMap { unsigned short maxid; char map[1]; } SLOT_BITMAP; #define SlotBitMapSize(bmp) ((sizeof(SLOT_BITMAP) + \ (sizeof(char) * (bmp->maxid / BITS_PER_BYTE)))) typedef struct objectAlphaNode OBJECT_ALPHA_NODE; typedef struct objectPatternNode { unsigned blocked : 1; unsigned multifieldNode : 1; unsigned endSlot : 1; unsigned selector : 1; unsigned whichField : 8; unsigned short leaveFields; unsigned long long matchTimeTag; int slotNameID; EXPRESSION *networkTest; struct objectPatternNode *nextLevel; struct objectPatternNode *lastLevel; struct objectPatternNode *leftNode; struct objectPatternNode *rightNode; OBJECT_ALPHA_NODE *alphaNode; long bsaveID; } OBJECT_PATTERN_NODE; struct objectAlphaNode { struct patternNodeHeader header; unsigned long long matchTimeTag; BITMAP_HN *classbmp,*slotbmp; OBJECT_PATTERN_NODE *patternNode; struct objectAlphaNode *nxtInGroup, *nxtTerminal; long bsaveID; }; typedef struct objectMatchAction { int type; INSTANCE_TYPE *ins; SLOT_BITMAP *slotNameIDs; struct objectMatchAction *nxt; } OBJECT_MATCH_ACTION; #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTMCH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ObjectMatchDelay(void *,DATA_OBJECT *); LOCALE intBool SetDelayObjectPatternMatching(void *,int); LOCALE intBool GetDelayObjectPatternMatching(void *); LOCALE OBJECT_PATTERN_NODE *ObjectNetworkPointer(void *); LOCALE OBJECT_ALPHA_NODE *ObjectNetworkTerminalPointer(void *); LOCALE void SetObjectNetworkPointer(void *,OBJECT_PATTERN_NODE *); LOCALE void SetObjectNetworkTerminalPointer(void *,OBJECT_ALPHA_NODE *); LOCALE void ObjectNetworkAction(void *,int,INSTANCE_TYPE *,int); LOCALE void ResetObjectMatchTimeTags(void *); #endif /* DEFRULE_CONSTRUCT && OBJECT_SYSTEM */ #endif /* _H_objrtmch */ clips_core_source_630/core/objrtbld.h0000755000175000017500000000557712374023174016225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* OBJECT PATTERN MATCHER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for long long integers. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Added support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_objrtbld #define _H_objrtbld #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTBLD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectPatternStuff(void *); #endif /* DEFRULE_CONSTRUCT && OBJECT_SYSTEM */ #endif /* _H_objrtbld */ clips_core_source_630/core/._insmoddp.h0000755000175000017500000000040712373756343016452 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/agenda.h0000755000175000017500000001617412424473432015637 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* AGENDA HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Provides functionality for examining, manipulating, */ /* adding, and removing activations from the agenda. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES and */ /* DYNAMIC_SALIENCE compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvGetActivationBasisPPForm function. */ /* */ /* 6.30: Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /* Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_agenda #define _H_agenda #ifndef _H_ruledef #include "ruledef.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_match #include "match.h" #endif #define WHEN_DEFINED 0 #define WHEN_ACTIVATED 1 #define EVERY_CYCLE 2 #define MAX_DEFRULE_SALIENCE 10000 #define MIN_DEFRULE_SALIENCE -10000 /*******************/ /* DATA STRUCTURES */ /*******************/ struct activation { struct defrule *theRule; struct partialMatch *basis; int salience; unsigned long long timetag; int randomID; struct activation *prev; struct activation *next; }; struct salienceGroup { int salience; struct activation *first; struct activation *last; struct salienceGroup *next; struct salienceGroup *prev; }; typedef struct activation ACTIVATION; #define AGENDA_DATA 17 struct agendaData { #if DEBUGGING_FUNCTIONS unsigned WatchActivations; #endif unsigned long NumberOfActivations; unsigned long long CurrentTimetag; int AgendaChanged; intBool SalienceEvaluation; int Strategy; }; #define AgendaData(theEnv) ((struct agendaData *) GetEnvironmentData(theEnv,AGENDA_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _AGENDA_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /****************************************/ /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */ /****************************************/ LOCALE void AddActivation(void *,void *,void *); LOCALE void ClearRuleFromAgenda(void *,void *); LOCALE void *EnvGetNextActivation(void *,void *); LOCALE struct partialMatch *EnvGetActivationBasis(void *,void *); LOCALE const char *EnvGetActivationName(void *,void *); LOCALE struct defrule *EnvGetActivationRule(void *,void *); LOCALE int EnvGetActivationSalience(void *,void *); LOCALE int EnvSetActivationSalience(void *,void *,int); LOCALE void EnvGetActivationPPForm(void *,char *,size_t,void *); LOCALE void EnvGetActivationBasisPPForm(void *,char *,size_t,void *); LOCALE intBool MoveActivationToTop(void *,void *); LOCALE intBool EnvDeleteActivation(void *,void *); LOCALE intBool DetachActivation(void *,void *); LOCALE void EnvAgenda(void *,const char *,void *); LOCALE void RemoveActivation(void *,void *,int,int); LOCALE void RemoveAllActivations(void *); LOCALE int EnvGetAgendaChanged(void *); LOCALE void EnvSetAgendaChanged(void *,int); LOCALE unsigned long GetNumberOfActivations(void *); LOCALE intBool EnvGetSalienceEvaluation(void *); LOCALE intBool EnvSetSalienceEvaluation(void *,intBool); LOCALE void EnvRefreshAgenda(void *,void *); LOCALE void EnvReorderAgenda(void *,void *); LOCALE void InitializeAgenda(void *); LOCALE void *SetSalienceEvaluationCommand(void *); LOCALE void *GetSalienceEvaluationCommand(void *); LOCALE void RefreshAgendaCommand(void *); LOCALE void RefreshCommand(void *); LOCALE intBool EnvRefresh(void *,void *); #if DEBUGGING_FUNCTIONS LOCALE void AgendaCommand(void *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void Agenda(const char *,void *); LOCALE intBool DeleteActivation(void *); LOCALE struct partialMatch *GetActivationBasis(void *); LOCALE const char *GetActivationName(void *); LOCALE void GetActivationPPForm(char *,unsigned,void *); LOCALE struct defrule *GetActivationRule(void *); LOCALE int GetActivationSalience(void *); LOCALE int GetAgendaChanged(void); LOCALE void *GetNextActivation(void *); LOCALE intBool GetSalienceEvaluation(void); LOCALE intBool Refresh(void *); LOCALE void RefreshAgenda(void *); LOCALE void ReorderAgenda(void *); LOCALE int SetActivationSalience(void *,int); LOCALE void SetAgendaChanged(int); LOCALE intBool SetSalienceEvaluation(int); #endif #endif clips_core_source_630/core/._classini.h0000755000175000017500000000040712373714502016431 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globlcmp.h0000755000175000017500000000425712373753367016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_globlcmp #define _H_globlcmp #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefglobalCompilerSetup(void *); LOCALE void DefglobalCModuleReference(void *,FILE *,int,int,int); LOCALE void DefglobalCConstructReference(void *,FILE *,void *,int,int); #endif /* _H_globlcmp */ clips_core_source_630/core/._insquery.c0000755000175000017500000000040712500141166016466 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/inherpsr.c0000755000175000017500000010021112373755057016240 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* MULTIPLE INHERITANCE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing Routines for Multiple Inheritance */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #include "classcom.h" #include "classfun.h" #include "envrnmnt.h" #include "memalloc.h" #include "modulutl.h" #include "router.h" #include "scanner.h" #define _INHERPSR_SOURCE_ #include "inherpsr.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct partialOrder PARTIAL_ORDER; typedef struct successor SUCCESSOR; struct partialOrder { DEFCLASS *cls; unsigned pre; SUCCESSOR *suc; struct partialOrder *nxt; }; struct successor { PARTIAL_ORDER *po; struct successor *nxt; }; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static PARTIAL_ORDER *InitializePartialOrderTable(void *,PARTIAL_ORDER *,PACKED_CLASS_LINKS *); static void RecordPartialOrders(void *,PARTIAL_ORDER *,DEFCLASS *,PACKED_CLASS_LINKS *,long); static PARTIAL_ORDER *FindPartialOrder(PARTIAL_ORDER *,DEFCLASS *); static void PrintPartialOrderLoop(void *,PARTIAL_ORDER *); static void PrintClassLinks(void *,const char *,const char *,CLASS_LINK *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************** NAME : ParseSuperclasses DESCRIPTION : Parses the (is-a +) portion of the (defclass ...) construct and returns a list of direct superclasses. The class "standard-class" is the precedence list for classes with no direct superclasses. The final precedence list (not calculated here) will have the class in question first followed by the merged precedence lists of its direct superclasses. INPUTS : 1) The logical name of the input source 2) The symbolic name of the new class RETURNS : The address of the superclass list or NULL if there was an error SIDE EFFECTS : None NOTES : Assumes "(defclass [] (" has already been scanned. All superclasses must be defined before their subclasses. Duplicates in the (is-a ...) list are are not allowed (a class may only inherits from a superclass once). This routine also checks the class-precedence lists of each of the direct superclasses for an occurrence of the new class - i.e. cycles! This can only happen when a class is redefined (a new class cannot have an unspecified superclass). This routine allocates the space for the list ***************************************************************/ globle PACKED_CLASS_LINKS *ParseSuperclasses( void *theEnv, const char *readSource, SYMBOL_HN *newClassName) { CLASS_LINK *clink = NULL,*cbot = NULL,*ctmp; DEFCLASS *sclass; PACKED_CLASS_LINKS *plinks; if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"defclass inheritance"); return(NULL); } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (DefclassData(theEnv)->ObjectParseToken.value != (void *) DefclassData(theEnv)->ISA_SYMBOL)) { SyntaxErrorMessage(theEnv,"defclass inheritance"); return(NULL); } SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass"); goto SuperclassParseError; } if (FindModuleSeparator(ValueToString(newClassName))) { IllegalModuleSpecifierMessage(theEnv); goto SuperclassParseError; } if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) newClassName) { PrintErrorID(theEnv,"INHERPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class may not have itself as a superclass.\n"); goto SuperclassParseError; } for (ctmp = clink ; ctmp != NULL ; ctmp = ctmp->nxt) { if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) ctmp->cls->header.name) { PrintErrorID(theEnv,"INHERPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"A class may inherit from a superclass only once.\n"); goto SuperclassParseError; } } sclass = LookupDefclassInScope(theEnv,ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken))); if (sclass == NULL) { PrintErrorID(theEnv,"INHERPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined after all its superclasses.\n"); goto SuperclassParseError; } if ((sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"INHERPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"A user-defined class cannot be a subclass of "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sclass)); EnvPrintRouter(theEnv,WERROR,".\n"); goto SuperclassParseError; } ctmp = get_struct(theEnv,classLink); ctmp->cls = sclass; if (clink == NULL) clink = ctmp; else cbot->nxt = ctmp; ctmp->nxt = NULL; cbot = ctmp; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if (clink == NULL) { PrintErrorID(theEnv,"INHERPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Must have at least one superclass.\n"); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); plinks = get_struct(theEnv,packedClassLinks); PackClassLinks(theEnv,plinks,clink); return(plinks); SuperclassParseError: DeleteClassLinks(theEnv,clink); return(NULL); } /*************************************************************************** NAME : FindPrecedenceList DESCRIPTION : A complete class precedence list is obtained from the list of direct superclasses as follows : Each class and its direct superclasses are recursively entered in order to a list called the partial order table. A class is only entered once. The order reflects a pre-order depth-first traversal of the classes, and this order will be followed as closely as possible to preserve the "family" heuristic when constructing the class precedence list. Attached to each node is a count indicating the number of classes which must precede this class and a list of classes which must succeed this class (attached via the suc field and linked via nxt fields). These predecessor counts and successor lists indicate the partial orderings given by the rules of multiple inheritance for the classes: 1) a class must precede all its superclasses, and 2) a class determines the precedence of its immediate superclasses. For example, the following class definitions (defclass A (is-a USER)) (defclass B (is-a USER)) (defclass C (is-a A B)) would give the following partial orders: C < A by Rule 1 C < B by Rule 1 A < B by Rule 2 B < USER by Rule 1 A < USER by Rule 1 USER < OBJECT by Rule 1 In turn, these partial orders would be recorded in a sequence table: C A USER OBJECT B Predecessor Count 0 1 2 1 2 Successor List A,B B,USER OBJECT USER To generate a precedence list for C, we pick the first class with a predecessor count of 0, append it to the precedence list, and decrement the counts of all its successors. We continue scanning for a 0 from where we left off. If we ever scan completely through the table without finding a 0, then we know there is an error. Shown below is the table above after each class is entered onto the precedence list: Precedence list: C A USER OBJECT B Predecessor Count 0 2 1 1 Successor List B,USER OBJECT USER Precedence list: C A USER OBJECT B Predecessor Count 1 1 0 Successor List OBJECT USER Precedence list: C A B USER OBJECT Predecessor Count 0 1 Successor List OBJECT Precedence list: C A B USER OBJECT Predecessor Count 0 Successor List Precedence List: C A B USER OBJECT And since the table is now empty we are done! INPUTS : 1) The old class definition (NULL if it is new) 2) The list of direct superclasses RETURNS : The address of the precedence list if successful, NULL otherwise SIDE EFFECTS : Precedence list allocated NOTES : WARNING!! - This routine assumes that there are no cyclic dependencies in the given superclass list, i.e. none of the superclasses inherit from the class for which the precedence list is being defined. (This is verified in ParseDefclasses() in CLASSCOM.C) Every class-precedence list has the class itself on it (implicitly) and a built-in system class on it explicitly (except for the built-in classes). The precedence determination algorithm is a variation on the topological sorting algorithm given in The Art of Computer Programming - Vol. I (Fundamental Algorithms) by Donald Knuth. ***************************************************************************/ globle PACKED_CLASS_LINKS *FindPrecedenceList( void *theEnv, DEFCLASS *cls, PACKED_CLASS_LINKS *supers) { PARTIAL_ORDER *po_table = NULL,*start,*pop,*poprv,*potmp; SUCCESSOR *stmp; CLASS_LINK *ptop,*pbot,*ptmp; PACKED_CLASS_LINKS *plinks; long i; /* ===================================================================== Recursively add all superclasses in a pre-order depth-first traversal to the partial order table. There should be only one node per class. ===================================================================== */ po_table = InitializePartialOrderTable(theEnv,po_table,supers); /* ============================================================= If the class already exists, record the rule 1 partial orders with the new superclass lists. This is so that cyclic dependencies can be detected. ============================================================= */ if (cls != NULL) { pop = get_struct(theEnv,partialOrder); pop->cls = cls; pop->pre = 0; pop->suc = NULL; pop->nxt = po_table; po_table = pop; pop = po_table->nxt; RecordPartialOrders(theEnv,po_table,cls,supers,0); } else pop = po_table; /* ================================================================== Record the rule 1 and rule 2 partial orders given by the direct superclass lists of the classes in the table. There is no need to recurse since all possible classes have been entered already. Be sure to skip the class itself if it was added to the front of the table. ================================================================== */ for ( ; pop != NULL ; pop = pop->nxt) { RecordPartialOrders(theEnv,po_table,pop->cls,&pop->cls->directSuperclasses,0); for (i = 0 ; i < pop->cls->directSuperclasses.classCount ; i++) RecordPartialOrders(theEnv,po_table,pop->cls->directSuperclasses.classArray[i], &pop->cls->directSuperclasses,i+1); } /* ============================================================= Record the rule 2 partial orders given by the superclass list ============================================================= */ for (i = 0 ; i < supers->classCount ; i++) RecordPartialOrders(theEnv,po_table,supers->classArray[i],supers,i+1); start = NULL; poprv = NULL; pop = po_table; ptop = pbot = NULL; while (pop != start) { /* ============================================================== Allow wraparound - happens when the search for a 0 node begins somewhere in the middle of the sequence table ============================================================== */ if (pop == NULL) { poprv = NULL; pop = po_table; start = start->nxt; } /* ========================================================= Search for the first class with no remaining predecessors ========================================================= */ if (pop->pre == 0) { /* ================================================= Decrement the predecessor count for all the successors of this class and delete the list. This is the variation on Knuth's algorithm which allows us to preserve the "family" heuristic. Since we will pick up scanning for 0's from this point, we will be able to keep "family" trees together, if possible. BuildPartialOrders() entered the classes into the sequence table in a pre-order depth traversal order. ================================================= */ while (pop->suc != NULL) { stmp = pop->suc; pop->suc = stmp->nxt; stmp->po->pre--; rtn_struct(theEnv,successor,stmp); } /* ============================================= Append the class to the precedence list and remove its entry from the partial order table ============================================= */ potmp = pop; if (poprv == NULL) po_table = pop->nxt; else poprv->nxt = pop->nxt; pop = pop->nxt; start = poprv; ptmp = get_struct(theEnv,classLink); ptmp->cls = potmp->cls; ptmp->nxt = NULL; rtn_struct(theEnv,partialOrder,potmp); if (ptop == NULL) ptop = ptmp; else pbot->nxt = ptmp; pbot = ptmp; } else { poprv = pop; pop = pop->nxt; } } /* ====================================================================== If the table of partial orders is not empty and we were unable to find a class with no predecessors, then there is no solution! Print out the precedence loop in the partial orders. Delete the remaining partial order table and the partial precedence list. ====================================================================== */ if (po_table != NULL) { PrintErrorID(theEnv,"INHERPSR",5,FALSE); PrintClassLinks(theEnv,WERROR,"Partial precedence list formed:",ptop); PrintPartialOrderLoop(theEnv,po_table); while (po_table != NULL) { while (po_table->suc != NULL) { stmp = po_table->suc; po_table->suc = stmp->nxt; rtn_struct(theEnv,successor,stmp); } potmp = po_table; po_table = po_table->nxt; rtn_struct(theEnv,partialOrder,potmp); } DeleteClassLinks(theEnv,ptop); return(NULL); } /* ============================================================================= If the class already existed, be sure and remove it from its own precedence list. Remember that we stuck it on the table artificially to catch cycles. It was first in the table, and, since it started with a predecessor count of zero (given that there were no loops), it is first in the precedence list. We will leave the dummy node there so that functions which wish to iterate over a class and its superclasses may easily do so. ============================================================================= */ if (cls == NULL) { ptmp = get_struct(theEnv,classLink); ptmp->nxt = ptop; ptop = ptmp; } /* ============================================================ The class pointer will be filled in later by ParseDefclass() ============================================================ */ ptop->cls = NULL; plinks = get_struct(theEnv,packedClassLinks); PackClassLinks(theEnv,plinks,ptop); return(plinks); } /*************************************************** NAME : PackClassLinks DESCRIPTION : Writes a list of class links into a contiguous section of memory to reduce overhead (the original list is deleted) INPUTS : 1) The packed list structure to use 2) The top of the original list RETURNS : Nothing useful SIDE EFFECTS : Packed list allocated and old list deleted NOTES : None ***************************************************/ globle void PackClassLinks( void *theEnv, PACKED_CLASS_LINKS *plinks, CLASS_LINK *lptop) { register unsigned count; register CLASS_LINK *lp; for (count = 0 , lp = lptop ; lp != NULL ; lp = lp->nxt) count++; if (count > 0) plinks->classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * count)); else plinks->classArray = NULL; for (count = 0 , lp = lptop ; lp != NULL ; lp = lp->nxt , count++) plinks->classArray[count] = lp->cls; DeleteClassLinks(theEnv,lptop); plinks->classCount = (unsigned short) count; } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************************** NAME : InitializePartialOrderTable DESCRIPTION : This function recursively enters the classes that will be used in a precedence list determination in depth-first pre-order traversal. The predecessor counts and successor list are initialized. INPUTS : 1) The partial order table 2) A list of direct superclasses 3) The class for which a precedence class is being determined (NULL for new class) 4) The class which superclass list is being processed RETURNS : The top of partial order table SIDE EFFECTS : The partial order table is initialized. NOTES : None **************************************************************************/ static PARTIAL_ORDER *InitializePartialOrderTable( void *theEnv, PARTIAL_ORDER *po_table, PACKED_CLASS_LINKS *supers) { register PARTIAL_ORDER *pop,*poprv; long i; for (i = 0 ; i < supers->classCount ; i++) { /* ================================================= Append this class at the end of the partial order table only if it is not already present ================================================= */ poprv = NULL; for (pop = po_table ; pop != NULL ; pop = pop->nxt) { if (pop->cls == supers->classArray[i]) break; poprv = pop; } if (pop == NULL) { pop = get_struct(theEnv,partialOrder); pop->cls = supers->classArray[i]; pop->nxt = NULL; pop->suc = NULL; pop->pre = 0; if (poprv == NULL) po_table = pop; else poprv->nxt = pop; /* ============================================================= Recursively append all its superclasses immediately after it. This order will allow us to preserve the "family" heuristic in the precedence list. ============================================================= */ po_table = InitializePartialOrderTable(theEnv,po_table, &supers->classArray[i]->directSuperclasses); } } return(po_table); } /*********************************************************************************** NAME : RecordPartialOrders DESCRIPTION : Given a predecessor class and a list of successor classes, this function enters a number of partial orders into the table equaling the number of successor classes. INPUTS : 1) The partial order table 2) The predecessor class 3) An array of successor classes 4) A starting index for the successor classes RETURNS : The top of sequence table SIDE EFFECTS : The sequence table is built, e.g.: CLASS1 < CLASS2 , CLASS3 would be recorded as: PO_TABLE -> NXT -> NXT -> NXT -> SUC SUC SUC | | | V V V NXT | V NXT | V The predecessor counts would be 0, 1 and 1 for CLASS1, CLASS2 and CLASS3 respectively. NOTES : None ***********************************************************************************/ static void RecordPartialOrders( void *theEnv, PARTIAL_ORDER *po_table, DEFCLASS *cls, PACKED_CLASS_LINKS *successors, long starti) { register PARTIAL_ORDER *clspo; register SUCCESSOR *stmp; clspo = FindPartialOrder(po_table,cls); while (starti < successors->classCount) { stmp = get_struct(theEnv,successor); stmp->po = FindPartialOrder(po_table,successors->classArray[starti]); stmp->nxt = clspo->suc; clspo->suc = stmp; stmp->po->pre++; starti++; } } /*************************************************** NAME : FindPartialOrder DESCRIPTION : Finds a partial order node INPUTS : 1) The partial order table 2) The class to look up RETURNS : The partial order node address SIDE EFFECTS : None NOTES : None ***************************************************/ static PARTIAL_ORDER *FindPartialOrder( PARTIAL_ORDER *po_table, DEFCLASS *cls) { while (po_table != NULL) { if (po_table->cls == cls) break; po_table = po_table->nxt; } return(po_table); } /************************************************************************** NAME : PrintPartialOrderLoop DESCRIPTION : This routine prints a conflicting loop (there may be more than one) in the given sequence table of partial orders. The algorithm works as follows: Given the following class definitions, (defclass A (is-a USER)) (defclass B (is-a USER)) (defclass C (is-a A B)) (defclass D (is-a B A)) (defclass E (is-a C D)) the partial order table will look as follows after as many classes as possible have been entered onto the precedence list: A USER OBJECT B Predecessor Count 1 2 1 1 Successor List B,USER OBJECT A,USER Construct a new table where each class is linked to one of its predecessors. For the example above one would be: Class: A USER OBJECT B Predecessor: B A USER A This table is actually implemnted using the original partial order table (see the code below for specifics). Now using this table, start with the first node, and visit successive nodes by following the predecessor links. Mark each node as "visited". When a previously visited node is encountered, the loop has been found. In the case above, we start with A, goto B and then goto A again which we have already seen. So starting from where we found the loop (A) we follow the links again, printing the nodes as we go, until we're back where we started: A B A. Notice that this loop reflects the Rule 2 conflicts between Class C and Class D in Class E's precedence list. INPUTS : The remaining partial order table of conflicting partial orders RETURNS : Nothing useful SIDE EFFECTS : The predecessor counts and successor lists are modified to implement the loop detection. NOTES : This algorithm is adopted from one given in Donald Knuth's The Art of Computer Programming - Vol. I (Fundamental Algorithms). **************************************************************************/ static void PrintPartialOrderLoop( void *theEnv, PARTIAL_ORDER *po_table) { register PARTIAL_ORDER *pop1,*pop2; SUCCESSOR *prc,*stmp; /* ==================================================== Set the predecessor count of every node to 0 so that this field can be used as a marker ==================================================== */ for (pop1 = po_table ; pop1 != NULL ; pop1 = pop1->nxt) pop1->pre = 0; /* ======================================================= Mark each node in the partial order table with one of its predecessors. If the class has already been marked (predecessor count > 0), don't bother. This is accomplished by adding a node to the front of its successors' successor lists. When the process is finished, all nodes will have one predecessor chained to them by their 'suc' field. (If any nodes had had no predecessors, they would not still be in the table.) ======================================================= */ for (pop1 = po_table ; pop1 != NULL ; pop1 = pop1->nxt) { if (pop1->pre == 0) { prc = pop1->suc; pop1->suc = NULL; } else { prc = pop1->suc->nxt; pop1->suc->nxt = NULL; } while (prc != NULL) { pop2 = FindPartialOrder(po_table,prc->po->cls); if (pop2->pre == 0) { stmp = get_struct(theEnv,successor); stmp->po = pop1; stmp->nxt = pop2->suc; pop2->suc = stmp; pop2->pre = 1; } stmp = prc; prc = prc->nxt; rtn_struct(theEnv,successor,stmp); } } /* ================================================= Set the predecessor count of every node back to 0 so that this field can be used as a marker again ================================================= */ for (pop1 = po_table ; pop1 != NULL ; pop1 = pop1->nxt) pop1->pre = 0; /* ========================================================= Now start with the first node in the partial order table, and follow the predecessor links, marking the nodes as they are visited. When we reach a node we have been before, we have found a loop! Follow all the marked nodes again starting from the CURRENT position to print the loop. ========================================================= */ pop1 = po_table; while (pop1->pre == 0) { pop1->pre = 1; pop1 = pop1->suc->po; } EnvPrintRouter(theEnv,WERROR,"Precedence loop in superclasses:"); while (pop1->pre == 1) { EnvPrintRouter(theEnv,WERROR," "); PrintClassName(theEnv,WERROR,pop1->cls,FALSE); pop1->pre = 0; pop1 = pop1->suc->po; } EnvPrintRouter(theEnv,WERROR," "); PrintClassName(theEnv,WERROR,pop1->cls,TRUE); } /*************************************************** NAME : PrintClassLinks DESCRIPTION : Displays the names of classes in a list with a title INPUTS : 1) The logical name of the output 2) Title string 3) List of class links RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintClassLinks( void *theEnv, const char *logicalName, const char *title, CLASS_LINK *clink) { if (title != NULL) EnvPrintRouter(theEnv,logicalName,title); while (clink != NULL) { EnvPrintRouter(theEnv,logicalName," "); PrintClassName(theEnv,logicalName,clink->cls,FALSE); clink = clink->nxt; } EnvPrintRouter(theEnv,logicalName,"\n"); } #endif clips_core_source_630/core/._retract.h0000755000175000017500000000040712500146515016263 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._engine.h0000755000175000017500000000040712464554105016073 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/conscomp.c0000755000175000017500000015617012462771770016245 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* CONSTRUCT COMPILER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for the constructs-to-c */ /* command. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* Barry Cameron */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modifications to use the system constant */ /* FILENAME_MAX to check file name lengths. */ /* DR0856 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Used EnvClear rather than Clear in */ /* InitCImage initialization code. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Removed SHORT_LINK_NAMES code as this option */ /* is no longer supported. */ /* */ /* Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* 6.30: Added path name argument to constructs-to-c. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, MAC_MCW, */ /* IBM_TBC, IBM_MSC, IBM_ICB, IBM_ZTC, and */ /* IBM_SC). */ /* */ /* Use genstrcpy instead of strcpy. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _CONSCOMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include #include #include "symbol.h" #include "memalloc.h" #include "constant.h" #include "exprnpsr.h" #include "cstrccom.h" #include "constrct.h" #include "argacces.h" #include "cstrncmp.h" #include "router.h" #include "sysdep.h" #include "utility.h" #include "modulcmp.h" #include "envrnmnt.h" #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxcmp.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltcmp.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globlcmp.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccmp.h" #endif #if OBJECT_SYSTEM #include "objcmp.h" #endif #include "conscomp.h" /***************/ /* DEFINITIONS */ /***************/ #define EXTRA_FILE_NAME 20 /**********************************************/ /* CONSTRUCT CODES DEFINITIONS: The codes F, */ /* I, B, S, E, P, L, and C are not included */ /* because those are already taken. */ /* */ /* B: BitMap hash nodes */ /* C: Constraint hash nodes */ /* E: Expression hash nodes */ /* F: Float hash nodes */ /* I: Integer hash nodes */ /* L: Bitmaps */ /* P: Functions */ /* S: Symbol hash nodes */ /**********************************************/ #define PRIMARY_CODES "ADGHJKMNOQRTUVWXYZ" #define PRIMARY_LEN 18 #define SECONDARY_CODES "ABCDEFGHIJKLMNOPQRSTUVWXYZ" #define SECONDARY_LEN 26 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ void ConstructsToCCommand(void *); static int ConstructsToC(void *,const char *,const char *,char *,long long,long long); static void WriteFunctionExternDeclarations(void *,FILE *); static int FunctionsToCode(void *theEnv,const char *,const char *,char *); static int WriteInitializationFunction(void *,const char *,const char *,char *); static void DumpExpression(void *,struct expr *); static void MarkConstruct(void *,struct constructHeader *,void *); static void HashedExpressionsToCode(void *); static void DeallocateConstructCompilerData(void *); /**********************************************************/ /* InitializeConstructCompilerData: Allocates environment */ /* data for the constructs-to-c command. */ /**********************************************************/ globle void InitializeConstructCompilerData( void *theEnv) { AllocateEnvironmentData(theEnv,CONSTRUCT_COMPILER_DATA,sizeof(struct constructCompilerData),DeallocateConstructCompilerData); ConstructCompilerData(theEnv)->MaxIndices = 2000; ConstructCompilerData(theEnv)->CodeGeneratorCount = 0; } /************************************************************/ /* DeallocateConstructCompilerData: Deallocates environment */ /* data for the constructs-to-c command. */ /************************************************************/ static void DeallocateConstructCompilerData( void *theEnv) { struct CodeGeneratorItem *tmpPtr, *nextPtr; int i; tmpPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; for (i = 0; i < tmpPtr->arrayCount ; i++) { rm(theEnv,tmpPtr->arrayNames[i],strlen(tmpPtr->arrayNames[i]) + 1); } if (tmpPtr->arrayCount != 0) { rm(theEnv,tmpPtr->arrayNames,sizeof(char *) * tmpPtr->arrayCount); } rtn_struct(theEnv,CodeGeneratorItem,tmpPtr); tmpPtr = nextPtr; } } /**********************************************/ /* ConstructsToCCommand: H/L access routine */ /* for the constructs-to-c command. */ /**********************************************/ globle void ConstructsToCCommand( void *theEnv) { const char *fileName; char *fileNameBuffer; const char *pathName; DATA_OBJECT theArg; int argCount; long long id, max; int nameLength, pathLength; #if VAX_VMS || WIN_MVC int i; #endif /*============================================*/ /* Check for appropriate number of arguments. */ /*============================================*/ if ((argCount = EnvArgRangeCheck(theEnv,"constructs-to-c",2,4)) == -1) return; /*====================================================*/ /* Get the name of the file in which to place C code. */ /*====================================================*/ if (EnvArgTypeCheck(theEnv,"constructs-to-c",1,SYMBOL_OR_STRING,&theArg) == FALSE) { return; } fileName = DOToString(theArg); nameLength = (int) strlen(fileName); /*================================*/ /* File names for the VAX and IBM */ /* PCs can't contain a period. */ /*================================*/ #if VAX_VMS || WIN_MVC for (i = 0 ; *(fileName+i) ; i++) { if (*(fileName+i) == '.') { PrintErrorID(theEnv,"CONSCOMP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid file name "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR," contains \'.\'\n"); return; } } #endif /*==========================================================*/ /* The maximum file name size that can be passed into fopen */ /* is specified by FILENAME_MAX. Assume that the most */ /* characters that will be appended to the file prefix will */ /* be 20 and check that the prefix plus the additional */ /* characters is less than the supported maximum. */ /*==========================================================*/ if ((nameLength + EXTRA_FILE_NAME) > FILENAME_MAX) { PrintErrorID(theEnv,"CONSCOMP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Aborting because the base file name may cause the fopen maximum of "); PrintLongInteger(theEnv,WERROR,FILENAME_MAX); EnvPrintRouter(theEnv,WERROR," to be violated when file names are generated.\n"); return; } /*===========================================*/ /* If the base file name is greater than 3 */ /* characters, issue a warning that the file */ /* name lengths may exceed what is allowed */ /* under some operating systems. */ /*===========================================*/ if (nameLength > 3) { PrintWarningID(theEnv,"CONSCOMP",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Base file name exceeds 3 characters.\n"); EnvPrintRouter(theEnv,WWARNING," This may cause files to be overwritten if file name length\n"); EnvPrintRouter(theEnv,WWARNING," is limited on your platform.\n"); } /*====================================*/ /* Get the runtime image ID argument. */ /*====================================*/ if (EnvArgTypeCheck(theEnv,"constructs-to-c",2,INTEGER,&theArg) == FALSE) { return; } id = DOToLong(theArg); if (id < 0) { ExpectedTypeError1(theEnv,"constructs-to-c",2,"positive integer"); return; } /*==================================================*/ /* Get the path name argument if one was specified. */ /*==================================================*/ if (argCount == 3) { if (EnvArgTypeCheck(theEnv,"constructs-to-c",3,SYMBOL_OR_STRING,&theArg) == FALSE) { return; } pathName = DOToString(theArg); pathLength = (int) strlen(pathName); } else { pathName = ""; pathLength = 0; } /*===========================================*/ /* Get the maximum number of data structures */ /* to store per file argument (if supplied). */ /*===========================================*/ if (argCount == 4) { if (EnvArgTypeCheck(theEnv,"constructs-to-c",4,INTEGER,&theArg) == FALSE) { return; } max = DOToLong(theArg); if (max < 0) { ExpectedTypeError1(theEnv,"constructs-to-c",4,"positive integer"); return; } } else { max = 10000; } /*============================*/ /* Call the driver routine to */ /* generate the C code. */ /*============================*/ fileNameBuffer = (char *) genalloc(theEnv,nameLength + pathLength + EXTRA_FILE_NAME); ConstructsToC(theEnv,fileName,pathName,fileNameBuffer,id,max); genfree(theEnv,fileNameBuffer,nameLength + pathLength + EXTRA_FILE_NAME); } /***************************************/ /* ConstructsToC: C access routine for */ /* the constructs-to-c command. */ /***************************************/ static int ConstructsToC( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, long long theImageID, long long max) { int fileVersion; struct CodeGeneratorItem *cgPtr; /*===============================================*/ /* Set the global MaxIndices variable indicating */ /* the maximum number of data structures to save */ /* in each file. */ /*===============================================*/ ConstructCompilerData(theEnv)->MaxIndices = (int) max; /* TBD */ /*=====================================================*/ /* Open a header file for dumping general information. */ /*=====================================================*/ gensprintf(fileNameBuffer,"%s%s.h",pathName,fileName); if ((ConstructCompilerData(theEnv)->HeaderFP = GenOpen(theEnv,fileNameBuffer,"w")) == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fileNameBuffer); return(0); } /*============================================*/ /* Open a file for dumping fixup information. */ /*============================================*/ gensprintf(fileNameBuffer,"%s%s_init.c",pathName,fileName); if ((ConstructCompilerData(theEnv)->FixupFP = GenOpen(theEnv,fileNameBuffer,"w")) == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fileNameBuffer); return(0); } /*==================================*/ /* Call the list of functions to be */ /* executed before generating code. */ /*==================================*/ for (cgPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; cgPtr != NULL; cgPtr = cgPtr->next) { if (cgPtr->beforeFunction != NULL) (*cgPtr->beforeFunction)(theEnv); } /*=====================================*/ /* Initialize some global information. */ /*=====================================*/ ConstructCompilerData(theEnv)->FilePrefix = fileName; ConstructCompilerData(theEnv)->PathName = pathName; ConstructCompilerData(theEnv)->FileNameBuffer = fileNameBuffer; ConstructCompilerData(theEnv)->ImageID = (int) theImageID; /* TBD */ ConstructCompilerData(theEnv)->ExpressionFP = NULL; ConstructCompilerData(theEnv)->ExpressionVersion = 1; ConstructCompilerData(theEnv)->ExpressionHeader = TRUE; ConstructCompilerData(theEnv)->ExpressionCount = 0; fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#ifndef _CONSTRUCT_COMPILER_HEADER_\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#define _CONSTRUCT_COMPILER_HEADER_\n\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"setup.h\"\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"expressn.h\"\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"extnfunc.h\"\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"%s\"\n",API_HEADER); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"\n#define VS (void *)\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"\n"); /*=========================================================*/ /* Give extern declarations for user and system functions. */ /*=========================================================*/ WriteFunctionExternDeclarations(theEnv,ConstructCompilerData(theEnv)->HeaderFP); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"\n#endif\n\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"/****************************/\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"/* EXTERN ARRAY DEFINITIONS */\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"/****************************/\n\n"); /*================================================*/ /* Write out the first portion of the fixup file. */ /*================================================*/ fprintf(ConstructCompilerData(theEnv)->FixupFP,"#include \"%s.h\"\n",fileName); fprintf(ConstructCompilerData(theEnv)->FixupFP,"\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"/**********************************/\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"/* CONSTRUCT IMAGE FIXUP FUNCTION */\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"/**********************************/\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"\nvoid FixupCImage_%d(\n",ConstructCompilerData(theEnv)->ImageID); fprintf(ConstructCompilerData(theEnv)->FixupFP," void *theEnv)\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP," {\n"); /*==================================*/ /* Generate code for atomic values, */ /* function definitions, hashed */ /* expressions, and constructs. */ /*==================================*/ AtomicValuesToCode(theEnv,fileName,pathName,fileNameBuffer); FunctionsToCode(theEnv,fileName,pathName,fileNameBuffer); HashedExpressionsToCode(theEnv); ConstraintsToCode(theEnv,fileName,pathName,fileNameBuffer,4, ConstructCompilerData(theEnv)->HeaderFP, ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->MaxIndices); /*===============================*/ /* Call each code generator item */ /* for the various constructs. */ /*===============================*/ fileVersion = 5; for (cgPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; cgPtr != NULL; cgPtr = cgPtr->next) { if (cgPtr->generateFunction != NULL) { (*cgPtr->generateFunction)(theEnv,fileName,pathName,fileNameBuffer,fileVersion,ConstructCompilerData(theEnv)->HeaderFP,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); fileVersion++; } } /*=========================================*/ /* Restore the atomic data bucket values */ /* (which were set to an index reference). */ /*=========================================*/ RestoreAtomicValueBuckets(theEnv); /*============================*/ /* Close the expression file. */ /*============================*/ if (ConstructCompilerData(theEnv)->ExpressionFP != NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"};\n"); GenClose(theEnv,ConstructCompilerData(theEnv)->ExpressionFP); } /*=======================*/ /* Close the fixup file. */ /*=======================*/ if (ConstructCompilerData(theEnv)->FixupFP != NULL) { fprintf(ConstructCompilerData(theEnv)->FixupFP," }\n"); GenClose(theEnv,ConstructCompilerData(theEnv)->FixupFP); } /*====================================*/ /* Write the initialization function. */ /*====================================*/ WriteInitializationFunction(theEnv,fileName,pathName,fileNameBuffer); /*========================*/ /* Close the header file. */ /*========================*/ GenClose(theEnv,ConstructCompilerData(theEnv)->HeaderFP); /*==================================================*/ /* Return TRUE to indicate that the constructs-to-c */ /* command was successfully executed. */ /*==================================================*/ return(TRUE); } /*******************************************************/ /* WriteFunctionExternDeclarations: Loop through the */ /* list of function definitions and generates extern */ /* declarations for them in the specified file. */ /*******************************************************/ static void WriteFunctionExternDeclarations( void *theEnv, FILE *fp) { struct FunctionDefinition *theFunction; fprintf(fp,"\n"); fprintf(fp,"/************************************/\n"); fprintf(fp,"/* EXTERNAL FUNCTION DEFINITIONS */\n"); fprintf(fp,"/************************************/\n\n"); for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { fprintf(fp,"extern "); switch(theFunction->returnValueType) { case 'i': case 'b': fprintf(fp,"int "); break; case 'g': fprintf(fp,"long long "); break; case 'l': fprintf(fp,"long "); break; case 'f': fprintf(fp,"float "); break; case 'd': fprintf(fp,"double "); break; case 'w': case 's': case 'o': fprintf(fp,"void *"); break; case 'c': fprintf(fp,"char "); break; case 'a': case 'x': case 'y': fprintf(fp,"void * "); break; case 'v': case 'm': case 'u': case 'n': case 'j': case 'k': fprintf(fp,"void "); break; default: SystemError(theEnv,"CONSCOMP",1); break; } fprintf(fp,"%s(",theFunction->actualFunctionName); switch(theFunction->returnValueType) { case 'i': case 'b': case 'g': case 'l': case 'f': case 'd': case 'w': case 's': case 'o': case 'c': case 'a': case 'x': case 'y': case 'v': if (theFunction->environmentAware) { fprintf(fp,"void *"); } else { fprintf(fp,"void"); } break; case 'm': case 'u': case 'n': case 'j': case 'k': if (theFunction->environmentAware) { fprintf(fp,"void *,DATA_OBJECT_PTR_ARG"); } else { fprintf(fp,"DATA_OBJECT_PTR_ARG"); } break; } fprintf(fp,");\n"); } } /****************************************************/ /* FunctionsToCode: Generates C code to represent */ /* the function declaration data structures (used */ /* to declare system and user defined functions). */ /****************************************************/ static int FunctionsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer) { short i = 0; FILE *fp; int version = 1; int newHeader = TRUE; struct FunctionDefinition *fctnPtr; /*=============================*/ /* Assign a reference index to */ /* each of the functions. */ /*=============================*/ for (fctnPtr = GetFunctionList(theEnv); fctnPtr != NULL; fctnPtr = fctnPtr->next) { fctnPtr->bsaveIndex = i++; } /*=======================================*/ /* Create the file in which to store the */ /* function definition data structures. */ /*=======================================*/ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,2,version,FALSE)) == NULL) { return(0); } /*===============================================*/ /* Construct the definition of the function list */ /* from the definitions of the functions. */ /*===============================================*/ fprintf(fp,"\n\n"); fprintf(fp,"/************************************/\n"); fprintf(fp,"/* FUNCTION LIST DEFINITION */\n"); fprintf(fp,"/************************************/\n\n"); i = 1; fctnPtr = GetFunctionList(theEnv); while (fctnPtr != NULL) { if (newHeader) { fprintf(fp,"struct FunctionDefinition P%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,version); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct FunctionDefinition P%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,version); newHeader = FALSE; } fprintf(fp,"{"); PrintSymbolReference(theEnv,fp,fctnPtr->callFunctionName); fprintf(fp,",\"%s\",",fctnPtr->actualFunctionName); fprintf(fp,"'%c',",fctnPtr->returnValueType); fprintf(fp,"PTIF %s,",fctnPtr->actualFunctionName); fprintf(fp,"NULL,"); if (fctnPtr->restrictions != NULL) fprintf(fp,"\"%s\",",fctnPtr->restrictions); else fprintf(fp,"NULL,"); fprintf(fp,"0,0,%d,0,",(fctnPtr->environmentAware ? 1 : 0)); PrintFunctionReference(theEnv,fp,fctnPtr->next); i++; fctnPtr = fctnPtr->next; if ((i > ConstructCompilerData(theEnv)->MaxIndices) || (fctnPtr == NULL)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); i = 1; version++; if (fctnPtr != NULL) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,2,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } return(TRUE); } /************************************************************/ /* PrintFunctionReference: Writes the C code representation */ /* of a pointer to a function definition data structure. */ /************************************************************/ globle void PrintFunctionReference( void *theEnv, FILE *fp, struct FunctionDefinition *funcPtr) { if (funcPtr == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&P%d_%d[%d]",ConstructCompilerData(theEnv)->ImageID, (funcPtr->bsaveIndex / ConstructCompilerData(theEnv)->MaxIndices) + 1, funcPtr->bsaveIndex % ConstructCompilerData(theEnv)->MaxIndices); } /******************************************/ /* WriteInitializationFunction: Generates */ /* the C initialization function for */ /* this constructs-to-c module. */ /******************************************/ static int WriteInitializationFunction( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer) { FILE *fp; struct CodeGeneratorItem *cgPtr; /*===============================*/ /* Open the initialization file. */ /*===============================*/ gensprintf(fileNameBuffer,"%s%s.c",pathName,fileName); if ((fp = GenOpen(theEnv,fileNameBuffer,"w")) == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fileNameBuffer); return(FALSE); } /*=====================================*/ /* Write out #includes and prototypes. */ /*=====================================*/ fprintf(fp,"#include \"%s.h\"\n",fileName); fprintf(fp,"\n"); fprintf(fp,"#include \"utility.h\"\n"); fprintf(fp,"#include \"generate.h\"\n"); fprintf(fp,"#include \"envrnmnt.h\"\n"); fprintf(fp,"#include \"expressn.h\"\n"); fprintf(fp,"#include \"extnfunc.h\"\n"); fprintf(fp,"#include \"objrtmch.h\"\n"); fprintf(fp,"#include \"rulebld.h\"\n\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP," void *InitCImage_%d(void);\n",ConstructCompilerData(theEnv)->ImageID); fprintf(ConstructCompilerData(theEnv)->HeaderFP," void FixupCImage_%d(void *);\n",ConstructCompilerData(theEnv)->ImageID); /*============================================*/ /* Begin writing the initialization function. */ /*============================================*/ fprintf(fp,"\n"); fprintf(fp,"/*******************************************/\n"); fprintf(fp,"/* CONSTRUCT IMAGE INITIALIZATION FUNCTION */\n"); fprintf(fp,"/*******************************************/\n"); fprintf(fp,"\nvoid *InitCImage_%d()\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp," {\n"); fprintf(fp," static void *theEnv = NULL;\n\n"); fprintf(fp," if (theEnv != NULL) return(NULL);\n\n"); fprintf(fp," theEnv = CreateRuntimeEnvironment(sht%d,fht%d,iht%d,bmht%d);\n\n", ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ImageID); fprintf(fp," EnvClear(theEnv);\n"); fprintf(fp," RefreshSpecialSymbols(theEnv);\n"); fprintf(fp," InstallFunctionList(theEnv,P%d_1);\n\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp," InitExpressionPointers(theEnv);\n"); fprintf(fp," FixupCImage_%d(theEnv);\n\n",ConstructCompilerData(theEnv)->ImageID); /*==========================================*/ /* Write construct specific initialization. */ /*==========================================*/ cgPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; while (cgPtr != NULL) { if (cgPtr->initFunction != NULL) { (*cgPtr->initFunction)(theEnv,fp,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); fprintf(fp,"\n"); } cgPtr = cgPtr->next; } /*================================*/ /* Close the initialization file. */ /*================================*/ fprintf(fp," return(theEnv);\n"); fprintf(fp," }\n"); GenClose(theEnv,fp); /*========================================*/ /* Return TRUE to indicate initialization */ /* file was successfully written. */ /*========================================*/ return(TRUE); } /**************************************************/ /* NewCFile: Opens a new file for writing C code. */ /**************************************************/ globle FILE *NewCFile( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int id, int version, int reopenOldFile) { FILE *newFP; gensprintf(fileNameBuffer,"%s%s%d_%d.c",pathName,fileName,id,version); if (reopenOldFile) { newFP = GenOpen(theEnv,fileNameBuffer,"a"); } else { newFP = GenOpen(theEnv,fileNameBuffer,"w"); } if (newFP == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fileNameBuffer); return(NULL); } if (reopenOldFile == FALSE) { fprintf(newFP,"#include \"%s.h\"\n",fileName); fprintf(newFP,"\n"); } return(newFP); } /**********************************************************/ /* HashedExpressionsToCode: Traverses the expression hash */ /* table and calls ExpressionToCode to write the C */ /* code representation to a file of every expression in */ /* the table. */ /**********************************************************/ static void HashedExpressionsToCode( void *theEnv) { unsigned i; EXPRESSION_HN *exphash; for (i = 0; i < EXPRESSION_HASH_SIZE; i++) { for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i]; exphash != NULL; exphash = exphash->next) { exphash->bsaveID = ConstructCompilerData(theEnv)->ExpressionCount + (ConstructCompilerData(theEnv)->MaxIndices * ConstructCompilerData(theEnv)->ExpressionVersion); ExpressionToCode(theEnv,NULL,exphash->exp); } } } /*****************************************************/ /* PrintHashedExpressionReference: Writes the C code */ /* representation of a pointer to an expression */ /* stored in the expression hash table. */ /*****************************************************/ globle void PrintHashedExpressionReference( void *theEnv, FILE *theFile, struct expr *theExpression, int imageID, int maxIndices) { long theIDValue; if (theExpression == NULL) { fprintf(theFile,"NULL"); } else { theIDValue = HashedExpressionIndex(theEnv,theExpression); fprintf(theFile,"&E%d_%ld[%ld]", imageID, theIDValue / maxIndices, theIDValue % maxIndices); } } /**************************************************************/ /* ExpressionToCode: Writes the C code reference of a pointer */ /* to an expression and then calls DumpExpression to write */ /* the C code for the expression to the expression file. */ /**************************************************************/ globle int ExpressionToCode( void *theEnv, FILE *fp, struct expr *exprPtr) { /*========================================*/ /* Print the reference to the expression. */ /*========================================*/ if (exprPtr == NULL) { if (fp != NULL) fprintf(fp,"NULL"); return(FALSE); } else if (fp != NULL) { fprintf(fp,"&E%d_%d[%ld]",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion,ConstructCompilerData(theEnv)->ExpressionCount); } /*==================================================*/ /* Create a new expression code file, if necessary. */ /*==================================================*/ if (ConstructCompilerData(theEnv)->ExpressionHeader == TRUE) { if ((ConstructCompilerData(theEnv)->ExpressionFP = NewCFile(theEnv,ConstructCompilerData(theEnv)->FilePrefix, ConstructCompilerData(theEnv)->PathName, ConstructCompilerData(theEnv)->FileNameBuffer, 3,ConstructCompilerData(theEnv)->ExpressionVersion,FALSE)) == NULL) { return(-1); } fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"struct expr E%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct expr E%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion); ConstructCompilerData(theEnv)->ExpressionHeader = FALSE; } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,",\n"); } /*===========================*/ /* Dump the expression code. */ /*===========================*/ DumpExpression(theEnv,exprPtr); /*=========================================*/ /* Close the expression file if necessary. */ /*=========================================*/ if (ConstructCompilerData(theEnv)->ExpressionCount >= ConstructCompilerData(theEnv)->MaxIndices) { ConstructCompilerData(theEnv)->ExpressionCount = 0; ConstructCompilerData(theEnv)->ExpressionVersion++; fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"};\n"); GenClose(theEnv,ConstructCompilerData(theEnv)->ExpressionFP); ConstructCompilerData(theEnv)->ExpressionFP = NULL; ConstructCompilerData(theEnv)->ExpressionHeader = TRUE; } /*==========================================*/ /* Return TRUE to indicate the expression */ /* reference and expression data structures */ /* were succcessfully written to the file. */ /*==========================================*/ return(TRUE); } /**********************************************************/ /* DumpExpression: Writes the C code representation of an */ /* expression data structure to the expression file. */ /**********************************************************/ static void DumpExpression( void *theEnv, struct expr *exprPtr) { while (exprPtr != NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"{"); fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"%d,",exprPtr->type); fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"VS "); switch (exprPtr->type) { case FCALL: PrintFunctionReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(struct FunctionDefinition *) exprPtr->value); break; case INTEGER: PrintIntegerReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(INTEGER_HN *) exprPtr->value); break; case FLOAT: PrintFloatReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(FLOAT_HN *) exprPtr->value); break; case PCALL: #if DEFFUNCTION_CONSTRUCT PrintDeffunctionReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(DEFFUNCTION *) exprPtr->value, ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case GCALL: #if DEFGENERIC_CONSTRUCT PrintGenericFunctionReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(DEFGENERIC *) exprPtr->value, ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case DEFTEMPLATE_PTR: #if DEFTEMPLATE_CONSTRUCT DeftemplateCConstructReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,exprPtr->value,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case DEFGLOBAL_PTR: #if DEFGLOBAL_CONSTRUCT DefglobalCConstructReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,exprPtr->value,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case DEFCLASS_PTR: #if OBJECT_SYSTEM PrintClassReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(DEFCLASS *) exprPtr->value,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case FACT_ADDRESS: #if DEFTEMPLATE_CONSTRUCT fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); fprintf(ConstructCompilerData(theEnv)->FixupFP, " E%d_%d[%ld].value = &FactData(theEnv)->DummyFact;\n", ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case INSTANCE_ADDRESS: #if OBJECT_SYSTEM fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); fprintf(ConstructCompilerData(theEnv)->FixupFP, " E%d_%d[%ld].value = &InstanceData(theEnv)->DummyInstance;\n", ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case STRING: case SYMBOL: case INSTANCE_NAME: case GBL_VARIABLE: PrintSymbolReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(SYMBOL_HN *) exprPtr->value); break; case RVOID: fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); break; default: if (EvaluationData(theEnv)->PrimitivesArray[exprPtr->type] == NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); } else if (EvaluationData(theEnv)->PrimitivesArray[exprPtr->type]->bitMap) { PrintBitMapReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(BITMAP_HN *) exprPtr->value); } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); } break; } fprintf(ConstructCompilerData(theEnv)->ExpressionFP,","); ConstructCompilerData(theEnv)->ExpressionCount++; if (exprPtr->argList == NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL,"); } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"&E%d_%d[%ld],",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount); } if (exprPtr->nextArg == NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL}"); } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"&E%d_%d[%ld]}",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount + ExpressionSize(exprPtr->argList)); } if (exprPtr->argList != NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,",\n"); DumpExpression(theEnv,exprPtr->argList); } exprPtr = exprPtr->nextArg; if (exprPtr != NULL) fprintf(ConstructCompilerData(theEnv)->ExpressionFP,",\n"); } } /***********************************************/ /* ConstructsToCCommandDefinition: Initializes */ /* the constructs-to-c command. */ /***********************************************/ globle void ConstructsToCCommandDefinition( void *theEnv) { EnvDefineFunction2(theEnv,"constructs-to-c",'v', PTIEF ConstructsToCCommand, "ConstructsToCCommand", "24*kiki"); } /*********************************************************/ /* AddCodeGeneratorItem: Adds another code generator */ /* item to the list of items for which code is */ /* generated bythe constructs-to-c function. Typically */ /* each construct has its own code generator item. */ /*********************************************************/ globle struct CodeGeneratorItem *AddCodeGeneratorItem( void *theEnv, const char *name, int priority, void (*beforeFunction)(void *), void (*initFunction)(void *,FILE *,int,int), int (*generateFunction)(void *,const char *,const char *,char *,int,FILE *,int,int), int arrayCount) { struct CodeGeneratorItem *newPtr, *currentPtr, *lastPtr = NULL; register int i; char theBuffer[3]; /*======================================*/ /* Create the code generator item data */ /* structure and initialize its values. */ /*======================================*/ newPtr = get_struct(theEnv,CodeGeneratorItem); newPtr->name = name; newPtr->beforeFunction = beforeFunction; newPtr->initFunction = initFunction; newPtr->generateFunction = generateFunction; newPtr->priority = priority; newPtr->arrayCount = arrayCount; /*================================================*/ /* Create the primary and secondary codes used to */ /* provide names for the C data structure arrays. */ /* (The maximum number of arrays is currently */ /* limited to 47. */ /*================================================*/ if (arrayCount != 0) { if ((arrayCount + ConstructCompilerData(theEnv)->CodeGeneratorCount) > (PRIMARY_LEN + SECONDARY_LEN)) { SystemError(theEnv,"CONSCOMP",2); EnvExitRouter(theEnv,EXIT_FAILURE); } newPtr->arrayNames = (char **) gm2(theEnv,(sizeof(char *) * arrayCount)); for (i = 0 ; i < arrayCount ; i++) { if (ConstructCompilerData(theEnv)->CodeGeneratorCount < PRIMARY_LEN) { gensprintf(theBuffer,"%c",PRIMARY_CODES[ConstructCompilerData(theEnv)->CodeGeneratorCount]); } else { gensprintf(theBuffer,"%c_",SECONDARY_CODES[ConstructCompilerData(theEnv)->CodeGeneratorCount - PRIMARY_LEN]); } ConstructCompilerData(theEnv)->CodeGeneratorCount++; newPtr->arrayNames[i] = (char *) gm2(theEnv,(strlen(theBuffer) + 1)); genstrcpy(newPtr->arrayNames[i],theBuffer); } } else { newPtr->arrayNames = NULL; } /*===========================================*/ /* Add the new item in the appropriate place */ /* in the code generator item list. */ /*===========================================*/ if (ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems == NULL) { newPtr->next = NULL; ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems = newPtr; return(newPtr); } currentPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } /*=========================*/ /* Return a pointer to the */ /* code generator item. */ /*=========================*/ return(newPtr); } /************************************************************/ /* CloseFileIfNeeded: Determines if a C file to which data */ /* structures have been written should be closed. The */ /* file is closed either when all data structures of */ /* that specific type are written to files or the maximum */ /* number of array entries for a single file has been */ /* exceeded. */ /************************************************************/ globle FILE *CloseFileIfNeeded( void *theEnv, FILE *theFile, int *theCount, int *arrayVersion, int maxIndices, int *canBeReopened, struct CodeGeneratorFile *codeFile) { /*==========================================*/ /* If the maximum number of entries for the */ /* file hasn't been exceeded, then... */ /*==========================================*/ if (*theCount < maxIndices) { /*====================================*/ /* If the file can be reopened later, */ /* close it. Otherwise, keep it open. */ /*====================================*/ if (canBeReopened != NULL) { *canBeReopened = TRUE; GenClose(theEnv,theFile); return(NULL); } return(theFile); } /*===========================================*/ /* Otherwise, the number of entries allowed */ /* in a file has been reached. Indicate that */ /* the file can't be reopened. */ /*===========================================*/ if (canBeReopened != NULL) { *canBeReopened = FALSE; } /*===============================================*/ /* If the file is closed, then we need to reopen */ /* it to print the final closing right brace. */ /*===============================================*/ if (theFile == NULL) { if ((canBeReopened == NULL) || (codeFile == NULL)) { SystemError(theEnv,"CONSCOMP",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (codeFile->filePrefix == NULL) { return(NULL); } theFile = NewCFile(theEnv,codeFile->filePrefix,codeFile->pathName,codeFile->fileNameBuffer,codeFile->id,codeFile->version,TRUE); if (theFile == NULL) { SystemError(theEnv,"CONSCOMP",4); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*================================*/ /* Print the final closing brace. */ /*================================*/ fprintf(theFile,"};\n"); GenClose(theEnv,theFile); /*============================================*/ /* Update index values for subsequent writing */ /* of data structures to files. */ /*============================================*/ *theCount = 0; (*arrayVersion)++; /*=========================*/ /* Return NULL to indicate */ /* the file is closed. */ /*=========================*/ return(NULL); } /**************************************************************/ /* OpenFileIfNeeded: Determines if a C file to which data */ /* structures have been written should be closed. The */ /* file is closed either when all data structures of */ /* that specific type are written to files or the maximum */ /* number of array entries for a single file has been */ /* exceeded. */ /******************************************************************/ globle FILE *OpenFileIfNeeded( void *theEnv, FILE *theFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, int *fileCount, int arrayVersion, FILE *headerFP, const char *structureName, char *structPrefix, int reopenOldFile, struct CodeGeneratorFile *codeFile) { char arrayName[80]; const char *newName; int newID, newVersion; /*===========================================*/ /* If a file is being reopened, use the same */ /* version number, name, and ID as before. */ /*===========================================*/ if (reopenOldFile) { if (codeFile == NULL) { SystemError(theEnv,"CONSCOMP",5); EnvExitRouter(theEnv,EXIT_FAILURE); } newName = codeFile->filePrefix; newID = codeFile->id; newVersion = codeFile->version; } /*=====================================================*/ /* Otherwise, use the specified version number, name, */ /* and ID. If the appropriate argument is supplied, */ /* remember these values for later reopening the file. */ /*=====================================================*/ else { newName = fileName; newVersion = *fileCount; newID = fileID; if (codeFile != NULL) { codeFile->version = newVersion; codeFile->filePrefix = newName; codeFile->id = newID; } } /*=========================================*/ /* If the file is already open, return it. */ /*=========================================*/ if (theFile != NULL) { fprintf(theFile,",\n"); return(theFile); } /*================*/ /* Open the file. */ /*================*/ if ((theFile = NewCFile(theEnv,newName,pathName,fileNameBuffer,newID,newVersion,reopenOldFile)) == NULL) { return(NULL); } /*=========================================*/ /* If this is the first time the file has */ /* been opened, write out the beginning of */ /* the array variable definition. */ /*=========================================*/ if (reopenOldFile == FALSE) { (*fileCount)++; gensprintf(arrayName,"%s%d_%d",structPrefix,imageID,arrayVersion); fprintf(theFile,"%s %s[] = {\n",structureName,arrayName); fprintf(headerFP,"extern %s %s[];\n",structureName,arrayName); } else { fprintf(theFile,",\n"); } /*==================*/ /* Return the file. */ /*==================*/ return(theFile); } /*************************************************/ /* MarkConstructBsaveIDs: Mark all occurences of */ /* a specific construct with a unique ID. */ /*************************************************/ globle void MarkConstructBsaveIDs( void *theEnv, int constructModuleIndex) { long theCount = 0; DoForAllConstructs(theEnv,MarkConstruct,constructModuleIndex,FALSE,&theCount); } /*************************************************************/ /* MarkConstruct: Sets the bsaveID for a specific construct. */ /* Used with the MarkConstructBsaveIDs function to mark all */ /* occurences of a specific construct with a unique ID. */ /*************************************************************/ static void MarkConstruct( void *theEnv, struct constructHeader *theConstruct, void *vTheBuffer) { long *count = (long *) vTheBuffer; #if MAC_XCD #pragma unused(theEnv) #endif theConstruct->bsaveID = (*count)++; } /***********************************************************/ /* ConstructHeaderToCode: Writes the C code representation */ /* of a single construct header to the specified file. */ /***********************************************************/ globle void ConstructHeaderToCode( void *theEnv, FILE *theFile, struct constructHeader *theConstruct, int imageID, int maxIndices, int moduleCount, const char *constructModulePrefix, const char *constructPrefix) { /*================*/ /* Construct Name */ /*================*/ fprintf(theFile,"{"); PrintSymbolReference(theEnv,theFile,theConstruct->name); /*===================*/ /* Pretty Print Form */ /*===================*/ fprintf(theFile,",NULL,"); /*====================*/ /* Construct Module */ /*====================*/ fprintf(theFile,"MIHS &%s%d_%d[%d],", constructModulePrefix, imageID, (moduleCount / maxIndices) + 1, moduleCount % maxIndices); /*==========*/ /* Bsave ID */ /*==========*/ fprintf(theFile,"0,"); /*================*/ /* Next Construct */ /*================*/ if (theConstruct->next == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"CHS &%s%d_%ld[%ld]}", constructPrefix, imageID, (theConstruct->next->bsaveID / maxIndices) + 1, theConstruct->next->bsaveID % maxIndices); } } /***********************************************************/ /* ConstructModuleToCode: Writes the C code representation */ /* of a single construct module to the specified file. */ /***********************************************************/ globle void ConstructModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int constructIndex, const char *constructPrefix) { struct defmoduleItemHeader *theModuleItem; /*======================*/ /* Associated Defmodule */ /*======================*/ fprintf(theFile,"{"); theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,constructIndex); PrintDefmoduleReference(theEnv,theFile,theModule); fprintf(theFile,","); /*=============================*/ /* First Construct Module Item */ /*=============================*/ if (theModuleItem->firstItem == NULL) fprintf(theFile,"NULL,"); else fprintf(theFile,"CHS &%s%d_%ld[%ld],", constructPrefix, imageID, (long) (theModuleItem->firstItem->bsaveID / maxIndices) + 1, (long) theModuleItem->firstItem->bsaveID % maxIndices); /*============================*/ /* Last Construct Module Item */ /*============================*/ if (theModuleItem->lastItem == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"CHS &%s%d_%ld[%ld]", constructPrefix, imageID, (long) (theModuleItem->lastItem->bsaveID / maxIndices) + 1, (long) theModuleItem->lastItem->bsaveID % maxIndices); fprintf(theFile,"}"); } #else /* CONSTRUCT_COMPILER && (! RUN_TIME) */ void ConstructsToCCommand(void *); /************************************/ /* ConstructsToCCommand: Definition */ /* for rule compiler stub. */ /************************************/ void ConstructsToCCommand( void *theEnv) { #if MAC_XCD #pragma unused(theEnv) #endif } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips_core_source_630/core/._symblcmp.h0000755000175000017500000000040712373755525016464 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/drive.h0000755000175000017500000000571712500146076015526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 12/04/07 */ /* */ /* DRIVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the addition of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /* Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Removed pseudo-facts used in not CE. */ /* */ /*************************************************************/ #ifndef _H_drive #define _H_drive #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DRIVE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif void NetworkAssert(void *,struct partialMatch *,struct joinNode *); intBool EvaluateJoinExpression(void *,struct expr *,struct joinNode *); void NetworkAssertLeft(void *,struct partialMatch *,struct joinNode *,int); void NetworkAssertRight(void *,struct partialMatch *,struct joinNode *,int); void PPDrive(void *,struct partialMatch *,struct partialMatch *,struct joinNode *,int); unsigned long BetaMemoryHashValue(void *,struct expr *,struct partialMatch *,struct partialMatch *,struct joinNode *); intBool EvaluateSecondaryNetworkTest(void *,struct partialMatch *,struct joinNode *); void EPMDrive(void *,struct partialMatch *,struct joinNode *,int); #endif /* _H_drive */ clips_core_source_630/core/commline.h0000755000175000017500000001357212373714244016224 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* COMMAND LINE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of routines for processing */ /* commands entered at the top level prompt. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Refactored several functions and added */ /* additional functions for use by an interface */ /* layered on top of CLIPS. */ /* */ /* 6.30: Local variables set with the bind function */ /* persist until a reset/clear command is issued. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Changed integer type/precision. */ /* */ /* Metrowerks CodeWarrior (MAC_MCW, IBM_MCW) is */ /* no longer supported. */ /* */ /* UTF-8 support. */ /* */ /* Command history and editing support */ /* */ /* Used genstrcpy instead of strcpy. */ /* */ /* Added before command execution callback */ /* function. */ /* */ /* Fixed RouteCommand return value. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_commline #define _H_commline #define COMMANDLINE_DATA 40 struct commandLineData { int EvaluatingTopLevelCommand; int HaltCommandLoopBatch; #if ! RUN_TIME struct expr *CurrentCommand; char *CommandString; size_t MaximumCharacters; int ParsingTopLevelCommand; const char *BannerString; int (*EventFunction)(void *); int (*AfterPromptFunction)(void *); int (*BeforeCommandExecutionFunction)(void *); #endif }; #define CommandLineData(theEnv) ((struct commandLineData *) GetEnvironmentData(theEnv,COMMANDLINE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _COMMLINE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeCommandLineData(void *); LOCALE int ExpandCommandString(void *,int); LOCALE void FlushCommandString(void *); LOCALE void SetCommandString(void *,const char *); LOCALE void AppendCommandString(void *,const char *); LOCALE void InsertCommandString(void *,const char *,unsigned); LOCALE char *GetCommandString(void *); LOCALE int CompleteCommand(const char *); LOCALE void CommandLoop(void *); LOCALE void CommandLoopBatch(void *); LOCALE void CommandLoopBatchDriver(void *); LOCALE void PrintPrompt(void *); LOCALE void PrintBanner(void *); LOCALE void SetAfterPromptFunction(void *,int (*)(void *)); LOCALE void SetBeforeCommandExecutionFunction(void *,int (*)(void *)); LOCALE intBool RouteCommand(void *,const char *,int); LOCALE int (*SetEventFunction(void *,int (*)(void *)))(void *); LOCALE intBool TopLevelCommand(void *); LOCALE void AppendNCommandString(void *,const char *,unsigned); LOCALE void SetNCommandString(void *,const char *,unsigned); LOCALE const char *GetCommandCompletionString(void *,const char *,size_t); LOCALE intBool ExecuteIfCommandComplete(void *); LOCALE void CommandLoopOnceThenBatch(void *); LOCALE intBool CommandCompleteAndNotEmpty(void *); LOCALE void SetHaltCommandLoopBatch(void *,int); LOCALE int GetHaltCommandLoopBatch(void *); #endif clips_core_source_630/core/._tmpltpsr.c0000755000175000017500000000040712461252211016474 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._constant.h0000755000175000017500000000033012502204536016443 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/evaluatn.c0000755000175000017500000011736012464554105016232 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* EVALUATION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for evaluating expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EvaluateAndStoreInDataObject function. */ /* */ /* 6.30: Added support for passing context information */ /* to user defined functions. */ /* */ /* Added support for external address hash table */ /* and subtyping. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Support for DATA_OBJECT_ARRAY primitive. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _EVALUATN_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include #include "setup.h" #include "argacces.h" #include "commline.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "extnfunc.h" #include "prcdrfun.h" #include "multifld.h" #include "factmngr.h" #include "prntutil.h" #include "exprnpsr.h" #include "utility.h" #include "proflfun.h" #include "sysdep.h" #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #if OBJECT_SYSTEM #include "object.h" #include "inscom.h" #endif #include "evaluatn.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocateEvaluationData(void *); static void PrintCAddress(void *,const char *,void *); static void NewCAddress(void *,DATA_OBJECT *); /* static intBool DiscardCAddress(void *,void *); */ /**************************************************/ /* InitializeEvaluationData: Allocates environment */ /* data for expression evaluation. */ /**************************************************/ globle void InitializeEvaluationData( void *theEnv) { struct externalAddressType cPointer = { "C", PrintCAddress, PrintCAddress, NULL, NewCAddress, NULL }; AllocateEnvironmentData(theEnv,EVALUATION_DATA,sizeof(struct evaluationData),DeallocateEvaluationData); InstallExternalAddressType(theEnv,&cPointer); } /*****************************************************/ /* DeallocateEvaluationData: Deallocates environment */ /* data for evaluation data. */ /*****************************************************/ static void DeallocateEvaluationData( void *theEnv) { int i; for (i = 0; i < EvaluationData(theEnv)->numberOfAddressTypes; i++) { rtn_struct(theEnv,externalAddressType,EvaluationData(theEnv)->ExternalAddressTypes[i]); } } /**************************************************************/ /* EvaluateExpression: Evaluates an expression. Returns FALSE */ /* if no errors occurred during evaluation, otherwise TRUE. */ /**************************************************************/ globle int EvaluateExpression( void *theEnv, struct expr *problem, DATA_OBJECT_PTR returnValue) { struct expr *oldArgument; void *oldContext; struct FunctionDefinition *fptr; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif if (problem == NULL) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return(EvaluationData(theEnv)->EvaluationError); } switch (problem->type) { case STRING: case SYMBOL: case FLOAT: case INTEGER: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = problem->type; returnValue->value = problem->value; break; case DATA_OBJECT_ARRAY: /* TBD Remove with AddPrimitive */ returnValue->type = problem->type; returnValue->value = problem->value; break; case FCALL: { fptr = (struct FunctionDefinition *) problem->value; oldContext = SetEnvironmentFunctionContext(theEnv,fptr->context); #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &fptr->usrData, ProfileFunctionData(theEnv)->ProfileUserFunctions); #endif oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = problem; switch(fptr->returnValueType) { case 'v' : if (fptr->environmentAware) { (* (void (*)(void *)) fptr->functionPointer)(theEnv); } else { (* (void (*)(void)) fptr->functionPointer)(); } returnValue->type = RVOID; returnValue->value = EnvFalseSymbol(theEnv); break; case 'b' : returnValue->type = SYMBOL; if (fptr->environmentAware) { if ((* (int (*)(void *)) fptr->functionPointer)(theEnv)) returnValue->value = EnvTrueSymbol(theEnv); else returnValue->value = EnvFalseSymbol(theEnv); } else { if ((* (int (*)(void)) fptr->functionPointer)()) returnValue->value = EnvTrueSymbol(theEnv); else returnValue->value = EnvFalseSymbol(theEnv); } break; case 'a' : returnValue->type = EXTERNAL_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } break; case 'g' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(* (long long (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(* (long long (*)(void)) fptr->functionPointer)()); } break; case 'i' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (int (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (int (*)(void)) fptr->functionPointer)()); } break; case 'l' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (long int (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (long int (*)(void)) fptr->functionPointer)()); } break; case 'f' : returnValue->type = FLOAT; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddDouble(theEnv,(double) (* (float (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddDouble(theEnv,(double) (* (float (*)(void)) fptr->functionPointer)()); } break; case 'd' : returnValue->type = FLOAT; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddDouble(theEnv,(* (double (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddDouble(theEnv,(* (double (*)(void)) fptr->functionPointer)()); } break; case 's' : returnValue->type = STRING; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; case 'w' : returnValue->type = SYMBOL; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; #if OBJECT_SYSTEM case 'x' : returnValue->type = INSTANCE_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } if (returnValue->value == NULL) { returnValue->value = (void *) &InstanceData(theEnv)->DummyInstance; } break; case 'o' : returnValue->type = INSTANCE_NAME; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; #endif #if DEFTEMPLATE_CONSTRUCT case 'y' : returnValue->type = FACT_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } if (returnValue->value == NULL) { returnValue->value = (void *) &FactData(theEnv)->DummyFact; } break; #endif case 'c' : { char cbuff[2]; if (fptr->environmentAware) { cbuff[0] = (* (char (*)(void *)) fptr->functionPointer)(theEnv); } else { cbuff[0] = (* (char (*)(void)) fptr->functionPointer)(); } cbuff[1] = EOS; returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,cbuff); break; } case 'j' : case 'k' : case 'm' : case 'n' : case 'u' : if (fptr->environmentAware) { (* (void (*)(void *,DATA_OBJECT_PTR)) fptr->functionPointer)(theEnv,returnValue); } else { (* (void (*)(DATA_OBJECT_PTR)) fptr->functionPointer)(returnValue); } break; default : SystemError(theEnv,"EVALUATN",2); EnvExitRouter(theEnv,EXIT_FAILURE); break; } #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif SetEnvironmentFunctionContext(theEnv,oldContext); EvaluationData(theEnv)->CurrentExpression = oldArgument; break; } case MULTIFIELD: returnValue->type = MULTIFIELD; returnValue->value = ((DATA_OBJECT_PTR) (problem->value))->value; returnValue->begin = ((DATA_OBJECT_PTR) (problem->value))->begin; returnValue->end = ((DATA_OBJECT_PTR) (problem->value))->end; break; case MF_VARIABLE: case SF_VARIABLE: if (GetBoundVariable(theEnv,returnValue,(SYMBOL_HN *) problem->value) == FALSE) { PrintErrorID(theEnv,"EVALUATN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(problem->value)); EnvPrintRouter(theEnv,WERROR," is unbound\n"); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); } break; default: if (EvaluationData(theEnv)->PrimitivesArray[problem->type] == NULL) { SystemError(theEnv,"EVALUATN",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->copyToEvaluate) { returnValue->type = problem->type; returnValue->value = problem->value; break; } if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction == NULL) { SystemError(theEnv,"EVALUATN",4); EnvExitRouter(theEnv,EXIT_FAILURE); } oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = problem; #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &EvaluationData(theEnv)->PrimitivesArray[problem->type]->usrData, ProfileFunctionData(theEnv)->ProfileUserFunctions); #endif (*EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction)(theEnv,problem->value,returnValue); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif EvaluationData(theEnv)->CurrentExpression = oldArgument; break; } return(EvaluationData(theEnv)->EvaluationError); } /******************************************/ /* InstallPrimitive: Installs a primitive */ /* data type in the primitives array. */ /******************************************/ globle void InstallPrimitive( void *theEnv, struct entityRecord *thePrimitive, int whichPosition) { if (EvaluationData(theEnv)->PrimitivesArray[whichPosition] != NULL) { SystemError(theEnv,"EVALUATN",5); EnvExitRouter(theEnv,EXIT_FAILURE); } EvaluationData(theEnv)->PrimitivesArray[whichPosition] = thePrimitive; } /******************************************************/ /* InstallExternalAddressType: Installs an external */ /* address type in the external address type array. */ /******************************************************/ globle int InstallExternalAddressType( void *theEnv, struct externalAddressType *theAddressType) { struct externalAddressType *copyEAT; int rv = EvaluationData(theEnv)->numberOfAddressTypes; if (EvaluationData(theEnv)->numberOfAddressTypes == MAXIMUM_EXTERNAL_ADDRESS_TYPES) { SystemError(theEnv,"EVALUATN",6); EnvExitRouter(theEnv,EXIT_FAILURE); } copyEAT = (struct externalAddressType *) genalloc(theEnv,sizeof(struct externalAddressType)); memcpy(copyEAT,theAddressType,sizeof(struct externalAddressType)); EvaluationData(theEnv)->ExternalAddressTypes[EvaluationData(theEnv)->numberOfAddressTypes++] = copyEAT; return rv; } /******************************************************/ /* SetEvaluationError: Sets the EvaluationError flag. */ /******************************************************/ globle void SetEvaluationError( void *theEnv, int value) { EvaluationData(theEnv)->EvaluationError = value; if (value == TRUE) { EvaluationData(theEnv)->HaltExecution = TRUE; } } /*********************************************************/ /* GetEvaluationError: Returns the EvaluationError flag. */ /*********************************************************/ globle int GetEvaluationError( void *theEnv) { return(EvaluationData(theEnv)->EvaluationError); } /**************************************************/ /* SetHaltExecution: Sets the HaltExecution flag. */ /**************************************************/ globle void SetHaltExecution( void *theEnv, int value) { EvaluationData(theEnv)->HaltExecution = value; } /*****************************************************/ /* GetHaltExecution: Returns the HaltExecution flag. */ /*****************************************************/ globle int GetHaltExecution( void *theEnv) { return(EvaluationData(theEnv)->HaltExecution); } /******************************************************/ /* ReturnValues: Returns a linked list of DATA_OBJECT */ /* structures to the pool of free memory. */ /******************************************************/ globle void ReturnValues( void *theEnv, DATA_OBJECT_PTR garbagePtr, intBool decrementSupplementalInfo) { DATA_OBJECT_PTR nextPtr; while (garbagePtr != NULL) { nextPtr = garbagePtr->next; ValueDeinstall(theEnv,garbagePtr); if ((garbagePtr->supplementalInfo != NULL) && decrementSupplementalInfo) { DecrementSymbolCount(theEnv,(struct symbolHashNode *) garbagePtr->supplementalInfo); } rtn_struct(theEnv,dataObject,garbagePtr); garbagePtr = nextPtr; } } /***************************************************/ /* PrintDataObject: Prints a DATA_OBJECT structure */ /* to the specified logical name. */ /***************************************************/ globle void PrintDataObject( void *theEnv, const char *fileid, DATA_OBJECT_PTR argPtr) { switch(argPtr->type) { case RVOID: case SYMBOL: case STRING: case INTEGER: case FLOAT: case EXTERNAL_ADDRESS: case DATA_OBJECT_ARRAY: // TBD Remove with AddPrimitive case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif PrintAtom(theEnv,fileid,argPtr->type,argPtr->value); break; case MULTIFIELD: PrintMultifield(theEnv,fileid,(struct multifield *) argPtr->value, argPtr->begin,argPtr->end,TRUE); break; default: if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type] != NULL) { if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction)(theEnv,fileid,argPtr->value); break; } else if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction)(theEnv,fileid,argPtr->value); break; } } EnvPrintRouter(theEnv,fileid,"type); EnvPrintRouter(theEnv,fileid,">"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); break; } } /****************************************************/ /* EnvSetMultifieldErrorValue: Creates a multifield */ /* value of length zero for error returns. */ /****************************************************/ globle void EnvSetMultifieldErrorValue( void *theEnv, DATA_OBJECT_PTR returnValue) { returnValue->type = MULTIFIELD; returnValue->value = EnvCreateMultifield(theEnv,0L); returnValue->begin = 1; returnValue->end = 0; } /**************************************************/ /* ValueInstall: Increments the appropriate count */ /* (in use) values for a DATA_OBJECT structure. */ /**************************************************/ globle void ValueInstall( void *theEnv, DATA_OBJECT *vPtr) { if (vPtr->type == MULTIFIELD) MultifieldInstall(theEnv,(struct multifield *) vPtr->value); else AtomInstall(theEnv,vPtr->type,vPtr->value); } /****************************************************/ /* ValueDeinstall: Decrements the appropriate count */ /* (in use) values for a DATA_OBJECT structure. */ /****************************************************/ globle void ValueDeinstall( void *theEnv, DATA_OBJECT *vPtr) { if (vPtr->type == MULTIFIELD) MultifieldDeinstall(theEnv,(struct multifield *) vPtr->value); else AtomDeinstall(theEnv,vPtr->type,vPtr->value); } /*****************************************/ /* AtomInstall: Increments the reference */ /* count of an atomic data type. */ /*****************************************/ globle void AtomInstall( void *theEnv, int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif IncrementSymbolCount(vPtr); break; case FLOAT: IncrementFloatCount(vPtr); break; case INTEGER: IncrementIntegerCount(vPtr); break; case EXTERNAL_ADDRESS: IncrementExternalAddressCount(vPtr); break; case MULTIFIELD: MultifieldInstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)(theEnv,vPtr); } break; } } /*******************************************/ /* AtomDeinstall: Decrements the reference */ /* count of an atomic data type. */ /*******************************************/ globle void AtomDeinstall( void *theEnv, int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif DecrementSymbolCount(theEnv,(SYMBOL_HN *) vPtr); break; case FLOAT: DecrementFloatCount(theEnv,(FLOAT_HN *) vPtr); break; case INTEGER: DecrementIntegerCount(theEnv,(INTEGER_HN *) vPtr); break; case EXTERNAL_ADDRESS: DecrementExternalAddressCount(theEnv,(EXTERNAL_ADDRESS_HN *) vPtr); break; case MULTIFIELD: MultifieldDeinstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) DecrementBitMapCount(theEnv,(BITMAP_HN *) vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount)(theEnv,vPtr); } } } #if DEFFUNCTION_CONSTRUCT || DEFGENERIC_CONSTRUCT /********************************************/ /* EnvFunctionCall: Allows Deffunctions and */ /* Generic Functions to be called from C. */ /* Allows only constants as arguments. */ /********************************************/ globle int EnvFunctionCall( void *theEnv, const char *name, const char *args, DATA_OBJECT *result) { FUNCTION_REFERENCE theReference; /*=======================================*/ /* Call the function if it can be found. */ /*=======================================*/ if (GetFunctionReference(theEnv,name,&theReference)) { return(FunctionCall2(theEnv,&theReference,args,result)); } /*=========================================================*/ /* Otherwise signal an error if a deffunction, defgeneric, */ /* or user defined function doesn't exist that matches */ /* the specified function name. */ /*=========================================================*/ PrintErrorID(theEnv,"EVALUATN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No function, generic function or deffunction of name "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR," exists for external call.\n"); return(TRUE); } /********************************************/ /* FunctionCall2: Allows Deffunctions and */ /* Generic Functions to be called from C. */ /* Allows only constants as arguments. */ /********************************************/ globle int FunctionCall2( void *theEnv, FUNCTION_REFERENCE *theReference, const char *args, DATA_OBJECT *result) { EXPRESSION *argexps; int error = FALSE; /*=============================================*/ /* Force periodic cleanup if the function call */ /* was executed from an embedded application. */ /*=============================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*========================*/ /* Reset the error state. */ /*========================*/ if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE); EvaluationData(theEnv)->EvaluationError = FALSE; /*======================================*/ /* Initialize the default return value. */ /*======================================*/ result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /*============================*/ /* Parse the argument string. */ /*============================*/ argexps = ParseConstantArguments(theEnv,args,&error); if (error == TRUE) return(TRUE); /*====================*/ /* Call the function. */ /*====================*/ theReference->argList = argexps; error = EvaluateExpression(theEnv,theReference,result); /*========================*/ /* Return the expression. */ /*========================*/ ReturnExpression(theEnv,argexps); theReference->argList = NULL; /*==========================*/ /* Return the error status. */ /*==========================*/ return(error); } #endif /***************************************************/ /* CopyDataObject: Copies the values from a source */ /* DATA_OBJECT to a destination DATA_OBJECT. */ /***************************************************/ globle void CopyDataObject( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, int garbageMultifield) { if (src->type != MULTIFIELD) { dst->type = src->type; dst->value = src->value; } else { DuplicateMultifield(theEnv,dst,src); if (garbageMultifield) { AddToMultifieldList(theEnv,(struct multifield *) dst->value); } } } /***********************************************/ /* TransferDataObjectValues: Copies the values */ /* directly from a source DATA_OBJECT to a */ /* destination DATA_OBJECT. */ /***********************************************/ globle void TransferDataObjectValues( DATA_OBJECT *dst, DATA_OBJECT *src) { dst->type = src->type; dst->value = src->value; dst->begin = src->begin; dst->end = src->end; dst->supplementalInfo = src->supplementalInfo; dst->next = src->next; } /************************************************************************/ /* ConvertValueToExpression: Converts the value stored in a data object */ /* into an expression. For multifield values, a chain of expressions */ /* is generated and the chain is linked by the nextArg field. For a */ /* single field value, a single expression is created. */ /************************************************************************/ globle struct expr *ConvertValueToExpression( void *theEnv, DATA_OBJECT *theValue) { long i; struct expr *head = NULL, *last = NULL, *newItem; if (GetpType(theValue) != MULTIFIELD) { return(GenConstant(theEnv,GetpType(theValue),GetpValue(theValue))); } for (i = GetpDOBegin(theValue); i <= GetpDOEnd(theValue); i++) { newItem = GenConstant(theEnv,GetMFType(GetpValue(theValue),i), GetMFValue(GetpValue(theValue),i)); if (last == NULL) head = newItem; else last->nextArg = newItem; last = newItem; } if (head == NULL) return(GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"))); return(head); } /****************************************/ /* GetAtomicHashValue: Returns the hash */ /* value for an atomic data type. */ /****************************************/ unsigned long GetAtomicHashValue( unsigned short type, void *value, int position) { unsigned long tvalue; union { double fv; void *vv; unsigned long liv; } fis; switch (type) { case FLOAT: fis.liv = 0; fis.fv = ValueToDouble(value); tvalue = fis.liv; break; case INTEGER: tvalue = (unsigned long) ValueToLong(value); break; case EXTERNAL_ADDRESS: fis.liv = 0; fis.vv = ValueToExternalAddress(value); tvalue = (unsigned long) fis.liv; break; case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif fis.liv = 0; fis.vv = value; tvalue = (unsigned long) fis.liv; break; case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: tvalue = ((SYMBOL_HN *) value)->bucket; break; default: tvalue = type; } if (position < 0) return(tvalue); return((unsigned long) (tvalue * (((unsigned long) position) + 29))); } /***********************************************************/ /* FunctionReferenceExpression: Returns an expression with */ /* an appropriate expression reference to the specified */ /* name if it is the name of a deffunction, defgeneric, */ /* or user/system defined function. */ /***********************************************************/ globle struct expr *FunctionReferenceExpression( void *theEnv, const char *name) { #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif struct FunctionDefinition *fptr; /*=====================================================*/ /* Check to see if the function call is a deffunction. */ /*=====================================================*/ #if DEFFUNCTION_CONSTRUCT if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL) { return(GenConstant(theEnv,PCALL,dptr)); } #endif /*====================================================*/ /* Check to see if the function call is a defgeneric. */ /*====================================================*/ #if DEFGENERIC_CONSTRUCT if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL) { return(GenConstant(theEnv,GCALL,gfunc)); } #endif /*======================================*/ /* Check to see if the function call is */ /* a system or user defined function. */ /*======================================*/ if ((fptr = FindFunction(theEnv,name)) != NULL) { return(GenConstant(theEnv,FCALL,fptr)); } /*===================================================*/ /* The specified function name is not a deffunction, */ /* defgeneric, or user/system defined function. */ /*===================================================*/ return(NULL); } /******************************************************************/ /* GetFunctionReference: Fills an expression with an appropriate */ /* expression reference to the specified name if it is the */ /* name of a deffunction, defgeneric, or user/system defined */ /* function. */ /******************************************************************/ globle intBool GetFunctionReference( void *theEnv, const char *name, FUNCTION_REFERENCE *theReference) { #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif struct FunctionDefinition *fptr; theReference->nextArg = NULL; theReference->argList = NULL; theReference->type = RVOID; theReference->value = NULL; /*=====================================================*/ /* Check to see if the function call is a deffunction. */ /*=====================================================*/ #if DEFFUNCTION_CONSTRUCT if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL) { theReference->type = PCALL; theReference->value = dptr; return(TRUE); } #endif /*====================================================*/ /* Check to see if the function call is a defgeneric. */ /*====================================================*/ #if DEFGENERIC_CONSTRUCT if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL) { theReference->type = GCALL; theReference->value = gfunc; return(TRUE); } #endif /*======================================*/ /* Check to see if the function call is */ /* a system or user defined function. */ /*======================================*/ if ((fptr = FindFunction(theEnv,name)) != NULL) { theReference->type = FCALL; theReference->value = fptr; return(TRUE); } /*===================================================*/ /* The specified function name is not a deffunction, */ /* defgeneric, or user/system defined function. */ /*===================================================*/ return(FALSE); } /*******************************************************/ /* DOsEqual: Determines if two DATA_OBJECTS are equal. */ /*******************************************************/ globle intBool DOsEqual( DATA_OBJECT_PTR dobj1, DATA_OBJECT_PTR dobj2) { if (GetpType(dobj1) != GetpType(dobj2)) { return(FALSE); } if (GetpType(dobj1) == MULTIFIELD) { if (MultifieldDOsEqual(dobj1,dobj2) == FALSE) { return(FALSE); } } else if (GetpValue(dobj1) != GetpValue(dobj2)) { return(FALSE); } return(TRUE); } /*********************************************************** NAME : EvaluateAndStoreInDataObject DESCRIPTION : Evaluates slot-value expressions and stores the result in a Kernel data object INPUTS : 1) Flag indicating if multifields are OK 2) The value-expression 3) The data object structure 4) Flag indicating if a multifield value should be placed on the garbage list. RETURNS : FALSE on errors, TRUE otherwise SIDE EFFECTS : Segment allocated for storing multifield values NOTES : None ***********************************************************/ globle int EvaluateAndStoreInDataObject( void *theEnv, int mfp, EXPRESSION *theExp, DATA_OBJECT *val, int garbageSegment) { val->type = MULTIFIELD; val->begin = 0; val->end = -1; if (theExp == NULL) { if (garbageSegment) val->value = EnvCreateMultifield(theEnv,0L); else val->value = CreateMultifield2(theEnv,0L); return(TRUE); } if ((mfp == 0) && (theExp->nextArg == NULL)) EvaluateExpression(theEnv,theExp,val); else StoreInMultifield(theEnv,val,theExp,garbageSegment); return(EvaluationData(theEnv)->EvaluationError ? FALSE : TRUE); } /*******************************************************/ /* PrintCAddress: */ /*******************************************************/ static void PrintCAddress( void *theEnv, const char *logicalName, void *theValue) { char buffer[20]; EnvPrintRouter(theEnv,logicalName,""); } /****************/ /* NewCAddress: */ /****************/ static void NewCAddress( void *theEnv, DATA_OBJECT *rv) { int numberOfArguments; numberOfArguments = EnvRtnArgCount(theEnv); if (numberOfArguments != 1) { PrintErrorID(theEnv,"NEW",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function new expected no additional arguments for the C external language type.\n"); SetEvaluationError(theEnv,TRUE); return; } SetpType(rv,EXTERNAL_ADDRESS); SetpValue(rv,EnvAddExternalAddress(theEnv,NULL,0)); } /*******************************************************/ /* DiscardCAddress: TBD Remove */ /*******************************************************/ /* static intBool DiscardCAddress( void *theEnv, void *theValue) { EnvPrintRouter(theEnv,WDISPLAY,"Discarding C Address\n"); return TRUE; } */ /*##################################*/ /* Additional Environment Functions */ /*##################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void SetMultifieldErrorValue( DATA_OBJECT_PTR returnValue) { EnvSetMultifieldErrorValue(GetCurrentEnvironment(),returnValue); } globle int FunctionCall( const char *name, const char *args, DATA_OBJECT *result) { return EnvFunctionCall(GetCurrentEnvironment(),name,args,result); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/factlhs.c0000755000175000017500000002511412373742653016040 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT LHS PATTERN PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains routines for integration of ordered and */ /* deftemplate fact patterns with the defrule LHS pattern */ /* parser including routines for recognizing fact */ /* patterns, parsing ordered fact patterns, initiating the */ /* parsing of deftemplate fact patterns, and creating the */ /* default initial-fact fact pattern. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Initialize the exists member. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _FACTLHS_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include "cstrcpsr.h" #include "envrnmnt.h" #include "pattern.h" #include "router.h" #include "reorder.h" #include "tmpltpsr.h" #include "tmpltdef.h" #include "tmpltlhs.h" #include "tmpltutl.h" #include "modulutl.h" #include "modulpsr.h" #include "factlhs.h" /***********************************************/ /* SequenceRestrictionParse: Parses an ordered */ /* fact pattern conditional element. */ /* */ /* */ /* ::= ( +) */ /***********************************************/ globle struct lhsParseNode *SequenceRestrictionParse( void *theEnv, const char *readSource, struct token *theToken) { struct lhsParseNode *topNode; struct lhsParseNode *nextField; /*================================================*/ /* Create the pattern node for the relation name. */ /*================================================*/ topNode = GetLHSParseNode(theEnv); topNode->type = SF_WILDCARD; topNode->negated = FALSE; topNode->exists = FALSE; topNode->index = -1; topNode->slotNumber = 1; topNode->bottom = GetLHSParseNode(theEnv); topNode->bottom->type = SYMBOL; topNode->bottom->negated = FALSE; topNode->bottom->exists = FALSE; topNode->bottom->value = (void *) theToken->value; /*======================================================*/ /* Connective constraints cannot be used in conjunction */ /* with the first field of a pattern. */ /*======================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if ((theToken->type == OR_CONSTRAINT) || (theToken->type == AND_CONSTRAINT)) { ReturnLHSParseNodes(theEnv,topNode); SyntaxErrorMessage(theEnv,"the first field of a pattern"); return(NULL); } /*============================================================*/ /* Treat the remaining constraints of an ordered fact pattern */ /* as if they were contained in a multifield slot. */ /*============================================================*/ nextField = RestrictionParse(theEnv,readSource,theToken,TRUE,NULL,1,NULL,1); if (nextField == NULL) { ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->right = nextField; /*================================================*/ /* The pattern must end with a right parenthesis. */ /*================================================*/ if (theToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); SyntaxErrorMessage(theEnv,"fact patterns"); ReturnLHSParseNodes(theEnv,topNode); return(NULL); } /*====================================*/ /* Fix the pretty print output if the */ /* slot contained no restrictions. */ /*====================================*/ if (nextField->bottom == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } /*===================================*/ /* If no errors, return the pattern. */ /*===================================*/ return(topNode); } /****************************************************************/ /* CreateInitialFactPattern: Creates the pattern (initial-fact) */ /* for use in rules which have no LHS patterns. */ /****************************************************************/ globle struct lhsParseNode *CreateInitialFactPattern( void *theEnv) { struct lhsParseNode *topNode; struct deftemplate *theDeftemplate; int count; /*==================================*/ /* If the initial-fact deftemplate */ /* doesn't exist, then create it. */ /*==================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,"initial-fact", &count,TRUE,NULL); if (theDeftemplate == NULL) { PrintWarningID(theEnv,"FACTLHS",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Creating implied initial-fact deftemplate in module "); EnvPrintRouter(theEnv,WWARNING,EnvGetDefmoduleName(theEnv,EnvGetCurrentModule(theEnv))); EnvPrintRouter(theEnv,WWARNING,".\n"); EnvPrintRouter(theEnv,WWARNING," You probably want to import this deftemplate from the MAIN module.\n"); CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); } /*====================================*/ /* Create the (initial-fact) pattern. */ /*====================================*/ topNode = GetLHSParseNode(theEnv); topNode->type = SF_WILDCARD; topNode->index = 0; topNode->slotNumber = 1; topNode->bottom = GetLHSParseNode(theEnv); topNode->bottom->type = SYMBOL; topNode->bottom->value = (void *) EnvAddSymbol(theEnv,"initial-fact"); /*=====================*/ /* Return the pattern. */ /*=====================*/ return(topNode); } /**********************************************************************/ /* FactPatternParserFind: This function is the pattern find function */ /* for facts. It tells the pattern parsing code that the specified */ /* pattern can be parsed as a fact pattern. By default, any pattern */ /* beginning with a symbol can be parsed as a fact pattern. Since */ /* all patterns begin with a symbol, it follows that all patterns */ /* can be parsed as a fact pattern. */ /**********************************************************************/ globle int FactPatternParserFind( SYMBOL_HN *theRelation) { #if MAC_XCD #pragma unused(theRelation) #endif return(TRUE); } /******************************************************/ /* FactPatternParse: This function is called to parse */ /* both deftemplate and ordered fact patterns. */ /******************************************************/ globle struct lhsParseNode *FactPatternParse( void *theEnv, const char *readSource, struct token *theToken) { struct deftemplate *theDeftemplate; int count; /*=========================================*/ /* A module separator can not be included */ /* as part of the pattern's relation name. */ /*=========================================*/ if (FindModuleSeparator(ValueToString(theToken->value))) { IllegalModuleSpecifierMessage(theEnv); return(NULL); } /*=========================================================*/ /* Find the deftemplate associated with the relation name. */ /*=========================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(theToken->value), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(theToken->value)); return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) { #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(theToken->value))) { ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(theToken->value),NULL,NULL); return(NULL); } #endif /* DEFMODULE_CONSTRUCT */ if (! ConstructData(theEnv)->CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) theToken->value,TRUE); } else { theDeftemplate = NULL; } } /*===============================================*/ /* If an explicit deftemplate exists, then parse */ /* the pattern as a deftemplate pattern. */ /*===============================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { return(DeftemplateLHSParse(theEnv,readSource,theDeftemplate)); } /*================================*/ /* Parse an ordered fact pattern. */ /*================================*/ return(SequenceRestrictionParse(theEnv,readSource,theToken)); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */ clips_core_source_630/core/tmpltutl.c0000755000175000017500000004432512373754173016306 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE UTILITIES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides utility routines for deftemplates. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added additional arguments to */ /* InvalidDeftemplateSlotMessage function. */ /* */ /* Added additional arguments to */ /* PrintTemplateFact function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _TMPLTUTL_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "extnfunc.h" #include "memalloc.h" #include "constrct.h" #include "router.h" #include "argacces.h" #include "cstrnchk.h" #include "envrnmnt.h" #include "tmpltfun.h" #include "tmpltpsr.h" #include "modulutl.h" #include "watch.h" #include "sysdep.h" #include "tmpltbsc.h" #include "tmpltdef.h" #include "tmpltutl.h" /********************************************************/ /* InvalidDeftemplateSlotMessage: Generic error message */ /* for use when a specified slot name isn't defined */ /* in its corresponding deftemplate. */ /********************************************************/ globle void InvalidDeftemplateSlotMessage( void *theEnv, const char *slotName, const char *deftemplateName, int printCR) { PrintErrorID(theEnv,"TMPLTDEF",1,printCR); EnvPrintRouter(theEnv,WERROR,"Invalid slot "); EnvPrintRouter(theEnv,WERROR,slotName); EnvPrintRouter(theEnv,WERROR," not defined in corresponding deftemplate "); EnvPrintRouter(theEnv,WERROR,deftemplateName); EnvPrintRouter(theEnv,WERROR,".\n"); } /**********************************************************/ /* SingleFieldSlotCardinalityError: Generic error message */ /* used when an attempt is made to placed a multifield */ /* value into a single field slot. */ /**********************************************************/ globle void SingleFieldSlotCardinalityError( void *theEnv, const char *slotName) { PrintErrorID(theEnv,"TMPLTDEF",2,TRUE); EnvPrintRouter(theEnv,WERROR,"The single field slot "); EnvPrintRouter(theEnv,WERROR,slotName); EnvPrintRouter(theEnv,WERROR," can only contain a single field value.\n"); } /**********************************************************************/ /* MultiIntoSingleFieldSlotError: Determines if a multifield value is */ /* being placed into a single field slot of a deftemplate fact. */ /**********************************************************************/ globle void MultiIntoSingleFieldSlotError( void *theEnv, struct templateSlot *theSlot, struct deftemplate *theDeftemplate) { PrintErrorID(theEnv,"TMPLTFUN",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Attempted to assert a multifield value \n"); EnvPrintRouter(theEnv,WERROR,"into the single field slot "); if (theSlot != NULL) EnvPrintRouter(theEnv,WERROR,theSlot->slotName->contents); else EnvPrintRouter(theEnv,WERROR,"<>"); EnvPrintRouter(theEnv,WERROR," of deftemplate "); if (theDeftemplate != NULL) EnvPrintRouter(theEnv,WERROR,theDeftemplate->header.name->contents); else EnvPrintRouter(theEnv,WERROR,"<>"); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /**************************************************************/ /* CheckTemplateFact: Checks a fact to see if it violates any */ /* deftemplate type, allowed-..., or range specifications. */ /**************************************************************/ globle void CheckTemplateFact( void *theEnv, struct fact *theFact) { struct field *sublist; int i; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; DATA_OBJECT theData; char thePlace[20]; int rv; if (! EnvGetDynamicConstraintChecking(theEnv)) return; sublist = theFact->theProposition.theFields; /*========================================================*/ /* If the deftemplate corresponding to the first field of */ /* of the fact cannot be found, then the fact cannot be */ /* checked against the deftemplate format. */ /*========================================================*/ theDeftemplate = theFact->whichDeftemplate; if (theDeftemplate == NULL) return; if (theDeftemplate->implied) return; /*=============================================*/ /* Check each of the slots of the deftemplate. */ /*=============================================*/ i = 0; for (slotPtr = theDeftemplate->slotList; slotPtr != NULL; slotPtr = slotPtr->next) { /*================================================*/ /* Store the slot value in the appropriate format */ /* for a call to the constraint checking routine. */ /*================================================*/ if (slotPtr->multislot == FALSE) { theData.type = sublist[i].type; theData.value = sublist[i].value; i++; } else { theData.type = MULTIFIELD; theData.value = (void *) sublist[i].value; SetDOBegin(theData,1); SetDOEnd(theData,((struct multifield *) sublist[i].value)->multifieldLength); i++; } /*=============================================*/ /* Call the constraint checking routine to see */ /* if a constraint violation occurred. */ /*=============================================*/ rv = ConstraintCheckDataObject(theEnv,&theData,slotPtr->constraints); if (rv != NO_VIOLATION) { gensprintf(thePlace,"fact f-%-5lld ",theFact->factIndex); PrintErrorID(theEnv,"CSTRNCHK",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Slot value "); PrintDataObject(theEnv,WERROR,&theData); EnvPrintRouter(theEnv,WERROR," "); ConstraintViolationErrorMessage(theEnv,NULL,thePlace,FALSE,0,slotPtr->slotName, 0,rv,slotPtr->constraints,TRUE); SetHaltExecution(theEnv,TRUE); return; } } return; } /***********************************************************************/ /* CheckRHSSlotTypes: Checks the validity of a change to a slot as the */ /* result of an assert, modify, or duplicate command. This checking */ /* is performed statically (i.e. when the command is being parsed). */ /***********************************************************************/ globle intBool CheckRHSSlotTypes( void *theEnv, struct expr *rhsSlots, struct templateSlot *slotPtr, const char *thePlace) { int rv; const char *theName; if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(TRUE); rv = ConstraintCheckExpressionChain(theEnv,rhsSlots,slotPtr->constraints); if (rv != NO_VIOLATION) { if (rv != CARDINALITY_VIOLATION) theName = "A literal slot value"; else theName = "Literal slot values"; ConstraintViolationErrorMessage(theEnv,theName,thePlace,TRUE,0, slotPtr->slotName,0,rv,slotPtr->constraints,TRUE); return(0); } return(1); } /*********************************************************/ /* GetNthSlot: Given a deftemplate and an integer index, */ /* returns the nth slot of a deftemplate. */ /*********************************************************/ globle struct templateSlot *GetNthSlot( struct deftemplate *theDeftemplate, int position) { struct templateSlot *slotPtr; int i = 0; slotPtr = theDeftemplate->slotList; while (slotPtr != NULL) { if (i == position) return(slotPtr); slotPtr = slotPtr->next; i++; } return(NULL); } /*******************************************************/ /* FindSlotPosition: Finds the position of a specified */ /* slot in a deftemplate structure. */ /*******************************************************/ globle int FindSlotPosition( struct deftemplate *theDeftemplate, SYMBOL_HN *name) { struct templateSlot *slotPtr; int position; for (slotPtr = theDeftemplate->slotList, position = 1; slotPtr != NULL; slotPtr = slotPtr->next, position++) { if (slotPtr->slotName == name) { return(position); } } return(0); } /*******************************************************************/ /* PrintTemplateFact: Prints a fact using the deftemplate format. */ /* Returns TRUE if the fact was printed using this format, */ /* otherwise FALSE. */ /*******************************************************************/ globle void PrintTemplateFact( void *theEnv, const char *logicalName, struct fact *theFact, int seperateLines, int ignoreDefaults) { struct field *sublist; int i; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; DATA_OBJECT tempDO; int slotPrinted = FALSE; /*==============================*/ /* Initialize some information. */ /*==============================*/ theDeftemplate = theFact->whichDeftemplate; sublist = theFact->theProposition.theFields; /*=============================================*/ /* Print the relation name of the deftemplate. */ /*=============================================*/ EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,theDeftemplate->header.name->contents); /*===================================================*/ /* Print each of the field slots of the deftemplate. */ /*===================================================*/ slotPtr = theDeftemplate->slotList; i = 0; while (slotPtr != NULL) { /*=================================================*/ /* If we're ignoring slots with their original */ /* default value, check to see if the fact's slot */ /* value differs from the deftemplate default. */ /*=================================================*/ if (ignoreDefaults && (slotPtr->defaultDynamic == FALSE)) { DeftemplateSlotDefault(theEnv,theDeftemplate,slotPtr,&tempDO,TRUE); if (slotPtr->multislot == FALSE) { if ((GetType(tempDO) == sublist[i].type) && (GetValue(tempDO) == sublist[i].value)) { i++; slotPtr = slotPtr->next; continue; } } else if (MultifieldsEqual((struct multifield*) GetValue(tempDO), (struct multifield *) sublist[i].value)) { i++; slotPtr = slotPtr->next; continue; } } /*===========================================*/ /* Print the opening parenthesis of the slot */ /* and the slot name. */ /*===========================================*/ if (! slotPrinted) { slotPrinted = TRUE; EnvPrintRouter(theEnv,logicalName," "); } if (seperateLines) { EnvPrintRouter(theEnv,logicalName,"\n "); } EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,slotPtr->slotName->contents); /*======================================================*/ /* Print the value of the slot for a single field slot. */ /*======================================================*/ if (slotPtr->multislot == FALSE) { EnvPrintRouter(theEnv,logicalName," "); PrintAtom(theEnv,logicalName,sublist[i].type,sublist[i].value); } /*==========================================================*/ /* Else print the value of the slot for a multi field slot. */ /*==========================================================*/ else { struct multifield *theSegment; theSegment = (struct multifield *) sublist[i].value; if (theSegment->multifieldLength > 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,(struct multifield *) sublist[i].value, 0,(long) theSegment->multifieldLength-1,FALSE); } } /*============================================*/ /* Print the closing parenthesis of the slot. */ /*============================================*/ i++; EnvPrintRouter(theEnv,logicalName,")"); slotPtr = slotPtr->next; if (slotPtr != NULL) EnvPrintRouter(theEnv,logicalName," "); } EnvPrintRouter(theEnv,logicalName,")"); } /***************************************************************************/ /* UpdateDeftemplateScope: Updates the scope flag of all the deftemplates. */ /***************************************************************************/ globle void UpdateDeftemplateScope( void *theEnv) { struct deftemplate *theDeftemplate; int moduleCount; struct defmodule *theModule; struct defmoduleItemHeader *theItem; /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Loop through each of the deftemplates in the module. */ /*======================================================*/ theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DeftemplateData(theEnv)->DeftemplateModuleIndex); for (theDeftemplate = (struct deftemplate *) theItem->firstItem; theDeftemplate != NULL ; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*=======================================*/ /* If the deftemplate can be seen by the */ /* current module, then it is in scope. */ /*=======================================*/ if (FindImportedConstruct(theEnv,"deftemplate",theModule, ValueToString(theDeftemplate->header.name), &moduleCount,TRUE,NULL) != NULL) { theDeftemplate->inScope = TRUE; } else { theDeftemplate->inScope = FALSE; } } } } /****************************************************************/ /* FindSlot: Finds a specified slot in a deftemplate structure. */ /****************************************************************/ globle struct templateSlot *FindSlot( struct deftemplate *theDeftemplate, SYMBOL_HN *name, short *whichOne) { struct templateSlot *slotPtr; *whichOne = 1; slotPtr = theDeftemplate->slotList; while (slotPtr != NULL) { if (slotPtr->slotName == name) { return(slotPtr); } (*whichOne)++; slotPtr = slotPtr->next; } *whichOne = -1; return(NULL); } #if (! RUN_TIME) && (! BLOAD_ONLY) /************************************************************/ /* CreateImpliedDeftemplate: Creates an implied deftemplate */ /* and adds it to the list of deftemplates. */ /************************************************************/ globle struct deftemplate *CreateImpliedDeftemplate( void *theEnv, SYMBOL_HN *deftemplateName, int setFlag) { struct deftemplate *newDeftemplate; newDeftemplate = get_struct(theEnv,deftemplate); newDeftemplate->header.name = deftemplateName; newDeftemplate->header.ppForm = NULL; newDeftemplate->header.usrData = NULL; newDeftemplate->slotList = NULL; newDeftemplate->implied = setFlag; newDeftemplate->numberOfSlots = 0; newDeftemplate->inScope = 1; newDeftemplate->patternNetwork = NULL; newDeftemplate->factList = NULL; newDeftemplate->lastFact = NULL; newDeftemplate->busyCount = 0; newDeftemplate->watch = FALSE; newDeftemplate->header.next = NULL; #if DEBUGGING_FUNCTIONS if (EnvGetWatchItem(theEnv,"facts")) { EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); } #endif newDeftemplate->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex); AddConstructToModule(&newDeftemplate->header); InstallDeftemplate(theEnv,newDeftemplate); return(newDeftemplate); } #endif #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/rulebin.c0000755000175000017500000012723312374024071016045 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFRULE BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* Barry Cameron */ /* */ /* Revision History: */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, and LOGICAL_DEPENDENCIES */ /* compilation flags. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Added support for alpha memories. */ /* */ /* Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /*************************************************************/ #define _RULEBIN_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include #include "memalloc.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "reteutil.h" #include "agenda.h" #include "engine.h" #include "retract.h" #include "rulebsc.h" #include "pattern.h" #include "moduldef.h" #include "rulebin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveExpressions(void *,FILE *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); static void BsaveJoins(void *,FILE *); static void BsaveJoin(void *,FILE *,struct joinNode *); static void BsaveDisjuncts(void *,FILE *,struct defrule *); static void BsaveTraverseJoins(void *,FILE *,struct joinNode *); static void BsaveLinks(void *,FILE *); static void BsaveTraverseLinks(void *,FILE *,struct joinNode *); static void BsaveLink(FILE *,struct joinLink *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDefruleModule(void *,void *,long); static void UpdateDefrule(void *,void *,long); static void UpdateJoin(void *,void *,long); static void UpdateLink(void *,void *,long); static void ClearBload(void *); static void DeallocateDefruleBloadData(void *); /*****************************************************/ /* DefruleBinarySetup: Installs the binary save/load */ /* feature for the defrule construct. */ /*****************************************************/ globle void DefruleBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,RULEBIN_DATA,sizeof(struct defruleBinaryData),DeallocateDefruleBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defrule",20,BsaveFind,BsaveExpressions, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"defrule",20,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /*******************************************************/ /* DeallocateDefruleBloadData: Deallocates environment */ /* data for the defrule bsave functionality. */ /*******************************************************/ static void DeallocateDefruleBloadData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) size_t space; long i; struct defruleModule *theModuleItem; struct activation *theActivation, *tmpActivation; struct salienceGroup *theGroup, *tmpGroup; for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfJoins; i++) { DestroyBetaMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i],LHS); DestroyBetaMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i],RHS); ReturnLeftMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i]); ReturnRightMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i]); } for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfDefruleModules; i++) { theModuleItem = &DefruleBinaryData(theEnv)->ModuleArray[i]; theActivation = theModuleItem->agenda; while (theActivation != NULL) { tmpActivation = theActivation->next; rtn_struct(theEnv,activation,theActivation); theActivation = tmpActivation; } theGroup = theModuleItem->groupings; while (theGroup != NULL) { tmpGroup = theGroup->next; rtn_struct(theEnv,salienceGroup,theGroup); theGroup = tmpGroup; } } space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->ModuleArray,space); space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->DefruleArray,space); space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->JoinArray,space); space = DefruleBinaryData(theEnv)->NumberOfLinks * sizeof(struct joinLink); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->LinkArray,space); if (Bloaded(theEnv)) { rm3(theEnv,DefruleData(theEnv)->AlphaMemoryTable,sizeof(ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE); } #endif } #if BLOAD_AND_BSAVE /*************************************************************/ /* BsaveFind: Determines the amount of memory needed to save */ /* the defrule and joinNode data structures in addition to */ /* the memory needed for their associated expressions. */ /*************************************************************/ static void BsaveFind( void *theEnv) { struct defrule *theDefrule, *theDisjunct; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfDefruleModules); SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfDefrules); SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfJoins); SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfLinks); /*====================================================*/ /* Set the binary save ID for defrule data structures */ /* and count the number of each type. */ /*====================================================*/ TagRuleNetwork(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefruleModules, &DefruleBinaryData(theEnv)->NumberOfDefrules, &DefruleBinaryData(theEnv)->NumberOfJoins, &DefruleBinaryData(theEnv)->NumberOfLinks); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*============================*/ /* Set the current module to */ /* the module being examined. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==================================================*/ /* Loop through each defrule in the current module. */ /*==================================================*/ for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { /*================================================*/ /* Initialize the construct header for the binary */ /* save. The binary save ID has already been set. */ /*================================================*/ MarkConstructHeaderNeededItems(&theDefrule->header,theDefrule->header.bsaveID); /*===========================================*/ /* Count and mark data structures associated */ /* with dynamic salience. */ /*===========================================*/ ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDefrule->dynamicSalience); MarkNeededItems(theEnv,theDefrule->dynamicSalience); /*==========================================*/ /* Loop through each disjunct of the rule */ /* counting and marking the data structures */ /* associated with RHS actions. */ /*==========================================*/ for (theDisjunct = theDefrule; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct) { ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDisjunct->actions); MarkNeededItems(theEnv,theDisjunct->actions); } } } /*===============================*/ /* Reset the bsave tags assigned */ /* to defrule data structures. */ /*===============================*/ MarkRuleNetwork(theEnv,1); } /************************************************/ /* BsaveExpressions: Saves the expressions used */ /* by defrules to the binary save file. */ /************************************************/ static void BsaveExpressions( void *theEnv, FILE *fp) { struct defrule *theDefrule, *theDisjunct; struct defmodule *theModule; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==================================================*/ /* Loop through each defrule in the current module. */ /*==================================================*/ for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { /*===========================================*/ /* Save the dynamic salience of the defrule. */ /*===========================================*/ BsaveExpression(theEnv,theDefrule->dynamicSalience,fp); /*===================================*/ /* Loop through each disjunct of the */ /* defrule and save its RHS actions. */ /*===================================*/ for (theDisjunct = theDefrule; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct) { BsaveExpression(theEnv,theDisjunct->actions,fp); } } } /*==============================*/ /* Set the marked flag for each */ /* join in the join network. */ /*==============================*/ MarkRuleNetwork(theEnv,1); } /*****************************************************/ /* BsaveStorage: Writes out storage requirements for */ /* all defrule structures to the binary file */ /*****************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { size_t space; long int value; space = sizeof(long) * 5; GenWrite(&space,sizeof(size_t),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfDefruleModules,sizeof(long int),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfDefrules,sizeof(long int),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfJoins,sizeof(long int),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfLinks,sizeof(long int),fp); if (DefruleData(theEnv)->RightPrimeJoins == NULL) { value = -1; } else { value = DefruleData(theEnv)->RightPrimeJoins->bsaveID; } GenWrite(&value,sizeof(long int),fp); if (DefruleData(theEnv)->LeftPrimeJoins == NULL) { value = -1; } else { value = DefruleData(theEnv)->LeftPrimeJoins->bsaveID; } GenWrite(&value,sizeof(long int),fp); } /*******************************************/ /* BsaveBinaryItem: Writes out all defrule */ /* structures to the binary file. */ /*******************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { size_t space; struct defrule *theDefrule; struct defmodule *theModule; struct defruleModule *theModuleItem; struct bsaveDefruleModule tempDefruleModule; /*===============================================*/ /* Write out the space required by the defrules. */ /*===============================================*/ space = (DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct bsaveDefrule)) + (DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct bsaveJoinNode)) + (DefruleBinaryData(theEnv)->NumberOfLinks * sizeof(struct bsaveJoinLink)) + (DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct bsaveDefruleModule)); GenWrite(&space,sizeof(size_t),fp); /*===============================================*/ /* Write out each defrule module data structure. */ /*===============================================*/ DefruleBinaryData(theEnv)->NumberOfDefrules = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&tempDefruleModule.header, &theModuleItem->header); GenWrite(&tempDefruleModule,sizeof(struct bsaveDefruleModule),fp); } /*========================================*/ /* Write out each defrule data structure. */ /*========================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { BsaveDisjuncts(theEnv,fp,theDefrule); } } /*=============================*/ /* Write out the Rete Network. */ /*=============================*/ MarkRuleNetwork(theEnv,1); BsaveJoins(theEnv,fp); /*===========================*/ /* Write out the join links. */ /*===========================*/ MarkRuleNetwork(theEnv,1); BsaveLinks(theEnv,fp); /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of defrules, defrule modules, and joins in the binary image */ /* (these were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefruleModules); RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefrules); RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfJoins); RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfLinks); } /************************************************************/ /* BsaveDisjuncts: Writes out all the disjunct defrule data */ /* structures for a specific rule to the binary file. */ /************************************************************/ static void BsaveDisjuncts( void *theEnv, FILE *fp, struct defrule *theDefrule) { struct defrule *theDisjunct; struct bsaveDefrule tempDefrule; long int disjunctExpressionCount = 0L; int first; /*=========================================*/ /* Loop through each disjunct of the rule. */ /*=========================================*/ for (theDisjunct = theDefrule, first = TRUE; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct, first = FALSE) { DefruleBinaryData(theEnv)->NumberOfDefrules++; /*======================================*/ /* Set header and miscellaneous values. */ /*======================================*/ AssignBsaveConstructHeaderVals(&tempDefrule.header, &theDisjunct->header); tempDefrule.salience = theDisjunct->salience; tempDefrule.localVarCnt = theDisjunct->localVarCnt; tempDefrule.complexity = theDisjunct->complexity; tempDefrule.autoFocus = theDisjunct->autoFocus; /*=======================================*/ /* Set dynamic salience data structures. */ /*=======================================*/ if (theDisjunct->dynamicSalience != NULL) { if (first) { tempDefrule.dynamicSalience = ExpressionData(theEnv)->ExpressionCount; disjunctExpressionCount = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDisjunct->dynamicSalience); } else { tempDefrule.dynamicSalience = disjunctExpressionCount; } } else { tempDefrule.dynamicSalience = -1L; } /*==============================================*/ /* Set the index to the disjunct's RHS actions. */ /*==============================================*/ if (theDisjunct->actions != NULL) { tempDefrule.actions = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDisjunct->actions); } else { tempDefrule.actions = -1L; } /*=================================*/ /* Set the index to the disjunct's */ /* logical join and last join. */ /*=================================*/ tempDefrule.logicalJoin = BsaveJoinIndex(theDisjunct->logicalJoin); tempDefrule.lastJoin = BsaveJoinIndex(theDisjunct->lastJoin); /*=====================================*/ /* Set the index to the next disjunct. */ /*=====================================*/ if (theDisjunct->disjunct != NULL) { tempDefrule.disjunct = DefruleBinaryData(theEnv)->NumberOfDefrules; } else { tempDefrule.disjunct = -1L; } /*=================================*/ /* Write the disjunct to the file. */ /*=================================*/ GenWrite(&tempDefrule,sizeof(struct bsaveDefrule),fp); } } /********************************************/ /* BsaveJoins: Writes out all the join node */ /* data structures to the binary file. */ /********************************************/ static void BsaveJoins( void *theEnv, FILE *fp) { struct defrule *rulePtr, *disjunctPtr; struct defmodule *theModule; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); /*===========================================*/ /* Loop through each rule and its disjuncts. */ /*===========================================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { /*=========================================*/ /* Loop through each join of the disjunct. */ /*=========================================*/ for (disjunctPtr = rulePtr; disjunctPtr != NULL; disjunctPtr = disjunctPtr->disjunct) { BsaveTraverseJoins(theEnv,fp,disjunctPtr->lastJoin); } /*===========================*/ /* Move on to the next rule. */ /*===========================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } } /**************************************************************/ /* BsaveTraverseJoins: Traverses the join network for a rule. */ /**************************************************************/ static void BsaveTraverseJoins( void *theEnv, FILE *fp, struct joinNode *joinPtr) { for (; joinPtr != NULL; joinPtr = joinPtr->lastLevel) { if (joinPtr->marked) BsaveJoin(theEnv,fp,joinPtr); if (joinPtr->joinFromTheRight) { BsaveTraverseJoins(theEnv,fp,(struct joinNode *) joinPtr->rightSideEntryStructure); } } } /********************************************/ /* BsaveJoin: Writes out a single join node */ /* data structure to the binary file. */ /********************************************/ static void BsaveJoin( void *theEnv, FILE *fp, struct joinNode *joinPtr) { struct bsaveJoinNode tempJoin; joinPtr->marked = 0; tempJoin.depth = joinPtr->depth; tempJoin.rhsType = joinPtr->rhsType; tempJoin.firstJoin = joinPtr->firstJoin; tempJoin.logicalJoin = joinPtr->logicalJoin; tempJoin.joinFromTheRight = joinPtr->joinFromTheRight; tempJoin.patternIsNegated = joinPtr->patternIsNegated; tempJoin.patternIsExists = joinPtr->patternIsExists; if (joinPtr->joinFromTheRight) { tempJoin.rightSideEntryStructure = BsaveJoinIndex(joinPtr->rightSideEntryStructure); } else { tempJoin.rightSideEntryStructure = -1L; } tempJoin.lastLevel = BsaveJoinIndex(joinPtr->lastLevel); tempJoin.nextLinks = BsaveJoinLinkIndex(joinPtr->nextLinks); tempJoin.rightMatchNode = BsaveJoinIndex(joinPtr->rightMatchNode); tempJoin.networkTest = HashedExpressionIndex(theEnv,joinPtr->networkTest); tempJoin.secondaryNetworkTest = HashedExpressionIndex(theEnv,joinPtr->secondaryNetworkTest); tempJoin.leftHash = HashedExpressionIndex(theEnv,joinPtr->leftHash); tempJoin.rightHash = HashedExpressionIndex(theEnv,joinPtr->rightHash); if (joinPtr->ruleToActivate != NULL) { tempJoin.ruleToActivate = GetDisjunctIndex(joinPtr->ruleToActivate); } else { tempJoin.ruleToActivate = -1L; } GenWrite(&tempJoin,(unsigned long) sizeof(struct bsaveJoinNode),fp); } /********************************************/ /* BsaveLinks: Writes out all the join link */ /* data structures to the binary file. */ /********************************************/ static void BsaveLinks( void *theEnv, FILE *fp) { struct defrule *rulePtr, *disjunctPtr; struct defmodule *theModule; struct joinLink *theLink; for (theLink = DefruleData(theEnv)->LeftPrimeJoins; theLink != NULL; theLink = theLink->next) { BsaveLink(fp,theLink); } for (theLink = DefruleData(theEnv)->RightPrimeJoins; theLink != NULL; theLink = theLink->next) { BsaveLink(fp,theLink); } /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); /*===========================================*/ /* Loop through each rule and its disjuncts. */ /*===========================================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { /*=========================================*/ /* Loop through each join of the disjunct. */ /*=========================================*/ for (disjunctPtr = rulePtr; disjunctPtr != NULL; disjunctPtr = disjunctPtr->disjunct) { BsaveTraverseLinks(theEnv,fp,disjunctPtr->lastJoin); } /*=======================================*/ /* Move on to the next rule or disjunct. */ /*=======================================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } } /***************************************************/ /* BsaveTraverseLinks: Traverses the join network */ /* for a rule saving the join links. */ /**************************************************/ static void BsaveTraverseLinks( void *theEnv, FILE *fp, struct joinNode *joinPtr) { struct joinLink *theLink; for (; joinPtr != NULL; joinPtr = joinPtr->lastLevel) { if (joinPtr->marked) { for (theLink = joinPtr->nextLinks; theLink != NULL; theLink = theLink->next) { BsaveLink(fp,theLink); } joinPtr->marked = 0; } if (joinPtr->joinFromTheRight) { BsaveTraverseLinks(theEnv,fp,(struct joinNode *) joinPtr->rightSideEntryStructure); } } } /********************************************/ /* BsaveLink: Writes out a single join link */ /* data structure to the binary file. */ /********************************************/ static void BsaveLink( FILE *fp, struct joinLink *linkPtr) { struct bsaveJoinLink tempLink; tempLink.enterDirection = linkPtr->enterDirection; tempLink.join = BsaveJoinIndex(linkPtr->join); tempLink.next = BsaveJoinLinkIndex(linkPtr->next); GenWrite(&tempLink,(unsigned long) sizeof(struct bsaveJoinLink),fp); } /***********************************************************/ /* AssignBsavePatternHeaderValues: Assigns the appropriate */ /* values to a bsave pattern header record. */ /***********************************************************/ globle void AssignBsavePatternHeaderValues( void *theEnv, struct bsavePatternNodeHeader *theBsaveHeader, struct patternNodeHeader *theHeader) { theBsaveHeader->multifieldNode = theHeader->multifieldNode; theBsaveHeader->entryJoin = BsaveJoinIndex(theHeader->entryJoin); theBsaveHeader->rightHash = HashedExpressionIndex(theEnv,theHeader->rightHash); theBsaveHeader->singlefieldNode = theHeader->singlefieldNode; theBsaveHeader->stopNode = theHeader->stopNode; theBsaveHeader->beginSlot = theHeader->beginSlot; theBsaveHeader->endSlot = theHeader->endSlot; theBsaveHeader->selector = theHeader->selector; } #endif /* BLOAD_AND_BSAVE */ /************************************************/ /* BloadStorage: Loads storage requirements for */ /* the defrules used by this binary image. */ /************************************************/ static void BloadStorage( void *theEnv) { size_t space; /*=================================================*/ /* Determine the number of defrule, defruleModule, */ /* and joinNode data structures to be read. */ /*=================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefruleModules,sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefrules,sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfJoins,sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfLinks,sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->RightPrimeIndex,sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->LeftPrimeIndex,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* defruleModule data structures. */ /*===================================*/ if (DefruleBinaryData(theEnv)->NumberOfDefruleModules == 0) { DefruleBinaryData(theEnv)->ModuleArray = NULL; DefruleBinaryData(theEnv)->DefruleArray = NULL; DefruleBinaryData(theEnv)->JoinArray = NULL; } space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule); DefruleBinaryData(theEnv)->ModuleArray = (struct defruleModule *) genalloc(theEnv,space); /*===============================*/ /* Allocate the space needed for */ /* the defrule data structures. */ /*===============================*/ if (DefruleBinaryData(theEnv)->NumberOfDefrules == 0) { DefruleBinaryData(theEnv)->DefruleArray = NULL; DefruleBinaryData(theEnv)->JoinArray = NULL; return; } space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule); DefruleBinaryData(theEnv)->DefruleArray = (struct defrule *) genalloc(theEnv,space); /*===============================*/ /* Allocate the space needed for */ /* the joinNode data structures. */ /*===============================*/ space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode); DefruleBinaryData(theEnv)->JoinArray = (struct joinNode *) genalloc(theEnv,space); /*===============================*/ /* Allocate the space needed for */ /* the joinNode data structures. */ /*===============================*/ space = DefruleBinaryData(theEnv)->NumberOfLinks * sizeof(struct joinLink); DefruleBinaryData(theEnv)->LinkArray = (struct joinLink *) genalloc(theEnv,space); } /****************************************************/ /* BloadBinaryItem: Loads and refreshes the defrule */ /* constructs used by this binary image. */ /****************************************************/ static void BloadBinaryItem( void *theEnv) { size_t space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); /*===========================================*/ /* Read in the defruleModule data structures */ /* and refresh the pointers. */ /*===========================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfDefruleModules, sizeof(struct bsaveDefruleModule),UpdateDefruleModule); /*=====================================*/ /* Read in the defrule data structures */ /* and refresh the pointers. */ /*=====================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfDefrules, sizeof(struct bsaveDefrule),UpdateDefrule); /*======================================*/ /* Read in the joinNode data structures */ /* and refresh the pointers. */ /*======================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfJoins, sizeof(struct bsaveJoinNode),UpdateJoin); /*======================================*/ /* Read in the joinLink data structures */ /* and refresh the pointers. */ /*======================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfLinks, sizeof(struct bsaveJoinLink),UpdateLink); DefruleData(theEnv)->RightPrimeJoins = BloadJoinLinkPointer(DefruleBinaryData(theEnv)->RightPrimeIndex); DefruleData(theEnv)->LeftPrimeJoins = BloadJoinLinkPointer(DefruleBinaryData(theEnv)->LeftPrimeIndex); } /**********************************************/ /* UpdateDefruleModule: Bload refresh routine */ /* for defrule module data structures. */ /**********************************************/ static void UpdateDefruleModule( void *theEnv, void *buf, long obji) { struct bsaveDefruleModule *bdmPtr; bdmPtr = (struct bsaveDefruleModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DefruleBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct defrule), (void *) DefruleBinaryData(theEnv)->DefruleArray); DefruleBinaryData(theEnv)->ModuleArray[obji].agenda = NULL; DefruleBinaryData(theEnv)->ModuleArray[obji].groupings = NULL; } /****************************************/ /* UpdateDefrule: Bload refresh routine */ /* for defrule data structures. */ /****************************************/ static void UpdateDefrule( void *theEnv, void *buf, long obji) { struct bsaveDefrule *br; br = (struct bsaveDefrule *) buf; UpdateConstructHeader(theEnv,&br->header,&DefruleBinaryData(theEnv)->DefruleArray[obji].header, (int) sizeof(struct defruleModule),(void *) DefruleBinaryData(theEnv)->ModuleArray, (int) sizeof(struct defrule),(void *) DefruleBinaryData(theEnv)->DefruleArray); DefruleBinaryData(theEnv)->DefruleArray[obji].dynamicSalience = ExpressionPointer(br->dynamicSalience); DefruleBinaryData(theEnv)->DefruleArray[obji].actions = ExpressionPointer(br->actions); DefruleBinaryData(theEnv)->DefruleArray[obji].logicalJoin = BloadJoinPointer(br->logicalJoin); DefruleBinaryData(theEnv)->DefruleArray[obji].lastJoin = BloadJoinPointer(br->lastJoin); DefruleBinaryData(theEnv)->DefruleArray[obji].disjunct = BloadDefrulePointer(DefruleBinaryData(theEnv)->DefruleArray,br->disjunct); DefruleBinaryData(theEnv)->DefruleArray[obji].salience = br->salience; DefruleBinaryData(theEnv)->DefruleArray[obji].localVarCnt = br->localVarCnt; DefruleBinaryData(theEnv)->DefruleArray[obji].complexity = br->complexity; DefruleBinaryData(theEnv)->DefruleArray[obji].autoFocus = br->autoFocus; DefruleBinaryData(theEnv)->DefruleArray[obji].executing = 0; DefruleBinaryData(theEnv)->DefruleArray[obji].afterBreakpoint = 0; #if DEBUGGING_FUNCTIONS DefruleBinaryData(theEnv)->DefruleArray[obji].watchActivation = AgendaData(theEnv)->WatchActivations; DefruleBinaryData(theEnv)->DefruleArray[obji].watchFiring = DefruleData(theEnv)->WatchRules; #endif } /*************************************/ /* UpdateJoin: Bload refresh routine */ /* for joinNode data structures. */ /*************************************/ static void UpdateJoin( void *theEnv, void *buf, long obji) { struct bsaveJoinNode *bj; bj = (struct bsaveJoinNode *) buf; DefruleBinaryData(theEnv)->JoinArray[obji].firstJoin = bj->firstJoin; DefruleBinaryData(theEnv)->JoinArray[obji].logicalJoin = bj->logicalJoin; DefruleBinaryData(theEnv)->JoinArray[obji].joinFromTheRight = bj->joinFromTheRight; DefruleBinaryData(theEnv)->JoinArray[obji].patternIsNegated = bj->patternIsNegated; DefruleBinaryData(theEnv)->JoinArray[obji].patternIsExists = bj->patternIsExists; DefruleBinaryData(theEnv)->JoinArray[obji].depth = bj->depth; DefruleBinaryData(theEnv)->JoinArray[obji].rhsType = bj->rhsType; DefruleBinaryData(theEnv)->JoinArray[obji].networkTest = HashedExpressionPointer(bj->networkTest); DefruleBinaryData(theEnv)->JoinArray[obji].secondaryNetworkTest = HashedExpressionPointer(bj->secondaryNetworkTest); DefruleBinaryData(theEnv)->JoinArray[obji].leftHash = HashedExpressionPointer(bj->leftHash); DefruleBinaryData(theEnv)->JoinArray[obji].rightHash = HashedExpressionPointer(bj->rightHash); DefruleBinaryData(theEnv)->JoinArray[obji].nextLinks = BloadJoinLinkPointer(bj->nextLinks); DefruleBinaryData(theEnv)->JoinArray[obji].lastLevel = BloadJoinPointer(bj->lastLevel); if (bj->joinFromTheRight == TRUE) { DefruleBinaryData(theEnv)->JoinArray[obji].rightSideEntryStructure = (void *) BloadJoinPointer(bj->rightSideEntryStructure); } else { DefruleBinaryData(theEnv)->JoinArray[obji].rightSideEntryStructure = NULL; } DefruleBinaryData(theEnv)->JoinArray[obji].rightMatchNode = BloadJoinPointer(bj->rightMatchNode); DefruleBinaryData(theEnv)->JoinArray[obji].ruleToActivate = BloadDefrulePointer(DefruleBinaryData(theEnv)->DefruleArray,bj->ruleToActivate); DefruleBinaryData(theEnv)->JoinArray[obji].initialize = 0; DefruleBinaryData(theEnv)->JoinArray[obji].marked = 0; DefruleBinaryData(theEnv)->JoinArray[obji].bsaveID = 0L; DefruleBinaryData(theEnv)->JoinArray[obji].leftMemory = NULL; DefruleBinaryData(theEnv)->JoinArray[obji].rightMemory = NULL; AddBetaMemoriesToJoin(theEnv,&DefruleBinaryData(theEnv)->JoinArray[obji]); } /*************************************/ /* UpdateLink: Bload refresh routine */ /* for joinLink data structures. */ /*************************************/ static void UpdateLink( void *theEnv, void *buf, long obji) { struct bsaveJoinLink *bj; bj = (struct bsaveJoinLink *) buf; DefruleBinaryData(theEnv)->LinkArray[obji].enterDirection = bj->enterDirection; DefruleBinaryData(theEnv)->LinkArray[obji].next = BloadJoinLinkPointer(bj->next); DefruleBinaryData(theEnv)->LinkArray[obji].join = BloadJoinPointer(bj->join); } /************************************************************/ /* UpdatePatternNodeHeader: Refreshes the values in pattern */ /* node headers from the loaded binary image. */ /************************************************************/ globle void UpdatePatternNodeHeader( void *theEnv, struct patternNodeHeader *theHeader, struct bsavePatternNodeHeader *theBsaveHeader) { struct joinNode *theJoin; theHeader->singlefieldNode = theBsaveHeader->singlefieldNode; theHeader->multifieldNode = theBsaveHeader->multifieldNode; theHeader->stopNode = theBsaveHeader->stopNode; theHeader->beginSlot = theBsaveHeader->beginSlot; theHeader->endSlot = theBsaveHeader->endSlot; theHeader->selector = theBsaveHeader->selector; theHeader->initialize = 0; theHeader->marked = 0; theHeader->firstHash = NULL; theHeader->lastHash = NULL; theHeader->rightHash = HashedExpressionPointer(theBsaveHeader->rightHash); theJoin = BloadJoinPointer(theBsaveHeader->entryJoin); theHeader->entryJoin = theJoin; while (theJoin != NULL) { theJoin->rightSideEntryStructure = (void *) theHeader; theJoin = theJoin->rightMatchNode; } } /**************************************/ /* ClearBload: Defrule clear routine */ /* when a binary load is in effect. */ /**************************************/ static void ClearBload( void *theEnv) { size_t space; long i; struct patternParser *theParser = NULL; struct patternEntity *theEntity = NULL; void *theModule; /*===========================================*/ /* Delete all known entities before removing */ /* the defrule data structures. */ /*===========================================*/ GetNextPatternEntity(theEnv,&theParser,&theEntity); while (theEntity != NULL) { (*theEntity->theInfo->base.deleteFunction)(theEnv,theEntity); theEntity = NULL; GetNextPatternEntity(theEnv,&theParser,&theEntity); } /*=========================================*/ /* Remove all activations from the agenda. */ /*=========================================*/ SaveCurrentModule(theEnv); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,theModule); RemoveAllActivations(theEnv); } RestoreCurrentModule(theEnv); EnvClearFocusStack(theEnv); /*==========================================================*/ /* Remove all partial matches from the beta memories in the */ /* join network. Alpha memories do not need to be examined */ /* since all pattern entities have been deleted by now. */ /*==========================================================*/ for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfJoins; i++) { FlushBetaMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i],LHS); ReturnLeftMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i]); FlushBetaMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i],RHS); ReturnRightMemory(theEnv,&DefruleBinaryData(theEnv)->JoinArray[i]); } /*================================================*/ /* Decrement the symbol count for each rule name. */ /*================================================*/ for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfDefrules; i++) { UnmarkConstructHeader(theEnv,&DefruleBinaryData(theEnv)->DefruleArray[i].header); } /*==================================================*/ /* Return the space allocated for the bload arrays. */ /*==================================================*/ space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->ModuleArray,space); DefruleBinaryData(theEnv)->NumberOfDefruleModules = 0; space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->DefruleArray,space); DefruleBinaryData(theEnv)->NumberOfDefrules = 0; space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->JoinArray,space); DefruleBinaryData(theEnv)->NumberOfJoins = 0; space = DefruleBinaryData(theEnv)->NumberOfLinks * sizeof(struct joinLink); if (space != 0) genfree(theEnv,(void *) DefruleBinaryData(theEnv)->LinkArray,space); DefruleBinaryData(theEnv)->NumberOfLinks = 0; DefruleData(theEnv)->RightPrimeJoins = NULL; DefruleData(theEnv)->LeftPrimeJoins = NULL; } /*******************************************************/ /* BloadDefruleModuleReference: Returns the defrule */ /* module pointer for using with the bload function. */ /*******************************************************/ globle void *BloadDefruleModuleReference( void *theEnv, int theIndex) { return ((void *) &DefruleBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFRULE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips_core_source_630/core/classinf.c0000755000175000017500000011512612373714502016211 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CLASS INFO PROGRAMMATIC ACCESS MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Class Information Interface Support Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include #include "argacces.h" #include "classcom.h" #include "classexm.h" #include "classfun.h" #include "classini.h" #include "envrnmnt.h" #include "memalloc.h" #include "insfun.h" #include "msgcom.h" #include "msgfun.h" #include "multifld.h" #include "prntutil.h" #define _CLASSINF_SOURCE_ #include "classinf.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void SlotInfoSupportFunction(void *,DATA_OBJECT *,const char *,void (*)(void *,void *,const char *,DATA_OBJECT *)); static unsigned CountSubclasses(DEFCLASS *,int,int); static unsigned StoreSubclasses(void *,unsigned,DEFCLASS *,int,int,short); static SLOT_DESC *SlotInfoSlot(void *,DATA_OBJECT *,DEFCLASS *,const char *,const char *); /********************************************************************* NAME : ClassAbstractPCommand DESCRIPTION : Determines if direct instances of a class can be made INPUTS : None RETURNS : TRUE (1) if class is abstract, FALSE (0) if concrete SIDE EFFECTS : None NOTES : Syntax: (class-abstractp ) *********************************************************************/ globle int ClassAbstractPCommand( void *theEnv) { DATA_OBJECT tmp; DEFCLASS *cls; if (EnvArgTypeCheck(theEnv,"class-abstractp",1,SYMBOL,&tmp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"class-abstractp",ValueToString(tmp.value)); return(FALSE); } return(EnvClassAbstractP(theEnv,(void *) cls)); } #if DEFRULE_CONSTRUCT /***************************************************************** NAME : ClassReactivePCommand DESCRIPTION : Determines if instances of a class can match rule patterns INPUTS : None RETURNS : TRUE (1) if class is reactive, FALSE (0) if non-reactive SIDE EFFECTS : None NOTES : Syntax: (class-reactivep ) *****************************************************************/ globle int ClassReactivePCommand( void *theEnv) { DATA_OBJECT tmp; DEFCLASS *cls; if (EnvArgTypeCheck(theEnv,"class-reactivep",1,SYMBOL,&tmp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"class-reactivep",ValueToString(tmp.value)); return(FALSE); } return(EnvClassReactiveP(theEnv,(void *) cls)); } #endif /*********************************************************** NAME : ClassInfoFnxArgs DESCRIPTION : Examines arguments for: class-slots, get-defmessage-handler-list, class-superclasses and class-subclasses INPUTS : 1) Name of function 2) A buffer to hold a flag indicating if the inherit keyword was specified RETURNS : Pointer to the class on success, NULL on errors SIDE EFFECTS : inhp flag set error flag set NOTES : None ***********************************************************/ globle void *ClassInfoFnxArgs( void *theEnv, const char *fnx, int *inhp) { void *clsptr; DATA_OBJECT tmp; *inhp = 0; if (EnvRtnArgCount(theEnv) == 0) { ExpectedCountError(theEnv,fnx,AT_LEAST,1); SetEvaluationError(theEnv,TRUE); return(NULL); } if (EnvArgTypeCheck(theEnv,fnx,1,SYMBOL,&tmp) == FALSE) return(NULL); clsptr = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (clsptr == NULL) { ClassExistError(theEnv,fnx,ValueToString(tmp.value)); return(NULL); } if (EnvRtnArgCount(theEnv) == 2) { if (EnvArgTypeCheck(theEnv,fnx,2,SYMBOL,&tmp) == FALSE) return(NULL); if (strcmp(ValueToString(tmp.value),"inherit") == 0) *inhp = 1; else { SyntaxErrorMessage(theEnv,fnx); SetEvaluationError(theEnv,TRUE); return(NULL); } } return(clsptr); } /******************************************************************** NAME : ClassSlotsCommand DESCRIPTION : Groups slot info for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the slots of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the slots of the class NOTES : Syntax: (class-slots [inherit]) ********************************************************************/ globle void ClassSlotsCommand( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; clsptr = ClassInfoFnxArgs(theEnv,"class-slots",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvClassSlots(theEnv,clsptr,result,inhp); } /************************************************************************ NAME : ClassSuperclassesCommand DESCRIPTION : Groups superclasses for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the superclasses of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the superclasses of the class NOTES : Syntax: (class-superclasses [inherit]) ************************************************************************/ globle void ClassSuperclassesCommand( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; clsptr = ClassInfoFnxArgs(theEnv,"class-superclasses",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvClassSuperclasses(theEnv,clsptr,result,inhp); } /************************************************************************ NAME : ClassSubclassesCommand DESCRIPTION : Groups subclasses for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the subclasses of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the subclasses of the class NOTES : Syntax: (class-subclasses [inherit]) ************************************************************************/ globle void ClassSubclassesCommand( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; clsptr = ClassInfoFnxArgs(theEnv,"class-subclasses",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvClassSubclasses(theEnv,clsptr,result,inhp); } /*********************************************************************** NAME : GetDefmessageHandlersListCmd DESCRIPTION : Groups message-handlers for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the handlers of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the message-handlers of the class NOTES : Syntax: (get-defmessage-handler-list [inherit]) ***********************************************************************/ globle void GetDefmessageHandlersListCmd( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; if (EnvRtnArgCount(theEnv) == 0) EnvGetDefmessageHandlerList(theEnv,NULL,result,0); else { clsptr = ClassInfoFnxArgs(theEnv,"get-defmessage-handler-list",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvGetDefmessageHandlerList(theEnv,clsptr,result,inhp); } } /********************************* Slot Information Access Functions *********************************/ globle void SlotFacetsCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-facets",EnvSlotFacets); } globle void SlotSourcesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-sources",EnvSlotSources); } globle void SlotTypesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-types",EnvSlotTypes); } globle void SlotAllowedValuesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-allowed-values",EnvSlotAllowedValues); } globle void SlotAllowedClassesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-allowed-classes",EnvSlotAllowedClasses); } globle void SlotRangeCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-range",EnvSlotRange); } globle void SlotCardinalityCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-cardinality",EnvSlotCardinality); } /******************************************************************** NAME : EnvClassAbstractP DESCRIPTION : Determines if a class is abstract or not INPUTS : Generic pointer to class RETURNS : 1 if class is abstract, 0 otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ globle intBool EnvClassAbstractP( void *theEnv, void *clsptr) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) clsptr)->abstract); } #if DEFRULE_CONSTRUCT /******************************************************************** NAME : EnvClassReactiveP DESCRIPTION : Determines if a class is reactive or not INPUTS : Generic pointer to class RETURNS : 1 if class is reactive, 0 otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ globle intBool EnvClassReactiveP( void *theEnv, void *clsptr) { #if MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) clsptr)->reactive); } #endif /******************************************************************** NAME : EnvClassSlots DESCRIPTION : Groups slot info for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the slots of the class 3) Include (1) or exclude (0) inherited slots RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the slots of the class NOTES : None ********************************************************************/ globle void EnvClassSlots( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { long size; register DEFCLASS *cls; long i; cls = (DEFCLASS *) clsptr; size = inhp ? cls->instanceSlotCount : cls->slotCount; result->type = MULTIFIELD; SetpDOBegin(result,1); SetpDOEnd(result,size); result->value = (void *) EnvCreateMultifield(theEnv,size); if (size == 0) return; if (inhp) { for (i = 0 ; i < cls->instanceSlotCount ; i++) { SetMFType(result->value,i+1,SYMBOL); SetMFValue(result->value,i+1,cls->instanceTemplate[i]->slotName->name); } } else { for (i = 0 ; i < cls->slotCount ; i++) { SetMFType(result->value,i+1,SYMBOL); SetMFValue(result->value,i+1,cls->slots[i].slotName->name); } } } /************************************************************************ NAME : EnvGetDefmessageHandlerList DESCRIPTION : Groups handler info for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class (NULL to get handlers for all classes) 2) Data object buffer to hold the handlers of the class 3) Include (1) or exclude (0) inherited handlers RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names and types of the message-handlers of the class NOTES : None ************************************************************************/ globle void EnvGetDefmessageHandlerList( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { DEFCLASS *cls,*svcls,*svnxt,*supcls; long j; register int classi,classiLimit; unsigned long i, sublen, len; if (clsptr == NULL) { inhp = 0; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls); } else { cls = (DEFCLASS *) clsptr; svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls); SetNextDefclass((void *) cls,NULL); } for (svcls = cls , i = 0 ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { classiLimit = inhp ? cls->allSuperclasses.classCount : 1; for (classi = 0 ; classi < classiLimit ; classi++) i += cls->allSuperclasses.classArray[classi]->handlerCount; } len = i * 3; result->type = MULTIFIELD; SetpDOBegin(result,1); SetpDOEnd(result,len); result->value = (void *) EnvCreateMultifield(theEnv,len); for (cls = svcls , sublen = 0 ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { classiLimit = inhp ? cls->allSuperclasses.classCount : 1; for (classi = 0 ; classi < classiLimit ; classi++) { supcls = cls->allSuperclasses.classArray[classi]; if (inhp == 0) i = sublen + 1; else i = len - (supcls->handlerCount * 3) - sublen + 1; for (j = 0 ; j < supcls->handlerCount ; j++) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,GetDefclassNamePointer((void *) supcls)); SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,supcls->handlers[j].name); SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,MessageHandlerData(theEnv)->hndquals[supcls->handlers[j].type])); } sublen += supcls->handlerCount * 3; } } if (svcls != NULL) SetNextDefclass((void *) svcls,(void *) svnxt); } /*************************************************************************** NAME : EnvClassSuperclasses DESCRIPTION : Groups the names of superclasses into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the superclasses of the class 3) Include (1) or exclude (0) indirect superclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the superclasses of the class NOTES : None ***************************************************************************/ globle void EnvClassSuperclasses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { PACKED_CLASS_LINKS *plinks; unsigned offset; long i,j; if (inhp) { plinks = &((DEFCLASS *) clsptr)->allSuperclasses; offset = 1; } else { plinks = &((DEFCLASS *) clsptr)->directSuperclasses; offset = 0; } result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,plinks->classCount - offset); result->value = (void *) EnvCreateMultifield(theEnv,result->end + 1U); if (result->end == -1) return; for (i = offset , j = 1 ; i < plinks->classCount ; i++ , j++) { SetMFType(result->value,j,SYMBOL); SetMFValue(result->value,j,GetDefclassNamePointer((void *) plinks->classArray[i])); } } /************************************************************************** NAME : EnvClassSubclasses DESCRIPTION : Groups the names of subclasses for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the sublclasses of the class 3) Include (1) or exclude (0) indirect subclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names the subclasses of the class NOTES : None **************************************************************************/ globle void EnvClassSubclasses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { register int i; // Bug fix 2014-07-18: Previously unsigned and SetpDOEnd decremented to -1. register int id; if ((id = GetTraversalID(theEnv)) == -1) return; i = CountSubclasses((DEFCLASS *) clsptr,inhp,id); ReleaseTraversalID(theEnv); result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); if (i == 0) return; if ((id = GetTraversalID(theEnv)) == -1) return; StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,TRUE); ReleaseTraversalID(theEnv); } /************************************************************************** NAME : ClassSubclassAddresses DESCRIPTION : Groups the class addresses of subclasses for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the sublclasses of the class 3) Include (1) or exclude (0) indirect subclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the subclass addresss of the class NOTES : None **************************************************************************/ globle void ClassSubclassAddresses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { register int i; // Bug fix 2014-07-18: Previously unsigned and SetpDOEnd decremented to -1. register int id; if ((id = GetTraversalID(theEnv)) == -1) return; i = CountSubclasses((DEFCLASS *) clsptr,inhp,id); ReleaseTraversalID(theEnv); result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); if (i == 0) return; if ((id = GetTraversalID(theEnv)) == -1) return; StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,FALSE); ReleaseTraversalID(theEnv); } /************************************************************************** NAME : Slot... Slot information access functions DESCRIPTION : Groups the sources/facets/types/allowed-values/range or cardinality of a slot for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Name of the slot 3) Data object buffer to hold the attributes of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the attributes for the slot of the class NOTES : None **************************************************************************/ globle void EnvSlotFacets( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-facets")) == NULL) return; #if DEFRULE_CONSTRUCT result->end = 9; result->value = (void *) EnvCreateMultifield(theEnv,10L); for (i = 1 ; i <= 10 ; i++) SetMFType(result->value,i,SYMBOL); #else result->end = 8; result->value = (void *) EnvCreateMultifield(theEnv,9L); for (i = 1 ; i <= 9 ; i++) SetMFType(result->value,i,SYMBOL); #endif if (sp->multiple) SetMFValue(result->value,1,EnvAddSymbol(theEnv,"MLT")); else SetMFValue(result->value,1,EnvAddSymbol(theEnv,"SGL")); if (sp->noDefault) SetMFValue(result->value,2,EnvAddSymbol(theEnv,"NIL")); else { if (sp->dynamicDefault) SetMFValue(result->value,2,EnvAddSymbol(theEnv,"DYN")); else SetMFValue(result->value,2,EnvAddSymbol(theEnv,"STC")); } if (sp->noInherit) SetMFValue(result->value,3,EnvAddSymbol(theEnv,"NIL")); else SetMFValue(result->value,3,EnvAddSymbol(theEnv,"INH")); if (sp->initializeOnly) SetMFValue(result->value,4,EnvAddSymbol(theEnv,"INT")); else if (sp->noWrite) SetMFValue(result->value,4,EnvAddSymbol(theEnv,"R")); else SetMFValue(result->value,4,EnvAddSymbol(theEnv,"RW")); if (sp->shared) SetMFValue(result->value,5,EnvAddSymbol(theEnv,"SHR")); else SetMFValue(result->value,5,EnvAddSymbol(theEnv,"LCL")); #if DEFRULE_CONSTRUCT if (sp->reactive) SetMFValue(result->value,6,EnvAddSymbol(theEnv,"RCT")); else SetMFValue(result->value,6,EnvAddSymbol(theEnv,"NIL")); if (sp->composite) SetMFValue(result->value,7,EnvAddSymbol(theEnv,"CMP")); else SetMFValue(result->value,7,EnvAddSymbol(theEnv,"EXC")); if (sp->publicVisibility) SetMFValue(result->value,8,EnvAddSymbol(theEnv,"PUB")); else SetMFValue(result->value,8,EnvAddSymbol(theEnv,"PRV")); SetMFValue(result->value,9,EnvAddSymbol(theEnv,GetCreateAccessorString((void *) sp))); SetMFValue(result->value,10,sp->noWrite ? EnvAddSymbol(theEnv,"NIL") : (void *) sp->overrideMessage); #else if (sp->composite) SetMFValue(result->value,6,EnvAddSymbol(theEnv,"CMP")); else SetMFValue(result->value,6,EnvAddSymbol(theEnv,"EXC")); if (sp->publicVisibility) SetMFValue(result->value,7,EnvAddSymbol(theEnv,"PUB")); else SetMFValue(result->value,7,EnvAddSymbol(theEnv,"PRV")); SetMFValue(result->value,8,EnvAddSymbol(theEnv,GetCreateAccessorString((void *) sp))); SetMFValue(result->value,9,sp->noWrite ? EnvAddSymbol(theEnv,"NIL") : (void *) sp->overrideMessage); #endif } globle void EnvSlotSources( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register unsigned i; register int classi; register SLOT_DESC *sp,*csp; CLASS_LINK *ctop,*ctmp; DEFCLASS *cls; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-sources")) == NULL) return; i = 1; ctop = get_struct(theEnv,classLink); ctop->cls = sp->cls; ctop->nxt = NULL; if (sp->composite) { for (classi = 1 ; classi < sp->cls->allSuperclasses.classCount ; classi++) { cls = sp->cls->allSuperclasses.classArray[classi]; csp = FindClassSlot(cls,sp->slotName->name); if ((csp != NULL) ? (csp->noInherit == 0) : FALSE) { ctmp = get_struct(theEnv,classLink); ctmp->cls = cls; ctmp->nxt = ctop; ctop = ctmp; i++; if (csp->composite == 0) break; } } } SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); for (ctmp = ctop , i = 1 ; ctmp != NULL ; ctmp = ctmp->nxt , i++) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i,GetDefclassNamePointer((void *) ctmp->cls)); } DeleteClassLinks(theEnv,ctop); } globle void EnvSlotTypes( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register unsigned i,j; register SLOT_DESC *sp; char typemap[2]; unsigned msize; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-types")) == NULL) return; if ((sp->constraint != NULL) ? sp->constraint->anyAllowed : TRUE) { typemap[0] = typemap[1] = (char) 0xFF; ClearBitMap(typemap,MULTIFIELD); msize = 8; } else { typemap[0] = typemap[1] = (char) 0x00; msize = 0; if (sp->constraint->symbolsAllowed) { msize++; SetBitMap(typemap,SYMBOL); } if (sp->constraint->stringsAllowed) { msize++; SetBitMap(typemap,STRING); } if (sp->constraint->floatsAllowed) { msize++; SetBitMap(typemap,FLOAT); } if (sp->constraint->integersAllowed) { msize++; SetBitMap(typemap,INTEGER); } if (sp->constraint->instanceNamesAllowed) { msize++; SetBitMap(typemap,INSTANCE_NAME); } if (sp->constraint->instanceAddressesAllowed) { msize++; SetBitMap(typemap,INSTANCE_ADDRESS); } if (sp->constraint->externalAddressesAllowed) { msize++; SetBitMap(typemap,EXTERNAL_ADDRESS); } if (sp->constraint->factAddressesAllowed) { msize++; SetBitMap(typemap,FACT_ADDRESS); } } SetpDOEnd(result,msize); result->value = EnvCreateMultifield(theEnv,msize); i = 1; j = 0; while (i <= msize) { if (TestBitMap(typemap,j)) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i, (void *) GetDefclassNamePointer((void *) DefclassData(theEnv)->PrimitiveClassMap[j])); i++; } j++; } } globle void EnvSlotAllowedValues( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; register EXPRESSION *theExp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-allowed-values")) == NULL) return; if ((sp->constraint != NULL) ? (sp->constraint->restrictionList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->end = ExpressionSize(sp->constraint->restrictionList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = sp->constraint->restrictionList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } } globle void EnvSlotAllowedClasses( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; register EXPRESSION *theExp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-allowed-classes")) == NULL) return; if ((sp->constraint != NULL) ? (sp->constraint->classList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->end = ExpressionSize(sp->constraint->classList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = sp->constraint->classList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } } globle void EnvSlotRange( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-range")) == NULL) return; if ((sp->constraint == NULL) ? FALSE : (sp->constraint->anyAllowed || sp->constraint->floatsAllowed || sp->constraint->integersAllowed)) { result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,sp->constraint->minValue->type); SetMFValue(result->value,1,sp->constraint->minValue->value); SetMFType(result->value,2,sp->constraint->maxValue->type); SetMFValue(result->value,2,sp->constraint->maxValue->value); } else { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } } globle void EnvSlotCardinality( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-cardinality")) == NULL) return; if (sp->multiple == 0) { EnvSetMultifieldErrorValue(theEnv,result); return; } result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); if (sp->constraint != NULL) { SetMFType(result->value,1,sp->constraint->minFields->type); SetMFValue(result->value,1,sp->constraint->minFields->value); SetMFType(result->value,2,sp->constraint->maxFields->type); SetMFValue(result->value,2,sp->constraint->maxFields->value); } else { SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : SlotInfoSupportFunction DESCRIPTION : Support routine for slot-sources, slot-facets, et. al. INPUTS : 1) Data object buffer 2) Name of the H/L caller 3) Pointer to support function to call RETURNS : Nothing useful SIDE EFFECTS : Support function called and data object buffer set NOTES : None *****************************************************/ static void SlotInfoSupportFunction( void *theEnv, DATA_OBJECT *result, const char *fnxname, void (*fnx)(void *,void *,const char *,DATA_OBJECT *)) { SYMBOL_HN *ssym; DEFCLASS *cls; ssym = CheckClassAndSlot(theEnv,fnxname,&cls); if (ssym == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } (*fnx)(theEnv,(void *) cls,ValueToString(ssym),result); } /***************************************************************** NAME : CountSubclasses DESCRIPTION : Counts the number of direct or indirect subclasses for a class INPUTS : 1) Address of class 2) Include (1) or exclude (0) indirect subclasses 3) Traversal id RETURNS : The number of subclasses SIDE EFFECTS : None NOTES : None *****************************************************************/ static unsigned CountSubclasses( DEFCLASS *cls, int inhp, int tvid) { long i,cnt; register DEFCLASS *subcls; for (cnt = 0 , i = 0 ; i < cls->directSubclasses.classCount ; i++) { subcls = cls->directSubclasses.classArray[i]; if (TestTraversalID(subcls->traversalRecord,tvid) == 0) { cnt++; SetTraversalID(subcls->traversalRecord,tvid); if (inhp && (subcls->directSubclasses.classCount != 0)) cnt += CountSubclasses(subcls,inhp,tvid); } } return(cnt); } /********************************************************************* NAME : StoreSubclasses DESCRIPTION : Stores the names of direct or indirect subclasses for a class in a mutlifield INPUTS : 1) Caller's multifield buffer 2) Starting index 3) Address of the class 4) Include (1) or exclude (0) indirect subclasses 5) Traversal id RETURNS : The number of subclass names stored in the multifield SIDE EFFECTS : Multifield set with subclass names NOTES : Assumes multifield is big enough to hold subclasses *********************************************************************/ static unsigned StoreSubclasses( void *mfval, unsigned si, DEFCLASS *cls, int inhp, int tvid, short storeName) { long i,classi; register DEFCLASS *subcls; for (i = si , classi = 0 ; classi < cls->directSubclasses.classCount ; classi++) { subcls = cls->directSubclasses.classArray[classi]; if (TestTraversalID(subcls->traversalRecord,tvid) == 0) { SetTraversalID(subcls->traversalRecord,tvid); if (storeName) { SetMFType(mfval,i,SYMBOL); SetMFValue(mfval,i++,(void *) GetDefclassNamePointer((void *) subcls)); } else { SetMFType(mfval,i,DEFCLASS_PTR); SetMFValue(mfval,i++,(void *) subcls); } if (inhp && (subcls->directSubclasses.classCount != 0)) i += StoreSubclasses(mfval,i,subcls,inhp,tvid,storeName); } } return(i - si); } /********************************************************* NAME : SlotInfoSlot DESCRIPTION : Runtime support routine for slot-sources, slot-facets, et. al. which looks up a slot INPUTS : 1) Data object buffer 2) Class pointer 3) Name-string of slot to find 4) The name of the calling function RETURNS : Nothing useful SIDE EFFECTS : Support function called and data object buffer initialized NOTES : None *********************************************************/ static SLOT_DESC *SlotInfoSlot( void *theEnv, DATA_OBJECT *result, DEFCLASS *cls, const char *sname, const char *fnxname) { SYMBOL_HN *ssym; int i; if ((ssym = FindSymbolHN(theEnv,sname)) == NULL) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,result); return(NULL); } i = FindInstanceTemplateSlot(theEnv,cls,ssym); if (i == -1) { SlotExistError(theEnv,sname,fnxname); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,result); return(NULL); } result->type = MULTIFIELD; result->begin = 0; return(cls->instanceTemplate[i]); } /*##################################*/ /* Additional Environment Functions */ /*##################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool ClassAbstractP( void *clsptr) { return EnvClassAbstractP(GetCurrentEnvironment(),clsptr); } #if DEFRULE_CONSTRUCT globle intBool ClassReactiveP( void *clsptr) { return EnvClassReactiveP(GetCurrentEnvironment(),clsptr); } #endif globle void ClassSlots( void *clsptr, DATA_OBJECT *result, int inhp) { EnvClassSlots(GetCurrentEnvironment(),clsptr,result,inhp); } globle void ClassSubclasses( void *clsptr, DATA_OBJECT *result, int inhp) { EnvClassSubclasses(GetCurrentEnvironment(),clsptr,result,inhp); } globle void ClassSuperclasses( void *clsptr, DATA_OBJECT *result, int inhp) { EnvClassSuperclasses(GetCurrentEnvironment(),clsptr,result,inhp); } globle void SlotAllowedValues( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotAllowedValues(GetCurrentEnvironment(),clsptr,sname,result); } globle void SlotAllowedClasses( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotAllowedClasses(GetCurrentEnvironment(),clsptr,sname,result); } globle void SlotCardinality( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotCardinality(GetCurrentEnvironment(),clsptr,sname,result); } globle void SlotFacets( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotFacets(GetCurrentEnvironment(),clsptr,sname,result); } globle void SlotRange( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotRange(GetCurrentEnvironment(),clsptr,sname,result); } globle void SlotSources( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotSources(GetCurrentEnvironment(),clsptr,sname,result); } globle void SlotTypes( void *clsptr, const char *sname, DATA_OBJECT *result) { EnvSlotTypes(GetCurrentEnvironment(),clsptr,sname,result); } globle void GetDefmessageHandlerList( void *clsptr, DATA_OBJECT *result, int inhp) { EnvGetDefmessageHandlerList(GetCurrentEnvironment(),clsptr,result,inhp); } #endif #endif clips_core_source_630/core/._facthsh.h0000755000175000017500000000040712373742654016255 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factrhs.h0000755000175000017500000000040712375261537016265 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objcmp.c0000755000175000017500000000040712374023214016063 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._prdctfun.c0000755000175000017500000000040712373743656016460 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulebld.c0000755000175000017500000000040712374024067016251 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._incrrset.h0000755000175000017500000000040712373755061016462 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factcmp.h0000755000175000017500000000040712373743676016257 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/reteutil.c0000755000175000017500000015305012500721260016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* RETE UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for join network changes. */ /* */ /* Support for using an asterick (*) to indicate */ /* that existential patterns are matched. */ /* */ /* Support for partial match changes. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added support for hashed memories. */ /* */ /* Removed pseudo-facts used in not CEs. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _RETEUTIL_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFRULE_CONSTRUCT #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "incrrset.h" #include "match.h" #include "memalloc.h" #include "moduldef.h" #include "pattern.h" #include "retract.h" #include "router.h" #include "rulecom.h" #include "reteutil.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void TraceErrorToRuleDriver(void *,struct joinNode *,const char *,int,int); static struct alphaMemoryHash *FindAlphaMemory(void *,struct patternNodeHeader *,unsigned long); static unsigned long AlphaMemoryHashValue(struct patternNodeHeader *,unsigned long); static void UnlinkAlphaMemory(void *,struct patternNodeHeader *,struct alphaMemoryHash *); static void UnlinkAlphaMemoryBucketSiblings(void *,struct alphaMemoryHash *); static void InitializePMLinks(struct partialMatch *); static void UnlinkBetaPartialMatchfromAlphaAndBetaLineage(struct partialMatch *); static int CountPriorPatterns(struct joinNode *); static void ResizeBetaMemory(void *,struct betaMemory *); static void ResetBetaMemory(void *,struct betaMemory *); #if (CONSTRUCT_COMPILER || BLOAD_AND_BSAVE) && (! RUN_TIME) static void TagNetworkTraverseJoins(void *,long int *,long int *,struct joinNode *); #endif /***********************************************************/ /* PrintPartialMatch: Prints out the list of fact indices */ /* and/or instance names associated with a partial match */ /* or rule instantiation. */ /***********************************************************/ globle void PrintPartialMatch( void *theEnv, const char *logicalName, struct partialMatch *list) { struct patternEntity *matchingItem; unsigned short i; for (i = 0; i < list->bcount;) { if ((get_nth_pm_match(list,i) != NULL) && (get_nth_pm_match(list,i)->matchingItem != NULL)) { matchingItem = get_nth_pm_match(list,i)->matchingItem; (*matchingItem->theInfo->base.shortPrintFunction)(theEnv,logicalName,matchingItem); } else { EnvPrintRouter(theEnv,logicalName,"*"); } i++; if (i < list->bcount) EnvPrintRouter(theEnv,logicalName,","); } } /**********************************************/ /* CopyPartialMatch: Copies a partial match. */ /**********************************************/ globle struct partialMatch *CopyPartialMatch( void *theEnv, struct partialMatch *list) { struct partialMatch *linker; unsigned short i; linker = get_var_struct(theEnv,partialMatch,sizeof(struct genericMatch) * (list->bcount - 1)); InitializePMLinks(linker); linker->betaMemory = TRUE; linker->busy = FALSE; linker->rhsMemory = FALSE; linker->bcount = list->bcount; linker->hashValue = 0; for (i = 0; i < linker->bcount; i++) linker->binds[i] = list->binds[i]; return(linker); } /**********************************************/ /* CreateEmptyPartialMatch: */ /**********************************************/ globle struct partialMatch *CreateEmptyPartialMatch( void *theEnv) { struct partialMatch *linker; linker = get_struct(theEnv,partialMatch); InitializePMLinks(linker); linker->betaMemory = TRUE; linker->busy = FALSE; linker->rhsMemory = FALSE; linker->bcount = 1; linker->hashValue = 0; linker->binds[0].gm.theValue = NULL; return(linker); } /****************************************************/ /* InitializePMLinks: */ /****************************************************/ static void InitializePMLinks( struct partialMatch *theMatch) { theMatch->nextInMemory = NULL; theMatch->prevInMemory = NULL; theMatch->nextRightChild = NULL; theMatch->prevRightChild = NULL; theMatch->nextLeftChild = NULL; theMatch->prevLeftChild = NULL; theMatch->children = NULL; theMatch->rightParent = NULL; theMatch->leftParent = NULL; theMatch->blockList = NULL; theMatch->nextBlocked = NULL; theMatch->prevBlocked = NULL; theMatch->marker = NULL; theMatch->dependents = NULL; } /***********************************************************/ /* UpdateBetaPMLinks: . */ /***********************************************************/ globle void UpdateBetaPMLinks( void *theEnv, struct partialMatch *thePM, struct partialMatch *lhsBinds, struct partialMatch *rhsBinds, struct joinNode *join, unsigned long hashValue, int side) { unsigned long betaLocation; struct betaMemory *theMemory; if (side == LHS) { theMemory = join->leftMemory; thePM->rhsMemory = FALSE; } else { theMemory = join->rightMemory; thePM->rhsMemory = TRUE; } thePM->hashValue = hashValue; /*================================*/ /* Update the node's linked list. */ /*================================*/ betaLocation = hashValue % theMemory->size; if (side == LHS) { thePM->nextInMemory = theMemory->beta[betaLocation]; if (theMemory->beta[betaLocation] != NULL) { theMemory->beta[betaLocation]->prevInMemory = thePM; } theMemory->beta[betaLocation] = thePM; } else { if (theMemory->last[betaLocation] != NULL) { theMemory->last[betaLocation]->nextInMemory = thePM; thePM->prevInMemory = theMemory->last[betaLocation]; } else { theMemory->beta[betaLocation] = thePM; } theMemory->last[betaLocation] = thePM; } theMemory->count++; if (side == LHS) { join->memoryLeftAdds++; } else { join->memoryRightAdds++; } thePM->owner = join; /*======================================*/ /* Update the alpha memory linked list. */ /*======================================*/ if (rhsBinds != NULL) { thePM->nextRightChild = rhsBinds->children; if (rhsBinds->children != NULL) { rhsBinds->children->prevRightChild = thePM; } rhsBinds->children = thePM; thePM->rightParent = rhsBinds; } /*=====================================*/ /* Update the beta memory linked list. */ /*=====================================*/ if (lhsBinds != NULL) { thePM->nextLeftChild = lhsBinds->children; if (lhsBinds->children != NULL) { lhsBinds->children->prevLeftChild = thePM; } lhsBinds->children = thePM; thePM->leftParent = lhsBinds; } if (! DefruleData(theEnv)->BetaMemoryResizingFlag) { return; } if ((theMemory->size > 1) && (theMemory->count > (theMemory->size * 11))) { ResizeBetaMemory(theEnv,theMemory); } } /**********************************************************/ /* AddBlockedLink: Adds a link between a partial match in */ /* the beta memory of a join (with a negated RHS) and a */ /* partial match in its right memory that prevents the */ /* partial match from being satisfied and propagated to */ /* the next join in the rule. */ /**********************************************************/ globle void AddBlockedLink( struct partialMatch *thePM, struct partialMatch *rhsBinds) { thePM->marker = rhsBinds; thePM->nextBlocked = rhsBinds->blockList; if (rhsBinds->blockList != NULL) { rhsBinds->blockList->prevBlocked = thePM; } rhsBinds->blockList = thePM; } /*************************************************************/ /* RemoveBlockedLink: Removes a link between a partial match */ /* in the beta memory of a join (with a negated RHS) and a */ /* partial match in its right memory that prevents the */ /* partial match from being satisfied and propagated to */ /* the next join in the rule. */ /*************************************************************/ globle void RemoveBlockedLink( struct partialMatch *thePM) { struct partialMatch *blocker; if (thePM->prevBlocked == NULL) { blocker = (struct partialMatch *) thePM->marker; blocker->blockList = thePM->nextBlocked; } else { thePM->prevBlocked->nextBlocked = thePM->nextBlocked; } if (thePM->nextBlocked != NULL) { thePM->nextBlocked->prevBlocked = thePM->prevBlocked; } thePM->nextBlocked = NULL; thePM->prevBlocked = NULL; thePM->marker = NULL; } /***********************************************************/ /* UnlinkBetaPMFromNodeAndLineage: . */ /***********************************************************/ globle void UnlinkBetaPMFromNodeAndLineage( void *theEnv, struct joinNode *join, struct partialMatch *thePM, int side) { unsigned long betaLocation; struct betaMemory *theMemory; if (side == LHS) { theMemory = join->leftMemory; } else { theMemory = join->rightMemory; } /*=============================================*/ /* Update the nextInMemory/prevInMemory links. */ /*=============================================*/ theMemory->count--; if (side == LHS) { join->memoryLeftDeletes++; } else { join->memoryRightDeletes++; } betaLocation = thePM->hashValue % theMemory->size; if ((side == RHS) && (theMemory->last[betaLocation] == thePM)) { theMemory->last[betaLocation] = thePM->prevInMemory; } if (thePM->prevInMemory == NULL) { betaLocation = thePM->hashValue % theMemory->size; theMemory->beta[betaLocation] = thePM->nextInMemory; } else { thePM->prevInMemory->nextInMemory = thePM->nextInMemory; } if (thePM->nextInMemory != NULL) { thePM->nextInMemory->prevInMemory = thePM->prevInMemory; } thePM->nextInMemory = NULL; thePM->prevInMemory = NULL; UnlinkBetaPartialMatchfromAlphaAndBetaLineage(thePM); if (! DefruleData(theEnv)->BetaMemoryResizingFlag) { return; } if ((theMemory->count == 0) && (theMemory->size > 1)) { ResetBetaMemory(theEnv,theMemory); } } /***********************************************************/ /* UnlinkNonLeftLineage: . */ /***********************************************************/ globle void UnlinkNonLeftLineage( void *theEnv, struct joinNode *join, struct partialMatch *thePM, int side) { unsigned long betaLocation; struct betaMemory *theMemory; struct partialMatch *tempPM; if (side == LHS) { theMemory = join->leftMemory; } else { theMemory = join->rightMemory; } /*=============================================*/ /* Update the nextInMemory/prevInMemory links. */ /*=============================================*/ theMemory->count--; if (side == LHS) { join->memoryLeftDeletes++; } else { join->memoryRightDeletes++; } betaLocation = thePM->hashValue % theMemory->size; if ((side == RHS) && (theMemory->last[betaLocation] == thePM)) { theMemory->last[betaLocation] = thePM->prevInMemory; } if (thePM->prevInMemory == NULL) { betaLocation = thePM->hashValue % theMemory->size; theMemory->beta[betaLocation] = thePM->nextInMemory; } else { thePM->prevInMemory->nextInMemory = thePM->nextInMemory; } if (thePM->nextInMemory != NULL) { thePM->nextInMemory->prevInMemory = thePM->prevInMemory; } /*=========================*/ /* Update the alpha lists. */ /*=========================*/ if (thePM->prevRightChild == NULL) { if (thePM->rightParent != NULL) { thePM->rightParent->children = thePM->nextRightChild; if (thePM->nextRightChild != NULL) { thePM->rightParent->children = thePM->nextRightChild; thePM->nextRightChild->rightParent = thePM->rightParent; } } } else { thePM->prevRightChild->nextRightChild = thePM->nextRightChild; } if (thePM->nextRightChild != NULL) { thePM->nextRightChild->prevRightChild = thePM->prevRightChild; } /*===========================*/ /* Update the blocked lists. */ /*===========================*/ if (thePM->prevBlocked == NULL) { tempPM = (struct partialMatch *) thePM->marker; if (tempPM != NULL) { tempPM->blockList = thePM->nextBlocked; } } else { thePM->prevBlocked->nextBlocked = thePM->nextBlocked; } if (thePM->nextBlocked != NULL) { thePM->nextBlocked->prevBlocked = thePM->prevBlocked; } if (! DefruleData(theEnv)->BetaMemoryResizingFlag) { return; } if ((theMemory->count == 0) && (theMemory->size > 1)) { ResetBetaMemory(theEnv,theMemory); } } /*******************************************************************/ /* UnlinkBetaPartialMatchfromAlphaAndBetaLineage: Removes the */ /* lineage links from a beta memory partial match. This removes */ /* the links between this partial match and its left and right */ /* memory parents. It also removes the links between this */ /* partial match and any of its children in other beta memories. */ /*******************************************************************/ static void UnlinkBetaPartialMatchfromAlphaAndBetaLineage( struct partialMatch *thePM) { struct partialMatch *tempPM; /*=========================*/ /* Update the alpha lists. */ /*=========================*/ if (thePM->prevRightChild == NULL) { if (thePM->rightParent != NULL) { thePM->rightParent->children = thePM->nextRightChild; } } else { thePM->prevRightChild->nextRightChild = thePM->nextRightChild; } if (thePM->nextRightChild != NULL) { thePM->nextRightChild->prevRightChild = thePM->prevRightChild; } thePM->rightParent = NULL; thePM->nextRightChild = NULL; thePM->prevRightChild = NULL; /*========================*/ /* Update the beta lists. */ /*========================*/ if (thePM->prevLeftChild == NULL) { if (thePM->leftParent != NULL) { thePM->leftParent->children = thePM->nextLeftChild; } } else { thePM->prevLeftChild->nextLeftChild = thePM->nextLeftChild; } if (thePM->nextLeftChild != NULL) { thePM->nextLeftChild->prevLeftChild = thePM->prevLeftChild; } thePM->leftParent = NULL; thePM->nextLeftChild = NULL; thePM->prevLeftChild = NULL; /*===========================*/ /* Update the blocked lists. */ /*===========================*/ if (thePM->prevBlocked == NULL) { tempPM = (struct partialMatch *) thePM->marker; if (tempPM != NULL) { tempPM->blockList = thePM->nextBlocked; } } else { thePM->prevBlocked->nextBlocked = thePM->nextBlocked; } if (thePM->nextBlocked != NULL) { thePM->nextBlocked->prevBlocked = thePM->prevBlocked; } thePM->marker = NULL; thePM->nextBlocked = NULL; thePM->prevBlocked = NULL; /*===============================================*/ /* Remove parent reference from the child links. */ /*===============================================*/ if (thePM->children != NULL) { if (thePM->rhsMemory) { for (tempPM = thePM->children; tempPM != NULL; tempPM = tempPM->nextRightChild) { tempPM->rightParent = NULL; } } else { for (tempPM = thePM->children; tempPM != NULL; tempPM = tempPM->nextLeftChild) { tempPM->leftParent = NULL; } } thePM->children = NULL; } } /********************************************************/ /* MergePartialMatches: Merges two partial matches. The */ /* second match should either be NULL (indicating a */ /* negated CE) or contain a single match. */ /********************************************************/ globle struct partialMatch *MergePartialMatches( void *theEnv, struct partialMatch *lhsBind, struct partialMatch *rhsBind) { struct partialMatch *linker; static struct partialMatch mergeTemplate = { 1 }; /* betaMemory is TRUE, remainder are 0 or NULL */ /*=================================*/ /* Allocate the new partial match. */ /*=================================*/ linker = get_var_struct(theEnv,partialMatch,sizeof(struct genericMatch) * lhsBind->bcount); /*============================================*/ /* Set the flags to their appropriate values. */ /*============================================*/ memcpy(linker,&mergeTemplate,sizeof(struct partialMatch) - sizeof(struct genericMatch)); linker->bcount = (unsigned short) (lhsBind->bcount + 1); /*========================================================*/ /* Copy the bindings of the partial match being extended. */ /*========================================================*/ memcpy(linker->binds,lhsBind->binds,sizeof(struct genericMatch) * lhsBind->bcount); /*===================================*/ /* Add the binding of the rhs match. */ /*===================================*/ if (rhsBind == NULL) { linker->binds[lhsBind->bcount].gm.theValue = NULL; } else { linker->binds[lhsBind->bcount].gm.theValue = rhsBind->binds[0].gm.theValue; } return(linker); } /*******************************************************************/ /* InitializePatternHeader: Initializes a pattern header structure */ /* (used by the fact and instance pattern matchers). */ /*******************************************************************/ globle void InitializePatternHeader( void *theEnv, struct patternNodeHeader *theHeader) { #if MAC_XCD #pragma unused(theEnv) #endif theHeader->firstHash = NULL; theHeader->lastHash = NULL; theHeader->entryJoin = NULL; theHeader->rightHash = NULL; theHeader->singlefieldNode = FALSE; theHeader->multifieldNode = FALSE; theHeader->stopNode = FALSE; #if (! RUN_TIME) theHeader->initialize = EnvGetIncrementalReset(theEnv); #else theHeader->initialize = FALSE; #endif theHeader->marked = FALSE; theHeader->beginSlot = FALSE; theHeader->endSlot = FALSE; theHeader->selector = FALSE; } /******************************************************************/ /* CreateAlphaMatch: Given a pointer to an entity (such as a fact */ /* or instance) which matched a pattern, this function creates */ /* a partial match suitable for storing in the alpha memory of */ /* the pattern network. Note that the multifield markers which */ /* are passed as a calling argument are copied (thus the caller */ /* is still responsible for freeing these data structures). */ /******************************************************************/ globle struct partialMatch *CreateAlphaMatch( void *theEnv, void *theEntity, struct multifieldMarker *markers, struct patternNodeHeader *theHeader, unsigned long hashOffset) { struct partialMatch *theMatch; struct alphaMatch *afbtemp; unsigned long hashValue; struct alphaMemoryHash *theAlphaMemory; /*==================================================*/ /* Create the alpha match and intialize its values. */ /*==================================================*/ theMatch = get_struct(theEnv,partialMatch); InitializePMLinks(theMatch); theMatch->betaMemory = FALSE; theMatch->busy = FALSE; theMatch->bcount = 1; theMatch->hashValue = hashOffset; afbtemp = get_struct(theEnv,alphaMatch); afbtemp->next = NULL; afbtemp->matchingItem = (struct patternEntity *) theEntity; if (markers != NULL) { afbtemp->markers = CopyMultifieldMarkers(theEnv,markers); } else { afbtemp->markers = NULL; } theMatch->binds[0].gm.theMatch = afbtemp; /*============================================*/ /* Find the alpha memory of the pattern node. */ /*============================================*/ hashValue = AlphaMemoryHashValue(theHeader,hashOffset); theAlphaMemory = FindAlphaMemory(theEnv,theHeader,hashValue); afbtemp->bucket = hashValue; /*============================================*/ /* Create an alpha memory if it wasn't found. */ /*============================================*/ if (theAlphaMemory == NULL) { theAlphaMemory = get_struct(theEnv,alphaMemoryHash); theAlphaMemory->bucket = hashValue; theAlphaMemory->owner = theHeader; theAlphaMemory->alphaMemory = NULL; theAlphaMemory->endOfQueue = NULL; theAlphaMemory->nextHash = NULL; theAlphaMemory->next = DefruleData(theEnv)->AlphaMemoryTable[hashValue]; if (theAlphaMemory->next != NULL) { theAlphaMemory->next->prev = theAlphaMemory; } theAlphaMemory->prev = NULL; DefruleData(theEnv)->AlphaMemoryTable[hashValue] = theAlphaMemory; if (theHeader->firstHash == NULL) { theHeader->firstHash = theAlphaMemory; theHeader->lastHash = theAlphaMemory; theAlphaMemory->prevHash = NULL; } else { theHeader->lastHash->nextHash = theAlphaMemory; theAlphaMemory->prevHash = theHeader->lastHash; theHeader->lastHash = theAlphaMemory; } } /*====================================*/ /* Store the alpha match in the alpha */ /* memory of the pattern node. */ /*====================================*/ theMatch->prevInMemory = theAlphaMemory->endOfQueue; if (theAlphaMemory->endOfQueue == NULL) { theAlphaMemory->alphaMemory = theMatch; theAlphaMemory->endOfQueue = theMatch; } else { theAlphaMemory->endOfQueue->nextInMemory = theMatch; theAlphaMemory->endOfQueue = theMatch; } /*===================================================*/ /* Return a pointer to the newly create alpha match. */ /*===================================================*/ return(theMatch); } /*******************************************/ /* CopyMultifieldMarkers: Copies a list of */ /* multifieldMarker data structures. */ /*******************************************/ struct multifieldMarker *CopyMultifieldMarkers( void *theEnv, struct multifieldMarker *theMarkers) { struct multifieldMarker *head = NULL, *lastMark = NULL, *newMark; while (theMarkers != NULL) { newMark = get_struct(theEnv,multifieldMarker); newMark->next = NULL; newMark->whichField = theMarkers->whichField; newMark->where = theMarkers->where; newMark->startPosition = theMarkers->startPosition; newMark->endPosition = theMarkers->endPosition; if (lastMark == NULL) { head = newMark; } else { lastMark->next = newMark; } lastMark = newMark; theMarkers = theMarkers->next; } return(head); } /***************************************************************/ /* FlushAlphaBetaMemory: Returns all partial matches in a list */ /* of partial matches either directly to the pool of free */ /* memory or to the list of GarbagePartialMatches. Partial */ /* matches stored in alpha memories must be placed on the */ /* list of GarbagePartialMatches. */ /***************************************************************/ globle void FlushAlphaBetaMemory( void *theEnv, struct partialMatch *pfl) { struct partialMatch *pfltemp; while (pfl != NULL) { pfltemp = pfl->nextInMemory; UnlinkBetaPartialMatchfromAlphaAndBetaLineage(pfl); ReturnPartialMatch(theEnv,pfl); pfl = pfltemp; } } /*****************************************************************/ /* DestroyAlphaBetaMemory: Returns all partial matches in a list */ /* of partial matches directly to the pool of free memory. */ /*****************************************************************/ globle void DestroyAlphaBetaMemory( void *theEnv, struct partialMatch *pfl) { struct partialMatch *pfltemp; while (pfl != NULL) { pfltemp = pfl->nextInMemory; DestroyPartialMatch(theEnv,pfl); pfl = pfltemp; } } /******************************************************/ /* FindEntityInPartialMatch: Searches for a specified */ /* data entity in a partial match. */ /******************************************************/ globle int FindEntityInPartialMatch( struct patternEntity *theEntity, struct partialMatch *thePartialMatch) { unsigned short i; for (i = 0 ; i < thePartialMatch->bcount; i++) { if (thePartialMatch->binds[i].gm.theMatch == NULL) continue; if (thePartialMatch->binds[i].gm.theMatch->matchingItem == theEntity) { return(TRUE); } } return(FALSE); } /***********************************************************************/ /* GetPatternNumberFromJoin: Given a pointer to a join associated with */ /* a pattern CE, returns an integer representing the position of the */ /* pattern CE in the rule (e.g. first, second, third). */ /***********************************************************************/ globle int GetPatternNumberFromJoin( struct joinNode *joinPtr) { int whichOne = 0; while (joinPtr != NULL) { if (joinPtr->joinFromTheRight) { joinPtr = (struct joinNode *) joinPtr->rightSideEntryStructure; } else { whichOne++; joinPtr = joinPtr->lastLevel; } } return(whichOne); } /************************************************************************/ /* TraceErrorToRule: Prints an error message when a error occurs as the */ /* result of evaluating an expression in the pattern network. Used to */ /* indicate which rule caused the problem. */ /************************************************************************/ globle void TraceErrorToRule( void *theEnv, struct joinNode *joinPtr, const char *indentSpaces) { int patternCount; MarkRuleNetwork(theEnv,0); patternCount = CountPriorPatterns(joinPtr->lastLevel) + 1; TraceErrorToRuleDriver(theEnv,joinPtr,indentSpaces,patternCount,FALSE); MarkRuleNetwork(theEnv,0); } /**************************************************************/ /* TraceErrorToRuleDriver: Driver code for printing out which */ /* rule caused a pattern or join network error. */ /**************************************************************/ static void TraceErrorToRuleDriver( void *theEnv, struct joinNode *joinPtr, const char *indentSpaces, int priorRightJoinPatterns, int enteredJoinFromRight) { const char *name; int priorPatternCount; struct joinLink *theLinks; if ((joinPtr->joinFromTheRight) && enteredJoinFromRight) { priorPatternCount = CountPriorPatterns(joinPtr->lastLevel); } else { priorPatternCount = 0; } if (joinPtr->marked) { /* Do Nothing */ } else if (joinPtr->ruleToActivate != NULL) { joinPtr->marked = 1; name = EnvGetDefruleName(theEnv,joinPtr->ruleToActivate); EnvPrintRouter(theEnv,WERROR,indentSpaces); EnvPrintRouter(theEnv,WERROR,"Of pattern #"); PrintLongInteger(theEnv,WERROR,priorRightJoinPatterns+priorPatternCount); EnvPrintRouter(theEnv,WERROR," in rule "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,"\n"); } else { joinPtr->marked = 1; theLinks = joinPtr->nextLinks; while (theLinks != NULL) { TraceErrorToRuleDriver(theEnv,theLinks->join,indentSpaces, priorRightJoinPatterns+priorPatternCount, (theLinks->enterDirection == RHS)); theLinks = theLinks->next; } } } /**************************************************************/ /* CountPriorPatterns: */ /**************************************************************/ static int CountPriorPatterns( struct joinNode *joinPtr) { int count = 0; while (joinPtr != NULL) { if (joinPtr->joinFromTheRight) { count += CountPriorPatterns((struct joinNode *) joinPtr->rightSideEntryStructure); } else { count++; } joinPtr = joinPtr->lastLevel; } return(count); } /********************************************************/ /* MarkRuleNetwork: Sets the marked flag in each of the */ /* joins in the join network to the specified value. */ /********************************************************/ globle void MarkRuleNetwork( void *theEnv, int value) { struct defrule *rulePtr, *disjunctPtr; struct joinNode *joinPtr; struct defmodule *modulePtr; /*===========================*/ /* Loop through each module. */ /*===========================*/ SaveCurrentModule(theEnv); for (modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); modulePtr != NULL; modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,modulePtr)) { EnvSetCurrentModule(theEnv,(void *) modulePtr); /*=========================*/ /* Loop through each rule. */ /*=========================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { /*=============================*/ /* Mark each join for the rule */ /* with the specified value. */ /*=============================*/ for (disjunctPtr = rulePtr; disjunctPtr != NULL; disjunctPtr = disjunctPtr->disjunct) { joinPtr = disjunctPtr->lastJoin; MarkRuleJoins(joinPtr,value); } /*===========================*/ /* Move on to the next rule. */ /*===========================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } RestoreCurrentModule(theEnv); } /*****************************************/ /* MarkRuleJoins: */ /*****************************************/ globle void MarkRuleJoins( struct joinNode *joinPtr, int value) { while (joinPtr != NULL) { if (joinPtr->joinFromTheRight) { MarkRuleJoins((struct joinNode *) joinPtr->rightSideEntryStructure,value); } joinPtr->marked = value; joinPtr = joinPtr->lastLevel; } } /*****************************************/ /* GetAlphaMemory: Retrieves the list of */ /* matches from an alpha memory. */ /*****************************************/ globle struct partialMatch *GetAlphaMemory( void *theEnv, struct patternNodeHeader *theHeader, unsigned long hashOffset) { struct alphaMemoryHash *theAlphaMemory; unsigned long hashValue; hashValue = AlphaMemoryHashValue(theHeader,hashOffset); theAlphaMemory = FindAlphaMemory(theEnv,theHeader,hashValue); if (theAlphaMemory == NULL) { return NULL; } return theAlphaMemory->alphaMemory; } /*****************************************/ /* GetLeftBetaMemory: Retrieves the list */ /* of matches from a beta memory. */ /*****************************************/ globle struct partialMatch *GetLeftBetaMemory( struct joinNode *theJoin, unsigned long hashValue) { unsigned long betaLocation; betaLocation = hashValue % theJoin->leftMemory->size; return theJoin->leftMemory->beta[betaLocation]; } /******************************************/ /* GetRightBetaMemory: Retrieves the list */ /* of matches from a beta memory. */ /******************************************/ globle struct partialMatch *GetRightBetaMemory( struct joinNode *theJoin, unsigned long hashValue) { unsigned long betaLocation; betaLocation = hashValue % theJoin->rightMemory->size; return theJoin->rightMemory->beta[betaLocation]; } /***************************************/ /* ReturnLeftMemory: Sets the contents */ /* of a beta memory to NULL. */ /***************************************/ globle void ReturnLeftMemory( void *theEnv, struct joinNode *theJoin) { if (theJoin->leftMemory == NULL) return; genfree(theEnv,theJoin->leftMemory->beta,sizeof(struct partialMatch *) * theJoin->leftMemory->size); rtn_struct(theEnv,betaMemory,theJoin->leftMemory); theJoin->leftMemory = NULL; } /***************************************/ /* ReturnRightMemory: Sets the contents */ /* of a beta memory to NULL. */ /***************************************/ globle void ReturnRightMemory( void *theEnv, struct joinNode *theJoin) { if (theJoin->rightMemory == NULL) return; genfree(theEnv,theJoin->rightMemory->beta,sizeof(struct partialMatch *) * theJoin->rightMemory->size); genfree(theEnv,theJoin->rightMemory->last,sizeof(struct partialMatch *) * theJoin->rightMemory->size); rtn_struct(theEnv,betaMemory,theJoin->rightMemory); theJoin->rightMemory = NULL; } /****************************************************************/ /* DestroyBetaMemory: Destroys the contents of a beta memory in */ /* preperation for the deallocation of a join. Destroying is */ /* performed when the environment is being deallocated and it */ /* is not necessary to leave the environment in a consistent */ /* state (as it would be if just a single rule were being */ /* deleted). */ /****************************************************************/ globle void DestroyBetaMemory( void *theEnv, struct joinNode *theJoin, int side) { unsigned long i; if (side == LHS) { if (theJoin->leftMemory == NULL) return; for (i = 0; i < theJoin->leftMemory->size; i++) { DestroyAlphaBetaMemory(theEnv,theJoin->leftMemory->beta[i]); } } else { if (theJoin->rightMemory == NULL) return; for (i = 0; i < theJoin->rightMemory->size; i++) { DestroyAlphaBetaMemory(theEnv,theJoin->rightMemory->beta[i]); } } } /*************************************************************/ /* FlushBetaMemory: Flushes the contents of a beta memory in */ /* preperation for the deallocation of a join. Flushing */ /* is performed when the partial matches in the beta */ /* memory may still be in use because the environment will */ /* remain active. */ /*************************************************************/ globle void FlushBetaMemory( void *theEnv, struct joinNode *theJoin, int side) { unsigned long i; if (side == LHS) { if (theJoin->leftMemory == NULL) return; for (i = 0; i < theJoin->leftMemory->size; i++) { FlushAlphaBetaMemory(theEnv,theJoin->leftMemory->beta[i]); } } else { if (theJoin->rightMemory == NULL) return; for (i = 0; i < theJoin->rightMemory->size; i++) { FlushAlphaBetaMemory(theEnv,theJoin->rightMemory->beta[i]); } } } /*****************************************************************/ /* BetaMemoryNotEmpty: */ /*****************************************************************/ globle intBool BetaMemoryNotEmpty( struct joinNode *theJoin) { if (theJoin->leftMemory != NULL) { if (theJoin->leftMemory->count > 0) { return(TRUE); } } if (theJoin->rightMemory != NULL) { if (theJoin->rightMemory->count > 0) { return(TRUE); } } return(FALSE); } /*********************************************/ /* RemoveAlphaMemoryMatches: Removes matches */ /* from an alpha memory. */ /*********************************************/ globle void RemoveAlphaMemoryMatches( void *theEnv, struct patternNodeHeader *theHeader, struct partialMatch *theMatch, struct alphaMatch *theAlphaMatch) { struct alphaMemoryHash *theAlphaMemory = NULL; unsigned long hashValue; if ((theMatch->prevInMemory == NULL) || (theMatch->nextInMemory == NULL)) { hashValue = theAlphaMatch->bucket; theAlphaMemory = FindAlphaMemory(theEnv,theHeader,hashValue); } if (theMatch->prevInMemory != NULL) { theMatch->prevInMemory->nextInMemory = theMatch->nextInMemory; } else { theAlphaMemory->alphaMemory = theMatch->nextInMemory; } if (theMatch->nextInMemory != NULL) { theMatch->nextInMemory->prevInMemory = theMatch->prevInMemory; } else { theAlphaMemory->endOfQueue = theMatch->prevInMemory; } /*====================================*/ /* Add the match to the garbage list. */ /*====================================*/ theMatch->nextInMemory = EngineData(theEnv)->GarbagePartialMatches; EngineData(theEnv)->GarbagePartialMatches = theMatch; if ((theAlphaMemory != NULL) && (theAlphaMemory->alphaMemory == NULL)) { UnlinkAlphaMemory(theEnv,theHeader,theAlphaMemory); } } /*****************************************************************/ /* DestroyAlphaMemory: */ /*****************************************************************/ globle void DestroyAlphaMemory( void *theEnv, struct patternNodeHeader *theHeader, int unlink) { struct alphaMemoryHash *theAlphaMemory, *tempMemory; theAlphaMemory = theHeader->firstHash; while (theAlphaMemory != NULL) { tempMemory = theAlphaMemory->nextHash; DestroyAlphaBetaMemory(theEnv,theAlphaMemory->alphaMemory); if (unlink) { UnlinkAlphaMemoryBucketSiblings(theEnv,theAlphaMemory); } rtn_struct(theEnv,alphaMemoryHash,theAlphaMemory); theAlphaMemory = tempMemory; } theHeader->firstHash = NULL; theHeader->lastHash = NULL; } /*****************************************************************/ /* FlushAlphaMemory: */ /*****************************************************************/ globle void FlushAlphaMemory( void *theEnv, struct patternNodeHeader *theHeader) { struct alphaMemoryHash *theAlphaMemory, *tempMemory; theAlphaMemory = theHeader->firstHash; while (theAlphaMemory != NULL) { tempMemory = theAlphaMemory->nextHash; FlushAlphaBetaMemory(theEnv,theAlphaMemory->alphaMemory); UnlinkAlphaMemoryBucketSiblings(theEnv,theAlphaMemory); rtn_struct(theEnv,alphaMemoryHash,theAlphaMemory); theAlphaMemory = tempMemory; } theHeader->firstHash = NULL; theHeader->lastHash = NULL; } /*****************************************************************/ /* FindAlphaMemory: */ /*****************************************************************/ static struct alphaMemoryHash *FindAlphaMemory( void *theEnv, struct patternNodeHeader *theHeader, unsigned long hashValue) { struct alphaMemoryHash *theAlphaMemory; theAlphaMemory = DefruleData(theEnv)->AlphaMemoryTable[hashValue]; if (theAlphaMemory != NULL) { while ((theAlphaMemory != NULL) && (theAlphaMemory->owner != theHeader)) { theAlphaMemory = theAlphaMemory->next; } } return theAlphaMemory; } /*****************************************************************/ /* AlphaMemoryHashValue: */ /*****************************************************************/ static unsigned long AlphaMemoryHashValue( struct patternNodeHeader *theHeader, unsigned long hashOffset) { unsigned long hashValue; union { void *vv; unsigned uv; } fis; fis.uv = 0; fis.vv = theHeader; hashValue = fis.uv + hashOffset; hashValue = hashValue % ALPHA_MEMORY_HASH_SIZE; return hashValue; } /*****************************************************************/ /* UnlinkAlphaMemory: */ /*****************************************************************/ static void UnlinkAlphaMemory( void *theEnv, struct patternNodeHeader *theHeader, struct alphaMemoryHash *theAlphaMemory) { /*======================*/ /* Unlink the siblings. */ /*======================*/ UnlinkAlphaMemoryBucketSiblings(theEnv,theAlphaMemory); /*================================*/ /* Update firstHash and lastHash. */ /*================================*/ if (theAlphaMemory == theHeader->firstHash) { theHeader->firstHash = theAlphaMemory->nextHash; } if (theAlphaMemory == theHeader->lastHash) { theHeader->lastHash = theAlphaMemory->prevHash; } /*===============================*/ /* Update nextHash and prevHash. */ /*===============================*/ if (theAlphaMemory->prevHash != NULL) { theAlphaMemory->prevHash->nextHash = theAlphaMemory->nextHash; } if (theAlphaMemory->nextHash != NULL) { theAlphaMemory->nextHash->prevHash = theAlphaMemory->prevHash; } rtn_struct(theEnv,alphaMemoryHash,theAlphaMemory); } /*****************************************************************/ /* UnlinkAlphaMemoryBucketSiblings: */ /*****************************************************************/ static void UnlinkAlphaMemoryBucketSiblings( void *theEnv, struct alphaMemoryHash *theAlphaMemory) { if (theAlphaMemory->prev == NULL) { DefruleData(theEnv)->AlphaMemoryTable[theAlphaMemory->bucket] = theAlphaMemory->next; } else { theAlphaMemory->prev->next = theAlphaMemory->next; } if (theAlphaMemory->next != NULL) { theAlphaMemory->next->prev = theAlphaMemory->prev; } } /********************************************/ /* ComputeRightHashValue: */ /********************************************/ unsigned long ComputeRightHashValue( void *theEnv, struct patternNodeHeader *theHeader) { struct expr *tempExpr; unsigned long hashValue = 0; unsigned long multiplier = 1; union { void *vv; unsigned long liv; } fis; if (theHeader->rightHash == NULL) { return hashValue; } for (tempExpr = theHeader->rightHash; tempExpr != NULL; tempExpr = tempExpr->nextArg, multiplier = multiplier * 509) { DATA_OBJECT theResult; struct expr *oldArgument; oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = tempExpr; (*EvaluationData(theEnv)->PrimitivesArray[tempExpr->type]->evaluateFunction)(theEnv,tempExpr->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; switch (theResult.type) { case STRING: case SYMBOL: case INSTANCE_NAME: hashValue += (((SYMBOL_HN *) theResult.value)->bucket * multiplier); break; case INTEGER: hashValue += (((INTEGER_HN *) theResult.value)->bucket * multiplier); break; case FLOAT: hashValue += (((FLOAT_HN *) theResult.value)->bucket * multiplier); break; case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif fis.liv = 0; fis.vv = theResult.value; hashValue += (unsigned long) (fis.liv * multiplier); break; case EXTERNAL_ADDRESS: fis.liv = 0; fis.vv = ValueToExternalAddress(theResult.value); hashValue += (unsigned long) (fis.liv * multiplier); break; } } return hashValue; } /***********************************************************/ /* ResizeBetaMemory: */ /***********************************************************/ globle void ResizeBetaMemory( void *theEnv, struct betaMemory *theMemory) { struct partialMatch **oldArray, **lastAdd, *thePM, *nextPM; unsigned long i, oldSize, betaLocation; oldSize = theMemory->size; oldArray = theMemory->beta; theMemory->size = oldSize * 11; theMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * theMemory->size); lastAdd = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * theMemory->size); memset(theMemory->beta,0,sizeof(struct partialMatch *) * theMemory->size); memset(lastAdd,0,sizeof(struct partialMatch *) * theMemory->size); for (i = 0; i < oldSize; i++) { thePM = oldArray[i]; while (thePM != NULL) { nextPM = thePM->nextInMemory; thePM->nextInMemory = NULL; betaLocation = thePM->hashValue % theMemory->size; thePM->prevInMemory = lastAdd[betaLocation]; if (lastAdd[betaLocation] != NULL) { lastAdd[betaLocation]->nextInMemory = thePM; } else { theMemory->beta[betaLocation] = thePM; } lastAdd[betaLocation] = thePM; thePM = nextPM; } } if (theMemory->last != NULL) { genfree(theEnv,theMemory->last,sizeof(struct partialMatch *) * oldSize); theMemory->last = lastAdd; } else { genfree(theEnv,lastAdd,sizeof(struct partialMatch *) * theMemory->size); } genfree(theEnv,oldArray,sizeof(struct partialMatch *) * oldSize); } /***********************************************************/ /* ResetBetaMemory: */ /***********************************************************/ static void ResetBetaMemory( void *theEnv, struct betaMemory *theMemory) { struct partialMatch **oldArray, **lastAdd; unsigned long oldSize; if ((theMemory->size == 1) || (theMemory->size == INITIAL_BETA_HASH_SIZE)) { return; } oldSize = theMemory->size; oldArray = theMemory->beta; theMemory->size = INITIAL_BETA_HASH_SIZE; theMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * theMemory->size); memset(theMemory->beta,0,sizeof(struct partialMatch *) * theMemory->size); genfree(theEnv,oldArray,sizeof(struct partialMatch *) * oldSize); if (theMemory->last != NULL) { lastAdd = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * theMemory->size); memset(lastAdd,0,sizeof(struct partialMatch *) * theMemory->size); genfree(theEnv,theMemory->last,sizeof(struct partialMatch *) * oldSize); theMemory->last = lastAdd; } } /********************/ /* PrintBetaMemory: */ /********************/ globle unsigned long PrintBetaMemory( void *theEnv, const char *logName, struct betaMemory *theMemory, int indentFirst, const char *indentString, int output) { struct partialMatch *listOfMatches; unsigned long b, count = 0; if (GetHaltExecution(theEnv) == TRUE) { return count; } for (b = 0; b < theMemory->size; b++) { listOfMatches = theMemory->beta[b]; while (listOfMatches != NULL) { /*=========================================*/ /* Check to see if the user is attempting */ /* to stop the display of partial matches. */ /*=========================================*/ if (GetHaltExecution(theEnv) == TRUE) { return count; } /*=========================================================*/ /* The first partial match may have already been indented. */ /* Subsequent partial matches will always be indented with */ /* the indentation string. */ /*=========================================================*/ if (output == VERBOSE) { if (indentFirst) { EnvPrintRouter(theEnv,logName,indentString); } else { indentFirst = TRUE; } } /*==========================*/ /* Print the partial match. */ /*==========================*/ if (output == VERBOSE) { PrintPartialMatch(theEnv,logName,listOfMatches); EnvPrintRouter(theEnv,logName,"\n"); } count++; /*============================*/ /* Move on to the next match. */ /*============================*/ listOfMatches = listOfMatches->nextInMemory; } } return count; } #if (CONSTRUCT_COMPILER || BLOAD_AND_BSAVE) && (! RUN_TIME) /*************************************************************/ /* TagRuleNetwork: Assigns each join in the join network and */ /* each defrule data structure with a unique integer ID. */ /* Also counts the number of defrule and joinNode data */ /* structures currently in use. */ /*************************************************************/ globle void TagRuleNetwork( void *theEnv, long int *moduleCount, long int *ruleCount, long int *joinCount, long int *linkCount) { struct defmodule *modulePtr; struct defrule *rulePtr, *disjunctPtr; struct joinLink *theLink; *moduleCount = 0; *ruleCount = 0; *joinCount = 0; *linkCount = 0; MarkRuleNetwork(theEnv,0); for (theLink = DefruleData(theEnv)->LeftPrimeJoins; theLink != NULL; theLink = theLink->next) { theLink->bsaveID = *linkCount; (*linkCount)++; } for (theLink = DefruleData(theEnv)->RightPrimeJoins; theLink != NULL; theLink = theLink->next) { theLink->bsaveID = *linkCount; (*linkCount)++; } /*===========================*/ /* Loop through each module. */ /*===========================*/ for (modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); modulePtr != NULL; modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,modulePtr)) { (*moduleCount)++; EnvSetCurrentModule(theEnv,(void *) modulePtr); /*=========================*/ /* Loop through each rule. */ /*=========================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { /*=============================*/ /* Loop through each disjunct. */ /*=============================*/ for (disjunctPtr = rulePtr; disjunctPtr != NULL; disjunctPtr = disjunctPtr->disjunct) { disjunctPtr->header.bsaveID = *ruleCount; (*ruleCount)++; TagNetworkTraverseJoins(theEnv,joinCount,linkCount,disjunctPtr->lastJoin); } rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } } /*******************************************************************/ /* TagNetworkTraverseJoins: Traverses the join network for a rule. */ /*******************************************************************/ static void TagNetworkTraverseJoins( void *theEnv, long int *joinCount, long int *linkCount, struct joinNode *joinPtr) { struct joinLink *theLink; for (; joinPtr != NULL; joinPtr = joinPtr->lastLevel) { if (joinPtr->marked == 0) { joinPtr->marked = 1; joinPtr->bsaveID = *joinCount; (*joinCount)++; for (theLink = joinPtr->nextLinks; theLink != NULL; theLink = theLink->next) { theLink->bsaveID = *linkCount; (*linkCount)++; } } if (joinPtr->joinFromTheRight) { TagNetworkTraverseJoins(theEnv,joinCount,linkCount,(struct joinNode *) joinPtr->rightSideEntryStructure); } } } #endif /* (CONSTRUCT_COMPILER || BLOAD_AND_BSAVE) && (! RUN_TIME) */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/._commline.c0000755000175000017500000000040712461762345016430 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtmch.h0000755000175000017500000000040712374023157016434 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffctpsr.h0000755000175000017500000000375612373731204016232 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFFACTS PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_dffctpsr #define _H_dffctpsr #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDeffacts(void *,const char *); #endif /* _H_dffctpsr */ clips_core_source_630/core/classcom.h0000755000175000017500000001473712464554105016230 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/04/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_classcom #define _H_classcom #define CONVENIENCE_MODE 0 #define CONSERVATION_MODE 1 #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE const char *EnvGetDefclassName(void *,void *); LOCALE const char *EnvGetDefclassPPForm(void *,void *); LOCALE struct defmoduleItemHeader *EnvGetDefclassModule(void *,void *); LOCALE const char *EnvDefclassModule(void *,void *); LOCALE SYMBOL_HN *GetDefclassNamePointer(void *); LOCALE void SetNextDefclass(void *,void *); LOCALE void EnvSetDefclassPPForm(void *,void *,char *); LOCALE void *EnvFindDefclass(void *,const char *); LOCALE void *EnvFindDefclassInModule(void *,const char *); LOCALE DEFCLASS *LookupDefclassByMdlOrScope(void *,const char *); LOCALE DEFCLASS *LookupDefclassInScope(void *,const char *); LOCALE DEFCLASS *LookupDefclassAnywhere(void *,struct defmodule *,const char *); LOCALE intBool DefclassInScope(void *,DEFCLASS *,struct defmodule *); LOCALE void *EnvGetNextDefclass(void *,void *); LOCALE intBool EnvIsDefclassDeletable(void *,void *); LOCALE void UndefclassCommand(void *); LOCALE unsigned short EnvSetClassDefaultsMode(void *,unsigned short); LOCALE unsigned short EnvGetClassDefaultsMode(void *); LOCALE void *GetClassDefaultsModeCommand(void *); LOCALE void *SetClassDefaultsModeCommand(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDefclassCommand(void *); LOCALE void ListDefclassesCommand(void *); LOCALE void EnvListDefclasses(void *,const char *,struct defmodule *); LOCALE unsigned EnvGetDefclassWatchInstances(void *,void *); LOCALE void EnvSetDefclassWatchInstances(void *,unsigned,void *); LOCALE unsigned EnvGetDefclassWatchSlots(void *,void *); LOCALE void EnvSetDefclassWatchSlots(void *,unsigned,void *); LOCALE unsigned DefclassWatchAccess(void *,int,unsigned,EXPRESSION *); LOCALE unsigned DefclassWatchPrint(void *,const char *,int,EXPRESSION *); #endif LOCALE void GetDefclassListFunction(void *,DATA_OBJECT *); LOCALE void EnvGetDefclassList(void *,DATA_OBJECT *,struct defmodule *); LOCALE intBool EnvUndefclass(void *,void *); LOCALE intBool HasSuperclass(DEFCLASS *,DEFCLASS *); LOCALE SYMBOL_HN *CheckClassAndSlot(void *,const char *,DEFCLASS **); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE void SaveDefclasses(void *,void *,const char *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *DefclassModule(void *); LOCALE void *FindDefclass(const char *); LOCALE void GetDefclassList(DATA_OBJECT *,struct defmodule *); LOCALE unsigned short GetClassDefaultsMode(void); LOCALE struct defmoduleItemHeader *GetDefclassModule(void *); LOCALE const char *GetDefclassName(void *); LOCALE const char *GetDefclassPPForm(void *); LOCALE unsigned GetDefclassWatchInstances(void *); LOCALE unsigned GetDefclassWatchSlots(void *); LOCALE void *GetNextDefclass(void *); LOCALE intBool IsDefclassDeletable(void *); LOCALE void ListDefclasses(const char *,struct defmodule *); LOCALE unsigned short SetClassDefaultsMode(unsigned short); LOCALE void SetDefclassWatchInstances(unsigned,void *); LOCALE void SetDefclassWatchSlots(unsigned,void *); LOCALE intBool Undefclass(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_classcom */ clips_core_source_630/core/._extnfunc.h0000755000175000017500000000040712373737770016472 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrnpsr.c0000755000175000017500000000040712461303660016472 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factcmp.c0000755000175000017500000003315012373741772016031 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT PATTERN NETWORK CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* fact pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _FACTCMP_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (! RUN_TIME) && DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER #define FactPrefix() ArbitraryPrefix(FactData(theEnv)->FactCodeItem,0) #include #define _STDIO_INCLUDED_ #include "factbld.h" #include "conscomp.h" #include "factcmp.h" #include "tmpltdef.h" #include "envrnmnt.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int PatternNetworkToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void BeforePatternNetworkToCode(void *); static struct factPatternNode *GetNextPatternNode(struct factPatternNode *); static void CloseNetworkFiles(void *,FILE *,int); static void PatternNodeToCode(void *,FILE *,struct factPatternNode *,int,int); /**************************************************************/ /* FactPatternsCompilerSetup: Initializes the constructs-to-c */ /* command for use with the fact pattern network. */ /**************************************************************/ globle void FactPatternsCompilerSetup( void *theEnv) { FactData(theEnv)->FactCodeItem = AddCodeGeneratorItem(theEnv,"facts",0,BeforePatternNetworkToCode, NULL,PatternNetworkToCode,1); } /****************************************************************/ /* BeforePatternNetworkToCode: Assigns each pattern node with a */ /* unique ID which will be used for pointer references when */ /* the data structures are written to a file as C code */ /****************************************************************/ static void BeforePatternNetworkToCode( void *theEnv) { int whichPattern = 0; int whichDeftemplate = 0; struct defmodule *theModule; struct deftemplate *theDeftemplate; struct factPatternNode *thePattern; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================*/ /* Set the current module. */ /*=========================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*======================================================*/ /* Loop through each deftemplate in the current module. */ /*======================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*=================================================*/ /* Assign each pattern node in the pattern network */ /* for the deftemplate a unique integer ID. */ /*=================================================*/ theDeftemplate->header.bsaveID = whichDeftemplate++; for (thePattern = theDeftemplate->patternNetwork; thePattern != NULL; thePattern = GetNextPatternNode(thePattern)) { thePattern->bsaveID = whichPattern++; } } } } /********************************************************************/ /* GetNextPatternNode: Returns the next node in a pattern network */ /* tree. The next node is computed using a depth first traversal. */ /********************************************************************/ static struct factPatternNode *GetNextPatternNode( struct factPatternNode *thePattern) { /*=========================================*/ /* If it's possible to go deeper into the */ /* tree, then move down to the next level. */ /*=========================================*/ if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); /*========================================*/ /* Keep backing up toward the root of the */ /* tree until a side branch can be taken. */ /*========================================*/ while (thePattern->rightNode == NULL) { /*========================================*/ /* Back up to check the next side branch. */ /*========================================*/ thePattern = thePattern->lastLevel; /*======================================*/ /* If we branched up from the root, the */ /* entire tree has been traversed. */ /*======================================*/ if (thePattern == NULL) return(NULL); } /*==================================*/ /* Move on to the next side branch. */ /*==================================*/ return(thePattern->rightNode); } /********************************************************************/ /* PatternNetworkToCode: Produces the fact pattern network code for */ /* a run-time module created using the constructs-to-c function. */ /********************************************************************/ static int PatternNetworkToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct deftemplate *theTemplate; struct factPatternNode *thePatternNode; int networkArrayCount = 0, networkArrayVersion = 1; FILE *networkFile = NULL; /*===========================================================*/ /* Include the appropriate fact pattern network header file. */ /*===========================================================*/ fprintf(headerFP,"#include \"factbld.h\"\n"); /*===============================*/ /* Loop through all the modules. */ /*===============================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================*/ /* Set the current module. */ /*=========================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*======================================*/ /* Loop through all of the deftemplates */ /* in the current module. */ /*======================================*/ for (theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theTemplate != NULL; theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theTemplate)) { /*======================================================*/ /* Loop through each pattern node in the deftemplate's */ /* pattern network writing its C code representation to */ /* the file as it is traversed. */ /*======================================================*/ for (thePatternNode = theTemplate->patternNetwork; thePatternNode != NULL; thePatternNode = GetNextPatternNode(thePatternNode)) { networkFile = OpenFileIfNeeded(theEnv,networkFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, networkArrayVersion,headerFP, "struct factPatternNode",FactPrefix(),FALSE,NULL); if (networkFile == NULL) { CloseNetworkFiles(theEnv,networkFile,maxIndices); return(0); } PatternNodeToCode(theEnv,networkFile,thePatternNode,imageID,maxIndices); networkArrayCount++; networkFile = CloseFileIfNeeded(theEnv,networkFile,&networkArrayCount, &networkArrayVersion,maxIndices,NULL,NULL); } } } /*==============================*/ /* Close any C files left open. */ /*==============================*/ CloseNetworkFiles(theEnv,networkFile,maxIndices); /*===============================*/ /* Return TRUE to indicate the C */ /* code was successfully saved. */ /*===============================*/ return(TRUE); } /****************************************************************/ /* CloseNetworkFiles: Closes all of the C files created for the */ /* fact pattern network. Called when an error occurs or when */ /* the fact pattern network data structures have all been */ /* written to the files. */ /****************************************************************/ static void CloseNetworkFiles( void *theEnv, FILE *networkFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (networkFile != NULL) { CloseFileIfNeeded(theEnv,networkFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /************************************************************/ /* PatternNodeToCode: Writes the C code representation of a */ /* single fact pattern node slot to the specified file. */ /************************************************************/ static void PatternNodeToCode( void *theEnv, FILE *theFile, struct factPatternNode *thePatternNode, int imageID, int maxIndices) { fprintf(theFile,"{"); /*=====================*/ /* Pattern Node Header */ /*=====================*/ PatternNodeHeaderToCode(theEnv,theFile,&thePatternNode->header,imageID,maxIndices); /*========================*/ /* Field and Slot Indices */ /*========================*/ fprintf(theFile,",0,%d,%d,%d,",thePatternNode->whichField, thePatternNode->whichSlot, thePatternNode->leaveFields); /*===============*/ /* Network Tests */ /*===============*/ PrintHashedExpressionReference(theEnv,theFile,thePatternNode->networkTest,imageID,maxIndices); /*============*/ /* Next Level */ /*============*/ if (thePatternNode->nextLevel == NULL) { fprintf(theFile,",NULL,"); } else { fprintf(theFile,",&%s%d_%ld[%ld],",FactPrefix(), imageID,(thePatternNode->nextLevel->bsaveID / maxIndices) + 1, thePatternNode->nextLevel->bsaveID % maxIndices); } /*============*/ /* Last Level */ /*============*/ if (thePatternNode->lastLevel == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",FactPrefix(), imageID,(thePatternNode->lastLevel->bsaveID / maxIndices) + 1, thePatternNode->lastLevel->bsaveID % maxIndices); } /*===========*/ /* Left Node */ /*===========*/ if (thePatternNode->leftNode == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",FactPrefix(), imageID,(thePatternNode->leftNode->bsaveID / maxIndices) + 1, thePatternNode->leftNode->bsaveID % maxIndices); } /*============*/ /* Right Node */ /*============*/ if (thePatternNode->rightNode == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"&%s%d_%ld[%ld]}",FactPrefix(), imageID,(thePatternNode->rightNode->bsaveID / maxIndices) + 1, thePatternNode->rightNode->bsaveID % maxIndices); } } /**********************************************************/ /* FactPatternNodeReference: Prints C code representation */ /* of a fact pattern node data structure reference. */ /**********************************************************/ globle void FactPatternNodeReference( void *theEnv, void *theVPattern, FILE *theFile, int imageID, int maxIndices) { struct factPatternNode *thePattern = (struct factPatternNode *) theVPattern; if (thePattern == NULL) fprintf(theFile,"NULL"); else { fprintf(theFile,"&%s%d_%ld[%ld]",FactPrefix(), imageID,(thePattern->bsaveID / maxIndices) + 1, thePattern->bsaveID % maxIndices); } } #endif /* DEFRULE_CONSTRUCT && (! RUN_TIME) && DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER */ clips_core_source_630/core/network.h0000755000175000017500000000705612374017636016114 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* NETWORK HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /*************************************************************/ #ifndef _H_network #define _H_network struct patternNodeHeader; struct joinNode; struct alphaMemoryHash; #ifndef _H_match #include "match.h" #endif #ifndef _H_expressn #include "expressn.h" #endif struct patternNodeHeader { struct alphaMemoryHash *firstHash; struct alphaMemoryHash *lastHash; struct joinNode *entryJoin; struct expr *rightHash; unsigned int singlefieldNode : 1; unsigned int multifieldNode : 1; unsigned int stopNode : 1; unsigned int initialize : 1; unsigned int marked : 1; unsigned int beginSlot : 1; unsigned int endSlot : 1; unsigned int selector : 1; }; struct patternNodeHashEntry { void *parent; void *child; int type; void *value; struct patternNodeHashEntry *next; }; #define SIZE_PATTERN_HASH 16231 struct alphaMemoryHash { unsigned long bucket; struct patternNodeHeader *owner; struct partialMatch *alphaMemory; struct partialMatch *endOfQueue; struct alphaMemoryHash *nextHash; struct alphaMemoryHash *prevHash; struct alphaMemoryHash *next; struct alphaMemoryHash *prev; }; typedef struct alphaMemoryHash ALPHA_MEMORY_HASH; #ifndef _H_ruledef #include "ruledef.h" #endif #define INITIAL_BETA_HASH_SIZE 17 struct betaMemory { unsigned long size; unsigned long count; struct partialMatch **beta; struct partialMatch **last; }; struct joinLink { char enterDirection; struct joinNode *join; struct joinLink *next; long bsaveID; }; struct joinNode { unsigned int firstJoin : 1; unsigned int logicalJoin : 1; unsigned int joinFromTheRight : 1; unsigned int patternIsNegated : 1; unsigned int patternIsExists : 1; unsigned int initialize : 1; unsigned int marked : 1; unsigned int rhsType : 3; unsigned int depth : 16; long bsaveID; long long memoryLeftAdds; long long memoryRightAdds; long long memoryLeftDeletes; long long memoryRightDeletes; long long memoryCompares; struct betaMemory *leftMemory; struct betaMemory *rightMemory; struct expr *networkTest; struct expr *secondaryNetworkTest; struct expr *leftHash; struct expr *rightHash; void *rightSideEntryStructure; struct joinLink *nextLinks; struct joinNode *lastLevel; struct joinNode *rightMatchNode; struct defrule *ruleToActivate; }; #endif /* _H_network */ clips_core_source_630/core/genrccmp.c0000755000175000017500000006022312373753412016205 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added pragmas to remove unused parameter */ /* warnings. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #if DEFRULE_CONSTRUCT #include "network.h" #endif #include "genrccom.h" #include "conscomp.h" #include "envrnmnt.h" #if OBJECT_SYSTEM #include "objcmp.h" #endif #define _GENRCCMP_SOURCE_ #include "genrccmp.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MODULEI 0 #define GENERICI 1 #define METHODI 2 #define RESTRICTIONI 3 #define TYPEI 4 #define SAVE_ITEMS 5 /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define MethodPrefix() ArbitraryPrefix(DefgenericData(theEnv)->DefgenericCodeItem,2) #define RestrictionPrefix() ArbitraryPrefix(DefgenericData(theEnv)->DefgenericCodeItem,3) #define TypePrefix() ArbitraryPrefix(DefgenericData(theEnv)->DefgenericCodeItem,4) /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyDefgenericsForCode(void *); static int DefgenericsToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void CloseDefgenericFiles(void *,FILE *[SAVE_ITEMS],int [SAVE_ITEMS], struct CodeGeneratorFile [SAVE_ITEMS],int); static void DefgenericModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDefgenericToCode(void *,FILE *,int,int,DEFGENERIC *,int,int,int); static void MethodToCode(void *,FILE *,int,DEFMETHOD *,int,int); static void RestrictionToCode(void *,FILE *,int,RESTRICTION *,int,int); static void TypeToCode(void *,FILE *,int,void *,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupGenericsCompiler DESCRIPTION : Initializes the construct compiler item for generic functions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupGenericsCompiler( void *theEnv) { DefgenericData(theEnv)->DefgenericCodeItem = AddCodeGeneratorItem(theEnv,"generics",0,ReadyDefgenericsForCode, NULL,DefgenericsToCode,5); } /*************************************************** NAME : PrintGenericFunctionReference DESCRIPTION : Prints a reference to the run-time generic array for the construct compiler INPUTS : 1) The file output destination 2) A pointer to the generic 3) The id of the run-time image 4) The maximum number of indices in any array RETURNS : Nothing useful SIDE EFFECTS : Reference printed NOTES : None ***************************************************/ globle void PrintGenericFunctionReference( void *theEnv, FILE *fp, DEFGENERIC *gfunc, int imageID, int maxIndices) { if (gfunc == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem),imageID, (int) ((gfunc->header.bsaveID / maxIndices) + 1), (int) (gfunc->header.bsaveID % maxIndices)); } /**************************************************** NAME : DefgenericCModuleReference DESCRIPTION : Prints out a reference to a defgeneric module INPUTS : 1) The output file 2) The id of the module item 3) The id of the image 4) The maximum number of elements allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Defgeneric module reference printed NOTES : None ****************************************************/ globle void DefgenericCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReadyDefgenericsForCode DESCRIPTION : Sets index of generic-functions for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None ***************************************************/ static void ReadyDefgenericsForCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DefgenericData(theEnv)->DefgenericModuleIndex); } /******************************************************* NAME : DefgenericsToCode DESCRIPTION : Writes out static array code for generic functions, methods, etc. INPUTS : 1) The base name of the construct set 2) The base id for this construct 3) The file pointer for the header file 4) The base id for the construct set 5) The max number of indices allowed in an array RETURNS : -1 if no generic functions, 0 on errors, 1 if generic functions written SIDE EFFECTS : Code written to files NOTES : None *******************************************************/ static int DefgenericsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFGENERIC *theDefgeneric; DEFMETHOD *theMethod; RESTRICTION *theRestriction; short i,j,k; int moduleCount = 0; int itemArrayCounts[SAVE_ITEMS]; int itemArrayVersions[SAVE_ITEMS]; FILE *itemFiles[SAVE_ITEMS]; int itemReopenFlags[SAVE_ITEMS]; struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS]; for (i = 0 ; i < SAVE_ITEMS ; i++) { itemArrayCounts[i] = 0; itemArrayVersions[i] = 1; itemFiles[i] = NULL; itemReopenFlags[i] = FALSE; itemCodeFiles[i].filePrefix = NULL; itemCodeFiles[i].pathName = pathName; itemCodeFiles[i].fileNameBuffer = fileNameBuffer; } /* =========================================== Include the appropriate generic header file =========================================== */ fprintf(headerFP,"#include \"genrcfun.h\"\n"); /* ============================================================= Loop through all the modules and all the defgenerics writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); itemFiles[MODULEI] = OpenFileIfNeeded(theEnv,itemFiles[MODULEI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, itemArrayVersions[MODULEI],headerFP, "DEFGENERIC_MODULE",ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem), itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); if (itemFiles[MODULEI] == NULL) goto GenericCodeError; DefgenericModuleToCode(theEnv,itemFiles[MODULEI],theModule,imageID,maxIndices); itemFiles[MODULEI] = CloseFileIfNeeded(theEnv,itemFiles[MODULEI],&itemArrayCounts[MODULEI], &itemArrayVersions[MODULEI],maxIndices, &itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); while (theDefgeneric != NULL) { itemFiles[GENERICI] = OpenFileIfNeeded(theEnv,itemFiles[GENERICI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, itemArrayVersions[GENERICI],headerFP, "DEFGENERIC",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem), itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]); if (itemFiles[GENERICI] == NULL) goto GenericCodeError; SingleDefgenericToCode(theEnv,itemFiles[GENERICI],imageID,maxIndices,theDefgeneric, moduleCount,itemArrayVersions[METHODI], itemArrayCounts[METHODI]); itemArrayCounts[GENERICI]++; itemFiles[GENERICI] = CloseFileIfNeeded(theEnv,itemFiles[GENERICI],&itemArrayCounts[GENERICI], &itemArrayVersions[GENERICI],maxIndices, &itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]); if (theDefgeneric->mcnt > 0) { /* =========================================== Make sure that all methods for a particular generic function go into the same array =========================================== */ itemFiles[METHODI] = OpenFileIfNeeded(theEnv,itemFiles[METHODI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, itemArrayVersions[METHODI],headerFP, "DEFMETHOD",MethodPrefix(), itemReopenFlags[METHODI],&itemCodeFiles[METHODI]); if (itemFiles[METHODI] == NULL) goto GenericCodeError; for (i = 0 ; i < theDefgeneric->mcnt ; i++) { theMethod = &theDefgeneric->methods[i]; if (i > 0) fprintf(itemFiles[METHODI],",\n"); MethodToCode(theEnv,itemFiles[METHODI],imageID,theMethod, itemArrayVersions[RESTRICTIONI],itemArrayCounts[RESTRICTIONI]); if (theMethod->restrictionCount > 0) { /* ======================================== Make sure that all restrictions for a particular method go into the same array ======================================== */ itemFiles[RESTRICTIONI] = OpenFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],fileName,pathName,fileNameBuffer,fileID, imageID,&fileCount, itemArrayVersions[RESTRICTIONI],headerFP, "RESTRICTION",RestrictionPrefix(), itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]); if (itemFiles[RESTRICTIONI] == NULL) goto GenericCodeError; for (j = 0 ; j < theMethod->restrictionCount ; j++) { theRestriction = &theMethod->restrictions[j]; if (j > 0) fprintf(itemFiles[RESTRICTIONI],",\n"); RestrictionToCode(theEnv,itemFiles[RESTRICTIONI],imageID,theRestriction, itemArrayVersions[TYPEI],itemArrayCounts[TYPEI]); if (theRestriction->tcnt > 0) { /* ========================================= Make sure that all types for a particular restriction go into the same array ========================================= */ itemFiles[TYPEI] = OpenFileIfNeeded(theEnv,itemFiles[TYPEI],fileName,pathName,fileNameBuffer,fileID, imageID,&fileCount, itemArrayVersions[TYPEI],headerFP, "void *",TypePrefix(), itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]); if (itemFiles[TYPEI] == NULL) goto GenericCodeError; for (k = 0 ; k < theRestriction->tcnt ; k++) { if (k > 0) fprintf(itemFiles[TYPEI],",\n"); TypeToCode(theEnv,itemFiles[TYPEI],imageID, theRestriction->types[k],maxIndices); } itemArrayCounts[TYPEI] += (int) theRestriction->tcnt; itemFiles[TYPEI] = CloseFileIfNeeded(theEnv,itemFiles[TYPEI],&itemArrayCounts[TYPEI], &itemArrayVersions[TYPEI],maxIndices, &itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]); } } itemArrayCounts[RESTRICTIONI] += theMethod->restrictionCount; itemFiles[RESTRICTIONI] = CloseFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],&itemArrayCounts[RESTRICTIONI], &itemArrayVersions[RESTRICTIONI],maxIndices, &itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]); } } itemArrayCounts[METHODI] += (int) theDefgeneric->mcnt; itemFiles[METHODI] = CloseFileIfNeeded(theEnv,itemFiles[METHODI],&itemArrayCounts[METHODI], &itemArrayVersions[METHODI],maxIndices, &itemReopenFlags[METHODI],&itemCodeFiles[METHODI]); } theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; itemArrayCounts[MODULEI]++; } CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(1); GenericCodeError: CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(0); } /****************************************************** NAME : CloseDefgenericFiles DESCRIPTION : Closes construct compiler files for defgeneric structures INPUTS : 1) An array containing all the pertinent file pointers 2) An array containing all the pertinent file reopen flags 3) An array containing all the pertinent file name/id/version info 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None *****************************************************/ static void CloseDefgenericFiles( void *theEnv, FILE *itemFiles[SAVE_ITEMS], int itemReopenFlags[SAVE_ITEMS], struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS], int maxIndices) { int count = maxIndices; int arrayVersion = 0; register int i; for (i = 0 ; i < SAVE_ITEMS ; i++) { count = maxIndices; itemFiles[i] = CloseFileIfNeeded(theEnv,itemFiles[i],&count,&arrayVersion, maxIndices,&itemReopenFlags[i], &itemCodeFiles[i]); } } /*************************************************** NAME : DefgenericModuleToCode DESCRIPTION : Writes out the C values for a defgeneric module item INPUTS : 1) The output file 2) The module for the defgenerics 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Defgeneric module item written NOTES : None ***************************************************/ static void DefgenericModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefgenericData(theEnv)->DefgenericModuleIndex,ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem)); fprintf(theFile,"}"); } /**************************************************************** NAME : SingleDefgenericToCode DESCRIPTION : Writes out a single defgeneric's data to the file INPUTS : 1) The output file 2) The compile image id 3) The maximum number of elements in an array 4) The defgeneric 5) The module index 6) The partition holding the generic methods 7) The relative index of the generics methods in the partition RETURNS : Nothing useful SIDE EFFECTS : Defgeneric data written NOTES : None ***************************************************************/ static void SingleDefgenericToCode( void *theEnv, FILE *theFile, int imageID, int maxIndices, DEFGENERIC *theDefgeneric, int moduleCount, int methodArrayVersion, int methodArrayCount) { /* ================== Defgeneric Header ================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefgeneric->header,imageID,maxIndices,moduleCount, ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem), ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem)); /* ========================= Defgeneric specific data ========================= */ fprintf(theFile,",0,0,"); if (theDefgeneric->methods == NULL) fprintf(theFile,"NULL"); else { fprintf(theFile,"&%s%d_%d[%d]",MethodPrefix(),imageID, methodArrayVersion,methodArrayCount); } fprintf(theFile,",%hd,0}",theDefgeneric->mcnt); } /**************************************************************** NAME : MethodToCode DESCRIPTION : Writes out a single method's data to the file INPUTS : 1) The output file 2) The compile image id 3) The method 4) The partition holding the method restrictions 5) The relative index of the method restrictions in the partition RETURNS : Nothing useful SIDE EFFECTS : Method data written NOTES : None ***************************************************************/ static void MethodToCode( void *theEnv, FILE *theFile, int imageID, DEFMETHOD *theMethod, int restrictionArrayVersion, int restrictionArrayCount) { fprintf(theFile,"{%hd,0,%hd,%hd,%hd,%hd,%u,0,", theMethod->index,theMethod->restrictionCount, theMethod->minRestrictions,theMethod->maxRestrictions, theMethod->localVarCount,theMethod->system); if (theMethod->restrictions == NULL) fprintf(theFile,"NULL,"); else fprintf(theFile,"&%s%d_%d[%d],",RestrictionPrefix(),imageID, restrictionArrayVersion,restrictionArrayCount); ExpressionToCode(theEnv,theFile,theMethod->actions); fprintf(theFile,",NULL}"); } /**************************************************************** NAME : RestrictionToCode DESCRIPTION : Writes out a single restriction's data to the file INPUTS : 1) The output file 2) The compile image id 3) The restriction 4) The partition holding the restriction types 5) The relative index of the restriction types in the partition RETURNS : Nothing useful SIDE EFFECTS : Restriction data written NOTES : None ***************************************************************/ static void RestrictionToCode( void *theEnv, FILE *theFile, int imageID, RESTRICTION *theRestriction, int typeArrayVersion, int typeArrayCount) { fprintf(theFile,"{"); if (theRestriction->types == NULL) fprintf(theFile,"NULL,"); else fprintf(theFile,"&%s%d_%d[%d],",TypePrefix(),imageID, typeArrayVersion,typeArrayCount); ExpressionToCode(theEnv,theFile,theRestriction->query); fprintf(theFile,",%hd}",theRestriction->tcnt); } /**************************************************************** NAME : TypeToCode DESCRIPTION : Writes out a single type's data to the file INPUTS : 1) The output file 2) The compile image id 3) The type RETURNS : Nothing useful SIDE EFFECTS : Type data written NOTES : None ***************************************************************/ static void TypeToCode( void *theEnv, FILE *theFile, int imageID, void *theType, int maxIndices) { #if OBJECT_SYSTEM fprintf(theFile,"VS "); PrintClassReference(theEnv,theFile,(DEFCLASS *) theType,imageID,maxIndices); #else #if MAC_XCD #pragma unused(imageID) #pragma unused(maxIndices) #endif PrintIntegerReference(theEnv,theFile,(INTEGER_HN *) theType); #endif } #endif clips_core_source_630/core/._cstrnops.h0000755000175000017500000000040712373714214016477 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrccom.c0000755000175000017500000000040712464742046016421 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._globlbin.c0000755000175000017500000000040712373753376016423 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._symbol.h0000755000175000017500000000040712464470634016137 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltutl.h0000755000175000017500000000040712373754171016517 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffnxbin.c0000755000175000017500000000040712373721221016411 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._classpsr.h0000755000175000017500000000040712373714253016461 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/genrcfun.c0000755000175000017500000006720312424473412016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Functions Internal Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when DEBUGGING_FUNCTIONS */ /* is set to 0 and PROFILING_FUNCTIONS is set to */ /* 1. */ /* */ /* Fixed typing issue when OBJECT_SYSTEM */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #endif #include "argacces.h" #include "constrct.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "genrccom.h" #include "genrcexe.h" #include "memalloc.h" #include "prccode.h" #include "router.h" #include "sysdep.h" #define _GENRCFUN_SOURCE_ #include "genrcfun.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS static void DisplayGenericCore(void *,DEFGENERIC *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! RUN_TIME /*************************************************** NAME : ClearDefgenericsReady DESCRIPTION : Determines if it is safe to remove all defgenerics Assumes *all* constructs will be deleted - only checks to see if any methods are currently executing INPUTS : None RETURNS : TRUE if no methods are executing, FALSE otherwise SIDE EFFECTS : None NOTES : Used by (clear) and (bload) ***************************************************/ globle intBool ClearDefgenericsReady( void *theEnv) { return((DefgenericData(theEnv)->CurrentGeneric != NULL) ? FALSE : TRUE); } /***************************************************** NAME : AllocateDefgenericModule DESCRIPTION : Creates and initializes a list of defgenerics for a new module INPUTS : None RETURNS : The new deffunction module SIDE EFFECTS : Deffunction module created NOTES : None *****************************************************/ globle void *AllocateDefgenericModule( void *theEnv) { return((void *) get_struct(theEnv,defgenericModule)); } /*************************************************** NAME : FreeDefgenericModule DESCRIPTION : Removes a deffunction module and all associated deffunctions INPUTS : The deffunction module RETURNS : Nothing useful SIDE EFFECTS : Module and deffunctions deleted NOTES : None ***************************************************/ globle void FreeDefgenericModule( void *theEnv, void *theItem) { #if (! BLOAD_ONLY) FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefgenericData(theEnv)->DefgenericConstruct); #endif rtn_struct(theEnv,defgenericModule,theItem); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /************************************************************ NAME : ClearDefmethods DESCRIPTION : Deletes all defmethods - generic headers are left intact INPUTS : None RETURNS : TRUE if all methods deleted, FALSE otherwise SIDE EFFECTS : Defmethods deleted NOTES : Clearing generic functions is done in two stages 1) Delete all methods (to clear any references to other constructs) 2) Delete all generic headers This allows other constructs which mutually refer to generic functions to be cleared ************************************************************/ globle int ClearDefmethods( void *theEnv) { register DEFGENERIC *gfunc; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); while (gfunc != NULL) { if (RemoveAllExplicitMethods(theEnv,gfunc) == FALSE) success = FALSE; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc); } return(success); } /***************************************************************** NAME : RemoveAllExplicitMethods DESCRIPTION : Deletes all explicit defmethods - generic headers are left intact (as well as a method for an overloaded system function) INPUTS : None RETURNS : TRUE if all methods deleted, FALSE otherwise SIDE EFFECTS : Explicit defmethods deleted NOTES : None *****************************************************************/ globle int RemoveAllExplicitMethods( void *theEnv, DEFGENERIC *gfunc) { long i,j; unsigned systemMethodCount = 0; DEFMETHOD *narr; if (MethodsExecuting(gfunc) == FALSE) { for (i = 0 ; i < gfunc->mcnt ; i++) { if (gfunc->methods[i].system) systemMethodCount++; else DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[i]); } if (systemMethodCount != 0) { narr = (DEFMETHOD *) gm2(theEnv,(systemMethodCount * sizeof(DEFMETHOD))); i = 0; j = 0; while (i < gfunc->mcnt) { if (gfunc->methods[i].system) GenCopyMemory(DEFMETHOD,1,&narr[j++],&gfunc->methods[i]); i++; } rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); gfunc->mcnt = (short) systemMethodCount; gfunc->methods = narr; } else { if (gfunc->mcnt != 0) rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); gfunc->mcnt = 0; gfunc->methods = NULL; } return(TRUE); } return(FALSE); } /************************************************** NAME : RemoveDefgeneric DESCRIPTION : Removes a generic function node from the generic list along with all its methods INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : List adjusted Nodes deallocated NOTES : Assumes generic is not in use!!! **************************************************/ globle void RemoveDefgeneric( void *theEnv, void *vgfunc) { DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc; long i; for (i = 0 ; i < gfunc->mcnt ; i++) DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[i]); if (gfunc->mcnt != 0) rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); DecrementSymbolCount(theEnv,GetDefgenericNamePointer((void *) gfunc)); EnvSetDefgenericPPForm(theEnv,(void *) gfunc,NULL); ClearUserDataList(theEnv,gfunc->header.usrData); rtn_struct(theEnv,defgeneric,gfunc); } /**************************************************************** NAME : ClearDefgenerics DESCRIPTION : Deletes all generic headers INPUTS : None RETURNS : TRUE if all methods deleted, FALSE otherwise SIDE EFFECTS : Generic headers deleted (and any implicit system function methods) NOTES : None ****************************************************************/ globle int ClearDefgenerics( void *theEnv) { register DEFGENERIC *gfunc,*gtmp; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); while (gfunc != NULL) { gtmp = gfunc; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc); if (RemoveAllExplicitMethods(theEnv,gtmp) == FALSE) { CantDeleteItemErrorMessage(theEnv,"generic function",EnvGetDefgenericName(theEnv,gtmp)); success = FALSE; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) gtmp); RemoveDefgeneric(theEnv,(void *) gtmp); } } return(success); } /******************************************************** NAME : MethodAlterError DESCRIPTION : Prints out an error message reflecting that a generic function's methods cannot be altered while any of them are executing INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ********************************************************/ globle void MethodAlterError( void *theEnv, DEFGENERIC *gfunc) { PrintErrorID(theEnv,"GENRCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgeneric "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," cannot be modified while one of its methods is executing.\n"); } /*************************************************** NAME : DeleteMethodInfo DESCRIPTION : Deallocates all the data associated w/ a method but does not release the method structure itself INPUTS : 1) The generic function address 2) The method address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated NOTES : None ***************************************************/ globle void DeleteMethodInfo( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { short j,k; RESTRICTION *rptr; SaveBusyCount(gfunc); ExpressionDeinstall(theEnv,meth->actions); ReturnPackedExpression(theEnv,meth->actions); ClearUserDataList(theEnv,meth->usrData); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); for (j = 0 ; j < meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; for (k = 0 ; k < rptr->tcnt ; k++) #if OBJECT_SYSTEM DecrementDefclassBusyCount(theEnv,rptr->types[k]); #else DecrementIntegerCount(theEnv,(INTEGER_HN *) rptr->types[k]); #endif if (rptr->types != NULL) rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt)); ExpressionDeinstall(theEnv,rptr->query); ReturnPackedExpression(theEnv,rptr->query); } if (meth->restrictions != NULL) rm(theEnv,(void *) meth->restrictions, (sizeof(RESTRICTION) * meth->restrictionCount)); RestoreBusyCount(gfunc); } /*************************************************** NAME : DestroyMethodInfo DESCRIPTION : Deallocates all the data associated w/ a method but does not release the method structure itself INPUTS : 1) The generic function address 2) The method address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated NOTES : None ***************************************************/ globle void DestroyMethodInfo( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { register int j; register RESTRICTION *rptr; #if MAC_XCD #pragma unused(gfunc) #endif ReturnPackedExpression(theEnv,meth->actions); ClearUserDataList(theEnv,meth->usrData); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); for (j = 0 ; j < meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; if (rptr->types != NULL) rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt)); ReturnPackedExpression(theEnv,rptr->query); } if (meth->restrictions != NULL) rm(theEnv,(void *) meth->restrictions, (sizeof(RESTRICTION) * meth->restrictionCount)); } /*************************************************** NAME : MethodsExecuting DESCRIPTION : Determines if any of the methods of a generic function are currently executing INPUTS : The generic function address RETURNS : TRUE if any methods are executing, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int MethodsExecuting( DEFGENERIC *gfunc) { long i; for (i = 0 ; i < gfunc->mcnt ; i++) if (gfunc->methods[i].busy > 0) return(TRUE); return(FALSE); } #endif #if ! OBJECT_SYSTEM /************************************************************** NAME : SubsumeType DESCRIPTION : Determines if the second type subsumes the first type (e.g. INTEGER is subsumed by NUMBER_TYPE_CODE) INPUTS : Two type codes RETURNS : TRUE if type 2 subsumes type 1, FALSE otherwise SIDE EFFECTS : None NOTES : Used only when COOL is not present **************************************************************/ globle intBool SubsumeType( int t1, int t2) { if ((t2 == OBJECT_TYPE_CODE) || (t2 == PRIMITIVE_TYPE_CODE)) return(TRUE); if ((t2 == NUMBER_TYPE_CODE) && ((t1 == INTEGER) || (t1 == FLOAT))) return(TRUE); if ((t2 == LEXEME_TYPE_CODE) && ((t1 == STRING) || (t1 == SYMBOL))) return(TRUE); if ((t2 == ADDRESS_TYPE_CODE) && ((t1 == EXTERNAL_ADDRESS) || (t1 == FACT_ADDRESS) || (t1 == INSTANCE_ADDRESS))) return(TRUE); if ((t2 == LEXEME_TYPE_CODE) && ((t1 == INSTANCE_NAME) || (t1 == INSTANCE_ADDRESS))) return(TRUE); return(FALSE); } #endif /***************************************************** NAME : FindMethodByIndex DESCRIPTION : Finds a generic function method of specified index INPUTS : 1) The generic function 2) The index RETURNS : The position of the method in the generic function's method array, -1 if not found SIDE EFFECTS : None NOTES : None *****************************************************/ globle long FindMethodByIndex( DEFGENERIC *gfunc, long theIndex) { long i; for (i = 0 ; i < gfunc->mcnt ; i++) if (gfunc->methods[i].index == theIndex) return(i); return(-1); } #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS /****************************************************************** NAME : PrintMethod DESCRIPTION : Lists a brief description of methods for a method INPUTS : 1) Buffer for method info 2) Size of buffer (not including space for '\0') 3) The method address RETURNS : Nothing useful SIDE EFFECTS : None NOTES : A terminating newline is NOT included ******************************************************************/ globle void PrintMethod( void *theEnv, char *buf, size_t buflen, DEFMETHOD *meth) { #if MAC_XCD #pragma unused(theEnv) #endif long j,k; register RESTRICTION *rptr; char numbuf[15]; buf[0] = '\0'; if (meth->system) genstrncpy(buf,"SYS",(STD_SIZE) buflen); gensprintf(numbuf,"%-2d ",meth->index); genstrncat(buf,numbuf,(STD_SIZE) buflen-3); for (j = 0 ; j < meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; if ((((int) j) == meth->restrictionCount-1) && (meth->maxRestrictions == -1)) { if ((rptr->tcnt == 0) && (rptr->query == NULL)) { genstrncat(buf,"$?",buflen-strlen(buf)); break; } genstrncat(buf,"($? ",buflen-strlen(buf)); } else genstrncat(buf,"(",buflen-strlen(buf)); for (k = 0 ; k < rptr->tcnt ; k++) { #if OBJECT_SYSTEM genstrncat(buf,EnvGetDefclassName(theEnv,rptr->types[k]),buflen-strlen(buf)); #else genstrncat(buf,TypeName(theEnv,ValueToInteger(rptr->types[k])),buflen-strlen(buf)); #endif if (((int) k) < (((int) rptr->tcnt) - 1)) genstrncat(buf," ",buflen-strlen(buf)); } if (rptr->query != NULL) { if (rptr->tcnt != 0) genstrncat(buf," ",buflen-strlen(buf)); genstrncat(buf,"",buflen-strlen(buf)); } genstrncat(buf,")",buflen-strlen(buf)); if (((int) j) != (((int) meth->restrictionCount)-1)) genstrncat(buf," ",buflen-strlen(buf)); } } #endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */ #if DEBUGGING_FUNCTIONS /************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic ) *************************************************************/ globle void PreviewGeneric( void *theEnv) { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; EvaluationData(theEnv)->EvaluationError = FALSE; if (EnvArgTypeCheck(theEnv,"preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp)); if (gfunc == NULL) { PrintErrorID(theEnv,"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find generic function "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR," in function preview-generic.\n"); return; } oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; PushProcParameters(theEnv,GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), EnvGetDefgenericName(theEnv,(void *) gfunc),"generic function", UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; EvaluationData(theEnv)->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,oldce); return; } gfunc->busy++; DisplayGenericCore(theEnv,gfunc); gfunc->busy--; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; EvaluationData(theEnv)->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,oldce); } #endif /* DEBUGGING_FUNCTIONS */ /*************************************************** NAME : CheckGenericExists DESCRIPTION : Finds the address of named generic function and prints out error message if not found INPUTS : 1) Calling function 2) Name of generic function RETURNS : Generic function address (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle DEFGENERIC *CheckGenericExists( void *theEnv, const char *fname, const char *gname) { DEFGENERIC *gfunc; gfunc = LookupDefgenericByMdlOrScope(theEnv,gname); if (gfunc == NULL) { PrintErrorID(theEnv,"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find generic function "); EnvPrintRouter(theEnv,WERROR,gname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,fname); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } return(gfunc); } /*************************************************** NAME : CheckMethodExists DESCRIPTION : Finds the array index of the specified method and prints out error message if not found INPUTS : 1) Calling function 2) Generic function address 3) Index of method RETURNS : Method array index (-1 if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle long CheckMethodExists( void *theEnv, const char *fname, DEFGENERIC *gfunc, long mi) { long fi; fi = FindMethodByIndex(gfunc,mi); if (fi == -1) { PrintErrorID(theEnv,"GENRCFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find method "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," #"); PrintLongInteger(theEnv,WERROR,mi); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,fname); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } return(fi); } #if ! OBJECT_SYSTEM /******************************************************* NAME : TypeName DESCRIPTION : Given an integer type code, this function returns the string name of the type INPUTS : The type code RETURNS : The name-string of the type, or "" for unrecognized types SIDE EFFECTS : EvaluationError set and error message printed for unrecognized types NOTES : Used only when COOL is not present *******************************************************/ globle const char *TypeName( void *theEnv, int tcode) { switch (tcode) { case INTEGER : return(INTEGER_TYPE_NAME); case FLOAT : return(FLOAT_TYPE_NAME); case SYMBOL : return(SYMBOL_TYPE_NAME); case STRING : return(STRING_TYPE_NAME); case MULTIFIELD : return(MULTIFIELD_TYPE_NAME); case EXTERNAL_ADDRESS : return(EXTERNAL_ADDRESS_TYPE_NAME); case FACT_ADDRESS : return(FACT_ADDRESS_TYPE_NAME); case INSTANCE_ADDRESS : return(INSTANCE_ADDRESS_TYPE_NAME); case INSTANCE_NAME : return(INSTANCE_NAME_TYPE_NAME); case OBJECT_TYPE_CODE : return(OBJECT_TYPE_NAME); case PRIMITIVE_TYPE_CODE : return(PRIMITIVE_TYPE_NAME); case NUMBER_TYPE_CODE : return(NUMBER_TYPE_NAME); case LEXEME_TYPE_CODE : return(LEXEME_TYPE_NAME); case ADDRESS_TYPE_CODE : return(ADDRESS_TYPE_NAME); case INSTANCE_TYPE_CODE : return(INSTANCE_TYPE_NAME); default : PrintErrorID(theEnv,"INSCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Undefined type in function type.\n"); SetEvaluationError(theEnv,TRUE); return(""); } } #endif /****************************************************** NAME : PrintGenericName DESCRIPTION : Prints the name of a gneric function (including the module name if the generic is not in the current module) INPUTS : 1) The logical name of the output 2) The generic functions RETURNS : Nothing useful SIDE EFFECTS : Generic name printed NOTES : None ******************************************************/ globle void PrintGenericName( void *theEnv, const char *logName, DEFGENERIC *gfunc) { if (gfunc->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) gfunc->header.whichModule->theModule)); EnvPrintRouter(theEnv,logName,"::"); } EnvPrintRouter(theEnv,logName,ValueToString((void *) gfunc->header.name)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /********************************************************* NAME : DisplayGenericCore DESCRIPTION : Prints out a description of a core frame of applicable methods for a particular call of a generic function INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *********************************************************/ static void DisplayGenericCore( void *theEnv, DEFGENERIC *gfunc) { long i; char buf[256]; int rtn = FALSE; for (i = 0 ; i < gfunc->mcnt ; i++) { gfunc->methods[i].busy++; if (IsMethodApplicable(theEnv,&gfunc->methods[i])) { rtn = TRUE; EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WDISPLAY," #"); PrintMethod(theEnv,buf,255,&gfunc->methods[i]); EnvPrintRouter(theEnv,WDISPLAY,buf); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } gfunc->methods[i].busy--; } if (rtn == FALSE) { EnvPrintRouter(theEnv,WDISPLAY,"No applicable methods for "); EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WDISPLAY,".\n"); } } #endif #endif clips_core_source_630/core/._moduldef.h0000755000175000017500000000040712424473404016423 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxpsr.h0000755000175000017500000000426712373731175016256 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_dffnxpsr #define _H_dffnxpsr #if DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ParseDeffunction(void *,const char *); #endif /* DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ #endif /* _H_dffnxpsr */ clips_core_source_630/core/defins.h0000755000175000017500000001340712464554105015665 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_defins #define _H_defins #if DEFINSTANCES_CONSTRUCT struct definstances; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_object #include "object.h" #endif typedef struct definstancesModule { struct defmoduleItemHeader header; } DEFINSTANCES_MODULE; typedef struct definstances { struct constructHeader header; unsigned busy; EXPRESSION *mkinstance; } DEFINSTANCES; #define DEFINSTANCES_DATA 22 struct definstancesData { struct construct *DefinstancesConstruct; int DefinstancesModuleIndex; #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefinstancesCodeItem; #endif }; #define DefinstancesData(theEnv) ((struct definstancesData *) GetEnvironmentData(theEnv,DEFINSTANCES_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DEFINS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE const char *EnvDefinstancesModule(void *,void *); LOCALE const char *EnvDefinstancesModuleName(void *,void *); LOCALE void *EnvFindDefinstances(void *,const char *); LOCALE void *EnvFindDefinstancesInModule(void *,const char *); LOCALE void EnvGetDefinstancesList(void *,DATA_OBJECT *,struct defmodule *); LOCALE const char *EnvGetDefinstancesName(void *,void *); LOCALE SYMBOL_HN *EnvGetDefinstancesNamePointer(void *,void *); LOCALE const char *EnvGetDefinstancesPPForm(void *,void *); LOCALE void *EnvGetNextDefinstances(void *,void *); LOCALE int EnvIsDefinstancesDeletable(void *,void *); LOCALE void EnvSetDefinstancesPPForm(void *,void *,const char *); LOCALE intBool EnvUndefinstances(void *,void *); LOCALE void GetDefinstancesListFunction(void *,DATA_OBJECT *); LOCALE void *GetDefinstancesModuleCommand(void *); LOCALE void SetupDefinstances(void *); LOCALE void UndefinstancesCommand(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDefinstancesCommand(void *); LOCALE void ListDefinstancesCommand(void *); LOCALE void EnvListDefinstances(void *,const char *,struct defmodule *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *DefinstancesModule(void *); LOCALE void *FindDefinstances(const char *); LOCALE void GetDefinstancesList(DATA_OBJECT *,struct defmodule *); LOCALE const char *GetDefinstancesName(void *); LOCALE const char *GetDefinstancesPPForm(void *); LOCALE void *GetNextDefinstances(void *); LOCALE int IsDefinstancesDeletable(void *); #if DEBUGGING_FUNCTIONS LOCALE void ListDefinstances(const char *,struct defmodule *); #endif LOCALE intBool Undefinstances(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFINSTANCES_CONSTRUCT */ #endif /* _H_defins */ clips_core_source_630/core/._globlbsc.c0000755000175000017500000000040712373753373016417 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objcmp.h0000755000175000017500000000040712374023212016066 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/pattern.h0000755000175000017500000001603212500146515016060 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PATTERN HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the mechanism for recognizing and */ /* parsing the various types of patterns that can be used */ /* in the LHS of a rule. In version 6.0, the only pattern */ /* types provided are for deftemplate and instance */ /* patterns. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_pattern #define _H_pattern #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif struct patternEntityRecord { struct entityRecord base; void (*decrementBasisCount)(void *,void *); void (*incrementBasisCount)(void *,void *); void (*matchFunction)(void *,void *); intBool (*synchronized)(void *,void *); intBool (*isDeleted)(void *,void *); }; typedef struct patternEntityRecord PTRN_ENTITY_RECORD; typedef struct patternEntityRecord *PTRN_ENTITY_RECORD_PTR; struct patternEntity { struct patternEntityRecord *theInfo; void *dependents; unsigned busyCount; unsigned long long timeTag; }; typedef struct patternEntity PATTERN_ENTITY; typedef struct patternEntity * PATTERN_ENTITY_PTR; struct patternParser; #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #define MAXIMUM_NUMBER_OF_PATTERNS 128 struct patternParser { const char *name; struct patternEntityRecord *entityType; int positionInArray; int (*recognizeFunction)(SYMBOL_HN *); struct lhsParseNode *(*parseFunction)(void *,const char *,struct token *); int (*postAnalysisFunction)(void *,struct lhsParseNode *); struct patternNodeHeader *(*addPatternFunction)(void *,struct lhsParseNode *); void (*removePatternFunction)(void *,struct patternNodeHeader *); struct expr *(*genJNConstantFunction)(void *,struct lhsParseNode *,int); void (*replaceGetJNValueFunction)(void *,struct expr *,struct lhsParseNode *,int); struct expr *(*genGetJNValueFunction)(void *,struct lhsParseNode *,int); struct expr *(*genCompareJNValuesFunction)(void *,struct lhsParseNode *,struct lhsParseNode *,int); struct expr *(*genPNConstantFunction)(void *,struct lhsParseNode *); void (*replaceGetPNValueFunction)(void *,struct expr *,struct lhsParseNode *); struct expr *(*genGetPNValueFunction)(void *,struct lhsParseNode *); struct expr *(*genComparePNValuesFunction)(void *,struct lhsParseNode *,struct lhsParseNode *); void (*returnUserDataFunction)(void *,void *); void *(*copyUserDataFunction)(void *,void *); void (*markIRPatternFunction)(void *,struct patternNodeHeader *,int); void (*incrementalResetFunction)(void *); struct lhsParseNode *(*initialPatternFunction)(void *); void (*codeReferenceFunction)(void *,void *,FILE *,int,int); int priority; struct patternParser *next; }; struct reservedSymbol { const char *theSymbol; const char *reservedBy; struct reservedSymbol *next; }; #define MAX_POSITIONS 8 #define PATTERN_DATA 19 struct patternData { struct patternParser *ListOfPatternParsers; struct patternParser *PatternParserArray[MAX_POSITIONS]; int NextPosition; struct reservedSymbol *ListOfReservedPatternSymbols; int WithinNotCE; int GlobalSalience; int GlobalAutoFocus; struct expr *SalienceExpression; struct patternNodeHashEntry **PatternHashTable; unsigned long PatternHashTableSize; }; #define PatternData(theEnv) ((struct patternData *) GetEnvironmentData(theEnv,PATTERN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PATTERN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializePatterns(void *); LOCALE int AddPatternParser(void *,struct patternParser *); LOCALE struct patternParser *FindPatternParser(void *,const char *); LOCALE void DetachPattern(void *,int,struct patternNodeHeader *); LOCALE void GetNextPatternEntity(void *, struct patternParser **, struct patternEntity **); LOCALE struct patternParser *GetPatternParser(void *,int); LOCALE struct lhsParseNode *RestrictionParse(void *,const char *,struct token *,int, struct symbolHashNode *,short, struct constraintRecord *,short); LOCALE int PostPatternAnalysis(void *,struct lhsParseNode *); LOCALE void PatternNodeHeaderToCode(void *,FILE *,struct patternNodeHeader *,int,int); LOCALE void AddReservedPatternSymbol(void *,const char *,const char *); LOCALE intBool ReservedPatternSymbol(void *,const char *,const char *); LOCALE void ReservedPatternSymbolErrorMsg(void *,const char *,const char *); LOCALE void AddHashedPatternNode(void *,void *,void *,unsigned short,void *); LOCALE intBool RemoveHashedPatternNode(void *,void *,void *,unsigned short,void *); LOCALE void *FindHashedPatternNode(void *,void *,unsigned short,void *); #endif /* _H_pattern */ clips_core_source_630/core/._filertr.h0000755000175000017500000000040712373742630016276 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._msgpass.c0000755000175000017500000000040712455255047016301 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factgen.h0000755000175000017500000000040712373742656016246 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objbin.h0000755000175000017500000000546212374023216015654 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /*************************************************************/ #ifndef _H_objbin #define _H_objbin #ifndef _H_object #include "object.h" #endif #define OBJECTBIN_DATA 33 struct objectBinaryData { DEFCLASS *DefclassArray; long ModuleCount; long ClassCount; long LinkCount; long SlotCount; long SlotNameCount; long TemplateSlotCount; long SlotNameMapCount; long HandlerCount; DEFCLASS_MODULE *ModuleArray; DEFCLASS **LinkArray; SLOT_DESC *SlotArray; SLOT_DESC **TmpslotArray; SLOT_NAME *SlotNameArray; unsigned *MapslotArray; HANDLER *HandlerArray; unsigned *MaphandlerArray; }; #define ObjectBinaryData(theEnv) ((struct objectBinaryData *) GetEnvironmentData(theEnv,OBJECTBIN_DATA)) #define DefclassPointer(i) (((i) == -1L) ? NULL : (DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[i]) #define DefclassIndex(cls) (((cls) == NULL) ? -1 : ((struct constructHeader *) cls)->bsaveID) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectsBload(void *); LOCALE void *BloadDefclassModuleReference(void *,int); #endif /* _H_objbin */ clips_core_source_630/core/insmngr.h0000755000175000017500000000626412373756346016107 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INSTANCE PRIMITIVE SUPPORT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_insmngr #define _H_insmngr #ifndef _H_object #include "object.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSMNGR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeInstanceCommand(void *,DATA_OBJECT *); LOCALE void MakeInstanceCommand(void *,DATA_OBJECT *); LOCALE SYMBOL_HN *GetFullInstanceName(void *,INSTANCE_TYPE *); LOCALE INSTANCE_TYPE *BuildInstance(void *,SYMBOL_HN *,DEFCLASS *,intBool); LOCALE void InitSlotsCommand(void *,DATA_OBJECT *); LOCALE intBool QuashInstance(void *,INSTANCE_TYPE *); #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void InactiveInitializeInstance(void *,DATA_OBJECT *); LOCALE void InactiveMakeInstance(void *,DATA_OBJECT *); #endif #endif /* _H_insmngr */ clips_core_source_630/core/._dffnxpsr.h0000755000175000017500000000040712373731175016463 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/multifld.h0000755000175000017500000001452512374717747016254 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/19/14 */ /* */ /* MULTIFIELD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for creating and manipulating */ /* multifield values. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* Moved ImplodeMultifield from multifun.c. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Used DataObjectToString instead of */ /* ValueToString in implode$ to handle */ /* print representation of external addresses. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed issue with StoreInMultifield when */ /* asserting void values in implied deftemplate */ /* facts. */ /* */ /*************************************************************/ #ifndef _H_multifld #define _H_multifld struct field; struct multifield; #ifndef _H_evaluatn #include "evaluatn.h" #endif struct field { unsigned short type; void *value; }; struct multifield { unsigned busyCount; long multifieldLength; struct multifield *next; struct field theFields[1]; }; typedef struct multifield SEGMENT; typedef struct multifield * SEGMENT_PTR; typedef struct multifield * MULTIFIELD_PTR; typedef struct field FIELD; typedef struct field * FIELD_PTR; #define GetMFLength(target) (((struct multifield *) (target))->multifieldLength) #define GetMFPtr(target,index) (&(((struct field *) ((struct multifield *) (target))->theFields)[index-1])) #define SetMFType(target,index,value) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type = (unsigned short) (value)) #define SetMFValue(target,index,val) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value = (void *) (val)) #define GetMFType(target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type) #define GetMFValue(target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value) #define EnvGetMFLength(theEnv,target) (((struct multifield *) (target))->multifieldLength) #define EnvGetMFPtr(theEnv,target,index) (&(((struct field *) ((struct multifield *) (target))->theFields)[index-1])) #define EnvSetMFType(theEnv,target,index,value) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type = (unsigned short) (value)) #define EnvSetMFValue(theEnv,target,index,val) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value = (void *) (val)) #define EnvGetMFType(theEnv,target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type) #define EnvGetMFValue(theEnv,target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value) #ifdef LOCALE #undef LOCALE #endif #ifdef _MULTIFLD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void *CreateMultifield2(void *,long); LOCALE void ReturnMultifield(void *,struct multifield *); LOCALE void MultifieldInstall(void *,struct multifield *); LOCALE void MultifieldDeinstall(void *,struct multifield *); LOCALE struct multifield *StringToMultifield(void *,const char *); LOCALE void *EnvCreateMultifield(void *,long); LOCALE void AddToMultifieldList(void *,struct multifield *); LOCALE void FlushMultifields(void *); LOCALE void DuplicateMultifield(void *,struct dataObject *,struct dataObject *); LOCALE void PrintMultifield(void *,const char *,SEGMENT_PTR,long,long,int); LOCALE intBool MultifieldDOsEqual(DATA_OBJECT_PTR,DATA_OBJECT_PTR); LOCALE void StoreInMultifield(void *,DATA_OBJECT *,EXPRESSION *,int); LOCALE void *CopyMultifield(void *,struct multifield *); LOCALE intBool MultifieldsEqual(struct multifield *,struct multifield *); LOCALE void *DOToMultifield(void *,DATA_OBJECT *); LOCALE unsigned long HashMultifield(struct multifield *,unsigned long); LOCALE struct multifield *GetMultifieldList(void *); LOCALE void *ImplodeMultifield(void *,DATA_OBJECT *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void *CreateMultifield(long); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_multifld */ clips_core_source_630/core/._modulcmp.c0000755000175000017500000000040712374017710016435 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._ruledef.h0000755000175000017500000000040712461253173016252 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/genrcpsr.c0000755000175000017500000016102412461252076016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Functions Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* If the last construct in a loaded file is a */ /* deffunction or defmethod with no closing right */ /* parenthesis, an error should be issued, but is */ /* not. DR0872 */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_AND_SAVE */ /* compiler flag is set to 0. */ /* */ /* Fixed typing issue when OBJECT_SYSTEM */ /* compiler flag is set to 0. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if OBJECT_SYSTEM #include "classfun.h" #include "classcom.h" #endif #include "memalloc.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "genrccom.h" #include "immthpsr.h" #include "modulutl.h" #include "prcdrpsr.h" #include "prccode.h" #include "router.h" #include "scanner.h" #include "sysdep.h" #define _GENRCPSR_SOURCE_ #include "genrcpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define HIGHER_PRECEDENCE -1 #define IDENTICAL 0 #define LOWER_PRECEDENCE 1 #define CURR_ARG_VAR "current-argument" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ValidGenericName(void *,const char *); static SYMBOL_HN *ParseMethodNameAndIndex(void *,const char *,int *); #if DEBUGGING_FUNCTIONS static void CreateDefaultGenericPPForm(void *,DEFGENERIC *); #endif static int ParseMethodParameters(void *,const char *,EXPRESSION **,SYMBOL_HN **); static RESTRICTION *ParseRestriction(void *,const char *); static void ReplaceCurrentArgRefs(void *,EXPRESSION *); static int DuplicateParameters(void *,EXPRESSION *,EXPRESSION **,SYMBOL_HN *); static EXPRESSION *AddParameter(void *,EXPRESSION *,EXPRESSION *,SYMBOL_HN *,RESTRICTION *); static EXPRESSION *ValidType(void *,SYMBOL_HN *); static intBool RedundantClasses(void *,void *,void *); static DEFGENERIC *AddGeneric(void *,SYMBOL_HN *,int *); static DEFMETHOD *AddGenericMethod(void *,DEFGENERIC *,int,short); static int RestrictionsCompare(EXPRESSION *,int,int,int,DEFMETHOD *); static int TypeListCompare(RESTRICTION *,RESTRICTION *); static DEFGENERIC *NewGeneric(void *,SYMBOL_HN *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************** NAME : ParseDefgeneric DESCRIPTION : Parses the defgeneric construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid generic function defn into generic entry NOTES : H/L Syntax : (defgeneric []) ***************************************************************************/ globle intBool ParseDefgeneric( void *theEnv, const char *readSource) { SYMBOL_HN *gname; DEFGENERIC *gfunc; int newGeneric; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defgeneric "); SetIndentDepth(theEnv,3); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defgeneric"); return(TRUE); } #endif gname = GetConstructNameAndComment(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken,"defgeneric", EnvFindDefgenericInModule,NULL,"^",TRUE, TRUE,TRUE,FALSE); if (gname == NULL) return(TRUE); if (ValidGenericName(theEnv,ValueToString(gname)) == FALSE) return(TRUE); if (DefgenericData(theEnv)->GenericInputToken.type != RPAREN) { PrintErrorID(theEnv,"GENRCPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected ')' to complete defgeneric.\n"); return(TRUE); } SavePPBuffer(theEnv,"\n"); /* ======================================================== If we're only checking syntax, don't add the successfully parsed deffacts to the KB. ======================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { return(FALSE); } gfunc = AddGeneric(theEnv,gname,&newGeneric); #if DEBUGGING_FUNCTIONS EnvSetDefgenericPPForm(theEnv,(void *) gfunc,EnvGetConserveMemory(theEnv) ? NULL : CopyPPBuffer(theEnv)); #endif return(FALSE); } /*************************************************************************** NAME : ParseDefmethod DESCRIPTION : Parses the defmethod construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid method definition into generic entry NOTES : H/L Syntax : (defmethod [] [] (* []) *) :== ? | (? * []) :== $? | ($? * []) ***************************************************************************/ globle intBool ParseDefmethod( void *theEnv, const char *readSource) { SYMBOL_HN *gname; int rcnt,mposn,mi,newMethod,mnew = FALSE,lvars,error; EXPRESSION *params,*actions,*tmp; SYMBOL_HN *wildcard; DEFMETHOD *meth; DEFGENERIC *gfunc; int theIndex; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmethod "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmethod"); return(TRUE); } #endif gname = ParseMethodNameAndIndex(theEnv,readSource,&theIndex); if (gname == NULL) return(TRUE); if (ValidGenericName(theEnv,ValueToString(gname)) == FALSE) return(TRUE); /* ======================================================== Go ahead and add the header so that the generic function can be called recursively ======================================================== */ gfunc = AddGeneric(theEnv,gname,&newMethod); #if DEBUGGING_FUNCTIONS if (newMethod && (! ConstructData(theEnv)->CheckSyntaxMode)) CreateDefaultGenericPPForm(theEnv,gfunc); #endif IncrementIndentDepth(theEnv,1); rcnt = ParseMethodParameters(theEnv,readSource,¶ms,&wildcard); DecrementIndentDepth(theEnv,1); if (rcnt == -1) goto DefmethodParseError; PPCRAndIndent(theEnv); for (tmp = params ; tmp != NULL ; tmp = tmp->nextArg) { ReplaceCurrentArgRefs(theEnv,((RESTRICTION *) tmp->argList)->query); if (ReplaceProcVars(theEnv,"method",((RESTRICTION *) tmp->argList)->query, params,wildcard,NULL,NULL)) { DeleteTempRestricts(theEnv,params); goto DefmethodParseError; } } meth = FindMethodByRestrictions(gfunc,params,rcnt,wildcard,&mposn); error = FALSE; if (meth != NULL) { if (meth->system) { PrintErrorID(theEnv,"GENRCPSR",17,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot replace the implicit system method #"); PrintLongInteger(theEnv,WERROR,(long long) meth->index); EnvPrintRouter(theEnv,WERROR,".\n"); error = TRUE; } else if ((theIndex != 0) && (theIndex != meth->index)) { PrintErrorID(theEnv,"GENRCPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"New method #"); PrintLongInteger(theEnv,WERROR,(long long) theIndex); EnvPrintRouter(theEnv,WERROR," would be indistinguishable from method #"); PrintLongInteger(theEnv,WERROR,(long long) meth->index); EnvPrintRouter(theEnv,WERROR,".\n"); error = TRUE; } } else if (theIndex != 0) { mi = FindMethodByIndex(gfunc,theIndex); if (mi == -1) mnew = TRUE; else if (gfunc->methods[mi].system) { PrintErrorID(theEnv,"GENRCPSR",17,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot replace the implicit system method #"); PrintLongInteger(theEnv,WERROR,(long long) theIndex); EnvPrintRouter(theEnv,WERROR,".\n"); error = TRUE; } } else mnew = TRUE; if (error) { DeleteTempRestricts(theEnv,params); goto DefmethodParseError; } ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"method",readSource, &DefgenericData(theEnv)->GenericInputToken,params,wildcard, NULL,NULL,&lvars,NULL); /*===========================================================*/ /* Check for the closing right parenthesis of the defmethod. */ /*===========================================================*/ if ((DefgenericData(theEnv)->GenericInputToken.type != RPAREN) && /* DR0872 */ (actions != NULL)) { SyntaxErrorMessage(theEnv,"defmethod"); DeleteTempRestricts(theEnv,params); ReturnPackedExpression(theEnv,actions); goto DefmethodParseError; } if (actions == NULL) { DeleteTempRestricts(theEnv,params); goto DefmethodParseError; } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffunction to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { DeleteTempRestricts(theEnv,params); ReturnPackedExpression(theEnv,actions); if (newMethod) { RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc); RemoveDefgeneric(theEnv,(struct constructHeader *) gfunc); } return(FALSE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm); SavePPBuffer(theEnv,"\n"); #if DEBUGGING_FUNCTIONS meth = AddMethod(theEnv,gfunc,meth,mposn,(short) theIndex,params,rcnt,lvars,wildcard,actions, EnvGetConserveMemory(theEnv) ? NULL : CopyPPBuffer(theEnv),FALSE); #else meth = AddMethod(theEnv,gfunc,meth,mposn,theIndex,params,rcnt,lvars,wildcard,actions,NULL,FALSE); #endif DeleteTempRestricts(theEnv,params); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { const char *outRouter = WDIALOG; if (mnew) { EnvPrintRouter(theEnv,outRouter," Method #"); PrintLongInteger(theEnv,outRouter,(long long) meth->index); EnvPrintRouter(theEnv,outRouter," defined.\n"); } else { outRouter = WWARNING; PrintWarningID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,outRouter,"Method #"); PrintLongInteger(theEnv,outRouter,(long long) meth->index); EnvPrintRouter(theEnv,outRouter," redefined.\n"); } } return(FALSE); DefmethodParseError: if (newMethod) { RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc); RemoveDefgeneric(theEnv,(void *) gfunc); } return(TRUE); } /************************************************************************ NAME : AddMethod DESCRIPTION : (Re)defines a new method for a generic If method already exists, deletes old information before proceeding. INPUTS : 1) The generic address 2) The old method address (can be NULL) 3) The old method array position (can be -1) 4) The method index to assign (0 if don't care) 5) The parameter expression-list (restrictions attached to argList pointers) 6) The number of restrictions 7) The number of locals vars reqd 8) The wildcard symbol (NULL if none) 9) Method actions 10) Method pretty-print form 11) A flag indicating whether to copy the restriction types or just use the pointers RETURNS : The new (old) method address SIDE EFFECTS : Method added to (or changed in) method array for generic Restrictions repacked into new method Actions and pretty-print form attached NOTES : Assumes if a method is being redefined, its busy count is 0!! IMPORTANT: Expects that FindMethodByRestrictions() has previously been called to determine if this method is already present or not. Arguments #1 and #2 should be the values obtained from FindMethod...(). ************************************************************************/ globle DEFMETHOD *AddMethod( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth, int mposn, short mi, EXPRESSION *params, int rcnt, int lvars, SYMBOL_HN *wildcard, EXPRESSION *actions, char *ppForm, int copyRestricts) { RESTRICTION *rptr,*rtmp; register int i,j; int mai; SaveBusyCount(gfunc); if (meth == NULL) { mai = (mi != 0) ? FindMethodByIndex(gfunc,mi) : -1; if (mai == -1) meth = AddGenericMethod(theEnv,gfunc,mposn,mi); else { DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[mai]); if (mai < mposn) { mposn--; for (i = mai+1 ; i <= mposn ; i++) GenCopyMemory(DEFMETHOD,1,&gfunc->methods[i-1],&gfunc->methods[i]); } else { for (i = mai-1 ; i >= mposn ; i--) GenCopyMemory(DEFMETHOD,1,&gfunc->methods[i+1],&gfunc->methods[i]); } meth = &gfunc->methods[mposn]; meth->index = mi; } } else { /* ================================ The old trace state is preserved ================================ */ ExpressionDeinstall(theEnv,meth->actions); ReturnPackedExpression(theEnv,meth->actions); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); } meth->system = 0; meth->actions = actions; ExpressionInstall(theEnv,meth->actions); meth->ppForm = ppForm; if (mposn == -1) { RestoreBusyCount(gfunc); return(meth); } meth->localVarCount = (short) lvars; meth->restrictionCount = (short) rcnt; if (wildcard != NULL) { meth->minRestrictions = (short) (rcnt-1); meth->maxRestrictions = -1; } else meth->minRestrictions = meth->maxRestrictions = (short) rcnt; if (rcnt != 0) meth->restrictions = (RESTRICTION *) gm2(theEnv,(sizeof(RESTRICTION) * rcnt)); else meth->restrictions = NULL; for (i = 0 ; i < rcnt ; i++) { rptr = &meth->restrictions[i]; rtmp = (RESTRICTION *) params->argList; rptr->query = PackExpression(theEnv,rtmp->query); rptr->tcnt = rtmp->tcnt; if (copyRestricts) { if (rtmp->types != NULL) { rptr->types = (void **) gm2(theEnv,(rptr->tcnt * sizeof(void *))); GenCopyMemory(void *,rptr->tcnt,rptr->types,rtmp->types); } else rptr->types = NULL; } else { rptr->types = rtmp->types; /* ===================================================== Make sure the types-array is not deallocated when the temporary restriction nodes are ===================================================== */ rtmp->tcnt = 0; rtmp->types = NULL; } ExpressionInstall(theEnv,rptr->query); for (j = 0 ; j < rptr->tcnt ; j++) #if OBJECT_SYSTEM IncrementDefclassBusyCount(theEnv,rptr->types[j]); #else IncrementIntegerCount((INTEGER_HN *) rptr->types[j]); #endif params = params->nextArg; } RestoreBusyCount(gfunc); return(meth); } /***************************************************** NAME : PackRestrictionTypes DESCRIPTION : Takes the restriction type list and packs it into a contiguous array of void *. INPUTS : 1) The restriction structure 2) The types expression list RETURNS : Nothing useful SIDE EFFECTS : Array allocated & expressions freed NOTES : None *****************************************************/ globle void PackRestrictionTypes( void *theEnv, RESTRICTION *rptr, EXPRESSION *types) { EXPRESSION *tmp; long i; rptr->tcnt = 0; for (tmp = types ; tmp != NULL ; tmp = tmp->nextArg) rptr->tcnt++; if (rptr->tcnt != 0) rptr->types = (void **) gm2(theEnv,(sizeof(void *) * rptr->tcnt)); else rptr->types = NULL; for (i = 0 , tmp = types ; i < rptr->tcnt ; i++ , tmp = tmp->nextArg) rptr->types[i] = (void *) tmp->value; ReturnExpression(theEnv,types); } /*************************************************** NAME : DeleteTempRestricts DESCRIPTION : Deallocates the method temporary parameter list INPUTS : The head of the list RETURNS : Nothing useful SIDE EFFECTS : List deallocated NOTES : None ***************************************************/ globle void DeleteTempRestricts( void *theEnv, EXPRESSION *phead) { EXPRESSION *ptmp; RESTRICTION *rtmp; while (phead != NULL) { ptmp = phead; phead = phead->nextArg; rtmp = (RESTRICTION *) ptmp->argList; rtn_struct(theEnv,expr,ptmp); ReturnExpression(theEnv,rtmp->query); if (rtmp->tcnt != 0) rm(theEnv,(void *) rtmp->types,(sizeof(void *) * rtmp->tcnt)); rtn_struct(theEnv,restriction,rtmp); } } /********************************************************** NAME : FindMethodByRestrictions DESCRIPTION : See if a method for the specified generic satsifies the given restrictions INPUTS : 1) Generic function 2) Parameter/restriction expression list 3) Number of restrictions 4) Wildcard symbol (can be NULL) 5) Caller's buffer for holding array posn of where to add new generic method (-1 if method already present) RETURNS : The address of the found method, NULL if not found SIDE EFFECTS : Sets the caller's buffer to the index of where to place the new method, -1 if already present NOTES : None **********************************************************/ globle DEFMETHOD *FindMethodByRestrictions( DEFGENERIC *gfunc, EXPRESSION *params, int rcnt, SYMBOL_HN *wildcard, int *posn) { register int i,cmp; int min,max; if (wildcard != NULL) { min = rcnt-1; max = -1; } else min = max = rcnt; for (i = 0 ; i < gfunc->mcnt ; i++) { cmp = RestrictionsCompare(params,rcnt,min,max,&gfunc->methods[i]); if (cmp == IDENTICAL) { *posn = -1; return(&gfunc->methods[i]); } else if (cmp == HIGHER_PRECEDENCE) { *posn = i; return(NULL); } } *posn = i; return(NULL); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : ValidGenericName DESCRIPTION : Determines if a particular function name can be overloaded INPUTS : The name RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed NOTES : GetConstructNameAndComment() (called before this function) ensures that the defgeneric name does not conflict with one from another module ***********************************************************/ static intBool ValidGenericName( void *theEnv, const char *theDefgenericName) { struct constructHeader *theDefgeneric; #if DEFFUNCTION_CONSTRUCT struct defmodule *theModule; struct constructHeader *theDeffunction; #endif struct FunctionDefinition *systemFunction; /* ============================================ A defgeneric cannot be named the same as a construct type, e.g, defclass, defrule, etc. ============================================ */ if (FindConstruct(theEnv,theDefgenericName) != NULL) { PrintErrorID(theEnv,"GENRCPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgenerics are not allowed to replace constructs.\n"); return(FALSE); } #if DEFFUNCTION_CONSTRUCT /* ======================================== A defgeneric cannot be named the same as a defffunction (either in this module or imported from another) ======================================== */ theDeffunction = (struct constructHeader *) LookupDeffunctionInScope(theEnv,theDefgenericName); if (theDeffunction != NULL) { theModule = GetConstructModuleItem(theDeffunction)->theModule; if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { PrintErrorID(theEnv,"GENRCPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction)); EnvPrintRouter(theEnv,WERROR," imported from module "); EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,WERROR," conflicts with this defgeneric.\n"); return(FALSE); } else { PrintErrorID(theEnv,"GENRCPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgenerics are not allowed to replace deffunctions.\n"); } return(FALSE); } #endif /* ========================================= See if the defgeneric already exists in this module (or is imported from another) ========================================= */ theDefgeneric = (struct constructHeader *) EnvFindDefgenericInModule(theEnv,theDefgenericName); if (theDefgeneric != NULL) { /* =========================================== And the redefinition of a defgeneric in the current module is only valid if none of its methods are executing =========================================== */ if (MethodsExecuting((DEFGENERIC *) theDefgeneric)) { MethodAlterError(theEnv,(DEFGENERIC *) theDefgeneric); return(FALSE); } } /* ======================================= Only certain specific system functions may be overloaded by generic functions ======================================= */ systemFunction = FindFunction(theEnv,theDefgenericName); if ((systemFunction != NULL) ? (systemFunction->overloadable == FALSE) : FALSE) { PrintErrorID(theEnv,"GENRCPSR",16,FALSE); EnvPrintRouter(theEnv,WERROR,"The system function "); EnvPrintRouter(theEnv,WERROR,theDefgenericName); EnvPrintRouter(theEnv,WERROR," cannot be overloaded.\n"); return(FALSE); } return(TRUE); } #if DEBUGGING_FUNCTIONS /*************************************************** NAME : CreateDefaultGenericPPForm DESCRIPTION : Adds a default pretty-print form for a gneric function when it is impliciylt created by the defn of its first method INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : Pretty-print form created and attached. NOTES : None ***************************************************/ static void CreateDefaultGenericPPForm( void *theEnv, DEFGENERIC *gfunc) { const char *moduleName, *genericName; char *buf; moduleName = EnvGetDefmoduleName(theEnv,(void *) ((struct defmodule *) EnvGetCurrentModule(theEnv))); genericName = EnvGetDefgenericName(theEnv,(void *) gfunc); buf = (char *) gm2(theEnv,(sizeof(char) * (strlen(moduleName) + strlen(genericName) + 17))); gensprintf(buf,"(defgeneric %s::%s)\n",moduleName,genericName); EnvSetDefgenericPPForm(theEnv,(void *) gfunc,buf); } #endif /******************************************************* NAME : ParseMethodNameAndIndex DESCRIPTION : Parses the name of the method and optional method index INPUTS : 1) The logical name of the input source 2) Caller's buffer for method index (0 if not specified) RETURNS : The symbolic name of the method SIDE EFFECTS : None NOTES : Assumes "(defmethod " already parsed *******************************************************/ static SYMBOL_HN *ParseMethodNameAndIndex( void *theEnv, const char *readSource, int *theIndex) { SYMBOL_HN *gname; *theIndex = 0; gname = GetConstructNameAndComment(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken,"defgeneric", EnvFindDefgenericInModule,NULL,"&",TRUE,FALSE,TRUE,TRUE); if (gname == NULL) return(NULL); if (GetType(DefgenericData(theEnv)->GenericInputToken) == INTEGER) { int tmp; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm); tmp = (int) ValueToLong(GetValue(DefgenericData(theEnv)->GenericInputToken)); if (tmp < 1) { PrintErrorID(theEnv,"GENRCPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Method index out of range.\n"); return(NULL); } *theIndex = tmp; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } if (GetType(DefgenericData(theEnv)->GenericInputToken) == STRING) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } return(gname); } /************************************************************************ NAME : ParseMethodParameters DESCRIPTION : Parses method restrictions (parameter names with class and expression specifiers) INPUTS : 1) The logical name of the input source 2) Caller's buffer for the parameter name list (Restriction structures are attached to argList pointers of parameter nodes) 3) Caller's buffer for wildcard symbol (if any) RETURNS : The number of parameters, or -1 on errors SIDE EFFECTS : Memory allocated for parameters and restrictions Parameter names stored in expression list Parameter restrictions stored in contiguous array NOTES : Any memory allocated is freed on errors Assumes first opening parenthesis has been scanned ************************************************************************/ static int ParseMethodParameters( void *theEnv, const char *readSource, EXPRESSION **params, SYMBOL_HN **wildcard) { EXPRESSION *phead = NULL,*pprv; SYMBOL_HN *pname; RESTRICTION *rtmp; int rcnt = 0; *wildcard = NULL; *params = NULL; if (GetType(DefgenericData(theEnv)->GenericInputToken) != LPAREN) { PrintErrorID(theEnv,"GENRCPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a '(' to begin method parameter restrictions.\n"); return(-1); } GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); while (DefgenericData(theEnv)->GenericInputToken.type != RPAREN) { if (*wildcard != NULL) { DeleteTempRestricts(theEnv,phead); PrintErrorID(theEnv,"PRCCODE",8,FALSE); EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n"); return(-1); } if ((DefgenericData(theEnv)->GenericInputToken.type == SF_VARIABLE) || (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE)) { pname = (SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value; if (DuplicateParameters(theEnv,phead,&pprv,pname)) { DeleteTempRestricts(theEnv,phead); return(-1); } if (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE) *wildcard = pname; rtmp = get_struct(theEnv,restriction); PackRestrictionTypes(theEnv,rtmp,NULL); rtmp->query = NULL; phead = AddParameter(theEnv,phead,pprv,pname,rtmp); rcnt++; } else if (DefgenericData(theEnv)->GenericInputToken.type == LPAREN) { GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); if ((DefgenericData(theEnv)->GenericInputToken.type != SF_VARIABLE) && (DefgenericData(theEnv)->GenericInputToken.type != MF_VARIABLE)) { DeleteTempRestricts(theEnv,phead); PrintErrorID(theEnv,"GENRCPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a variable for parameter specification.\n"); return(-1); } pname = (SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value; if (DuplicateParameters(theEnv,phead,&pprv,pname)) { DeleteTempRestricts(theEnv,phead); return(-1); } if (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE) *wildcard = pname; SavePPBuffer(theEnv," "); rtmp = ParseRestriction(theEnv,readSource); if (rtmp == NULL) { DeleteTempRestricts(theEnv,phead); return(-1); } phead = AddParameter(theEnv,phead,pprv,pname,rtmp); rcnt++; } else { DeleteTempRestricts(theEnv,phead); PrintErrorID(theEnv,"GENRCPSR",9,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a variable or '(' for parameter specification.\n"); return(-1); } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } if (rcnt != 0) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } *params = phead; return(rcnt); } /************************************************************ NAME : ParseRestriction DESCRIPTION : Parses the restriction for a parameter of a method This restriction is comprised of: 1) A list of classes (or types) that are allowed for the parameter (None if no type restriction) 2) And an optional restriction-query expression INPUTS : The logical name of the input source RETURNS : The address of a RESTRICTION node, NULL on errors SIDE EFFECTS : RESTRICTION node allocated Types are in a contiguous array of void * Query is an expression NOTES : Assumes "(? " has already been parsed H/L Syntax: * []) ************************************************************/ static RESTRICTION *ParseRestriction( void *theEnv, const char *readSource) { EXPRESSION *types = NULL,*new_types, *typesbot,*tmp,*tmp2, *query = NULL; RESTRICTION *rptr; GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); while (DefgenericData(theEnv)->GenericInputToken.type != RPAREN) { if (query != NULL) { PrintErrorID(theEnv,"GENRCPSR",10,FALSE); EnvPrintRouter(theEnv,WERROR,"Query must be last in parameter restriction.\n"); ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); return(NULL); } if (DefgenericData(theEnv)->GenericInputToken.type == SYMBOL) { new_types = ValidType(theEnv,(SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value); if (new_types == NULL) { ReturnExpression(theEnv,types); ReturnExpression(theEnv,query); return(NULL); } if (types == NULL) types = new_types; else { for (typesbot = tmp = types ; tmp != NULL ; tmp = tmp->nextArg) { for (tmp2 = new_types ; tmp2 != NULL ; tmp2 = tmp2->nextArg) { if (tmp->value == tmp2->value) { PrintErrorID(theEnv,"GENRCPSR",11,FALSE); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WERROR,"Duplicate classes not allowed in parameter restriction.\n"); #else EnvPrintRouter(theEnv,WERROR,"Duplicate types not allowed in parameter restriction.\n"); #endif ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); ReturnExpression(theEnv,new_types); return(NULL); } if (RedundantClasses(theEnv,tmp->value,tmp2->value)) { ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); ReturnExpression(theEnv,new_types); return(NULL); } } typesbot = tmp; } typesbot->nextArg = new_types; } } else if (DefgenericData(theEnv)->GenericInputToken.type == LPAREN) { query = Function1Parse(theEnv,readSource); if (query == NULL) { ReturnExpression(theEnv,types); return(NULL); } if (GetParsedBindNames(theEnv) != NULL) { PrintErrorID(theEnv,"GENRCPSR",12,FALSE); EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in query expressions.\n"); ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); return(NULL); } } #if DEFGLOBAL_CONSTRUCT else if (DefgenericData(theEnv)->GenericInputToken.type == GBL_VARIABLE) query = GenConstant(theEnv,GBL_VARIABLE,DefgenericData(theEnv)->GenericInputToken.value); #endif else { PrintErrorID(theEnv,"GENRCPSR",13,FALSE); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WERROR,"Expected a valid class name or query.\n"); #else EnvPrintRouter(theEnv,WERROR,"Expected a valid type name or query.\n"); #endif ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); return(NULL); } SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); if ((types == NULL) && (query == NULL)) { PrintErrorID(theEnv,"GENRCPSR",13,FALSE); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WERROR,"Expected a valid class name or query.\n"); #else EnvPrintRouter(theEnv,WERROR,"Expected a valid type name or query.\n"); #endif return(NULL); } rptr = get_struct(theEnv,restriction); rptr->query = query; PackRestrictionTypes(theEnv,rptr,types); return(rptr); } /***************************************************************** NAME : ReplaceCurrentArgRefs DESCRIPTION : Replaces all references to ?current-argument in method parameter queries with special calls to (gnrc-current-arg) INPUTS : The query expression RETURNS : Nothing useful SIDE EFFECTS : Variable references to ?current-argument replaced NOTES : None *****************************************************************/ static void ReplaceCurrentArgRefs( void *theEnv, EXPRESSION *query) { while (query != NULL) { if ((query->type != SF_VARIABLE) ? FALSE : (strcmp(ValueToString(query->value),CURR_ARG_VAR) == 0)) { query->type = FCALL; query->value = (void *) FindFunction(theEnv,"(gnrc-current-arg)"); } if (query->argList != NULL) ReplaceCurrentArgRefs(theEnv,query->argList); query = query->nextArg; } } /********************************************************** NAME : DuplicateParameters DESCRIPTION : Examines the parameter expression chain for a method looking duplicates. INPUTS : 1) The parameter chain (can be NULL) 2) Caller's buffer for address of last node searched (can be used to later attach new parameter) 3) The name of the parameter being checked RETURNS : TRUE if duplicates found, FALSE otherwise SIDE EFFECTS : Caller's prv address set NOTES : Assumes all parameter list nodes are WORDS **********************************************************/ static int DuplicateParameters( void *theEnv, EXPRESSION *head, EXPRESSION **prv, SYMBOL_HN *name) { *prv = NULL; while (head != NULL) { if (head->value == (void *) name) { PrintErrorID(theEnv,"PRCCODE",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n"); return(TRUE); } *prv = head; head = head->nextArg; } return(FALSE); } /***************************************************************** NAME : AddParameter DESCRIPTION : Shoves a new paramter with its restriction onto the list for a method The parameter list is a list of expressions linked by neext_arg pointers, and the argList pointers are used for the restrictions INPUTS : 1) The head of the list 2) The bottom of the list 3) The parameter name 4) The parameter restriction RETURNS : The (new) head of the list SIDE EFFECTS : New parameter expression node allocated, set, and attached NOTES : None *****************************************************************/ static EXPRESSION *AddParameter( void *theEnv, EXPRESSION *phead, EXPRESSION *pprv, SYMBOL_HN *pname, RESTRICTION *rptr) { EXPRESSION *ptmp; ptmp = GenConstant(theEnv,SYMBOL,(void *) pname); if (phead == NULL) phead = ptmp; else pprv->nextArg = ptmp; ptmp->argList = (EXPRESSION *) rptr; return(phead); } /************************************************************** NAME : ValidType DESCRIPTION : Examines the name of a restriction type and forms a list of integer-code expressions corresponding to the primitive types (or a Class address if COOL is installed) INPUTS : The type name RETURNS : The expression chain (NULL on errors) SIDE EFFECTS : Expression type chain allocated one or more nodes holding codes for types (or class addresses) NOTES : None *************************************************************/ static EXPRESSION *ValidType( void *theEnv, SYMBOL_HN *tname) { #if OBJECT_SYSTEM DEFCLASS *cls; if (FindModuleSeparator(ValueToString(tname))) IllegalModuleSpecifierMessage(theEnv); else { cls = LookupDefclassInScope(theEnv,ValueToString(tname)); if (cls == NULL) { PrintErrorID(theEnv,"GENRCPSR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Unknown class in method.\n"); return(NULL); } return(GenConstant(theEnv,DEFCLASS_PTR,(void *) cls)); } #else if (strcmp(ValueToString(tname),INTEGER_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) INTEGER))); if (strcmp(ValueToString(tname),FLOAT_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) FLOAT))); if (strcmp(ValueToString(tname),SYMBOL_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) SYMBOL))); if (strcmp(ValueToString(tname),STRING_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) STRING))); if (strcmp(ValueToString(tname),MULTIFIELD_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) MULTIFIELD))); if (strcmp(ValueToString(tname),EXTERNAL_ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) EXTERNAL_ADDRESS))); if (strcmp(ValueToString(tname),FACT_ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) FACT_ADDRESS))); if (strcmp(ValueToString(tname),NUMBER_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) NUMBER_TYPE_CODE))); if (strcmp(ValueToString(tname),LEXEME_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) LEXEME_TYPE_CODE))); if (strcmp(ValueToString(tname),ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) ADDRESS_TYPE_CODE))); if (strcmp(ValueToString(tname),PRIMITIVE_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) PRIMITIVE_TYPE_CODE))); if (strcmp(ValueToString(tname),OBJECT_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) OBJECT_TYPE_CODE))); if (strcmp(ValueToString(tname),INSTANCE_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) INSTANCE_TYPE_CODE))); if (strcmp(ValueToString(tname),INSTANCE_NAME_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) INSTANCE_NAME))); if (strcmp(ValueToString(tname),INSTANCE_ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) INSTANCE_ADDRESS))); PrintErrorID(theEnv,"GENRCPSR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Unknown type in method.\n"); #endif return(NULL); } /************************************************************* NAME : RedundantClasses DESCRIPTION : Determines if one class (type) is subsumes (or is subsumed by) another. INPUTS : Two void pointers which are class pointers if COOL is installed or integer hash nodes for type codes otherwise. RETURNS : TRUE if there is subsumption, FALSE otherwise SIDE EFFECTS : An error message is printed, if appropriate. NOTES : None *************************************************************/ static intBool RedundantClasses( void *theEnv, void *c1, void *c2) { const char *tname; #if OBJECT_SYSTEM if (HasSuperclass((DEFCLASS *) c1,(DEFCLASS *) c2)) tname = EnvGetDefclassName(theEnv,c1); else if (HasSuperclass((DEFCLASS *) c2,(DEFCLASS *) c1)) tname = EnvGetDefclassName(theEnv,c2); #else if (SubsumeType(ValueToInteger(c1),ValueToInteger(c2))) tname = TypeName(theEnv,ValueToInteger(c1)); else if (SubsumeType(ValueToInteger(c2),ValueToInteger(c1))) tname = TypeName(theEnv,ValueToInteger(c2)); #endif else return(FALSE); PrintErrorID(theEnv,"GENRCPSR",15,FALSE); EnvPrintRouter(theEnv,WERROR,tname); EnvPrintRouter(theEnv,WERROR," class is redundant.\n"); return(TRUE); } /********************************************************* NAME : AddGeneric DESCRIPTION : Inserts a new generic function header into the generic list INPUTS : 1) Symbolic name of the new generic 2) Caller's input buffer for flag if added generic is new or not RETURNS : The address of the new node, or address of old node if already present SIDE EFFECTS : Generic header inserted If the node is already present, it is moved to the end of the list, otherwise the new node is inserted at the end NOTES : None *********************************************************/ static DEFGENERIC *AddGeneric( void *theEnv, SYMBOL_HN *name, int *newGeneric) { DEFGENERIC *gfunc; gfunc = (DEFGENERIC *) EnvFindDefgenericInModule(theEnv,ValueToString(name)); if (gfunc != NULL) { *newGeneric = FALSE; if (ConstructData(theEnv)->CheckSyntaxMode) { return(gfunc); } /* ================================ The old trace state is preserved ================================ */ RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc); } else { *newGeneric = TRUE; gfunc = NewGeneric(theEnv,name); IncrementSymbolCount(name); AddImplicitMethods(theEnv,gfunc); } AddConstructToModule((struct constructHeader *) gfunc); return(gfunc); } /********************************************************************** NAME : AddGenericMethod DESCRIPTION : Inserts a blank method (with the method-index set) into the specified position of the generic method array INPUTS : 1) The generic function 2) The index where to add the method in the array 3) The method user-index (0 if don't care) RETURNS : The address of the new method SIDE EFFECTS : Fields initialized (index set) and new method inserted Generic function new method-index set to specified by user-index if > current new method-index NOTES : None **********************************************************************/ static DEFMETHOD *AddGenericMethod( void *theEnv, DEFGENERIC *gfunc, int mposn, short mi) { DEFMETHOD *narr; long b, e; narr = (DEFMETHOD *) gm2(theEnv,(sizeof(DEFMETHOD) * (gfunc->mcnt+1))); for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++) { if (b == mposn) e++; GenCopyMemory(DEFMETHOD,1,&narr[e],&gfunc->methods[b]); } if (mi == 0) narr[mposn].index = gfunc->new_index++; else { narr[mposn].index = mi; if (mi >= gfunc->new_index) gfunc->new_index = (short) (mi+1); } narr[mposn].busy = 0; #if DEBUGGING_FUNCTIONS narr[mposn].trace = DefgenericData(theEnv)->WatchMethods; #endif narr[mposn].minRestrictions = 0; narr[mposn].maxRestrictions = 0; narr[mposn].restrictionCount = 0; narr[mposn].localVarCount = 0; narr[mposn].system = 0; narr[mposn].restrictions = NULL; narr[mposn].actions = NULL; narr[mposn].ppForm = NULL; narr[mposn].usrData = NULL; if (gfunc->mcnt != 0) rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); gfunc->mcnt++; gfunc->methods = narr; return(&narr[mposn]); } /**************************************************************** NAME : RestrictionsCompare DESCRIPTION : Compares the restriction-expression list with an existing methods restrictions to determine an ordering INPUTS : 1) The parameter/restriction expression list 2) The total number of restrictions 3) The number of minimum restrictions 4) The number of maximum restrictions (-1 if unlimited) 5) The method with which to compare restrictions RETURNS : A code representing how the method restrictions -1 : New restrictions have higher precedence 0 : New restrictions are identical 1 : New restrictions have lower precedence SIDE EFFECTS : None NOTES : The new restrictions are stored in the argList pointers of the parameter expressions ****************************************************************/ static int RestrictionsCompare( EXPRESSION *params, int rcnt, int min, int max, DEFMETHOD *meth) { register int i; register RESTRICTION *r1,*r2; int diff = FALSE,rtn; for (i = 0 ; (i < rcnt) && (i < meth->restrictionCount) ; i++) { /* ============================================================= A wildcard parameter always has lower precedence than a regular parameter, regardless of the class restriction list ============================================================= */ if ((i == rcnt-1) && (max == -1) && (meth->maxRestrictions != -1)) return(LOWER_PRECEDENCE); if ((i == meth->restrictionCount-1) && (max != -1) && (meth->maxRestrictions == -1)) return(HIGHER_PRECEDENCE); /* ============================================================= The parameter with the most specific type list has precedence ============================================================= */ r1 = (RESTRICTION *) params->argList; r2 = &meth->restrictions[i]; rtn = TypeListCompare(r1,r2); if (rtn != IDENTICAL) return(rtn); /* ===================================================== The parameter with a query restriction has precedence ===================================================== */ if ((r1->query == NULL) && (r2->query != NULL)) return(LOWER_PRECEDENCE); if ((r1->query != NULL) && (r2->query == NULL)) return(HIGHER_PRECEDENCE); /* ========================================================== Remember if the method restrictions differ at all - query expressions must be identical as well for the restrictions to be the same ========================================================== */ if (IdenticalExpression(r1->query,r2->query) == FALSE) diff = TRUE; params = params->nextArg; } /* ============================================================= If the methods have the same number of parameters here, they are either the same restrictions, or they differ only in the query restrictions ============================================================= */ if (rcnt == meth->restrictionCount) return(diff ? LOWER_PRECEDENCE : IDENTICAL); /* ============================================= The method with the greater number of regular parameters has precedence If they require the smae # of reg params, then one without a wildcard has precedence ============================================= */ if (min > meth->minRestrictions) return(HIGHER_PRECEDENCE); if (meth->minRestrictions < min) return(LOWER_PRECEDENCE); return((max == - 1) ? LOWER_PRECEDENCE : HIGHER_PRECEDENCE); } /***************************************************** NAME : TypeListCompare DESCRIPTION : Determines the precedence between the class lists on two restrictions INPUTS : 1) Restriction address #1 2) Restriction address #2 RETURNS : -1 : r1 precedes r2 0 : Identical classes 1 : r2 precedes r1 SIDE EFFECTS : None NOTES : None *****************************************************/ static int TypeListCompare( RESTRICTION *r1, RESTRICTION *r2) { long i; int diff = FALSE; if ((r1->tcnt == 0) && (r2->tcnt == 0)) return(IDENTICAL); if (r1->tcnt == 0) return(LOWER_PRECEDENCE); if (r2->tcnt == 0) return(HIGHER_PRECEDENCE); for (i = 0 ; (i < r1->tcnt) && (i < r2->tcnt) ; i++) { if (r1->types[i] != r2->types[i]) { diff = TRUE; #if OBJECT_SYSTEM if (HasSuperclass((DEFCLASS *) r1->types[i],(DEFCLASS *) r2->types[i])) return(HIGHER_PRECEDENCE); if (HasSuperclass((DEFCLASS *) r2->types[i],(DEFCLASS *) r1->types[i])) return(LOWER_PRECEDENCE); #else if (SubsumeType(ValueToInteger(r1->types[i]),ValueToInteger(r2->types[i]))) return(HIGHER_PRECEDENCE); if (SubsumeType(ValueToInteger(r2->types[i]),ValueToInteger(r1->types[i]))) return(LOWER_PRECEDENCE); #endif } } if (r1->tcnt < r2->tcnt) return(HIGHER_PRECEDENCE); if (r1->tcnt > r2->tcnt) return(LOWER_PRECEDENCE); if (diff) return(LOWER_PRECEDENCE); return(IDENTICAL); } /*************************************************** NAME : NewGeneric DESCRIPTION : Allocates and initializes a new generic function header INPUTS : The name of the new generic RETURNS : The address of the new generic SIDE EFFECTS : Generic function header created NOTES : None ***************************************************/ static DEFGENERIC *NewGeneric( void *theEnv, SYMBOL_HN *gname) { DEFGENERIC *ngen; ngen = get_struct(theEnv,defgeneric); InitializeConstructHeader(theEnv,"defgeneric",(struct constructHeader *) ngen,gname); ngen->busy = 0; ngen->new_index = 1; ngen->methods = NULL; ngen->mcnt = 0; #if DEBUGGING_FUNCTIONS ngen->trace = DefgenericData(theEnv)->WatchGenerics; #endif return(ngen); } #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips_core_source_630/core/rulepsr.h0000755000175000017500000000521412374023477016111 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Coordinates parsing of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* and LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Changed integer type/precision. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added support for hashed memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_rulepsr #define _H_rulepsr #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDefrule(void *,const char *); LOCALE struct lhsParseNode *FindVariable(struct symbolHashNode *, struct lhsParseNode *); #if DEVELOPER && DEBUGGING_FUNCTIONS LOCALE void DumpRuleAnalysis(void *,struct lhsParseNode *); #endif #endif /* _H_rulepsr */ clips_core_source_630/core/factmch.h0000755000175000017500000000574312373742651016032 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT MATCH HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Fix for DR0880. 2008-01-24 */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /*************************************************************/ #ifndef _H_factmch #define _H_factmch #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_factbld #include "factbld.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTMCH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactPatternMatch(void *,struct fact *, struct factPatternNode *,int, struct multifieldMarker *, struct multifieldMarker *); LOCALE void MarkFactPatternForIncrementalReset(void *,struct patternNodeHeader *,int); LOCALE void FactsIncrementalReset(void *); #endif /* _H_factmch */ clips_core_source_630/core/bsave.h0000755000175000017500000001037712373706572015526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* BSAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Used genstrncpy instead of strncpy. */ /* */ /* Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_bsave #define _H_bsave struct BinaryItem; #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _BSAVE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct BinaryItem { const char *name; void (*findFunction)(void *); void (*bloadStorageFunction)(void *); void (*bloadFunction)(void *); void (*clearFunction)(void *); void (*expressionFunction)(void *,FILE *); void (*bsaveStorageFunction)(void *,FILE *); void (*bsaveFunction)(void *,FILE *); int priority; struct BinaryItem *next; }; #if BLOAD_AND_BSAVE typedef struct bloadcntsv { long val; struct bloadcntsv *nxt; } BLOADCNTSV; #endif typedef struct bsave_expr { unsigned short type; long value,arg_list,next_arg; } BSAVE_EXPRESSION; #define CONSTRUCT_HEADER_SIZE 20 #define BSAVE_DATA 39 struct bsaveData { struct BinaryItem *ListOfBinaryItems; #if BLOAD_AND_BSAVE BLOADCNTSV *BloadCountSaveTop; #endif }; #define BsaveData(theEnv) ((struct bsaveData *) GetEnvironmentData(theEnv,BSAVE_DATA)) LOCALE void InitializeBsaveData(void *); LOCALE int BsaveCommand(void *); #if BLOAD_AND_BSAVE LOCALE intBool EnvBsave(void *,const char *); LOCALE void MarkNeededItems(void *,struct expr *); LOCALE void SaveBloadCount(void *,long); LOCALE void RestoreBloadCount(void *,long *); #endif LOCALE intBool AddBinaryItem(void *,const char *,int, void (*)(void *), void (*)(void *,FILE *), void (*)(void *,FILE *), void (*)(void *,FILE *), void (*)(void *), void (*)(void *), void (*)(void *)); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool Bsave(const char *); #endif #endif /* _H_bsave */ clips_core_source_630/core/._globldef.c0000755000175000017500000000040712461252236016374 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/userdata.c0000755000175000017500000001167312373740574016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* USER DATA MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for attaching user data to constructs, */ /* facts, instances, user functions, etc. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _USERDATA_SOURCE_ #include #include "setup.h" #include "envrnmnt.h" #include "userdata.h" /*************************************************/ /* InitializeUserDataData: Allocates environment */ /* data for user data routines. */ /*************************************************/ globle void InitializeUserDataData( void *theEnv) { AllocateEnvironmentData(theEnv,USER_DATA_DATA,sizeof(struct userDataData),NULL); } /******************************************************/ /* InstallUserDataRecord: Installs a user data record */ /* in the user data record array and returns the */ /* integer data ID associated with the record. */ /******************************************************/ globle unsigned char InstallUserDataRecord( void *theEnv, struct userDataRecord *theRecord) { theRecord->dataID = UserDataData(theEnv)->UserDataRecordCount; UserDataData(theEnv)->UserDataRecordArray[UserDataData(theEnv)->UserDataRecordCount] = theRecord; return(UserDataData(theEnv)->UserDataRecordCount++); } /*****************************************************/ /* FetchUserData: Searches for user data information */ /* from a list of user data structures. A new user */ /* data structure is created if one is not found. */ /*****************************************************/ globle struct userData *FetchUserData( void *theEnv, unsigned char userDataID, struct userData **theList) { struct userData *theData; for (theData = *theList; theData != NULL; theData = theData->next) { if (theData->dataID == userDataID) { return(theData); } } theData = (struct userData *) (*UserDataData(theEnv)->UserDataRecordArray[userDataID]->createUserData)(theEnv); theData->dataID = userDataID; theData->next = *theList; *theList = theData; return(theData); } /*****************************************************/ /* TestUserData: Searches for user data information */ /* from a list of user data structures. NULL is */ /* returned if the appropriate user data structure */ /* is not found. */ /*****************************************************/ globle struct userData *TestUserData( unsigned char userDataID, struct userData *theList) { struct userData *theData; for (theData = theList; theData != NULL; theData = theData->next) { if (theData->dataID == userDataID) { return(theData); } } return(NULL); } /***************************************************************/ /* ClearUserDataList: Deallocates a linked list of user data. */ /***************************************************************/ globle void ClearUserDataList( void *theEnv, struct userData *theList) { struct userData *nextData; while (theList != NULL) { nextData = theList->next; (*UserDataData(theEnv)->UserDataRecordArray[theList->dataID]->deleteUserData)(theEnv,theList); theList = nextData; } } /*************************************************/ /* DeleteUserData: Removes user data information */ /* from a list of user data structures. */ /*************************************************/ globle struct userData *DeleteUserData( void *theEnv, unsigned char userDataID, struct userData *theList) { struct userData *theData, *lastData = NULL; for (theData = theList; theData != NULL; theData = theData->next) { if (theData->dataID == userDataID) { if (lastData == NULL) { theList = theData->next; } else { lastData->next = theData->next; } (*UserDataData(theEnv)->UserDataRecordArray[userDataID]->deleteUserData)(theEnv,theData); return(theList); } lastData = theData; } return(theList); } clips_core_source_630/core/._crstrtgy.h0000755000175000017500000000040712373714233016506 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._sortfun.h0000755000175000017500000000040712373755540016333 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltbsc.c0000755000175000017500000000040712373754241016453 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/strngrtr.c0000755000175000017500000002641512373755534016310 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* STRING I/O ROUTER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow strings to be */ /* used as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Used genstrcpy instead of strcpy. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _STRNGRTR_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "strngrtr.h" #define READ_STRING 0 #define WRITE_STRING 1 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int FindString(void *,const char *); static int PrintString(void *,const char *,const char *); static int GetcString(void *,const char *); static int UngetcString(void *,int,const char *); static struct stringRouter *FindStringRouter(void *,const char *); static int CreateReadStringSource(void *,const char *,const char *,size_t,size_t); static void DeallocateStringRouterData(void *); /**********************************************************/ /* InitializeStringRouter: Initializes string I/O router. */ /**********************************************************/ globle void InitializeStringRouter( void *theEnv) { AllocateEnvironmentData(theEnv,STRING_ROUTER_DATA,sizeof(struct stringRouterData),DeallocateStringRouterData); EnvAddRouter(theEnv,"string",0,FindString,PrintString,GetcString,UngetcString,NULL); } /*******************************************/ /* DeallocateStringRouterData: Deallocates */ /* environment data for string routers. */ /*******************************************/ static void DeallocateStringRouterData( void *theEnv) { struct stringRouter *tmpPtr, *nextPtr; tmpPtr = StringRouterData(theEnv)->ListOfStringRouters; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rm(theEnv,(void *) tmpPtr->name,strlen(tmpPtr->name) + 1); rtn_struct(theEnv,stringRouter,tmpPtr); tmpPtr = nextPtr; } } /*************************************************************/ /* FindString: Find routine for string router logical names. */ /*************************************************************/ static int FindString( void *theEnv, const char *fileid) { struct stringRouter *head; head = StringRouterData(theEnv)->ListOfStringRouters; while (head != NULL) { if (strcmp(head->name,fileid) == 0) { return(TRUE); } head = head->next; } return(FALSE); } /**************************************************/ /* PrintString: Print routine for string routers. */ /**************************************************/ static int PrintString( void *theEnv, const char *logicalName, const char *str) { struct stringRouter *head; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,"ROUTER",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != WRITE_STRING) return(1); if (head->maximumPosition == 0) return(1); if ((head->currentPosition + 1) >= head->maximumPosition) return(1); genstrncpy(&head->writeString[head->currentPosition], str,(STD_SIZE) (head->maximumPosition - head->currentPosition) - 1); head->currentPosition += strlen(str); return(1); } /************************************************/ /* GetcString: Getc routine for string routers. */ /************************************************/ static int GetcString( void *theEnv, const char *logicalName) { struct stringRouter *head; int rc; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,"ROUTER",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != READ_STRING) return(EOF); if (head->currentPosition >= head->maximumPosition) { head->currentPosition++; return(EOF); } rc = (unsigned char) head->readString[head->currentPosition]; head->currentPosition++; return(rc); } /****************************************************/ /* UngetcString: Ungetc routine for string routers. */ /****************************************************/ static int UngetcString( void *theEnv, int ch, const char *logicalName) { struct stringRouter *head; #if MAC_XCD #pragma unused(ch) #endif head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,"ROUTER",2); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != READ_STRING) return(0); if (head->currentPosition > 0) { head->currentPosition--; } return(1); } /************************************************/ /* OpenStringSource: Opens a new string router. */ /************************************************/ globle int OpenStringSource( void *theEnv, const char *name, const char *str, size_t currentPosition) { size_t maximumPosition; if (str == NULL) { currentPosition = 0; maximumPosition = 0; } else { maximumPosition = strlen(str); } return(CreateReadStringSource(theEnv,name,str,currentPosition,maximumPosition)); } /******************************************************/ /* OpenTextSource: Opens a new string router for text */ /* (which is not NULL terminated). */ /******************************************************/ globle int OpenTextSource( void *theEnv, const char *name, const char *str, size_t currentPosition, size_t maximumPosition) { if (str == NULL) { currentPosition = 0; maximumPosition = 0; } return(CreateReadStringSource(theEnv,name,str,currentPosition,maximumPosition)); } /******************************************************************/ /* CreateReadStringSource: Creates a new string router for input. */ /******************************************************************/ static int CreateReadStringSource( void *theEnv, const char *name, const char *str, size_t currentPosition, size_t maximumPosition) { struct stringRouter *newStringRouter; char *theName; if (FindStringRouter(theEnv,name) != NULL) return(0); newStringRouter = get_struct(theEnv,stringRouter); theName = (char *) gm1(theEnv,strlen(name) + 1); genstrcpy(theName,name); newStringRouter->name = theName; newStringRouter->writeString = NULL; newStringRouter->readString = str; newStringRouter->currentPosition = currentPosition; newStringRouter->readWriteType = READ_STRING; newStringRouter->maximumPosition = maximumPosition; newStringRouter->next = StringRouterData(theEnv)->ListOfStringRouters; StringRouterData(theEnv)->ListOfStringRouters = newStringRouter; return(1); } /**********************************************/ /* CloseStringSource: Closes a string router. */ /**********************************************/ globle int CloseStringSource( void *theEnv, const char *name) { struct stringRouter *head, *last; last = NULL; head = StringRouterData(theEnv)->ListOfStringRouters; while (head != NULL) { if (strcmp(head->name,name) == 0) { if (last == NULL) { StringRouterData(theEnv)->ListOfStringRouters = head->next; rm(theEnv,(void *) head->name,strlen(head->name) + 1); rtn_struct(theEnv,stringRouter,head); return(1); } else { last->next = head->next; rm(theEnv,(void *) head->name,strlen(head->name) + 1); rtn_struct(theEnv,stringRouter,head); return(1); } } last = head; head = head->next; } return(0); } /******************************************************************/ /* OpenStringDestination: Opens a new string router for printing. */ /******************************************************************/ globle int OpenStringDestination( void *theEnv, const char *name, char *str, size_t maximumPosition) { struct stringRouter *newStringRouter; char *theName; if (FindStringRouter(theEnv,name) != NULL) return(0); newStringRouter = get_struct(theEnv,stringRouter); theName = (char *) gm1(theEnv,(int) strlen(name) + 1); genstrcpy(theName,name); newStringRouter->name = theName; newStringRouter->readString = NULL; newStringRouter->writeString = str; newStringRouter->currentPosition = 0; newStringRouter->readWriteType = WRITE_STRING; newStringRouter->maximumPosition = maximumPosition; newStringRouter->next = StringRouterData(theEnv)->ListOfStringRouters; StringRouterData(theEnv)->ListOfStringRouters = newStringRouter; return(1); } /***************************************************/ /* CloseStringDestination: Closes a string router. */ /***************************************************/ globle int CloseStringDestination( void *theEnv, const char *name) { return(CloseStringSource(theEnv,name)); } /*******************************************************************/ /* FindStringRouter: Returns a pointer to the named string router. */ /*******************************************************************/ static struct stringRouter *FindStringRouter( void *theEnv, const char *name) { struct stringRouter *head; head = StringRouterData(theEnv)->ListOfStringRouters; while (head != NULL) { if (strcmp(head->name,name) == 0) { return(head); } head = head->next; } return(NULL); } clips_core_source_630/core/cstrncmp.h0000755000175000017500000000472412373714215016247 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT CONSTRUCTS-TO-C HEADER */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Added environment parameter to GenClose. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_cstrncmp #define _H_cstrncmp #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif LOCALE void PrintConstraintReference(void *,FILE *,CONSTRAINT_RECORD *,int,int); LOCALE void ConstraintRecordToCode(FILE *,CONSTRAINT_RECORD *); LOCALE int ConstraintsToCode(void *,const char *,const char *,char *,int,FILE *,int,int); #endif /* _H_cstrncmp */ clips_core_source_630/core/objrtcmp.c0000755000175000017500000004464412374023171016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* OBJECT PATTERN NETWORK CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Saves object pattern network for constructs-to-c */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Added environment parameter to GenClose. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && CONSTRUCT_COMPILER #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "envrnmnt.h" #include "objrtfnx.h" #include "objrtmch.h" #include "pattern.h" #include "sysdep.h" #define _OBJRTCMP_SOURCE_ #include "objrtcmp.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define ObjectPNPrefix() ArbitraryPrefix(ObjectReteData(theEnv)->ObjectPatternCodeItem,0) #define ObjectANPrefix() ArbitraryPrefix(ObjectReteData(theEnv)->ObjectPatternCodeItem,1) /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void BeforeObjectPatternsToCode(void *); static OBJECT_PATTERN_NODE *GetNextObjectPatternNode(OBJECT_PATTERN_NODE *); static void InitObjectPatternsCode(void *,FILE *,int,int); static int ObjectPatternsToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void IntermediatePatternNodeReference(void *,OBJECT_PATTERN_NODE *,FILE *,int,int); static int IntermediatePatternNodesToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int); static int AlphaPatternNodesToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ObjectPatternsCompilerSetup DESCRIPTION : Sets up interface for object patterns to construct compiler INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item added NOTES : None ***************************************************/ globle void ObjectPatternsCompilerSetup( void *theEnv) { ObjectReteData(theEnv)->ObjectPatternCodeItem = AddCodeGeneratorItem(theEnv,"object-patterns",0,BeforeObjectPatternsToCode, InitObjectPatternsCode,ObjectPatternsToCode,2); } /*************************************************** NAME : ObjectPatternNodeReference DESCRIPTION : Prints out a reference to an object pattern alpha memory for the join network interface to the construct compiler INPUTS : 1) A pointer to the object pattern alpha memory 2) A pointer to the output file 3) The id of constructs-to-c image 4) The maximum number of indices allowed in any single array in the image RETURNS : Nothing useful SIDE EFFECTS : Reference to object pattern alpha memory printed NOTES : None ***************************************************/ globle void ObjectPatternNodeReference( void *theEnv, void *theVPattern, FILE *theFile, int imageID, int maxIndices) { OBJECT_ALPHA_NODE *thePattern; if (theVPattern == NULL) fprintf(theFile,"NULL"); else { thePattern = (OBJECT_ALPHA_NODE *) theVPattern; fprintf(theFile,"&%s%d_%d[%d]", ObjectANPrefix(),imageID, (((int) thePattern->bsaveID) / maxIndices) + 1, ((int) thePattern->bsaveID) % maxIndices); } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : BeforeObjectPatternsToCode DESCRIPTION : Marks all object pattern intermediate and alpha memory nodes with a unique integer id prior to the constructs-to-c execution INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : bsaveIDs of nodes set NOTES : None *****************************************************/ static void BeforeObjectPatternsToCode( void *theEnv) { long whichPattern; OBJECT_PATTERN_NODE *intermediateNode; OBJECT_ALPHA_NODE *alphaNode; whichPattern = 0L; intermediateNode = ObjectNetworkPointer(theEnv); while (intermediateNode != NULL) { intermediateNode->bsaveID = whichPattern++; intermediateNode = GetNextObjectPatternNode(intermediateNode); } whichPattern = 0L; alphaNode = ObjectNetworkTerminalPointer(theEnv); while (alphaNode != NULL) { alphaNode->bsaveID = whichPattern++; alphaNode = alphaNode->nxtTerminal; } } /*************************************************** NAME : GetNextObjectPatternNode DESCRIPTION : Grabs the next node in a depth first perusal of the object pattern intermediate nodes INPUTS : The previous node RETURNS : The next node (NULL if done) SIDE EFFECTS : None NOTES : Alpha meory nodes are ignored ***************************************************/ static OBJECT_PATTERN_NODE *GetNextObjectPatternNode( OBJECT_PATTERN_NODE *thePattern) { if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); while (thePattern->rightNode == NULL) { thePattern = thePattern->lastLevel; if (thePattern == NULL) return(NULL); } return(thePattern->rightNode); } /*************************************************** NAME : InitObjectPatternsCode DESCRIPTION : Prints out run-time initialization code for object patterns INPUTS : 1) A pointer to the output file 2) The id of constructs-to-c image 3) The maximum number of indices allowed in any single array in the image RETURNS : Nothing useful SIDE EFFECTS : Initialization code written NOTES : None ***************************************************/ static void InitObjectPatternsCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { long firstIntermediateNode,firstAlphaNode; if (ObjectNetworkPointer(theEnv) != NULL) { firstIntermediateNode = ObjectNetworkPointer(theEnv)->bsaveID; firstAlphaNode = ObjectNetworkTerminalPointer(theEnv)->bsaveID; fprintf(initFP," SetObjectNetworkPointer(theEnv,&%s%d_%d[%d]);\n", ObjectPNPrefix(),imageID, (int) ((firstIntermediateNode / maxIndices) + 1), (int) (firstIntermediateNode % maxIndices)); fprintf(initFP," SetObjectNetworkTerminalPointer(theEnv,&%s%d_%d[%d]);\n", ObjectANPrefix(),imageID, (int) ((firstAlphaNode / maxIndices) + 1), (int) (firstAlphaNode % maxIndices)); } else { fprintf(initFP," SetObjectNetworkPointer(theEnv,NULL);\n"); fprintf(initFP," SetObjectNetworkTerminalPointer(theEnv,NULL);\n"); } } /*********************************************************** NAME : ObjectPatternsToCode DESCRIPTION : Writes out data structures for run-time creation of object patterns INPUTS : 1) The base image output file name 2) The base image file id 3) A pointer to the header output file 4) The id of constructs-to-c image 5) The maximum number of indices allowed in any single array in the image RETURNS : 1 if OK, 0 if could not open a file SIDE EFFECTS : Object patterns code written to files NOTES : None ***********************************************************/ static int ObjectPatternsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int version; version = IntermediatePatternNodesToCode(theEnv,fileName,pathName,fileNameBuffer, fileID,headerFP,imageID,maxIndices,1); if (version == 0) return(0); if (! AlphaPatternNodesToCode(theEnv,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID,maxIndices,version)) return(0); return(1); } /*************************************************** NAME : IntermediatePatternNodeReference DESCRIPTION : Prints out a reference to an object pattern intermediate node INPUTS : 1) A pointer to the object pattern intermediate node 2) A pointer to the output file 3) The id of constructs-to-c image 4) The maximum number of indices allowed in any single array in the image RETURNS : 1 if OK, 0 if could not open a file SIDE EFFECTS : Reference to object pattern alpha memory printed NOTES : None ***************************************************/ static void IntermediatePatternNodeReference( void *theEnv, OBJECT_PATTERN_NODE *thePattern, FILE *theFile, int imageID, int maxIndices) { if (thePattern == NULL) fprintf(theFile,"NULL"); else { fprintf(theFile,"&%s%d_%d[%d]", ObjectPNPrefix(),imageID, (((int) thePattern->bsaveID) / maxIndices) + 1, ((int) thePattern->bsaveID) % maxIndices); } } /************************************************************* NAME : IntermediatePatternNodesToCode DESCRIPTION : Writes out data structures for run-time creation of object pattern intermediate nodes INPUTS : 1) The base image output file name 2) The base image file id 3) A pointer to the header output file 4) The id of constructs-to-c image 5) The maximum number of indices allowed in any single array in the image RETURNS : Next version file to open, 0 if error SIDE EFFECTS : Object patterns code written to files NOTES : None *************************************************************/ static int IntermediatePatternNodesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int version) { FILE *fp; int arrayVersion; int newHeader; int i; OBJECT_PATTERN_NODE *thePattern; /* ================ Create the file. ================ */ if (ObjectNetworkPointer(theEnv) == NULL) return(1); fprintf(headerFP,"#include \"objrtmch.h\"\n"); /* ================================= Dump the pattern node structures. ================================= */ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; arrayVersion = 1; i = 1; thePattern = ObjectNetworkPointer(theEnv); while (thePattern != NULL) { if (newHeader) { fprintf(fp,"OBJECT_PATTERN_NODE %s%d_%d[] = {\n", ObjectPNPrefix(),imageID,arrayVersion); fprintf(headerFP,"extern OBJECT_PATTERN_NODE %s%d_%d[];\n", ObjectPNPrefix(),imageID,arrayVersion); newHeader = FALSE; } fprintf(fp,"{0,%u,%u,%u,%u,%u,0L,%u,",thePattern->multifieldNode, thePattern->endSlot, thePattern->selector, thePattern->whichField, thePattern->leaveFields, thePattern->slotNameID); PrintHashedExpressionReference(theEnv,fp,thePattern->networkTest,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->nextLevel,fp,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->lastLevel,fp,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->leftNode,fp,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->rightNode,fp,imageID,maxIndices); fprintf(fp,","); ObjectPatternNodeReference(theEnv,(void *) thePattern->alphaNode,fp,imageID,maxIndices); fprintf(fp,",0L}"); i++; thePattern = GetNextObjectPatternNode(thePattern); if ((i > maxIndices) || (thePattern == NULL)) { fprintf(fp,"};\n"); GenClose(theEnv,fp); i = 1; version++; arrayVersion++; if (thePattern != NULL) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else if (thePattern != NULL) { fprintf(fp,",\n"); } } return(version); } /*********************************************************** NAME : AlphaPatternNodesToCode DESCRIPTION : Writes out data structures for run-time creation of object pattern alpha memories INPUTS : 1) The base image output file name 2) The base image file id 3) A pointer to the header output file 4) The id of constructs-to-c image 5) The maximum number of indices allowed in any single array in the image RETURNS : Next version file to open, 0 if error SIDE EFFECTS : Object patterns code written to files NOTES : None ***********************************************************/ static int AlphaPatternNodesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int version) { FILE *fp; int arrayVersion; int newHeader; int i; OBJECT_ALPHA_NODE *thePattern; /* ================ Create the file. ================ */ if (ObjectNetworkTerminalPointer(theEnv) == NULL) return(version); /* ================================= Dump the pattern node structures. ================================= */ if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; arrayVersion = 1; i = 1; thePattern = ObjectNetworkTerminalPointer(theEnv); while (thePattern != NULL) { if (newHeader) { fprintf(fp,"OBJECT_ALPHA_NODE %s%d_%d[] = {\n", ObjectANPrefix(),imageID,arrayVersion); fprintf(headerFP,"extern OBJECT_ALPHA_NODE %s%d_%d[];\n", ObjectANPrefix(),imageID,arrayVersion); newHeader = FALSE; } fprintf(fp,"{"); PatternNodeHeaderToCode(theEnv,fp,&thePattern->header,imageID,maxIndices); fprintf(fp,",0L,"); PrintBitMapReference(theEnv,fp,thePattern->classbmp); fprintf(fp,","); PrintBitMapReference(theEnv,fp,thePattern->slotbmp); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->patternNode,fp,imageID,maxIndices); fprintf(fp,","); ObjectPatternNodeReference(theEnv,thePattern->nxtInGroup,fp,imageID,maxIndices); fprintf(fp,","); ObjectPatternNodeReference(theEnv,thePattern->nxtTerminal,fp,imageID,maxIndices); fprintf(fp,",0L}"); i++; thePattern = thePattern->nxtTerminal; if ((i > maxIndices) || (thePattern == NULL)) { fprintf(fp,"};\n"); GenClose(theEnv,fp); i = 1; version++; arrayVersion++; if (thePattern != NULL) { if ((fp = NewCFile(theEnv,fileName,pathName,fileNameBuffer,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else if (thePattern != NULL) { fprintf(fp,",\n"); } } return(version); } #endif clips_core_source_630/core/dffnxcmp.h0000755000175000017500000000424612373731203016216 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Deffunction Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_dffnxcmp #define _H_dffnxcmp #if DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "dffnxfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDeffunctionCompiler(void *); LOCALE void PrintDeffunctionReference(void *,FILE *,DEFFUNCTION *,int,int); LOCALE void DeffunctionCModuleReference(void *,FILE *,int,int,int); #endif /* DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ #endif /* _H_dffnxcmp */ clips_core_source_630/core/filertr.c0000755000175000017500000002665412461762346016074 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* FILE I/O ROUTER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow files to be used */ /* as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Used gengetc and genungetchar rather than */ /* getc and ungetc. */ /* */ /* Replaced BASIC_IO and ADVANCED_IO compiler */ /* flags with the single IO_FUNCTIONS compiler */ /* flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ #define _FILERTR_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "filertr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ExitFile(void *,int); static int PrintFile(void *,const char *,const char *); static int GetcFile(void *,const char *); static int UngetcFile(void *,int,const char *); static void DeallocateFileRouterData(void *); /***************************************************************/ /* InitializeFileRouter: Initializes file input/output router. */ /***************************************************************/ globle void InitializeFileRouter( void *theEnv) { AllocateEnvironmentData(theEnv,FILE_ROUTER_DATA,sizeof(struct fileRouterData),DeallocateFileRouterData); EnvAddRouter(theEnv,"fileio",0,FindFile, PrintFile,GetcFile, UngetcFile,ExitFile); } /*****************************************/ /* DeallocateFileRouterData: Deallocates */ /* environment data for file routers. */ /*****************************************/ static void DeallocateFileRouterData( void *theEnv) { struct fileRouter *tmpPtr, *nextPtr; tmpPtr = FileRouterData(theEnv)->ListOfFileRouters; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; GenClose(theEnv,tmpPtr->stream); rm(theEnv,(void *) tmpPtr->logicalName,strlen(tmpPtr->logicalName) + 1); rtn_struct(theEnv,fileRouter,tmpPtr); tmpPtr = nextPtr; } } /*****************************************/ /* FindFptr: Returns a pointer to a file */ /* stream for a given logical name. */ /*****************************************/ globle FILE *FindFptr( void *theEnv, const char *logicalName) { struct fileRouter *fptr; /*========================================================*/ /* Check to see if standard input or output is requested. */ /*========================================================*/ if (strcmp(logicalName,STDOUT) == 0) { return(stdout); } else if (strcmp(logicalName,STDIN) == 0) { return(stdin); } else if (strcmp(logicalName,WTRACE) == 0) { return(stdout); } else if (strcmp(logicalName,WDIALOG) == 0) { return(stdout); } else if (strcmp(logicalName,WPROMPT) == 0) { return(stdout); } else if (strcmp(logicalName,WDISPLAY) == 0) { return(stdout); } else if (strcmp(logicalName,WERROR) == 0) { return(stdout); } else if (strcmp(logicalName,WWARNING) == 0) { return(stdout); } /*==============================================================*/ /* Otherwise, look up the logical name on the global file list. */ /*==============================================================*/ fptr = FileRouterData(theEnv)->ListOfFileRouters; while ((fptr != NULL) ? (strcmp(logicalName,fptr->logicalName) != 0) : FALSE) { fptr = fptr->next; } if (fptr != NULL) return(fptr->stream); return(NULL); } /*****************************************************/ /* FindFile: Find routine for file router logical */ /* names. Returns TRUE if the specified logical */ /* name has an associated file stream (which means */ /* that the logical name can be handled by the */ /* file router). Otherwise, FALSE is returned. */ /*****************************************************/ globle int FindFile( void *theEnv, const char *logicalName) { if (FindFptr(theEnv,logicalName) != NULL) return(TRUE); return(FALSE); } /********************************************/ /* ExitFile: Exit routine for file router. */ /********************************************/ static int ExitFile( void *theEnv, int num) { #if MAC_XCD #pragma unused(num) #endif #if IO_FUNCTIONS CloseAllFiles(theEnv); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif return(1); } /*********************************************/ /* PrintFile: Print routine for file router. */ /*********************************************/ static int PrintFile( void *theEnv, const char *logicalName, const char *str) { FILE *fptr; fptr = FindFptr(theEnv,logicalName); genprintfile(theEnv,fptr,str); return(1); } /*******************************************/ /* GetcFile: Getc routine for file router. */ /*******************************************/ static int GetcFile( void *theEnv, const char *logicalName) { FILE *fptr; int theChar; fptr = FindFptr(theEnv,logicalName); if (fptr == stdin) { theChar = gengetchar(theEnv); } else { theChar = getc(fptr); } /*=================================================*/ /* The following code prevents Control-D on UNIX */ /* machines from terminating all input from stdin. */ /*=================================================*/ if ((fptr == stdin) && (theChar == EOF)) clearerr(stdin); return(theChar); } /***********************************************/ /* UngetcFile: Ungetc routine for file router. */ /***********************************************/ static int UngetcFile( void *theEnv, int ch, const char *logicalName) { FILE *fptr; fptr = FindFptr(theEnv,logicalName); if (fptr == stdin) { return(genungetchar(theEnv,ch)); } else { return(ungetc(ch,fptr)); } } /*********************************************************/ /* OpenFile: Opens a file with the specified access mode */ /* and stores the opened stream on the list of files */ /* associated with logical names Returns TRUE if the */ /* file was succesfully opened, otherwise FALSE. */ /*********************************************************/ globle int OpenAFile( void *theEnv, const char *fileName, const char *accessMode, const char *logicalName) { FILE *newstream; struct fileRouter *newRouter; char *theName; /*==================================*/ /* Make sure the file can be opened */ /* with the specified access mode. */ /*==================================*/ if ((newstream = GenOpen(theEnv,fileName,accessMode)) == NULL) { return(FALSE); } /*===========================*/ /* Create a new file router. */ /*===========================*/ newRouter = get_struct(theEnv,fileRouter); theName = (char *) gm2(theEnv,strlen(logicalName) + 1); genstrcpy(theName,logicalName); newRouter->logicalName = theName; newRouter->stream = newstream; /*==========================================*/ /* Add the newly opened file to the list of */ /* files associated with logical names. */ /*==========================================*/ newRouter->next = FileRouterData(theEnv)->ListOfFileRouters; FileRouterData(theEnv)->ListOfFileRouters = newRouter; /*==================================*/ /* Return TRUE to indicate the file */ /* was opened successfully. */ /*==================================*/ return(TRUE); } /*************************************************************/ /* CloseFile: Closes the file associated with the specified */ /* logical name. Returns TRUE if the file was successfully */ /* closed, otherwise FALSE. */ /*************************************************************/ globle int CloseFile( void *theEnv, const char *fid) { struct fileRouter *fptr, *prev; for (fptr = FileRouterData(theEnv)->ListOfFileRouters, prev = NULL; fptr != NULL; fptr = fptr->next) { if (strcmp(fptr->logicalName,fid) == 0) { GenClose(theEnv,fptr->stream); rm(theEnv,(void *) fptr->logicalName,strlen(fptr->logicalName) + 1); if (prev == NULL) { FileRouterData(theEnv)->ListOfFileRouters = fptr->next; } else { prev->next = fptr->next; } rm(theEnv,fptr,(int) sizeof(struct fileRouter)); return(TRUE); } prev = fptr; } return(FALSE); } /**********************************************/ /* CloseAllFiles: Closes all files associated */ /* with a file I/O router. Returns TRUE if */ /* any file was closed, otherwise FALSE. */ /**********************************************/ globle int CloseAllFiles( void *theEnv) { struct fileRouter *fptr, *prev; if (FileRouterData(theEnv)->ListOfFileRouters == NULL) return(FALSE); fptr = FileRouterData(theEnv)->ListOfFileRouters; while (fptr != NULL) { GenClose(theEnv,fptr->stream); prev = fptr; rm(theEnv,(void *) fptr->logicalName,strlen(fptr->logicalName) + 1); fptr = fptr->next; rm(theEnv,prev,(int) sizeof(struct fileRouter)); } FileRouterData(theEnv)->ListOfFileRouters = NULL; return(TRUE); } clips_core_source_630/core/factfun.c0000755000175000017500000005451112461762345016043 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* FACT FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* */ /* (fact-existp ) */ /* Returns TRUE if the fact exists, otherwise FALSE is */ /* returned. */ /* */ /* (fact-relation ) */ /* Returns the deftemplate name of the fact. Returns */ /* False if the specified fact doesn't exist. */ /* */ /* (fact-slot-value ) */ /* Returns the contents of a slot (use the slot name */ /* implied for the implied multifield slot of an ordered */ /* fact). Returns the value FALSE if the slot name is */ /* invalid or the fact doesn't exist. */ /* */ /* (fact-slot-names ) */ /* Returns the slot names associated with a fact in a */ /* multifield value. Returns FALSE if the fact doesn't */ /* exist. */ /* */ /* (get-fact-list []) */ /* Returns the list of facts visible to the specified */ /* module or to the current module if none is specified. */ /* If * is specified then all facts are returned. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added ppfact function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #define _FACTFUN_SOURCE_ #include "extnfunc.h" #include "envrnmnt.h" #include "argacces.h" #include "prntutil.h" #include "tmpltutl.h" #include "router.h" #include "sysdep.h" #include "factfun.h" /****************************************************/ /* FactFunctionDefinitions: Defines fact functions. */ /****************************************************/ globle void FactFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"fact-existp", 'b', PTIEF FactExistpFunction, "FactExistpFunction", "11z"); EnvDefineFunction2(theEnv,"fact-relation",'w', PTIEF FactRelationFunction,"FactRelationFunction", "11z"); EnvDefineFunction2(theEnv,"fact-slot-value",'u', PTIEF FactSlotValueFunction,"FactSlotValueFunction", "22*zw"); EnvDefineFunction2(theEnv,"fact-slot-names",'u', PTIEF FactSlotNamesFunction,"FactSlotNamesFunction", "11z"); EnvDefineFunction2(theEnv,"get-fact-list",'m',PTIEF GetFactListFunction,"GetFactListFunction","01w"); EnvDefineFunction2(theEnv,"ppfact",'v',PTIEF PPFactFunction,"PPFactFunction","13*z"); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /**********************************************/ /* FactRelationFunction: H/L access routine */ /* for the fact-relation function. */ /**********************************************/ globle void *FactRelationFunction( void *theEnv) { struct fact *theFact; if (EnvArgCountCheck(theEnv,"fact-relation",EXACTLY,1) == -1) return(EnvFalseSymbol(theEnv)); theFact = GetFactAddressOrIndexArgument(theEnv,"fact-relation",1,FALSE); if (theFact == NULL) return(EnvFalseSymbol(theEnv)); return(FactRelation(theFact)); } /**************************************/ /* FactRelation: C access routine for */ /* the fact-relation function. */ /**************************************/ globle void *FactRelation( void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; return((void *) theFact->whichDeftemplate->header.name); } /****************************************/ /* EnvFactDeftemplate: C access routine */ /* to retrieve a fact's deftemplate. */ /****************************************/ globle void *EnvFactDeftemplate( void *theEnv, void *vTheFact) { #if MAC_XCD #pragma unused(theEnv) #endif struct fact *theFact = (struct fact *) vTheFact; return((void *) theFact->whichDeftemplate); } /********************************************/ /* FactExistpFunction: H/L access routine */ /* for the fact-existp function. */ /********************************************/ globle int FactExistpFunction( void *theEnv) { struct fact *theFact; if (EnvArgCountCheck(theEnv,"fact-existp",EXACTLY,1) == -1) return(-1L); theFact = GetFactAddressOrIndexArgument(theEnv,"fact-existp",1,FALSE); return(EnvFactExistp(theEnv,theFact)); } /***********************************/ /* EnvFactExistp: C access routine */ /* for the fact-existp function. */ /***********************************/ globle int EnvFactExistp( void *theEnv, void *vTheFact) { #if MAC_XCD #pragma unused(theEnv) #endif struct fact *theFact = (struct fact *) vTheFact; if (theFact == NULL) return(FALSE); if (theFact->garbage) return(FALSE); return(TRUE); } /***********************************************/ /* FactSlotValueFunction: H/L access routine */ /* for the fact-slot-value function. */ /***********************************************/ globle void FactSlotValueFunction( void *theEnv, DATA_OBJECT *returnValue) { struct fact *theFact; DATA_OBJECT theValue; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"fact-slot-value",EXACTLY,2) == -1) return; /*================================*/ /* Get the reference to the fact. */ /*================================*/ theFact = GetFactAddressOrIndexArgument(theEnv,"fact-slot-value",1,TRUE); if (theFact == NULL) return; /*===========================*/ /* Get the name of the slot. */ /*===========================*/ if (EnvArgTypeCheck(theEnv,"fact-slot-value",2,SYMBOL,&theValue) == FALSE) { return; } /*=======================*/ /* Get the slot's value. */ /*=======================*/ FactSlotValue(theEnv,theFact,DOToString(theValue),returnValue); } /***************************************/ /* FactSlotValue: C access routine for */ /* the fact-slot-value function. */ /***************************************/ globle void FactSlotValue( void *theEnv, void *vTheFact, const char *theSlotName, DATA_OBJECT *returnValue) { struct fact *theFact = (struct fact *) vTheFact; short position; /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theFact->whichDeftemplate->implied) { if (strcmp(theSlotName,"implied") != 0) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,theSlotName, ValueToString(theFact->whichDeftemplate->header.name),FALSE); return; } } else if (FindSlot(theFact->whichDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,theSlotName),&position) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,theSlotName, ValueToString(theFact->whichDeftemplate->header.name),FALSE); return; } /*==========================*/ /* Return the slot's value. */ /*==========================*/ if (theFact->whichDeftemplate->implied) { EnvGetFactSlot(theEnv,theFact,NULL,returnValue); } else { EnvGetFactSlot(theEnv,theFact,theSlotName,returnValue); } } /***********************************************/ /* FactSlotNamesFunction: H/L access routine */ /* for the fact-slot-names function. */ /***********************************************/ globle void FactSlotNamesFunction( void *theEnv, DATA_OBJECT *returnValue) { struct fact *theFact; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"fact-slot-names",EXACTLY,1) == -1) return; /*================================*/ /* Get the reference to the fact. */ /*================================*/ theFact = GetFactAddressOrIndexArgument(theEnv,"fact-slot-names",1,TRUE); if (theFact == NULL) return; /*=====================*/ /* Get the slot names. */ /*=====================*/ EnvFactSlotNames(theEnv,theFact,returnValue); } /***************************************/ /* EnvFactSlotNames: C access routine */ /* for the fact-slot-names function. */ /***************************************/ globle void EnvFactSlotNames( void *theEnv, void *vTheFact, DATA_OBJECT *returnValue) { struct fact *theFact = (struct fact *) vTheFact; struct multifield *theList; struct templateSlot *theSlot; unsigned long count; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theFact->whichDeftemplate->implied) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,1); theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1); SetMFType(theList,1,SYMBOL); SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied")); SetpValue(returnValue,(void *) theList); return; } /*=================================*/ /* Count the number of slot names. */ /*=================================*/ for (count = 0, theSlot = theFact->whichDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { /* Do Nothing */ } /*=============================================================*/ /* Create a multifield value in which to store the slot names. */ /*=============================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===============================================*/ /* Store the slot names in the multifield value. */ /*===============================================*/ for (count = 1, theSlot = theFact->whichDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theSlot->slotName); } } /*********************************************/ /* GetFactListFunction: H/L access routine */ /* for the get-fact-list function. */ /*********************************************/ globle void GetFactListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*===========================================*/ /* Determine if a module name was specified. */ /*===========================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"get-fact-list",NO_MORE_THAN,1)) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (numArgs == 1) { EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name"); return; } if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name"); return; } theModule = NULL; } } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=====================*/ /* Get the constructs. */ /*=====================*/ EnvGetFactList(theEnv,returnValue,theModule); } /*************************************/ /* EnvGetFactList: C access routine */ /* for the get-fact-list function. */ /*************************************/ globle void EnvGetFactList( void *theEnv, DATA_OBJECT_PTR returnValue, void *vTheModule) { struct fact *theFact; unsigned long count; struct multifield *theList; struct defmodule *theModule = (struct defmodule *) vTheModule; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*============================================*/ /* Count the number of facts to be retrieved. */ /*============================================*/ if (theModule == NULL) { for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 0; theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++) { /* Do Nothing */ } } else { EnvSetCurrentModule(theEnv,(void *) theModule); UpdateDeftemplateScope(theEnv); for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 0; theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++) { /* Do Nothing */ } } /*===========================================================*/ /* Create the multifield value to store the construct names. */ /*===========================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*==================================================*/ /* Store the fact pointers in the multifield value. */ /*==================================================*/ if (theModule == NULL) { for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 1; theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++) { SetMFType(theList,count,FACT_ADDRESS); SetMFValue(theList,count,(void *) theFact); } } else { for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 1; theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++) { SetMFType(theList,count,FACT_ADDRESS); SetMFValue(theList,count,(void *) theFact); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); UpdateDeftemplateScope(theEnv); } /**************************************/ /* PPFactFunction: H/L access routine */ /* for the ppfact function. */ /**************************************/ globle void PPFactFunction( void *theEnv) { struct fact *theFact; int numberOfArguments; const char *logicalName = NULL; /* Avoids warning */ int ignoreDefaults = FALSE; DATA_OBJECT theArg; if ((numberOfArguments = EnvArgRangeCheck(theEnv,"ppfact",1,3)) == -1) return; theFact = GetFactAddressOrIndexArgument(theEnv,"ppfact",1,TRUE); if (theFact == NULL) return; /*===============================================================*/ /* Determine the logical name to which the fact will be printed. */ /*===============================================================*/ if (numberOfArguments == 1) { logicalName = STDOUT; } else { logicalName = GetLogicalName(theEnv,2,STDOUT); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"ppfact"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } } /*=========================================*/ /* Should slot values be printed if they */ /* are the same as the default slot value. */ /*=========================================*/ if (numberOfArguments == 3) { EnvRtnUnknown(theEnv,3,&theArg); if ((theArg.value == EnvFalseSymbol(theEnv)) && (theArg.type == SYMBOL)) { ignoreDefaults = FALSE; } else { ignoreDefaults = TRUE; } } /*============================================================*/ /* Determine if any router recognizes the output destination. */ /*============================================================*/ if (strcmp(logicalName,"nil") == 0) { return; } else if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); return; } EnvPPFact(theEnv,theFact,logicalName,ignoreDefaults); } /*******************************/ /* EnvPPFact: C access routine */ /* for the ppfact function. */ /*******************************/ globle void EnvPPFact( void *theEnv, void *vTheFact, const char *logicalName, int ignoreDefaults) { #if MAC_XCD #pragma unused(theEnv) #endif struct fact *theFact = (struct fact *) vTheFact; if (theFact == NULL) return; if (theFact->garbage) return; PrintFact(theEnv,logicalName,theFact,TRUE,ignoreDefaults); EnvPrintRouter(theEnv,logicalName,"\n"); } /**************************************************************/ /* GetFactAddressOrIndexArgument: Retrieves an argument for a */ /* function which should be a reference to a valid fact. */ /**************************************************************/ globle struct fact *GetFactAddressOrIndexArgument( void *theEnv, const char *theFunction, int position, int noFactError) { DATA_OBJECT item; long long factIndex; struct fact *theFact; char tempBuffer[20]; EnvRtnUnknown(theEnv,position,&item); if (GetType(item) == FACT_ADDRESS) { if (((struct fact *) GetValue(item))->garbage) return(NULL); else return (((struct fact *) GetValue(item))); } else if (GetType(item) == INTEGER) { factIndex = ValueToLong(item.value); if (factIndex < 0) { ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index"); return(NULL); } theFact = FindIndexedFact(theEnv,factIndex); if ((theFact == NULL) && noFactError) { gensprintf(tempBuffer,"f-%lld",factIndex); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return(NULL); } return(theFact); } ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index"); return(NULL); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void *FactDeftemplate( void *vTheFact) { return EnvFactDeftemplate(GetCurrentEnvironment(),vTheFact); } globle int FactExistp( void *vTheFact) { return EnvFactExistp(GetCurrentEnvironment(),vTheFact); } globle void FactSlotNames( void *vTheFact, DATA_OBJECT *returnValue) { EnvFactSlotNames(GetCurrentEnvironment(),vTheFact,returnValue); } globle void GetFactList( DATA_OBJECT_PTR returnValue, void *vTheModule) { EnvGetFactList(GetCurrentEnvironment(),returnValue,vTheModule); } globle void PPFact( void *vTheFact, const char *logicalName, int ignoreDefaults) { EnvPPFact(GetCurrentEnvironment(),vTheFact,logicalName,ignoreDefaults); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/globlbsc.h0000755000175000017500000001031112373753372016201 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Moved WatchGlobals global to defglobalData. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_globlbsc #define _H_globlbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefglobalBasicCommands(void *); LOCALE void UndefglobalCommand(void *); LOCALE intBool EnvUndefglobal(void *,void *); LOCALE void GetDefglobalListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDefglobalList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DefglobalModuleFunction(void *); LOCALE void PPDefglobalCommand(void *); LOCALE int PPDefglobal(void *,const char *,const char *); LOCALE void ListDefglobalsCommand(void *); #if DEBUGGING_FUNCTIONS LOCALE unsigned EnvGetDefglobalWatch(void *,void *); LOCALE void EnvListDefglobals(void *,const char *,void *); LOCALE void EnvSetDefglobalWatch(void *,unsigned,void *); #endif LOCALE void ResetDefglobals(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void GetDefglobalList(DATA_OBJECT_PTR,void *); #if DEBUGGING_FUNCTIONS LOCALE unsigned GetDefglobalWatch(void *); LOCALE void ListDefglobals(const char *,void *); LOCALE void SetDefglobalWatch(unsigned,void *); #endif LOCALE intBool Undefglobal(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_globlbsc */ clips_core_source_630/core/._utility.c0000755000175000017500000000040712464470634016330 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/exprnpsr.c0000755000175000017500000007364112464742046016302 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* EXPRESSION PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Module specifier can be used within an */ /* expression to refer to a deffunction or */ /* defgeneric exported by the specified module, */ /* but not necessarily imported by the current */ /* module. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _EXPRNPSR_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "constant.h" #include "envrnmnt.h" #include "router.h" #include "strngrtr.h" #include "scanner.h" #include "memalloc.h" #include "argacces.h" #include "prntutil.h" #include "cstrnchk.h" #include "extnfunc.h" #include "exprnpsr.h" #include "modulutl.h" #include "prcdrfun.h" #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if (! RUN_TIME) /***************************************************/ /* Function0Parse: Parses a function. Assumes that */ /* none of the function has been parsed yet. */ /***************************************************/ globle struct expr *Function0Parse( void *theEnv, const char *logicalName) { struct token theToken; struct expr *top; /*=================================*/ /* All functions begin with a '('. */ /*=================================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"function calls"); return(NULL); } /*=================================*/ /* Parse the rest of the function. */ /*=================================*/ top = Function1Parse(theEnv,logicalName); return(top); } /*******************************************************/ /* Function1Parse: Parses a function. Assumes that the */ /* opening left parenthesis has already been parsed. */ /*******************************************************/ globle struct expr *Function1Parse( void *theEnv, const char *logicalName) { struct token theToken; struct expr *top; /*========================*/ /* Get the function name. */ /*========================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != SYMBOL) { PrintErrorID(theEnv,"EXPRNPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"A function name must be a symbol\n"); return(NULL); } /*=================================*/ /* Parse the rest of the function. */ /*=================================*/ top = Function2Parse(theEnv,logicalName,ValueToString(theToken.value)); return(top); } /****************************************************/ /* Function2Parse: Parses a function. Assumes that */ /* the opening left parenthesis and function name */ /* have already been parsed. */ /****************************************************/ globle struct expr *Function2Parse( void *theEnv, const char *logicalName, const char *name) { struct FunctionDefinition *theFunction; struct expr *top; int moduleSpecified = FALSE; unsigned position; struct symbolHashNode *moduleName = NULL, *constructName = NULL; #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif /*=========================================================*/ /* Module specification cannot be used in a function call. */ /*=========================================================*/ if ((position = FindModuleSeparator(name)) != FALSE) { moduleName = ExtractModuleName(theEnv,position,name); constructName = ExtractConstructName(theEnv,position,name); moduleSpecified = TRUE; } /*================================*/ /* Has the function been defined? */ /*================================*/ theFunction = FindFunction(theEnv,name); #if DEFGENERIC_CONSTRUCT if (moduleSpecified) { if (ConstructExported(theEnv,"defgeneric",moduleName,constructName) || EnvGetCurrentModule(theEnv) == EnvFindDefmodule(theEnv,ValueToString(moduleName))) { gfunc = (void *) EnvFindDefgenericInModule(theEnv,name); } else { gfunc = NULL; } } else { gfunc = (void *) LookupDefgenericInScope(theEnv,name); } #endif #if DEFFUNCTION_CONSTRUCT #if DEFGENERIC_CONSTRUCT if ((theFunction == NULL) && (gfunc == NULL)) #else if (theFunction == NULL) #endif if (moduleSpecified) { if (ConstructExported(theEnv,"deffunction",moduleName,constructName) || EnvGetCurrentModule(theEnv) == EnvFindDefmodule(theEnv,ValueToString(moduleName))) { dptr = (void *) EnvFindDeffunctionInModule(theEnv,name); } else { dptr = NULL; } } else { dptr = (void *) LookupDeffunctionInScope(theEnv,name); } else dptr = NULL; #endif /*=============================*/ /* Define top level structure. */ /*=============================*/ #if DEFFUNCTION_CONSTRUCT if (dptr != NULL) top = GenConstant(theEnv,PCALL,dptr); else #endif #if DEFGENERIC_CONSTRUCT if (gfunc != NULL) top = GenConstant(theEnv,GCALL,gfunc); else #endif if (theFunction != NULL) top = GenConstant(theEnv,FCALL,theFunction); else { PrintErrorID(theEnv,"EXPRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing function declaration for "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,".\n"); return(NULL); } /*=======================================================*/ /* Check to see if function has its own parsing routine. */ /*=======================================================*/ PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; #if DEFGENERIC_CONSTRUCT || DEFFUNCTION_CONSTRUCT if (top->type == FCALL) #endif { if (theFunction->parser != NULL) { top = (*theFunction->parser)(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } } /*========================================*/ /* Default parsing routine for functions. */ /*========================================*/ top = CollectArguments(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } /*============================================================*/ /* If the function call uses the sequence expansion operator, */ /* its arguments cannot be checked until runtime. */ /*============================================================*/ if (top->value == (void *) FindFunction(theEnv,"(expansion-call)")) { return(top); } /*============================*/ /* Check for argument errors. */ /*============================*/ if ((top->type == FCALL) && EnvGetStaticConstraintChecking(theEnv)) { if (CheckExpressionAgainstRestrictions(theEnv,top,theFunction->restrictions,name)) { ReturnExpression(theEnv,top); return(NULL); } } #if DEFFUNCTION_CONSTRUCT else if (top->type == PCALL) { if (CheckDeffunctionCall(theEnv,top->value,CountArguments(top->argList)) == FALSE) { ReturnExpression(theEnv,top); return(NULL); } } #endif /*========================*/ /* Return the expression. */ /*========================*/ return(top); } /*********************************************************************** NAME : ReplaceSequenceExpansionOps DESCRIPTION : Replaces function calls which have multifield references as arguments into a call to a special function which expands the multifield into single arguments at run-time. Multifield references which are not function arguments are errors INPUTS : 1) The expression 2) The current function call 3) The address of the internal H/L function (expansion-call) 4) The address of the H/L function expand$ RETURNS : FALSE if OK, TRUE on errors SIDE EFFECTS : Function call expressions modified, if necessary NOTES : Function calls which truly want a multifield to be passed need use only a single-field refernce (i.e. ? instead of $? - the $ is being treated as a special expansion operator) **********************************************************************/ globle intBool ReplaceSequenceExpansionOps( void *theEnv, EXPRESSION *actions, EXPRESSION *fcallexp, void *expcall, void *expmult) { EXPRESSION *theExp; while (actions != NULL) { if ((ExpressionData(theEnv)->SequenceOpMode == FALSE) && (actions->type == MF_VARIABLE)) actions->type = SF_VARIABLE; if ((actions->type == MF_VARIABLE) || (actions->type == MF_GBL_VARIABLE) || (actions->value == expmult)) { if ((fcallexp->type != FCALL) ? FALSE : (((struct FunctionDefinition *) fcallexp->value)->sequenceuseok == FALSE)) { PrintErrorID(theEnv,"EXPRNPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"$ Sequence operator not a valid argument for "); EnvPrintRouter(theEnv,WERROR,ValueToString(((struct FunctionDefinition *) fcallexp->value)->callFunctionName)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (fcallexp->value != expcall) { theExp = GenConstant(theEnv,fcallexp->type,fcallexp->value); theExp->argList = fcallexp->argList; theExp->nextArg = NULL; fcallexp->type = FCALL; fcallexp->value = expcall; fcallexp->argList = theExp; } if (actions->value != expmult) { theExp = GenConstant(theEnv,SF_VARIABLE,actions->value); if (actions->type == MF_GBL_VARIABLE) theExp->type = GBL_VARIABLE; actions->argList = theExp; actions->type = FCALL; actions->value = expmult; } } if (actions->argList != NULL) { if ((actions->type == GCALL) || (actions->type == PCALL) || (actions->type == FCALL)) theExp = actions; else theExp = fcallexp; if (ReplaceSequenceExpansionOps(theEnv,actions->argList,theExp,expcall,expmult)) return(TRUE); } actions = actions->nextArg; } return(FALSE); } /*************************************************/ /* PushRtnBrkContexts: Saves the current context */ /* for the break/return functions. */ /*************************************************/ globle void PushRtnBrkContexts( void *theEnv) { SAVED_CONTEXTS *svtmp; svtmp = get_struct(theEnv,saved_contexts); svtmp->rtn = ExpressionData(theEnv)->ReturnContext; svtmp->brk = ExpressionData(theEnv)->BreakContext; svtmp->nxt = ExpressionData(theEnv)->svContexts; ExpressionData(theEnv)->svContexts = svtmp; } /***************************************************/ /* PopRtnBrkContexts: Restores the current context */ /* for the break/return functions. */ /***************************************************/ globle void PopRtnBrkContexts( void *theEnv) { SAVED_CONTEXTS *svtmp; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk; svtmp = ExpressionData(theEnv)->svContexts; ExpressionData(theEnv)->svContexts = ExpressionData(theEnv)->svContexts->nxt; rtn_struct(theEnv,saved_contexts,svtmp); } /*****************************************************************/ /* CheckExpressionAgainstRestrictions: Compares the arguments to */ /* a function to the set of restrictions for that function to */ /* determine if any incompatibilities exist. If so, the value */ /* TRUE is returned, otherwise FALSE is returned. */ /*****************************************************************/ globle int CheckExpressionAgainstRestrictions( void *theEnv, struct expr *theExpression, const char *restrictions, const char *functionName) { char theChar[2]; int i = 0, j = 1; int number1, number2; int argCount; char defaultRestriction, argRestriction; struct expr *argPtr; int theRestriction; theChar[0] = '0'; theChar[1] = '\0'; /*============================================*/ /* If there are no restrictions, then there's */ /* no need to check the function. */ /*============================================*/ if (restrictions == NULL) return(FALSE); /*=========================================*/ /* Count the number of function arguments. */ /*=========================================*/ argCount = CountArguments(theExpression->argList); /*======================================*/ /* Get the minimum number of arguments. */ /*======================================*/ theChar[0] = restrictions[i++]; if (isdigit(theChar[0])) { number1 = atoi(theChar); } else if (theChar[0] == '*') { number1 = -1; } else { return(FALSE); } /*======================================*/ /* Get the maximum number of arguments. */ /*======================================*/ theChar[0] = restrictions[i++]; if (isdigit(theChar[0])) { number2 = atoi(theChar); } else if (theChar[0] == '*') { number2 = 10000; } else { return(FALSE); } /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (number1 == number2) { if (argCount != number1) { ExpectedCountError(theEnv,functionName,EXACTLY,number1); return(TRUE); } } else if (argCount < number1) { ExpectedCountError(theEnv,functionName,AT_LEAST,number1); return(TRUE); } else if (argCount > number2) { ExpectedCountError(theEnv,functionName,NO_MORE_THAN,number2); return(TRUE); } /*=======================================*/ /* Check for the default argument types. */ /*=======================================*/ defaultRestriction = restrictions[i]; if (defaultRestriction == '\0') { defaultRestriction = 'u'; } else if (defaultRestriction == '*') { defaultRestriction = 'u'; i++; } else { i++; } /*======================*/ /* Check each argument. */ /*======================*/ for (argPtr = theExpression->argList; argPtr != NULL; argPtr = argPtr->nextArg) { argRestriction = restrictions[i]; if (argRestriction == '\0') { argRestriction = defaultRestriction; } else { i++; } if (argRestriction != '*') { theRestriction = (int) argRestriction; } else { theRestriction = (int) defaultRestriction; } if (CheckArgumentAgainstRestriction(theEnv,argPtr,theRestriction)) { ExpectedTypeError1(theEnv,functionName,j,GetArgumentTypeName(theRestriction)); return(TRUE); } j++; } return(FALSE); } /*******************************************************/ /* CollectArguments: Parses and groups together all of */ /* the arguments for a function call expression. */ /*******************************************************/ globle struct expr *CollectArguments( void *theEnv, struct expr *top, const char *logicalName) { int errorFlag; struct expr *lastOne, *nextOne; /*========================================*/ /* Default parsing routine for functions. */ /*========================================*/ lastOne = NULL; while (TRUE) { SavePPBuffer(theEnv," "); errorFlag = FALSE; nextOne = ArgumentParse(theEnv,logicalName,&errorFlag); if (errorFlag == TRUE) { ReturnExpression(theEnv,top); return(NULL); } if (nextOne == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(top); } if (lastOne == NULL) { top->argList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; } } /********************************************/ /* ArgumentParse: Parses an argument within */ /* a function call expression. */ /********************************************/ globle struct expr *ArgumentParse( void *theEnv, const char *logicalName, int *errorFlag) { struct expr *top; struct token theToken; /*===============*/ /* Grab a token. */ /*===============*/ GetToken(theEnv,logicalName,&theToken); /*============================*/ /* ')' counts as no argument. */ /*============================*/ if (theToken.type == RPAREN) { return(NULL); } /*================================*/ /* Parse constants and variables. */ /*================================*/ if ((theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE) || (theToken.type == SYMBOL) || (theToken.type == STRING) || #if DEFGLOBAL_CONSTRUCT (theToken.type == GBL_VARIABLE) || (theToken.type == MF_GBL_VARIABLE) || #endif #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == FLOAT) || (theToken.type == INTEGER)) { return(GenConstant(theEnv,theToken.type,theToken.value)); } /*======================*/ /* Parse function call. */ /*======================*/ if (theToken.type != LPAREN) { PrintErrorID(theEnv,"EXPRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression.\n"); *errorFlag = TRUE; return(NULL); } top = Function1Parse(theEnv,logicalName); if (top == NULL) *errorFlag = TRUE; return(top); } /************************************************************/ /* ParseAtomOrExpression: Parses an expression which may be */ /* a function call, atomic value (string, symbol, etc.), */ /* or variable (local or global). */ /************************************************************/ globle struct expr *ParseAtomOrExpression( void *theEnv, const char *logicalName, struct token *useToken) { struct token theToken, *thisToken; struct expr *rv; if (useToken == NULL) { thisToken = &theToken; GetToken(theEnv,logicalName,thisToken); } else thisToken = useToken; if ((thisToken->type == SYMBOL) || (thisToken->type == STRING) || (thisToken->type == INTEGER) || (thisToken->type == FLOAT) || #if OBJECT_SYSTEM (thisToken->type == INSTANCE_NAME) || #endif #if DEFGLOBAL_CONSTRUCT (thisToken->type == GBL_VARIABLE) || (thisToken->type == MF_GBL_VARIABLE) || #endif (thisToken->type == SF_VARIABLE) || (thisToken->type == MF_VARIABLE)) { rv = GenConstant(theEnv,thisToken->type,thisToken->value); } else if (thisToken->type == LPAREN) { rv = Function1Parse(theEnv,logicalName); if (rv == NULL) return(NULL); } else { PrintErrorID(theEnv,"EXPRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression.\n"); return(NULL); } return(rv); } /*********************************************/ /* GroupActions: Groups together a series of */ /* actions within a progn expression. Used */ /* for example to parse the RHS of a rule. */ /*********************************************/ globle struct expr *GroupActions( void *theEnv, const char *logicalName, struct token *theToken, int readFirstToken, const char *endWord, int functionNameParsed) { struct expr *top, *nextOne, *lastOne = NULL; /*=============================*/ /* Create the enclosing progn. */ /*=============================*/ top = GenConstant(theEnv,FCALL,FindFunction(theEnv,"progn")); /*========================================================*/ /* Continue until all appropriate commands are processed. */ /*========================================================*/ while (TRUE) { /*================================================*/ /* Skip reading in the token if this is the first */ /* pass and the initial token was already read */ /* before calling this function. */ /*================================================*/ if (readFirstToken) { GetToken(theEnv,logicalName,theToken); } else { readFirstToken = TRUE; } /*=================================================*/ /* Look to see if a symbol has terminated the list */ /* of actions (such as "else" in an if function). */ /*=================================================*/ if ((theToken->type == SYMBOL) && (endWord != NULL) && (! functionNameParsed)) { if (strcmp(ValueToString(theToken->value),endWord) == 0) { return(top); } } /*====================================*/ /* Process a function if the function */ /* name has already been read. */ /*====================================*/ if (functionNameParsed) { nextOne = Function2Parse(theEnv,logicalName,ValueToString(theToken->value)); functionNameParsed = FALSE; } /*========================================*/ /* Process a constant or global variable. */ /*========================================*/ else if ((theToken->type == SYMBOL) || (theToken->type == STRING) || (theToken->type == INTEGER) || (theToken->type == FLOAT) || #if DEFGLOBAL_CONSTRUCT (theToken->type == GBL_VARIABLE) || (theToken->type == MF_GBL_VARIABLE) || #endif #if OBJECT_SYSTEM (theToken->type == INSTANCE_NAME) || #endif (theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE)) { nextOne = GenConstant(theEnv,theToken->type,theToken->value); } /*=============================*/ /* Otherwise parse a function. */ /*=============================*/ else if (theToken->type == LPAREN) { nextOne = Function1Parse(theEnv,logicalName); } /*======================================*/ /* Otherwise replace sequence expansion */ /* variables and return the expression. */ /*======================================*/ else { if (ReplaceSequenceExpansionOps(theEnv,top,NULL, FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } /*===========================*/ /* Add the new action to the */ /* list of progn arguments. */ /*===========================*/ if (nextOne == NULL) { theToken->type = UNKNOWN_VALUE; ReturnExpression(theEnv,top); return(NULL); } if (lastOne == NULL) { top->argList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; PPCRAndIndent(theEnv); } } #endif /* (! RUN_TIME) */ /********************************************************/ /* EnvSetSequenceOperatorRecognition: C access routine */ /* for the set-sequence-operator-recognition function */ /********************************************************/ globle intBool EnvSetSequenceOperatorRecognition( void *theEnv, int value) { int ov; ov = ExpressionData(theEnv)->SequenceOpMode; ExpressionData(theEnv)->SequenceOpMode = value; return(ov); } /********************************************************/ /* EnvSetSequenceOperatorRecognition: C access routine */ /* for the Get-sequence-operator-recognition function */ /********************************************************/ globle intBool EnvGetSequenceOperatorRecognition( void *theEnv) { return(ExpressionData(theEnv)->SequenceOpMode); } /*******************************************/ /* ParseConstantArguments: Parses a string */ /* into a set of constant expressions. */ /*******************************************/ globle EXPRESSION *ParseConstantArguments( void *theEnv, const char *argstr, int *error) { EXPRESSION *top = NULL,*bot = NULL,*tmp; const char *router = "***FNXARGS***"; struct token tkn; *error = FALSE; if (argstr == NULL) return(NULL); /*=====================================*/ /* Open the string as an input source. */ /*=====================================*/ if (OpenStringSource(theEnv,router,argstr,0) == 0) { PrintErrorID(theEnv,"EXPRNPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot read arguments for external call.\n"); *error = TRUE; return(NULL); } /*======================*/ /* Parse the constants. */ /*======================*/ GetToken(theEnv,router,&tkn); while (tkn.type != STOP) { if ((tkn.type != SYMBOL) && (tkn.type != STRING) && (tkn.type != FLOAT) && (tkn.type != INTEGER) && (tkn.type != INSTANCE_NAME)) { PrintErrorID(theEnv,"EXPRNPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Only constant arguments allowed for external function call.\n"); ReturnExpression(theEnv,top); *error = TRUE; CloseStringSource(theEnv,router); return(NULL); } tmp = GenConstant(theEnv,tkn.type,tkn.value); if (top == NULL) top = tmp; else bot->nextArg = tmp; bot = tmp; GetToken(theEnv,router,&tkn); } /*================================*/ /* Close the string input source. */ /*================================*/ CloseStringSource(theEnv,router); /*=======================*/ /* Return the arguments. */ /*=======================*/ return(top); } /*********************************************/ /* RemoveUnneededProgn: */ /*********************************************/ globle struct expr *RemoveUnneededProgn( void *theEnv, struct expr *theExpression) { struct FunctionDefinition *fptr; struct expr *temp; if (theExpression == NULL) return(theExpression); if (theExpression->type != FCALL) return(theExpression); fptr = (struct FunctionDefinition *) theExpression->value; if (fptr->functionPointer != PTIF PrognFunction) { return(theExpression); } if ((theExpression->argList != NULL) && (theExpression->argList->nextArg == NULL)) { temp = theExpression; theExpression = theExpression->argList; temp->argList = NULL; temp->nextArg = NULL; ReturnExpression(theEnv,temp); } return(theExpression); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool SetSequenceOperatorRecognition( int value) { return EnvSetSequenceOperatorRecognition(GetCurrentEnvironment(),value); } globle intBool GetSequenceOperatorRecognition() { return EnvGetSequenceOperatorRecognition(GetCurrentEnvironment()); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/argacces.c0000755000175000017500000011642612424476360016167 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* ARGUMENT ACCESS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides access routines for accessing arguments */ /* passed to user or system functions defined using the */ /* DefineFunction protocol. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added IllegalLogicalNameMessage function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Support for fact-address arguments. */ /* */ /*************************************************************/ #define _ARGACCES_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "envrnmnt.h" #include "extnfunc.h" #include "router.h" #include "cstrnchk.h" #include "insfun.h" #include "factmngr.h" #include "prntutil.h" #include "sysdep.h" #include "argacces.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void NonexistantError(void *,const char *,const char *,int); static void ExpectedTypeError3(void *,const char *,const char *,int,const char *); /*******************************************************************/ /* EnvRtnLexeme: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved must be a symbol, string, or */ /* instance name, otherwise an error is generated. Only the */ /* value of the argument is returned (i.e. the string "a" would */ /* be returned for a, "a", and [a]). */ /*******************************************************************/ globle const char *EnvRtnLexeme( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*============================================*/ /* Return the value of the nth argument if it */ /* is a symbol, string, or instance name. */ /*============================================*/ EvaluateExpression(theEnv,argPtr,&result); if ((result.type == SYMBOL) || #if OBJECT_SYSTEM (result.type == INSTANCE_NAME) || #endif (result.type == STRING)) { return(ValueToString(result.value));} /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"symbol, string, or instance name"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*******************************************************************/ /* EnvRtnDouble: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved must be a either a float or */ /* an integer (type conversion to a float is performed for */ /* integers), otherwise an error is generated. Only the value of */ /* the argument is returned (i.e. the float 3.0 would be */ /* returned for 3.0 and 3). */ /*******************************************************************/ globle double EnvRtnDouble( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnDouble", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1.0); } /*======================================*/ /* Return the value of the nth argument */ /* if it is a float or integer. */ /*======================================*/ EvaluateExpression(theEnv,argPtr,&result); if (result.type == FLOAT) { return(ValueToDouble(result.value)); } else if (result.type == INTEGER) { return((double) ValueToLong(result.value)); } /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnDouble", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1.0); } /*****************************************************************/ /* EnvRtnLong: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved must be a either a float */ /* or an integer (type conversion to an integer is performed */ /* for floats), otherwise an error is generated. Only the */ /* value of the argument is returned (i.e. the integer 4 */ /* would be returned for 4.3 and 4). */ /*****************************************************************/ globle long long EnvRtnLong( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } /*======================================*/ /* Return the value of the nth argument */ /* if it is a float or integer. */ /*======================================*/ EvaluateExpression(theEnv,argPtr,&result); if (result.type == FLOAT) { return((long) ValueToDouble(result.value)); } else if (result.type == INTEGER) { return(ValueToLong(result.value)); } /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } /********************************************************************/ /* EnvRtnUnknown: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved can be of any type. The value */ /* and type of the argument are returned in a DATA_OBJECT */ /* structure provided by the calling function. */ /********************************************************************/ globle DATA_OBJECT_PTR EnvRtnUnknown( void *theEnv, int argumentPosition, DATA_OBJECT_PTR returnValue) { int count = 1; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnUnknown", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*=======================================*/ /* Return the value of the nth argument. */ /*=======================================*/ EvaluateExpression(theEnv,argPtr,returnValue); return(returnValue); } /***********************************************************/ /* EnvRtnArgCount: Returns the length of the argument list */ /* for the function call currently being evaluated. */ /***********************************************************/ globle int EnvRtnArgCount( void *theEnv) { int count = 0; struct expr *argPtr; for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; argPtr != NULL; argPtr = argPtr->nextArg) { count++; } return(count); } /************************************************************************/ /* EnvArgCountCheck: Given the expected number of arguments, determines */ /* if the function currently being evaluated has the correct number */ /* of arguments. Three types of argument checking are provided by */ /* this function: 1) The function has exactly the expected number of */ /* arguments; 2) The function has at least the expected number of */ /* arguments; 3) The function has at most the expected number of */ /* arguments. The number of arguments is returned if no error occurs, */ /* otherwise -1 is returned. */ /************************************************************************/ globle int EnvArgCountCheck( void *theEnv, const char *functionName, int countRelation, int expectedNumber) { int numberOfArguments; /*==============================================*/ /* Get the number of arguments for the function */ /* currently being evaluated. */ /*==============================================*/ numberOfArguments = EnvRtnArgCount(theEnv); /*=========================================================*/ /* If the function satisfies expected number of arguments, */ /* constraint, then return the number of arguments found. */ /*=========================================================*/ if (countRelation == EXACTLY) { if (numberOfArguments == expectedNumber) return(numberOfArguments); } else if (countRelation == AT_LEAST) { if (numberOfArguments >= expectedNumber) return(numberOfArguments); } else if (countRelation == NO_MORE_THAN) { if (numberOfArguments <= expectedNumber) return(numberOfArguments); } /*================================================*/ /* The correct number of arguments was not found. */ /* Generate an error message and return -1. */ /*================================================*/ ExpectedCountError(theEnv,functionName,countRelation,expectedNumber); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } /****************************************************************/ /* EnvArgRangeCheck: Checks that the number of arguments passed */ /* to a function falls within a specified minimum and maximum */ /* range. The number of arguments passed to the function is */ /* returned if no error occurs, otherwise -1 is returned. */ /****************************************************************/ globle int EnvArgRangeCheck( void *theEnv, const char *functionName, int min, int max) { int numberOfArguments; numberOfArguments = EnvRtnArgCount(theEnv); if ((numberOfArguments < min) || (numberOfArguments > max)) { PrintErrorID(theEnv,"ARGACCES",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," expected at least "); PrintLongInteger(theEnv,WERROR,(long) min); EnvPrintRouter(theEnv,WERROR," and no more than "); PrintLongInteger(theEnv,WERROR,(long) max); EnvPrintRouter(theEnv,WERROR," arguments.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } return(numberOfArguments); } /*************************************************************/ /* EnvArgTypeCheck: Retrieves the nth argument passed to the */ /* function call currently being evaluated and determines */ /* if it matches a specified type. Returns TRUE if the */ /* argument was successfully retrieved and is of the */ /* appropriate type, otherwise returns FALSE. */ /*************************************************************/ globle int EnvArgTypeCheck( void *theEnv, const char *functionName, int argumentPosition, int expectedType, DATA_OBJECT_PTR returnValue) { /*========================*/ /* Retrieve the argument. */ /*========================*/ EnvRtnUnknown(theEnv,argumentPosition,returnValue); if (EvaluationData(theEnv)->EvaluationError) return(FALSE); /*========================================*/ /* If the argument's type exactly matches */ /* the expected type, then return TRUE. */ /*========================================*/ if (returnValue->type == expectedType) return (TRUE); /*=============================================================*/ /* Some expected types encompass more than one primitive type. */ /* If the argument's type matches one of the primitive types */ /* encompassed by the expected type, then return TRUE. */ /*=============================================================*/ if ((expectedType == INTEGER_OR_FLOAT) && ((returnValue->type == INTEGER) || (returnValue->type == FLOAT))) { return(TRUE); } if ((expectedType == SYMBOL_OR_STRING) && ((returnValue->type == SYMBOL) || (returnValue->type == STRING))) { return(TRUE); } #if OBJECT_SYSTEM if (((expectedType == SYMBOL_OR_STRING) || (expectedType == SYMBOL)) && (returnValue->type == INSTANCE_NAME)) { return(TRUE); } if ((expectedType == INSTANCE_NAME) && ((returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL))) { return(TRUE); } if ((expectedType == INSTANCE_OR_INSTANCE_NAME) && ((returnValue->type == INSTANCE_ADDRESS) || (returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL))) { return(TRUE); } #endif /*===========================================================*/ /* If the expected type is float and the argument's type is */ /* integer (or vice versa), then convert the argument's type */ /* to match the expected type and then return TRUE. */ /*===========================================================*/ if ((returnValue->type == INTEGER) && (expectedType == FLOAT)) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,(double) ValueToLong(returnValue->value)); return(TRUE); } if ((returnValue->type == FLOAT) && (expectedType == INTEGER)) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,(long long) ValueToDouble(returnValue->value)); return(TRUE); } /*=====================================================*/ /* The argument's type didn't match the expected type. */ /* Print an error message and return FALSE. */ /*=====================================================*/ if (expectedType == FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"float"); else if (expectedType == INTEGER) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer"); else if (expectedType == SYMBOL) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol"); else if (expectedType == STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"string"); else if (expectedType == MULTIFIELD) ExpectedTypeError1(theEnv,functionName,argumentPosition,"multifield"); else if (expectedType == INTEGER_OR_FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer or float"); else if (expectedType == SYMBOL_OR_STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol or string"); else if (expectedType == FACT_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"fact address"); #if OBJECT_SYSTEM else if (expectedType == INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance name"); else if (expectedType == INSTANCE_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address"); else if (expectedType == INSTANCE_OR_INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address or instance name"); #endif SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(FALSE); } /******************************************************************/ /* GetNumericArgument: Evaluates an expression to yield a numeric */ /* argument. This provides quicker retrieval than using some of */ /* the other argument access routines. The numeric argument is */ /* returned in a DATA_OBJECT supplied by the calling function. */ /* TRUE is returned if a numeric argument was successfully */ /* retrieved, otherwise FALSE is returned. */ /******************************************************************/ globle intBool GetNumericArgument( void *theEnv, struct expr *theArgument, const char *functionName, DATA_OBJECT *result, intBool convertToFloat, int whichArgument) { unsigned short theType; void *theValue; /*==================================================================*/ /* Evaluate the expression (don't bother calling EvaluateExpression */ /* if the type is float or integer). */ /*==================================================================*/ switch(theArgument->type) { case FLOAT: case INTEGER: theType = theArgument->type; theValue = theArgument->value; break; default: EvaluateExpression(theEnv,theArgument,result); theType = result->type; theValue = result->value; break; } /*==========================================*/ /* If the argument is not float or integer, */ /* print an error message and return FALSE. */ /*==========================================*/ if ((theType != FLOAT) && (theType != INTEGER)) { ExpectedTypeError1(theEnv,functionName,whichArgument,"integer or float"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0LL); return(FALSE); } /*==========================================================*/ /* If the argument is an integer and the "convert to float" */ /* flag is TRUE, then convert the integer to a float. */ /*==========================================================*/ if ((convertToFloat) && (theType == INTEGER)) { theType = FLOAT; theValue = (void *) EnvAddDouble(theEnv,(double) ValueToLong(theValue)); } /*============================================================*/ /* The numeric argument was successfully retrieved. Store the */ /* argument in the user supplied DATA_OBJECT and return TRUE. */ /*============================================================*/ result->type = theType; result->value = theValue; return(TRUE); } /*********************************************************************/ /* GetLogicalName: Retrieves the nth argument passed to the function */ /* call currently being evaluated and determines if it is a valid */ /* logical name. If valid, the logical name is returned, otherwise */ /* NULL is returned. */ /*********************************************************************/ globle const char *GetLogicalName( void *theEnv, int whichArgument, const char *defaultLogicalName) { const char *logicalName; DATA_OBJECT result; EnvRtnUnknown(theEnv,whichArgument,&result); if ((GetType(result) == SYMBOL) || (GetType(result) == STRING) || (GetType(result) == INSTANCE_NAME)) { logicalName = ValueToString(result.value); if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0)) { logicalName = defaultLogicalName; } } else if (GetType(result) == FLOAT) { logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result)))); } else if (GetType(result) == INTEGER) { logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result)))); } else { logicalName = NULL; } return(logicalName); } /************************************************************/ /* GetFileName: Retrieves the nth argument passed to the */ /* function call currently being evaluated and determines */ /* if it is a valid file name. If valid, the file name is */ /* returned, otherwise NULL is returned. */ /************************************************************/ globle const char *GetFileName( void *theEnv, const char *functionName, int whichArgument) { DATA_OBJECT result; EnvRtnUnknown(theEnv,whichArgument,&result); if ((GetType(result) != STRING) && (GetType(result) != SYMBOL)) { ExpectedTypeError1(theEnv,functionName,whichArgument,"file name"); return(NULL); } return(DOToString(result)); } /******************************************************************/ /* OpenErrorMessage: Generalized error message for opening files. */ /******************************************************************/ globle void OpenErrorMessage( void *theEnv, const char *functionName, const char *fileName) { PrintErrorID(theEnv,"ARGACCES",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," was unable to open file "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR,".\n"); } /************************************************************/ /* GetModuleName: Retrieves the nth argument passed to the */ /* function call currently being evaluated and determines */ /* if it is a valid module name. If valid, the module */ /* name is returned or NULL is returned to indicate all */ /* modules. */ /************************************************************/ globle struct defmodule *GetModuleName( void *theEnv, const char *functionName, int whichArgument, int *error) { DATA_OBJECT result; struct defmodule *theModule; *error = FALSE; /*========================*/ /* Retrieve the argument. */ /*========================*/ EnvRtnUnknown(theEnv,whichArgument,&result); /*=================================*/ /* A module name must be a symbol. */ /*=================================*/ if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name"); *error = TRUE; return(NULL); } /*=======================================*/ /* Check to see that the symbol actually */ /* corresponds to a defined module. */ /*=======================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name"); *error = TRUE; } return(NULL); } /*=================================*/ /* Return a pointer to the module. */ /*=================================*/ return(theModule); } /****************************************************************/ /* GetConstructName: Retrieves the 1st argument passed to the */ /* function call currently being evaluated and determines if */ /* it is a valid name for a construct. Also checks that the */ /* function is only passed a single argument. This routine */ /* is used by functions such as ppdeftemplate, undefrule, */ /* etc... to retrieve the construct name on which to operate. */ /****************************************************************/ globle const char *GetConstructName( void *theEnv, const char *functionName, const char *constructType) { DATA_OBJECT result; if (EnvRtnArgCount(theEnv) != 1) { ExpectedCountError(theEnv,functionName,EXACTLY,1); return(NULL); } EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,1,constructType); return(NULL); } return(DOToString(result)); } /**************************************************************************/ /* NonexistantError: Prints the error message for a nonexistant argument. */ /**************************************************************************/ static void NonexistantError( void *theEnv, const char *accessFunction, const char *functionName, int argumentPosition) { PrintErrorID(theEnv,"ARGACCES",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,accessFunction); EnvPrintRouter(theEnv,WERROR," received a request from function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," for argument #"); PrintLongInteger(theEnv,WERROR,(long int) argumentPosition); EnvPrintRouter(theEnv,WERROR," which is non-existent\n"); } /*********************************************************/ /* ExpectedCountError: Prints the error message for an */ /* incorrect number of arguments passed to a function. */ /*********************************************************/ globle void ExpectedCountError( void *theEnv, const char *functionName, int countRelation, int expectedNumber) { PrintErrorID(theEnv,"ARGACCES",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); if (countRelation == EXACTLY) { EnvPrintRouter(theEnv,WERROR," expected exactly "); } else if (countRelation == AT_LEAST) { EnvPrintRouter(theEnv,WERROR," expected at least "); } else if (countRelation == NO_MORE_THAN) { EnvPrintRouter(theEnv,WERROR," expected no more than "); } else { EnvPrintRouter(theEnv,WERROR," generated an illegal argument check for "); } PrintLongInteger(theEnv,WERROR,(long int) expectedNumber); EnvPrintRouter(theEnv,WERROR," argument(s)\n"); } /*************************************************************/ /* NAME : CheckFunctionArgCount */ /* DESCRIPTION : Checks the number of arguments against */ /* the system function restriction list */ /* INPUTS : 1) Name of the calling function */ /* 2) The restriction list can be NULL */ /* 3) The number of arguments */ /* RETURNS : TRUE if OK, FALSE otherwise */ /* SIDE EFFECTS : EvaluationError set on errrors */ /* NOTES : Used to check generic function implicit */ /* method (system function) calls and system */ /* function calls which have the sequence */ /* expansion operator in their argument list */ /*************************************************************/ globle intBool CheckFunctionArgCount( void *theEnv, const char *functionName, const char *restrictions, int argumentCount) { register int minArguments, maxArguments; char theChar[2]; theChar[0] = '0'; theChar[1] = EOS; /*=====================================================*/ /* If there are no restrictions, then there is no need */ /* to check for the correct number of arguments. */ /*=====================================================*/ if (restrictions == NULL) return(TRUE); /*===========================================*/ /* Determine the minimum number of arguments */ /* required by the function. */ /*===========================================*/ if (isdigit(restrictions[0])) { theChar[0] = restrictions[0]; minArguments = atoi(theChar); } else { minArguments = -1; } /*===========================================*/ /* Determine the maximum number of arguments */ /* required by the function. */ /*===========================================*/ if (isdigit(restrictions[1])) { theChar[0] = restrictions[1]; maxArguments = atoi(theChar); } else { maxArguments = 10000; } /*==============================================*/ /* If the function expects exactly N arguments, */ /* then check to see if there are N arguments. */ /*==============================================*/ if (minArguments == maxArguments) { if (argumentCount != minArguments) { ExpectedCountError(theEnv,functionName,EXACTLY,minArguments); SetEvaluationError(theEnv,TRUE); return(FALSE); } return(TRUE); } /*==================================*/ /* Check to see if there were fewer */ /* arguments passed than expected. */ /*==================================*/ if (argumentCount < minArguments) { ExpectedCountError(theEnv,functionName,AT_LEAST,minArguments); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*=================================*/ /* Check to see if there were more */ /* arguments passed than expected. */ /*=================================*/ if (argumentCount > maxArguments) { ExpectedCountError(theEnv,functionName,NO_MORE_THAN,maxArguments); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*===============================*/ /* The number of arguments falls */ /* within the expected range. */ /*===============================*/ return(TRUE); } /*******************************************************************/ /* ExpectedTypeError1: Prints the error message for the wrong type */ /* of argument passed to a user or system defined function. The */ /* expected type is passed as a string to this function. */ /*******************************************************************/ globle void ExpectedTypeError1( void *theEnv, const char *functionName, int whichArg, const char *expectedType) { PrintErrorID(theEnv,"ARGACCES",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," expected argument #"); PrintLongInteger(theEnv,WERROR,(long int) whichArg); EnvPrintRouter(theEnv,WERROR," to be of type "); EnvPrintRouter(theEnv,WERROR,expectedType); EnvPrintRouter(theEnv,WERROR,"\n"); } /**************************************************************/ /* ExpectedTypeError2: Prints the error message for the wrong */ /* type of argument passed to a user or system defined */ /* function. The expected type is derived by examining the */ /* function's argument restriction list. */ /**************************************************************/ globle void ExpectedTypeError2( void *theEnv, const char *functionName, int whichArg) { struct FunctionDefinition *theFunction; const char *theType; theFunction = FindFunction(theEnv,functionName); if (theFunction == NULL) return; theType = GetArgumentTypeName(GetNthRestriction(theFunction,whichArg)); ExpectedTypeError1(theEnv,functionName,whichArg,theType); } /*******************************************************************/ /* ExpectedTypeError3: Prints the error message for the wrong type */ /* of argument passed to a user or system defined function when */ /* the argument was requested by calling RtnLexeme, RtnLong, or */ /* RtnDouble. */ /*******************************************************************/ static void ExpectedTypeError3( void *theEnv, const char *accessFunction, const char *functionName, int argumentPosition, const char *type) { PrintErrorID(theEnv,"ARGACCES",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,accessFunction); EnvPrintRouter(theEnv,WERROR," received a request from function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," for argument #"); PrintLongInteger(theEnv,WERROR,(long int) argumentPosition); EnvPrintRouter(theEnv,WERROR," which is not of type "); EnvPrintRouter(theEnv,WERROR,type); EnvPrintRouter(theEnv,WERROR,"\n"); } /***************************************************/ /* GetFactOrInstanceArgument: Utility routine for */ /* retrieving a fact or instance argument */ /***************************************************/ void *GetFactOrInstanceArgument( void *theEnv, int thePosition, DATA_OBJECT *item, const char *functionName) { #if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM void *ptr; #endif /*==============================*/ /* Retrieve the first argument. */ /*==============================*/ EnvRtnUnknown(theEnv,thePosition,item); /*==================================================*/ /* Fact and instance addresses are valid arguments. */ /*==================================================*/ if ((GetpType(item) == FACT_ADDRESS) || (GetpType(item) == INSTANCE_ADDRESS)) { return(GetpValue(item)); } /*==================================================*/ /* An integer is a valid argument if it corresponds */ /* to the fact index of an existing fact. */ /*==================================================*/ #if DEFTEMPLATE_CONSTRUCT else if (GetpType(item) == INTEGER) { if ((ptr = (void *) FindIndexedFact(theEnv,DOPToLong(item))) == NULL) { char tempBuffer[20]; gensprintf(tempBuffer,"f-%lld",DOPToLong(item)); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); } return(ptr); } #endif /*================================================*/ /* Instance names and symbols are valid arguments */ /* if they correspond to an existing instance. */ /*================================================*/ #if OBJECT_SYSTEM else if ((GetpType(item) == INSTANCE_NAME) || (GetpType(item) == SYMBOL)) { if ((ptr = (void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) GetpValue(item))) == NULL) { CantFindItemErrorMessage(theEnv,"instance",ValueToString(GetpValue(item))); } return(ptr); } #endif /*========================================*/ /* Any other type is an invalid argument. */ /*========================================*/ ExpectedTypeError2(theEnv,functionName,thePosition); return(NULL); } /****************************************************/ /* IllegalLogicalNameMessage: Generic error message */ /* for illegal logical names. */ /****************************************************/ void IllegalLogicalNameMessage( void *theEnv, const char *theFunction) { PrintErrorID(theEnv,"IOFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal logical name used for "); EnvPrintRouter(theEnv,WERROR,theFunction); EnvPrintRouter(theEnv,WERROR," function.\n"); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle int ArgCountCheck( const char *functionName, int countRelation, int expectedNumber) { return EnvArgCountCheck(GetCurrentEnvironment(),functionName,countRelation,expectedNumber); } globle int ArgRangeCheck( const char *functionName, int min, int max) { return EnvArgRangeCheck(GetCurrentEnvironment(),functionName,min,max); } globle int ArgTypeCheck( const char *functionName, int argumentPosition, int expectedType, DATA_OBJECT_PTR returnValue) { return EnvArgTypeCheck(GetCurrentEnvironment(),functionName,argumentPosition,expectedType,returnValue); } globle int RtnArgCount() { return EnvRtnArgCount(GetCurrentEnvironment()); } globle double RtnDouble( int argumentPosition) { return EnvRtnDouble(GetCurrentEnvironment(),argumentPosition); } globle const char *RtnLexeme( int argumentPosition) { return EnvRtnLexeme(GetCurrentEnvironment(),argumentPosition); } globle long long RtnLong( int argumentPosition) { return EnvRtnLong(GetCurrentEnvironment(),argumentPosition); } globle DATA_OBJECT_PTR RtnUnknown( int argumentPosition, DATA_OBJECT_PTR returnValue) { return EnvRtnUnknown(GetCurrentEnvironment(),argumentPosition,returnValue); } #endif clips_core_source_630/core/._clips.h0000755000175000017500000000040712424476504015742 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffnxexe.c0000755000175000017500000000040712373730371016430 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/modulbsc.h0000755000175000017500000000544212373755044016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deffacts */ /* construct such as clear, reset, save, undeffacts, */ /* ppdeffacts, list-deffacts, and get-deffacts-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_modulbsc #define _H_modulbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefmoduleBasicCommands(void *); LOCALE void EnvGetDefmoduleList(void *,DATA_OBJECT_PTR); LOCALE void PPDefmoduleCommand(void *); LOCALE int PPDefmodule(void *,const char *,const char *); LOCALE void ListDefmodulesCommand(void *); LOCALE void EnvListDefmodules(void *,const char *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void GetDefmoduleList(DATA_OBJECT_PTR); #if DEBUGGING_FUNCTIONS LOCALE void ListDefmodules(const char *); #endif #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_modulbsc */ clips_core_source_630/core/._factqury.c0000644000175000017500000000040712500141166016442 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factcmp.c0000755000175000017500000000040712373741772016245 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._sysdep.c0000755000175000017500000000040712466460165016134 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/generate.h0000755000175000017500000000462212373753416016213 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* GENERATE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for converting field */ /* constraints to expressions which can be used */ /* in the pattern and join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Reimplemented algorithm for comparisons to */ /* variables contained within not/and CEs. */ /* */ /*************************************************************/ #ifndef _H_generate #define _H_generate #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_analysis #include "analysis.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GENERATE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FieldConversion(void *,struct lhsParseNode *,struct lhsParseNode *,struct nandFrame *); LOCALE struct expr *GetvarReplace(void *,struct lhsParseNode *,int,struct nandFrame *); LOCALE void AddNandUnification(void *,struct lhsParseNode *,struct nandFrame *); #endif /* _H_generate */ clips_core_source_630/core/._globlcom.h0000755000175000017500000000033012374672752016430 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._globlcmp.h0000755000175000017500000000040712373753367016437 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factbin.h0000755000175000017500000000407612373742664016035 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT BLOAD/BSAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_factbin #define _H_factbin #include "factbld.h" #define FACTBIN_DATA 62 struct factBinaryData { struct factPatternNode *FactPatternArray; long NumberOfPatterns; }; #define FactBinaryData(theEnv) ((struct factBinaryData *) GetEnvironmentData(theEnv,FACTBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactBinarySetup(void *); #define BsaveFactPatternIndex(patPtr) ((patPtr == NULL) ? -1L : ((struct factPatternNode *) patPtr)->bsaveID) #define BloadFactPatternPointer(i) ((struct factPatternNode *) ((i == -1L) ? NULL : &FactBinaryData(theEnv)->FactPatternArray[i])) #endif clips_core_source_630/core/symbol.h0000755000175000017500000003470712464470634015734 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/03/15 */ /* */ /* SYMBOL HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Manages the atomic data value hash tables for */ /* storing symbols, integers, floats, and bit maps. */ /* Contains routines for adding entries, examining the */ /* hash tables, and performing garbage collection to */ /* remove entries no longer in use. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: CLIPS crashing on AMD64 processor in the */ /* function used to generate a hash value for */ /* integers. DR0871 */ /* */ /* Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Corrected code generating compilation */ /* warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for hashing EXTERNAL_ADDRESS data */ /* type. */ /* */ /* Support for long long integers. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Used genstrcpy instead of strcpy. */ /* */ /* Added support for external address hash table */ /* and subtyping. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added ValueToPointer and EnvValueToPointer */ /* macros. */ /* */ /*************************************************************/ #ifndef _H_symbol #define _H_symbol #ifdef LOCALE #undef LOCALE #endif #ifdef _SYMBOL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #include #ifndef _H_multifld #include "multifld.h" #endif #ifndef SYMBOL_HASH_SIZE #define SYMBOL_HASH_SIZE 63559L #endif #ifndef FLOAT_HASH_SIZE #define FLOAT_HASH_SIZE 8191 #endif #ifndef INTEGER_HASH_SIZE #define INTEGER_HASH_SIZE 8191 #endif #ifndef BITMAP_HASH_SIZE #define BITMAP_HASH_SIZE 8191 #endif #ifndef EXTERNAL_ADDRESS_HASH_SIZE #define EXTERNAL_ADDRESS_HASH_SIZE 8191 #endif /************************************************************/ /* symbolHashNode STRUCTURE: */ /************************************************************/ struct symbolHashNode { struct symbolHashNode *next; long count; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededSymbol : 1; unsigned int bucket : 29; const char *contents; }; /************************************************************/ /* floatHashNode STRUCTURE: */ /************************************************************/ struct floatHashNode { struct floatHashNode *next; long count; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededFloat : 1; unsigned int bucket : 29; double contents; }; /************************************************************/ /* integerHashNode STRUCTURE: */ /************************************************************/ struct integerHashNode { struct integerHashNode *next; long count; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededInteger : 1; unsigned int bucket : 29; long long contents; }; /************************************************************/ /* bitMapHashNode STRUCTURE: */ /************************************************************/ struct bitMapHashNode { struct bitMapHashNode *next; long count; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededBitMap : 1; unsigned int bucket : 29; const char *contents; unsigned short size; }; /************************************************************/ /* externalAddressHashNode STRUCTURE: */ /************************************************************/ struct externalAddressHashNode { struct externalAddressHashNode *next; long count; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededPointer : 1; unsigned int bucket : 29; void *externalAddress; unsigned short type; }; /************************************************************/ /* genericHashNode STRUCTURE: */ /************************************************************/ struct genericHashNode { struct genericHashNode *next; long count; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int needed : 1; unsigned int bucket : 29; }; typedef struct symbolHashNode SYMBOL_HN; typedef struct floatHashNode FLOAT_HN; typedef struct integerHashNode INTEGER_HN; typedef struct bitMapHashNode BITMAP_HN; typedef struct externalAddressHashNode EXTERNAL_ADDRESS_HN; typedef struct genericHashNode GENERIC_HN; /**********************************************************/ /* EPHEMERON STRUCTURE: Data structure used to keep track */ /* of ephemeral symbols, floats, and integers. */ /* */ /* associatedValue: Contains a pointer to the storage */ /* structure for the symbol, float, or integer which is */ /* ephemeral. */ /* */ /* next: Contains a pointer to the next ephemeral item */ /* in a list of ephemeral items. */ /**********************************************************/ struct ephemeron { GENERIC_HN *associatedValue; struct ephemeron *next; }; /************************************************************/ /* symbolMatch STRUCTURE: */ /************************************************************/ struct symbolMatch { struct symbolHashNode *match; struct symbolMatch *next; }; #define ValueToString(target) (((struct symbolHashNode *) (target))->contents) #define ValueToDouble(target) (((struct floatHashNode *) (target))->contents) #define ValueToLong(target) (((struct integerHashNode *) (target))->contents) #define ValueToInteger(target) ((int) (((struct integerHashNode *) (target))->contents)) #define ValueToBitMap(target) ((void *) ((struct bitMapHashNode *) (target))->contents) #define ValueToPointer(target) ((void *) target) #define ValueToExternalAddress(target) ((void *) ((struct externalAddressHashNode *) (target))->externalAddress) #define EnvValueToString(theEnv,target) (((struct symbolHashNode *) (target))->contents) #define EnvValueToDouble(theEnv,target) (((struct floatHashNode *) (target))->contents) #define EnvValueToLong(theEnv,target) (((struct integerHashNode *) (target))->contents) #define EnvValueToInteger(theEnv,target) ((int) (((struct integerHashNode *) (target))->contents)) #define EnvValueToBitMap(theEnv,target) ((void *) ((struct bitMapHashNode *) (target))->contents) #define EnvValueToPointer(theEnv,target) ((void *) target) #define EnvValueToExternalAddress(theEnv,target) ((void *) ((struct externalAddressHashNode *) (target))->externalAddress) #define IncrementSymbolCount(theValue) (((SYMBOL_HN *) theValue)->count++) #define IncrementFloatCount(theValue) (((FLOAT_HN *) theValue)->count++) #define IncrementIntegerCount(theValue) (((INTEGER_HN *) theValue)->count++) #define IncrementBitMapCount(theValue) (((BITMAP_HN *) theValue)->count++) #define IncrementExternalAddressCount(theValue) (((EXTERNAL_ADDRESS_HN *) theValue)->count++) /*==================*/ /* ENVIRONMENT DATA */ /*==================*/ #define SYMBOL_DATA 49 struct symbolData { void *TrueSymbolHN; void *FalseSymbolHN; void *PositiveInfinity; void *NegativeInfinity; void *Zero; SYMBOL_HN **SymbolTable; FLOAT_HN **FloatTable; INTEGER_HN **IntegerTable; BITMAP_HN **BitMapTable; EXTERNAL_ADDRESS_HN **ExternalAddressTable; #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES long NumberOfSymbols; long NumberOfFloats; long NumberOfIntegers; long NumberOfBitMaps; long NumberOfExternalAddresses; SYMBOL_HN **SymbolArray; struct floatHashNode **FloatArray; INTEGER_HN **IntegerArray; BITMAP_HN **BitMapArray; EXTERNAL_ADDRESS_HN **ExternalAddressArray; #endif }; #define SymbolData(theEnv) ((struct symbolData *) GetEnvironmentData(theEnv,SYMBOL_DATA)) LOCALE void InitializeAtomTables(void *,struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **, struct externalAddressHashNode **); LOCALE void *EnvAddSymbol(void *,const char *); LOCALE SYMBOL_HN *FindSymbolHN(void *,const char *); LOCALE void *EnvAddDouble(void *,double); LOCALE void *EnvAddLong(void *,long long); LOCALE void *EnvAddBitMap(void *,void *,unsigned); LOCALE void *EnvAddExternalAddress(void *,void *,unsigned); LOCALE INTEGER_HN *FindLongHN(void *,long long); LOCALE unsigned long HashSymbol(const char *,unsigned long); LOCALE unsigned long HashFloat(double,unsigned long); LOCALE unsigned long HashInteger(long long,unsigned long); LOCALE unsigned long HashBitMap(const char *,unsigned long,unsigned); LOCALE unsigned long HashExternalAddress(void *,unsigned long); LOCALE void DecrementSymbolCount(void *,struct symbolHashNode *); LOCALE void DecrementFloatCount(void *,struct floatHashNode *); LOCALE void DecrementIntegerCount(void *,struct integerHashNode *); LOCALE void DecrementBitMapCount(void *,struct bitMapHashNode *); LOCALE void DecrementExternalAddressCount(void *,struct externalAddressHashNode *); LOCALE void RemoveEphemeralAtoms(void *); LOCALE struct symbolHashNode **GetSymbolTable(void *); LOCALE void SetSymbolTable(void *,struct symbolHashNode **); LOCALE struct floatHashNode **GetFloatTable(void *); LOCALE void SetFloatTable(void *,struct floatHashNode **); LOCALE struct integerHashNode **GetIntegerTable(void *); LOCALE void SetIntegerTable(void *,struct integerHashNode **); LOCALE struct bitMapHashNode **GetBitMapTable(void *); LOCALE void SetBitMapTable(void *,struct bitMapHashNode **); LOCALE struct externalAddressHashNode **GetExternalAddressTable(void *); LOCALE void SetExternalAddressTable(void *,struct externalAddressHashNode **); LOCALE void RefreshSpecialSymbols(void *); LOCALE struct symbolMatch *FindSymbolMatches(void *,const char *,unsigned *,size_t *); LOCALE void ReturnSymbolMatches(void *,struct symbolMatch *); LOCALE SYMBOL_HN *GetNextSymbolMatch(void *,const char *,size_t,SYMBOL_HN *,int,size_t *); LOCALE void ClearBitString(void *,unsigned); LOCALE void SetAtomicValueIndices(void *,int); LOCALE void RestoreAtomicValueBuckets(void *); LOCALE void *EnvFalseSymbol(void *); LOCALE void *EnvTrueSymbol(void *); LOCALE void EphemerateValue(void *,int,void *); LOCALE void EphemerateMultifield(void *,struct multifield *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void *AddDouble(double); LOCALE void *AddLong(long long); LOCALE void *AddSymbol(const char *); LOCALE void *FalseSymbol(void); LOCALE void *TrueSymbol(void); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_symbol */ clips_core_source_630/core/._exprnpsr.c0000755000175000017500000000040712464742046016505 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dfinscmp.h0000755000175000017500000000355212373731171016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Definstances Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /*************************************************************/ #ifndef _H_dfinscmp #define _H_dfinscmp #if DEFINSTANCES_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFINSCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDefinstancesCompiler(void *); LOCALE void DefinstancesCModuleReference(void *,FILE *,int,int,int); #endif /* DEFINSTANCES_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ #endif /* _H_dfinscmp */ clips_core_source_630/core/._factmngr.c0000755000175000017500000000040712500146076016415 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/default.c0000755000175000017500000004062712373721033016033 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFAULT ATTRIBUTE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing the default */ /* attribute and determining default values based on */ /* slot constraints. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Support for deftemplate-slot-default-value */ /* function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _DEFAULT_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include "constant.h" #include "constrnt.h" #include "cstrnchk.h" #include "multifld.h" #include "inscom.h" #include "exprnpsr.h" #include "scanner.h" #include "router.h" #include "factmngr.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "default.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *FindDefaultValue(void *,int,CONSTRAINT_RECORD *,void *); /********************************************************/ /* DeriveDefaultFromConstraints: Returns an appropriate */ /* default value for the supplied constraints. */ /********************************************************/ globle void DeriveDefaultFromConstraints( void *theEnv, CONSTRAINT_RECORD *constraints, DATA_OBJECT *theDefault, int multifield, int garbageMultifield) { unsigned short theType; unsigned long minFields; void *theValue; /*=============================================================*/ /* If no constraints are specified, then use the symbol nil as */ /* a default for single field slots and a multifield of length */ /* 0 as a default for multifield slots. */ /*=============================================================*/ if (constraints == NULL) { if (multifield) { SetpType(theDefault,MULTIFIELD); SetpDOBegin(theDefault,1); SetpDOEnd(theDefault,0); if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,0L)); else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,0L)); } else { theDefault->type = SYMBOL; theDefault->value = EnvAddSymbol(theEnv,"nil"); } return; } /*=========================================*/ /* Determine the default's type and value. */ /*=========================================*/ if (constraints->anyAllowed || constraints->symbolsAllowed) { theType = SYMBOL; theValue = FindDefaultValue(theEnv,SYMBOL,constraints,EnvAddSymbol(theEnv,"nil")); } else if (constraints->stringsAllowed) { theType = STRING; theValue = FindDefaultValue(theEnv,STRING,constraints,EnvAddSymbol(theEnv,"")); } else if (constraints->integersAllowed) { theType = INTEGER; theValue = FindDefaultValue(theEnv,INTEGER,constraints,EnvAddLong(theEnv,0LL)); } else if (constraints->floatsAllowed) { theType = FLOAT; theValue = FindDefaultValue(theEnv,FLOAT,constraints,EnvAddDouble(theEnv,0.0)); } #if OBJECT_SYSTEM else if (constraints->instanceNamesAllowed) { theType = INSTANCE_NAME; theValue = FindDefaultValue(theEnv,INSTANCE_NAME,constraints,EnvAddSymbol(theEnv,"nil")); } else if (constraints->instanceAddressesAllowed) { theType = INSTANCE_ADDRESS; theValue = (void *) &InstanceData(theEnv)->DummyInstance; } #endif #if DEFTEMPLATE_CONSTRUCT else if (constraints->factAddressesAllowed) { theType = FACT_ADDRESS; theValue = (void *) &FactData(theEnv)->DummyFact; } #endif else if (constraints->externalAddressesAllowed) { theType = EXTERNAL_ADDRESS; theValue = EnvAddExternalAddress(theEnv,NULL,0); } else { theType = SYMBOL; theValue = EnvAddSymbol(theEnv,"nil"); } /*=========================================================*/ /* If the default is for a multifield slot, then create a */ /* multifield default value that satisfies the cardinality */ /* constraints for the slot. The default value for a */ /* multifield slot is a multifield of length 0. */ /*=========================================================*/ if (multifield) { if (constraints->minFields == NULL) minFields = 0; else if (constraints->minFields->value == SymbolData(theEnv)->NegativeInfinity) minFields = 0; else minFields = (unsigned long) ValueToLong(constraints->minFields->value); SetpType(theDefault,MULTIFIELD); SetpDOBegin(theDefault,1); SetpDOEnd(theDefault,(long) minFields); if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,minFields)); else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,minFields)); for (; minFields > 0; minFields--) { SetMFType(GetpValue(theDefault),minFields,theType); SetMFValue(GetpValue(theDefault),minFields,theValue); } } else { theDefault->type = theType; theDefault->value = theValue; } } /***********************************************************************/ /* FindDefaultValue: Searches the list of restriction values for a */ /* constraint to find a default value of the specified type. For */ /* example, if the attribute (allowed-symbols on off) was specified, */ /* then the symbol "on" would be used as a default value rather than */ /* the symbol "nil". For integers and floats, the range attribute is */ /* also used to select a suitable default value. If a minimum value */ /* was specified, then this value is used first followed by the */ /* maximum value. */ /************************************************************************/ static void *FindDefaultValue( void *theEnv, int theType, CONSTRAINT_RECORD *theConstraints, void *standardDefault) { struct expr *theList; /*=====================================================*/ /* Look on the the allowed values list to see if there */ /* is a value of the requested type. Return the first */ /* value found of the requested type. */ /*=====================================================*/ theList = theConstraints->restrictionList; while (theList != NULL) { if (theList->type == theType) return(theList->value); theList = theList->nextArg; } /*=============================================================*/ /* If no specific values were available for the default value, */ /* and the type requested is a float or integer, then use the */ /* range attribute to select a default value. */ /*=============================================================*/ if (theType == INTEGER) { if (theConstraints->minValue->type == INTEGER) { return(theConstraints->minValue->value); } else if (theConstraints->minValue->type == FLOAT) { return(EnvAddLong(theEnv,(long long) ValueToDouble(theConstraints->minValue->value))); } else if (theConstraints->maxValue->type == INTEGER) { return(theConstraints->maxValue->value); } else if (theConstraints->maxValue->type == FLOAT) { return(EnvAddLong(theEnv,(long long) ValueToDouble(theConstraints->maxValue->value))); } } else if (theType == FLOAT) { if (theConstraints->minValue->type == FLOAT) { return(theConstraints->minValue->value); } else if (theConstraints->minValue->type == INTEGER) { return(EnvAddDouble(theEnv,(double) ValueToLong(theConstraints->minValue->value))); } else if (theConstraints->maxValue->type == FLOAT) { return(theConstraints->maxValue->value); } else if (theConstraints->maxValue->type == INTEGER) { return(EnvAddDouble(theEnv,(double) ValueToLong(theConstraints->maxValue->value))); } } /*======================================*/ /* Use the standard default value (such */ /* as nil if symbols are allowed). */ /*======================================*/ return(standardDefault); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**********************************************/ /* ParseDefault: Parses a default value list. */ /**********************************************/ globle struct expr *ParseDefault( void *theEnv, const char *readSource, int multifield, int dynamic, int evalStatic, int *noneSpecified, int *deriveSpecified, int *error) { struct expr *defaultList = NULL, *lastDefault = NULL; struct expr *newItem, *tmpItem; struct token theToken; DATA_OBJECT theValue; CONSTRAINT_RECORD *rv; int specialVarCode; *noneSpecified = FALSE; *deriveSpecified = FALSE; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); /*===================================================*/ /* Read the items contained in the default attribute */ /* until a closing right parenthesis is encountered. */ /*===================================================*/ while (theToken.type != RPAREN) { /*========================================*/ /* Get the next item in the default list. */ /*========================================*/ newItem = ParseAtomOrExpression(theEnv,readSource,&theToken); if (newItem == NULL) { ReturnExpression(theEnv,defaultList); *error = TRUE; return(NULL); } /*===========================================================*/ /* Check for invalid variable usage. With the expection of */ /* ?NONE for the default attribute, local variables may not */ /* be used within the default or default-dynamic attributes. */ /*===========================================================*/ if ((newItem->type == SF_VARIABLE) || (newItem->type == MF_VARIABLE)) { if (strcmp(ValueToString(newItem->value),"NONE") == 0) { specialVarCode = 0; } else if (strcmp(ValueToString(newItem->value),"DERIVE") == 0) { specialVarCode = 1; } else { specialVarCode = -1; } if ((dynamic) || (newItem->type == MF_VARIABLE) || (specialVarCode == -1) || ((specialVarCode != -1) && (defaultList != NULL))) { if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute"); else SyntaxErrorMessage(theEnv,"default attribute"); ReturnExpression(theEnv,newItem); ReturnExpression(theEnv,defaultList); *error = TRUE; return(NULL); } ReturnExpression(theEnv,newItem); /*============================================*/ /* Check for the closing right parenthesis of */ /* the default or default dynamic attribute. */ /*============================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != RPAREN) { if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute"); else SyntaxErrorMessage(theEnv,"default attribute"); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); *error = TRUE; } if (specialVarCode == 0) *noneSpecified = TRUE; else *deriveSpecified = TRUE; return(NULL); } /*====================================================*/ /* Look to see if any variables have been used within */ /* expressions contained within the default list. */ /*====================================================*/ if (ExpressionContainsVariables(newItem,FALSE) == TRUE) { ReturnExpression(theEnv,defaultList); ReturnExpression(theEnv,newItem); *error = TRUE; if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute"); else SyntaxErrorMessage(theEnv,"default attribute"); return(NULL); } /*============================================*/ /* Add the default value to the default list. */ /*============================================*/ if (lastDefault == NULL) { defaultList = newItem; } else { lastDefault->nextArg = newItem; } lastDefault = newItem; /*=======================================*/ /* Begin parsing the next default value. */ /*=======================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); } /*=====================================*/ /* Fix up pretty print representation. */ /*=====================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*=========================================*/ /* A single field slot's default attribute */ /* must contain a single value. */ /*=========================================*/ if (multifield == FALSE) { if (defaultList == NULL) { *error = TRUE; } else if (defaultList->nextArg != NULL) { *error = TRUE; } else { rv = ExpressionToConstraintRecord(theEnv,defaultList); rv->multifieldsAllowed = FALSE; if (UnmatchableConstraint(rv)) *error = TRUE; RemoveConstraint(theEnv,rv); } if (*error) { PrintErrorID(theEnv,"DEFAULT",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The default value for a single field slot must be a single field value\n"); ReturnExpression(theEnv,defaultList); return(NULL); } } /*=======================================================*/ /* If the dynamic-default attribute is not being parsed, */ /* evaluate the expressions to make the default value. */ /*=======================================================*/ if (dynamic || (! evalStatic) || (defaultList == NULL)) return(defaultList); tmpItem = defaultList; newItem = defaultList; defaultList = NULL; while (newItem != NULL) { SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,newItem,&theValue)) *error = TRUE; if ((theValue.type == MULTIFIELD) && (multifield == FALSE) && (*error == FALSE)) { PrintErrorID(theEnv,"DEFAULT",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The default value for a single field slot must be a single field value\n"); *error = TRUE; } if (*error) { ReturnExpression(theEnv,tmpItem); ReturnExpression(theEnv,defaultList); *error = TRUE; return(NULL); } lastDefault = ConvertValueToExpression(theEnv,&theValue); defaultList = AppendExpressions(defaultList,lastDefault); newItem = newItem->nextArg; } ReturnExpression(theEnv,tmpItem); /*==========================*/ /* Return the default list. */ /*==========================*/ return(defaultList); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips_core_source_630/core/multifun.h0000755000175000017500000001242512374017640016255 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* MULTIFIELD FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary Riley and Brian Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved ImplodeMultifield to multifld.c. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Fixed memory leaks when error occurred. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when DEFMODULE_CONSTRUCT */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #ifndef _H_multifun #define _H_multifun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MULTIFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void MultifieldFunctionDefinitions(void *); #if MULTIFIELD_FUNCTIONS LOCALE void DeleteFunction(void *,DATA_OBJECT_PTR); LOCALE void MVDeleteFunction(void *,DATA_OBJECT_PTR); LOCALE void ReplaceFunction(void *,DATA_OBJECT_PTR); LOCALE void MVReplaceFunction(void *,DATA_OBJECT_PTR); LOCALE void DeleteMemberFunction(void *,DATA_OBJECT_PTR); LOCALE void ReplaceMemberFunction(void *,DATA_OBJECT_PTR); LOCALE void InsertFunction(void *,DATA_OBJECT_PTR); LOCALE void ExplodeFunction(void *,DATA_OBJECT_PTR); LOCALE void *ImplodeFunction(void *); LOCALE void SubseqFunction(void *,DATA_OBJECT_PTR); LOCALE void MVSubseqFunction(void *,DATA_OBJECT_PTR); LOCALE void FirstFunction(void *,DATA_OBJECT_PTR); LOCALE void RestFunction(void *,DATA_OBJECT_PTR); LOCALE void NthFunction(void *,DATA_OBJECT_PTR); LOCALE intBool SubsetpFunction(void *); LOCALE void MemberFunction(void *,DATA_OBJECT_PTR); LOCALE void MultifieldPrognFunction(void *,DATA_OBJECT_PTR); LOCALE void ForeachFunction(void *,DATA_OBJECT_PTR); LOCALE void GetMvPrognField(void *,DATA_OBJECT_PTR); LOCALE long GetMvPrognIndex(void *); LOCALE intBool FindDOsInSegment(DATA_OBJECT_PTR,int,DATA_OBJECT_PTR, long *,long *,long *,int); #endif LOCALE int ReplaceMultiValueField(void *,struct dataObject *, struct dataObject *, long,long, struct dataObject *,const char *); LOCALE int InsertMultiValueField(void *,struct dataObject *, struct dataObject *, long,struct dataObject *,const char *); LOCALE int DeleteMultiValueField(void *,struct dataObject *,struct dataObject *, long,long,const char *); #endif /* _H_multifun */ clips_core_source_630/core/._userdata.c0000755000175000017500000000040712373740574016437 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._prdctfun.h0000755000175000017500000000040712373743655016464 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/multifun.c0000755000175000017500000015652312433455671016266 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* MULTIFIELD FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several multifield */ /* functions including first$, rest$, subseq$, delete$, */ /* delete-member$, replace-member$ */ /* replace$, insert$, explode$, implode$, nth$, member$, */ /* subsetp, progn$, str-implode, str-explode, subset, nth, */ /* mv-replace, member, mv-subseq, and mv-delete. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian Dantes */ /* Barry Cameron */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved ImplodeMultifield to multifld.c. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Fixed memory leaks when error occurred. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when DEFMODULE_CONSTRUCT */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #define _MULTIFUN_SOURCE_ #include "setup.h" #if MULTIFIELD_FUNCTIONS || OBJECT_SYSTEM #include #define _STDIO_INCLUDED_ #include #include "argacces.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "multifld.h" #include "multifun.h" #include "prcdrpsr.h" #include "prcdrfun.h" #include "router.h" #if (! BLOAD_ONLY) && (! RUN_TIME) #include "scanner.h" #endif #include "utility.h" #if OBJECT_SYSTEM #include "object.h" #endif /**************/ /* STRUCTURES */ /**************/ typedef struct fieldVarStack { unsigned short type; void *value; long index; struct fieldVarStack *nxt; } FIELD_VAR_STACK; /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if MULTIFIELD_FUNCTIONS static intBool MVRangeCheck(long,long,long *,int); static void MultifieldPrognDriver(void *,DATA_OBJECT_PTR,const char *); #if (! BLOAD_ONLY) && (! RUN_TIME) static struct expr *MultifieldPrognParser(void *,struct expr *,const char *); static struct expr *ForeachParser(void *,struct expr *,const char *); static void ReplaceMvPrognFieldVars(void *,SYMBOL_HN *,struct expr *,int); #endif /* (! BLOAD_ONLY) && (! RUN_TIME) */ #endif /* MULTIFIELD_FUNCTIONS */ static void MVRangeError(void *,long,long,long,const char *); #endif /* MULTIFIELD_FUNCTIONS || OBJECT_SYSTEM */ /***************************************/ /* LOCAL INTERNAL VARIABLE DEFINITIONS */ /***************************************/ #if MULTIFIELD_FUNCTIONS #define MULTIFUN_DATA 10 struct multiFunctionData { FIELD_VAR_STACK *FieldVarStack; }; #define MultiFunctionData(theEnv) ((struct multiFunctionData *) GetEnvironmentData(theEnv,MULTIFUN_DATA)) /**********************************************/ /* MultifieldFunctionDefinitions: Initializes */ /* the multifield functions. */ /**********************************************/ globle void MultifieldFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,MULTIFUN_DATA,sizeof(struct multiFunctionData),NULL); #if ! RUN_TIME EnvDefineFunction2(theEnv,"first$", 'm', PTIEF FirstFunction, "FirstFunction", "11m"); EnvDefineFunction2(theEnv,"rest$", 'm', PTIEF RestFunction, "RestFunction", "11m"); EnvDefineFunction2(theEnv,"subseq$", 'm', PTIEF SubseqFunction, "SubseqFunction", "33im"); EnvDefineFunction2(theEnv,"delete-member$", 'm', PTIEF DeleteMemberFunction, "DeleteMemberFunction", "2*um"); EnvDefineFunction2(theEnv,"replace-member$", 'm', PTIEF ReplaceMemberFunction, "ReplaceMemberFunction","3*um"); EnvDefineFunction2(theEnv,"delete$", 'm', PTIEF DeleteFunction, "DeleteFunction", "33im"); EnvDefineFunction2(theEnv,"replace$", 'm', PTIEF ReplaceFunction, "ReplaceFunction","4**mii"); EnvDefineFunction2(theEnv,"insert$", 'm', PTIEF InsertFunction, "InsertFunction", "3**mi"); EnvDefineFunction2(theEnv,"explode$", 'm', PTIEF ExplodeFunction, "ExplodeFunction", "11s"); EnvDefineFunction2(theEnv,"implode$", 's', PTIEF ImplodeFunction, "ImplodeFunction", "11m"); EnvDefineFunction2(theEnv,"nth$", 'u', PTIEF NthFunction, "NthFunction", "22*im"); EnvDefineFunction2(theEnv,"member$", 'u', PTIEF MemberFunction, "MemberFunction", "22*um"); EnvDefineFunction2(theEnv,"subsetp", 'b', PTIEF SubsetpFunction, "SubsetpFunction", "22*mm"); EnvDefineFunction2(theEnv,"progn$", 'u', PTIEF MultifieldPrognFunction, "MultifieldPrognFunction", NULL); EnvDefineFunction2(theEnv,"foreach", 'u', PTIEF ForeachFunction, "ForeachFunction", NULL); EnvDefineFunction2(theEnv,"str-implode", 's', PTIEF ImplodeFunction, "ImplodeFunction", "11m"); EnvDefineFunction2(theEnv,"str-explode", 'm', PTIEF ExplodeFunction, "ExplodeFunction", "11s"); EnvDefineFunction2(theEnv,"subset", 'b', PTIEF SubsetpFunction, "SubsetpFunction", "22*mm"); EnvDefineFunction2(theEnv,"nth", 'u', PTIEF NthFunction, "NthFunction", "22*im"); EnvDefineFunction2(theEnv,"mv-replace", 'm', PTIEF MVReplaceFunction, "MVReplaceFunction","33*im"); EnvDefineFunction2(theEnv,"member", 'u', PTIEF MemberFunction, "MemberFunction", "22*um"); EnvDefineFunction2(theEnv,"mv-subseq", 'm', PTIEF MVSubseqFunction, "MVSubseqFunction", "33*iim"); EnvDefineFunction2(theEnv,"mv-delete", 'm', PTIEF MVDeleteFunction,"MVDeleteFunction", "22*im"); #if ! BLOAD_ONLY AddFunctionParser(theEnv,"progn$",MultifieldPrognParser); AddFunctionParser(theEnv,"foreach",ForeachParser); #endif FuncSeqOvlFlags(theEnv,"progn$",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"foreach",FALSE,FALSE); EnvDefineFunction2(theEnv,"(get-progn$-field)", 'u', PTIEF GetMvPrognField, "GetMvPrognField", "00"); EnvDefineFunction2(theEnv,"(get-progn$-index)", 'l', PTIEF GetMvPrognIndex, "GetMvPrognIndex", "00"); #endif } /****************************************/ /* DeleteFunction: H/L access routine */ /* for the delete$ function. */ /****************************************/ globle void DeleteFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"delete$",1,MULTIFIELD,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"delete$",2,INTEGER,&value2) == FALSE) || (EnvArgTypeCheck(theEnv,"delete$",3,INTEGER,&value3) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=================================================*/ /* Delete the section out of the multifield value. */ /*=================================================*/ if (DeleteMultiValueField(theEnv,returnValue,&value1, (long) DOToLong(value2),(long) DOToLong(value3),"delete$") == FALSE)/* TBD */ { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /******************************************/ /* MVDeleteFunction: H/L access routine */ /* for the mv-delete function. */ /******************************************/ globle void MVDeleteFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"mv-delete",1,INTEGER,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"mv-delete",2,MULTIFIELD,&value2) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=================================================*/ /* Delete the section out of the multifield value. */ /*=================================================*/ if (DeleteMultiValueField(theEnv,returnValue,&value2, (long) DOToLong(value1),(long) DOToLong(value1),"mv-delete") == FALSE) /* TBD */ { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*****************************************/ /* ReplaceFunction: H/L access routine */ /* for the replace$ function. */ /*****************************************/ globle void ReplaceFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3, value4; EXPRESSION *fieldarg; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"replace$",1,MULTIFIELD,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"replace$",2,INTEGER,&value2) == FALSE) || (EnvArgTypeCheck(theEnv,"replace$",3,INTEGER,&value3) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*===============================*/ /* Create the replacement value. */ /*===============================*/ fieldarg = GetFirstArgument()->nextArg->nextArg->nextArg; if (fieldarg->nextArg != NULL) { StoreInMultifield(theEnv,&value4,fieldarg,TRUE); } else { EvaluateExpression(theEnv,fieldarg,&value4); } /*==============================================*/ /* Replace the section in the multifield value. */ /*==============================================*/ if (ReplaceMultiValueField(theEnv,returnValue,&value1,(long) DOToLong(value2), (long) DOToLong(value3),&value4,"replace$") == FALSE) /* TBD */ { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*******************************************/ /* MVReplaceFunction: H/L access routine */ /* for the mv-replace function. */ /*******************************************/ globle void MVReplaceFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"mv-replace",1,INTEGER,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"mv-replace",2,MULTIFIELD,&value2) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*===============================*/ /* Create the replacement value. */ /*===============================*/ EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&value3); /*==============================================*/ /* Replace the section in the multifield value. */ /*==============================================*/ if (ReplaceMultiValueField(theEnv,returnValue,&value2,(long) DOToLong(value1), (long) DOToLong(value1),&value3,"mv-replace") == FALSE) /* TBD */ { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /**********************************************/ /* DeleteMemberFunction: H/L access routine */ /* for the delete-member$ function. */ /**********************************************/ globle void DeleteMemberFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT resultValue,*delVals,tmpVal; int i,argCnt; unsigned delSize; long j,k; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ argCnt = EnvArgCountCheck(theEnv,"delete-member$",AT_LEAST,2); if (argCnt == -1) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if (EnvArgTypeCheck(theEnv,"delete-member$",1,MULTIFIELD,&resultValue) == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*================================================= For every value specified, delete all occurrences of those values from the multifield ================================================= */ delSize = (sizeof(DATA_OBJECT) * (argCnt-1)); delVals = (DATA_OBJECT_PTR) gm2(theEnv,delSize); for (i = 2 ; i <= argCnt ; i++) { if (!EnvRtnUnknown(theEnv,i,&delVals[i-2])) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } } while (FindDOsInSegment(delVals,argCnt-1,&resultValue,&j,&k,NULL,0)) { if (DeleteMultiValueField(theEnv,&tmpVal,&resultValue, j,k,"delete-member$") == FALSE) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } GenCopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal); } rm(theEnv,(void *) delVals,delSize); GenCopyMemory(DATA_OBJECT,1,returnValue,&resultValue); } /***********************************************/ /* ReplaceMemberFunction: H/L access routine */ /* for the replace-member$ function. */ /***********************************************/ globle void ReplaceMemberFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT resultValue,replVal,*delVals,tmpVal; int i,argCnt; unsigned delSize; long j,k,mink[2],*minkp; long replLen = 1L; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ argCnt = EnvArgCountCheck(theEnv,"replace-member$",AT_LEAST,3); if (argCnt == -1) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if (EnvArgTypeCheck(theEnv,"replace-member$",1,MULTIFIELD,&resultValue) == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (!EnvRtnUnknown(theEnv,2,&replVal)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (GetType(replVal) == MULTIFIELD) replLen = GetDOLength(replVal); /*===================================================== For the value (or values from multifield ) specified, replace all occurrences of those values with all values specified ===================================================== */ delSize = (sizeof(DATA_OBJECT) * (argCnt-2)); delVals = (DATA_OBJECT_PTR) gm2(theEnv,delSize); for (i = 3 ; i <= argCnt ; i++) { if (!EnvRtnUnknown(theEnv,i,&delVals[i-3])) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } } minkp = NULL; while (FindDOsInSegment(delVals,argCnt-2,&resultValue,&j,&k,minkp,minkp ? 1 : 0)) { if (ReplaceMultiValueField(theEnv,&tmpVal,&resultValue,j,k, &replVal,"replace-member$") == FALSE) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } GenCopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal); mink[0] = 1L; mink[1] = j + replLen - 1L; minkp = mink; } rm(theEnv,(void *) delVals,delSize); GenCopyMemory(DATA_OBJECT,1,returnValue,&resultValue); } /****************************************/ /* InsertFunction: H/L access routine */ /* for the insert$ function. */ /****************************************/ globle void InsertFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3; EXPRESSION *fieldarg; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"insert$",1,MULTIFIELD,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"insert$",2,INTEGER,&value2) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=============================*/ /* Create the insertion value. */ /*=============================*/ fieldarg = GetFirstArgument()->nextArg->nextArg; if (fieldarg->nextArg != NULL) StoreInMultifield(theEnv,&value3,fieldarg,TRUE); else EvaluateExpression(theEnv,fieldarg,&value3); /*===========================================*/ /* Insert the value in the multifield value. */ /*===========================================*/ if (InsertMultiValueField(theEnv,returnValue,&value1,(long) DOToLong(value2), /* TBD */ &value3,"insert$") == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*****************************************/ /* ExplodeFunction: H/L access routine */ /* for the explode$ function. */ /*****************************************/ globle void ExplodeFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value; struct multifield *theMultifield; unsigned long end; /*=====================================*/ /* Explode$ expects a single argument. */ /*=====================================*/ if (EnvArgCountCheck(theEnv,"explode$",EXACTLY,1) == -1) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*==================================*/ /* The argument should be a string. */ /*==================================*/ if (EnvArgTypeCheck(theEnv,"explode$",1,STRING,&value) == FALSE) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=====================================*/ /* Convert the string to a multifield. */ /*=====================================*/ theMultifield = StringToMultifield(theEnv,DOToString(value)); if (theMultifield == NULL) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); end = 0; } else { end = GetMFLength(theMultifield); } /*========================*/ /* Return the multifield. */ /*========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,end); SetpValue(returnValue,(void *) theMultifield); return; } /*****************************************/ /* ImplodeFunction: H/L access routine */ /* for the implode$ function. */ /*****************************************/ globle void *ImplodeFunction( void *theEnv) { DATA_OBJECT value; /*=====================================*/ /* Implode$ expects a single argument. */ /*=====================================*/ if (EnvArgCountCheck(theEnv,"implode$",EXACTLY,1) == -1) { return(EnvAddSymbol(theEnv,"")); } /*======================================*/ /* The argument should be a multifield. */ /*======================================*/ if (EnvArgTypeCheck(theEnv,"implode$",1,MULTIFIELD,&value) == FALSE) { return(EnvAddSymbol(theEnv,"")); } /*====================*/ /* Return the string. */ /*====================*/ return(ImplodeMultifield(theEnv,&value)); } /****************************************/ /* SubseqFunction: H/L access routine */ /* for the subseq$ function. */ /****************************************/ globle void SubseqFunction( void *theEnv, DATA_OBJECT_PTR sub_value) { DATA_OBJECT value; struct multifield *theList; long long offset, start, end, length; /* 6.04 Bug Fix */ /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"subseq$",1,MULTIFIELD,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } theList = (struct multifield *) DOToPointer(value); offset = GetDOBegin(value); length = GetDOLength(value); /*=============================================*/ /* Get range arguments. If they are not within */ /* appropriate ranges, return a null segment. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"subseq$",2,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } start = DOToLong(value); if (EnvArgTypeCheck(theEnv,"subseq$",3,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } end = DOToLong(value); if ((end < 1) || (end < start)) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } /*===================================================*/ /* Adjust lengths to conform to segment boundaries. */ /*===================================================*/ if (start > length) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } if (end > length) end = length; if (start < 1) start = 1; /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(sub_value,MULTIFIELD); SetpValue(sub_value,theList); SetpDOEnd(sub_value,offset + end - 1); SetpDOBegin(sub_value,offset + start - 1); } /******************************************/ /* MVSubseqFunction: H/L access routine */ /* for the mv-subseq function. */ /******************************************/ globle void MVSubseqFunction( void *theEnv, DATA_OBJECT_PTR sub_value) { DATA_OBJECT value; struct multifield *theList; long long offset, start, end, length; /* 6.04 Bug Fix */ /*=============================================*/ /* Get range arguments. If they are not within */ /* appropriate ranges, return a null segment. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"mv-subseq",1,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } start = DOToLong(value); if (EnvArgTypeCheck(theEnv,"mv-subseq",2,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } end = DOToLong(value); if ((end < 1) || (end < start)) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"mv-subseq",3,MULTIFIELD,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } theList = (struct multifield *) DOToPointer(value); offset = GetDOBegin(value); /*===================================================*/ /* Adjust lengths to conform to segment boundaries. */ /*===================================================*/ length = GetDOLength(value); if (start > length) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } if (end > length) end = length; if (start < 1) start = 1; /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(sub_value,MULTIFIELD); SetpValue(sub_value,theList); SetpDOEnd(sub_value,offset + end - 1); SetpDOBegin(sub_value,offset + start - 1); } /***************************************/ /* FirstFunction: H/L access routine */ /* for the first$ function. */ /***************************************/ globle void FirstFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theValue; struct multifield *theList; /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"first$",1,MULTIFIELD,&theValue) == FALSE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } theList = (struct multifield *) DOToPointer(theValue); /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpValue(returnValue,theList); if (GetDOEnd(theValue) >= GetDOBegin(theValue)) { SetpDOEnd(returnValue,GetDOBegin(theValue)); } else { SetpDOEnd(returnValue,GetDOEnd(theValue)); } SetpDOBegin(returnValue,GetDOBegin(theValue)); } /**************************************/ /* RestFunction: H/L access routine */ /* for the rest$ function. */ /**************************************/ globle void RestFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theValue; struct multifield *theList; /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"rest$",1,MULTIFIELD,&theValue) == FALSE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } theList = (struct multifield *) DOToPointer(theValue); /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpValue(returnValue,theList); if (GetDOBegin(theValue) > GetDOEnd(theValue)) { SetpDOBegin(returnValue,GetDOBegin(theValue)); } else { SetpDOBegin(returnValue,GetDOBegin(theValue) + 1); } SetpDOEnd(returnValue,GetDOEnd(theValue)); } /*************************************/ /* NthFunction: H/L access routine */ /* for the nth$ function. */ /*************************************/ globle void NthFunction( void *theEnv, DATA_OBJECT_PTR nth_value) { DATA_OBJECT value1, value2; struct multifield *elm_ptr; long long n; /* 6.04 Bug Fix */ if (EnvArgCountCheck(theEnv,"nth$",EXACTLY,2) == -1) { SetpType(nth_value,SYMBOL); SetpValue(nth_value,(void *) EnvAddSymbol(theEnv,"nil")); return; } if ((EnvArgTypeCheck(theEnv,"nth$",1,INTEGER,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"nth$",2,MULTIFIELD,&value2) == FALSE)) { SetpType(nth_value,SYMBOL); SetpValue(nth_value,(void *) EnvAddSymbol(theEnv,"nil")); return; } n = DOToLong(value1); /* 6.04 Bug Fix */ if ((n > GetDOLength(value2)) || (n < 1)) { SetpType(nth_value,SYMBOL); SetpValue(nth_value,(void *) EnvAddSymbol(theEnv,"nil")); return; } elm_ptr = (struct multifield *) GetValue(value2); SetpType(nth_value,GetMFType(elm_ptr,((long) n) + GetDOBegin(value2) - 1)); SetpValue(nth_value,GetMFValue(elm_ptr,((long) n) + GetDOBegin(value2) - 1)); } /* ------------------------------------------------------------------ * SubsetFunction: * This function compares two multi-field variables * to see if the first is a subset of the second. It * does not consider order. * * INPUTS: Two arguments via argument stack. First is the sublist * multi-field variable, the second is the list to be * compared to. Both should be of type MULTIFIELD. * * OUTPUTS: TRUE if the first list is a subset of the * second, else FALSE * * NOTES: This function is called from H/L with the subset * command. Repeated values in the sublist must also * be repeated in the main list. * ------------------------------------------------------------------ */ globle intBool SubsetpFunction( void *theEnv) { DATA_OBJECT item1, item2, tmpItem; long i,j,k; if (EnvArgCountCheck(theEnv,"subsetp",EXACTLY,2) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,"subsetp",1,MULTIFIELD,&item1) == FALSE) return(FALSE); if (EnvArgTypeCheck(theEnv,"subsetp",2,MULTIFIELD,&item2) == FALSE) return(FALSE); if (GetDOLength(item1) == 0) return(TRUE); if (GetDOLength(item2) == 0) return(FALSE); for (i = GetDOBegin(item1) ; i <= GetDOEnd(item1) ; i++) { SetType(tmpItem,GetMFType((struct multifield *) GetValue(item1),i)); SetValue(tmpItem,GetMFValue((struct multifield *) GetValue(item1),i)); if (! FindDOsInSegment(&tmpItem,1,&item2,&j,&k,NULL,0)) { return(FALSE); } } return(TRUE); } /****************************************/ /* MemberFunction: H/L access routine */ /* for the member$ function. */ /****************************************/ globle void MemberFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT item1, item2; long j, k; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgCountCheck(theEnv,"member$",EXACTLY,2) == -1) return; EnvRtnUnknown(theEnv,1,&item1); if (EnvArgTypeCheck(theEnv,"member$",2,MULTIFIELD,&item2) == FALSE) return; if (FindDOsInSegment(&item1,1,&item2,&j,&k,NULL,0)) { if (j == k) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,j); } else { result->type = MULTIFIELD; result->value = EnvCreateMultifield(theEnv,2); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,EnvAddLong(theEnv,j)); SetMFType(result->value,2,INTEGER); SetMFValue(result->value,2,EnvAddLong(theEnv,k)); SetpDOBegin(result,1); SetpDOEnd(result,2); } } } /***************************************/ /* FindDOsInSegment: */ /***************************************/ /* 6.05 Bug Fix */ intBool FindDOsInSegment( DATA_OBJECT_PTR searchDOs, int scnt, DATA_OBJECT_PTR value, long *si, long *ei, long *excludes, int epaircnt) { long mul_length,slen,i,k; /* 6.04 Bug Fix */ int j; mul_length = GetpDOLength(value); for (i = 0 ; i < mul_length ; i++) { for (j = 0 ; j < scnt ; j++) { if (GetType(searchDOs[j]) == MULTIFIELD) { slen = GetDOLength(searchDOs[j]); if (MVRangeCheck(i+1L,i+slen,excludes,epaircnt)) { for (k = 0L ; (k < slen) && ((k + i) < mul_length) ; k++) if ((GetMFType(GetValue(searchDOs[j]),k+GetDOBegin(searchDOs[j])) != GetMFType(GetpValue(value),k+i+GetpDOBegin(value))) || (GetMFValue(GetValue(searchDOs[j]),k+GetDOBegin(searchDOs[j])) != GetMFValue(GetpValue(value),k+i+GetpDOBegin(value)))) break; if (k >= slen) { *si = i + 1L; *ei = i + slen; return(TRUE); } } } else if ((GetValue(searchDOs[j]) == GetMFValue(GetpValue(value),i + GetpDOBegin(value))) && (GetType(searchDOs[j]) == GetMFType(GetpValue(value),i + GetpDOBegin(value))) && MVRangeCheck(i+1L,i+1L,excludes,epaircnt)) { *si = *ei = i+1L; return(TRUE); } } } return(FALSE); } /******************************************************/ /* MVRangeCheck: */ /******************************************************/ static intBool MVRangeCheck( long si, long ei, long *elist, int epaircnt) { int i; if (!elist || !epaircnt) return(TRUE); for (i = 0 ; i < epaircnt ; i++) if (((si >= elist[i*2]) && (si <= elist[i*2+1])) || ((ei >= elist[i*2]) && (ei <= elist[i*2+1]))) return(FALSE); return(TRUE); } #if (! BLOAD_ONLY) && (! RUN_TIME) /******************************************************/ /* MultifieldPrognParser: Parses the progn$ function. */ /******************************************************/ static struct expr *MultifieldPrognParser( void *theEnv, struct expr *top, const char *infile) { struct BindInfo *oldBindList,*newBindList,*prev; struct token tkn; struct expr *tmp; SYMBOL_HN *fieldVar = NULL; SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&tkn); /* ================================ Simple form: progn$ ... ================================ */ if (tkn.type != LPAREN) { top->argList = ParseAtomOrExpression(theEnv,infile,&tkn); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } } else { GetToken(theEnv,infile,&tkn); if (tkn.type != SF_VARIABLE) { if (tkn.type != SYMBOL) goto MvPrognParseError; top->argList = Function2Parse(theEnv,infile,ValueToString(tkn.value)); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } } /* ========================================= Complex form: progn$ ( ) ... ========================================= */ else { fieldVar = (SYMBOL_HN *) tkn.value; SavePPBuffer(theEnv," "); top->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } GetToken(theEnv,infile,&tkn); if (tkn.type != RPAREN) goto MvPrognParseError; PPBackup(theEnv); /* PPBackup(theEnv); */ SavePPBuffer(theEnv,tkn.printForm); SavePPBuffer(theEnv," "); } } if (CheckArgumentAgainstRestriction(theEnv,top->argList,(int) 'm')) goto MvPrognParseError; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); IncrementIndentDepth(theEnv,3); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; PPCRAndIndent(theEnv); top->argList->nextArg = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); if (top->argList->nextArg == NULL) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(NULL); } tmp = top->argList->nextArg; top->argList->nextArg = tmp->argList; tmp->argList = NULL; ReturnExpression(theEnv,tmp); newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { if ((fieldVar == NULL) ? FALSE : (strcmp(ValueToString(newBindList->name),ValueToString(fieldVar)) == 0)) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"MULTIFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind field variable in function progn$.\n"); ReturnExpression(theEnv,top); return(NULL); } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; if (fieldVar != NULL) ReplaceMvPrognFieldVars(theEnv,fieldVar,top->argList->nextArg,0); return(top); MvPrognParseError: SyntaxErrorMessage(theEnv,"progn$"); ReturnExpression(theEnv,top); return(NULL); } /******************************************************/ /* ForeachParser: Parses the foreach function. */ /******************************************************/ static struct expr *ForeachParser( void *theEnv, struct expr *top, const char *infile) { struct BindInfo *oldBindList,*newBindList,*prev; struct token tkn; struct expr *tmp; SYMBOL_HN *fieldVar; SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&tkn); if (tkn.type != SF_VARIABLE) { goto ForeachParseError; } fieldVar = (SYMBOL_HN *) tkn.value; SavePPBuffer(theEnv," "); top->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } if (CheckArgumentAgainstRestriction(theEnv,top->argList,(int) 'm')) goto ForeachParseError; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); IncrementIndentDepth(theEnv,3); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; PPCRAndIndent(theEnv); top->argList->nextArg = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); if (top->argList->nextArg == NULL) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(NULL); } tmp = top->argList->nextArg; top->argList->nextArg = tmp->argList; tmp->argList = NULL; ReturnExpression(theEnv,tmp); newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { if ((fieldVar == NULL) ? FALSE : (strcmp(ValueToString(newBindList->name),ValueToString(fieldVar)) == 0)) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"MULTIFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind field variable in function foreach.\n"); ReturnExpression(theEnv,top); return(NULL); } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; if (fieldVar != NULL) ReplaceMvPrognFieldVars(theEnv,fieldVar,top->argList->nextArg,0); return(top); ForeachParseError: SyntaxErrorMessage(theEnv,"foreach"); ReturnExpression(theEnv,top); return(NULL); } /**********************************************/ /* ReplaceMvPrognFieldVars: Replaces variable */ /* references found in the progn$ function. */ /**********************************************/ static void ReplaceMvPrognFieldVars( void *theEnv, SYMBOL_HN *fieldVar, struct expr *theExp, int depth) { size_t flen; flen = strlen(ValueToString(fieldVar)); while (theExp != NULL) { if ((theExp->type != SF_VARIABLE) ? FALSE : (strncmp(ValueToString(theExp->value),ValueToString(fieldVar), (STD_SIZE) flen) == 0)) { if (ValueToString(theExp->value)[flen] == '\0') { theExp->type = FCALL; theExp->value = (void *) FindFunction(theEnv,"(get-progn$-field)"); theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long long) depth)); } else if (strcmp(ValueToString(theExp->value) + flen,"-index") == 0) { theExp->type = FCALL; theExp->value = (void *) FindFunction(theEnv,"(get-progn$-index)"); theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long long) depth)); } } else if (theExp->argList != NULL) { if ((theExp->type == FCALL) && ((theExp->value == (void *) FindFunction(theEnv,"progn$")) || (theExp->value == (void *) FindFunction(theEnv,"foreach")) )) ReplaceMvPrognFieldVars(theEnv,fieldVar,theExp->argList,depth+1); else ReplaceMvPrognFieldVars(theEnv,fieldVar,theExp->argList,depth); } theExp = theExp->nextArg; } } #endif /* (! BLOAD_ONLY) && (! RUN_TIME) */ /*****************************************/ /* MultifieldPrognFunction: H/L access */ /* routine for the progn$ function. */ /*****************************************/ globle void MultifieldPrognFunction( void *theEnv, DATA_OBJECT_PTR result) { MultifieldPrognDriver(theEnv,result,"progn$"); } /***************************************/ /* ForeachFunction: H/L access routine */ /* for the foreach function. */ /***************************************/ globle void ForeachFunction( void *theEnv, DATA_OBJECT_PTR result) { MultifieldPrognDriver(theEnv,result,"foreach"); } /*******************************************/ /* MultifieldPrognDriver: Driver routine */ /* for the progn$ and foreach functions. */ /******************************************/ static void MultifieldPrognDriver( void *theEnv, DATA_OBJECT_PTR result, const char *functionName) { EXPRESSION *theExp; DATA_OBJECT argval; long i, end; /* 6.04 Bug Fix */ FIELD_VAR_STACK *tmpField; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; tmpField = get_struct(theEnv,fieldVarStack); tmpField->type = SYMBOL; tmpField->value = EnvFalseSymbol(theEnv); tmpField->nxt = MultiFunctionData(theEnv)->FieldVarStack; MultiFunctionData(theEnv)->FieldVarStack = tmpField; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,functionName,1,MULTIFIELD,&argval) == FALSE) { MultiFunctionData(theEnv)->FieldVarStack = tmpField->nxt; rtn_struct(theEnv,fieldVarStack,tmpField); return; } oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; end = GetDOEnd(argval); for (i = GetDOBegin(argval) ; i <= end ; i++) { tmpField->type = GetMFType(argval.value,i); tmpField->value = GetMFValue(argval.value,i); /* tmpField->index = i; */ tmpField->index = (i - GetDOBegin(argval)) + 1; for (theExp = GetFirstArgument()->nextArg ; theExp != NULL ; theExp = theExp->nextArg) { EvaluateExpression(theEnv,theExp,result); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { ProcedureFunctionData(theEnv)->BreakFlag = FALSE; if (EvaluationData(theEnv)->HaltExecution) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } MultiFunctionData(theEnv)->FieldVarStack = tmpField->nxt; rtn_struct(theEnv,fieldVarStack,tmpField); RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); return; } /*===================================*/ /* Garbage collect if this isn't the */ /* last evaluation of the progn$. */ /*===================================*/ if ((i < end) || (theExp->nextArg != NULL)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } } } ProcedureFunctionData(theEnv)->BreakFlag = FALSE; MultiFunctionData(theEnv)->FieldVarStack = tmpField->nxt; rtn_struct(theEnv,fieldVarStack,tmpField); RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); } /***************************************************/ /* GetMvPrognField */ /***************************************************/ globle void GetMvPrognField( void *theEnv, DATA_OBJECT_PTR result) { int depth; FIELD_VAR_STACK *tmpField; depth = ValueToInteger(GetFirstArgument()->value); tmpField = MultiFunctionData(theEnv)->FieldVarStack; while (depth > 0) { tmpField = tmpField->nxt; depth--; } result->type = tmpField->type; result->value = tmpField->value; } /***************************************************/ /* GetMvPrognIndex */ /***************************************************/ globle long GetMvPrognIndex( void *theEnv) { int depth; FIELD_VAR_STACK *tmpField; depth = ValueToInteger(GetFirstArgument()->value); tmpField = MultiFunctionData(theEnv)->FieldVarStack; while (depth > 0) { tmpField = tmpField->nxt; depth--; } return(tmpField->index); } #endif /* MULTIFIELD_FUNCTIONS */ #if OBJECT_SYSTEM || MULTIFIELD_FUNCTIONS /************************************************************************** NAME : ReplaceMultiValueField DESCRIPTION : Performs a replace on the src multi-field value storing the results in the dst multi-field value INPUTS : 1) The destination value buffer 2) The source value (can be NULL) 3) Beginning of index range 4) End of range 5) The new field value RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Allocates and sets a ephemeral segment (even if new number of fields is 0) Src value segment is not changed NOTES : index is NOT guaranteed to be valid src is guaranteed to be a multi-field variable or NULL **************************************************************************/ globle int ReplaceMultiValueField( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, long rb, long re, DATA_OBJECT *field, const char *funcName) { long i,j,k; struct field *deptr; struct field *septr; long srclen,dstlen; srclen = ((src != NULL) ? (src->end - src->begin + 1) : 0); if ((re < rb) || (rb < 1) || (re < 1) || (rb > srclen) || (re > srclen)) { MVRangeError(theEnv,rb,re,srclen,funcName); return(FALSE); } rb = src->begin + rb - 1; re = src->begin + re - 1; if (field->type == MULTIFIELD) dstlen = srclen + GetpDOLength(field) - (re-rb+1); else dstlen = srclen + 1 - (re-rb+1); dst->type = MULTIFIELD; dst->begin = 0; dst->value = EnvCreateMultifield(theEnv,dstlen); SetpDOEnd(dst,dstlen); for (i = 0 , j = src->begin ; j < rb ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } if (field->type != MULTIFIELD) { deptr = &((struct multifield *) dst->value)->theFields[i++]; deptr->type = field->type; deptr->value = field->value; } else { for (k = field->begin ; k <= field->end ; k++ , i++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) field->value)->theFields[k]; deptr->type = septr->type; deptr->value = septr->value; } } while (j < re) j++; for (j++ ; i < dstlen ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } return(TRUE); } /************************************************************************** NAME : InsertMultiValueField DESCRIPTION : Performs an insert on the src multi-field value storing the results in the dst multi-field value INPUTS : 1) The destination value buffer 2) The source value (can be NULL) 3) The index for the change 4) The new field value RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Allocates and sets a ephemeral segment (even if new number of fields is 0) Src value segment is not changed NOTES : index is NOT guaranteed to be valid src is guaranteed to be a multi-field variable or NULL **************************************************************************/ globle int InsertMultiValueField( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, long theIndex, DATA_OBJECT *field, const char *funcName) { long i,j,k; register FIELD *deptr, *septr; long srclen,dstlen; srclen = (long) ((src != NULL) ? (src->end - src->begin + 1) : 0); if (theIndex < 1) { MVRangeError(theEnv,theIndex,theIndex,srclen+1,funcName); return(FALSE); } if (theIndex > (srclen + 1)) theIndex = (srclen + 1); dst->type = MULTIFIELD; dst->begin = 0; if (src == NULL) { if (field->type == MULTIFIELD) { DuplicateMultifield(theEnv,dst,field); AddToMultifieldList(theEnv,(struct multifield *) dst->value); } else { dst->value = EnvCreateMultifield(theEnv,0L); dst->end = 0; deptr = &((struct multifield *) dst->value)->theFields[0]; deptr->type = field->type; deptr->value = field->value; } return(TRUE); } dstlen = (field->type == MULTIFIELD) ? GetpDOLength(field) + srclen : srclen + 1; dst->value = EnvCreateMultifield(theEnv,dstlen); SetpDOEnd(dst,dstlen); theIndex--; for (i = 0 , j = src->begin ; i < theIndex ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } if (field->type != MULTIFIELD) { deptr = &((struct multifield *) dst->value)->theFields[theIndex]; deptr->type = field->type; deptr->value = field->value; i++; } else { for (k = field->begin ; k <= field->end ; k++ , i++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) field->value)->theFields[k]; deptr->type = septr->type; deptr->value = septr->value; } } for ( ; j <= src->end ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } return(TRUE); } /******************************************************* NAME : MVRangeError DESCRIPTION : Prints out an error messages for index out-of-range errors in multi-field access functions INPUTS : 1) The bad range start 2) The bad range end 3) The max end of the range (min is assumed to be 1) RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ******************************************************/ static void MVRangeError( void *theEnv, long brb, long bre, long max, const char *funcName) { PrintErrorID(theEnv,"MULTIFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Multifield index "); if (brb == bre) PrintLongInteger(theEnv,WERROR,(long long) brb); else { EnvPrintRouter(theEnv,WERROR,"range "); PrintLongInteger(theEnv,WERROR,(long long) brb); EnvPrintRouter(theEnv,WERROR,".."); PrintLongInteger(theEnv,WERROR,(long long) bre); } EnvPrintRouter(theEnv,WERROR," out of range 1.."); PrintLongInteger(theEnv,WERROR,(long long) max); if (funcName != NULL) { EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,funcName); } EnvPrintRouter(theEnv,WERROR,".\n"); } /************************************************************************** NAME : DeleteMultiValueField DESCRIPTION : Performs a modify on the src multi-field value storing the results in the dst multi-field value INPUTS : 1) The destination value buffer 2) The source value (can be NULL) 3) The beginning index for deletion 4) The ending index for deletion RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Allocates and sets a ephemeral segment (even if new number of fields is 0) Src value segment is not changed NOTES : index is NOT guaranteed to be valid src is guaranteed to be a multi-field variable or NULL **************************************************************************/ globle int DeleteMultiValueField( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, long rb, long re, const char *funcName) { long i,j; register FIELD_PTR deptr,septr; long srclen, dstlen; srclen = (long) ((src != NULL) ? (src->end - src->begin + 1) : 0); if ((re < rb) || (rb < 1) || (re < 1) || (rb > srclen) || (re > srclen)) { MVRangeError(theEnv,rb,re,srclen,funcName); return(FALSE); } dst->type = MULTIFIELD; dst->begin = 0; if (srclen == 0) { dst->value = EnvCreateMultifield(theEnv,0L); dst->end = -1; return(TRUE); } rb = src->begin + rb -1; re = src->begin + re -1; dstlen = srclen-(re-rb+1); SetpDOEnd(dst,dstlen); dst->value = EnvCreateMultifield(theEnv,dstlen); for (i = 0 , j = src->begin ; j < rb ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } while (j < re) j++; for (j++ ; i <= dst->end ; j++ , i++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } return(TRUE); } #endif /* OBJECT_SYSTEM || MULTIFIELD_FUNCTIONS */ clips_core_source_630/core/._bmathfun.c0000755000175000017500000000040712373706603016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._parsefun.c0000755000175000017500000000040712375756073016455 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._argacces.h0000755000175000017500000000040712375756164016410 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrccom.c0000755000175000017500000000040712461252076016435 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._msgcom.c0000755000175000017500000000040712424473403016103 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffctbsc.h0000755000175000017500000000673612373720715016203 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFFACTS BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deffacts */ /* construct such as clear, reset, save, undeffacts, */ /* ppdeffacts, list-deffacts, and get-deffacts-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_dffctbsc #define _H_dffctbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeffactsBasicCommands(void *); LOCALE void UndeffactsCommand(void *); LOCALE intBool EnvUndeffacts(void *,void *); LOCALE void GetDeffactsListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDeffactsList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DeffactsModuleFunction(void *); LOCALE void PPDeffactsCommand(void *); LOCALE int PPDeffacts(void *,const char *,const char *); LOCALE void ListDeffactsCommand(void *); LOCALE void EnvListDeffacts(void *,const char *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void GetDeffactsList(DATA_OBJECT_PTR,void *); LOCALE intBool Undeffacts(void *); #if DEBUGGING_FUNCTIONS LOCALE void ListDeffacts(const char *,void *); #endif #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_dffctbsc */ clips_core_source_630/core/rulebin.h0000755000175000017500000001204612374024070016044 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFRULE BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, and LOGICAL_DEPENDENCIES */ /* compilation flags. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Added support for alpha memories. */ /* */ /* Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /*************************************************************/ #if (! RUN_TIME) #ifndef _H_rulebin #define _H_rulebin #include "modulbin.h" #include "cstrcbin.h" #ifndef _H_network #include "network.h" #endif struct bsaveDefrule { struct bsaveConstructHeader header; int salience; int localVarCnt; unsigned int complexity : 12; unsigned int autoFocus : 1; long dynamicSalience; long actions; long logicalJoin; long lastJoin; long disjunct; }; struct bsavePatternNodeHeader { long entryJoin; long rightHash; unsigned int singlefieldNode : 1; unsigned int multifieldNode : 1; unsigned int stopNode : 1; unsigned int blocked : 1; unsigned int initialize : 1; unsigned int marked : 1; unsigned int beginSlot : 1; unsigned int endSlot : 1; unsigned int selector : 1; }; struct bsaveDefruleModule { struct bsaveDefmoduleItemHeader header; }; struct bsaveJoinLink { char enterDirection; long join; long next; }; struct bsaveJoinNode { unsigned int firstJoin : 1; unsigned int logicalJoin : 1; unsigned int joinFromTheRight : 1; unsigned int patternIsNegated : 1; unsigned int patternIsExists : 1; unsigned int rhsType : 3; unsigned int depth : 7; long networkTest; long secondaryNetworkTest; long leftHash; long rightHash; long rightSideEntryStructure; long nextLinks; long lastLevel; long rightMatchNode; long ruleToActivate; }; #define RULEBIN_DATA 20 struct defruleBinaryData { long NumberOfDefruleModules; long NumberOfDefrules; long NumberOfJoins; long NumberOfLinks; long RightPrimeIndex; long LeftPrimeIndex; struct defruleModule *ModuleArray; struct defrule *DefruleArray; struct joinNode *JoinArray; struct joinLink *LinkArray; }; #define DefruleBinaryData(theEnv) ((struct defruleBinaryData *) GetEnvironmentData(theEnv,RULEBIN_DATA)) #define BloadDefrulePointer(x,i) ((struct defrule *) ((i == -1L) ? NULL : &x[i])) #define BsaveJoinIndex(joinPtr) ((joinPtr == NULL) ? -1L : ((struct joinNode *) joinPtr)->bsaveID) #define BloadJoinPointer(i) ((struct joinNode *) ((i == -1L) ? NULL : &DefruleBinaryData(theEnv)->JoinArray[i])) #define BsaveJoinLinkIndex(linkPtr) ((linkPtr == NULL) ? -1L : ((struct joinLink *) linkPtr)->bsaveID) #define BloadJoinLinkPointer(i) ((struct joinLink *) ((i == -1L) ? NULL : &DefruleBinaryData(theEnv)->LinkArray[i])) #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefruleBinarySetup(void *); LOCALE void UpdatePatternNodeHeader(void *,struct patternNodeHeader *, struct bsavePatternNodeHeader *); LOCALE void AssignBsavePatternHeaderValues(void *,struct bsavePatternNodeHeader *, struct patternNodeHeader *); LOCALE void *BloadDefruleModuleReference(void *,int); #endif /* _H_rulebin */ #endif /* (! RUN_TIME) */ clips_core_source_630/core/._clsltpsr.c0000755000175000017500000000040712373714251016466 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/expressn.c0000755000175000017500000003652612373740007016263 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains routines for creating, deleting, */ /* compacting, installing, and hashing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Corrected link errors with non-default */ /* setup.h configuration settings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Changed integer type/precision. */ /* */ /* Changed expression hashing value. */ /* */ /*************************************************************/ #define _EXPRESSN_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "bload.h" #include "memalloc.h" #include "envrnmnt.h" #include "router.h" #include "extnfunc.h" #include "exprnops.h" #include "prntutil.h" #include "evaluatn.h" #include "expressn.h" #define PRIME_ONE 257 #define PRIME_TWO 263 #define PRIME_THREE 269 /****************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /****************************************/ #if (! RUN_TIME) static long ListToPacked(struct expr *, struct expr *,long); static EXPRESSION_HN *FindHashedExpression(void *,EXPRESSION *,unsigned *,EXPRESSION_HN **); static unsigned HashExpression(EXPRESSION *); #endif static void DeallocateExpressionData(void *); /**************************************************/ /* InitExpressionData: Initializes the function */ /* pointers used in generating some expressions */ /* and the expression hash table. */ /**************************************************/ globle void InitExpressionData( void *theEnv) { #if ! RUN_TIME register unsigned i; #endif AllocateEnvironmentData(theEnv,EXPRESSION_DATA,sizeof(struct expressionData),DeallocateExpressionData); #if ! RUN_TIME InitExpressionPointers(theEnv); ExpressionData(theEnv)->ExpressionHashTable = (EXPRESSION_HN **) gm2(theEnv,(int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE)); for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++) ExpressionData(theEnv)->ExpressionHashTable[i] = NULL; #endif } /*****************************************/ /* DeallocateExpressionData: Deallocates */ /* environment data for expressions. */ /*****************************************/ static void DeallocateExpressionData( void *theEnv) { #if ! RUN_TIME int i; EXPRESSION_HN *tmpPtr, *nextPtr; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) if (! Bloaded(theEnv)) #endif { for (i = 0; i < EXPRESSION_HASH_SIZE; i++) { tmpPtr = ExpressionData(theEnv)->ExpressionHashTable[i]; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; ReturnPackedExpression(theEnv,tmpPtr->exp); rtn_struct(theEnv,exprHashNode,tmpPtr); tmpPtr = nextPtr; } } } rm(theEnv,ExpressionData(theEnv)->ExpressionHashTable, (int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE)); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) if ((ExpressionData(theEnv)->NumberOfExpressions != 0) && Bloaded(theEnv)) { genfree(theEnv,(void *) ExpressionData(theEnv)->ExpressionArray, ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr)); } #endif } /****************************************************/ /* InitExpressionPointers: Initializes the function */ /* pointers used in generating some expressions. */ /****************************************************/ globle void InitExpressionPointers( void *theEnv) { ExpressionData(theEnv)->PTR_AND = (void *) FindFunction(theEnv,"and"); ExpressionData(theEnv)->PTR_OR = (void *) FindFunction(theEnv,"or"); ExpressionData(theEnv)->PTR_EQ = (void *) FindFunction(theEnv,"eq"); ExpressionData(theEnv)->PTR_NEQ = (void *) FindFunction(theEnv,"neq"); ExpressionData(theEnv)->PTR_NOT = (void *) FindFunction(theEnv,"not"); if ((ExpressionData(theEnv)->PTR_AND == NULL) || (ExpressionData(theEnv)->PTR_OR == NULL) || (ExpressionData(theEnv)->PTR_EQ == NULL) || (ExpressionData(theEnv)->PTR_NEQ == NULL) || (ExpressionData(theEnv)->PTR_NOT == NULL)) { SystemError(theEnv,"EXPRESSN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } } /***************************************************/ /* ExpressionInstall: Increments the busy count of */ /* atomic data values found in an expression. */ /***************************************************/ globle void ExpressionInstall( void *theEnv, struct expr *expression) { if (expression == NULL) return; while (expression != NULL) { AtomInstall(theEnv,expression->type,expression->value); ExpressionInstall(theEnv,expression->argList); expression = expression->nextArg; } } /*****************************************************/ /* ExpressionDeinstall: Decrements the busy count of */ /* atomic data values found in an expression. */ /*****************************************************/ globle void ExpressionDeinstall( void *theEnv, struct expr *expression) { if (expression == NULL) return; while (expression != NULL) { AtomDeinstall(theEnv,expression->type,expression->value); ExpressionDeinstall(theEnv,expression->argList); expression = expression->nextArg; } } #if (! RUN_TIME) /***********************************************************************/ /* PackExpression: Copies an expression (created using multiple memory */ /* requests) into an array (created using a single memory request) */ /* while maintaining all appropriate links in the expression. A */ /* packed expression requires less total memory because it reduces */ /* the overhead required for multiple memory allocations. */ /***********************************************************************/ globle struct expr *PackExpression( void *theEnv, struct expr *original) { struct expr *packPtr; if (original == NULL) return (NULL); packPtr = (struct expr *) gm3(theEnv,(long) sizeof (struct expr) * (long) ExpressionSize(original)); ListToPacked(original,packPtr,0L); return(packPtr); } /***********************************************************/ /* ListToPacked: Copies a list of expressions to an array. */ /***********************************************************/ static long ListToPacked( struct expr *original, struct expr *destination, long count) { long i; if (original == NULL) { return(count); } while (original != NULL) { i = count; count++; destination[i].type = original->type; destination[i].value = original->value; if (original->argList == NULL) { destination[i].argList = NULL; } else { destination[i].argList = (struct expr *) &destination[(long) count]; count = ListToPacked(original->argList,destination,count); } if (original->nextArg == NULL) { destination[i].nextArg = NULL; } else { destination[i].nextArg = (struct expr *) &destination[(long) count]; } original = original->nextArg; } return(count); } /***************************************************************/ /* ReturnPackedExpression: Returns a packed expression created */ /* using PackExpression to the memory manager. */ /***************************************************************/ globle void ReturnPackedExpression( void *theEnv, struct expr *packPtr) { if (packPtr != NULL) { rm3(theEnv,(void *) packPtr,(long) sizeof (struct expr) * ExpressionSize(packPtr)); } } #endif /* (! RUN_TIME) */ /***********************************************/ /* ReturnExpression: Returns a multiply linked */ /* list of expr data structures. */ /***********************************************/ globle void ReturnExpression( void *theEnv, struct expr *waste) { register struct expr *tmp; while (waste != NULL) { if (waste->argList != NULL) ReturnExpression(theEnv,waste->argList); tmp = waste; waste = waste->nextArg; rtn_struct(theEnv,expr,tmp); } } #if (! RUN_TIME) /*************************************************** NAME : FindHashedExpression DESCRIPTION : Determines if a given expression is in the expression hash table INPUTS : 1) The expression 2) A buffer to hold the hash value 3) A buffer to hold the previous node in the hash chain RETURNS : The expression hash table entry (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ static EXPRESSION_HN *FindHashedExpression( void *theEnv, EXPRESSION *theExp, unsigned *hashval, EXPRESSION_HN **prv) { EXPRESSION_HN *exphash; if (theExp == NULL) return(NULL); *hashval = HashExpression(theExp); *prv = NULL; exphash = ExpressionData(theEnv)->ExpressionHashTable[*hashval]; while (exphash != NULL) { if (IdenticalExpression(exphash->exp,theExp)) return(exphash); *prv = exphash; exphash = exphash->next; } return(NULL); } /*************************************************** NAME : HashExpression DESCRIPTION : Assigns a deterministic number to an expression INPUTS : The expression RETURNS : The "value" of the expression SIDE EFFECTS : None NOTES : None ***************************************************/ static unsigned HashExpression( EXPRESSION *theExp) { unsigned long tally = PRIME_THREE; union { void *vv; unsigned long uv; } fis; if (theExp->argList != NULL) tally += HashExpression(theExp->argList) * PRIME_ONE; while (theExp != NULL) { tally += (unsigned long) (theExp->type * PRIME_TWO); fis.uv = 0; fis.vv = theExp->value; tally += fis.uv; theExp = theExp->nextArg; } return((unsigned) (tally % EXPRESSION_HASH_SIZE)); } /*************************************************** NAME : RemoveHashedExpression DESCRIPTION : Removes a hashed expression from the hash table INPUTS : The expression RETURNS : Nothing useful SIDE EFFECTS : Hash node removed (or use count decremented). If the hash node is removed, the expression is deinstalled and deleted NOTES : If the expression is in use by others, then the use count is merely decremented ***************************************************/ globle void RemoveHashedExpression( void *theEnv, EXPRESSION *theExp) { EXPRESSION_HN *exphash,*prv; unsigned hashval; exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv); if (exphash == NULL) return; if (--exphash->count != 0) return; if (prv == NULL) ExpressionData(theEnv)->ExpressionHashTable[hashval] = exphash->next; else prv->next = exphash->next; ExpressionDeinstall(theEnv,exphash->exp); ReturnPackedExpression(theEnv,exphash->exp); rtn_struct(theEnv,exprHashNode,exphash); } #endif /* (! RUN_TIME) */ #if (! BLOAD_ONLY) && (! RUN_TIME) /***************************************************** NAME : AddHashedExpression DESCRIPTION : Adds a new expression to the expression hash table (or increments the use count if it is already there) INPUTS : The (new) expression RETURNS : A pointer to the (new) hash node SIDE EFFECTS : Adds the new hash node or increments the count of an existing one NOTES : It is the caller's responsibility to delete the passed expression. This routine copies, packs and installs the given expression *****************************************************/ globle EXPRESSION *AddHashedExpression( void *theEnv, EXPRESSION *theExp) { EXPRESSION_HN *prv,*exphash; unsigned hashval; if (theExp == NULL) return(NULL); exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv); if (exphash != NULL) { exphash->count++; return(exphash->exp); } exphash = get_struct(theEnv,exprHashNode); exphash->hashval = hashval; exphash->count = 1; exphash->exp = PackExpression(theEnv,theExp); ExpressionInstall(theEnv,exphash->exp); exphash->next = ExpressionData(theEnv)->ExpressionHashTable[exphash->hashval]; ExpressionData(theEnv)->ExpressionHashTable[exphash->hashval] = exphash; exphash->bsaveID = 0L; return(exphash->exp); } #endif /* (! BLOAD_ONLY) && (! RUN_TIME) */ #if (BLOAD_AND_BSAVE || BLOAD_ONLY || BLOAD || CONSTRUCT_COMPILER) && (! RUN_TIME) /*************************************************** NAME : HashedExpressionIndex DESCRIPTION : Finds the expression bload array index for a hashed expression INPUTS : The expression RETURNS : The bload index SIDE EFFECTS : None NOTES : None ***************************************************/ globle long HashedExpressionIndex( void *theEnv, EXPRESSION *theExp) { EXPRESSION_HN *exphash,*prv; unsigned hashval; if (theExp == NULL) return(-1L); exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv); return((exphash != NULL) ? exphash->bsaveID : -1L); } #endif /* (BLOAD_AND_BSAVE || BLOAD_ONLY || BLOAD || CONSTRUCT_COMPILER) && (! RUN_TIME) */ clips_core_source_630/core/._conscomp.c0000755000175000017500000000040712462771770016451 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._iofun.h0000755000175000017500000000040712373756315015754 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrcfun.h0000755000175000017500000000040712424473411016431 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._reteutil.c0000755000175000017500000000040712500721260016443 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dfinsbin.c0000755000175000017500000000040712373731174016417 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/bsave.c0000755000175000017500000004640412375756163015524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* BSAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for saving constructs to */ /* a binary file. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Used genstrncpy instead of strncpy. */ /* */ /* Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _BSAVE_SOURCE_ #include "setup.h" #include "argacces.h" #include "bload.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "moduldef.h" #include "router.h" #include "symblbin.h" #include "bsave.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void FindNeededItems(void *); static void InitializeFunctionNeededFlags(void *); static void WriteNeededFunctions(void *,FILE *); static size_t FunctionBinarySize(void *); static void WriteBinaryHeader(void *,FILE *); static void WriteBinaryFooter(void *,FILE *); #endif static void DeallocateBsaveData(void *); /**********************************************/ /* InitializeBsaveData: Allocates environment */ /* data for the bsave command. */ /**********************************************/ globle void InitializeBsaveData( void *theEnv) { AllocateEnvironmentData(theEnv,BSAVE_DATA,sizeof(struct bsaveData),DeallocateBsaveData); } /************************************************/ /* DeallocateBsaveData: Deallocates environment */ /* data for the bsave command. */ /************************************************/ static void DeallocateBsaveData( void *theEnv) { struct BinaryItem *tmpPtr, *nextPtr; tmpPtr = BsaveData(theEnv)->ListOfBinaryItems; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,BinaryItem,tmpPtr); tmpPtr = nextPtr; } } /**************************************/ /* BsaveCommand: H/L access routine */ /* for the bsave command. */ /**************************************/ globle int BsaveCommand( void *theEnv) { #if (! RUN_TIME) && BLOAD_AND_BSAVE const char *fileName; if (EnvArgCountCheck(theEnv,"bsave",EXACTLY,1) == -1) return(FALSE); fileName = GetFileName(theEnv,"bsave",1); if (fileName != NULL) { if (EnvBsave(theEnv,fileName)) return(TRUE); } #else #if MAC_XCD #pragma unused(theEnv) #endif #endif return(FALSE); } #if BLOAD_AND_BSAVE /******************************/ /* EnvBsave: C access routine */ /* for the bsave command. */ /******************************/ globle intBool EnvBsave( void *theEnv, const char *fileName) { FILE *fp; struct BinaryItem *biPtr; char constructBuffer[CONSTRUCT_HEADER_SIZE]; long saveExpressionCount; /*===================================*/ /* A bsave can't occur when a binary */ /* image is already loaded. */ /*===================================*/ if (Bloaded(theEnv)) { PrintErrorID(theEnv,"BSAVE",1,FALSE); EnvPrintRouter(theEnv,WERROR, "Cannot perform a binary save while a binary load is in effect.\n"); return(0); } /*================*/ /* Open the file. */ /*================*/ if ((fp = GenOpen(theEnv,fileName,"wb")) == NULL) { OpenErrorMessage(theEnv,"bsave",fileName); return(0); } /*==============================*/ /* Remember the current module. */ /*==============================*/ SaveCurrentModule(theEnv); /*==================================*/ /* Write binary header to the file. */ /*==================================*/ WriteBinaryHeader(theEnv,fp); /*===========================================*/ /* Initialize count variables, index values, */ /* and determine some of the data structures */ /* which need to be saved. */ /*===========================================*/ ExpressionData(theEnv)->ExpressionCount = 0; InitializeFunctionNeededFlags(theEnv); InitAtomicValueNeededFlags(theEnv); FindHashedExpressions(theEnv); FindNeededItems(theEnv); SetAtomicValueIndices(theEnv,FALSE); /*===============================*/ /* Save the functions and atoms. */ /*===============================*/ WriteNeededFunctions(theEnv,fp); WriteNeededAtomicValues(theEnv,fp); /*=========================================*/ /* Write out the number of expression data */ /* structures in the binary image. */ /*=========================================*/ GenWrite((void *) &ExpressionData(theEnv)->ExpressionCount,(unsigned long) sizeof(unsigned long),fp); /*===========================================*/ /* Save the numbers indicating the amount of */ /* memory needed to bload the constructs. */ /*===========================================*/ for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->bsaveStorageFunction != NULL) { genstrncpy(constructBuffer,biPtr->name,CONSTRUCT_HEADER_SIZE); GenWrite(constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp); (*biPtr->bsaveStorageFunction)(theEnv,fp); } } /*====================================*/ /* Write a binary footer to the file. */ /*====================================*/ WriteBinaryFooter(theEnv,fp); /*===================*/ /* Save expressions. */ /*===================*/ ExpressionData(theEnv)->ExpressionCount = 0; BsaveHashedExpressions(theEnv,fp); saveExpressionCount = ExpressionData(theEnv)->ExpressionCount; BsaveConstructExpressions(theEnv,fp); ExpressionData(theEnv)->ExpressionCount = saveExpressionCount; /*===================*/ /* Save constraints. */ /*===================*/ WriteNeededConstraints(theEnv,fp); /*==================*/ /* Save constructs. */ /*==================*/ for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->bsaveFunction != NULL) { genstrncpy(constructBuffer,biPtr->name,CONSTRUCT_HEADER_SIZE); GenWrite(constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp); (*biPtr->bsaveFunction)(theEnv,fp); } } /*===================================*/ /* Save a binary footer to the file. */ /*===================================*/ WriteBinaryFooter(theEnv,fp); /*===========*/ /* Clean up. */ /*===========*/ RestoreAtomicValueBuckets(theEnv); /*=================*/ /* Close the file. */ /*=================*/ GenClose(theEnv,fp); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*========================================*/ /* Return TRUE to indicate success. */ /*========================================*/ return(TRUE); } /*********************************************/ /* InitializeFunctionNeededFlags: Marks each */ /* function in the list of functions as */ /* being unneeded by this binary image. */ /*********************************************/ static void InitializeFunctionNeededFlags( void *theEnv) { struct FunctionDefinition *functionList; for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { functionList->bsaveIndex = 0; } } /**********************************************************/ /* FindNeededItems: Searches through the constructs for */ /* the functions, constraints, or atoms that are needed */ /* by that construct. This routine also counts the */ /* number of expressions in use (through a global). */ /**********************************************************/ static void FindNeededItems( void *theEnv) { struct BinaryItem *biPtr; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->findFunction != NULL) (*biPtr->findFunction)(theEnv); } } /****************************************************/ /* WriteNeededFunctions: Writes the names of needed */ /* functions to the binary save file. */ /****************************************************/ static void WriteNeededFunctions( void *theEnv, FILE *fp) { unsigned long int count = 0; size_t space, length; struct FunctionDefinition *functionList; /*================================================*/ /* Assign each function an index if it is needed. */ /*================================================*/ for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { if (functionList->bsaveIndex) { functionList->bsaveIndex = (short int) count++; } else { functionList->bsaveIndex = -1; } } /*===================================================*/ /* Write the number of function names to be written. */ /*===================================================*/ GenWrite(&count,(unsigned long) sizeof(unsigned long int),fp); if (count == 0) { GenWrite(&count,(unsigned long) sizeof(unsigned long int),fp); return; } /*================================*/ /* Determine the amount of space */ /* needed for the function names. */ /*================================*/ space = FunctionBinarySize(theEnv); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*===============================*/ /* Write out the function names. */ /*===============================*/ for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { if (functionList->bsaveIndex >= 0) { length = strlen(ValueToString(functionList->callFunctionName)) + 1; GenWrite((void *) ValueToString(functionList->callFunctionName),(unsigned long) length,fp); } } } /*********************************************/ /* FunctionBinarySize: Determines the number */ /* of bytes needed to save all of the */ /* function names in the binary save file. */ /*********************************************/ static size_t FunctionBinarySize( void *theEnv) { size_t size = 0; struct FunctionDefinition *functionList; for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { if (functionList->bsaveIndex >= 0) { size += strlen(ValueToString(functionList->callFunctionName)) + 1; } } return(size); } /***************************************************/ /* SaveBloadCount: Used to save the data structure */ /* count values when a binary save command is */ /* issued when a binary image is loaded. */ /***************************************************/ globle void SaveBloadCount( void *theEnv, long cnt) { BLOADCNTSV *tmp, *prv; tmp = get_struct(theEnv,bloadcntsv); tmp->val = cnt; tmp->nxt = NULL; if (BsaveData(theEnv)->BloadCountSaveTop == NULL) { BsaveData(theEnv)->BloadCountSaveTop = tmp; } else { prv = BsaveData(theEnv)->BloadCountSaveTop; while (prv->nxt != NULL) { prv = prv->nxt; } prv->nxt = tmp; } } /**************************************************/ /* RestoreBloadCount: Restores the data structure */ /* count values after a binary save command is */ /* completed when a binary image is loaded. */ /**************************************************/ globle void RestoreBloadCount( void *theEnv, long *cnt) { BLOADCNTSV *tmp; *cnt = BsaveData(theEnv)->BloadCountSaveTop->val; tmp = BsaveData(theEnv)->BloadCountSaveTop; BsaveData(theEnv)->BloadCountSaveTop = BsaveData(theEnv)->BloadCountSaveTop->nxt; rtn_struct(theEnv,bloadcntsv,tmp); } /**********************************************/ /* MarkNeededItems: Examines an expression to */ /* determine which items are needed to save */ /* an expression as part of a binary image. */ /**********************************************/ globle void MarkNeededItems( void *theEnv, struct expr *testPtr) { while (testPtr != NULL) { switch (testPtr->type) { case SYMBOL: case STRING: case GBL_VARIABLE: case INSTANCE_NAME: ((SYMBOL_HN *) testPtr->value)->neededSymbol = TRUE; break; case FLOAT: ((FLOAT_HN *) testPtr->value)->neededFloat = TRUE; break; case INTEGER: ((INTEGER_HN *) testPtr->value)->neededInteger = TRUE; break; case FCALL: ((struct FunctionDefinition *) testPtr->value)->bsaveIndex = TRUE; break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type]->bitMap) { ((BITMAP_HN *) testPtr->value)->neededBitMap = TRUE; } break; } if (testPtr->argList != NULL) { MarkNeededItems(theEnv,testPtr->argList); } testPtr = testPtr->nextArg; } } /******************************************************/ /* WriteBinaryHeader: Writes a binary header used for */ /* verification when a binary image is loaded. */ /******************************************************/ static void WriteBinaryHeader( void *theEnv, FILE *fp) { GenWrite((void *) BloadData(theEnv)->BinaryPrefixID,(unsigned long) strlen(BloadData(theEnv)->BinaryPrefixID) + 1,fp); GenWrite((void *) BloadData(theEnv)->BinaryVersionID,(unsigned long) strlen(BloadData(theEnv)->BinaryVersionID) + 1,fp); } /******************************************************/ /* WriteBinaryFooter: Writes a binary footer used for */ /* verification when a binary image is loaded. */ /******************************************************/ static void WriteBinaryFooter( void *theEnv, FILE *fp) { char footerBuffer[CONSTRUCT_HEADER_SIZE]; genstrncpy(footerBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE); GenWrite(footerBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp); } #endif /* BLOAD_AND_BSAVE */ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE /**********************************************************/ /* AddBinaryItem: Informs the bload/bsave commands of the */ /* appropriate access functions needed to save/load the */ /* data structures of a construct or other "item" to a */ /* binary file. */ /**********************************************************/ globle intBool AddBinaryItem( void *theEnv, const char *name, int priority, void (*findFunction)(void *), void (*expressionFunction)(void *,FILE *), void (*bsaveStorageFunction)(void *,FILE *), void (*bsaveFunction)(void *,FILE *), void (*bloadStorageFunction)(void *), void (*bloadFunction)(void *), void (*clearFunction)(void *)) { struct BinaryItem *newPtr, *currentPtr, *lastPtr = NULL; /*========================================*/ /* Create the binary item data structure. */ /*========================================*/ newPtr = get_struct(theEnv,BinaryItem); newPtr->name = name; newPtr->findFunction = findFunction; newPtr->expressionFunction = expressionFunction; newPtr->bsaveStorageFunction = bsaveStorageFunction; newPtr->bsaveFunction = bsaveFunction; newPtr->bloadStorageFunction = bloadStorageFunction; newPtr->bloadFunction = bloadFunction; newPtr->clearFunction = clearFunction; newPtr->priority = priority; /*=================================*/ /* If no binary items are defined, */ /* just put the item on the list. */ /*=================================*/ if (BsaveData(theEnv)->ListOfBinaryItems == NULL) { newPtr->next = NULL; BsaveData(theEnv)->ListOfBinaryItems = newPtr; return(TRUE); } /*=========================================*/ /* Otherwise, place the binary item at the */ /* appropriate place in the list of binary */ /* items based on its priority. */ /*=========================================*/ currentPtr = BsaveData(theEnv)->ListOfBinaryItems; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = BsaveData(theEnv)->ListOfBinaryItems; BsaveData(theEnv)->ListOfBinaryItems = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } /*==================================*/ /* Return TRUE to indicate the item */ /* was successfully added. */ /*==================================*/ return(TRUE); } #endif /* BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if BLOAD_AND_BSAVE #if ALLOW_ENVIRONMENT_GLOBALS globle intBool Bsave( const char *fileName) { return EnvBsave(GetCurrentEnvironment(),fileName); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* BLOAD_AND_BSAVE */ clips_core_source_630/core/._cstrnops.c0000755000175000017500000000040712373713614016475 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffctbsc.h0000755000175000017500000000040712373720715016405 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/globldef.h0000755000175000017500000001506012461253173016166 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFGLOBAL HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_globldef #define _H_globldef #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #define DEFGLOBAL_DATA 1 struct defglobalData { struct construct *DefglobalConstruct; int DefglobalModuleIndex; int ChangeToGlobals; #if DEBUGGING_FUNCTIONS unsigned WatchGlobals; #endif intBool ResetGlobals; struct entityRecord GlobalInfo; struct entityRecord DefglobalPtrRecord; long LastModuleIndex; struct defmodule *TheDefmodule; #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefglobalCodeItem; #endif }; struct defglobal { struct constructHeader header; unsigned int watch : 1; unsigned int inScope : 1; long busyCount; DATA_OBJECT current; struct expr *initial; }; struct defglobalModule { struct defmoduleItemHeader header; }; #define DefglobalData(theEnv) ((struct defglobalData *) GetEnvironmentData(theEnv,DEFGLOBAL_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeDefglobals(void *); LOCALE void *EnvFindDefglobal(void *,const char *); LOCALE void *EnvFindDefglobalInModule(void *,const char *); LOCALE void *EnvGetNextDefglobal(void *,void *); LOCALE void CreateInitialFactDefglobal(void); LOCALE intBool EnvIsDefglobalDeletable(void *,void *); LOCALE struct defglobalModule *GetDefglobalModuleItem(void *,struct defmodule *); LOCALE void QSetDefglobalValue(void *,struct defglobal *,DATA_OBJECT_PTR,int); LOCALE struct defglobal *QFindDefglobal(void *,struct symbolHashNode *); LOCALE void EnvGetDefglobalValueForm(void *,char *,size_t,void *); LOCALE int EnvGetGlobalsChanged(void *); LOCALE void EnvSetGlobalsChanged(void *,int); LOCALE intBool EnvGetDefglobalValue(void *,const char *,DATA_OBJECT_PTR); LOCALE intBool EnvSetDefglobalValue(void *,const char *,DATA_OBJECT_PTR); LOCALE void UpdateDefglobalScope(void *); LOCALE void *GetNextDefglobalInScope(void *,void *); LOCALE int QGetDefglobalValue(void *,void *,DATA_OBJECT_PTR); LOCALE const char *EnvDefglobalModule(void *,void *); LOCALE const char *EnvGetDefglobalName(void *,void *); LOCALE const char *EnvGetDefglobalPPForm(void *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *DefglobalModule(void *); LOCALE void *FindDefglobal(const char *); LOCALE const char *GetDefglobalName(void *); LOCALE const char *GetDefglobalPPForm(void *); LOCALE intBool GetDefglobalValue(const char *,DATA_OBJECT_PTR); LOCALE void GetDefglobalValueForm(char *,unsigned,void *); LOCALE int GetGlobalsChanged(void); LOCALE void *GetNextDefglobal(void *); LOCALE intBool IsDefglobalDeletable(void *); LOCALE intBool SetDefglobalValue(const char *,DATA_OBJECT_PTR); LOCALE void SetGlobalsChanged(int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_globldef */ clips_core_source_630/core/genrcbin.c0000755000175000017500000010410212373753415016174 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Generic Functions */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "bload.h" #include "bsave.h" #include "cstrcbin.h" #if OBJECT_SYSTEM #include "objbin.h" #endif #include "genrccom.h" #include "modulbin.h" #define _GENRCBIN_SOURCE_ #include "genrcbin.h" #include "router.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define MethodPointer(i) (((i) == -1L) ? NULL : (DEFMETHOD *) &DefgenericBinaryData(theEnv)->MethodArray[i]) #define RestrictionPointer(i) (((i) == -1L) ? NULL : (RESTRICTION *) &DefgenericBinaryData(theEnv)->RestrictionArray[i]) #define TypePointer(i) (((i) == -1L) ? NULL : (void **) &DefgenericBinaryData(theEnv)->TypeArray[i]) typedef struct bsaveRestriction { long types,query; short tcnt; } BSAVE_RESTRICTION; typedef struct bsaveMethod { short index; short restrictionCount, minRestrictions,maxRestrictions, localVarCount; int system; long restrictions,actions; } BSAVE_METHOD; typedef struct bsaveGenericFunc { struct bsaveConstructHeader header; long methods; short mcnt; } BSAVE_GENERIC; typedef struct bsaveGenericModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFGENERIC_MODULE; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveGenericsFind(void *); static void MarkDefgenericItems(void *,struct constructHeader *,void *); static void BsaveGenericsExpressions(void *,FILE *); static void BsaveMethodExpressions(void *,struct constructHeader *,void *); static void BsaveRestrictionExpressions(void *,struct constructHeader *,void *); static void BsaveGenerics(void *,FILE *); static void BsaveDefgenericHeader(void *,struct constructHeader *,void *); static void BsaveMethods(void *,struct constructHeader *,void *); static void BsaveMethodRestrictions(void *,struct constructHeader *,void *); static void BsaveRestrictionTypes(void *,struct constructHeader *,void *); static void BsaveStorageGenerics(void *,FILE *); #endif static void BloadStorageGenerics(void *); static void BloadGenerics(void *); static void UpdateGenericModule(void *,void *,long); static void UpdateGeneric(void *,void *,long); static void UpdateMethod(void *,void *,long); static void UpdateRestriction(void *,void *,long); static void UpdateType(void *,void *,long); static void ClearBloadGenerics(void *); static void DeallocateDefgenericBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupGenericsBload DESCRIPTION : Initializes data structures and routines for binary loads of generic function constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupGenericsBload( void *theEnv) { AllocateEnvironmentData(theEnv,GENRCBIN_DATA,sizeof(struct defgenericBinaryData),DeallocateDefgenericBinaryData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"generic functions",0,BsaveGenericsFind,BsaveGenericsExpressions, BsaveStorageGenerics,BsaveGenerics, BloadStorageGenerics,BloadGenerics, ClearBloadGenerics); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"generic functions",0,NULL,NULL,NULL,NULL, BloadStorageGenerics,BloadGenerics, ClearBloadGenerics); #endif } /***********************************************************/ /* DeallocateDefgenericBinaryData: Deallocates environment */ /* data for the defgeneric binary functionality. */ /***********************************************************/ static void DeallocateDefgenericBinaryData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) size_t space; space = DefgenericBinaryData(theEnv)->GenericCount * sizeof(struct defgeneric); if (space != 0) genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->DefgenericArray,space); space = DefgenericBinaryData(theEnv)->MethodCount * sizeof(struct method); if (space != 0) genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->MethodArray,space); space = DefgenericBinaryData(theEnv)->RestrictionCount * sizeof(struct restriction); if (space != 0) genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->RestrictionArray,space); space = DefgenericBinaryData(theEnv)->TypeCount * sizeof(void *); if (space != 0) genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->TypeArray,space); space = DefgenericBinaryData(theEnv)->ModuleCount * sizeof(struct defgenericModule); if (space != 0) genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->ModuleArray,space); #endif } /*************************************************** NAME : BloadDefgenericModuleReference DESCRIPTION : Returns a pointer to the appropriate defgeneric module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDefgenericModuleReference( void *theEnv, int theIndex) { return ((void *) &DefgenericBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveGenericsFind DESCRIPTION : For all generic functions and their methods, this routine marks all the needed symbols and system functions. Also, it also counts the number of expression structures needed. Also, counts total number of generics, methods, restrictions and types. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols and system function are marked in their structures NOTES : Also sets bsaveIndex for each generic function (assumes generic functions will be bsaved in order of binary list) ***************************************************************************/ static void BsaveGenericsFind( void *theEnv) { SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->GenericCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->MethodCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->RestrictionCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->TypeCount); DefgenericBinaryData(theEnv)->GenericCount = 0L; DefgenericBinaryData(theEnv)->MethodCount = 0L; DefgenericBinaryData(theEnv)->RestrictionCount = 0L; DefgenericBinaryData(theEnv)->TypeCount = 0L; DefgenericBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDefgenericItems,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,NULL); } /*************************************************** NAME : MarkDefgenericItems DESCRIPTION : Marks the needed items for a defgeneric (and methods) bsave INPUTS : 1) The defgeneric 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Needed items marked NOTES : None ***************************************************/ static void MarkDefgenericItems( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { #if MAC_XCD #pragma unused(userBuffer) #endif DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; long i,j; DEFMETHOD *meth; RESTRICTION *rptr; MarkConstructHeaderNeededItems(&gfunc->header,DefgenericBinaryData(theEnv)->GenericCount++); DefgenericBinaryData(theEnv)->MethodCount += (long) gfunc->mcnt; for (i = 0 ; i < gfunc->mcnt ; i++) { meth = &gfunc->methods[i]; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions); MarkNeededItems(theEnv,meth->actions); DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount; for (j = 0 ; j < meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query); MarkNeededItems(theEnv,rptr->query); DefgenericBinaryData(theEnv)->TypeCount += rptr->tcnt; } } } /*************************************************** NAME : BsaveGenericsExpressions DESCRIPTION : Writes out all expressions needed by generic functions INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveGenericsExpressions( void *theEnv, FILE *fp) { /* ================================================================ Important to save all expressions for methods before any expressions for restrictions, since methods will be stored first ================================================================ */ DoForAllConstructs(theEnv,BsaveMethodExpressions,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); DoForAllConstructs(theEnv,BsaveRestrictionExpressions,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveMethodExpressions DESCRIPTION : Saves the needed expressions for a defgeneric methods bsave INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Method action expressions saved NOTES : None ***************************************************/ static void BsaveMethodExpressions( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; long i; for (i = 0 ; i < gfunc->mcnt ; i++) BsaveExpression(theEnv,gfunc->methods[i].actions,(FILE *) userBuffer); } /*************************************************** NAME : BsaveRestrictionExpressions DESCRIPTION : Saves the needed expressions for a defgeneric method restriction queries bsave INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Method restriction query expressions saved NOTES : None ***************************************************/ static void BsaveRestrictionExpressions( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; long i,j; DEFMETHOD *meth; for (i = 0 ; i < gfunc->mcnt ; i++) { meth = &gfunc->methods[i]; for (j = 0 ; j < meth->restrictionCount ; j++) BsaveExpression(theEnv,meth->restrictions[j].query,(FILE *) userBuffer); } } /*********************************************************** NAME : BsaveStorageGenerics DESCRIPTION : Writes out number of each type of structure required for generics Space required for counts (unsigned long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ***********************************************************/ static void BsaveStorageGenerics( void *theEnv, FILE *fp) { size_t space; space = sizeof(long) * 5; GenWrite((void *) &space,sizeof(size_t),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->ModuleCount,sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->GenericCount,sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->MethodCount,sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->RestrictionCount,sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->TypeCount,sizeof(long),fp); } /**************************************************************************************** NAME : BsaveGenerics DESCRIPTION : Writes out generic function in binary format Space required (unsigned long) All generic modules (sizeof(DEFGENERIC_MODULE) * Number of generic modules) All generic headers (sizeof(DEFGENERIC) * Number of generics) All methods (sizeof(DEFMETHOD) * Number of methods) All method restrictions (sizeof(RESTRICTION) * Number of restrictions) All restriction type arrays (sizeof(void *) * # of types) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ****************************************************************************************/ static void BsaveGenerics( void *theEnv, FILE *fp) { struct defmodule *theModule; DEFGENERIC_MODULE *theModuleItem; size_t space; BSAVE_DEFGENERIC_MODULE dummy_generic_module; /* ===================================================================== Space is: Sum over all structures(sizeof(structure) * structure-cnt)) ===================================================================== */ space = ((unsigned long) DefgenericBinaryData(theEnv)->ModuleCount * sizeof(BSAVE_DEFGENERIC_MODULE)) + ((unsigned long) DefgenericBinaryData(theEnv)->GenericCount * sizeof(BSAVE_GENERIC)) + ((unsigned long) DefgenericBinaryData(theEnv)->MethodCount * sizeof(BSAVE_METHOD)) + ((unsigned long) DefgenericBinaryData(theEnv)->RestrictionCount * sizeof(BSAVE_RESTRICTION)) + ((unsigned long) DefgenericBinaryData(theEnv)->TypeCount * sizeof(unsigned long)); /* ================================================================ Write out the total amount of space required: modules,headers, methods, restrictions, types ================================================================ */ GenWrite((void *) &space,sizeof(size_t),fp); /* ====================================== Write out the generic function modules ====================================== */ DefgenericBinaryData(theEnv)->GenericCount = 0L; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFGENERIC_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"defgeneric")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_generic_module.header, &theModuleItem->header); GenWrite((void *) &dummy_generic_module, sizeof(BSAVE_DEFGENERIC_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ====================================== Write out the generic function headers ====================================== */ DefgenericBinaryData(theEnv)->MethodCount = 0L; DoForAllConstructs(theEnv,BsaveDefgenericHeader,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); /* ===================== Write out the methods ===================== */ DefgenericBinaryData(theEnv)->RestrictionCount = 0L; DoForAllConstructs(theEnv,BsaveMethods,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); /* ================================= Write out the method restrictions ================================= */ DefgenericBinaryData(theEnv)->TypeCount = 0L; DoForAllConstructs(theEnv,BsaveMethodRestrictions,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); /* ============================================================= Finally, write out the type lists for the method restrictions ============================================================= */ DoForAllConstructs(theEnv,BsaveRestrictionTypes,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->GenericCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->MethodCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->RestrictionCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->TypeCount); } /*************************************************** NAME : BsaveDefgenericHeader DESCRIPTION : Bsaves a generic function header INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric header saved NOTES : None ***************************************************/ static void BsaveDefgenericHeader( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; BSAVE_GENERIC dummy_generic; AssignBsaveConstructHeaderVals(&dummy_generic.header,&gfunc->header); dummy_generic.mcnt = gfunc->mcnt; if (gfunc->methods != NULL) { dummy_generic.methods = DefgenericBinaryData(theEnv)->MethodCount; DefgenericBinaryData(theEnv)->MethodCount += (long) gfunc->mcnt; } else dummy_generic.methods = -1L; GenWrite((void *) &dummy_generic,(unsigned long) sizeof(BSAVE_GENERIC),(FILE *) userBuffer); } /*************************************************** NAME : BsaveMethods DESCRIPTION : Bsaves defgeneric methods INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric methods saved NOTES : None ***************************************************/ static void BsaveMethods( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; DEFMETHOD *meth; BSAVE_METHOD dummy_method; long i; for (i = 0 ; i < gfunc->mcnt ; i++) { meth = &gfunc->methods[i]; dummy_method.index = meth->index; dummy_method.restrictionCount = meth->restrictionCount; dummy_method.minRestrictions = meth->minRestrictions; dummy_method.maxRestrictions = meth->maxRestrictions; dummy_method.localVarCount = meth->localVarCount; dummy_method.system = meth->system; if (meth->restrictions != NULL) { dummy_method.restrictions = DefgenericBinaryData(theEnv)->RestrictionCount; DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount; } else dummy_method.restrictions = -1L; if (meth->actions != NULL) { dummy_method.actions = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions); } else dummy_method.actions = -1L; GenWrite((void *) &dummy_method,sizeof(BSAVE_METHOD),(FILE *) userBuffer); } } /****************************************************** NAME : BsaveMethodRestrictions DESCRIPTION : Bsaves defgeneric methods' retrictions INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric methods' restrictions saved NOTES : None ******************************************************/ static void BsaveMethodRestrictions( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; BSAVE_RESTRICTION dummy_restriction; RESTRICTION *rptr; short i,j; for (i = 0 ; i < gfunc->mcnt ; i++) { for (j = 0 ; j < gfunc->methods[i].restrictionCount ; j++) { rptr = &gfunc->methods[i].restrictions[j]; dummy_restriction.tcnt = rptr->tcnt; if (rptr->types != NULL) { dummy_restriction.types = DefgenericBinaryData(theEnv)->TypeCount; DefgenericBinaryData(theEnv)->TypeCount += rptr->tcnt; } else dummy_restriction.types = -1L; if (rptr->query != NULL) { dummy_restriction.query = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query); } else dummy_restriction.query = -1L; GenWrite((void *) &dummy_restriction, sizeof(BSAVE_RESTRICTION),(FILE *) userBuffer); } } } /************************************************************* NAME : BsaveRestrictionTypes DESCRIPTION : Bsaves defgeneric methods' retrictions' types INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric methods' restrictions' types saved NOTES : None *************************************************************/ static void BsaveRestrictionTypes( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; long dummy_type; RESTRICTION *rptr; short i,j,k; #if MAC_XCD #pragma unused(theEnv) #endif for (i = 0 ; i < gfunc->mcnt ; i++) { for (j = 0 ; j < gfunc->methods[i].restrictionCount ; j++) { rptr = &gfunc->methods[i].restrictions[j]; for (k = 0 ; k < rptr->tcnt ; k++) { #if OBJECT_SYSTEM dummy_type = DefclassIndex(rptr->types[k]); #else dummy_type = (long) ((INTEGER_HN *) rptr->types[k])->contents; #endif GenWrite(&dummy_type,sizeof(long),(FILE *) userBuffer); } } } } #endif /*********************************************************************** NAME : BloadStorageGenerics DESCRIPTION : This routine space required for generic function structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageGenerics( void *theEnv) { size_t space; long counts[5]; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; GenReadBinary(theEnv,(void *) counts,space); DefgenericBinaryData(theEnv)->ModuleCount = counts[0]; DefgenericBinaryData(theEnv)->GenericCount = counts[1]; DefgenericBinaryData(theEnv)->MethodCount = counts[2]; DefgenericBinaryData(theEnv)->RestrictionCount = counts[3]; DefgenericBinaryData(theEnv)->TypeCount = counts[4]; if (DefgenericBinaryData(theEnv)->ModuleCount != 0L) { space = (sizeof(DEFGENERIC_MODULE) * DefgenericBinaryData(theEnv)->ModuleCount); DefgenericBinaryData(theEnv)->ModuleArray = (DEFGENERIC_MODULE *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->GenericCount != 0L) { space = (sizeof(DEFGENERIC) * DefgenericBinaryData(theEnv)->GenericCount); DefgenericBinaryData(theEnv)->DefgenericArray = (DEFGENERIC *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->MethodCount != 0L) { space = (sizeof(DEFMETHOD) * DefgenericBinaryData(theEnv)->MethodCount); DefgenericBinaryData(theEnv)->MethodArray = (DEFMETHOD *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->RestrictionCount != 0L) { space = (sizeof(RESTRICTION) * DefgenericBinaryData(theEnv)->RestrictionCount); DefgenericBinaryData(theEnv)->RestrictionArray = (RESTRICTION *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->TypeCount != 0L) { space = (sizeof(void *) * DefgenericBinaryData(theEnv)->TypeCount); DefgenericBinaryData(theEnv)->TypeArray = (void * *) genalloc(theEnv,space); } } /********************************************************************* NAME : BloadGenerics DESCRIPTION : This routine reads generic function information from a binary file in four chunks: Generic-header array Method array Method restrictions array Restriction types array This routine moves through the generic function binary arrays updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished ********************************************************************/ static void BloadGenerics( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (DefgenericBinaryData(theEnv)->ModuleCount == 0L) return; BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->ModuleCount,sizeof(BSAVE_DEFGENERIC_MODULE),UpdateGenericModule); if (DefgenericBinaryData(theEnv)->GenericCount == 0L) return; BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->GenericCount,sizeof(BSAVE_GENERIC),UpdateGeneric); BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->MethodCount,sizeof(BSAVE_METHOD),UpdateMethod); BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->RestrictionCount,sizeof(BSAVE_RESTRICTION),UpdateRestriction); BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->TypeCount,sizeof(long),UpdateType); } /********************************************* Bload update routines for generic structures *********************************************/ static void UpdateGenericModule( void *theEnv, void *buf, long obji) { BSAVE_DEFGENERIC_MODULE *bdptr; bdptr = (BSAVE_DEFGENERIC_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&DefgenericBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFGENERIC),(void *) DefgenericBinaryData(theEnv)->DefgenericArray); } static void UpdateGeneric( void *theEnv, void *buf, long obji) { BSAVE_GENERIC *bgp; DEFGENERIC *gp; bgp = (BSAVE_GENERIC *) buf; gp = (DEFGENERIC *) &DefgenericBinaryData(theEnv)->DefgenericArray[obji]; UpdateConstructHeader(theEnv,&bgp->header,&gp->header, (int) sizeof(DEFGENERIC_MODULE),(void *) DefgenericBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFGENERIC),(void *) DefgenericBinaryData(theEnv)->DefgenericArray); DefgenericBinaryData(theEnv)->DefgenericArray[obji].busy = 0; #if DEBUGGING_FUNCTIONS DefgenericBinaryData(theEnv)->DefgenericArray[obji].trace = DefgenericData(theEnv)->WatchGenerics; #endif DefgenericBinaryData(theEnv)->DefgenericArray[obji].methods = MethodPointer(bgp->methods); DefgenericBinaryData(theEnv)->DefgenericArray[obji].mcnt = bgp->mcnt; DefgenericBinaryData(theEnv)->DefgenericArray[obji].new_index = 0; } static void UpdateMethod( void *theEnv, void *buf, long obji) { BSAVE_METHOD *bmth; bmth = (BSAVE_METHOD *) buf; DefgenericBinaryData(theEnv)->MethodArray[obji].index = bmth->index; DefgenericBinaryData(theEnv)->MethodArray[obji].busy = 0; #if DEBUGGING_FUNCTIONS DefgenericBinaryData(theEnv)->MethodArray[obji].trace = DefgenericData(theEnv)->WatchMethods; #endif DefgenericBinaryData(theEnv)->MethodArray[obji].restrictionCount = bmth->restrictionCount; DefgenericBinaryData(theEnv)->MethodArray[obji].minRestrictions = bmth->minRestrictions; DefgenericBinaryData(theEnv)->MethodArray[obji].maxRestrictions = bmth->maxRestrictions; DefgenericBinaryData(theEnv)->MethodArray[obji].localVarCount = bmth->localVarCount; DefgenericBinaryData(theEnv)->MethodArray[obji].system = bmth->system; DefgenericBinaryData(theEnv)->MethodArray[obji].restrictions = RestrictionPointer(bmth->restrictions); DefgenericBinaryData(theEnv)->MethodArray[obji].actions = ExpressionPointer(bmth->actions); DefgenericBinaryData(theEnv)->MethodArray[obji].ppForm = NULL; DefgenericBinaryData(theEnv)->MethodArray[obji].usrData = NULL; } static void UpdateRestriction( void *theEnv, void *buf, long obji) { BSAVE_RESTRICTION *brp; brp = (BSAVE_RESTRICTION *) buf; DefgenericBinaryData(theEnv)->RestrictionArray[obji].tcnt = brp->tcnt; DefgenericBinaryData(theEnv)->RestrictionArray[obji].types = TypePointer(brp->types); DefgenericBinaryData(theEnv)->RestrictionArray[obji].query = ExpressionPointer(brp->query); } static void UpdateType( void *theEnv, void *buf, long obji) { #if OBJECT_SYSTEM DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) DefclassPointer(* (long *) buf); #else if ((* (long *) buf) > (long) INSTANCE_TYPE_CODE) { PrintWarningID(theEnv,"GENRCBIN",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"COOL not installed! User-defined class\n"); EnvPrintRouter(theEnv,WWARNING," in method restriction substituted with OBJECT.\n"); DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,(long long) OBJECT_TYPE_CODE); } else DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,* (long *) buf); IncrementIntegerCount((INTEGER_HN *) DefgenericBinaryData(theEnv)->TypeArray[obji]); #endif } /*************************************************************** NAME : ClearBloadGenerics DESCRIPTION : Release all binary-loaded generic function structure arrays Resets generic function list to NULL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : Generic function name symbol counts decremented ***************************************************************/ static void ClearBloadGenerics( void *theEnv) { register long i; size_t space; space = (sizeof(DEFGENERIC_MODULE) * DefgenericBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->ModuleArray,space); DefgenericBinaryData(theEnv)->ModuleArray = NULL; DefgenericBinaryData(theEnv)->ModuleCount = 0L; for (i = 0 ; i < DefgenericBinaryData(theEnv)->GenericCount ; i++) UnmarkConstructHeader(theEnv,&DefgenericBinaryData(theEnv)->DefgenericArray[i].header); space = (sizeof(DEFGENERIC) * DefgenericBinaryData(theEnv)->GenericCount); if (space == 0L) return; genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->DefgenericArray,space); DefgenericBinaryData(theEnv)->DefgenericArray = NULL; DefgenericBinaryData(theEnv)->GenericCount = 0L; space = (sizeof(DEFMETHOD) * DefgenericBinaryData(theEnv)->MethodCount); if (space == 0L) return; genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->MethodArray,space); DefgenericBinaryData(theEnv)->MethodArray = NULL; DefgenericBinaryData(theEnv)->MethodCount = 0L; space = (sizeof(RESTRICTION) * DefgenericBinaryData(theEnv)->RestrictionCount); if (space == 0L) return; genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->RestrictionArray,space); DefgenericBinaryData(theEnv)->RestrictionArray = NULL; DefgenericBinaryData(theEnv)->RestrictionCount = 0L; #if ! OBJECT_SYSTEM for (i = 0 ; i < DefgenericBinaryData(theEnv)->TypeCount ; i++) DecrementIntegerCount(theEnv,(INTEGER_HN *) DefgenericBinaryData(theEnv)->TypeArray[i]); #endif space = (sizeof(void *) * DefgenericBinaryData(theEnv)->TypeCount); if (space == 0L) return; genfree(theEnv,(void *) DefgenericBinaryData(theEnv)->TypeArray,space); DefgenericBinaryData(theEnv)->TypeArray = NULL; DefgenericBinaryData(theEnv)->TypeCount = 0L; } #endif clips_core_source_630/core/prccode.h0000755000175000017500000001367712373743664016056 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Updated ENTITY_RECORD definitions to include */ /* additional NULL initializers. */ /* */ /* Added ReleaseProcParameters call. */ /* */ /* Added tracked memory calls. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_prccode #define _H_prccode #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_symbol #include "symbol.h" #endif typedef struct ProcParamStack { DATA_OBJECT *ParamArray; #if DEFGENERIC_CONSTRUCT EXPRESSION *ParamExpressions; #endif int ParamArraySize; DATA_OBJECT *WildcardValue; void (*UnboundErrFunc)(void *); struct ProcParamStack *nxt; } PROC_PARAM_STACK; #define PROCEDURAL_PRIMITIVE_DATA 37 struct proceduralPrimitiveData { void *NoParamValue; DATA_OBJECT *ProcParamArray; int ProcParamArraySize; EXPRESSION *CurrentProcActions; #if DEFGENERIC_CONSTRUCT EXPRESSION *ProcParamExpressions; #endif PROC_PARAM_STACK *pstack; DATA_OBJECT *WildcardValue; DATA_OBJECT *LocalVarArray; void (*ProcUnboundErrFunc)(void *); ENTITY_RECORD ProcParameterInfo; ENTITY_RECORD ProcWildInfo; ENTITY_RECORD ProcGetInfo; ENTITY_RECORD ProcBindInfo; #if ! DEFFUNCTION_CONSTRUCT ENTITY_RECORD DeffunctionEntityRecord; #endif #if ! DEFGENERIC_CONSTRUCT ENTITY_RECORD GenericEntityRecord; #endif int Oldindex; }; #define ProceduralPrimitiveData(theEnv) ((struct proceduralPrimitiveData *) GetEnvironmentData(theEnv,PROCEDURAL_PRIMITIVE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PRCCODE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InstallProcedurePrimitives(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) #if DEFFUNCTION_CONSTRUCT || OBJECT_SYSTEM LOCALE EXPRESSION *ParseProcParameters(void *,const char *,struct token *,EXPRESSION *, SYMBOL_HN **,int *,int *,int *, int (*)(void *,const char *)); #endif LOCALE EXPRESSION *ParseProcActions(void *,const char *,const char *,struct token *,EXPRESSION *,SYMBOL_HN *, int (*)(void *,EXPRESSION *,void *), int (*)(void *,EXPRESSION *,void *), int *,void *); LOCALE intBool ReplaceProcVars(void *,const char *,EXPRESSION *,EXPRESSION *,SYMBOL_HN *, int (*)(void *,EXPRESSION *,void *),void *); #if DEFGENERIC_CONSTRUCT LOCALE EXPRESSION *GenProcWildcardReference(void *,int); #endif #endif LOCALE void PushProcParameters(void *,EXPRESSION *,int,const char *,const char *,void (*)(void *)); LOCALE void PopProcParameters(void *); #if DEFGENERIC_CONSTRUCT LOCALE EXPRESSION *GetProcParamExpressions(void *); #endif LOCALE void EvaluateProcActions(void *,struct defmodule *,EXPRESSION *,int, DATA_OBJECT *,void (*)(void *)); LOCALE void PrintProcParamArray(void *,const char *); LOCALE void GrabProcWildargs(void *,DATA_OBJECT *,int); #endif /* _H_prccode */ clips_core_source_630/core/._genrcexe.h0000755000175000017500000000040712373753404016430 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/evaluatn.h0000755000175000017500000003036012464554105016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* EVALUATION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for evaluating expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EvaluateAndStoreInDataObject function. */ /* */ /* 6.30: Added support for passing context information */ /* to user defined functions. */ /* */ /* Added support for external address hash table */ /* and subtyping. */ /* */ /* Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Support for DATA_OBJECT_ARRAY primitive. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_evaluatn #define _H_evaluatn struct entityRecord; struct dataObject; #ifndef _H_constant #include "constant.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif struct dataObject { void *supplementalInfo; unsigned short type; void *value; long begin; long end; struct dataObject *next; }; typedef struct dataObject DATA_OBJECT; typedef struct dataObject * DATA_OBJECT_PTR; typedef struct expr FUNCTION_REFERENCE; #define DATA_OBJECT_PTR_ARG DATA_OBJECT_PTR #define C_POINTER_EXTERNAL_ADDRESS 0 #include "userdata.h" struct entityRecord { const char *name; unsigned int type : 13; unsigned int copyToEvaluate : 1; unsigned int bitMap : 1; unsigned int addsToRuleComplexity : 1; void (*shortPrintFunction)(void *,const char *,void *); void (*longPrintFunction)(void *,const char *,void *); intBool (*deleteFunction)(void *,void *); intBool (*evaluateFunction)(void *,void *,DATA_OBJECT *); void *(*getNextFunction)(void *,void *); void (*decrementBusyCount)(void *,void *); void (*incrementBusyCount)(void *,void *); void (*propagateDepth)(void *,void *); void (*markNeeded)(void *,void *); void (*install)(void *,void *); void (*deinstall)(void *,void *); struct userData *usrData; }; struct externalAddressType { const char *name; void (*shortPrintFunction)(void *,const char *,void *); void (*longPrintFunction)(void *,const char *,void *); intBool (*discardFunction)(void *,void *); void (*newFunction)(void *,DATA_OBJECT *); intBool (*callFunction)(void *,DATA_OBJECT *,DATA_OBJECT *); }; typedef struct entityRecord ENTITY_RECORD; typedef struct entityRecord * ENTITY_RECORD_PTR; #define GetDOLength(target) (((target).end - (target).begin) + 1) #define GetpDOLength(target) (((target)->end - (target)->begin) + 1) #define GetDOBegin(target) ((target).begin + 1) #define GetDOEnd(target) ((target).end + 1) #define GetpDOBegin(target) ((target)->begin + 1) #define GetpDOEnd(target) ((target)->end + 1) #define SetDOBegin(target,val) ((target).begin = (long) ((val) - 1)) #define SetDOEnd(target,val) ((target).end = (long) ((val) - 1)) #define SetpDOBegin(target,val) ((target)->begin = (long) ((val) - 1)) #define SetpDOEnd(target,val) ((target)->end = (long) ((val) - 1)) #define EnvGetDOLength(theEnv,target) (((target).end - (target).begin) + 1) #define EnvGetpDOLength(theEnv,target) (((target)->end - (target)->begin) + 1) #define EnvGetDOBegin(theEnv,target) ((target).begin + 1) #define EnvGetDOEnd(theEnv,target) ((target).end + 1) #define EnvGetpDOBegin(theEnv,target) ((target)->begin + 1) #define EnvGetpDOEnd(theEnv,target) ((target)->end + 1) #define EnvSetDOBegin(theEnv,target,val) ((target).begin = (long) ((val) - 1)) #define EnvSetDOEnd(theEnv,target,val) ((target).end = (long) ((val) - 1)) #define EnvSetpDOBegin(theEnv,target,val) ((target)->begin = (long) ((val) - 1)) #define EnvSetpDOEnd(theEnv,target,val) ((target)->end = (long) ((val) - 1)) #define DOPToString(target) (((struct symbolHashNode *) ((target)->value))->contents) #define DOPToDouble(target) (((struct floatHashNode *) ((target)->value))->contents) #define DOPToFloat(target) ((float) (((struct floatHashNode *) ((target)->value))->contents)) #define DOPToLong(target) (((struct integerHashNode *) ((target)->value))->contents) #define DOPToInteger(target) ((int) (((struct integerHashNode *) ((target)->value))->contents)) #define DOPToPointer(target) ((target)->value) #define DOPToExternalAddress(target) (((struct externalAddressHashNode *) ((target)->value))->externalAddress) #define EnvDOPToString(theEnv,target) (((struct symbolHashNode *) ((target)->value))->contents) #define EnvDOPToDouble(theEnv,target) (((struct floatHashNode *) ((target)->value))->contents) #define EnvDOPToFloat(theEnv,target) ((float) (((struct floatHashNode *) ((target)->value))->contents)) #define EnvDOPToLong(theEnv,target) (((struct integerHashNode *) ((target)->value))->contents) #define EnvDOPToInteger(theEnv,target) ((int) (((struct integerHashNode *) ((target)->value))->contents)) #define EnvDOPToPointer(theEnv,target) ((target)->value) #define EnvDOPToExternalAddress(target) (((struct externalAddressHashNode *) ((target)->value))->externalAddress) #define DOToString(target) (((struct symbolHashNode *) ((target).value))->contents) #define DOToDouble(target) (((struct floatHashNode *) ((target).value))->contents) #define DOToFloat(target) ((float) (((struct floatHashNode *) ((target).value))->contents)) #define DOToLong(target) (((struct integerHashNode *) ((target).value))->contents) #define DOToInteger(target) ((int) (((struct integerHashNode *) ((target).value))->contents)) #define DOToPointer(target) ((target).value) #define DOToExternalAddress(target) (((struct externalAddressHashNode *) ((target).value))->externalAddress) #define EnvDOToString(theEnv,target) (((struct symbolHashNode *) ((target).value))->contents) #define EnvDOToDouble(theEnv,target) (((struct floatHashNode *) ((target).value))->contents) #define EnvDOToFloat(theEnv,target) ((float) (((struct floatHashNode *) ((target).value))->contents)) #define EnvDOToLong(theEnv,target) (((struct integerHashNode *) ((target).value))->contents) #define EnvDOToInteger(theEnv,target) ((int) (((struct integerHashNode *) ((target).value))->contents)) #define EnvDOToPointer(theEnv,target) ((target).value) #define EnvDOToExternalAddress(target) (((struct externalAddressHashNode *) ((target).value))->externalAddress) #define CoerceToLongInteger(t,v) ((t == INTEGER) ? ValueToLong(v) : (long int) ValueToDouble(v)) #define CoerceToInteger(t,v) ((t == INTEGER) ? (int) ValueToLong(v) : (int) ValueToDouble(v)) #define CoerceToDouble(t,v) ((t == INTEGER) ? (double) ValueToLong(v) : ValueToDouble(v)) #define GetFirstArgument() (EvaluationData(theEnv)->CurrentExpression->argList) #define GetNextArgument(ep) (ep->nextArg) #define MAXIMUM_PRIMITIVES 150 #define MAXIMUM_EXTERNAL_ADDRESS_TYPES 10 #define BITS_PER_BYTE 8 #define BitwiseTest(n,b) ((n) & (char) (1 << (b))) #define BitwiseSet(n,b) (n |= (char) (1 << (b))) #define BitwiseClear(n,b) (n &= (char) ~(1 << (b))) #define TestBitMap(map,id) BitwiseTest(map[(id) / BITS_PER_BYTE],(id) % BITS_PER_BYTE) #define SetBitMap(map,id) BitwiseSet(map[(id) / BITS_PER_BYTE],(id) % BITS_PER_BYTE) #define ClearBitMap(map,id) BitwiseClear(map[(id) / BITS_PER_BYTE],(id) % BITS_PER_BYTE) #define EVALUATION_DATA 44 struct evaluationData { struct expr *CurrentExpression; int EvaluationError; int HaltExecution; int CurrentEvaluationDepth; int numberOfAddressTypes; struct entityRecord *PrimitivesArray[MAXIMUM_PRIMITIVES]; struct externalAddressType *ExternalAddressTypes[MAXIMUM_EXTERNAL_ADDRESS_TYPES]; }; #define EvaluationData(theEnv) ((struct evaluationData *) GetEnvironmentData(theEnv,EVALUATION_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _EVALUATN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeEvaluationData(void *); LOCALE int EvaluateExpression(void *,struct expr *,struct dataObject *); LOCALE void SetEvaluationError(void *,intBool); LOCALE int GetEvaluationError(void *); LOCALE void SetHaltExecution(void *,int); LOCALE int GetHaltExecution(void *); LOCALE void ReturnValues(void *,struct dataObject *,intBool); LOCALE void PrintDataObject(void *,const char *,struct dataObject *); LOCALE void EnvSetMultifieldErrorValue(void *,struct dataObject *); LOCALE void ValueInstall(void *,struct dataObject *); LOCALE void ValueDeinstall(void *,struct dataObject *); #if DEFFUNCTION_CONSTRUCT || DEFGENERIC_CONSTRUCT LOCALE int EnvFunctionCall(void *,const char *,const char *,DATA_OBJECT *); LOCALE int FunctionCall2(void *,FUNCTION_REFERENCE *,const char *,DATA_OBJECT *); #endif LOCALE void CopyDataObject(void *,DATA_OBJECT *,DATA_OBJECT *,int); LOCALE void AtomInstall(void *,int,void *); LOCALE void AtomDeinstall(void *,int,void *); LOCALE struct expr *ConvertValueToExpression(void *,DATA_OBJECT *); LOCALE unsigned long GetAtomicHashValue(unsigned short,void *,int); LOCALE void InstallPrimitive(void *,struct entityRecord *,int); LOCALE int InstallExternalAddressType(void *,struct externalAddressType *); LOCALE void TransferDataObjectValues(DATA_OBJECT *,DATA_OBJECT *); LOCALE struct expr *FunctionReferenceExpression(void *,const char *); LOCALE intBool GetFunctionReference(void *,const char *,FUNCTION_REFERENCE *); LOCALE intBool DOsEqual(DATA_OBJECT_PTR,DATA_OBJECT_PTR); LOCALE int EvaluateAndStoreInDataObject(void *,int,EXPRESSION *,DATA_OBJECT *,int); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void SetMultifieldErrorValue(DATA_OBJECT_PTR); LOCALE int FunctionCall(const char *,const char *,DATA_OBJECT *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_evaluatn */ clips_core_source_630/core/factmngr.c0000755000175000017500000020145412500146076016205 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* FACT MANAGER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for maintaining the fact */ /* list including assert/retract operations, data */ /* structure creation/deletion, printing, slot access, */ /* and other utility functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* AssignFactSlotDefaults function does not */ /* properly handle defaults for multifield slots. */ /* DR0869 */ /* */ /* Support for ppfact command. */ /* */ /* 6.30: Callback function support for assertion, */ /* retraction, and modification of facts. */ /* */ /* Updates to fact pattern entity record. */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Removed unused global variables. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* JoinOperationInProgress mechanism. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ #define _FACTMNGR_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "constant.h" #include "symbol.h" #include "memalloc.h" #include "exprnpsr.h" #include "argacces.h" #include "scanner.h" #include "router.h" #include "strngrtr.h" #include "match.h" #include "factbld.h" #include "factqury.h" #include "reteutil.h" #include "retract.h" #include "factcmp.h" #include "filecom.h" #include "factfun.h" #include "factcom.h" #include "constrct.h" #include "factrhs.h" #include "factmch.h" #include "watch.h" #include "utility.h" #include "factbin.h" #include "factmngr.h" #include "facthsh.h" #include "default.h" #include "commline.h" #include "envrnmnt.h" #include "sysdep.h" #include "engine.h" #include "lgcldpnd.h" #include "drive.h" #include "ruledlt.h" #include "tmpltbsc.h" #include "tmpltdef.h" #include "tmpltutl.h" #include "tmpltfun.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ResetFacts(void *); static int ClearFactsReady(void *); static void RemoveGarbageFacts(void *); static void DeallocateFactData(void *); /**************************************************************/ /* InitializeFacts: Initializes the fact data representation. */ /* Facts are only available when both the defrule and */ /* deftemplate constructs are available. */ /**************************************************************/ globle void InitializeFacts( void *theEnv) { struct patternEntityRecord factInfo = { { "FACT_ADDRESS", FACT_ADDRESS,1,0,0, PrintFactIdentifier, PrintFactIdentifierInLongForm, EnvRetract, NULL, EnvGetNextFact, EnvDecrementFactCount, EnvIncrementFactCount,NULL,NULL,NULL,NULL,NULL }, DecrementFactBasisCount, IncrementFactBasisCount, MatchFactFunction, NULL, FactIsDeleted }; struct fact dummyFact = { { NULL, NULL, 0, 0L }, NULL, NULL, -1L, 0, 1, NULL, NULL, NULL, NULL, { 1, 0UL, NULL, { { 0, NULL } } } }; AllocateEnvironmentData(theEnv,FACTS_DATA,sizeof(struct factsData),DeallocateFactData); memcpy(&FactData(theEnv)->FactInfo,&factInfo,sizeof(struct patternEntityRecord)); dummyFact.factHeader.theInfo = &FactData(theEnv)->FactInfo; memcpy(&FactData(theEnv)->DummyFact,&dummyFact,sizeof(struct fact)); FactData(theEnv)->LastModuleIndex = -1; /*=========================================*/ /* Initialize the fact hash table (used to */ /* quickly determine if a fact exists). */ /*=========================================*/ InitializeFactHashTable(theEnv); /*============================================*/ /* Initialize the fact callback functions for */ /* use with the reset and clear commands. */ /*============================================*/ EnvAddResetFunction(theEnv,"facts",ResetFacts,60); AddClearReadyFunction(theEnv,"facts",ClearFactsReady,0); /*=============================*/ /* Initialize periodic garbage */ /* collection for facts. */ /*=============================*/ AddCleanupFunction(theEnv,"facts",RemoveGarbageFacts,0); /*===================================*/ /* Initialize fact pattern matching. */ /*===================================*/ InitializeFactPatterns(theEnv); /*==================================*/ /* Initialize the facts keyword for */ /* use with the watch command. */ /*==================================*/ #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"facts",0,&FactData(theEnv)->WatchFacts,80,DeftemplateWatchAccess,DeftemplateWatchPrint); #endif /*=========================================*/ /* Initialize fact commands and functions. */ /*=========================================*/ FactCommandDefinitions(theEnv); FactFunctionDefinitions(theEnv); /*==============================*/ /* Initialize fact set queries. */ /*==============================*/ #if FACT_SET_QUERIES SetupFactQuery(theEnv); #endif /*==================================*/ /* Initialize fact patterns for use */ /* with the bload/bsave commands. */ /*==================================*/ #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) FactBinarySetup(theEnv); #endif /*===================================*/ /* Initialize fact patterns for use */ /* with the constructs-to-c command. */ /*===================================*/ #if CONSTRUCT_COMPILER && (! RUN_TIME) FactPatternsCompilerSetup(theEnv); #endif } /***********************************/ /* DeallocateFactData: Deallocates */ /* environment data for facts. */ /***********************************/ static void DeallocateFactData( void *theEnv) { struct factHashEntry *tmpFHEPtr, *nextFHEPtr; struct fact *tmpFactPtr, *nextFactPtr; unsigned long i; struct patternMatch *theMatch, *tmpMatch; for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++) { tmpFHEPtr = FactData(theEnv)->FactHashTable[i]; while (tmpFHEPtr != NULL) { nextFHEPtr = tmpFHEPtr->next; rtn_struct(theEnv,factHashEntry,tmpFHEPtr); tmpFHEPtr = nextFHEPtr; } } rm3(theEnv,FactData(theEnv)->FactHashTable, sizeof(struct factHashEntry *) * FactData(theEnv)->FactHashTableSize); tmpFactPtr = FactData(theEnv)->FactList; while (tmpFactPtr != NULL) { nextFactPtr = tmpFactPtr->nextFact; theMatch = (struct patternMatch *) tmpFactPtr->list; while (theMatch != NULL) { tmpMatch = theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = tmpMatch; } ReturnEntityDependencies(theEnv,(struct patternEntity *) tmpFactPtr); ReturnFact(theEnv,tmpFactPtr); tmpFactPtr = nextFactPtr; } tmpFactPtr = FactData(theEnv)->GarbageFacts; while (tmpFactPtr != NULL) { nextFactPtr = tmpFactPtr->nextFact; ReturnFact(theEnv,tmpFactPtr); tmpFactPtr = nextFactPtr; } DeallocateCallListWithArg(theEnv,FactData(theEnv)->ListOfAssertFunctions); DeallocateCallListWithArg(theEnv,FactData(theEnv)->ListOfRetractFunctions); DeallocateCallListWithArg(theEnv,FactData(theEnv)->ListOfModifyFunctions); } /**********************************************/ /* PrintFactWithIdentifier: Displays a single */ /* fact preceded by its fact identifier. */ /**********************************************/ globle void PrintFactWithIdentifier( void *theEnv, const char *logicalName, struct fact *factPtr) { char printSpace[20]; gensprintf(printSpace,"f-%-5lld ",factPtr->factIndex); EnvPrintRouter(theEnv,logicalName,printSpace); PrintFact(theEnv,logicalName,factPtr,FALSE,FALSE); } /****************************************************/ /* PrintFactIdentifier: Displays a fact identifier. */ /****************************************************/ globle void PrintFactIdentifier( void *theEnv, const char *logicalName, void *factPtr) { char printSpace[20]; gensprintf(printSpace,"f-%lld",((struct fact *) factPtr)->factIndex); EnvPrintRouter(theEnv,logicalName,printSpace); } /********************************************/ /* PrintFactIdentifierInLongForm: Display a */ /* fact identifier in a longer format. */ /********************************************/ globle void PrintFactIdentifierInLongForm( void *theEnv, const char *logicalName, void *factPtr) { if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); if (factPtr != (void *) &FactData(theEnv)->DummyFact) { EnvPrintRouter(theEnv,logicalName,"factIndex); EnvPrintRouter(theEnv,logicalName,">"); } else { EnvPrintRouter(theEnv,logicalName,""); } if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); } /*******************************************/ /* DecrementFactBasisCount: Decrements the */ /* partial match busy count of a fact */ /*******************************************/ globle void DecrementFactBasisCount( void *theEnv, void *vFactPtr) { struct fact *factPtr = (struct fact *) vFactPtr; struct multifield *theSegment; int i; EnvDecrementFactCount(theEnv,factPtr); theSegment = &factPtr->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomDeinstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } } /*******************************************/ /* IncrementFactBasisCount: Increments the */ /* partial match busy count of a fact. */ /*******************************************/ globle void IncrementFactBasisCount( void *theEnv, void *vFactPtr) { struct fact *factPtr = (struct fact *) vFactPtr; struct multifield *theSegment; int i; EnvIncrementFactCount(theEnv,factPtr); theSegment = &factPtr->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomInstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } } /******************/ /* FactIsDeleted: */ /******************/ globle intBool FactIsDeleted( void *theEnv, void *theFact) { #if MAC_XCD #pragma unused(theEnv) #endif return(((struct fact *) theFact)->garbage); } /**************************************************/ /* PrintFact: Displays the printed representation */ /* of a fact containing the relation name and */ /* all of the fact's slots or fields. */ /**************************************************/ globle void PrintFact( void *theEnv, const char *logicalName, struct fact *factPtr, int seperateLines, int ignoreDefaults) { struct multifield *theMultifield; /*=========================================*/ /* Print a deftemplate (non-ordered) fact. */ /*=========================================*/ if (factPtr->whichDeftemplate->implied == FALSE) { PrintTemplateFact(theEnv,logicalName,factPtr,seperateLines,ignoreDefaults); return; } /*==============================*/ /* Print an ordered fact (which */ /* has an implied deftemplate). */ /*==============================*/ EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,factPtr->whichDeftemplate->header.name->contents); theMultifield = (struct multifield *) factPtr->theProposition.theFields[0].value; if (theMultifield->multifieldLength != 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,theMultifield,0, (long) (theMultifield->multifieldLength - 1), FALSE); } EnvPrintRouter(theEnv,logicalName,")"); } /*********************************************/ /* MatchFactFunction: Filters a fact through */ /* the appropriate fact pattern network. */ /*********************************************/ globle void MatchFactFunction( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; FactPatternMatch(theEnv,theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL); } /*********************************************************/ /* EnvRetract: C access routine for the retract command. */ /*********************************************************/ globle intBool EnvRetract( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theTemplate = theFact->whichDeftemplate; struct callFunctionItemWithArg *theRetractFunction; /*===========================================*/ /* A fact can not be retracted while another */ /* fact is being asserted or retracted. */ /*===========================================*/ if (EngineData(theEnv)->JoinOperationInProgress) { PrintErrorID(theEnv,"FACTMNGR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Facts may not be retracted during pattern-matching\n"); return(FALSE); } /*====================================*/ /* A NULL fact pointer indicates that */ /* all facts should be retracted. */ /*====================================*/ if (theFact == NULL) { RemoveAllFacts(theEnv); return(TRUE); } /*======================================================*/ /* Check to see if the fact has already been retracted. */ /*======================================================*/ if (theFact->garbage) return(FALSE); /*==========================================*/ /* Execute the list of functions that are */ /* to be called before each fact assertion. */ /*==========================================*/ for (theRetractFunction = FactData(theEnv)->ListOfRetractFunctions; theRetractFunction != NULL; theRetractFunction = theRetractFunction->next) { SetEnvironmentCallbackContext(theEnv,theRetractFunction->context); if (theRetractFunction->environmentAware) { (*theRetractFunction->func)(theEnv,theFact); } else { ((void (*)(void *))(*theRetractFunction->func))(theFact); } } /*============================*/ /* Print retraction output if */ /* facts are being watched. */ /*============================*/ #if DEBUGGING_FUNCTIONS if (theFact->whichDeftemplate->watch) { EnvPrintRouter(theEnv,WTRACE,"<== "); PrintFactWithIdentifier(theEnv,WTRACE,theFact); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==================================*/ /* Set the change flag to indicate */ /* the fact-list has been modified. */ /*==================================*/ FactData(theEnv)->ChangeToFactList = TRUE; /*===============================================*/ /* Remove any links between the fact and partial */ /* matches in the join network. These links are */ /* used to keep track of logical dependencies. */ /*===============================================*/ RemoveEntityDependencies(theEnv,(struct patternEntity *) theFact); /*===========================================*/ /* Remove the fact from the fact hash table. */ /*===========================================*/ RemoveHashedFact(theEnv,theFact); /*=========================================*/ /* Remove the fact from its template list. */ /*=========================================*/ if (theFact == theTemplate->lastFact) { theTemplate->lastFact = theFact->previousTemplateFact; } if (theFact->previousTemplateFact == NULL) { theTemplate->factList = theTemplate->factList->nextTemplateFact; if (theTemplate->factList != NULL) { theTemplate->factList->previousTemplateFact = NULL; } } else { theFact->previousTemplateFact->nextTemplateFact = theFact->nextTemplateFact; if (theFact->nextTemplateFact != NULL) { theFact->nextTemplateFact->previousTemplateFact = theFact->previousTemplateFact; } } /*=====================================*/ /* Remove the fact from the fact list. */ /*=====================================*/ if (theFact == FactData(theEnv)->LastFact) { FactData(theEnv)->LastFact = theFact->previousFact; } if (theFact->previousFact == NULL) { FactData(theEnv)->FactList = FactData(theEnv)->FactList->nextFact; if (FactData(theEnv)->FactList != NULL) { FactData(theEnv)->FactList->previousFact = NULL; } } else { theFact->previousFact->nextFact = theFact->nextFact; if (theFact->nextFact != NULL) { theFact->nextFact->previousFact = theFact->previousFact; } } /*========================================*/ /* Add the fact to the fact garbage list. */ /*========================================*/ theFact->nextFact = FactData(theEnv)->GarbageFacts; FactData(theEnv)->GarbageFacts = theFact; theFact->garbage = TRUE; UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE; /*===================================================*/ /* Reset the evaluation error flag since expressions */ /* will be evaluated as part of the retract. */ /*===================================================*/ SetEvaluationError(theEnv,FALSE); /*===========================================*/ /* Loop through the list of all the patterns */ /* that matched the fact and process the */ /* retract operation for each one. */ /*===========================================*/ EngineData(theEnv)->JoinOperationInProgress = TRUE; NetworkRetract(theEnv,(struct patternMatch *) theFact->list); EngineData(theEnv)->JoinOperationInProgress = FALSE; /*=========================================*/ /* Free partial matches that were released */ /* by the retraction of the fact. */ /*=========================================*/ if (EngineData(theEnv)->ExecutingRule == NULL) { FlushGarbagePartialMatches(theEnv); } /*=========================================*/ /* Retract other facts that were logically */ /* dependent on the fact just retracted. */ /*=========================================*/ ForceLogicalRetractions(theEnv); /*===========================================*/ /* Force periodic cleanup if the retract was */ /* executed from an embedded application. */ /*===========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); } /*==================================*/ /* Update busy counts and ephemeral */ /* garbage information. */ /*==================================*/ FactDeinstall(theEnv,theFact); /*==================================*/ /* Return TRUE to indicate the fact */ /* was successfully retracted. */ /*==================================*/ return(TRUE); } /*******************************************************************/ /* RemoveGarbageFacts: Returns facts that have been retracted to */ /* the pool of available memory. It is necessary to postpone */ /* returning the facts to memory because RHS actions retrieve */ /* their variable bindings directly from the fact data structure */ /* and the facts may be in use in other data structures. */ /*******************************************************************/ static void RemoveGarbageFacts( void *theEnv) { struct fact *factPtr, *nextPtr, *lastPtr = NULL; factPtr = FactData(theEnv)->GarbageFacts; while (factPtr != NULL) { nextPtr = factPtr->nextFact; if (factPtr->factHeader.busyCount == 0) { ReturnFact(theEnv,factPtr); if (lastPtr == NULL) FactData(theEnv)->GarbageFacts = nextPtr; else lastPtr->nextFact = nextPtr; } else { lastPtr = factPtr; } factPtr = nextPtr; } } /********************************************************/ /* EnvAssert: C access routine for the assert function. */ /********************************************************/ globle void *EnvAssert( void *theEnv, void *vTheFact) { unsigned long hashValue; unsigned long length, i; struct field *theField; struct fact *theFact = (struct fact *) vTheFact; intBool duplicate; struct callFunctionItemWithArg *theAssertFunction; /*==========================================*/ /* A fact can not be asserted while another */ /* fact is being asserted or retracted. */ /*==========================================*/ if (EngineData(theEnv)->JoinOperationInProgress) { ReturnFact(theEnv,theFact); PrintErrorID(theEnv,"FACTMNGR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Facts may not be asserted during pattern-matching\n"); return(NULL); } /*=============================================================*/ /* Replace invalid data types in the fact with the symbol nil. */ /*=============================================================*/ length = theFact->theProposition.multifieldLength; theField = theFact->theProposition.theFields; for (i = 0; i < length; i++) { if (theField[i].type == RVOID) { theField[i].type = SYMBOL; theField[i].value = (void *) EnvAddSymbol(theEnv,"nil"); } } /*========================================================*/ /* If fact assertions are being checked for duplications, */ /* then search the fact list for a duplicate fact. */ /*========================================================*/ hashValue = HandleFactDuplication(theEnv,theFact,&duplicate); if (duplicate) return(NULL); /*==========================================================*/ /* If necessary, add logical dependency links between the */ /* fact and the partial match which is its logical support. */ /*==========================================================*/ if (AddLogicalDependencies(theEnv,(struct patternEntity *) theFact,FALSE) == FALSE) { ReturnFact(theEnv,theFact); return(NULL); } /*======================================*/ /* Add the fact to the fact hash table. */ /*======================================*/ AddHashedFact(theEnv,theFact,hashValue); /*================================*/ /* Add the fact to the fact list. */ /*================================*/ theFact->nextFact = NULL; theFact->list = NULL; theFact->previousFact = FactData(theEnv)->LastFact; if (FactData(theEnv)->LastFact == NULL) { FactData(theEnv)->FactList = theFact; } else { FactData(theEnv)->LastFact->nextFact = theFact; } FactData(theEnv)->LastFact = theFact; /*====================================*/ /* Add the fact to its template list. */ /*====================================*/ theFact->previousTemplateFact = theFact->whichDeftemplate->lastFact; theFact->nextTemplateFact = NULL; if (theFact->whichDeftemplate->lastFact == NULL) { theFact->whichDeftemplate->factList = theFact; } else { theFact->whichDeftemplate->lastFact->nextTemplateFact = theFact; } theFact->whichDeftemplate->lastFact = theFact; /*==================================*/ /* Set the fact index and time tag. */ /*==================================*/ theFact->factIndex = FactData(theEnv)->NextFactIndex++; theFact->factHeader.timeTag = DefruleData(theEnv)->CurrentEntityTimeTag++; /*=====================*/ /* Update busy counts. */ /*=====================*/ FactInstall(theEnv,theFact); /*==========================================*/ /* Execute the list of functions that are */ /* to be called before each fact assertion. */ /*==========================================*/ for (theAssertFunction = FactData(theEnv)->ListOfAssertFunctions; theAssertFunction != NULL; theAssertFunction = theAssertFunction->next) { SetEnvironmentCallbackContext(theEnv,theAssertFunction->context); if (theAssertFunction->environmentAware) { (*theAssertFunction->func)(theEnv,theFact); } else { ((void (*)(void *))(*theAssertFunction->func))(theFact); } } /*==========================*/ /* Print assert output if */ /* facts are being watched. */ /*==========================*/ #if DEBUGGING_FUNCTIONS if (theFact->whichDeftemplate->watch) { EnvPrintRouter(theEnv,WTRACE,"==> "); PrintFactWithIdentifier(theEnv,WTRACE,theFact); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==================================*/ /* Set the change flag to indicate */ /* the fact-list has been modified. */ /*==================================*/ FactData(theEnv)->ChangeToFactList = TRUE; /*==========================================*/ /* Check for constraint errors in the fact. */ /*==========================================*/ CheckTemplateFact(theEnv,theFact); /*===================================================*/ /* Reset the evaluation error flag since expressions */ /* will be evaluated as part of the assert . */ /*===================================================*/ SetEvaluationError(theEnv,FALSE); /*=============================================*/ /* Pattern match the fact using the associated */ /* deftemplate's pattern network. */ /*=============================================*/ EngineData(theEnv)->JoinOperationInProgress = TRUE; FactPatternMatch(theEnv,theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL); EngineData(theEnv)->JoinOperationInProgress = FALSE; /*===================================================*/ /* Retract other facts that were logically dependent */ /* on the non-existence of the fact just asserted. */ /*===================================================*/ ForceLogicalRetractions(theEnv); /*=========================================*/ /* Free partial matches that were released */ /* by the assertion of the fact. */ /*=========================================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); /*==========================================*/ /* Force periodic cleanup if the assert was */ /* executed from an embedded application. */ /*==========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*===============================*/ /* Return a pointer to the fact. */ /*===============================*/ return((void *) theFact); } /**************************************/ /* RemoveAllFacts: Loops through the */ /* fact-list and removes each fact. */ /**************************************/ globle void RemoveAllFacts( void *theEnv) { while (FactData(theEnv)->FactList != NULL) { EnvRetract(theEnv,(void *) FactData(theEnv)->FactList); } } /************************************************/ /* EnvCreateFact: Creates a fact data structure */ /* of the specified deftemplate. */ /************************************************/ globle struct fact *EnvCreateFact( void *theEnv, void *vTheDeftemplate) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct fact *newFact; int i; /*=================================*/ /* A deftemplate must be specified */ /* in order to create a fact. */ /*=================================*/ if (theDeftemplate == NULL) return(NULL); /*============================================*/ /* Create a fact for an explicit deftemplate. */ /*============================================*/ if (theDeftemplate->implied == FALSE) { newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots); for (i = 0; i < (int) theDeftemplate->numberOfSlots; i++) { newFact->theProposition.theFields[i].type = RVOID; } } /*===========================================*/ /* Create a fact for an implied deftemplate. */ /*===========================================*/ else { newFact = CreateFactBySize(theEnv,1); newFact->theProposition.theFields[0].type = MULTIFIELD; newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L); } /*===============================*/ /* Return a pointer to the fact. */ /*===============================*/ newFact->whichDeftemplate = theDeftemplate; return(newFact); } /******************************************/ /* EnvGetFactSlot: Returns the slot value */ /* from the specified slot of a fact. */ /******************************************/ globle intBool EnvGetFactSlot( void *theEnv, void *vTheFact, const char *slotName, DATA_OBJECT *theValue) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; short whichSlot; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*==============================================*/ /* Handle retrieving the slot value from a fact */ /* having an implied deftemplate. An implied */ /* facts has a single multifield slot. */ /*==============================================*/ if (theDeftemplate->implied) { if (slotName != NULL) return(FALSE); theValue->type = theFact->theProposition.theFields[0].type; theValue->value = theFact->theProposition.theFields[0].value; SetpDOBegin(theValue,1); SetpDOEnd(theValue,((struct multifield *) theValue->value)->multifieldLength); return(TRUE); } /*===================================*/ /* Make sure the slot name requested */ /* corresponds to a valid slot name. */ /*===================================*/ if (FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&whichSlot) == NULL) { return(FALSE); } /*======================================================*/ /* Return the slot value. If the slot value wasn't set, */ /* then return FALSE to indicate that an appropriate */ /* slot value wasn't available. */ /*======================================================*/ theValue->type = theFact->theProposition.theFields[whichSlot-1].type; theValue->value = theFact->theProposition.theFields[whichSlot-1].value; if (theValue->type == MULTIFIELD) { SetpDOBegin(theValue,1); SetpDOEnd(theValue,((struct multifield *) theValue->value)->multifieldLength); } if (theValue->type == RVOID) return(FALSE); return(TRUE); } /***************************************/ /* EnvPutFactSlot: Sets the slot value */ /* of the specified slot of a fact. */ /***************************************/ globle intBool EnvPutFactSlot( void *theEnv, void *vTheFact, const char *slotName, DATA_OBJECT *theValue) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; struct templateSlot *theSlot; short whichSlot; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*============================================*/ /* Handle setting the slot value of a fact */ /* having an implied deftemplate. An implied */ /* facts has a single multifield slot. */ /*============================================*/ if (theDeftemplate->implied) { if ((slotName != NULL) || (theValue->type != MULTIFIELD)) { return(FALSE); } if (theFact->theProposition.theFields[0].type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theFact->theProposition.theFields[0].value); } theFact->theProposition.theFields[0].type = theValue->type; theFact->theProposition.theFields[0].value = DOToMultifield(theEnv,theValue); return(TRUE); } /*===================================*/ /* Make sure the slot name requested */ /* corresponds to a valid slot name. */ /*===================================*/ if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&whichSlot)) == NULL) { return(FALSE); } /*=============================================*/ /* Make sure a single field value is not being */ /* stored in a multifield slot or vice versa. */ /*=============================================*/ if (((theSlot->multislot == 0) && (theValue->type == MULTIFIELD)) || ((theSlot->multislot == 1) && (theValue->type != MULTIFIELD))) { return(FALSE); } /*=====================*/ /* Set the slot value. */ /*=====================*/ if (theFact->theProposition.theFields[whichSlot-1].type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theFact->theProposition.theFields[whichSlot-1].value); } theFact->theProposition.theFields[whichSlot-1].type = theValue->type; if (theValue->type == MULTIFIELD) { theFact->theProposition.theFields[whichSlot-1].value = DOToMultifield(theEnv,theValue); } else { theFact->theProposition.theFields[whichSlot-1].value = theValue->value; } return(TRUE); } /********************************************************/ /* EnvAssignFactSlotDefaults: Sets a fact's slot values */ /* to its default value if the value of the slot has */ /* not yet been set. */ /********************************************************/ globle intBool EnvAssignFactSlotDefaults( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; int i; DATA_OBJECT theResult; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*================================================*/ /* The value for the implied multifield slot of */ /* an implied deftemplate is set to a multifield */ /* of length zero when the fact is created. */ /*================================================*/ if (theDeftemplate->implied) return(TRUE); /*============================================*/ /* Loop through each slot of the deftemplate. */ /*============================================*/ for (i = 0, slotPtr = theDeftemplate->slotList; i < (int) theDeftemplate->numberOfSlots; i++, slotPtr = slotPtr->next) { /*===================================*/ /* If the slot's value has been set, */ /* then move on to the next slot. */ /*===================================*/ if (theFact->theProposition.theFields[i].type != RVOID) continue; /*======================================================*/ /* Assign the default value for the slot if one exists. */ /*======================================================*/ if (DeftemplateSlotDefault(theEnv,theDeftemplate,slotPtr,&theResult,FALSE)) { theFact->theProposition.theFields[i].type = theResult.type; theFact->theProposition.theFields[i].value = theResult.value; } } /*==========================================*/ /* Return TRUE to indicate that the default */ /* values have been successfully set. */ /*==========================================*/ return(TRUE); } /********************************************************/ /* DeftemplateSlotDefault: Determines the default value */ /* for the specified slot of a deftemplate. */ /********************************************************/ globle intBool DeftemplateSlotDefault( void *theEnv, struct deftemplate *theDeftemplate, struct templateSlot *slotPtr, DATA_OBJECT *theResult, int garbageMultifield) { /*================================================*/ /* The value for the implied multifield slot of an */ /* implied deftemplate does not have a default. */ /*=================================================*/ if (theDeftemplate->implied) return(FALSE); /*===============================================*/ /* If the (default ?NONE) attribute was declared */ /* for the slot, then return FALSE to indicate */ /* the default values for the fact couldn't be */ /* supplied since this attribute requires that a */ /* default value can't be used for the slot. */ /*===============================================*/ if (slotPtr->noDefault) return(FALSE); /*==============================================*/ /* Otherwise if a static default was specified, */ /* use this as the default value. */ /*==============================================*/ else if (slotPtr->defaultPresent) { if (slotPtr->multislot) { StoreInMultifield(theEnv,theResult,slotPtr->defaultList,garbageMultifield); } else { theResult->type = slotPtr->defaultList->type; theResult->value = slotPtr->defaultList->value; } } /*================================================*/ /* Otherwise if a dynamic-default was specified, */ /* evaluate it and use this as the default value. */ /*================================================*/ else if (slotPtr->defaultDynamic) { if (! EvaluateAndStoreInDataObject(theEnv,(int) slotPtr->multislot, (EXPRESSION *) slotPtr->defaultList, theResult,garbageMultifield)) { return(FALSE); } } /*====================================*/ /* Otherwise derive the default value */ /* from the slot's constraints. */ /*====================================*/ else { DeriveDefaultFromConstraints(theEnv,slotPtr->constraints,theResult, (int) slotPtr->multislot,garbageMultifield); } /*==========================================*/ /* Return TRUE to indicate that the default */ /* values have been successfully set. */ /*==========================================*/ return(TRUE); } /***************************************************************/ /* CopyFactSlotValues: Copies the slot values from one fact to */ /* another. Both facts must have the same relation name. */ /***************************************************************/ globle intBool CopyFactSlotValues( void *theEnv, void *vTheDestFact, void *vTheSourceFact) { struct fact *theDestFact = (struct fact *) vTheDestFact; struct fact *theSourceFact = (struct fact *) vTheSourceFact; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; int i; /*===================================*/ /* Both facts must be the same type. */ /*===================================*/ theDeftemplate = theSourceFact->whichDeftemplate; if (theDestFact->whichDeftemplate != theDeftemplate) { return(FALSE); } /*===================================================*/ /* Loop through each slot of the deftemplate copying */ /* the source fact value to the destination fact. */ /*===================================================*/ for (i = 0, slotPtr = theDeftemplate->slotList; i < (int) theDeftemplate->numberOfSlots; i++, slotPtr = slotPtr->next) { theDestFact->theProposition.theFields[i].type = theSourceFact->theProposition.theFields[i].type; if (theSourceFact->theProposition.theFields[i].type != MULTIFIELD) { theDestFact->theProposition.theFields[i].value = theSourceFact->theProposition.theFields[i].value; } else { theDestFact->theProposition.theFields[i].value = CopyMultifield(theEnv,(struct multifield *) theSourceFact->theProposition.theFields[i].value); } } /*========================================*/ /* Return TRUE to indicate that fact slot */ /* values were successfully copied. */ /*========================================*/ return(TRUE); } /*********************************************/ /* CreateFactBySize: Allocates a fact data */ /* structure based on the number of slots. */ /*********************************************/ globle struct fact *CreateFactBySize( void *theEnv, unsigned size) { struct fact *theFact; unsigned newSize; if (size <= 0) newSize = 1; else newSize = size; theFact = get_var_struct(theEnv,fact,sizeof(struct field) * (newSize - 1)); theFact->garbage = FALSE; theFact->factIndex = 0LL; theFact->factHeader.busyCount = 0; theFact->factHeader.theInfo = &FactData(theEnv)->FactInfo; theFact->factHeader.dependents = NULL; theFact->whichDeftemplate = NULL; theFact->nextFact = NULL; theFact->previousFact = NULL; theFact->previousTemplateFact = NULL; theFact->nextTemplateFact = NULL; theFact->list = NULL; theFact->theProposition.multifieldLength = size; theFact->theProposition.busyCount = 0; return(theFact); } /*********************************************/ /* ReturnFact: Returns a fact data structure */ /* to the pool of free memory. */ /*********************************************/ globle void ReturnFact( void *theEnv, struct fact *theFact) { struct multifield *theSegment, *subSegment; long newSize, i; theSegment = &theFact->theProposition; for (i = 0; i < theSegment->multifieldLength; i++) { if (theSegment->theFields[i].type == MULTIFIELD) { subSegment = (struct multifield *) theSegment->theFields[i].value; if (subSegment->busyCount == 0) { ReturnMultifield(theEnv,subSegment); } else { AddToMultifieldList(theEnv,subSegment); } } } if (theFact->theProposition.multifieldLength == 0) newSize = 1; else newSize = theFact->theProposition.multifieldLength; rtn_var_struct(theEnv,fact,sizeof(struct field) * (newSize - 1),theFact); } /*************************************************************/ /* FactInstall: Increments the fact, deftemplate, and atomic */ /* data value busy counts associated with the fact. */ /*************************************************************/ globle void FactInstall( void *theEnv, struct fact *newFact) { struct multifield *theSegment; int i; FactData(theEnv)->NumberOfFacts++; newFact->whichDeftemplate->busyCount++; theSegment = &newFact->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomInstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } newFact->factHeader.busyCount++; } /***************************************************************/ /* FactDeinstall: Decrements the fact, deftemplate, and atomic */ /* data value busy counts associated with the fact. */ /***************************************************************/ globle void FactDeinstall( void *theEnv, struct fact *newFact) { struct multifield *theSegment; int i; FactData(theEnv)->NumberOfFacts--; theSegment = &newFact->theProposition; newFact->whichDeftemplate->busyCount--; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomDeinstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } newFact->factHeader.busyCount--; } /************************************************/ /* EnvIncrementFactCount: Increments the number */ /* of references to a specified fact. */ /************************************************/ globle void EnvIncrementFactCount( void *theEnv, void *factPtr) { #if MAC_XCD #pragma unused(theEnv) #endif ((struct fact *) factPtr)->factHeader.busyCount++; } /************************************************/ /* EnvDecrementFactCount: Decrements the number */ /* of references to a specified fact. */ /************************************************/ globle void EnvDecrementFactCount( void *theEnv, void *factPtr) { #if MAC_XCD #pragma unused(theEnv) #endif ((struct fact *) factPtr)->factHeader.busyCount--; } /*********************************************************/ /* EnvGetNextFact: If passed a NULL pointer, returns the */ /* first fact in the fact-list. Otherwise returns the */ /* next fact following the fact passed as an argument. */ /*********************************************************/ globle void *EnvGetNextFact( void *theEnv, void *factPtr) { if (factPtr == NULL) { return((void *) FactData(theEnv)->FactList); } if (((struct fact *) factPtr)->garbage) return(NULL); return((void *) ((struct fact *) factPtr)->nextFact); } /**************************************************/ /* GetNextFactInScope: Returns the next fact that */ /* is in scope of the current module. Works in */ /* a similar fashion to GetNextFact, but skips */ /* facts that are out of scope. */ /**************************************************/ globle void *GetNextFactInScope( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; /*=======================================================*/ /* If fact passed as an argument is a NULL pointer, then */ /* we're just beginning a traversal of the fact list. If */ /* the module index has changed since that last time the */ /* fact list was traversed by this routine, then */ /* determine all of the deftemplates that are in scope */ /* of the current module. */ /*=======================================================*/ if (theFact == NULL) { theFact = FactData(theEnv)->FactList; if (FactData(theEnv)->LastModuleIndex != DefmoduleData(theEnv)->ModuleChangeIndex) { UpdateDeftemplateScope(theEnv); FactData(theEnv)->LastModuleIndex = DefmoduleData(theEnv)->ModuleChangeIndex; } } /*==================================================*/ /* Otherwise, if the fact passed as an argument has */ /* been retracted, then there's no way to determine */ /* the next fact, so return a NULL pointer. */ /*==================================================*/ else if (((struct fact *) theFact)->garbage) { return(NULL); } /*==================================================*/ /* Otherwise, start the search for the next fact in */ /* scope with the fact immediately following the */ /* fact passed as an argument. */ /*==================================================*/ else { theFact = theFact->nextFact; } /*================================================*/ /* Continue traversing the fact-list until a fact */ /* is found that's associated with a deftemplate */ /* that's in scope. */ /*================================================*/ while (theFact != NULL) { if (theFact->whichDeftemplate->inScope) return((void *) theFact); theFact = theFact->nextFact; } return(NULL); } /****************************************/ /* EnvGetFactPPForm: Returns the pretty */ /* print representation of a fact. */ /****************************************/ globle void EnvGetFactPPForm( void *theEnv, char *buffer, size_t bufferLength, void *theFact) { OpenStringDestination(theEnv,"FactPPForm",buffer,bufferLength); PrintFactWithIdentifier(theEnv,"FactPPForm",(struct fact *) theFact); CloseStringDestination(theEnv,"FactPPForm"); } /**********************************/ /* EnvFactIndex: C access routine */ /* for the fact-index function. */ /**********************************/ globle long long EnvFactIndex( void *theEnv, void *factPtr) { #if MAC_XCD #pragma unused(theEnv) #endif return(((struct fact *) factPtr)->factIndex); } /*************************************/ /* EnvAssertString: C access routine */ /* for the assert-string function. */ /*************************************/ globle void *EnvAssertString( void *theEnv, const char *theString) { struct fact *theFact; int danglingConstructs; danglingConstructs = ConstructData(theEnv)->DanglingConstructs; if ((theFact = StringToFact(theEnv,theString)) == NULL) return(NULL); if ((! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { ConstructData(theEnv)->DanglingConstructs = danglingConstructs; } return((void *) EnvAssert(theEnv,(void *) theFact)); } /******************************************************/ /* EnvGetFactListChanged: Returns the flag indicating */ /* whether a change to the fact-list has been made. */ /******************************************************/ globle int EnvGetFactListChanged( void *theEnv) { return(FactData(theEnv)->ChangeToFactList); } /***********************************************************/ /* EnvSetFactListChanged: Sets the flag indicating whether */ /* a change to the fact-list has been made. */ /***********************************************************/ globle void EnvSetFactListChanged( void *theEnv, int value) { FactData(theEnv)->ChangeToFactList = value; } /****************************************/ /* GetNumberOfFacts: Returns the number */ /* of facts in the fact-list. */ /****************************************/ globle unsigned long GetNumberOfFacts( void *theEnv) { return(FactData(theEnv)->NumberOfFacts); } /***********************************************************/ /* ResetFacts: Reset function for facts. Sets the starting */ /* fact index to zero and removes all facts. */ /***********************************************************/ static void ResetFacts( void *theEnv) { /*====================================*/ /* Initialize the fact index to zero. */ /*====================================*/ FactData(theEnv)->NextFactIndex = 0L; /*======================================*/ /* Remove all facts from the fact list. */ /*======================================*/ RemoveAllFacts(theEnv); } /************************************************************/ /* ClearFactsReady: Clear ready function for facts. Returns */ /* TRUE if facts were successfully removed and the clear */ /* command can continue, otherwise FALSE. */ /************************************************************/ static int ClearFactsReady( void *theEnv) { /*======================================*/ /* Facts can not be deleted when a join */ /* operation is already in progress. */ /*======================================*/ if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE); /*====================================*/ /* Initialize the fact index to zero. */ /*====================================*/ FactData(theEnv)->NextFactIndex = 0L; /*======================================*/ /* Remove all facts from the fact list. */ /*======================================*/ RemoveAllFacts(theEnv); /*==============================================*/ /* If for some reason there are any facts still */ /* remaining, don't continue with the clear. */ /*==============================================*/ if (EnvGetNextFact(theEnv,NULL) != NULL) return(FALSE); /*=============================*/ /* Return TRUE to indicate the */ /* clear command can continue. */ /*=============================*/ return(TRUE); } /***************************************************/ /* FindIndexedFact: Returns a pointer to a fact in */ /* the fact list with the specified fact index. */ /***************************************************/ globle struct fact *FindIndexedFact( void *theEnv, long long factIndexSought) { struct fact *theFact; for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL); theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact)) { if (theFact->factIndex == factIndexSought) { return(theFact); } } return(NULL); } /*****************************************/ /* EnvAddAssertFunction: Adds a function */ /* to the ListOfAssertFunctions. */ /*****************************************/ globle intBool EnvAddAssertFunction( void *theEnv, const char *name, void (*functionPtr)(void *, void *), int priority) { FactData(theEnv)->ListOfAssertFunctions = AddFunctionToCallListWithArg(theEnv,name,priority, functionPtr, FactData(theEnv)->ListOfAssertFunctions,TRUE); return(1); } /********************************************/ /* EnvAddAssertFunctionWithContext: Adds a */ /* function to the ListOfAssertFunctions. */ /********************************************/ globle intBool EnvAddAssertFunctionWithContext( void *theEnv, const char *name, void (*functionPtr)(void *, void *), int priority, void *context) { FactData(theEnv)->ListOfAssertFunctions = AddFunctionToCallListWithArgWithContext(theEnv,name,priority,functionPtr, FactData(theEnv)->ListOfAssertFunctions, TRUE,context); return(1); } /***********************************************/ /* EnvRemoveAssertFunction: Removes a function */ /* from the ListOfAssertFunctions. */ /***********************************************/ globle intBool EnvRemoveAssertFunction( void *theEnv, const char *name) { int found; FactData(theEnv)->ListOfAssertFunctions = RemoveFunctionFromCallListWithArg(theEnv,name,FactData(theEnv)->ListOfAssertFunctions,&found); if (found) return(TRUE); return(FALSE); } /******************************************/ /* EnvAddRetractFunction: Adds a function */ /* to the ListOfRetractFunctions. */ /******************************************/ globle intBool EnvAddRetractFunction( void *theEnv, const char *name, void (*functionPtr)(void *, void *), int priority) { FactData(theEnv)->ListOfRetractFunctions = AddFunctionToCallListWithArg(theEnv,name,priority, functionPtr, FactData(theEnv)->ListOfRetractFunctions,TRUE); return(1); } /*********************************************/ /* EnvAddRetractFunctionWithContext: Adds a */ /* function to the ListOfRetractFunctions. */ /*********************************************/ globle intBool EnvAddRetractFunctionWithContext( void *theEnv, const char *name, void (*functionPtr)(void *, void *), int priority, void *context) { FactData(theEnv)->ListOfRetractFunctions = AddFunctionToCallListWithArgWithContext(theEnv,name,priority,functionPtr, FactData(theEnv)->ListOfRetractFunctions, TRUE,context); return(1); } /************************************************/ /* EnvRemoveRetractFunction: Removes a function */ /* from the ListOfRetractFunctions. */ /************************************************/ globle intBool EnvRemoveRetractFunction( void *theEnv, const char *name) { int found; FactData(theEnv)->ListOfRetractFunctions = RemoveFunctionFromCallListWithArg(theEnv,name,FactData(theEnv)->ListOfRetractFunctions,&found); if (found) return(TRUE); return(FALSE); } /*****************************************/ /* EnvAddModifyFunction: Adds a function */ /* to the ListOfModifyFunctions. */ /*****************************************/ globle intBool EnvAddModifyFunction( void *theEnv, const char *name, void (*functionPtr)(void *, void *, void *), int priority) { FactData(theEnv)->ListOfModifyFunctions = AddFunctionToCallListWithArg(theEnv,name,priority, (void (*)(void *, void *)) functionPtr, FactData(theEnv)->ListOfModifyFunctions,TRUE); return(1); } /********************************************/ /* EnvAddModifyFunctionWithContext: Adds a */ /* function to the ListOfModifyFunctions. */ /********************************************/ globle intBool EnvAddModifyFunctionWithContext( void *theEnv, const char *name, void (*functionPtr)(void *, void *, void *), int priority, void *context) { FactData(theEnv)->ListOfModifyFunctions = AddFunctionToCallListWithArgWithContext(theEnv,name,priority, (void (*)(void *, void *)) functionPtr, FactData(theEnv)->ListOfModifyFunctions, TRUE,context); return(1); } /***********************************************/ /* EnvRemoveModifyFunction: Removes a function */ /* from the ListOfModifyFunctions. */ /***********************************************/ globle intBool EnvRemoveModifyFunction( void *theEnv, const char *name) { int found; FactData(theEnv)->ListOfModifyFunctions = RemoveFunctionFromCallListWithArg(theEnv,name,FactData(theEnv)->ListOfModifyFunctions,&found); if (found) return(TRUE); return(FALSE); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool AddAssertFunction( const char *name, void (*functionPtr)(void *,void *), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); FactData(theEnv)->ListOfAssertFunctions = AddFunctionToCallListWithArg(theEnv,name,priority,(void (*)(void *, void *)) functionPtr, FactData(theEnv)->ListOfAssertFunctions,TRUE); return(1); } globle intBool AddModifyFunction( const char *name, void (*functionPtr)(void *,void *,void *), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); FactData(theEnv)->ListOfModifyFunctions = AddFunctionToCallListWithArg(theEnv,name,priority,(void (*)(void *, void *)) functionPtr, FactData(theEnv)->ListOfModifyFunctions,TRUE); return(1); } globle intBool AddRetractFunction( const char *name, void (*functionPtr)(void *,void *), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); FactData(theEnv)->ListOfRetractFunctions = AddFunctionToCallListWithArg(theEnv,name,priority,(void (*)(void *, void *)) functionPtr, FactData(theEnv)->ListOfRetractFunctions,TRUE); return(1); } globle void *Assert( void *vTheFact) { return EnvAssert(GetCurrentEnvironment(),vTheFact); } globle void *AssertString( const char *theString) { return EnvAssertString(GetCurrentEnvironment(),theString); } globle intBool AssignFactSlotDefaults( void *vTheFact) { return EnvAssignFactSlotDefaults(GetCurrentEnvironment(),vTheFact); } globle struct fact *CreateFact( void *vTheDeftemplate) { return EnvCreateFact(GetCurrentEnvironment(),vTheDeftemplate); } globle void DecrementFactCount( void *factPtr) { EnvDecrementFactCount(GetCurrentEnvironment(),factPtr); } globle long long FactIndex( void *factPtr) { return(EnvFactIndex(GetCurrentEnvironment(),factPtr)); } globle int GetFactListChanged() { return EnvGetFactListChanged(GetCurrentEnvironment()); } globle void GetFactPPForm( char *buffer, unsigned bufferLength, void *theFact) { EnvGetFactPPForm(GetCurrentEnvironment(),buffer,bufferLength,theFact); } globle intBool GetFactSlot( void *vTheFact, const char *slotName, DATA_OBJECT *theValue) { return(EnvGetFactSlot(GetCurrentEnvironment(),vTheFact,slotName,theValue)); } globle void *GetNextFact( void *factPtr) { return EnvGetNextFact(GetCurrentEnvironment(),factPtr); } globle void IncrementFactCount( void *factPtr) { EnvIncrementFactCount(GetCurrentEnvironment(),factPtr); } globle intBool PutFactSlot( void *vTheFact, const char *slotName, DATA_OBJECT *theValue) { return EnvPutFactSlot(GetCurrentEnvironment(),vTheFact,slotName,theValue); } globle intBool RemoveAssertFunction( const char *name) { return EnvRemoveAssertFunction(GetCurrentEnvironment(),name); } globle intBool RemoveModifyFunction( const char *name) { return EnvRemoveModifyFunction(GetCurrentEnvironment(),name); } globle intBool RemoveRetractFunction( const char *name) { return EnvRemoveRetractFunction(GetCurrentEnvironment(),name); } globle intBool Retract( void *vTheFact) { return EnvRetract(GetCurrentEnvironment(),vTheFact); } globle void SetFactListChanged( int value) { EnvSetFactListChanged(GetCurrentEnvironment(),value); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips_core_source_630/core/._proflfun.h0000755000175000017500000000040712373743632016465 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/router.h0000755000175000017500000001611112461762345015734 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* ROUTER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a centralized mechanism for handling */ /* input and output requests. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed conversion of '\r' to '\n' from the */ /* EnvGetcRouter function. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added support for passing context information */ /* to the router functions. */ /* */ /* 6.30: Fixed issues with passing context to routers. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ #ifndef _H_router #define _H_router #ifndef _H_prntutil #include "prntutil.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define WWARNING "wwarning" #define WERROR "werror" #define WTRACE "wtrace" #define WDIALOG "wdialog" #define WPROMPT WPROMPT_STRING #define WDISPLAY "wdisplay" #define STDOUT "stdout" #define STDIN "stdin" #define ROUTER_DATA 46 struct router { const char *name; int active; int priority; short int environmentAware; void *context; int (*query)(void *,const char *); int (*printer)(void *,const char *,const char *); int (*exiter)(void *,int); int (*charget)(void *,const char *); int (*charunget)(void *,int,const char *); struct router *next; }; struct routerData { size_t CommandBufferInputCount; int AwaitingInput; const char *LineCountRouter; const char *FastCharGetRouter; char *FastCharGetString; long FastCharGetIndex; struct router *ListOfRouters; FILE *FastLoadFilePtr; FILE *FastSaveFilePtr; int Abort; }; #define RouterData(theEnv) ((struct routerData *) GetEnvironmentData(theEnv,ROUTER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _ROUTER_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeDefaultRouters(void *); LOCALE int EnvPrintRouter(void *,const char *,const char *); LOCALE int EnvGetcRouter(void *,const char *); LOCALE int EnvUngetcRouter(void *,int,const char *); LOCALE void EnvExitRouter(void *,int); LOCALE void AbortExit(void *); LOCALE intBool EnvAddRouterWithContext(void *, const char *,int, int (*)(void *,const char *), int (*)(void *,const char *,const char *), int (*)(void *,const char *), int (*)(void *,int,const char *), int (*)(void *,int), void *); LOCALE intBool EnvAddRouter(void *, const char *,int, int (*)(void *,const char *), int (*)(void *,const char *,const char *), int (*)(void *,const char *), int (*)(void *,int,const char *), int (*)(void *,int)); LOCALE int EnvDeleteRouter(void *,const char *); LOCALE int QueryRouters(void *,const char *); LOCALE int EnvDeactivateRouter(void *,const char *); LOCALE int EnvActivateRouter(void *,const char *); LOCALE void SetFastLoad(void *,FILE *); LOCALE void SetFastSave(void *,FILE *); LOCALE FILE *GetFastLoad(void *); LOCALE FILE *GetFastSave(void *); LOCALE void UnrecognizedRouterMessage(void *,const char *); LOCALE void ExitCommand(void *); LOCALE int PrintNRouter(void *,const char *,const char *,unsigned long); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE int ActivateRouter(const char *); LOCALE intBool AddRouter(const char *,int, int (*)(const char *), int (*)(const char *,const char *), int (*)(const char *), int (*)(int,const char *), int (*)(int)); LOCALE int DeactivateRouter(const char *); LOCALE int DeleteRouter(const char *); LOCALE void ExitRouter(int); LOCALE int GetcRouter(const char *); LOCALE int PrintRouter(const char *,const char *); LOCALE int UngetcRouter(int,const char *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_router */ clips_core_source_630/core/._inherpsr.h0000755000175000017500000000040712373755056016467 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnpsr.h0000755000175000017500000000761012374023223016262 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing constraint */ /* declarations. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Used gensprintf instead of sprintf. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_cstrnpsr #define _H_cstrnpsr #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct constraintParseRecord { unsigned int type : 1; unsigned int range : 1; unsigned int allowedSymbols : 1; unsigned int allowedStrings : 1; unsigned int allowedLexemes : 1; unsigned int allowedFloats : 1; unsigned int allowedIntegers : 1; unsigned int allowedNumbers : 1; unsigned int allowedValues : 1; unsigned int allowedClasses : 1; unsigned int allowedInstanceNames : 1; unsigned int cardinality : 1; }; typedef struct constraintParseRecord CONSTRAINT_PARSE_RECORD; LOCALE intBool CheckConstraintParseConflicts(void *,CONSTRAINT_RECORD *); LOCALE void AttributeConflictErrorMessage(void *,const char *,const char *); #if (! RUN_TIME) && (! BLOAD_ONLY) LOCALE void InitializeConstraintParseRecord(CONSTRAINT_PARSE_RECORD *); LOCALE intBool StandardConstraint(const char *); LOCALE intBool ParseStandardConstraint(void *,const char *,const char *, CONSTRAINT_RECORD *, CONSTRAINT_PARSE_RECORD *, int); LOCALE void OverlayConstraint(void *,CONSTRAINT_PARSE_RECORD *, CONSTRAINT_RECORD *,CONSTRAINT_RECORD *); LOCALE void OverlayConstraintParseRecord(CONSTRAINT_PARSE_RECORD *, CONSTRAINT_PARSE_RECORD *); #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* _H_cstrnpsr */ clips_core_source_630/core/._factmch.c0000755000175000017500000000040712373742652016233 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/utility.h0000755000175000017500000002236712375756703016136 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. Primarily these are the functions for */ /* handling periodic garbage collection and appending */ /* string data. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added CopyString, DeleteString, */ /* InsertInString,and EnlargeString functions. */ /* */ /* Used genstrncpy function instead of strncpy */ /* function. */ /* */ /* Support for typed EXTERNAL_ADDRESS. */ /* */ /* Support for tracked memory (allows memory to */ /* be freed if CLIPS is exited while executing). */ /* */ /* Added UTF-8 routines. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_utility #define _H_utility #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif struct callFunctionItem { const char *name; void (*func)(void *); int priority; struct callFunctionItem *next; short int environmentAware; void *context; }; struct callFunctionItemWithArg { const char *name; void (*func)(void *,void *); int priority; struct callFunctionItemWithArg *next; short int environmentAware; void *context; }; struct trackedMemory { void *theMemory; struct trackedMemory *next; struct trackedMemory *prev; size_t memSize; }; struct garbageFrame { short dirty; short topLevel; struct garbageFrame *priorFrame; struct ephemeron *ephemeralSymbolList; struct ephemeron *ephemeralFloatList; struct ephemeron *ephemeralIntegerList; struct ephemeron *ephemeralBitMapList; struct ephemeron *ephemeralExternalAddressList; struct multifield *ListOfMultifields; struct multifield *LastMultifield; }; #define UTILITY_DATA 55 struct utilityData { struct callFunctionItem *ListOfCleanupFunctions; struct callFunctionItem *ListOfPeriodicFunctions; short GarbageCollectionLocks; short PeriodicFunctionsEnabled; short YieldFunctionEnabled; void (*YieldTimeFunction)(void); struct trackedMemory *trackList; struct garbageFrame MasterGarbageFrame; struct garbageFrame *CurrentGarbageFrame; }; #define UtilityData(theEnv) ((struct utilityData *) GetEnvironmentData(theEnv,UTILITY_DATA)) /* Is c the start of a utf8 sequence? */ #define IsUTF8Start(ch) (((ch) & 0xC0) != 0x80) #define IsUTF8MultiByteStart(ch) ((((unsigned char) ch) >= 0xC0) && (((unsigned char) ch) <= 0xF7)) #define IsUTF8MultiByteContinuation(ch) ((((unsigned char) ch) >= 0x80) && (((unsigned char) ch) <= 0xBF)) #ifdef _UTILITY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeUtilityData(void *); LOCALE intBool AddCleanupFunction(void *,const char *,void (*)(void *),int); LOCALE intBool EnvAddPeriodicFunction(void *,const char *,void (*)(void *),int); LOCALE intBool AddPeriodicFunction(const char *,void (*)(void),int); LOCALE intBool RemoveCleanupFunction(void *,const char *); LOCALE intBool EnvRemovePeriodicFunction(void *,const char *); LOCALE char *CopyString(void *,const char *); LOCALE void DeleteString(void *,char *); LOCALE const char *AppendStrings(void *,const char *,const char *); LOCALE const char *StringPrintForm(void *,const char *); LOCALE char *AppendToString(void *,const char *,char *,size_t *,size_t *); LOCALE char *InsertInString(void *,const char *,size_t,char *,size_t *,size_t *); LOCALE char *AppendNToString(void *,const char *,char *,size_t,size_t *,size_t *); LOCALE char *EnlargeString(void *,size_t,char *,size_t *,size_t *); LOCALE char *ExpandStringWithChar(void *,int,char *,size_t *,size_t *,size_t); LOCALE struct callFunctionItem *AddFunctionToCallList(void *,const char *,int,void (*)(void *), struct callFunctionItem *,intBool); LOCALE struct callFunctionItem *AddFunctionToCallListWithContext(void *,const char *,int,void (*)(void *), struct callFunctionItem *,intBool,void *); LOCALE struct callFunctionItem *RemoveFunctionFromCallList(void *,const char *, struct callFunctionItem *, int *); LOCALE void DeallocateCallList(void *,struct callFunctionItem *); LOCALE struct callFunctionItemWithArg *AddFunctionToCallListWithArg(void *,const char *,int,void (*)(void *, void *), struct callFunctionItemWithArg *,intBool); LOCALE struct callFunctionItemWithArg *AddFunctionToCallListWithArgWithContext(void *,const char *,int,void (*)(void *, void *), struct callFunctionItemWithArg *,intBool,void *); LOCALE struct callFunctionItemWithArg *RemoveFunctionFromCallListWithArg(void *,const char *, struct callFunctionItemWithArg *, int *); LOCALE void DeallocateCallListWithArg(void *,struct callFunctionItemWithArg *); LOCALE unsigned long ItemHashValue(void *,unsigned short,void *,unsigned long); LOCALE void YieldTime(void *); LOCALE void EnvIncrementGCLocks(void *); LOCALE void EnvDecrementGCLocks(void *); LOCALE short EnablePeriodicFunctions(void *,short); LOCALE short EnableYieldFunction(void *,short); LOCALE struct trackedMemory *AddTrackedMemory(void *,void *,size_t); LOCALE void RemoveTrackedMemory(void *,struct trackedMemory *); LOCALE void UTF8Increment(const char *,size_t *); LOCALE size_t UTF8Offset(const char *,size_t); LOCALE size_t UTF8Length(const char *); LOCALE size_t UTF8CharNum(const char *,size_t); LOCALE void RestorePriorGarbageFrame(void *,struct garbageFrame *,struct garbageFrame *,struct dataObject *); LOCALE void CallCleanupFunctions(void *); LOCALE void CallPeriodicTasks(void *); LOCALE void CleanCurrentGarbageFrame(void *,struct dataObject *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void IncrementGCLocks(void); LOCALE void DecrementGCLocks(void); LOCALE intBool RemovePeriodicFunction(const char *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_utility */ clips_core_source_630/core/cstrnchk.h0000755000175000017500000001030312375676605016237 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* CONSTRAINT CHECKING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for constraint checking of */ /* data types. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Dynamic constraint checking for the */ /* allowed-classes constraint now searches */ /* imported modules. */ /* */ /*************************************************************/ #ifndef _H_cstrnchk #define _H_cstrnchk #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNCHK_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define NO_VIOLATION 0 #define TYPE_VIOLATION 1 #define RANGE_VIOLATION 2 #define ALLOWED_VALUES_VIOLATION 3 #define FUNCTION_RETURN_TYPE_VIOLATION 4 #define CARDINALITY_VIOLATION 5 #define ALLOWED_CLASSES_VIOLATION 6 LOCALE intBool CheckCardinalityConstraint(void *,long,CONSTRAINT_RECORD *); LOCALE intBool CheckAllowedValuesConstraint(int,void *,CONSTRAINT_RECORD *); LOCALE intBool CheckAllowedClassesConstraint(void *,int,void *,CONSTRAINT_RECORD *); LOCALE int ConstraintCheckExpressionChain(void *,struct expr *, CONSTRAINT_RECORD *); LOCALE void ConstraintViolationErrorMessage(void *,const char *,const char *,int,int, struct symbolHashNode *, int,int,CONSTRAINT_RECORD *, int); LOCALE int ConstraintCheckValue(void *,int,void *,CONSTRAINT_RECORD *); LOCALE int ConstraintCheckDataObject(void *,DATA_OBJECT *,CONSTRAINT_RECORD *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int ConstraintCheckExpression(void *,struct expr *, CONSTRAINT_RECORD *); #endif #if (! RUN_TIME) LOCALE intBool UnmatchableConstraint(struct constraintRecord *); #endif #endif /* _H_cstrnchk */ clips_core_source_630/core/._pattern.c0000755000175000017500000000033012365012260016260 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insfun.c0000755000175000017500000014114612500146515015705 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* INSTANCE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Internal instance manipulation routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved EvaluateAndStoreInDataObject to */ /* evaluatn.c */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed slot override default ?NONE bug. */ /* */ /* Instances of the form [] are now */ /* searched for in all modules. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "cstrnchk.h" #include "engine.h" #include "envrnmnt.h" #include "inscom.h" #include "insmngr.h" #include "memalloc.h" #include "modulutl.h" #include "msgcom.h" #include "msgfun.h" #include "prccode.h" #include "router.h" #include "utility.h" #if DEFRULE_CONSTRUCT #include "drive.h" #include "objrtmch.h" #endif #define _INSFUN_SOURCE_ #include "insfun.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BIG_PRIME 11329 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static INSTANCE_TYPE *FindImportedInstance(void *,struct defmodule *,struct defmodule *,INSTANCE_TYPE *); #if DEFRULE_CONSTRUCT static void NetworkModifyForSharedSlot(void *,int,DEFCLASS *,SLOT_DESC *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : EnvIncrementInstanceCount DESCRIPTION : Increments instance busy count - prevents it from being deleted INPUTS : The address of the instance RETURNS : Nothing useful SIDE EFFECTS : Count set NOTES : None ***************************************************/ globle void EnvIncrementInstanceCount( void *theEnv, void *vptr) { #if MAC_XCD #pragma unused(theEnv) #endif ((INSTANCE_TYPE *) vptr)->busy++; } /*************************************************** NAME : EnvDecrementInstanceCount DESCRIPTION : Decrements instance busy count - might allow it to be deleted INPUTS : The address of the instance RETURNS : Nothing useful SIDE EFFECTS : Count set NOTES : None ***************************************************/ globle void EnvDecrementInstanceCount( void *theEnv, void *vptr) { #if MAC_XCD #pragma unused(theEnv) #endif ((INSTANCE_TYPE *) vptr)->busy--; } /*************************************************** NAME : InitializeInstanceTable DESCRIPTION : Initializes instance hash table to all NULL addresses INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Hash table initialized NOTES : None ***************************************************/ globle void InitializeInstanceTable( void *theEnv) { register int i; InstanceData(theEnv)->InstanceTable = (INSTANCE_TYPE **) gm2(theEnv,(int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE)); for (i = 0 ; i < INSTANCE_TABLE_HASH_SIZE ; i++) InstanceData(theEnv)->InstanceTable[i] = NULL; } /******************************************************* NAME : CleanupInstances DESCRIPTION : Iterates through instance garbage list looking for nodes that have become unused - and purges them INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Non-busy instance garbage nodes deleted NOTES : None *******************************************************/ globle void CleanupInstances( void *theEnv) { IGARBAGE *gprv,*gtmp,*dump; if (InstanceData(theEnv)->MaintainGarbageInstances) return; gprv = NULL; gtmp = InstanceData(theEnv)->InstanceGarbageList; while (gtmp != NULL) { #if DEFRULE_CONSTRUCT if ((gtmp->ins->busy == 0) && (gtmp->ins->header.busyCount == 0)) #else if (gtmp->ins->busy == 0) #endif { DecrementSymbolCount(theEnv,gtmp->ins->name); rtn_struct(theEnv,instance,gtmp->ins); if (gprv == NULL) InstanceData(theEnv)->InstanceGarbageList = gtmp->nxt; else gprv->nxt = gtmp->nxt; dump = gtmp; gtmp = gtmp->nxt; rtn_struct(theEnv,igarbage,dump); } else { gprv = gtmp; gtmp = gtmp->nxt; } } } /******************************************************* NAME : HashInstance DESCRIPTION : Generates a hash index for a given instance name INPUTS : The address of the instance name SYMBOL_HN RETURNS : The hash index value SIDE EFFECTS : None NOTES : Counts on the fact that the symbol has already been hashed into the symbol table - uses that hash value multiplied by a prime for a new hash *******************************************************/ globle unsigned HashInstance( SYMBOL_HN *cname) { unsigned long tally; tally = ((unsigned long) cname->bucket) * BIG_PRIME; return((unsigned) (tally % INSTANCE_TABLE_HASH_SIZE)); } /*************************************************** NAME : DestroyAllInstances DESCRIPTION : Deallocates all instances, reinitializes hash table and resets class instance pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : All instances deallocated NOTES : None ***************************************************/ globle void DestroyAllInstances( void *theEnv) { INSTANCE_TYPE *iptr; int svmaintain; SaveCurrentModule(theEnv); svmaintain = InstanceData(theEnv)->MaintainGarbageInstances; InstanceData(theEnv)->MaintainGarbageInstances = TRUE; iptr = InstanceData(theEnv)->InstanceList; while (iptr != NULL) { EnvSetCurrentModule(theEnv,(void *) iptr->cls->header.whichModule->theModule); DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,iptr,NULL,NULL); iptr = iptr->nxtList; while ((iptr != NULL) ? iptr->garbage : FALSE) iptr = iptr->nxtList; } InstanceData(theEnv)->MaintainGarbageInstances = svmaintain; RestoreCurrentModule(theEnv); } /****************************************************** NAME : RemoveInstanceData DESCRIPTION : Deallocates all the data objects in instance slots and then dealloactes the slots themeselves INPUTS : The instance RETURNS : Nothing useful SIDE EFFECTS : Instance slots removed NOTES : An instance made with CopyInstanceData will have shared values removed in all cases because they are not "real" instances. Instance class busy count decremented ******************************************************/ globle void RemoveInstanceData( void *theEnv, INSTANCE_TYPE *ins) { long i; INSTANCE_SLOT *sp; DecrementDefclassBusyCount(theEnv,(void *) ins->cls); for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { sp = ins->slotAddresses[i]; if ((sp == &sp->desc->sharedValue) ? (--sp->desc->sharedCount == 0) : TRUE) { if (sp->desc->multiple) { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value); AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value); } else AtomDeinstall(theEnv,(int) sp->type,sp->value); sp->value = NULL; } } if (ins->cls->instanceSlotCount != 0) { rm(theEnv,(void *) ins->slotAddresses, (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *))); if (ins->cls->localInstanceSlotCount != 0) rm(theEnv,(void *) ins->slots, (ins->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT))); } ins->slots = NULL; ins->slotAddresses = NULL; } /*************************************************************************** NAME : FindInstanceBySymbol DESCRIPTION : Looks up a specified instance in the instance hash table INPUTS : The symbol for the name of the instance RETURNS : The address of the found instance, NULL otherwise SIDE EFFECTS : None NOTES : An instance is searched for by name first in the current module - then in imported modules according to the order given in the current module's definition. Instances of the form [] are now searched for in all modules. ***************************************************************************/ globle INSTANCE_TYPE *FindInstanceBySymbol( void *theEnv, SYMBOL_HN *moduleAndInstanceName) { unsigned modulePosition,searchImports; SYMBOL_HN *moduleName,*instanceName; struct defmodule *currentModule,*theModule; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /* ======================================= Instance names of the form [] are searched for only in the current module ======================================= */ modulePosition = FindModuleSeparator(ValueToString(moduleAndInstanceName)); if (modulePosition == FALSE) { /* theModule = currentModule; instanceName = moduleAndInstanceName; searchImports = FALSE; */ INSTANCE_TYPE *ins; ins = InstanceData(theEnv)->InstanceTable[HashInstance(moduleAndInstanceName)]; while (ins != NULL) { if (ins->name == moduleAndInstanceName) { return ins; } ins = ins->nxtHash; } return(NULL); } /* ========================================= Instance names of the form [::] are searched for in the current module and imported modules in the definition order ========================================= */ else if (modulePosition == 1) { theModule = currentModule; instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName)); searchImports = TRUE; } /* ============================================= Instance names of the form [::] are searched for in the specified module ============================================= */ else { moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(moduleAndInstanceName)); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName)); if (theModule == NULL) return(NULL); searchImports = FALSE; } return(FindInstanceInModule(theEnv,instanceName,theModule,currentModule,searchImports)); } /*************************************************** NAME : FindInstanceInModule DESCRIPTION : Finds an instance of the given name in the given module in scope of the given current module (will also search imported modules if specified) INPUTS : 1) The instance name (no module) 2) The module to search 3) The currently active module 4) A flag indicating whether to search imported modules of given module as well RETURNS : The instance (NULL if none found) SIDE EFFECTS : None NOTES : The class no longer needs to be in scope of the current module if the instance's module name has been specified. ***************************************************/ globle INSTANCE_TYPE *FindInstanceInModule( void *theEnv, SYMBOL_HN *instanceName, struct defmodule *theModule, struct defmodule *currentModule, unsigned searchImports) { INSTANCE_TYPE *startInstance,*ins; /* =============================== Find the first instance of the correct name in the hash chain =============================== */ startInstance = InstanceData(theEnv)->InstanceTable[HashInstance(instanceName)]; while (startInstance != NULL) { if (startInstance->name == instanceName) break; startInstance = startInstance->nxtHash; } if (startInstance == NULL) return(NULL); /* =========================================== Look for the instance in the specified module - if the class of the found instance is in scope of the current module, we have found the instance =========================================== */ for (ins = startInstance ; (ins != NULL) ? (ins->name == startInstance->name) : FALSE ; ins = ins->nxtHash) //if ((ins->cls->header.whichModule->theModule == theModule) && // DefclassInScope(theEnv,ins->cls,currentModule)) if (ins->cls->header.whichModule->theModule == theModule) return(ins); /* ================================ For :: formats, we need to search imported modules too ================================ */ if (searchImports == FALSE) return(NULL); MarkModulesAsUnvisited(theEnv); return(FindImportedInstance(theEnv,theModule,currentModule,startInstance)); } /******************************************************************** NAME : FindInstanceSlot DESCRIPTION : Finds an instance slot by name INPUTS : 1) The address of the instance 2) The symbolic name of the slot RETURNS : The address of the slot, NULL if not found SIDE EFFECTS : None NOTES : None ********************************************************************/ globle INSTANCE_SLOT *FindInstanceSlot( void *theEnv, INSTANCE_TYPE *ins, SYMBOL_HN *sname) { register int i; i = FindInstanceTemplateSlot(theEnv,ins->cls,sname); return((i != -1) ? ins->slotAddresses[i] : NULL); } /******************************************************************** NAME : FindInstanceTemplateSlot DESCRIPTION : Performs a search on an class's instance template slot array to find a slot by name INPUTS : 1) The address of the class 2) The symbolic name of the slot RETURNS : The index of the slot, -1 if not found SIDE EFFECTS : None NOTES : The slot's unique id is used as index into the slot map array. ********************************************************************/ globle int FindInstanceTemplateSlot( void *theEnv, DEFCLASS *cls, SYMBOL_HN *sname) { int sid; sid = FindSlotNameID(theEnv,sname); if (sid == -1) return(-1); if (sid > (int) cls->maxSlotNameID) return(-1); return((int) cls->slotNameMap[sid] - 1); } /******************************************************* NAME : PutSlotValue DESCRIPTION : Evaluates new slot-expression and stores it as a multifield variable for the slot. INPUTS : 1) The address of the instance (NULL if no trace-messages desired) 2) The address of the slot 3) The address of the value 4) DATA_OBJECT_PTR to store the set value 5) The command doing the put- RETURNS : FALSE on errors, or TRUE SIDE EFFECTS : Old value deleted and new one allocated Old value symbols deinstalled New value symbols installed NOTES : None *******************************************************/ globle int PutSlotValue( void *theEnv, INSTANCE_TYPE *ins, INSTANCE_SLOT *sp, DATA_OBJECT *val, DATA_OBJECT *setVal, const char *theCommand) { if (ValidSlotValue(theEnv,val,sp->desc,ins,theCommand) == FALSE) { SetpType(setVal,SYMBOL); SetpValue(setVal,EnvFalseSymbol(theEnv)); return(FALSE); } return(DirectPutSlotValue(theEnv,ins,sp,val,setVal)); } /******************************************************* NAME : DirectPutSlotValue DESCRIPTION : Evaluates new slot-expression and stores it as a multifield variable for the slot. INPUTS : 1) The address of the instance (NULL if no trace-messages desired) 2) The address of the slot 3) The address of the value 4) DATA_OBJECT_PTR to store the set value RETURNS : FALSE on errors, or TRUE SIDE EFFECTS : Old value deleted and new one allocated Old value symbols deinstalled New value symbols installed NOTES : None *******************************************************/ globle int DirectPutSlotValue( void *theEnv, INSTANCE_TYPE *ins, INSTANCE_SLOT *sp, DATA_OBJECT *val, DATA_OBJECT *setVal) { register long i,j; /* 6.04 Bug Fix */ #if DEFRULE_CONSTRUCT int sharedTraversalID; INSTANCE_SLOT *bsp,**spaddr; #endif DATA_OBJECT tmpVal; SetpType(setVal,SYMBOL); SetpValue(setVal,EnvFalseSymbol(theEnv)); if (val == NULL) { SystemError(theEnv,"INSFUN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } else if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue) { if (sp->desc->dynamicDefault) { val = &tmpVal; if (!EvaluateAndStoreInDataObject(theEnv,sp->desc->multiple, (EXPRESSION *) sp->desc->defaultValue,val,TRUE)) return(FALSE); } else if (sp->desc->defaultValue != NULL) { val = (DATA_OBJECT *) sp->desc->defaultValue; } else { PrintErrorID(theEnv,"INSMNGR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Override required for slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } } #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress && sp->desc->reactive && (ins->cls->reactive || sp->desc->shared)) { PrintErrorID(theEnv,"INSFUN",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot modify reactive instance slots while\n"); EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } /* ============================================= If we are about to change a slot of an object which is a basis for a firing rule, we need to make sure that slot is copied first ============================================= */ if (ins->basisSlots != NULL) { spaddr = &ins->slotAddresses[ins->cls->slotNameMap[sp->desc->slotName->id] - 1]; bsp = ins->basisSlots + (spaddr - ins->slotAddresses); if (bsp->value == NULL) { bsp->type = sp->type; bsp->value = sp->value; if (sp->desc->multiple) MultifieldInstall(theEnv,(MULTIFIELD_PTR) bsp->value); else AtomInstall(theEnv,(int) bsp->type,bsp->value); } } #endif if (sp->desc->multiple == 0) { AtomDeinstall(theEnv,(int) sp->type,sp->value); /* ====================================== Assumed that multfield already checked to be of cardinality 1 ====================================== */ if (GetpType(val) == MULTIFIELD) { sp->type = GetMFType(GetpValue(val),GetpDOBegin(val)); sp->value = GetMFValue(GetpValue(val),GetpDOBegin(val)); } else { sp->type = val->type; sp->value = val->value; } AtomInstall(theEnv,(int) sp->type,sp->value); SetpType(setVal,sp->type); SetpValue(setVal,sp->value); } else { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value); AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value); sp->type = MULTIFIELD; if (val->type == MULTIFIELD) { sp->value = CreateMultifield2(theEnv,(unsigned long) GetpDOLength(val)); for (i = 1 , j = GetpDOBegin(val) ; i <= GetpDOLength(val) ; i++ , j++) { SetMFType(sp->value,i,GetMFType(val->value,j)); SetMFValue(sp->value,i,GetMFValue(val->value,j)); } } else { sp->value = CreateMultifield2(theEnv,1L); SetMFType(sp->value,1,(short) val->type); SetMFValue(sp->value,1,val->value); } MultifieldInstall(theEnv,(struct multifield *) sp->value); SetpType(setVal,MULTIFIELD); SetpValue(setVal,sp->value); SetpDOBegin(setVal,1); SetpDOEnd(setVal,GetMFLength(sp->value)); } /* ================================================== 6.05 Bug fix - any slot set directly or indirectly by a slot override or other side-effect during an instance initialization should not have its default value set ================================================== */ sp->override = ins->initializeInProgress; #if DEBUGGING_FUNCTIONS if (ins->cls->traceSlots) { if (sp->desc->shared) EnvPrintRouter(theEnv,WTRACE,"::= shared slot "); else EnvPrintRouter(theEnv,WTRACE,"::= local slot "); EnvPrintRouter(theEnv,WTRACE,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WTRACE," in instance "); EnvPrintRouter(theEnv,WTRACE,ValueToString(ins->name)); EnvPrintRouter(theEnv,WTRACE," <- "); if (sp->type != MULTIFIELD) PrintAtom(theEnv,WTRACE,(int) sp->type,sp->value); else PrintMultifield(theEnv,WTRACE,(MULTIFIELD_PTR) sp->value,0, (long) (GetInstanceSlotLength(sp) - 1),TRUE); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif InstanceData(theEnv)->ChangesToInstances = TRUE; #if DEFRULE_CONSTRUCT if (ins->cls->reactive && sp->desc->reactive) { /* ============================================ If we have changed a shared slot, we need to perform a Rete update for every instance which contains this slot ============================================ */ if (sp->desc->shared) { sharedTraversalID = GetTraversalID(theEnv); if (sharedTraversalID != -1) { NetworkModifyForSharedSlot(theEnv,sharedTraversalID,sp->desc->cls,sp->desc); ReleaseTraversalID(theEnv); } else { PrintErrorID(theEnv,"INSFUN",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to pattern-match on shared slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sp->desc->cls)); EnvPrintRouter(theEnv,WERROR,".\n"); } } else ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sp->desc->slotName->id); } #endif return(TRUE); } /******************************************************************* NAME : ValidSlotValue DESCRIPTION : Determines if a value is appropriate for a slot-value INPUTS : 1) The value buffer 2) Slot descriptor 3) Instance for which slot is being checked (can be NULL) 4) Buffer holding printout of the offending command (if NULL assumes message-handler is executing and calls PrintHandler for CurrentCore instead) RETURNS : TRUE if value is OK, FALSE otherwise SIDE EFFECTS : Sets EvaluationError if slot is not OK NOTES : Examines all fields of a multi-field *******************************************************************/ globle int ValidSlotValue( void *theEnv, DATA_OBJECT *val, SLOT_DESC *sd, INSTANCE_TYPE *ins, const char *theCommand) { register int violationCode; /* =================================== Special NoParamValue means to reset slot to default value =================================== */ if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue) return(TRUE); if ((sd->multiple == 0) && (val->type == MULTIFIELD) && (GetpDOLength(val) != 1)) { PrintErrorID(theEnv,"INSFUN",7,FALSE); PrintDataObject(theEnv,WERROR,val); EnvPrintRouter(theEnv,WERROR," illegal for single-field "); PrintSlot(theEnv,WERROR,sd,ins,theCommand); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (val->type == RVOID) { PrintErrorID(theEnv,"INSFUN",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Void function illegal value for "); PrintSlot(theEnv,WERROR,sd,ins,theCommand); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (EnvGetDynamicConstraintChecking(theEnv)) { violationCode = ConstraintCheckDataObject(theEnv,val,sd->constraint); if (violationCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); if ((GetpType(val) == MULTIFIELD) && (sd->multiple == 0)) PrintAtom(theEnv,WERROR,GetMFType(GetpValue(val),GetpDOBegin(val)), GetMFValue(GetpValue(val),GetpDOEnd(val))); else PrintDataObject(theEnv,WERROR,val); EnvPrintRouter(theEnv,WERROR," for "); PrintSlot(theEnv,WERROR,sd,ins,theCommand); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, violationCode,sd->constraint,FALSE); SetEvaluationError(theEnv,TRUE); return(FALSE); } } return(TRUE); } /******************************************************** NAME : CheckInstance DESCRIPTION : Checks to see if the first argument to a function is a valid instance INPUTS : Name of the calling function RETURNS : The address of the instance SIDE EFFECTS : EvaluationError set and messages printed on errors NOTES : Used by Initialize and ModifyInstance ********************************************************/ globle INSTANCE_TYPE *CheckInstance( void *theEnv, const char *func) { INSTANCE_TYPE *ins; DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return(NULL); } } else if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL)) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) { NoInstanceError(theEnv,ValueToString(temp.value),func); return(NULL); } } else { PrintErrorID(theEnv,"INSFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid instance in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } return(ins); } /*************************************************** NAME : NoInstanceError DESCRIPTION : Prints out an appropriate error message when an instance cannot be found for a function INPUTS : 1) The instance name 2) The function name RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void NoInstanceError( void *theEnv, const char *iname, const char *func) { PrintErrorID(theEnv,"INSFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No such instance "); EnvPrintRouter(theEnv,WERROR,iname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /*************************************************** NAME : StaleInstanceAddress DESCRIPTION : Prints out an appropriate error message when an instance address is no longer valid INPUTS : The function name RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void StaleInstanceAddress( void *theEnv, const char *func, int whichArg) { PrintErrorID(theEnv,"INSFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid instance-address in function "); EnvPrintRouter(theEnv,WERROR,func); if (whichArg > 0) { EnvPrintRouter(theEnv,WERROR,", argument #"); PrintLongInteger(theEnv,WERROR,(long long) whichArg); } EnvPrintRouter(theEnv,WERROR,".\n"); } /********************************************************************** NAME : EnvGetInstancesChanged DESCRIPTION : Returns whether instances have changed (any were added/deleted or slot values were changed) since last time flag was set to FALSE INPUTS : None RETURNS : The instances-changed flag SIDE EFFECTS : None NOTES : Used by interfaces to update instance windows **********************************************************************/ globle int EnvGetInstancesChanged( void *theEnv) { return(InstanceData(theEnv)->ChangesToInstances); } /******************************************************* NAME : EnvSetInstancesChanged DESCRIPTION : Sets instances-changed flag (see above) INPUTS : The value (TRUE or FALSE) RETURNS : Nothing useful SIDE EFFECTS : The flag is set NOTES : None *******************************************************/ globle void EnvSetInstancesChanged( void *theEnv, int changed) { InstanceData(theEnv)->ChangesToInstances = changed; } /******************************************************************* NAME : PrintSlot DESCRIPTION : Displays the name and origin of a slot INPUTS : 1) The logical output name 2) The slot descriptor 3) The instance source (can be NULL) 4) Buffer holding printout of the offending command (if NULL assumes message-handler is executing and calls PrintHandler for CurrentCore instead) RETURNS : Nothing useful SIDE EFFECTS : Message printed NOTES : None *******************************************************************/ globle void PrintSlot( void *theEnv, const char *logName, SLOT_DESC *sd, INSTANCE_TYPE *ins, const char *theCommand) { EnvPrintRouter(theEnv,logName,"slot "); EnvPrintRouter(theEnv,logName,ValueToString(sd->slotName->name)); if (ins != NULL) { EnvPrintRouter(theEnv,logName," of instance ["); EnvPrintRouter(theEnv,logName,ValueToString(ins->name)); EnvPrintRouter(theEnv,logName,"]"); } else if (sd->cls != NULL) { EnvPrintRouter(theEnv,logName," of class "); EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,(void *) sd->cls)); } EnvPrintRouter(theEnv,logName," found in "); if (theCommand != NULL) EnvPrintRouter(theEnv,logName,theCommand); else PrintHandler(theEnv,logName,MessageHandlerData(theEnv)->CurrentCore->hnd,FALSE); } /***************************************************** NAME : PrintInstanceNameAndClass DESCRIPTION : Displays an instance's name and class INPUTS : 1) Logical name of output 2) The instance 3) Flag indicating whether to print carriage-return at end RETURNS : Nothing useful SIDE EFFECTS : Instnace name and class printed NOTES : None *****************************************************/ globle void PrintInstanceNameAndClass( void *theEnv, const char *logicalName, INSTANCE_TYPE *theInstance, intBool linefeedFlag) { EnvPrintRouter(theEnv,logicalName,"["); EnvPrintRouter(theEnv,logicalName,EnvGetInstanceName(theEnv,(void *) theInstance)); EnvPrintRouter(theEnv,logicalName,"] of "); PrintClassName(theEnv,logicalName,theInstance->cls,linefeedFlag); } /*************************************************** NAME : PrintInstanceName DESCRIPTION : Used by the rule system commands such as (matches) and (agenda) to print out the name of an instance INPUTS : 1) The logical output name 2) A pointer to the instance RETURNS : Nothing useful SIDE EFFECTS : Name of instance printed NOTES : None ***************************************************/ globle void PrintInstanceName( void *theEnv, const char *logName, void *vins) { INSTANCE_TYPE *ins; ins = (INSTANCE_TYPE *) vins; if (ins->garbage) { EnvPrintRouter(theEnv,logName,"name)); EnvPrintRouter(theEnv,logName,"]>"); } else { EnvPrintRouter(theEnv,logName,"["); EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins))); EnvPrintRouter(theEnv,logName,"]"); } } /*************************************************** NAME : PrintInstanceLongForm DESCRIPTION : Used by kernel to print instance addresses INPUTS : 1) The logical output name 2) A pointer to the instance RETURNS : Nothing useful SIDE EFFECTS : Address of instance printed NOTES : None ***************************************************/ globle void PrintInstanceLongForm( void *theEnv, const char *logName, void *vins) { INSTANCE_TYPE *ins = (INSTANCE_TYPE *) vins; if (PrintUtilityData(theEnv)->InstanceAddressesToNames) { if (ins == &InstanceData(theEnv)->DummyInstance) EnvPrintRouter(theEnv,logName,"\"\""); else { EnvPrintRouter(theEnv,logName,"["); EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins))); EnvPrintRouter(theEnv,logName,"]"); } } else { if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logName,"\""); if (ins == &InstanceData(theEnv)->DummyInstance) EnvPrintRouter(theEnv,logName,""); else if (ins->garbage) { EnvPrintRouter(theEnv,logName,"name)); EnvPrintRouter(theEnv,logName,">"); } else { EnvPrintRouter(theEnv,logName,""); } if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logName,"\""); } } #if DEFRULE_CONSTRUCT /*************************************************** NAME : DecrementObjectBasisCount DESCRIPTION : Decrements the basis count of an object indicating that it is in use by the partial match of the currently executing rule INPUTS : The instance address RETURNS : Nothing useful SIDE EFFECTS : Basis count decremented and basis copy (possibly) deleted NOTES : When the count goes to zero, the basis copy of the object (if any) is deleted. ***************************************************/ globle void DecrementObjectBasisCount( void *theEnv, void *vins) { INSTANCE_TYPE *ins; long i; ins = (INSTANCE_TYPE *) vins; ins->header.busyCount--; if (ins->header.busyCount == 0) { if (ins->garbage) RemoveInstanceData(theEnv,ins); if (ins->cls->instanceSlotCount != 0) { for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) if (ins->basisSlots[i].value != NULL) { if (ins->basisSlots[i].desc->multiple) MultifieldDeinstall(theEnv,(struct multifield *) ins->basisSlots[i].value); else AtomDeinstall(theEnv,(int) ins->basisSlots[i].type, ins->basisSlots[i].value); } rm(theEnv,(void *) ins->basisSlots, (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT))); ins->basisSlots = NULL; } } } /*************************************************** NAME : IncrementObjectBasisCount DESCRIPTION : Increments the basis count of an object indicating that it is in use by the partial match of the currently executing rule If this the count was zero, allocate an array of extra instance slots for use by slot variables INPUTS : The instance address RETURNS : Nothing useful SIDE EFFECTS : Basis count incremented NOTES : None ***************************************************/ globle void IncrementObjectBasisCount( void *theEnv, void *vins) { INSTANCE_TYPE *ins; long i; ins = (INSTANCE_TYPE *) vins; if (ins->header.busyCount == 0) { if (ins->cls->instanceSlotCount != 0) { ins->basisSlots = (INSTANCE_SLOT *) gm2(theEnv,(sizeof(INSTANCE_SLOT) * ins->cls->instanceSlotCount)); for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { ins->basisSlots[i].desc = ins->slotAddresses[i]->desc; ins->basisSlots[i].value = NULL; } } } ins->header.busyCount++; } /*************************************************** NAME : MatchObjectFunction DESCRIPTION : Filters an instance through the object pattern network Used for incremental resets in binary loads and run-time modules INPUTS : The instance RETURNS : Nothing useful SIDE EFFECTS : Instance pattern-matched NOTES : None ***************************************************/ globle void MatchObjectFunction( void *theEnv, void *vins) { ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) vins,-1); } /*************************************************** NAME : NetworkSynchronized DESCRIPTION : Determines if state of instance is consistent with last push through pattern-matching network INPUTS : The instance RETURNS : TRUE if instance has not changed since last push through the Rete network, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool NetworkSynchronized( void *theEnv, void *vins) { #if MAC_XCD #pragma unused(theEnv) #endif return(((INSTANCE_TYPE *) vins)->reteSynchronized); } /*************************************************** NAME : InstanceIsDeleted DESCRIPTION : Determines if an instance has been deleted INPUTS : The instance RETURNS : TRUE if instance has been deleted, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool InstanceIsDeleted( void *theEnv, void *vins) { #if MAC_XCD #pragma unused(theEnv) #endif return(((INSTANCE_TYPE *) vins)->garbage); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : FindImportedInstance DESCRIPTION : Searches imported modules for an instance of the correct name The imports are searched recursively in the order of the module definition INPUTS : 1) The module for which to search imported modules 2) The currently active module 3) The first instance of the correct name (cannot be NULL) RETURNS : An instance of the correct name imported from another module which is in scope of the current module SIDE EFFECTS : None NOTES : None *****************************************************/ static INSTANCE_TYPE *FindImportedInstance( void *theEnv, struct defmodule *theModule, struct defmodule *currentModule, INSTANCE_TYPE *startInstance) { struct portItem *importList; INSTANCE_TYPE *ins; if (theModule->visitedFlag) return(NULL); theModule->visitedFlag = TRUE; importList = theModule->importList; while (importList != NULL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(importList->moduleName)); for (ins = startInstance ; (ins != NULL) ? (ins->name == startInstance->name) : FALSE ; ins = ins->nxtHash) if ((ins->cls->header.whichModule->theModule == theModule) && DefclassInScope(theEnv,ins->cls,currentModule)) return(ins); ins = FindImportedInstance(theEnv,theModule,currentModule,startInstance); if (ins != NULL) return(ins); importList = importList->next; } /* ======================================================== Make sure instances of system classes are always visible ======================================================== */ for (ins = startInstance ; (ins != NULL) ? (ins->name == startInstance->name) : FALSE ; ins = ins->nxtHash) if (ins->cls->system) return(ins); return(NULL); } #if DEFRULE_CONSTRUCT /***************************************************** NAME : NetworkModifyForSharedSlot DESCRIPTION : Performs a Rete network modify for all instances which contain a specific shared slot INPUTS : 1) The traversal id to use when recursively entering subclasses to prevent duplicate examinations of a class 2) The class 3) The descriptor for the shared slot RETURNS : Nothing useful SIDE EFFECTS : Instances which contain the shared slot are filtered through the Rete network via a retract/assert NOTES : Assumes traversal id has been established *****************************************************/ static void NetworkModifyForSharedSlot( void *theEnv, int sharedTraversalID, DEFCLASS *cls, SLOT_DESC *sd) { INSTANCE_TYPE *ins; long i; /* ================================================ Make sure we haven't already examined this class ================================================ */ if (TestTraversalID(cls->traversalRecord,sharedTraversalID)) return; SetTraversalID(cls->traversalRecord,sharedTraversalID); /* =========================================== If the instances of this class contain the shared slot, send update events to the Rete network for all of its instances =========================================== */ if ((sd->slotName->id > cls->maxSlotNameID) ? FALSE : ((cls->slotNameMap[sd->slotName->id] == 0) ? FALSE : (cls->instanceTemplate[cls->slotNameMap[sd->slotName->id] - 1] == sd))) { for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass) ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sd->slotName->id); } /* ================================== Check the subclasses of this class ================================== */ for (i = 0 ; i < cls->directSubclasses.classCount ; i++) NetworkModifyForSharedSlot(theEnv,sharedTraversalID,cls->directSubclasses.classArray[i],sd); } #endif /* DEFRULE_CONSTRUCT */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void DecrementInstanceCount( void *vptr) { EnvDecrementInstanceCount(GetCurrentEnvironment(),vptr); } globle int GetInstancesChanged() { return EnvGetInstancesChanged(GetCurrentEnvironment()); } globle void IncrementInstanceCount( void *vptr) { EnvIncrementInstanceCount(GetCurrentEnvironment(),vptr); } globle void SetInstancesChanged( int changed) { EnvSetInstancesChanged(GetCurrentEnvironment(),changed); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* OBJECT_SYSTEM */ clips_core_source_630/core/._rulecom.h0000755000175000017500000000033012374672752016300 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulepsr.c0000755000175000017500000010717012461253173016103 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* RULE PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses a defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* and LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Changed integer type/precision. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added support for hashed memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _RULEPSR_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "analysis.h" #include "constant.h" #include "constrct.h" #include "cstrcpsr.h" #include "cstrnchk.h" #include "cstrnops.h" #include "engine.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "incrrset.h" #include "memalloc.h" #include "pattern.h" #include "prccode.h" #include "prcdrpsr.h" #include "router.h" #include "rulebld.h" #include "rulebsc.h" #include "rulecstr.h" #include "ruledef.h" #include "ruledlt.h" #include "rulelhs.h" #include "scanner.h" #include "symbol.h" #include "watch.h" #include "lgcldpnd.h" #if DEFTEMPLATE_CONSTRUCT #include "tmpltfun.h" #endif #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "rulepsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct expr *ParseRuleRHS(void *,const char *); static int ReplaceRHSVariable(void *,struct expr *,void *); static struct defrule *ProcessRuleLHS(void *,struct lhsParseNode *,struct expr *,SYMBOL_HN *,int *); static struct defrule *CreateNewDisjunct(void *,SYMBOL_HN *,int,struct expr *, int,unsigned,struct joinNode *); static int RuleComplexity(void *,struct lhsParseNode *); static int ExpressionComplexity(void *,struct expr *); static int LogicalAnalysis(void *,struct lhsParseNode *); static void AddToDefruleList(struct defrule *); #endif /****************************************************/ /* ParseDefrule: Coordinates all actions necessary */ /* for the parsing and creation of a defrule into */ /* the current environment. */ /****************************************************/ globle int ParseDefrule( void *theEnv, const char *readSource) { #if (! RUN_TIME) && (! BLOAD_ONLY) SYMBOL_HN *ruleName; struct lhsParseNode *theLHS; struct expr *actions; struct token theToken; struct defrule *topDisjunct, *tempPtr; struct defruleModule *theModuleItem; int error; /*================================================*/ /* Flush the buffer which stores the pretty print */ /* representation for a rule. Add the already */ /* parsed keyword defrule to this buffer. */ /*================================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defrule "); /*=========================================================*/ /* Rules cannot be loaded when a binary load is in effect. */ /*=========================================================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defrule"); return(TRUE); } #endif /*================================================*/ /* Parse the name and comment fields of the rule, */ /* deleting the rule if it already exists. */ /*================================================*/ #if DEBUGGING_FUNCTIONS DefruleData(theEnv)->DeletedRuleDebugFlags = 0; #endif ruleName = GetConstructNameAndComment(theEnv,readSource,&theToken,"defrule", EnvFindDefruleInModule,EnvUndefrule,"*",FALSE, TRUE,TRUE,FALSE); if (ruleName == NULL) return(TRUE); /*============================*/ /* Parse the LHS of the rule. */ /*============================*/ theLHS = ParseRuleLHS(theEnv,readSource,&theToken,ValueToString(ruleName),&error); if (error) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return(TRUE); } /*============================*/ /* Parse the RHS of the rule. */ /*============================*/ ClearParsedBindNames(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseRuleRHS(theEnv,readSource); if (actions == NULL) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; ReturnLHSParseNodes(theEnv,theLHS); return(TRUE); } /*=======================*/ /* Process the rule LHS. */ /*=======================*/ topDisjunct = ProcessRuleLHS(theEnv,theLHS,actions,ruleName,&error); ReturnExpression(theEnv,actions); ClearParsedBindNames(theEnv); ReturnLHSParseNodes(theEnv,theLHS); if (error) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return(TRUE); } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed defrule to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return(FALSE); } PatternData(theEnv)->SalienceExpression = NULL; /*======================================*/ /* Save the nice printout of the rules. */ /*======================================*/ SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { topDisjunct->header.ppForm = NULL; } else { topDisjunct->header.ppForm = CopyPPBuffer(theEnv); } /*=======================================*/ /* Store a pointer to the rule's module. */ /*=======================================*/ theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex); for (tempPtr = topDisjunct; tempPtr != NULL; tempPtr = tempPtr->disjunct) { tempPtr->header.whichModule = (struct defmoduleItemHeader *) theModuleItem; tempPtr->header.ppForm = topDisjunct->header.ppForm; } /*===============================================*/ /* Rule completely parsed. Add to list of rules. */ /*===============================================*/ AddToDefruleList(topDisjunct); /*========================================================================*/ /* If a rule is redefined, then we want to restore its breakpoint status. */ /*========================================================================*/ #if DEBUGGING_FUNCTIONS if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,0)) { EnvSetBreak(theEnv,topDisjunct); } if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,1) || EnvGetWatchItem(theEnv,"activations")) { EnvSetDefruleWatchActivations(theEnv,ON,(void *) topDisjunct); } if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,2) || EnvGetWatchItem(theEnv,"rules")) { EnvSetDefruleWatchFirings(theEnv,ON,(void *) topDisjunct); } #endif /*================================*/ /* Perform the incremental reset. */ /*================================*/ IncrementalReset(theEnv,topDisjunct); /*=============================================*/ /* Return FALSE to indicate no errors occured. */ /*=============================================*/ #endif return(FALSE); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************************/ /* ProcessRuleLHS: Processes each of the disjuncts of a rule. */ /**************************************************************/ static struct defrule *ProcessRuleLHS( void *theEnv, struct lhsParseNode *theLHS, struct expr *actions, SYMBOL_HN *ruleName, int *error) { struct lhsParseNode *tempNode = NULL; struct defrule *topDisjunct = NULL, *currentDisjunct, *lastDisjunct = NULL; struct expr *newActions, *packPtr; int logicalJoin; int localVarCnt; int complexity; struct joinNode *lastJoin; intBool emptyLHS; /*================================================*/ /* Initially set the parsing error flag to FALSE. */ /*================================================*/ *error = FALSE; /*===========================================================*/ /* The top level of the construct representing the LHS of a */ /* rule is assumed to be an OR. If the implied OR is at the */ /* top level of the pattern construct, then remove it. */ /*===========================================================*/ if (theLHS == NULL) { emptyLHS = TRUE; } else { emptyLHS = FALSE; if (theLHS->type == OR_CE) theLHS = theLHS->right; } /*=========================================*/ /* Loop through each disjunct of the rule. */ /*=========================================*/ localVarCnt = CountParsedBindNames(theEnv); while ((theLHS != NULL) || (emptyLHS == TRUE)) { /*===================================*/ /* Analyze the LHS of this disjunct. */ /*===================================*/ if (emptyLHS) { tempNode = NULL; } else { if (theLHS->type == AND_CE) tempNode = theLHS->right; else if (theLHS->type == PATTERN_CE) tempNode = theLHS; } if (VariableAnalysis(theEnv,tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*=========================================*/ /* Perform entity dependent post analysis. */ /*=========================================*/ if (PostPatternAnalysis(theEnv,tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*========================================================*/ /* Print out developer information if it's being watched. */ /*========================================================*/ #if DEVELOPER && DEBUGGING_FUNCTIONS if (EnvGetWatchItem(theEnv,"rule-analysis")) { DumpRuleAnalysis(theEnv,tempNode); } #endif /*========================================*/ /* Check to see that logical CEs are used */ /* appropriately in the LHS of the rule. */ /*========================================*/ if ((logicalJoin = LogicalAnalysis(theEnv,tempNode)) < 0) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*======================================================*/ /* Check to see if there are any RHS constraint errors. */ /*======================================================*/ if (CheckRHSForConstraintErrors(theEnv,actions,tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*=================================================*/ /* Replace variable references in the RHS with the */ /* appropriate variable retrieval functions. */ /*=================================================*/ newActions = CopyExpression(theEnv,actions); if (ReplaceProcVars(theEnv,"RHS of defrule",newActions,NULL,NULL, ReplaceRHSVariable,(void *) tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); ReturnExpression(theEnv,newActions); return(NULL); } /*==================================*/ /* We're finished for this disjunct */ /* if we're only checking syntax. */ /*==================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,newActions); if (emptyLHS) { emptyLHS = FALSE; } else { theLHS = theLHS->bottom; } continue; } /*=================================*/ /* Install the disjunct's actions. */ /*=================================*/ ExpressionInstall(theEnv,newActions); packPtr = PackExpression(theEnv,newActions); ReturnExpression(theEnv,newActions); /*===============================================================*/ /* Create the pattern and join data structures for the new rule. */ /*===============================================================*/ lastJoin = ConstructJoins(theEnv,logicalJoin,tempNode,1,NULL,TRUE,TRUE); /*===================================================================*/ /* Determine the rule's complexity for use with conflict resolution. */ /*===================================================================*/ complexity = RuleComplexity(theEnv,tempNode); /*=====================================================*/ /* Create the defrule data structure for this disjunct */ /* and put it in the list of disjuncts for this rule. */ /*=====================================================*/ currentDisjunct = CreateNewDisjunct(theEnv,ruleName,localVarCnt,packPtr,complexity, (unsigned) logicalJoin,lastJoin); /*============================================================*/ /* Place the disjunct in the list of disjuncts for this rule. */ /* If the disjunct is the first disjunct, then increment the */ /* reference counts for the dynamic salience (the expression */ /* for the dynamic salience is only stored with the first */ /* disjuncts and the other disjuncts refer back to the first */ /* disjunct for their dynamic salience value. */ /*============================================================*/ if (topDisjunct == NULL) { topDisjunct = currentDisjunct; ExpressionInstall(theEnv,topDisjunct->dynamicSalience); } else lastDisjunct->disjunct = currentDisjunct; /*===========================================*/ /* Move on to the next disjunct of the rule. */ /*===========================================*/ lastDisjunct = currentDisjunct; if (emptyLHS) { emptyLHS = FALSE; } else { theLHS = theLHS->bottom; } } return(topDisjunct); } /************************************************************************/ /* CreateNewDisjunct: Creates and initializes a defrule data structure. */ /************************************************************************/ static struct defrule *CreateNewDisjunct( void *theEnv, SYMBOL_HN *ruleName, int localVarCnt, struct expr *theActions, int complexity, unsigned logicalJoin, struct joinNode *lastJoin) { struct joinNode *tempJoin; struct defrule *newDisjunct; /*===================================================*/ /* Create and initialize the defrule data structure. */ /*===================================================*/ newDisjunct = get_struct(theEnv,defrule); newDisjunct->header.ppForm = NULL; newDisjunct->header.next = NULL; newDisjunct->header.usrData = NULL; newDisjunct->logicalJoin = NULL; newDisjunct->disjunct = NULL; newDisjunct->header.name = ruleName; IncrementSymbolCount(newDisjunct->header.name); newDisjunct->actions = theActions; newDisjunct->salience = PatternData(theEnv)->GlobalSalience; newDisjunct->afterBreakpoint = 0; newDisjunct->watchActivation = 0; newDisjunct->watchFiring = 0; newDisjunct->executing = 0; newDisjunct->complexity = complexity; newDisjunct->autoFocus = PatternData(theEnv)->GlobalAutoFocus; newDisjunct->dynamicSalience = PatternData(theEnv)->SalienceExpression; newDisjunct->localVarCnt = localVarCnt; /*=====================================*/ /* Add a pointer to the rule's module. */ /*=====================================*/ newDisjunct->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex); /*============================================================*/ /* Attach the rule's last join to the defrule data structure. */ /*============================================================*/ lastJoin->ruleToActivate = newDisjunct; newDisjunct->lastJoin = lastJoin; /*=================================================*/ /* Determine the rule's logical join if it exists. */ /*=================================================*/ tempJoin = lastJoin; while (tempJoin != NULL) { if (tempJoin->depth == logicalJoin) { newDisjunct->logicalJoin = tempJoin; tempJoin->logicalJoin = TRUE; } tempJoin = tempJoin->lastLevel; } /*==================================================*/ /* Return the newly created defrule data structure. */ /*==================================================*/ return(newDisjunct); } /****************************************************************/ /* ReplaceExpressionVariables: Replaces all symbolic references */ /* to variables (local and global) found in an expression on */ /* the RHS of a rule with expressions containing function */ /* calls to retrieve the variable's value. Makes the final */ /* modifications necessary for handling the modify and */ /* duplicate commands. */ /****************************************************************/ static int ReplaceRHSVariable( void *theEnv, struct expr *list, void *VtheLHS) { struct lhsParseNode *theVariable; /*=======================================*/ /* Handle modify and duplicate commands. */ /*=======================================*/ #if DEFTEMPLATE_CONSTRUCT if (list->type == FCALL) { if (list->value == (void *) FindFunction(theEnv,"modify")) { if (UpdateModifyDuplicate(theEnv,list,"modify",VtheLHS) == FALSE) return(-1); } else if (list->value == (void *) FindFunction(theEnv,"duplicate")) { if (UpdateModifyDuplicate(theEnv,list,"duplicate",VtheLHS) == FALSE) return(-1); } return(0); } #endif if ((list->type != SF_VARIABLE) && (list->type != MF_VARIABLE)) { return(FALSE); } /*===============================================================*/ /* Check to see if the variable is bound on the LHS of the rule. */ /*===============================================================*/ theVariable = FindVariable((SYMBOL_HN *) list->value,(struct lhsParseNode *) VtheLHS); if (theVariable == NULL) return(FALSE); /*================================================*/ /* Replace the variable reference with a function */ /* call to retrieve the variable. */ /*================================================*/ if (theVariable->patternType != NULL) { (*theVariable->patternType->replaceGetJNValueFunction)(theEnv,list,theVariable,LHS); } else { return(FALSE); } /*=================================================================*/ /* Return TRUE to indicate the variable was successfully replaced. */ /*=================================================================*/ return(TRUE); } /*******************************************************/ /* ParseRuleRHS: Coordinates all the actions necessary */ /* for parsing the RHS of a rule. */ /*******************************************************/ static struct expr *ParseRuleRHS( void *theEnv, const char *readSource) { struct expr *actions; struct token theToken; /*=========================================================*/ /* Process the actions on the right hand side of the rule. */ /*=========================================================*/ SavePPBuffer(theEnv,"\n "); SetIndentDepth(theEnv,3); actions = GroupActions(theEnv,readSource,&theToken,TRUE,NULL,FALSE); if (actions == NULL) return(NULL); /*=============================*/ /* Reformat the closing token. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*======================================================*/ /* Check for the closing right parenthesis of the rule. */ /*======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"defrule"); ReturnExpression(theEnv,actions); return(NULL); } /*========================*/ /* Return the rule's RHS. */ /*========================*/ return(actions); } /************************************************************/ /* RuleComplexity: Returns the complexity of a rule for use */ /* by the LEX and MEA conflict resolution strategies. */ /************************************************************/ static int RuleComplexity( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *thePattern, *tempPattern; int complexity = 0; while (theLHS != NULL) { complexity += 1; /* Add 1 for each pattern. */ complexity += ExpressionComplexity(theEnv,theLHS->networkTest); thePattern = theLHS->right; while (thePattern != NULL) { if (thePattern->multifieldSlot) { tempPattern = thePattern->bottom; while (tempPattern != NULL) { complexity += ExpressionComplexity(theEnv,tempPattern->networkTest); tempPattern = tempPattern->right; } } else { complexity += ExpressionComplexity(theEnv,thePattern->networkTest); } thePattern = thePattern->right; } theLHS = theLHS->bottom; } return(complexity); } /********************************************************************/ /* ExpressionComplexity: Determines the complexity of a expression. */ /********************************************************************/ static int ExpressionComplexity( void *theEnv, struct expr *exprPtr) { int complexity = 0; while (exprPtr != NULL) { if (exprPtr->type == FCALL) { /*=========================================*/ /* Logical combinations do not add to the */ /* complexity, but their arguments do. */ /*=========================================*/ if ((exprPtr->value == ExpressionData(theEnv)->PTR_AND) || (exprPtr->value == ExpressionData(theEnv)->PTR_NOT) || (exprPtr->value == ExpressionData(theEnv)->PTR_OR)) { complexity += ExpressionComplexity(theEnv,exprPtr->argList); } /*=========================================*/ /* else other function calls increase the */ /* complexity, but their arguments do not. */ /*=========================================*/ else { complexity++; } } else if ((EvaluationData(theEnv)->PrimitivesArray[exprPtr->type] != NULL) ? EvaluationData(theEnv)->PrimitivesArray[exprPtr->type]->addsToRuleComplexity : FALSE) { complexity++; } exprPtr = exprPtr->nextArg; } return(complexity); } /********************************************/ /* LogicalAnalysis: Analyzes the use of the */ /* logical CE within the LHS of a rule. */ /********************************************/ static int LogicalAnalysis( void *theEnv, struct lhsParseNode *patternList) { int firstLogical, logicalsFound = FALSE, logicalJoin = 1; int gap = FALSE; if (patternList == NULL) return(0); firstLogical = patternList->logical; /*===================================================*/ /* Loop through each pattern in the LHS of the rule. */ /*===================================================*/ for (; patternList != NULL; patternList = patternList->bottom) { /*=======================================*/ /* Skip anything that isn't a pattern CE */ /* or is embedded within a not/and CE. */ /*=======================================*/ if ((patternList->type != PATTERN_CE) || (patternList->endNandDepth != 1)) { continue; } /*=====================================================*/ /* If the pattern CE is not contained within a logical */ /* CE, then set the gap flag to TRUE indicating that */ /* any subsequent pattern CE found within a logical CE */ /* represents a gap between logical CEs which is an */ /* error. */ /*=====================================================*/ if (patternList->logical == FALSE) { gap = TRUE; continue; } /*=================================================*/ /* If a logical CE is encountered and the first CE */ /* of the rule isn't a logical CE, then indicate */ /* that the first CE must be a logical CE. */ /*=================================================*/ if (! firstLogical) { PrintErrorID(theEnv,"RULEPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Logical CEs must be placed first in a rule\n"); return(-1); } /*===================================================*/ /* If a break within the logical CEs was found and a */ /* new logical CE is encountered, then indicate that */ /* there can't be any gaps between logical CEs. */ /*===================================================*/ if (gap) { PrintErrorID(theEnv,"RULEPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Gaps may not exist between logical CEs\n"); return(-1); } /*===========================================*/ /* Increment the count of logical CEs found. */ /*===========================================*/ logicalJoin++; logicalsFound = TRUE; } /*============================================*/ /* If logical CEs were found, then return the */ /* join number where the logical information */ /* will be stored in the join network. */ /*============================================*/ if (logicalsFound) return(logicalJoin); /*=============================*/ /* Return zero indicating that */ /* no logical CE was found. */ /*=============================*/ return(0); } /*****************************************************************/ /* FindVariable: Searches for the last occurence of a variable */ /* in the LHS of a rule that is visible from the RHS of a rule. */ /* The last occurence of the variable on the LHS side of the */ /* rule will have the strictest constraints (because it will */ /* have been intersected with all of the other constraints for */ /* the variable on the LHS of the rule). The strictest */ /* constraints are useful for performing type checking on the */ /* RHS of the rule. */ /*****************************************************************/ globle struct lhsParseNode *FindVariable( SYMBOL_HN *name, struct lhsParseNode *theLHS) { struct lhsParseNode *theFields, *tmpFields = NULL; struct lhsParseNode *theReturnValue = NULL; /*==============================================*/ /* Loop through each CE in the LHS of the rule. */ /*==============================================*/ for (; theLHS != NULL; theLHS = theLHS->bottom) { /*==========================================*/ /* Don't bother searching for the variable */ /* in anything other than a pattern CE that */ /* is not contained within a not CE. */ /*==========================================*/ if ((theLHS->type != PATTERN_CE) || (theLHS->negated == TRUE) || (theLHS->exists == TRUE) || (theLHS->beginNandDepth > 1)) { continue; } /*=====================================*/ /* Check the pattern address variable. */ /*=====================================*/ if (theLHS->value == (void *) name) { theReturnValue = theLHS; } /*============================================*/ /* Check for the variable inside the pattern. */ /*============================================*/ theFields = theLHS->right; while (theFields != NULL) { /*=================================================*/ /* Go one level deeper to check a multifield slot. */ /*=================================================*/ if (theFields->multifieldSlot) { tmpFields = theFields; theFields = theFields->bottom; } /*=================================*/ /* See if the field being examined */ /* is the variable being sought. */ /*=================================*/ if (theFields == NULL) { /* Do Nothing */ } else if (((theFields->type == SF_VARIABLE) || (theFields->type == MF_VARIABLE)) && (theFields->value == (void *) name)) { theReturnValue = theFields; } /*============================*/ /* Move on to the next field. */ /*============================*/ if (theFields == NULL) { theFields = tmpFields; tmpFields = NULL; } else if ((theFields->right == NULL) && (tmpFields != NULL)) { theFields = tmpFields; tmpFields = NULL; } theFields = theFields->right; } } /*=========================================================*/ /* Return a pointer to the LHS location where the variable */ /* was found (or a NULL pointer if it wasn't). */ /*=========================================================*/ return(theReturnValue); } /**********************************************************/ /* AddToDefruleList: Adds a defrule to the list of rules. */ /**********************************************************/ static void AddToDefruleList( struct defrule *rulePtr) { struct defrule *tempRule; struct defruleModule *theModuleItem; theModuleItem = (struct defruleModule *) rulePtr->header.whichModule; if (theModuleItem->header.lastItem == NULL) { theModuleItem->header.firstItem = (struct constructHeader *) rulePtr; } else { tempRule = (struct defrule *) theModuleItem->header.lastItem; // Note: Only the first disjunct tempRule->header.next = (struct constructHeader *) rulePtr; // points to the next rule } theModuleItem->header.lastItem = (struct constructHeader *) rulePtr; } #if DEVELOPER && DEBUGGING_FUNCTIONS /************************************************************/ /* DumpRuleAnalysis: Displays the information about network */ /* expressions generated from the analysis of the rule. */ /************************************************************/ globle void DumpRuleAnalysis( void *theEnv, struct lhsParseNode *tempNode) { struct lhsParseNode *traceNode; char buffer[20]; EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (traceNode = tempNode; traceNode != NULL; traceNode = traceNode->bottom) { if (traceNode->userCE) { gensprintf(buffer,"UCE %2d (%2d %2d): ",traceNode->whichCE,traceNode->beginNandDepth,traceNode->endNandDepth); } else { gensprintf(buffer,"SCE %2d (%2d %2d): ",traceNode->whichCE,traceNode->beginNandDepth,traceNode->endNandDepth); } EnvPrintRouter(theEnv,WDISPLAY,buffer); PrintExpression(theEnv,WDISPLAY,traceNode->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); if (traceNode->externalNetworkTest != NULL) { EnvPrintRouter(theEnv,WDISPLAY," ENT: "); PrintExpression(theEnv,WDISPLAY,traceNode->externalNetworkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (traceNode->secondaryNetworkTest != NULL) { EnvPrintRouter(theEnv,WDISPLAY," SNT: "); PrintExpression(theEnv,WDISPLAY,traceNode->secondaryNetworkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (traceNode->externalRightHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," ERH: "); PrintExpression(theEnv,WDISPLAY,traceNode->externalRightHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (traceNode->externalLeftHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," ELH: "); PrintExpression(theEnv,WDISPLAY,traceNode->externalLeftHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (traceNode->leftHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," LH: "); PrintExpression(theEnv,WDISPLAY,traceNode->leftHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (traceNode->rightHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," RH: "); PrintExpression(theEnv,WDISPLAY,traceNode->rightHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } if (traceNode->betaHash != NULL) { EnvPrintRouter(theEnv,WDISPLAY," BH: "); PrintExpression(theEnv,WDISPLAY,traceNode->betaHash); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } } #endif #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/._genrccmp.c0000755000175000017500000000040712373753412016420 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/msgcom.h0000755000175000017500000001353312424473402015676 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added DeallocateMessageHandlerData to */ /* deallocate message handler environment data. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_msgcom #define _H_msgcom #ifndef _H_object #include "object.h" #endif #ifndef _H_msgpass #include "msgpass.h" #endif #define MESSAGE_HANDLER_DATA 32 struct messageHandlerData { ENTITY_RECORD HandlerGetInfo; ENTITY_RECORD HandlerPutInfo; SYMBOL_HN *INIT_SYMBOL; SYMBOL_HN *DELETE_SYMBOL; SYMBOL_HN *CREATE_SYMBOL; #if DEBUGGING_FUNCTIONS unsigned WatchHandlers; unsigned WatchMessages; #endif const char *hndquals[4]; SYMBOL_HN *SELF_SYMBOL; SYMBOL_HN *CurrentMessageName; HANDLER_LINK *CurrentCore; HANDLER_LINK *TopOfCore; HANDLER_LINK *NextInCore; HANDLER_LINK *OldCore; }; #define MessageHandlerData(theEnv) ((struct messageHandlerData *) GetEnvironmentData(theEnv,MESSAGE_HANDLER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define INIT_STRING "init" #define DELETE_STRING "delete" #define PRINT_STRING "print" #define CREATE_STRING "create" LOCALE void SetupMessageHandlers(void *); LOCALE const char *EnvGetDefmessageHandlerName(void *,void *,int); LOCALE const char *EnvGetDefmessageHandlerType(void *,void *,int); LOCALE int EnvGetNextDefmessageHandler(void *,void *,int); LOCALE HANDLER *GetDefmessageHandlerPointer(void *,int); #if DEBUGGING_FUNCTIONS LOCALE unsigned EnvGetDefmessageHandlerWatch(void *,void *,int); LOCALE void EnvSetDefmessageHandlerWatch(void *,int,void *,int); #endif LOCALE unsigned EnvFindDefmessageHandler(void *,void *,const char *,const char *); LOCALE int EnvIsDefmessageHandlerDeletable(void *,void *,int); LOCALE void UndefmessageHandlerCommand(void *); LOCALE int EnvUndefmessageHandler(void *,void *,int); #if DEBUGGING_FUNCTIONS LOCALE void PPDefmessageHandlerCommand(void *); LOCALE void ListDefmessageHandlersCommand(void *); LOCALE void PreviewSendCommand(void *); LOCALE const char *EnvGetDefmessageHandlerPPForm(void *,void *,int); LOCALE void EnvListDefmessageHandlers(void *,const char *,void *,int); LOCALE void EnvPreviewSend(void *,const char *,void *,const char *); LOCALE long DisplayHandlersInLinks(void *,const char *,PACKED_CLASS_LINKS *,int); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE unsigned FindDefmessageHandler(void *,const char *,const char *); LOCALE const char *GetDefmessageHandlerName(void *,int); LOCALE const char *GetDefmessageHandlerType(void *,int); LOCALE int GetNextDefmessageHandler(void *,int); LOCALE int IsDefmessageHandlerDeletable(void *,int); LOCALE int UndefmessageHandler(void *,int); #if DEBUGGING_FUNCTIONS LOCALE const char *GetDefmessageHandlerPPForm(void *,int); LOCALE unsigned GetDefmessageHandlerWatch(void *,int); LOCALE void ListDefmessageHandlers(const char *,void *,int); LOCALE void PreviewSend(const char *,void *,const char *); LOCALE void SetDefmessageHandlerWatch(int,void *,int); #endif /* DEBUGGING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_msgcom */ clips_core_source_630/core/._dffnxpsr.c0000755000175000017500000000040712461252076016452 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._globlcmp.c0000755000175000017500000000040712373753370016424 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnbin.h0000755000175000017500000000444412373714222016235 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT BLOAD/BSAVE/CONSTRUCTS-TO-C HEADER */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_cstrnbin #define _H_cstrnbin #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define ConstraintIndex(theConstraint) (((! EnvGetDynamicConstraintChecking(theEnv)) || (theConstraint == NULL)) ? -1L : ((long) theConstraint->bsaveIndex)) #define ConstraintPointer(i) (((i) == -1L) ? NULL : (CONSTRAINT_RECORD *) &ConstraintData(theEnv)->ConstraintArray[i]) #if BLOAD_AND_BSAVE LOCALE void WriteNeededConstraints(void *,FILE *); #endif LOCALE void ReadNeededConstraints(void *); LOCALE void ClearBloadedConstraints(void *); #endif /* _H_cstrnbin */ clips_core_source_630/core/._crstrtgy.c0000755000175000017500000000040712375756151016510 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factgen.c0000755000175000017500000000040712373742657016242 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulebld.c0000755000175000017500000015711012374024067016040 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE BUILD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines to ntegrates a set of pattern */ /* and join tests associated with a rule into the pattern */ /* and join networks. The joins are integrated into the */ /* join network by routines in this module. The pattern */ /* is integrated by calling the external routine */ /* associated with the pattern parser that originally */ /* parsed the pattern. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Changes to constructing join network. */ /* */ /* Added support for hashed memories. */ /* */ /*************************************************************/ #define _RULEBLD_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "envrnmnt.h" #include "constrct.h" #include "drive.h" #include "incrrset.h" #include "memalloc.h" #include "pattern.h" #include "reteutil.h" #include "router.h" #include "rulebld.h" #include "rulepsr.h" #include "watch.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct joinNode *FindShareableJoin(struct joinLink *,struct joinNode *,intBool,void *,unsigned,unsigned, unsigned,unsigned,struct expr *,struct expr *, struct expr *,struct expr *); static int TestJoinForReuse(struct joinNode *,unsigned,unsigned, unsigned,unsigned,struct expr *,struct expr *, struct expr *,struct expr *); static struct joinNode *CreateNewJoin(void *,struct expr *,struct expr *,struct joinNode *,void *, int,int,int,struct expr *,struct expr *); static void AttachTestCEsToPatternCEs(void *,struct lhsParseNode *); /****************************************************************/ /* ConstructJoins: Integrates a set of pattern and join tests */ /* associated with a rule into the pattern and join networks. */ /****************************************************************/ globle struct joinNode *ConstructJoins( void *theEnv, int logicalJoin, struct lhsParseNode *theLHS, int startDepth, struct joinNode *lastJoin, int tryToReuse, int firstJoin) { struct patternNodeHeader *lastPattern; struct joinNode *listOfJoins = NULL; struct joinNode *oldJoin; int joinNumber = 1; int isLogical, isExists; struct joinNode *lastRightJoin; int lastIteration = FALSE; int rhsType; struct expr *leftHash, *rightHash; void *rhsStruct; struct lhsParseNode *nextLHS; struct expr *networkTest, *secondaryNetworkTest, *secondaryExternalTest; int joinFromTheRight; struct joinLink *theLinks; intBool useLinks; /*===================================================*/ /* Remove any test CEs from the LHS and attach their */ /* expression to the closest preceeding non-negated */ /* join at the same not/and depth. */ /*===================================================*/ if (startDepth == 1) { AttachTestCEsToPatternCEs(theEnv,theLHS); } if (theLHS == NULL) { lastJoin = FindShareableJoin(DefruleData(theEnv)->RightPrimeJoins,NULL,TRUE,NULL,TRUE, FALSE,FALSE,FALSE,NULL,NULL,NULL,NULL); if (lastJoin == NULL) { lastJoin = CreateNewJoin(theEnv,NULL,NULL,NULL,NULL,FALSE,FALSE,FALSE,NULL,NULL); } } /*=====================================================*/ /* Process each pattern CE in the rule. At this point, */ /* there should be no and/or/not CEs in the LHS. */ /*=====================================================*/ while (theLHS != NULL) { /*======================================================*/ /* Find the beginning of the next group of patterns. If */ /* the current pattern is not the beginning of a "join */ /* from the right" group of patterns, then the next */ /* pattern is the next pattern. Otherwise skip over all */ /* the patterns that belong to the group of subjoins. */ /*======================================================*/ nextLHS = theLHS->bottom; secondaryExternalTest = NULL; if (theLHS->endNandDepth > startDepth) { while ((nextLHS != NULL) && (nextLHS->endNandDepth > startDepth)) { nextLHS = nextLHS->bottom; } /*====================================================*/ /* Variable nextLHS is now pointing to the end of the */ /* not/and group beginning with variable theLHS. If */ /* the end depth of the group is less than the depth */ /* of the current enclosing not/and group, then this */ /* is the last iteration for the enclosing group. */ /*====================================================*/ if (nextLHS != NULL) { if (nextLHS->endNandDepth < startDepth) { lastIteration = TRUE; } } if (nextLHS != NULL) { nextLHS = nextLHS->bottom; } if ((nextLHS != NULL) && (nextLHS->type == TEST_CE) && (nextLHS->beginNandDepth >= startDepth)) { secondaryExternalTest = nextLHS->networkTest; nextLHS = nextLHS->bottom; } } /*=======================================*/ /* Is this the last pattern to be added? */ /*=======================================*/ if (nextLHS == NULL) { lastIteration = TRUE; } else if (theLHS->endNandDepth < startDepth) { lastIteration = TRUE; } else if ((nextLHS->type == TEST_CE) && (theLHS->beginNandDepth > startDepth) && (nextLHS->endNandDepth < startDepth)) { lastIteration = TRUE; } /*===============================================*/ /* If the pattern is a join from the right, then */ /* construct the subgroup of patterns and use */ /* that as the RHS of the join to be added. */ /*===============================================*/ if (theLHS->beginNandDepth > startDepth) { joinFromTheRight = TRUE; isExists = theLHS->existsNand; lastRightJoin = ConstructJoins(theEnv,logicalJoin,theLHS,startDepth+1,lastJoin,tryToReuse,firstJoin); rhsStruct = lastRightJoin; rhsType = 0; lastPattern = NULL; networkTest = theLHS->externalNetworkTest; secondaryNetworkTest = secondaryExternalTest; leftHash = theLHS->externalLeftHash; rightHash = theLHS->externalRightHash; } /*=======================================================*/ /* Otherwise, add the pattern to the appropriate pattern */ /* network and use the pattern node containing the alpha */ /* memory as the RHS of the join to be added. */ /*=======================================================*/ else if (theLHS->right == NULL) { joinFromTheRight = FALSE; rhsType = 0; lastPattern = NULL; rhsStruct = NULL; lastRightJoin = NULL; isExists = theLHS->exists; networkTest = theLHS->networkTest; secondaryNetworkTest = theLHS->secondaryNetworkTest; leftHash = NULL; rightHash = NULL; } else { joinFromTheRight = FALSE; rhsType = theLHS->patternType->positionInArray; lastPattern = (*theLHS->patternType->addPatternFunction)(theEnv,theLHS); rhsStruct = lastPattern; lastRightJoin = NULL; isExists = theLHS->exists; networkTest = theLHS->networkTest; secondaryNetworkTest = theLHS->secondaryNetworkTest; leftHash = theLHS->leftHash; rightHash = theLHS->rightHash; } /*======================================================*/ /* Determine if the join being added is a logical join. */ /*======================================================*/ if ((startDepth == 1) && (joinNumber == logicalJoin)) isLogical = TRUE; else isLogical = FALSE; /*===============================================*/ /* Get the list of joins which could potentially */ /* be reused in place of the join being added. */ /*===============================================*/ useLinks = TRUE; if (lastJoin != NULL) { theLinks = lastJoin->nextLinks; } else if (theLHS->right == NULL) { theLinks = DefruleData(theEnv)->RightPrimeJoins; } else if (lastPattern != NULL) { listOfJoins = lastPattern->entryJoin; theLinks = NULL; useLinks = FALSE; } else { theLinks = lastRightJoin->nextLinks; } /*=======================================================*/ /* Determine if the next join to be added can be shared. */ /*=======================================================*/ if ((tryToReuse == TRUE) && ((oldJoin = FindShareableJoin(theLinks,listOfJoins,useLinks,rhsStruct,firstJoin, theLHS->negated,isExists,isLogical, networkTest,secondaryNetworkTest, leftHash,rightHash)) != NULL) ) { #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"=j"); } #endif lastJoin = oldJoin; } else { tryToReuse = FALSE; if (! joinFromTheRight) { lastJoin = CreateNewJoin(theEnv,networkTest,secondaryNetworkTest,lastJoin, lastPattern,FALSE,(int) theLHS->negated, isExists, leftHash,rightHash); lastJoin->rhsType = rhsType; } else { lastJoin = CreateNewJoin(theEnv,networkTest,secondaryNetworkTest,lastJoin, lastRightJoin,TRUE,(int) theLHS->negated, isExists, leftHash,rightHash); lastJoin->rhsType = rhsType; } } /*============================================*/ /* If we've reached the end of the subgroup, */ /* then return the last join of the subgroup. */ /*============================================*/ if (lastIteration) { break; } /*=======================================*/ /* Move on to the next join to be added. */ /*=======================================*/ theLHS = nextLHS; joinNumber++; firstJoin = FALSE; } /*=================================================*/ /* Add the final join which stores the activations */ /* of the rule. This join is never shared. */ /*=================================================*/ if (startDepth == 1) { lastJoin = CreateNewJoin(theEnv,NULL,NULL,lastJoin,NULL, FALSE,FALSE,FALSE,NULL,NULL); } /*===================================================*/ /* If compilations are being watched, put a carriage */ /* return after all of the =j's and +j's */ /*===================================================*/ #if DEBUGGING_FUNCTIONS if ((startDepth == 1) && (EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"\n"); } #endif /*=============================*/ /* Return the last join added. */ /*=============================*/ return(lastJoin); } /****************************************************************/ /* AttachTestCEsToPatternCEs: Attaches the expressions found in */ /* test CEs to the closest preceeding pattern CE that is not */ /* negated and is at the same not/and depth. */ /****************************************************************/ static void AttachTestCEsToPatternCEs( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *lastNode, *tempNode, *lastLastNode; if (theLHS == NULL) return; /*=============================================================*/ /* Attach test CEs that can be attached directly to a pattern. */ /*=============================================================*/ lastLastNode = NULL; lastNode = theLHS; theLHS = lastNode->bottom; while (theLHS != NULL) { /*================================================================*/ /* Skip over any CE that's not a TEST CE as we're only interested */ /* in attaching a TEST CE to a preceding pattern CE. Update the */ /* variables that track the preceding pattern. */ /*================================================================*/ if (theLHS->type != TEST_CE) { lastLastNode = lastNode; lastNode = theLHS; theLHS = theLHS->bottom; continue; } /*=====================================================*/ /* If this is the beginning of a new NOT/AND CE group, */ /* then we can't attach this TEST CE to a preceding */ /* pattern CE and should skip over it. */ /*=====================================================*/ /*================================================*/ /* Case #2 */ /* Pattern CE */ /* Depth Begin: N */ /* Depth End: N */ /* Test CE */ /* Depth Begin: M where M > N */ /* Depth End: - */ /* */ /* (defrule example */ /* (a) */ /* (not (and (test (> 1 0)) */ /* (b))) */ /* =>) */ /* */ /* Case #8 */ /* Pattern CE */ /* Depth Begin: N */ /* Depth End: M where M < N */ /* Test CE */ /* Depth Begin: R where R > M */ /* Depth End: - */ /* */ /* (defrule example */ /* (not (and (a) */ /* (c))) */ /* (not (and (test (> 1 0)) */ /* (b))) */ /* =>) */ /* */ /* This situation will not occur with the current */ /* implementation. The initial pattern will be */ /* added before the test CE so that there is a */ /* pattern CE beginning the not/and or exists/and */ /* pattern group. */ /*================================================*/ if (theLHS->beginNandDepth > lastNode->endNandDepth) { lastLastNode = lastNode; lastNode = theLHS; theLHS = theLHS->bottom; continue; } /*==============================================================*/ /* If the preceding pattern was the end of a NOT/AND CE group, */ /* then we can't attach this TEST CE to a preceding pattern and */ /* should skip over it. The logic for handling the test CE will */ /* be triggered when the joins are constructed. Note that the */ /* endNandDepth will never be greater than the beginNandDepth. */ /*==============================================================*/ if (lastNode->beginNandDepth > lastNode->endNandDepth) { lastLastNode = lastNode; lastNode = theLHS; theLHS = theLHS->bottom; continue; } /*===================================================*/ /* If the TEST CE does not close the preceding CE... */ /*===================================================*/ /*===================================================*/ /* Case #1 */ /* Pattern CE */ /* Depth Begin: N */ /* Depth End: N */ /* Test CE */ /* Depth Begin: N */ /* Depth End: N */ /* */ /* (defrule example */ /* (a ?x) */ /* (test (> ?x 0)) */ /* =>) */ /* */ /* The test expression can be directly attached to */ /* the network expression for the preceding pattern. */ /*===================================================*/ if (theLHS->beginNandDepth == theLHS->endNandDepth) { /*==============================================================*/ /* If the preceding pattern was a NOT or EXISTS CE containing */ /* a single pattern, then attached the TEST CE to the secondary */ /* test, otherwise combine it with the primary network test. */ /*==============================================================*/ if (lastNode->negated) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } else { lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,theLHS->networkTest); } } /*=================================================================*/ /* Otherwise the TEST CE closes a prior NOT/AND or EXISTS/AND CE. */ /*=================================================================*/ /*==================================================*/ /* If these are the first two patterns in the rule. */ /*==================================================*/ /*=========*/ /* Case #3 */ /*=========*/ else if (lastLastNode == NULL) { /*=========================================================*/ /* The prior pattern is a single pattern within a not/and. */ /* */ /* (defrule example */ /* (not (and (b) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /* Collapse the nand pattern. */ /*=========================================================*/ if ((lastNode->negated == FALSE) && (lastNode->existsNand == FALSE)) { lastNode->beginNandDepth = theLHS->endNandDepth; lastNode->negated = TRUE; lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,lastNode->externalNetworkTest); lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,theLHS->networkTest); lastNode->externalNetworkTest = NULL; } /*=================================================================*/ /* The prior pattern is a single negated pattern within a not/and. */ /* */ /* (defrule example */ /* (not (and (not (b)) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /*=================================================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == FALSE) && (lastNode->existsNand == FALSE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*================================================================*/ /* The prior pattern is a single exists pattern within a not/and. */ /* */ /* (defrule example */ /* (not (and (exists (b)) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /*================================================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == TRUE) && (lastNode->existsNand == FALSE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*=============================================================*/ /* The prior pattern is a single pattern within an exists/and. */ /* */ /* (defrule example */ /* (exists (and (b) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /* Collapse the exists pattern. */ /*=============================================================*/ else if ((lastNode->negated == FALSE) && (lastNode->exists == FALSE) && (lastNode->existsNand == TRUE)) { lastNode->beginNandDepth = theLHS->endNandDepth; lastNode->existsNand = FALSE; lastNode->exists = TRUE; lastNode->negated = TRUE; /*===================================================*/ /* For the first two patterns, there shouldn't be an */ /* externalNetwork test, but this code is included */ /* to match the other cases where patterns are */ /* collapsed. */ /*===================================================*/ lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,lastNode->externalNetworkTest); lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,theLHS->networkTest); lastNode->externalNetworkTest = NULL; } /*=======================================*/ /* The prior pattern is a single negated */ /* pattern within an exists/and. */ /* */ /* (defrule example */ /* (exists (and (not (b)) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /*=======================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == FALSE) && (lastNode->existsNand == TRUE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*======================================*/ /* The prior pattern is a single exists */ /* pattern within an exists/and. */ /* */ /* (defrule example */ /* (exists (and (exists (b)) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /* Collapse the exists pattern. */ /*======================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == TRUE) && (lastNode->existsNand == TRUE)) { lastNode->beginNandDepth = theLHS->endNandDepth; lastNode->existsNand = FALSE; /*===================================================*/ /* For the first two patterns, there shouldn't be an */ /* externalNetwork test, but this code is included */ /* to match the other cases where patterns are */ /* collapsed. */ /*===================================================*/ lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,lastNode->externalNetworkTest); lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); lastNode->externalNetworkTest = NULL; } /*==============================================*/ /* Unhandled case which should not be possible. */ /*==============================================*/ else { SystemError(theEnv,"RULEBLD",1); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*==============================================*/ /* Otherwise, there are two preceding patterns. */ /*==============================================*/ /*====================================*/ /* Case #4 */ /* Pattern CE */ /* Depth Begin: - */ /* Depth End: N */ /* Pattern CE */ /* Depth Begin: N */ /* Depth End: N */ /* Test CE */ /* Depth Begin: N */ /* Depth End: M where M < N */ /*====================================*/ else if (lastLastNode->endNandDepth == theLHS->beginNandDepth) { /*==============================================================*/ /* If the preceding pattern was a NOT or EXISTS CE containing */ /* a single pattern, then attached the TEST CE to the secondary */ /* test, otherwise combine it with the primary network test. */ /*==============================================================*/ if (lastNode->negated) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } else { lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,theLHS->networkTest); } } /*====================================*/ /* Case #5 */ /* Pattern CE */ /* Depth Begin: - */ /* Depth End: R where R < N */ /* Pattern CE */ /* Depth Begin: N */ /* Depth End: N */ /* Test CE */ /* Depth Begin: N */ /* Depth End: M where M < N */ /*====================================*/ else if (lastLastNode->endNandDepth < theLHS->beginNandDepth) { /*=========================================================*/ /* The prior pattern is a single pattern within a not/and: */ /* */ /* (defrule example */ /* (a) */ /* (not (and (b) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /* The test expression can be directly attached to the */ /* network expression for the pattern and the pattern */ /* group can be collapsed into a single negated pattern. */ /*=========================================================*/ if ((lastNode->negated == FALSE) && (lastNode->existsNand == FALSE)) { /*====================*/ /* Use max of R and M */ /*====================*/ if (lastLastNode->endNandDepth > theLHS->endNandDepth) { lastNode->beginNandDepth = lastLastNode->endNandDepth; } else { lastNode->beginNandDepth = theLHS->endNandDepth; } lastNode->negated = TRUE; lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,lastNode->externalNetworkTest); lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,theLHS->networkTest); lastNode->externalNetworkTest = NULL; } /*=================================================================*/ /* The prior pattern is a single negated pattern within a not/and. */ /* */ /* (defrule example */ /* (a) */ /* (not (and (not (b)) */ /* (test (= 1 1)))) */ /* =>) */ /*=================================================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == FALSE) && (lastNode->existsNand == FALSE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*================================================================*/ /* The prior pattern is a single exists pattern within a not/and. */ /* */ /* (defrule example */ /* (a) */ /* (not (and (exists (b)) */ /* (test (= 1 1)))) */ /* =>) */ /*================================================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == TRUE) && (lastNode->existsNand == FALSE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*=============================================================*/ /* The prior pattern is a single pattern within an exists/and. */ /* */ /* (defrule example */ /* (a) */ /* (exists (and (b) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /* The test expression can be directly attached to the */ /* network expression for the pattern and the pattern */ /* group can be collapsed into a single exists pattern. */ /*=============================================================*/ else if ((lastNode->negated == FALSE) && (lastNode->exists == FALSE) && (lastNode->existsNand == TRUE)) { if (lastLastNode->endNandDepth > theLHS->endNandDepth) { lastNode->beginNandDepth = lastLastNode->endNandDepth; } else { lastNode->beginNandDepth = theLHS->endNandDepth; } lastNode->existsNand = FALSE; lastNode->exists = TRUE; lastNode->negated = TRUE; lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,lastNode->externalNetworkTest); lastNode->networkTest = CombineExpressions(theEnv,lastNode->networkTest,theLHS->networkTest); lastNode->externalNetworkTest = NULL; } /*=======================================*/ /* The prior pattern is a single negated */ /* pattern within an exists/and. */ /* */ /* (defrule example */ /* (a) */ /* (exists (and (not (b)) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /*=======================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == FALSE) && (lastNode->existsNand == TRUE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*======================================*/ /* The prior pattern is a single exists */ /* pattern within an exists/and. */ /* */ /* (defrule example */ /* (a) */ /* (exists (and (exists (b)) */ /* (test (= 1 1)))) */ /* =>) */ /* */ /*======================================*/ else if ((lastNode->negated == TRUE) && (lastNode->exists == TRUE) && (lastNode->existsNand == TRUE)) { lastNode->secondaryNetworkTest = CombineExpressions(theEnv,lastNode->secondaryNetworkTest,theLHS->networkTest); } /*==============================================*/ /* Unhandled case which should not be possible. */ /*==============================================*/ else { SystemError(theEnv,"RULEBLD",2); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*==============================================*/ /* Unhandled case which should not be possible. */ /*==============================================*/ else { SystemError(theEnv,"RULEBLD",3); EnvExitRouter(theEnv,EXIT_FAILURE); } /*=================================================*/ /* Remove the TEST CE and continue to the next CE. */ /*=================================================*/ theLHS->networkTest = NULL; tempNode = theLHS->bottom; theLHS->bottom = NULL; lastNode->bottom = tempNode; lastNode->endNandDepth = theLHS->endNandDepth; ReturnLHSParseNodes(theEnv,theLHS); theLHS = tempNode; } } /********************************************************************/ /* FindShareableJoin: Determines whether a join exists that can be */ /* reused for the join currently being added to the join network. */ /* Returns a pointer to the join to be shared if one if found, */ /* otherwise returns a NULL pointer. */ /********************************************************************/ static struct joinNode *FindShareableJoin( struct joinLink *theLinks, struct joinNode *listOfJoins, intBool useLinks, void *rhsStruct, unsigned int firstJoin, unsigned int negatedRHS, unsigned int existsRHS, unsigned int isLogical, struct expr *joinTest, struct expr *secondaryJoinTest, struct expr *leftHash, struct expr *rightHash) { /*========================================*/ /* Loop through all of the joins in the */ /* list of potential candiates for reuse. */ /*========================================*/ if (useLinks) { if (theLinks != NULL) { listOfJoins = theLinks->join; } else { listOfJoins = NULL; } } while (listOfJoins != NULL) { /*=========================================================*/ /* If the join being tested for reuse is connected on the */ /* RHS to the end node of the pattern node associated with */ /* the join to be added, then determine if the join can */ /* be reused. If so, return the join. */ /*=========================================================*/ if (listOfJoins->rightSideEntryStructure == rhsStruct) { if (TestJoinForReuse(listOfJoins,firstJoin,negatedRHS,existsRHS, isLogical,joinTest,secondaryJoinTest, leftHash,rightHash)) { return(listOfJoins); } } /*====================================================*/ /* Move on to the next potential candidate. Note that */ /* the rightMatchNode link is used for traversing */ /* through the candidates for the first join of a */ /* rule and that rightDriveNode link is used for */ /* traversing through the candidates for subsequent */ /* joins of a rule. */ /*====================================================*/ if (useLinks) { theLinks = theLinks->next; if (theLinks != NULL) { listOfJoins = theLinks->join; } else { listOfJoins = NULL; } } else { listOfJoins = listOfJoins->rightMatchNode; } } /*================================*/ /* Return a NULL pointer, since a */ /* reusable join was not found. */ /*================================*/ return(NULL); } /**************************************************************/ /* TestJoinForReuse: Determines if the specified join can be */ /* shared with a join being added for a rule being defined. */ /* Returns TRUE if the join can be shared, otherwise FALSE. */ /**************************************************************/ static int TestJoinForReuse( struct joinNode *testJoin, unsigned firstJoin, unsigned negatedRHS, unsigned existsRHS, unsigned int isLogical, struct expr *joinTest, struct expr *secondaryJoinTest, struct expr *leftHash, struct expr *rightHash) { /*==================================================*/ /* The first join of a rule may only be shared with */ /* a join that has its firstJoin field set to TRUE. */ /*==================================================*/ if (testJoin->firstJoin != firstJoin) return(FALSE); /*========================================================*/ /* A join connected to a not CE may only be shared with a */ /* join that has its patternIsNegated field set to TRUE. */ /*========================================================*/ if ((testJoin->patternIsNegated != negatedRHS) && (! existsRHS)) return(FALSE); /*==========================================================*/ /* A join connected to an exists CE may only be shared with */ /* a join that has its patternIsExists field set to TRUE. */ /*==========================================================*/ if (testJoin->patternIsExists != existsRHS) return(FALSE); /*==========================================================*/ /* If the join added is associated with a logical CE, then */ /* either the join to be shared must be associated with a */ /* logical CE or the beta memory must be empty (since */ /* joins associate an extra field with each partial match). */ /*==========================================================*/ if ((isLogical == TRUE) && (testJoin->logicalJoin == FALSE) && BetaMemoryNotEmpty(testJoin)) { return(FALSE); } /*===============================================================*/ /* The expression associated with the join must be identical to */ /* the networkTest expression stored with the join to be shared. */ /*===============================================================*/ if (IdenticalExpression(testJoin->networkTest,joinTest) != TRUE) { return(FALSE); } if (IdenticalExpression(testJoin->secondaryNetworkTest,secondaryJoinTest) != TRUE) { return(FALSE); } /*====================================================================*/ /* The alpha memory hashing values associated with the join must be */ /* identical to the hashing values stored with the join to be shared. */ /*====================================================================*/ if (IdenticalExpression(testJoin->leftHash,leftHash) != TRUE) { return(FALSE); } if (IdenticalExpression(testJoin->rightHash,rightHash) != TRUE) { return(FALSE); } /*=============================================*/ /* The join can be shared since all conditions */ /* for sharing have been satisfied. */ /*=============================================*/ return(TRUE); } /*************************************************************************/ /* CreateNewJoin: Creates a new join and links it into the join network. */ /*************************************************************************/ static struct joinNode *CreateNewJoin( void *theEnv, struct expr *joinTest, struct expr *secondaryJoinTest, struct joinNode *lhsEntryStruct, void *rhsEntryStruct, int joinFromTheRight, int negatedRHSPattern, int existsRHSPattern, struct expr *leftHash, struct expr *rightHash) { struct joinNode *newJoin; struct joinLink *theLink; /*===============================================*/ /* If compilations are being watch, print +j to */ /* indicate that a new join has been created for */ /* this pattern of the rule (i.e. a join could */ /* not be shared with another rule. */ /*===============================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"+j"); } #endif /*======================*/ /* Create the new join. */ /*======================*/ newJoin = get_struct(theEnv,joinNode); /*======================================================*/ /* The first join of a rule does not have a beta memory */ /* unless the RHS pattern is an exists or not CE. */ /*======================================================*/ if ((lhsEntryStruct != NULL) || existsRHSPattern || negatedRHSPattern || joinFromTheRight) { if (leftHash == NULL) { newJoin->leftMemory = get_struct(theEnv,betaMemory); newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->leftMemory->beta[0] = NULL; newJoin->leftMemory->last = NULL; newJoin->leftMemory->size = 1; newJoin->leftMemory->count = 0; } else { newJoin->leftMemory = get_struct(theEnv,betaMemory); newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(newJoin->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); newJoin->leftMemory->last = NULL; newJoin->leftMemory->size = INITIAL_BETA_HASH_SIZE; newJoin->leftMemory->count = 0; } /*===========================================================*/ /* If the first join of a rule connects to an exists or not */ /* CE, then we create an empty partial match for the usually */ /* empty left beta memory so that we can track the current */ /* current right memory partial match satisfying the CE. */ /*===========================================================*/ if ((lhsEntryStruct == NULL) && (existsRHSPattern || negatedRHSPattern || joinFromTheRight)) { newJoin->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv); newJoin->leftMemory->beta[0]->owner = newJoin; newJoin->leftMemory->count = 1; } } else { newJoin->leftMemory = NULL; } if (joinFromTheRight) { if (leftHash == NULL) { newJoin->rightMemory = get_struct(theEnv,betaMemory); newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->beta[0] = NULL; newJoin->rightMemory->last[0] = NULL; newJoin->rightMemory->size = 1; newJoin->rightMemory->count = 0; } else { newJoin->rightMemory = get_struct(theEnv,betaMemory); newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(newJoin->rightMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(newJoin->rightMemory->last,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); newJoin->rightMemory->size = INITIAL_BETA_HASH_SIZE; newJoin->rightMemory->count = 0; } } else if (rhsEntryStruct == NULL) { newJoin->rightMemory = get_struct(theEnv,betaMemory); newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv); newJoin->rightMemory->beta[0]->owner = newJoin; newJoin->rightMemory->beta[0]->rhsMemory = TRUE; newJoin->rightMemory->last[0] = newJoin->rightMemory->beta[0]; newJoin->rightMemory->size = 1; newJoin->rightMemory->count = 1; } else { newJoin->rightMemory = NULL; } newJoin->nextLinks = NULL; newJoin->joinFromTheRight = joinFromTheRight; if (existsRHSPattern) { newJoin->patternIsNegated = FALSE; } else { newJoin->patternIsNegated = negatedRHSPattern; } newJoin->patternIsExists = existsRHSPattern; newJoin->marked = FALSE; newJoin->initialize = EnvGetIncrementalReset(theEnv); newJoin->logicalJoin = FALSE; newJoin->ruleToActivate = NULL; newJoin->memoryLeftAdds = 0; newJoin->memoryRightAdds = 0; newJoin->memoryLeftDeletes = 0; newJoin->memoryRightDeletes = 0; newJoin->memoryCompares = 0; /*==============================================*/ /* Install the expressions used to determine */ /* if a partial match satisfies the constraints */ /* associated with this join. */ /*==============================================*/ newJoin->networkTest = AddHashedExpression(theEnv,joinTest); newJoin->secondaryNetworkTest = AddHashedExpression(theEnv,secondaryJoinTest); /*=====================================================*/ /* Install the expression used to hash the beta memory */ /* partial match to determine the location to search */ /* in the alpha memory. */ /*=====================================================*/ newJoin->leftHash = AddHashedExpression(theEnv,leftHash); newJoin->rightHash = AddHashedExpression(theEnv,rightHash); /*============================================================*/ /* Initialize the values associated with the LHS of the join. */ /*============================================================*/ newJoin->lastLevel = lhsEntryStruct; if (lhsEntryStruct == NULL) { newJoin->firstJoin = TRUE; newJoin->depth = 1; } else { newJoin->firstJoin = FALSE; newJoin->depth = lhsEntryStruct->depth; newJoin->depth++; /* To work around Sparcworks C compiler bug */ theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = LHS; /*==============================================================*/ /* If this is a join from the right, then there should already */ /* be a link from the previous join to the other join in the */ /* the bifurcated path through the join network. If so, we want */ /* add the next link to the join from the right so that it is */ /* visited after the other path. Doing this will reduce the */ /* number of activations added and then removed if the other */ /* path were followed first. The other path generates the */ /* partial matches which are negated by this path, so if that */ /* path is processed first, the partial matches from that path */ /* will prevent partial matches on this path. */ /*==============================================================*/ if ((joinFromTheRight) && (lhsEntryStruct->nextLinks != NULL)) { theLink->next = lhsEntryStruct->nextLinks->next; lhsEntryStruct->nextLinks->next = theLink; } else { theLink->next = lhsEntryStruct->nextLinks; lhsEntryStruct->nextLinks = theLink; } } /*=======================================================*/ /* Initialize the pointer values associated with the RHS */ /* of the join (both for the new join and the join or */ /* pattern which enters this join from the right. */ /*=======================================================*/ newJoin->rightSideEntryStructure = rhsEntryStruct; if (rhsEntryStruct == NULL) { if (newJoin->firstJoin) { theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = RHS; theLink->next = DefruleData(theEnv)->RightPrimeJoins; DefruleData(theEnv)->RightPrimeJoins = theLink; } newJoin->rightMatchNode = NULL; return(newJoin); } /*===========================================================*/ /* If the first join of a rule is a not CE, then it needs to */ /* be "primed" under certain circumstances. This used to be */ /* handled by adding the (initial-fact) pattern to a rule */ /* with the not CE as its first pattern, but this alternate */ /* mechanism is now used so patterns don't have to be added. */ /*===========================================================*/ if (newJoin->firstJoin && (newJoin->patternIsNegated || newJoin->joinFromTheRight) && (! newJoin->patternIsExists)) { theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = LHS; theLink->next = DefruleData(theEnv)->LeftPrimeJoins; DefruleData(theEnv)->LeftPrimeJoins = theLink; } if (joinFromTheRight) { theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = RHS; theLink->next = ((struct joinNode *) rhsEntryStruct)->nextLinks; ((struct joinNode *) rhsEntryStruct)->nextLinks = theLink; newJoin->rightMatchNode = NULL; } else { newJoin->rightMatchNode = ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin; ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin = newJoin; } /*================================*/ /* Return the newly created join. */ /*================================*/ return(newJoin); } #endif clips_core_source_630/core/immthpsr.c0000755000175000017500000003616412373755065016267 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* IMPLICIT SYSTEM METHODS PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing routines for Implicit System Methods */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added pragmas to remove unused parameter */ /* warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #include #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #endif #include "envrnmnt.h" #include "memalloc.h" #include "cstrnutl.h" #include "extnfunc.h" #include "genrcpsr.h" #include "prccode.h" #define _IMMTHPSR_SOURCE_ #include "immthpsr.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void FormMethodsFromRestrictions(void *,DEFGENERIC *,const char *,EXPRESSION *); static RESTRICTION *ParseRestrictionType(void *,int); static EXPRESSION *GenTypeExpression(void *,EXPRESSION *,int,int,const char *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : AddImplicitMethods DESCRIPTION : Adds a method(s) for a generic function for an overloaded system function INPUTS : A pointer to a gneeric function RETURNS : Nothing useful SIDE EFFECTS : Method added NOTES : Method marked as system Assumes no other methods already present ********************************************************/ globle void AddImplicitMethods( void *theEnv, DEFGENERIC *gfunc) { struct FunctionDefinition *sysfunc; EXPRESSION action; sysfunc = FindFunction(theEnv,ValueToString(gfunc->header.name)); if (sysfunc == NULL) return; action.type = FCALL; action.value = (void *) sysfunc; action.nextArg = NULL; action.argList = NULL; FormMethodsFromRestrictions(theEnv,gfunc,sysfunc->restrictions,&action); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************************** NAME : FormMethodsFromRestrictions DESCRIPTION : Uses restriction string given in DefineFunction2() for system function to create an equivalent method INPUTS : 1) The generic function for the new methods 2) System function restriction string (see DefineFunction2() last argument) 3) The actions to attach to a new method(s) RETURNS : Nothing useful SIDE EFFECTS : Implicit method(s) created NOTES : None **********************************************************************/ static void FormMethodsFromRestrictions( void *theEnv, DEFGENERIC *gfunc, const char *rstring, EXPRESSION *actions) { DEFMETHOD *meth; EXPRESSION *plist,*tmp,*bot,*svBot; RESTRICTION *rptr; char theChar[2],defaultc; int min,max,mposn,needMinimumMethod; register int i,j; /* =================================== The system function will accept any number of any type of arguments =================================== */ if (rstring == NULL) { tmp = get_struct(theEnv,expr); rptr = get_struct(theEnv,restriction); PackRestrictionTypes(theEnv,rptr,NULL); rptr->query = NULL; tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; meth = AddMethod(theEnv,gfunc,NULL,0,0,tmp,1,0,(SYMBOL_HN *) EnvTrueSymbol(theEnv), PackExpression(theEnv,actions),NULL,FALSE); meth->system = 1; DeleteTempRestricts(theEnv,tmp); return; } /* ============================== Extract the range of arguments from the restriction string ============================== */ theChar[1] = '\0'; if (rstring[0] == '*') min = 0; else { theChar[0] = rstring[0]; min = atoi(theChar); } if (rstring[1] == '*') max = -1; else { theChar[0] = rstring[1]; max = atoi(theChar); } if (rstring[2] != '\0') { defaultc = rstring[2]; j = 3; } else { defaultc = 'u'; j= 2; } /* ================================================ Form a list of method restrictions corresponding to the minimum number of arguments ================================================ */ plist = bot = NULL; for (i = 0 ; i < min ; i++) { theChar[0] = (rstring[j] != '\0') ? rstring[j++] : defaultc; rptr = ParseRestrictionType(theEnv,(int) theChar[0]); tmp = get_struct(theEnv,expr); tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; if (plist == NULL) plist = tmp; else bot->nextArg = tmp; bot = tmp; } /* =============================== Remember where restrictions end for minimum number of arguments =============================== */ svBot = bot; needMinimumMethod = TRUE; /* ======================================================= Attach one or more new methods to correspond to the possible variations of the extra arguments Add a separate method for each specified extra argument ======================================================= */ i = 0; while (rstring[j] != '\0') { if ((rstring[j+1] == '\0') && ((min + i + 1) == max)) { defaultc = rstring[j]; break; } rptr = ParseRestrictionType(theEnv,(int) rstring[j]); tmp = get_struct(theEnv,expr); tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; if (plist == NULL) plist = tmp; else bot->nextArg = tmp; bot = tmp; i++; j++; if ((rstring[j] != '\0') || ((min + i) == max)) { FindMethodByRestrictions(gfunc,plist,min + i,NULL,&mposn); meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min + i,0,NULL, PackExpression(theEnv,actions),NULL,TRUE); meth->system = 1; } } /* ============================================== Add a method to account for wildcard arguments and attach a query in case there is a limit ============================================== */ if ((min + i) != max) { /* ================================================ If a wildcard is present immediately after the minimum number of args - then the minimum case will already be handled by this method. We don't need to add an extra method for that case ================================================ */ if (i == 0) needMinimumMethod = FALSE; rptr = ParseRestrictionType(theEnv,(int) defaultc); if (max != -1) { rptr->query = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"<=")); rptr->query->argList = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"length$")); rptr->query->argList->argList = GenProcWildcardReference(theEnv,min + i + 1); rptr->query->argList->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) (max - min - i))); } tmp = get_struct(theEnv,expr); tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; if (plist == NULL) plist = tmp; else bot->nextArg = tmp; FindMethodByRestrictions(gfunc,plist,min + i + 1,(SYMBOL_HN *) EnvTrueSymbol(theEnv),&mposn); meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min + i + 1,0,(SYMBOL_HN *) EnvTrueSymbol(theEnv), PackExpression(theEnv,actions),NULL,FALSE); meth->system = 1; } /* =================================================== When extra methods had to be added because of different restrictions on the optional arguments OR the system function accepts a fixed number of args, we must add a specific method for the minimum case. Otherwise, the method with the wildcard covers it. =================================================== */ if (needMinimumMethod) { if (svBot != NULL) { bot = svBot->nextArg; svBot->nextArg = NULL; DeleteTempRestricts(theEnv,bot); } FindMethodByRestrictions(gfunc,plist,min,NULL,&mposn); meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min,0,NULL, PackExpression(theEnv,actions),NULL,TRUE); meth->system = 1; } DeleteTempRestricts(theEnv,plist); } /******************************************************************* NAME : ParseRestrictionType DESCRIPTION : Takes a string of type character codes (as given in DefineFunction2()) and converts it into a method restriction structure INPUTS : The type character code RETURNS : The restriction SIDE EFFECTS : Restriction allocated NOTES : None *******************************************************************/ static RESTRICTION *ParseRestrictionType( void *theEnv, int code) { RESTRICTION *rptr; CONSTRAINT_RECORD *rv; EXPRESSION *types = NULL; rptr = get_struct(theEnv,restriction); rptr->query = NULL; rv = ArgumentTypeToConstraintRecord(theEnv,code); if (rv->anyAllowed == FALSE) { if (rv->symbolsAllowed && rv->stringsAllowed) types = GenTypeExpression(theEnv,types,LEXEME_TYPE_CODE,-1,LEXEME_TYPE_NAME); else if (rv->symbolsAllowed) types = GenTypeExpression(theEnv,types,SYMBOL,SYMBOL,NULL); else if (rv->stringsAllowed) types = GenTypeExpression(theEnv,types,STRING,STRING,NULL); if (rv->floatsAllowed && rv->integersAllowed) types = GenTypeExpression(theEnv,types,NUMBER_TYPE_CODE,-1,NUMBER_TYPE_NAME); else if (rv->integersAllowed) types = GenTypeExpression(theEnv,types,INTEGER,INTEGER,NULL); else if (rv->floatsAllowed) types = GenTypeExpression(theEnv,types,FLOAT,FLOAT,NULL); if (rv->instanceNamesAllowed && rv->instanceAddressesAllowed) types = GenTypeExpression(theEnv,types,INSTANCE_TYPE_CODE,-1,INSTANCE_TYPE_NAME); else if (rv->instanceNamesAllowed) types = GenTypeExpression(theEnv,types,INSTANCE_NAME,INSTANCE_NAME,NULL); else if (rv->instanceAddressesAllowed) types = GenTypeExpression(theEnv,types,INSTANCE_ADDRESS,INSTANCE_ADDRESS,NULL); if (rv->externalAddressesAllowed && rv->instanceAddressesAllowed && rv->factAddressesAllowed) types = GenTypeExpression(theEnv,types,ADDRESS_TYPE_CODE,-1,ADDRESS_TYPE_NAME); else { if (rv->externalAddressesAllowed) types = GenTypeExpression(theEnv,types,EXTERNAL_ADDRESS,EXTERNAL_ADDRESS,NULL); if (rv->instanceAddressesAllowed && (rv->instanceNamesAllowed == 0)) types = GenTypeExpression(theEnv,types,INSTANCE_ADDRESS,INSTANCE_ADDRESS,NULL); if (rv->factAddressesAllowed) types = GenTypeExpression(theEnv,types,FACT_ADDRESS,FACT_ADDRESS,NULL); } if (rv->multifieldsAllowed) types = GenTypeExpression(theEnv,types,MULTIFIELD,MULTIFIELD,NULL); } RemoveConstraint(theEnv,rv); PackRestrictionTypes(theEnv,rptr,types); return(rptr); } /*************************************************** NAME : GenTypeExpression DESCRIPTION : Creates an expression corresponding to the type specified and adds it to the front of a temporary type list for a method restriction INPUTS : 1) The top of the current type list 2) The type code when COOL is not installed 3) The primitive type (-1 if not a primitive type) 4) The name of the COOL class if it is not a primitive type RETURNS : The new top of the types list SIDE EFFECTS : Type node allocated and attached NOTES : Restriction types in a non-COOL environment are the type codes given in CONSTANT.H. In a COOL environment, they are pointers to classes ***************************************************/ static EXPRESSION *GenTypeExpression( void *theEnv, EXPRESSION *top, int nonCOOLCode, int primitiveCode, const char *COOLName) { #if OBJECT_SYSTEM #if MAC_XCD #pragma unused(nonCOOLCode) #endif #else #if MAC_XCD #pragma unused(primitiveCode) #pragma unused(COOLName) #endif #endif EXPRESSION *tmp; #if OBJECT_SYSTEM if (primitiveCode != -1) tmp = GenConstant(theEnv,0,(void *) DefclassData(theEnv)->PrimitiveClassMap[primitiveCode]); else tmp = GenConstant(theEnv,0,(void *) LookupDefclassByMdlOrScope(theEnv,COOLName)); #else tmp = GenConstant(theEnv,0,EnvAddLong(theEnv,(long long) nonCOOLCode)); #endif tmp->nextArg = top; return(tmp); } #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ clips_core_source_630/core/factfun.h0000755000175000017500000001005612373742660016044 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added ppfact function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_factfun #define _H_factfun #ifndef _H_factmngr #include "factmngr.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactFunctionDefinitions(void *); LOCALE void *FactRelationFunction(void *); LOCALE void *FactRelation(void *); LOCALE void *EnvFactDeftemplate(void *,void *); LOCALE int FactExistpFunction(void *); LOCALE int EnvFactExistp(void *,void *); LOCALE void FactSlotValueFunction(void *,DATA_OBJECT *); LOCALE void FactSlotValue(void *,void *,const char *,DATA_OBJECT *); LOCALE void FactSlotNamesFunction(void *,DATA_OBJECT *); LOCALE void EnvFactSlotNames(void *,void *,DATA_OBJECT *); LOCALE void GetFactListFunction(void *,DATA_OBJECT *); LOCALE void EnvGetFactList(void *,DATA_OBJECT *,void *); LOCALE void PPFactFunction(void *); LOCALE void EnvPPFact(void *,void *,const char *,int); LOCALE struct fact *GetFactAddressOrIndexArgument(void *,const char *,int,int); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void *FactDeftemplate(void *); LOCALE int FactExistp(void *); LOCALE void FactSlotNames(void *,DATA_OBJECT *); LOCALE void GetFactList(DATA_OBJECT_PTR,void *); LOCALE void PPFact(void *,const char *,int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_factfun */ clips_core_source_630/core/argacces.h0000755000175000017500000001113712375756164016175 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* ARGUMENT ACCESS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides access routines for accessing arguments */ /* passed to user or system functions defined using the */ /* DefineFunction protocol. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added IllegalLogicalNameMessage function. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_argacces #define _H_argacces #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _ARGACCES_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int EnvRtnArgCount(void *); LOCALE int EnvArgCountCheck(void *,const char *,int,int); LOCALE int EnvArgRangeCheck(void *,const char *,int,int); LOCALE const char *EnvRtnLexeme(void *,int); LOCALE double EnvRtnDouble(void *,int); LOCALE long long EnvRtnLong(void *,int); LOCALE struct dataObject *EnvRtnUnknown(void *,int,struct dataObject *); LOCALE int EnvArgTypeCheck(void *,const char *,int,int,struct dataObject *); LOCALE intBool GetNumericArgument(void *,struct expr *,const char *,struct dataObject *,int,int); LOCALE const char *GetLogicalName(void *,int,const char *); LOCALE const char *GetFileName(void *,const char *,int); LOCALE const char *GetConstructName(void *,const char *,const char *); LOCALE void ExpectedCountError(void *,const char *,int,int); LOCALE void OpenErrorMessage(void *,const char *,const char *); LOCALE intBool CheckFunctionArgCount(void *,const char *,const char *,int); LOCALE void ExpectedTypeError1(void *,const char *,int,const char *); LOCALE void ExpectedTypeError2(void *,const char *,int); LOCALE struct defmodule *GetModuleName(void *,const char *,int,int *); LOCALE void *GetFactOrInstanceArgument(void *,int,DATA_OBJECT *,const char *); LOCALE void IllegalLogicalNameMessage(void *,const char *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE int ArgCountCheck(const char *,int,int); LOCALE int ArgRangeCheck(const char *,int,int); LOCALE int ArgTypeCheck(const char *,int,int,DATA_OBJECT_PTR); LOCALE int RtnArgCount(void); LOCALE double RtnDouble(int); LOCALE const char *RtnLexeme(int); LOCALE long long RtnLong(int); LOCALE DATA_OBJECT_PTR RtnUnknown(int,DATA_OBJECT_PTR); #endif #endif clips_core_source_630/core/insquery.h0000755000175000017500000000747012373756332016304 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_insquery #define _H_insquery #if INSTANCE_SET_QUERIES #ifndef _H_object #include "object.h" #endif typedef struct query_class { DEFCLASS *cls; struct defmodule *theModule; struct query_class *chain,*nxt; } QUERY_CLASS; typedef struct query_soln { INSTANCE_TYPE **soln; struct query_soln *nxt; } QUERY_SOLN; typedef struct query_core { INSTANCE_TYPE **solns; EXPRESSION *query,*action; QUERY_SOLN *soln_set,*soln_bottom; unsigned soln_size,soln_cnt; DATA_OBJECT *result; } QUERY_CORE; typedef struct query_stack { QUERY_CORE *core; struct query_stack *nxt; } QUERY_STACK; #define INSTANCE_QUERY_DATA 31 struct instanceQueryData { SYMBOL_HN *QUERY_DELIMETER_SYMBOL; QUERY_CORE *QueryCore; QUERY_STACK *QueryCoreStack; int AbortQuery; }; #define InstanceQueryData(theEnv) ((struct instanceQueryData *) GetEnvironmentData(theEnv,INSTANCE_QUERY_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _INSQUERY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define QUERY_DELIMETER_STRING "(QDS)" LOCALE void SetupQuery(void *); LOCALE void *GetQueryInstance(void *); LOCALE void GetQueryInstanceSlot(void *,DATA_OBJECT *); LOCALE intBool AnyInstances(void *); LOCALE void QueryFindInstance(void *,DATA_OBJECT *); LOCALE void QueryFindAllInstances(void *,DATA_OBJECT *); LOCALE void QueryDoForInstance(void *,DATA_OBJECT *); LOCALE void QueryDoForAllInstances(void *,DATA_OBJECT *); LOCALE void DelayedQueryDoForAllInstances(void *,DATA_OBJECT *); #endif /* INSTANCE_SET_QUERIES */ #endif /* _H_insquery */ clips_core_source_630/core/._factrete.c0000755000175000017500000000040712373742637016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffctcmp.h0000755000175000017500000000360712373731206016202 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFFACTS CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /*************************************************************/ #ifndef _H_dffctcmp #define _H_dffctcmp #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeffactsCompilerSetup(void *); LOCALE void DeffactsCModuleReference(void *,FILE *,int,int,int); #endif /* _H_dffctcmp */ clips_core_source_630/core/factbin.c0000755000175000017500000004123312373742000016004 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* fact pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #define _FACTBIN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "tmpltdef.h" #include "bload.h" #include "bsave.h" #include "reteutil.h" #include "rulebin.h" #include "moduldef.h" #include "envrnmnt.h" #include "factbin.h" /********************************************/ /* INTERNAL DATA STRUCTURES AND DEFINITIONS */ /********************************************/ struct bsaveFactPatternNode { struct bsavePatternNodeHeader header; unsigned short whichSlot; unsigned short whichField; unsigned short leaveFields; long networkTest; long nextLevel; long lastLevel; long leftNode; long rightNode; }; #define BSAVE_FIND 0 #define BSAVE_PATTERNS 1 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveDriver(void *,int,FILE *,struct factPatternNode *); static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveFactPatterns(void *,FILE *); static void BsavePatternNode(void *,struct factPatternNode *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateFactPatterns(void *,void *,long); static void ClearBload(void *); static void DeallocateFactBloadData(void *); /*****************************************************/ /* FactBinarySetup: Initializes the binary load/save */ /* feature for the fact pattern network. */ /*****************************************************/ globle void FactBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,FACTBIN_DATA,sizeof(struct factBinaryData),DeallocateFactBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"facts",0,BsaveFind,NULL, BsaveStorage,BsaveFactPatterns, BloadStorage,BloadBinaryItem, ClearBload); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"facts",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /****************************************************/ /* DeallocateFactBloadData: Deallocates environment */ /* data for the fact bsave functionality. */ /****************************************************/ static void DeallocateFactBloadData( void *theEnv) { size_t space; int i; for (i = 0; i < FactBinaryData(theEnv)->NumberOfPatterns; i++) { DestroyAlphaMemory(theEnv,&FactBinaryData(theEnv)->FactPatternArray[i].header,FALSE); } space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct factPatternNode); if (space != 0) genfree(theEnv,(void *) FactBinaryData(theEnv)->FactPatternArray,space); } #if BLOAD_AND_BSAVE /*********************************************************/ /* BsaveFind: Counts the number of data structures which */ /* must be saved in the binary image for the fact */ /* pattern network in the current environment. */ /*********************************************************/ static void BsaveFind( void *theEnv) { struct deftemplate *theDeftemplate; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,FactBinaryData(theEnv)->NumberOfPatterns); /*=======================================*/ /* Set the count of fact pattern network */ /* data structures to zero. */ /*=======================================*/ FactBinaryData(theEnv)->NumberOfPatterns = 0L; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*===============================*/ /* Set the current module to the */ /* module being examined. */ /*===============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*=====================================================*/ /* Loop through each deftemplate in the current module */ /* and count the number of data structures which must */ /* be saved for its pattern network. */ /*=====================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { BsaveDriver(theEnv,BSAVE_FIND,NULL,theDeftemplate->patternNetwork); } } } /**********************************************************/ /* BsaveDriver: Binary save driver routine which handles */ /* both finding/marking the data structures to be saved */ /* and saving the data structures to a file. */ /**********************************************************/ static void BsaveDriver( void *theEnv, int action, FILE *fp, struct factPatternNode *thePattern) { while (thePattern != NULL) { switch(action) { case BSAVE_FIND: thePattern->bsaveID = FactBinaryData(theEnv)->NumberOfPatterns++; break; case BSAVE_PATTERNS: BsavePatternNode(theEnv,thePattern,fp); break; default: break; } if (thePattern->nextLevel == NULL) { while (thePattern->rightNode == NULL) { thePattern = thePattern->lastLevel; if (thePattern == NULL) return; } thePattern = thePattern->rightNode; } else { thePattern = thePattern->nextLevel; } } } /*********************************************************/ /* BsaveStorage: Writes out storage requirements for all */ /* factPatternNode data structures to the binary file */ /*********************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { size_t space; space = sizeof(long); GenWrite(&space,sizeof(size_t),fp); GenWrite(&FactBinaryData(theEnv)->NumberOfPatterns,sizeof(long int),fp); } /*****************************************************/ /* BsaveFactPatterns: Writes out all factPatternNode */ /* data structures to the binary file. */ /*****************************************************/ static void BsaveFactPatterns( void *theEnv, FILE *fp) { size_t space; struct deftemplate *theDeftemplate; struct defmodule *theModule; /*========================================*/ /* Write out the amount of space taken up */ /* by the factPatternNode data structures */ /* in the binary image. */ /*========================================*/ space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct bsaveFactPatternNode); GenWrite(&space,sizeof(size_t),fp); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=====================================================*/ /* Loop through each deftemplate in the current module */ /* and save its fact pattern network to the file. */ /*=====================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { BsaveDriver(theEnv,BSAVE_PATTERNS,fp,theDeftemplate->patternNetwork); } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of factPatternNode data structures in the binary image */ /* (these were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&FactBinaryData(theEnv)->NumberOfPatterns); } /******************************************************/ /* BsavePatternNode: Writes out a single fact pattern */ /* node to the binary image save file. */ /******************************************************/ static void BsavePatternNode( void *theEnv, struct factPatternNode *thePattern, FILE *fp) { struct bsaveFactPatternNode tempNode; AssignBsavePatternHeaderValues(theEnv,&tempNode.header,&thePattern->header); tempNode.whichField = thePattern->whichField; tempNode.leaveFields = thePattern->leaveFields; tempNode.whichSlot = thePattern->whichSlot; tempNode.networkTest = HashedExpressionIndex(theEnv,thePattern->networkTest); tempNode.nextLevel = BsaveFactPatternIndex(thePattern->nextLevel); tempNode.lastLevel = BsaveFactPatternIndex(thePattern->lastLevel); tempNode.leftNode = BsaveFactPatternIndex(thePattern->leftNode); tempNode.rightNode = BsaveFactPatternIndex(thePattern->rightNode); GenWrite(&tempNode,(unsigned long) sizeof(struct bsaveFactPatternNode),fp); } #endif /* BLOAD_AND_BSAVE */ /*****************************************************/ /* BloadStorage: Allocates storage requirements for */ /* the factPatternNodes used by this binary image. */ /*****************************************************/ static void BloadStorage( void *theEnv) { size_t space; /*=========================================*/ /* Determine the number of factPatternNode */ /* data structures to be read. */ /*=========================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&FactBinaryData(theEnv)->NumberOfPatterns,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* factPatternNode data structures. */ /*===================================*/ if (FactBinaryData(theEnv)->NumberOfPatterns == 0) { FactBinaryData(theEnv)->FactPatternArray = NULL; return; } space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct factPatternNode); FactBinaryData(theEnv)->FactPatternArray = (struct factPatternNode *) genalloc(theEnv,space); } /************************************************************/ /* BloadBinaryItem: Loads and refreshes the factPatternNode */ /* data structures used by this binary image. */ /************************************************************/ static void BloadBinaryItem( void *theEnv) { size_t space; long i; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); /*=============================================*/ /* Read in the factPatternNode data structures */ /* and refresh the pointers. */ /*=============================================*/ BloadandRefresh(theEnv,FactBinaryData(theEnv)->NumberOfPatterns,(unsigned) sizeof(struct bsaveFactPatternNode), UpdateFactPatterns); for (i = 0; i < FactBinaryData(theEnv)->NumberOfPatterns; i++) { if ((FactBinaryData(theEnv)->FactPatternArray[i].lastLevel != NULL) && (FactBinaryData(theEnv)->FactPatternArray[i].lastLevel->header.selector)) { AddHashedPatternNode(theEnv,FactBinaryData(theEnv)->FactPatternArray[i].lastLevel, &FactBinaryData(theEnv)->FactPatternArray[i], FactBinaryData(theEnv)->FactPatternArray[i].networkTest->type, FactBinaryData(theEnv)->FactPatternArray[i].networkTest->value); } } } /*************************************************/ /* UpdateFactPatterns: Bload refresh routine for */ /* the factPatternNode structure. */ /*************************************************/ static void UpdateFactPatterns( void *theEnv, void *buf, long obji) { struct bsaveFactPatternNode *bp; bp = (struct bsaveFactPatternNode *) buf; UpdatePatternNodeHeader(theEnv,&FactBinaryData(theEnv)->FactPatternArray[obji].header,&bp->header); FactBinaryData(theEnv)->FactPatternArray[obji].bsaveID = 0L; FactBinaryData(theEnv)->FactPatternArray[obji].whichField = bp->whichField; FactBinaryData(theEnv)->FactPatternArray[obji].leaveFields = bp->leaveFields; FactBinaryData(theEnv)->FactPatternArray[obji].whichSlot = bp->whichSlot; FactBinaryData(theEnv)->FactPatternArray[obji].networkTest = HashedExpressionPointer(bp->networkTest); FactBinaryData(theEnv)->FactPatternArray[obji].rightNode = BloadFactPatternPointer(bp->rightNode); FactBinaryData(theEnv)->FactPatternArray[obji].nextLevel = BloadFactPatternPointer(bp->nextLevel); FactBinaryData(theEnv)->FactPatternArray[obji].lastLevel = BloadFactPatternPointer(bp->lastLevel); FactBinaryData(theEnv)->FactPatternArray[obji].leftNode = BloadFactPatternPointer(bp->leftNode); } /***************************************************/ /* ClearBload: Fact pattern network clear routine */ /* when a binary load is in effect. */ /***************************************************/ static void ClearBload( void *theEnv) { size_t space; long i; for (i = 0; i < FactBinaryData(theEnv)->NumberOfPatterns; i++) { if ((FactBinaryData(theEnv)->FactPatternArray[i].lastLevel != NULL) && (FactBinaryData(theEnv)->FactPatternArray[i].lastLevel->header.selector)) { RemoveHashedPatternNode(theEnv,FactBinaryData(theEnv)->FactPatternArray[i].lastLevel, &FactBinaryData(theEnv)->FactPatternArray[i], FactBinaryData(theEnv)->FactPatternArray[i].networkTest->type, FactBinaryData(theEnv)->FactPatternArray[i].networkTest->value); } } space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct factPatternNode); if (space != 0) genfree(theEnv,(void *) FactBinaryData(theEnv)->FactPatternArray,space); FactBinaryData(theEnv)->NumberOfPatterns = 0; } #endif /* DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips_core_source_630/core/._genrcpsr.h0000755000175000017500000000040712373753377016464 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffctdef.h0000755000175000017500000001050212461253173016151 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFFACTS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_dffctdef #define _H_dffctdef #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #define DEFFACTS_DATA 0 struct deffactsData { struct construct *DeffactsConstruct; int DeffactsModuleIndex; #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DeffactsCodeItem; #endif }; struct deffacts { struct constructHeader header; struct expr *assertList; }; struct deffactsModule { struct defmoduleItemHeader header; }; #define DeffactsData(theEnv) ((struct deffactsData *) GetEnvironmentData(theEnv,DEFFACTS_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeDeffacts(void *); LOCALE void *EnvFindDeffacts(void *,const char *); LOCALE void *EnvFindDeffactsInModule(void *,const char *); LOCALE void *EnvGetNextDeffacts(void *,void *); LOCALE void CreateInitialFactDeffacts(void); LOCALE intBool EnvIsDeffactsDeletable(void *,void *); LOCALE struct deffactsModule *GetDeffactsModuleItem(void *,struct defmodule *); LOCALE const char *EnvDeffactsModule(void *,void *); LOCALE const char *EnvGetDeffactsName(void *,void *); LOCALE const char *EnvGetDeffactsPPForm(void *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void *FindDeffacts(const char *); LOCALE void *GetNextDeffacts(void *); LOCALE intBool IsDeffactsDeletable(void *); LOCALE const char *DeffactsModule(void *); LOCALE const char *GetDeffactsName(void *); LOCALE const char *GetDeffactsPPForm(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_dffctdef */ clips_core_source_630/core/tmpltpsr.h0000755000175000017500000000465512373754332016312 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Support for deftemplate slot facets. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_tmpltpsr #define _H_tmpltpsr #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDeftemplate(void *,const char *); LOCALE void InstallDeftemplate(void *,struct deftemplate *); #endif /* _H_tmpltpsr */ clips_core_source_630/core/moduldef.h0000755000175000017500000002654312424473404016217 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* DEFMODULE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defmodule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defmodule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_moduldef #define _H_moduldef struct defmodule; struct portItem; struct defmoduleItemHeader; struct moduleItem; #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_modulpsr #include "modulpsr.h" #endif #ifndef _H_utility #include "utility.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif /**********************************************************************/ /* defmodule */ /* ---------- */ /* name: The name of the defmodule (stored as a reference in the */ /* table). */ /* */ /* ppForm: The pretty print representation of the defmodule (used by */ /* the save and ppdefmodule commands). */ /* */ /* itemsArray: An array of pointers to the module specific data used */ /* by each construct specified with the RegisterModuleItem */ /* function. The data pointer stored in the array is allocated by */ /* the allocateFunction in moduleItem data structure. */ /* */ /* importList: The list of items which are being imported by this */ /* module from other modules. */ /* */ /* next: A pointer to the next defmodule data structure. */ /**********************************************************************/ struct defmodule { struct symbolHashNode *name; char *ppForm; struct defmoduleItemHeader **itemsArray; struct portItem *importList; struct portItem *exportList; unsigned visitedFlag; long bsaveID; struct userData *usrData; struct defmodule *next; }; struct portItem { struct symbolHashNode *moduleName; struct symbolHashNode *constructType; struct symbolHashNode *constructName; struct portItem *next; }; struct defmoduleItemHeader { struct defmodule *theModule; struct constructHeader *firstItem; struct constructHeader *lastItem; }; #define MIHS (struct defmoduleItemHeader *) /**********************************************************************/ /* moduleItem */ /* ---------- */ /* name: The name of the construct which can be placed in a module. */ /* For example, "defrule". */ /* */ /* allocateFunction: Used to allocate a data structure containing all */ /* pertinent information related to a specific construct for a */ /* given module. For example, the deffacts construct stores a */ /* pointer to the first and last deffacts for each each module. */ /* */ /* freeFunction: Used to deallocate a data structure allocated by */ /* the allocateFunction. In addition, the freeFunction deletes */ /* all constructs of the specified type in the given module. */ /* */ /* bloadModuleReference: Used during a binary load to establish a */ /* link between the defmodule data structure and the data structure */ /* containing all pertinent module information for a specific */ /* construct. */ /* */ /* findFunction: Used to determine if a specified construct is in a */ /* specific module. The name is the specific construct is passed as */ /* a string and the function returns a pointer to the specified */ /* construct if it exists. */ /* */ /* exportable: If TRUE, then the specified construct type can be */ /* exported (and hence imported). If FALSE, it can't be exported. */ /* */ /* next: A pointer to the next moduleItem data structure. */ /**********************************************************************/ struct moduleItem { const char *name; int moduleIndex; void *(*allocateFunction)(void *); void (*freeFunction)(void *,void *); void *(*bloadModuleReference)(void *,int); void (*constructsToCModuleReference)(void *,FILE *,int,int,int); void *(*findFunction)(void *,const char *); struct moduleItem *next; }; typedef struct moduleStackItem { intBool changeFlag; struct defmodule *theModule; struct moduleStackItem *next; } MODULE_STACK_ITEM; #define DEFMODULE_DATA 4 struct defmoduleData { struct moduleItem *LastModuleItem; struct callFunctionItem *AfterModuleChangeFunctions; MODULE_STACK_ITEM *ModuleStack; intBool CallModuleChangeFunctions; struct defmodule *ListOfDefmodules; struct defmodule *CurrentModule; struct defmodule *LastDefmodule; int NumberOfModuleItems; struct moduleItem *ListOfModuleItems; long ModuleChangeIndex; int MainModuleRedefinable; #if (! RUN_TIME) && (! BLOAD_ONLY) struct portConstructItem *ListOfPortConstructItems; long NumberOfDefmodules; struct callFunctionItem *AfterModuleDefinedFunctions; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefmoduleCodeItem; #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) long BNumberOfDefmodules; long NumberOfPortItems; struct portItem *PortItemArray; struct defmodule *DefmoduleArray; #endif }; #define DefmoduleData(theEnv) ((struct defmoduleData *) GetEnvironmentData(theEnv,DEFMODULE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeDefmodules(void *); LOCALE void *EnvFindDefmodule(void *,const char *); LOCALE const char *EnvGetDefmoduleName(void *,void *); LOCALE const char *EnvGetDefmodulePPForm(void *,void *); LOCALE void *EnvGetNextDefmodule(void *,void *); LOCALE void RemoveAllDefmodules(void *); LOCALE int AllocateModuleStorage(void); LOCALE int RegisterModuleItem(void *,const char *, void *(*)(void *), void (*)(void *,void *), void *(*)(void *,int), void (*)(void *,FILE *,int,int,int), void *(*)(void *,const char *)); LOCALE void *GetModuleItem(void *,struct defmodule *,int); LOCALE void SetModuleItem(void *,struct defmodule *,int,void *); LOCALE void *EnvGetCurrentModule(void *); LOCALE void *EnvSetCurrentModule(void *,void *); LOCALE void *GetCurrentModuleCommand(void *); LOCALE void *SetCurrentModuleCommand(void *); LOCALE int GetNumberOfModuleItems(void *); LOCALE void CreateMainModule(void *); LOCALE void SetListOfDefmodules(void *,void *); LOCALE struct moduleItem *GetListOfModuleItems(void *); LOCALE struct moduleItem *FindModuleItem(void *,const char *); LOCALE void SaveCurrentModule(void *); LOCALE void RestoreCurrentModule(void *); LOCALE void AddAfterModuleChangeFunction(void *,const char *,void (*)(void *),int); LOCALE void IllegalModuleSpecifierMessage(void *); LOCALE void AllocateDefmoduleGlobals(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void *FindDefmodule(const char *); LOCALE void *GetCurrentModule(void); LOCALE const char *GetDefmoduleName(void *); LOCALE const char *GetDefmodulePPForm(void *); LOCALE void *GetNextDefmodule(void *); LOCALE void *SetCurrentModule(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_moduldef */ clips_core_source_630/core/insmoddp.h0000755000175000017500000000730512373756343016241 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* INSTANCE MODIFY AND DUPLICATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* 6.30: Added DATA_OBJECT_ARRAY primitive type. */ /* */ /* Changed integer type/precision. */ /* */ /* The return value of DirectMessage indicates */ /* whether an execution error has occurred. */ /* */ /*************************************************************/ #ifndef _H_insmoddp #define _H_insmoddp #define DIRECT_MODIFY_STRING "direct-modify" #define MSG_MODIFY_STRING "message-modify" #define DIRECT_DUPLICATE_STRING "direct-duplicate" #define MSG_DUPLICATE_STRING "message-duplicate" #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSMODDP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if (! RUN_TIME) LOCALE void SetupInstanceModDupCommands(void *); #endif LOCALE void ModifyInstance(void *,DATA_OBJECT *); LOCALE void MsgModifyInstance(void *,DATA_OBJECT *); LOCALE void DuplicateInstance(void *,DATA_OBJECT *); LOCALE void MsgDuplicateInstance(void *,DATA_OBJECT *); #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void InactiveModifyInstance(void *,DATA_OBJECT *); LOCALE void InactiveMsgModifyInstance(void *,DATA_OBJECT *); LOCALE void InactiveDuplicateInstance(void *,DATA_OBJECT *); LOCALE void InactiveMsgDuplicateInstance(void *,DATA_OBJECT *); #endif LOCALE void DirectModifyMsgHandler(void *,DATA_OBJECT *); LOCALE void MsgModifyMsgHandler(void *,DATA_OBJECT *); LOCALE void DirectDuplicateMsgHandler(void *,DATA_OBJECT *); LOCALE void MsgDuplicateMsgHandler(void *,DATA_OBJECT *); #endif /* _H_insmoddp */ clips_core_source_630/core/agenda.c0000755000175000017500000014157112424473433015633 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* AGENDA MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Provides functionality for examining, manipulating, */ /* adding, and removing activations from the agenda. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* and DYNAMIC_SALIENCE compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvGetActivationBasisPPForm function. */ /* */ /* 6.30: Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /* Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _AGENDA_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "argacces.h" #include "constant.h" #include "crstrtgy.h" #include "engine.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "moduldef.h" #include "modulutl.h" #include "multifld.h" #include "reteutil.h" #include "retract.h" #include "router.h" #include "rulebsc.h" #include "ruledef.h" #include "strngrtr.h" #include "sysdep.h" #include "watch.h" #include "agenda.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void PrintActivation(void *,const char *,void *); static void AgendaClearFunction(void *); static const char *SalienceEvaluationName(int); static int EvaluateSalience(void *,void *); static struct salienceGroup *ReuseOrCreateSalienceGroup(void *,struct defruleModule *,int); static struct salienceGroup *FindSalienceGroup(struct defruleModule *,int); static void RemoveActivationFromGroup(void *,struct activation *,struct defruleModule *); /*************************************************/ /* InitializeAgenda: Initializes the activations */ /* watch item and the H/L commands for */ /* manipulating the agenda. */ /*************************************************/ globle void InitializeAgenda( void *theEnv) { AllocateEnvironmentData(theEnv,AGENDA_DATA,sizeof(struct agendaData),NULL); AgendaData(theEnv)->SalienceEvaluation = WHEN_DEFINED; AgendaData(theEnv)->Strategy = DEFAULT_STRATEGY; EnvAddClearFunction(theEnv,"agenda",AgendaClearFunction,0); #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"activations",1,&AgendaData(theEnv)->WatchActivations,40,DefruleWatchAccess,DefruleWatchPrint); #endif #if ! RUN_TIME EnvDefineFunction2(theEnv,"refresh", 'v', PTIEF RefreshCommand, "RefreshCommand", "11w"); EnvDefineFunction2(theEnv,"refresh-agenda",'v', PTIEF RefreshAgendaCommand,"RefreshAgendaCommand", "01w"); EnvDefineFunction2(theEnv,"get-salience-evaluation",'w', PTIEF GetSalienceEvaluationCommand, "GetSalienceEvaluationCommand", "00"); EnvDefineFunction2(theEnv,"set-salience-evaluation",'w', PTIEF SetSalienceEvaluationCommand, "SetSalienceEvaluationCommand", "11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"agenda", 'v', PTIEF AgendaCommand, "AgendaCommand", "01w"); #endif #endif } /*****************************************************************/ /* AddActivation: Creates a rule activation to be added to the */ /* Agenda and links the activation with its associated partial */ /* match. The function PlaceActivation is then called to place */ /* the activation on the Agenda. Typically called when all */ /* patterns on the LHS of a rule have been satisfied. */ /*****************************************************************/ globle void AddActivation( void *theEnv, void *vTheRule, void *vBinds) { struct activation *newActivation; struct defrule *theRule = (struct defrule *) vTheRule; struct partialMatch *binds = (struct partialMatch *) vBinds; struct defruleModule *theModuleItem; struct salienceGroup *theGroup; /*=======================================*/ /* Focus on the module if the activation */ /* is from an auto-focus rule. */ /*=======================================*/ if (theRule->autoFocus) { EnvFocus(theEnv,(void *) theRule->header.whichModule->theModule); } /*=======================================================*/ /* Create the activation. The activation stores pointers */ /* to its associated partial match and defrule. The */ /* activation is given a time tag, its salience is */ /* evaluated, and it is assigned a random number for use */ /* with the random conflict resolution strategy. */ /*=======================================================*/ newActivation = get_struct(theEnv,activation); newActivation->theRule = theRule; newActivation->basis = binds; newActivation->timetag = AgendaData(theEnv)->CurrentTimetag++; newActivation->salience = EvaluateSalience(theEnv,theRule); newActivation->randomID = genrand(); newActivation->prev = NULL; newActivation->next = NULL; AgendaData(theEnv)->NumberOfActivations++; /*=======================================================*/ /* Point the partial match to the activation to complete */ /* the link between the join network and the agenda. */ /*=======================================================*/ binds->marker = (void *) newActivation; /*====================================================*/ /* If activations are being watch, display a message. */ /*====================================================*/ #if DEBUGGING_FUNCTIONS if (newActivation->theRule->watchActivation) { EnvPrintRouter(theEnv,WTRACE,"==> Activation "); PrintActivation(theEnv,WTRACE,(void *) newActivation); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=====================================*/ /* Place the activation on the agenda. */ /*=====================================*/ theModuleItem = (struct defruleModule *) theRule->header.whichModule; theGroup = ReuseOrCreateSalienceGroup(theEnv,theModuleItem,newActivation->salience); PlaceActivation(theEnv,&(theModuleItem->agenda),newActivation,theGroup); } /***************************************************************/ /* ReuseOrCreateSalienceGroup: */ /***************************************************************/ static struct salienceGroup *ReuseOrCreateSalienceGroup( void *theEnv, struct defruleModule *theRuleModule, int salience) { struct salienceGroup *theGroup, *lastGroup, *newGroup; for (lastGroup = NULL, theGroup = theRuleModule->groupings; theGroup != NULL; lastGroup = theGroup, theGroup = theGroup->next) { if (theGroup->salience == salience) { return(theGroup); } if (theGroup->salience < salience) { break; } } newGroup = get_struct(theEnv,salienceGroup); newGroup->salience = salience; newGroup->first = NULL; newGroup->last = NULL; newGroup->next = theGroup; newGroup->prev = lastGroup; if (newGroup->next != NULL) { newGroup->next->prev = newGroup; } if (newGroup->prev != NULL) { newGroup->prev->next = newGroup; } if (lastGroup == NULL) { theRuleModule->groupings = newGroup; } return newGroup; } /***************************************************************/ /* FindSalienceGroup: */ /***************************************************************/ static struct salienceGroup *FindSalienceGroup( struct defruleModule *theRuleModule, int salience) { struct salienceGroup *theGroup; for (theGroup = theRuleModule->groupings; theGroup != NULL; theGroup = theGroup->next) { if (theGroup->salience == salience) { return(theGroup); } if (theGroup->salience < salience) { break; } } return NULL; } /***************************************************************/ /* ClearRuleFromAgenda: Clears the agenda of a specified rule. */ /***************************************************************/ globle void ClearRuleFromAgenda( void *theEnv, void *vTheRule) { struct defrule *theRule = (struct defrule *) vTheRule; struct defrule *tempRule; struct activation *agendaPtr, *agendaNext; /*============================================*/ /* Get a pointer to the agenda for the module */ /* in which the rule is contained. */ /*============================================*/ agendaPtr = ((struct defruleModule *) theRule->header.whichModule)->agenda; /*==============================================*/ /* Loop through every activation on the agenda. */ /*==============================================*/ while (agendaPtr != NULL) { agendaNext = agendaPtr->next; /*========================================================*/ /* Check each disjunct of the rule against the activation */ /* to determine if the activation points to the rule. If */ /* it does, then remove the activation from the agenda. */ /*========================================================*/ for (tempRule = theRule; tempRule != NULL; tempRule = tempRule->disjunct) { if (agendaPtr->theRule == tempRule) { RemoveActivation(theEnv,agendaPtr,TRUE,TRUE); break; } } agendaPtr = agendaNext; } } /****************************************************************/ /* EnvGetNextActivation: Returns an activation from the Agenda. */ /* If its argument is NULL, then the first activation on the */ /* Agenda is returned. If its argument is not NULL, the next */ /* activation after the argument is returned. */ /****************************************************************/ globle void *EnvGetNextActivation( void *theEnv, void *actPtr) { struct defruleModule *theModuleItem; if (actPtr == NULL) { theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,NULL,DefruleData(theEnv)->DefruleModuleIndex); if (theModuleItem == NULL) return(NULL); return((void *) theModuleItem->agenda); } else { return((void *) (((struct activation *) actPtr)->next)); } } /***********************************************/ /* EnvGetActivationBasis: Returns the basis of */ /* the rule associated with an activation. */ /***********************************************/ globle struct partialMatch *EnvGetActivationBasis( void *theEnv, void *actPtr) { #if MAC_XCD #pragma unused(theEnv) #endif return ((struct activation *) actPtr)->basis; } /*********************************************/ /* EnvGetActivationName: Returns the name of */ /* the rule associated with an activation. */ /*********************************************/ globle const char *EnvGetActivationName( void *theEnv, void *actPtr) { #if MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(((struct activation *) actPtr)->theRule->header.name)); } /******************************************/ /* EnvGetActivationRule: Returns the rule */ /* associated with an activation. */ /******************************************/ globle struct defrule *EnvGetActivationRule( void *theEnv, void *actPtr) { #if MAC_XCD #pragma unused(theEnv) #endif return ((struct activation *) actPtr)->theRule; } /**************************************************/ /* EnvGetActivationSalience: Returns the salience */ /* of the rule associated with an activation. */ /**************************************************/ globle int EnvGetActivationSalience( void *theEnv, void *actPtr) { #if MAC_XCD #pragma unused(theEnv) #endif return ((struct activation *) actPtr)->salience; } /**************************************/ /* EnvSetActivationSalience: Sets the */ /* salience value of an activation. */ /**************************************/ globle int EnvSetActivationSalience( void *theEnv, void *actPtr, int value) { int temp; #if MAC_XCD #pragma unused(theEnv) #endif temp = ((struct activation *) actPtr)->salience; ((struct activation *) actPtr)->salience = value; return(temp); } /**********************************************/ /* EnvGetActivationPPForm: Returns the pretty */ /* print representation of an activation. */ /**********************************************/ globle void EnvGetActivationPPForm( void *theEnv, char *buffer, size_t bufferLength, void *theActivation) { OpenStringDestination(theEnv,"ActPPForm",buffer,bufferLength); PrintActivation(theEnv,"ActPPForm",(void *) theActivation); CloseStringDestination(theEnv,"ActPPForm"); } /****************************************************/ /* EnvGetActivationBasisPPForm: Returns the pretty */ /* print representation of an activation's basis. */ /****************************************************/ globle void EnvGetActivationBasisPPForm( void *theEnv, char *buffer, size_t bufferLength, void *vTheActivation) { struct activation *theActivation = (struct activation *) vTheActivation; OpenStringDestination(theEnv,"ActPPForm",buffer,bufferLength); PrintPartialMatch(theEnv,"ActPPForm",theActivation->basis); CloseStringDestination(theEnv,"ActPPForm"); } /********************************************/ /* MoveActivationToTop: Moves the specified */ /* activation to the top of the agenda. */ /********************************************/ globle intBool MoveActivationToTop( void *theEnv, void *vtheActivation) { struct activation *prevPtr; struct activation *theActivation = (struct activation *) vtheActivation; struct defruleModule *theModuleItem; /*====================================*/ /* Determine the module of the agenda */ /* in which the activation is stored. */ /*====================================*/ theModuleItem = (struct defruleModule *) theActivation->theRule->header.whichModule; /*============================================*/ /* If the activation is already at the top of */ /* the agenda, then nothing needs to be done. */ /*============================================*/ if (theActivation == theModuleItem->agenda) return(FALSE); /*=================================================*/ /* Update the pointers of the activation preceding */ /* and following the activation being moved. */ /*=================================================*/ prevPtr = theActivation->prev; prevPtr->next = theActivation->next; if (theActivation->next != NULL) theActivation->next->prev = prevPtr; /*=======================================================*/ /* Move the activation and then update its pointers, the */ /* pointers of the activation following it, and the */ /* module pointer to the top activation on the agenda. */ /*=======================================================*/ theActivation->next = theModuleItem->agenda; theModuleItem->agenda->prev = theActivation; theActivation->prev = NULL; theModuleItem->agenda = theActivation; /*=============================*/ /* Mark the agenda as changed. */ /*=============================*/ AgendaData(theEnv)->AgendaChanged = TRUE; return(TRUE); } /**********************************************/ /* EnvDeleteActivation: Removes the specified */ /* activation from the agenda. */ /**********************************************/ globle intBool EnvDeleteActivation( void *theEnv, void *theActivation) { if (theActivation == NULL) RemoveAllActivations(theEnv); else RemoveActivation(theEnv,(struct activation *) theActivation,TRUE,TRUE); return(TRUE); } /*******************************************************/ /* DetachActivation: Detaches the specified activation */ /* from the list of activations on the Agenda. */ /*******************************************************/ globle intBool DetachActivation( void *theEnv, void *vTheActivation) { struct defruleModule *theModuleItem; struct activation *theActivation = (struct activation *) vTheActivation; /*============================*/ /* A NULL pointer is invalid. */ /*============================*/ if (theActivation == NULL) SystemError(theEnv,"AGENDA",1); /*====================================*/ /* Determine the module of the agenda */ /* in which the activation is stored. */ /*====================================*/ theModuleItem = (struct defruleModule *) theActivation->theRule->header.whichModule; RemoveActivationFromGroup(theEnv,theActivation,theModuleItem); /*========================================================*/ /* If the activation is the top activation on the agenda, */ /* then update the module pointer to agenda. */ /*========================================================*/ if (theActivation == theModuleItem->agenda) { theModuleItem->agenda = theActivation->next; } /*==================================================*/ /* Update the pointers in the preceding activation. */ /*==================================================*/ if (theActivation->prev != NULL) { theActivation->prev->next = theActivation->next; } /*==================================================*/ /* Update the pointers in the following activation. */ /*==================================================*/ if (theActivation->next != NULL) { theActivation->next->prev = theActivation->prev; } /*=================================================*/ /* Update the pointers in the detached activation. */ /*=================================================*/ theActivation->prev = NULL; theActivation->next = NULL; /*=============================*/ /* Mark the agenda as changed. */ /*=============================*/ AgendaData(theEnv)->AgendaChanged = TRUE; return(TRUE); } /****************************************************************************/ /* PrintActivation: Prints an activation in a "pretty" format. Salience, */ /* rule name, and the partial match which activated the rule are printed. */ /****************************************************************************/ static void PrintActivation( void *theEnv, const char *logicalName, void *vTheActivation) { struct activation *theActivation = (struct activation *) vTheActivation; char printSpace[20]; gensprintf(printSpace,"%-6d ",theActivation->salience); EnvPrintRouter(theEnv,logicalName,printSpace); EnvPrintRouter(theEnv,logicalName,ValueToString(theActivation->theRule->header.name)); EnvPrintRouter(theEnv,logicalName,": "); PrintPartialMatch(theEnv,logicalName,theActivation->basis); } /*******************************/ /* EnvAgenda: C access routine */ /* for the agenda command. */ /*******************************/ globle void EnvAgenda( void *theEnv, const char *logicalName, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; ListItemsDriver(theEnv,logicalName,theModule,"activation","activations", EnvGetNextActivation,NULL,PrintActivation,NULL); } /*******************************************************************/ /* RemoveActivation: Returns an activation and its associated data */ /* structures to the Memory Manager. Links to other activations */ /* and partial matches may also be updated. */ /*******************************************************************/ globle void RemoveActivation( void *theEnv, void *vTheActivation, int updateAgenda, int updateLinks) { struct defruleModule *theModuleItem; struct activation *theActivation = (struct activation *) vTheActivation; /*====================================*/ /* Determine the module of the agenda */ /* in which the activation is stored. */ /*====================================*/ theModuleItem = (struct defruleModule *) theActivation->theRule->header.whichModule; /*=================================*/ /* Update the agenda if necessary. */ /*=================================*/ if (updateAgenda == TRUE) { RemoveActivationFromGroup(theEnv,theActivation,theModuleItem); /*===============================================*/ /* Update the pointer links between activations. */ /*===============================================*/ if (theActivation->prev == NULL) { theModuleItem->agenda = theModuleItem->agenda->next; if (theModuleItem->agenda != NULL) theModuleItem->agenda->prev = NULL; } else { theActivation->prev->next = theActivation->next; if (theActivation->next != NULL) { theActivation->next->prev = theActivation->prev; } } /*===================================*/ /* Indicate removal of activation if */ /* activations are being watched. */ /*===================================*/ #if DEBUGGING_FUNCTIONS if (theActivation->theRule->watchActivation) { EnvPrintRouter(theEnv,WTRACE,"<== Activation "); PrintActivation(theEnv,WTRACE,(void *) theActivation); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=============================*/ /* Mark the agenda as changed. */ /*=============================*/ AgendaData(theEnv)->AgendaChanged = TRUE; } /*============================================*/ /* Update join and agenda links if necessary. */ /*============================================*/ if ((updateLinks == TRUE) && (theActivation->basis != NULL)) { theActivation->basis->marker = NULL; } /*================================================*/ /* Return the activation to the free memory pool. */ /*================================================*/ AgendaData(theEnv)->NumberOfActivations--; rtn_struct(theEnv,activation,theActivation); } /**************************************************************/ /* RemoveActivationFromGroup: */ /**************************************************************/ static void RemoveActivationFromGroup( void *theEnv, struct activation *theActivation, struct defruleModule *theRuleModule) { struct salienceGroup *theGroup; theGroup = FindSalienceGroup(theRuleModule,theActivation->salience); if (theGroup == NULL) return; if (theActivation == theGroup->first) { /*====================================================*/ /* If the activation is the only remaining activation */ /* in the group, then the group needs to be removed. */ /*====================================================*/ if (theActivation == theGroup->last) { if (theGroup->prev == NULL) { theRuleModule->groupings = theGroup->next; } else { theGroup->prev->next = theGroup->next; } if (theGroup->next != NULL) { theGroup->next->prev = theGroup->prev; } rtn_struct(theEnv,salienceGroup,theGroup); } /*======================================================*/ /* Otherwise this is the first activation in the group, */ /* but there are other activations which follow. */ /*======================================================*/ else { theGroup->first = theActivation->next; } } else { /*====================================================*/ /* Otherwise if the activation isn't the first in the */ /* group, then check to see if it's the last. */ /*====================================================*/ if (theActivation == theGroup->last) { theGroup->last = theActivation->prev; } /*==================================================*/ /* Otherwise the activation is in the middle of the */ /* group and no first/last updates are needed. */ /*==================================================*/ else { return; } } } /**************************************************************/ /* AgendaClearFunction: Agenda clear routine for use with the */ /* clear command. Resets the current time tag to zero. */ /**************************************************************/ static void AgendaClearFunction( void *theEnv) { AgendaData(theEnv)->CurrentTimetag = 0; } /*************************************************/ /* RemoveAllActivations: Removes all activations */ /* from the agenda of the current module. */ /*************************************************/ globle void RemoveAllActivations( void *theEnv) { struct activation *tempPtr, *theActivation; struct salienceGroup *theGroup, *tempGroup; theActivation = GetDefruleModuleItem(theEnv,NULL)->agenda; while (theActivation != NULL) { tempPtr = theActivation->next; RemoveActivation(theEnv,theActivation,TRUE,TRUE); theActivation = tempPtr; } theGroup = GetDefruleModuleItem(theEnv,NULL)->groupings; while (theGroup != NULL) { tempGroup = theGroup->next; rtn_struct(theEnv,salienceGroup,theGroup); theGroup = tempGroup; } } /*********************************************************/ /* EnvGetAgendaChanged: Returns the value of the boolean */ /* flag which indicates whether any changes have been */ /* made to the agenda. */ /*********************************************************/ globle int EnvGetAgendaChanged( void *theEnv) { return(AgendaData(theEnv)->AgendaChanged); } /*****************************************************************/ /* EnvSetAgendaChanged: Sets the value of the boolean flag which */ /* indicates whether any changes have been made to the agenda. */ /*****************************************************************/ globle void EnvSetAgendaChanged( void *theEnv, int value) { AgendaData(theEnv)->AgendaChanged = value; } /**********************************************************/ /* EnvReorderAgenda: Completely reorders the agenda based */ /* on the current conflict resolution strategy. */ /**********************************************************/ globle void EnvReorderAgenda( void *theEnv, void *vTheModule) { struct activation *theActivation, *tempPtr; struct defmodule *theModule = (struct defmodule *) vTheModule; int allModules = FALSE; struct defruleModule *theModuleItem; struct salienceGroup *theGroup, *tempGroup; /*=============================================*/ /* If the module specified is a NULL pointer, */ /* then every module has its agenda reordered. */ /*=============================================*/ if (theModule == NULL) { allModules = TRUE; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); } /*========================*/ /* Reorder the agenda(s). */ /*========================*/ for (; theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=================================*/ /* Get the list of activations and */ /* remove them from the agenda. */ /*=================================*/ theModuleItem = GetDefruleModuleItem(theEnv,theModule); theActivation = theModuleItem->agenda; theModuleItem->agenda = NULL; theGroup = theModuleItem->groupings; while (theGroup != NULL) { tempGroup = theGroup->next; rtn_struct(theEnv,salienceGroup,theGroup); theGroup = tempGroup; } theModuleItem->groupings = NULL; /*=========================================*/ /* Reorder the activations by placing them */ /* back on the agenda one by one. */ /*=========================================*/ while (theActivation != NULL) { tempPtr = theActivation->next; theActivation->next = NULL; theActivation->prev = NULL; theGroup = ReuseOrCreateSalienceGroup(theEnv,theModuleItem,theActivation->salience); PlaceActivation(theEnv,&(theModuleItem->agenda),theActivation,theGroup); theActivation = tempPtr; } /*===============================================*/ /* Return if only one agenda is being reordered. */ /*===============================================*/ if (! allModules) return; } } /****************************************************/ /* GetNumberOfActivations: Returns the value of the */ /* total number of activations on all agendas. */ /****************************************************/ globle unsigned long GetNumberOfActivations( void *theEnv) { return(AgendaData(theEnv)->NumberOfActivations); } /******************************************************/ /* RefreshCommand: H/L Command for refreshing a rule. */ /* Syntax: (refresh ) */ /******************************************************/ globle void RefreshCommand( void *theEnv) { const char *ruleName; void *rulePtr; /*===========================*/ /* Get the name of the rule. */ /*===========================*/ ruleName = GetConstructName(theEnv,"refresh","rule name"); if (ruleName == NULL) return; /*===============================*/ /* Determine if the rule exists. */ /*===============================*/ rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } /*===================*/ /* Refresh the rule. */ /*===================*/ EnvRefresh(theEnv,rulePtr); } /************************************************************/ /* EnvRefresh: Refreshes a defrule. Activations of the rule */ /* that have already been fired are added to the agenda. */ /************************************************************/ globle intBool EnvRefresh( void *theEnv, void *theRule) { struct defrule *rulePtr; struct partialMatch *listOfMatches; unsigned long b; /*====================================*/ /* Refresh each disjunct of the rule. */ /*====================================*/ for (rulePtr = (struct defrule *) theRule; rulePtr != NULL; rulePtr = rulePtr->disjunct) { /*================================*/ /* Check each partial match that */ /* satisfies the LHS of the rule. */ /*================================*/ for (b = 0; b < rulePtr->lastJoin->leftMemory->size; b++) { for (listOfMatches = rulePtr->lastJoin->leftMemory->beta[b]; listOfMatches != NULL; listOfMatches = listOfMatches->nextInMemory) { /*=======================================================*/ /* If the partial match is associated with an activation */ /* (which it should always be), then place a new */ /* activation on the agenda if this partial matchdoesn't */ /* have an activation associated with it. */ /*=======================================================*/ if (((struct joinNode *) listOfMatches->owner)->ruleToActivate != NULL) { if (listOfMatches->marker == NULL) { AddActivation(theEnv,rulePtr,listOfMatches); } } } } } return(TRUE); } /**********************************************/ /* RefreshAgendaCommand: H/L access routine */ /* for the refresh-agenda command. */ /**********************************************/ globle void RefreshAgendaCommand( void *theEnv) { int numArgs, error; struct defmodule *theModule; /*==============================================*/ /* This function can have at most one argument. */ /*==============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"refresh-agenda",NO_MORE_THAN,1)) == -1) return; /*===============================================================*/ /* If a module name is specified, then the agenda of that module */ /* is refreshed. Otherwise, the agenda of the current module is */ /* refreshed. */ /*===============================================================*/ if (numArgs == 1) { theModule = GetModuleName(theEnv,"refresh-agenda",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*===============================================*/ /* Refresh the agenda of the appropriate module. */ /*===============================================*/ EnvRefreshAgenda(theEnv,theModule); } /**************************************/ /* EnvRefreshAgenda: C access routine */ /* for the refresh-agenda command. */ /**************************************/ globle void EnvRefreshAgenda( void *theEnv, void *vTheModule) { struct activation *theActivation; struct defmodule *theModule = (struct defmodule *) vTheModule; intBool oldValue; int allModules = FALSE; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=============================================*/ /* If the module specified is a NULL pointer, */ /* then every module has its agenda refreshed. */ /*=============================================*/ if (theModule == NULL) { allModules = TRUE; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); } /*=======================================================*/ /* Remember the current setting for salience evaluation. */ /* To perform the refresh, the when activated setting is */ /* used to recompute the salience values. */ /*=======================================================*/ oldValue = EnvGetSalienceEvaluation(theEnv); EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED); /*========================*/ /* Refresh the agenda(s). */ /*========================*/ for (; theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================================*/ /* Change the current module to the module */ /* of the agenda being refreshed. */ /*=========================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*================================================================*/ /* Recompute the salience values for the current module's agenda. */ /*================================================================*/ for (theActivation = (struct activation *) EnvGetNextActivation(theEnv,NULL); theActivation != NULL; theActivation = (struct activation *) EnvGetNextActivation(theEnv,theActivation)) { theActivation->salience = EvaluateSalience(theEnv,theActivation->theRule); } /*======================================================*/ /* Reorder the agenda based on the new salience values. */ /*======================================================*/ EnvReorderAgenda(theEnv,theModule); /*===============================================*/ /* Return if only one agenda is being refreshed. */ /*===============================================*/ if (! allModules) { EnvSetSalienceEvaluation(theEnv,oldValue); RestoreCurrentModule(theEnv); return; } } /*==========================================*/ /* Restore the salience evaluation setting. */ /*==========================================*/ EnvSetSalienceEvaluation(theEnv,oldValue); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*********************************************************/ /* SetSalienceEvaluationCommand: H/L Command for setting */ /* the salience evaluation behavior. */ /* Syntax: (set-salience-evaluation-behavior ) */ /*********************************************************/ globle void *SetSalienceEvaluationCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; const char *oldValue; /*==================================================*/ /* Get the current setting for salience evaluation. */ /*==================================================*/ oldValue = SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv)); /*=========================================*/ /* This function expects a single argument */ /* which must be a symbol. */ /*=========================================*/ if (EnvArgCountCheck(theEnv,"set-salience-evaluation",EXACTLY,1) == -1) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } if (EnvArgTypeCheck(theEnv,"set-salience-evaluation",1,SYMBOL,&argPtr) == FALSE) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } /*=============================================================*/ /* The allowed symbols to pass as an argument to this function */ /* are when-defined, when-activated, and every-cycle. */ /*=============================================================*/ argument = DOToString(argPtr); if (strcmp(argument,"when-defined") == 0) { EnvSetSalienceEvaluation(theEnv,WHEN_DEFINED); } else if (strcmp(argument,"when-activated") == 0) { EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED); } else if (strcmp(argument,"every-cycle") == 0) { EnvSetSalienceEvaluation(theEnv,EVERY_CYCLE); } else { ExpectedTypeError1(theEnv,"set-salience-evaluation",1, "symbol with value when-defined, when-activated, or every-cycle"); return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } /*=================================================*/ /* Return the old setting for salience evaluation. */ /*=================================================*/ return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } /*********************************************************/ /* GetSalienceEvaluationCommand: H/L Command for getting */ /* the salience evaluation behavior. */ /* Syntax: (get-salience-evaluation-behavior) */ /*********************************************************/ globle void *GetSalienceEvaluationCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-salience-evaluation",EXACTLY,0); return((SYMBOL_HN *) EnvAddSymbol(theEnv,SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv)))); } /*****************************************************************/ /* SalienceEvaluationName: Given the integer value corresponding */ /* to a specified salience evaluation behavior, returns a */ /* character string of the behavior's name. */ /*****************************************************************/ static const char *SalienceEvaluationName( int strategy) { const char *sname; switch (strategy) { case WHEN_DEFINED: sname = "when-defined"; break; case WHEN_ACTIVATED: sname = "when-activated"; break; case EVERY_CYCLE: sname = "every-cycle"; break; default: sname = "unknown"; break; } return(sname); } /****************************************************************/ /* EnvGetSalienceEvaluation: Returns the value of current type */ /* of salience evaluation (e.g., when defined, when activated, */ /* or every cycle). */ /****************************************************************/ globle intBool EnvGetSalienceEvaluation( void *theEnv) { return(AgendaData(theEnv)->SalienceEvaluation); } /***********************************************/ /* EnvSetSalienceEvaluation: Sets the value of */ /* the current type of salience evaluation. */ /***********************************************/ globle intBool EnvSetSalienceEvaluation( void *theEnv, int value) { int ov; ov = AgendaData(theEnv)->SalienceEvaluation; AgendaData(theEnv)->SalienceEvaluation = value; return(ov); } /*****************************************************************/ /* EvaluateSalience: Returns the salience value of the specified */ /* defrule. If salience evaluation is currently set to */ /* when-defined, then the current value of the rule's salience */ /* is returned. Otherwise the salience expression associated */ /* with the rule is reevaluated, the value is stored as the */ /* rule's current salience, and it is then returned. */ /*****************************************************************/ static int EvaluateSalience( void *theEnv, void *vPtr) { struct defrule *rPtr = (struct defrule *) vPtr; DATA_OBJECT salienceValue; int salience; /*==================================================*/ /* If saliences are only being evaluated when rules */ /* are defined, then just return the last salience */ /* value evaluated for the rule. */ /*==================================================*/ if (EnvGetSalienceEvaluation(theEnv) == WHEN_DEFINED) { return(rPtr->salience); } /*=================================================================*/ /* If the rule's salience value was defined as an integer constant */ /* (i.e., not an expression or global variable which could change */ /* on reevaluation), then just return the salience value computed */ /* for the rule when it was defined. */ /*=================================================================*/ if (rPtr->dynamicSalience == NULL) return(rPtr->salience); /*====================================================*/ /* Reevaluate the rule's salience. If an error occurs */ /* during evaluation, print an error message. */ /*====================================================*/ SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,rPtr->dynamicSalience,&salienceValue)) { SalienceInformationError(theEnv,"defrule",ValueToString(rPtr->header.name)); return(rPtr->salience); } /*========================================*/ /* The salience value must be an integer. */ /*========================================*/ if (salienceValue.type != INTEGER) { SalienceNonIntegerError(theEnv); SalienceInformationError(theEnv,"defrule",ValueToString(rPtr->header.name)); SetEvaluationError(theEnv,TRUE); return(rPtr->salience); } /*==========================================*/ /* The salience value must fall between the */ /* minimum and maximum allowed values. */ /*==========================================*/ salience = (int) ValueToLong(salienceValue.value); if ((salience > MAX_DEFRULE_SALIENCE) || (salience < MIN_DEFRULE_SALIENCE)) { SalienceRangeError(theEnv,MIN_DEFRULE_SALIENCE,MAX_DEFRULE_SALIENCE); SetEvaluationError(theEnv,TRUE); SalienceInformationError(theEnv,"defrule",ValueToString(((struct defrule *) rPtr)->header.name)); return(rPtr->salience); } /*===================================*/ /* Store the new salience value with */ /* the rule and return this value. */ /*===================================*/ rPtr->salience = salience; return(rPtr->salience); } #if DEBUGGING_FUNCTIONS /***********************************************/ /* AgendaCommand: Prints out the agenda of the */ /* rules that are ready to fire. */ /* Syntax: (agenda) */ /***********************************************/ globle void AgendaCommand( void *theEnv) { int numArgs, error; struct defmodule *theModule; /*==============================================*/ /* This function can have at most one argument. */ /*==============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"agenda",NO_MORE_THAN,1)) == -1) return; /*===============================================================*/ /* If a module name is specified, then the agenda of that module */ /* is displayed. Otherwise, the agenda of the current module is */ /* displayed. */ /*===============================================================*/ if (numArgs == 1) { theModule = GetModuleName(theEnv,"agenda",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*===============================================*/ /* Display the agenda of the appropriate module. */ /*===============================================*/ EnvAgenda(theEnv,WDISPLAY,theModule); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void Agenda( const char *logicalName, void *vTheModule) { EnvAgenda(GetCurrentEnvironment(),logicalName,vTheModule); } globle intBool DeleteActivation( void *theActivation) { return EnvDeleteActivation(GetCurrentEnvironment(),theActivation); } globle struct partialMatch *GetActivationBasis( void *actPtr) { return EnvGetActivationBasis(GetCurrentEnvironment(),actPtr); } globle const char *GetActivationName( void *actPtr) { return EnvGetActivationName(GetCurrentEnvironment(),actPtr); } globle void GetActivationPPForm( char *buffer, unsigned bufferLength, void *theActivation) { EnvGetActivationPPForm(GetCurrentEnvironment(),buffer,bufferLength,theActivation); } globle struct defrule *GetActivationRule( void *actPtr) { return EnvGetActivationRule(GetCurrentEnvironment(),actPtr); } globle int GetActivationSalience( void *actPtr) { return EnvGetActivationSalience(GetCurrentEnvironment(),actPtr); } globle int GetAgendaChanged() { return EnvGetAgendaChanged(GetCurrentEnvironment()); } globle void *GetNextActivation( void *actPtr) { return EnvGetNextActivation(GetCurrentEnvironment(),actPtr); } globle intBool Refresh( void *theRule) { return EnvRefresh(GetCurrentEnvironment(),theRule); } globle void RefreshAgenda( void *vTheModule) { EnvRefreshAgenda(GetCurrentEnvironment(),vTheModule); } globle void ReorderAgenda( void *vTheModule) { EnvReorderAgenda(GetCurrentEnvironment(),vTheModule); } globle void SetAgendaChanged( int value) { EnvSetAgendaChanged(GetCurrentEnvironment(),value); } globle int SetActivationSalience( void *actPtr, int value) { return EnvSetActivationSalience(GetCurrentEnvironment(),actPtr,value); } globle intBool GetSalienceEvaluation() { return EnvGetSalienceEvaluation(GetCurrentEnvironment()); } globle intBool SetSalienceEvaluation( int value) { return EnvSetSalienceEvaluation(GetCurrentEnvironment(),value); } #endif #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/crstrtgy.h0000755000175000017500000000702112373714233016270 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONFLICT RESOLUTION STRATEGY HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Used to determine where a new activation is */ /* placed on the agenda based on the current conflict */ /* resolution strategy (depth, breadth, mea, lex, */ /* simplicity, or complexity). Also provides the */ /* set-strategy and get-strategy commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /* 6.30: Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /* Removed pseudo-facts used for not CEs. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_crstrtgy #define _H_crstrtgy #include "agenda.h" #include "symbol.h" #define DEPTH_STRATEGY 0 #define BREADTH_STRATEGY 1 #define LEX_STRATEGY 2 #define MEA_STRATEGY 3 #define COMPLEXITY_STRATEGY 4 #define SIMPLICITY_STRATEGY 5 #define RANDOM_STRATEGY 6 #define DEFAULT_STRATEGY DEPTH_STRATEGY #ifdef LOCALE #undef LOCALE #endif #ifdef _CRSTRTGY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PlaceActivation(void *,ACTIVATION **,ACTIVATION *,struct salienceGroup *); LOCALE int EnvSetStrategy(void *,int); LOCALE int EnvGetStrategy(void *); LOCALE void *SetStrategyCommand(void *); LOCALE void *GetStrategyCommand(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE int SetStrategy(int); LOCALE int GetStrategy(void); #endif #endif /* _H_crstrtgy */ clips_core_source_630/core/._classinf.h0000755000175000017500000000040712373714260016427 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltutl.c0000755000175000017500000000040712373754173016514 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._commline.h0000755000175000017500000000040712373714244016432 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._insmngr.c0000755000175000017500000000040712464742046016301 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltcmp.c0000755000175000017500000000040712373754232016463 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltfun.h0000755000175000017500000001741712375261535016276 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/20/14 */ /* */ /* DEFTEMPLATE FUNCTION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added deftemplate-slot-names, */ /* deftemplate-slot-default-value, */ /* deftemplate-slot-cardinality, */ /* deftemplate-slot-allowed-values, */ /* deftemplate-slot-range, */ /* deftemplate-slot-types, */ /* deftemplate-slot-multip, */ /* deftemplate-slot-singlep, */ /* deftemplate-slot-existp, and */ /* deftemplate-slot-defaultp functions. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for deftemplate slot facets. */ /* */ /* Added deftemplate-slot-facet-existp and */ /* deftemplate-slot-facet-value functions. */ /* */ /* Support for long long integers. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Support for modify callback function. */ /* */ /* Added additional argument to function */ /* CheckDeftemplateAndSlotArguments to specify */ /* the expected number of arguments. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /*************************************************************/ #ifndef _H_tmpltfun #define _H_tmpltfun #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool UpdateModifyDuplicate(void *,struct expr *,const char *,void *); LOCALE struct expr *ModifyParse(void *,struct expr *,const char *); LOCALE struct expr *DuplicateParse(void *,struct expr *,const char *); LOCALE void DeftemplateFunctions( void *); LOCALE void ModifyCommand(void *,DATA_OBJECT_PTR); LOCALE void DuplicateCommand(void *,DATA_OBJECT_PTR); LOCALE void DeftemplateSlotNamesFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotNames(void *,void *,DATA_OBJECT *); LOCALE void DeftemplateSlotDefaultValueFunction(void *,DATA_OBJECT *); LOCALE intBool EnvDeftemplateSlotDefaultValue(void *,void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotCardinalityFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotCardinality(void *,void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotAllowedValuesFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotAllowedValues(void *,void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotRangeFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotRange(void *,void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotTypesFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotTypes(void *,void *,const char *,DATA_OBJECT *); LOCALE int DeftemplateSlotMultiPFunction(void *); LOCALE int EnvDeftemplateSlotMultiP(void *,void *,const char *); LOCALE int DeftemplateSlotSinglePFunction(void *); LOCALE int EnvDeftemplateSlotSingleP(void *,void *,const char *); LOCALE int DeftemplateSlotExistPFunction(void *); LOCALE int EnvDeftemplateSlotExistP(void *,void *,const char *); LOCALE void *DeftemplateSlotDefaultPFunction(void *); LOCALE int EnvDeftemplateSlotDefaultP(void *,void *,const char *); LOCALE int DeftemplateSlotFacetExistPFunction(void *); LOCALE int EnvDeftemplateSlotFacetExistP(void *,void *,const char *,const char *); LOCALE void DeftemplateSlotFacetValueFunction(void *,DATA_OBJECT *); LOCALE int EnvDeftemplateSlotFacetValue(void *,void *,const char *,const char *,DATA_OBJECT *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void DeftemplateSlotNames(void *,DATA_OBJECT *); LOCALE intBool DeftemplateSlotDefaultValue(void *,const char *,DATA_OBJECT_PTR); LOCALE void DeftemplateSlotCardinality(void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotAllowedValues(void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotRange(void *,const char *,DATA_OBJECT *); LOCALE void DeftemplateSlotTypes(void *,const char *,DATA_OBJECT *); LOCALE int DeftemplateSlotMultiP(void *,const char *); LOCALE int DeftemplateSlotSingleP(void *,const char *); LOCALE int DeftemplateSlotExistP(void *,const char *); LOCALE int DeftemplateSlotDefaultP(void *,const char *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_tmpltfun */ clips_core_source_630/core/prdctfun.h0000755000175000017500000000655412373743655016260 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PREDICATE FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /*************************************************************/ #ifndef _H_prdctfun #define _H_prdctfun #ifdef LOCALE #undef LOCALE #endif #ifdef _PRDCTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PredicateFunctionDefinitions(void *); LOCALE intBool EqFunction(void *); LOCALE intBool NeqFunction(void *); LOCALE intBool StringpFunction(void *); LOCALE intBool SymbolpFunction(void *); LOCALE intBool LexemepFunction(void *); LOCALE intBool NumberpFunction(void *); LOCALE intBool FloatpFunction(void *); LOCALE intBool IntegerpFunction(void *); LOCALE intBool MultifieldpFunction(void *); LOCALE intBool PointerpFunction(void *); LOCALE intBool NotFunction(void *); LOCALE intBool AndFunction(void *); LOCALE intBool OrFunction(void *); LOCALE intBool LessThanOrEqualFunction(void *); LOCALE intBool GreaterThanOrEqualFunction(void *); LOCALE intBool LessThanFunction(void *); LOCALE intBool GreaterThanFunction(void *); LOCALE intBool NumericEqualFunction(void *); LOCALE intBool NumericNotEqualFunction(void *); LOCALE intBool OddpFunction(void *); LOCALE intBool EvenpFunction(void *); #endif /* _H_prdctfun */ clips_core_source_630/core/objrtfnx.h0000755000175000017500000001546012374023164016246 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for hashed alpha memories. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_objrtfnx #define _H_objrtfnx #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_objrtmch #include "objrtmch.h" #endif struct ObjectMatchVar1 { unsigned short whichSlot; unsigned short whichPattern; unsigned short whichField; unsigned objectAddress : 1; unsigned allFields : 1; unsigned lhs : 1; unsigned rhs : 1; }; struct ObjectMatchVar2 { unsigned short whichSlot; unsigned short whichPattern; unsigned short beginningOffset; unsigned short endOffset; unsigned fromBeginning : 1; unsigned fromEnd : 1; unsigned lhs : 1; unsigned rhs : 1; }; struct ObjectMatchLength { unsigned minLength : 15; unsigned exactly : 1; }; struct ObjectCmpPNConstant { unsigned short offset; unsigned pass : 1; unsigned fail : 1; unsigned general : 1; unsigned fromBeginning : 1; }; struct ObjectCmpPNSingleSlotVars1 { unsigned short firstSlot; unsigned short secondSlot; unsigned pass : 1; unsigned fail : 1; }; struct ObjectCmpPNSingleSlotVars2 { unsigned short firstSlot; unsigned short secondSlot; unsigned short offset; unsigned pass : 1; unsigned fail : 1; unsigned fromBeginning : 1; }; struct ObjectCmpPNSingleSlotVars3 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstOffset; unsigned short secondOffset; unsigned pass : 1; unsigned fail : 1; unsigned firstFromBeginning : 1; unsigned secondFromBeginning : 1; }; struct ObjectCmpJoinSingleSlotVars1 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstPattern; unsigned short secondPattern; unsigned pass : 1; unsigned fail : 1; unsigned int firstPatternLHS : 1; unsigned int firstPatternRHS : 1; unsigned int secondPatternLHS : 1; unsigned int secondPatternRHS : 1; }; struct ObjectCmpJoinSingleSlotVars2 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstPattern; unsigned short secondPattern; unsigned short offset; unsigned pass : 1; unsigned fromBeginning : 1; unsigned fail : 1; unsigned int firstPatternLHS : 1; unsigned int firstPatternRHS : 1; unsigned int secondPatternLHS : 1; unsigned int secondPatternRHS : 1; }; struct ObjectCmpJoinSingleSlotVars3 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstPattern; unsigned short secondPattern; unsigned short firstOffset; unsigned short secondOffset; unsigned pass : 1; unsigned fail : 1; unsigned firstFromBeginning : 1; unsigned secondFromBeginning : 1; unsigned int firstPatternLHS : 1; unsigned int firstPatternRHS : 1; unsigned int secondPatternLHS : 1; unsigned int secondPatternRHS : 1; }; #define OBJECT_RETE_DATA 35 struct objectReteData { INSTANCE_TYPE *CurrentPatternObject; INSTANCE_SLOT *CurrentPatternObjectSlot; unsigned CurrentObjectSlotLength; struct multifieldMarker *CurrentPatternObjectMarks; struct entityRecord ObjectGVInfo1; struct entityRecord ObjectGVInfo2; struct entityRecord ObjectGVPNInfo1; struct entityRecord ObjectGVPNInfo2; struct entityRecord ObjectCmpConstantInfo; struct entityRecord LengthTestInfo; struct entityRecord PNSimpleCompareInfo1; struct entityRecord PNSimpleCompareInfo2; struct entityRecord PNSimpleCompareInfo3; struct entityRecord JNSimpleCompareInfo1; struct entityRecord JNSimpleCompareInfo2; struct entityRecord JNSimpleCompareInfo3; OBJECT_MATCH_ACTION *ObjectMatchActionQueue; OBJECT_PATTERN_NODE *ObjectPatternNetworkPointer; OBJECT_ALPHA_NODE *ObjectPatternNetworkTerminalPointer; intBool DelayObjectPatternMatching; unsigned long long CurrentObjectMatchTimeTag; long long UseEntityTimeTag; #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *ObjectPatternCodeItem; #endif }; #define ObjectReteData(theEnv) ((struct objectReteData *) GetEnvironmentData(theEnv,OBJECT_RETE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTFNX_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InstallObjectPrimitives(void *); LOCALE intBool ObjectCmpConstantFunction(void *,void *,DATA_OBJECT *); #endif /* DEFRULE_CONSTRUCT && OBJECT_SYSTEM */ #endif /* _H_objrtfnx */ clips_core_source_630/core/._exprnpsr.h0000755000175000017500000000033012374672752016513 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/ruledef.h0000755000175000017500000001676512461253173016053 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFRULE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defrule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defrule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for hashed memories. */ /* */ /* Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Added salience groups to improve performance */ /* with large numbers of activations of different */ /* saliences. */ /* */ /* Added EnvGetDisjunctCount and */ /* EnvGetNthDisjunct functions. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_ruledef #define _H_ruledef #define GetDisjunctIndex(r) ((struct constructHeader *) r)->bsaveID struct defrule; struct defruleModule; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_agenda #include "agenda.h" #endif #ifndef _H_network #include "network.h" #endif struct defrule { struct constructHeader header; int salience; int localVarCnt; unsigned int complexity : 11; unsigned int afterBreakpoint : 1; unsigned int watchActivation : 1; unsigned int watchFiring : 1; unsigned int autoFocus : 1; unsigned int executing : 1; struct expr *dynamicSalience; struct expr *actions; struct joinNode *logicalJoin; struct joinNode *lastJoin; struct defrule *disjunct; }; struct defruleModule { struct defmoduleItemHeader header; struct salienceGroup *groupings; struct activation *agenda; }; #ifndef ALPHA_MEMORY_HASH_SIZE #define ALPHA_MEMORY_HASH_SIZE 63559L #endif #define DEFRULE_DATA 16 struct defruleData { struct construct *DefruleConstruct; int DefruleModuleIndex; long long CurrentEntityTimeTag; struct alphaMemoryHash **AlphaMemoryTable; intBool BetaMemoryResizingFlag; struct joinLink *RightPrimeJoins; struct joinLink *LeftPrimeJoins; #if DEBUGGING_FUNCTIONS unsigned WatchRules; int DeletedRuleDebugFlags; #endif #if DEVELOPER && (! RUN_TIME) && (! BLOAD_ONLY) unsigned WatchRuleAnalysis; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefruleCodeItem; #endif }; #define DefruleData(theEnv) ((struct defruleData *) GetEnvironmentData(theEnv,DEFRULE_DATA)) #define GetPreviousJoin(theJoin) \ (((theJoin)->joinFromTheRight) ? \ ((struct joinNode *) (theJoin)->rightSideEntryStructure) : \ ((theJoin)->lastLevel)) #define GetPatternForJoin(theJoin) \ (((theJoin)->joinFromTheRight) ? \ NULL : \ ((theJoin)->rightSideEntryStructure)) #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeDefrules(void *); LOCALE void *EnvFindDefrule(void *,const char *); LOCALE void *EnvFindDefruleInModule(void *,const char *); LOCALE void *EnvGetNextDefrule(void *,void *); LOCALE struct defruleModule *GetDefruleModuleItem(void *,struct defmodule *); LOCALE intBool EnvIsDefruleDeletable(void *,void *); #if RUN_TIME LOCALE void DefruleRunTimeInitialize(void *,struct joinLink *,struct joinLink *); #endif #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE LOCALE void AddBetaMemoriesToJoin(void *,struct joinNode *); #endif LOCALE long EnvGetDisjunctCount(void *,void *); LOCALE void *EnvGetNthDisjunct(void *,void *,long); LOCALE const char *EnvDefruleModule(void *,void *); LOCALE const char *EnvGetDefruleName(void *,void *); LOCALE const char *EnvGetDefrulePPForm(void *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *DefruleModule(void *); LOCALE void *FindDefrule(const char *); LOCALE const char *GetDefruleName(void *); LOCALE const char *GetDefrulePPForm(void *); LOCALE void *GetNextDefrule(void *); LOCALE intBool IsDefruleDeletable(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_ruledef */ clips_core_source_630/core/factprt.h0000755000175000017500000000602612373742644016065 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT RETE PRINT FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Updates to support new struct members. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_factprt #define _H_factprt #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTPRT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PrintFactJNCompVars1(void *,const char *,void *); LOCALE void PrintFactJNCompVars2(void *,const char *,void *); LOCALE void PrintFactPNCompVars1(void *,const char *,void *); LOCALE void PrintFactJNGetVar1(void *,const char *,void *); LOCALE void PrintFactJNGetVar2(void *,const char *,void *); LOCALE void PrintFactJNGetVar3(void *,const char *,void *); LOCALE void PrintFactPNGetVar1(void *,const char *,void *); LOCALE void PrintFactPNGetVar2(void *,const char *,void *); LOCALE void PrintFactPNGetVar3(void *,const char *,void *); LOCALE void PrintFactSlotLength(void *,const char *,void *); LOCALE void PrintFactPNConstant1(void *,const char *,void *); LOCALE void PrintFactPNConstant2(void *,const char *,void *); #endif /* _H_factprt */ clips_core_source_630/core/cstrcpsr.h0000755000175000017500000001135012373714225016253 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRUCT PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing routines and utilities for parsing */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Made the construct redefinition message more */ /* prominent. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* 6.30: Added code for capturing errors/warnings. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, MAC_MCW, */ /* and IBM_TBC). */ /* */ /* Changed garbage collection algorithm. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #ifndef _H_cstrcpsr #define _H_cstrcpsr #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE int Load(const char *); #endif LOCALE int EnvLoad(void *,const char *); LOCALE int LoadConstructsFromLogicalName(void *,const char *); LOCALE int ParseConstruct(void *,const char *,const char *); LOCALE void RemoveConstructFromModule(void *,struct constructHeader *); LOCALE struct symbolHashNode *GetConstructNameAndComment(void *,const char *, struct token *,const char *, void *(*)(void *,const char *), int (*)(void *,void *), const char *,int,int,int,int); LOCALE void ImportExportConflictMessage(void *,const char *,const char *,const char *,const char *); #if (! RUN_TIME) && (! BLOAD_ONLY) LOCALE void FlushParsingMessages(void *); LOCALE char *EnvGetParsingFileName(void *); LOCALE void EnvSetParsingFileName(void *,const char *); LOCALE char *EnvGetErrorFileName(void *); LOCALE void EnvSetErrorFileName(void *,const char *); LOCALE char *EnvGetWarningFileName(void *); LOCALE void EnvSetWarningFileName(void *,const char *); LOCALE void CreateErrorCaptureRouter(void *); LOCALE void DeleteErrorCaptureRouter(void *); #endif #endif clips_core_source_630/core/sortfun.h0000755000175000017500000000425712373755540016125 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SORT FUNCTIONS HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for sorting functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: The sort function leaks memory when called */ /* with a multifield value of length zero. */ /* DR0864 */ /* */ /* 6.30: Added environment cleanup call function */ /* DeallocateSortFunctionData. */ /* */ /*************************************************************/ #ifndef _H_sortfun #define _H_sortfun #ifdef LOCALE #undef LOCALE #endif #ifdef _SORTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SortFunctionDefinitions(void *); LOCALE void MergeSort(void *,unsigned long,DATA_OBJECT *, int (*)(void *,DATA_OBJECT *,DATA_OBJECT *)); LOCALE void SortFunction(void *,DATA_OBJECT *); #endif /* _H_sortfun */ clips_core_source_630/core/._prccode.c0000755000175000017500000000040712373743665016252 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/constrct.c0000755000175000017500000007775212461254362016263 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* CONSTRUCT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides basic functionality for creating new */ /* types of constructs, saving constructs to a file, and */ /* adding new functionality to the clear and reset */ /* commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added code for capturing errors/warnings */ /* (EnvSetParserErrorCallback). */ /* */ /* Fixed issue with save function when multiple */ /* defmodules exist. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /* Added code to prevent a clear command from */ /* being executed during fact assertions via */ /* Increment/DecrementClearReadyLocks API. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /*************************************************************/ #define _CONSTRCT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "scanner.h" #include "watch.h" #include "prcdrfun.h" #include "prcdrpsr.h" #include "argacces.h" #include "exprnpsr.h" #include "multifld.h" #include "moduldef.h" #include "modulutl.h" #include "sysdep.h" #include "utility.h" #include "commline.h" #include "cstrcpsr.h" #include "ruledef.h" /* TBD Remove */ #include "constrct.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocateConstructData(void *); /**************************************************/ /* InitializeConstructData: Allocates environment */ /* data for constructs. */ /**************************************************/ globle void InitializeConstructData( void *theEnv) { AllocateEnvironmentData(theEnv,CONSTRUCT_DATA,sizeof(struct constructData),DeallocateConstructData); #if (! RUN_TIME) && (! BLOAD_ONLY) ConstructData(theEnv)->WatchCompilations = ON; #endif } /****************************************************/ /* DeallocateConstructData: Deallocates environment */ /* data for constructs. */ /****************************************************/ static void DeallocateConstructData( void *theEnv) { struct construct *tmpPtr, *nextPtr; #if (! RUN_TIME) && (! BLOAD_ONLY) DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfSaveFunctions); #endif DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfResetFunctions); DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfClearFunctions); DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfClearReadyFunctions); #if (! RUN_TIME) && (! BLOAD_ONLY) if (ConstructData(theEnv)->ErrorString != NULL) { genfree(theEnv,ConstructData(theEnv)->ErrorString,sizeof(ConstructData(theEnv)->ErrorString) + 1); } if (ConstructData(theEnv)->WarningString != NULL) { genfree(theEnv,ConstructData(theEnv)->WarningString,sizeof(ConstructData(theEnv)->WarningString) + 1); } ConstructData(theEnv)->ErrorString = NULL; ConstructData(theEnv)->WarningString = NULL; EnvSetParsingFileName(theEnv,NULL); EnvSetWarningFileName(theEnv,NULL); EnvSetErrorFileName(theEnv,NULL); #endif tmpPtr = ConstructData(theEnv)->ListOfConstructs; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,construct,tmpPtr); tmpPtr = nextPtr; } } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************/ /* EnvSetParserErrorCallback: Allows the function */ /* which is called when a construct parsing */ /* error occurs to be changed. */ /**************************************************/ globle void (*EnvSetParserErrorCallback(void *theEnv, void (*functionPtr)(void *,const char *,const char *,const char *,long))) (void *,const char *,const char *,const char*,long) { void (*tmpPtr)(void *,const char *,const char *,const char *,long); tmpPtr = ConstructData(theEnv)->ParserErrorCallback; ConstructData(theEnv)->ParserErrorCallback = functionPtr; return(tmpPtr); } /*************************************************/ /* FindConstruct: Determines whether a construct */ /* type is in the ListOfConstructs. */ /*************************************************/ globle struct construct *FindConstruct( void *theEnv, const char *name) { struct construct *currentPtr; for (currentPtr = ConstructData(theEnv)->ListOfConstructs; currentPtr != NULL; currentPtr = currentPtr->next) { if (strcmp(name,currentPtr->constructName) == 0) { return(currentPtr); } } return(NULL); } /***********************************************************/ /* RemoveConstruct: Removes a construct and its associated */ /* parsing function from the ListOfConstructs. Returns */ /* TRUE if the construct type was removed, otherwise */ /* FALSE. */ /***********************************************************/ globle int RemoveConstruct( void *theEnv, const char *name) { struct construct *currentPtr, *lastPtr = NULL; for (currentPtr = ConstructData(theEnv)->ListOfConstructs; currentPtr != NULL; currentPtr = currentPtr->next) { if (strcmp(name,currentPtr->constructName) == 0) { if (lastPtr == NULL) { ConstructData(theEnv)->ListOfConstructs = currentPtr->next; } else { lastPtr->next = currentPtr->next; } rtn_struct(theEnv,construct,currentPtr); return(TRUE); } lastPtr = currentPtr; } return(FALSE); } /************************************************/ /* Save: C access routine for the save command. */ /************************************************/ globle int EnvSave( void *theEnv, const char *fileName) { struct callFunctionItem *saveFunction; FILE *filePtr; struct defmodule *defmodulePtr; intBool updated = FALSE; intBool unvisited = TRUE; /*=====================*/ /* Open the save file. */ /*=====================*/ if ((filePtr = GenOpen(theEnv,fileName,"w")) == NULL) { return(FALSE); } /*===========================*/ /* Bypass the router system. */ /*===========================*/ SetFastSave(theEnv,filePtr); /*================================*/ /* Mark all modules as unvisited. */ /*================================*/ MarkModulesAsUnvisited(theEnv); /*===============================================*/ /* Save the constructs. Repeatedly loop over the */ /* modules until each module has been save. */ /*===============================================*/ while (unvisited) { unvisited = FALSE; updated = FALSE; for (defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); defmodulePtr != NULL; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr)) { /*=================================================================*/ /* We only want to save a module if all of the modules it imports */ /* from have already been saved. Since there can't be circular */ /* dependencies in imported modules, this should save the modules */ /* that don't import anything first and then work back from those. */ /*=================================================================*/ if (defmodulePtr->visitedFlag) { /* Module has already been saved. */ } else if (AllImportedModulesVisited(theEnv,defmodulePtr)) { for (saveFunction = ConstructData(theEnv)->ListOfSaveFunctions; saveFunction != NULL; saveFunction = saveFunction->next) { ((* (void (*)(void *,void *,char *)) saveFunction->func))(theEnv,defmodulePtr,(char *) filePtr); } updated = TRUE; defmodulePtr->visitedFlag = TRUE; } else { unvisited = TRUE; } } /*=====================================================================*/ /* At least one module should be saved in every pass. If all have been */ /* visited/saved, then both flags will be FALSE. If all remaining */ /* unvisited/unsaved modules were visited/saved, then unvisited will */ /* be FALSE and updated will be TRUE. If some, but not all, remaining */ /* unvisited/unsaved modules are visited/saved, then unvisited will */ /* be TRUE and updated will be TRUE. This leaves the case where there */ /* are remaining unvisited/unsaved modules, but none were */ /* visited/saved: unvisited is TRUE and updated is FALSE. */ /*=====================================================================*/ if (unvisited && (! updated)) { SystemError(theEnv,"CONSTRCT",2); break; } } /*======================*/ /* Close the save file. */ /*======================*/ GenClose(theEnv,filePtr); /*===========================*/ /* Remove the router bypass. */ /*===========================*/ SetFastSave(theEnv,NULL); /*=========================*/ /* Return TRUE to indicate */ /* successful completion. */ /*=========================*/ return(TRUE); } /*******************************************************/ /* RemoveSaveFunction: Removes a function from the */ /* ListOfSaveFunctions. Returns TRUE if the function */ /* was successfully removed, otherwise FALSE. */ /*******************************************************/ globle intBool RemoveSaveFunction( void *theEnv, const char *name) { int found; ConstructData(theEnv)->ListOfSaveFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfSaveFunctions,&found); if (found) return(TRUE); return(FALSE); } /**********************************/ /* SetCompilationsWatch: Sets the */ /* value of WatchCompilations. */ /**********************************/ globle void SetCompilationsWatch( void *theEnv, unsigned value) { ConstructData(theEnv)->WatchCompilations = value; } /*************************************/ /* GetCompilationsWatch: Returns the */ /* value of WatchCompilations. */ /*************************************/ globle unsigned GetCompilationsWatch( void *theEnv) { return(ConstructData(theEnv)->WatchCompilations); } /**********************************/ /* SetPrintWhileLoading: Sets the */ /* value of PrintWhileLoading. */ /**********************************/ globle void SetPrintWhileLoading( void *theEnv, intBool value) { ConstructData(theEnv)->PrintWhileLoading = value; } /*************************************/ /* GetPrintWhileLoading: Returns the */ /* value of PrintWhileLoading. */ /*************************************/ globle intBool GetPrintWhileLoading( void *theEnv) { return(ConstructData(theEnv)->PrintWhileLoading); } #endif /*************************************/ /* InitializeConstructs: Initializes */ /* the Construct Manager. */ /*************************************/ globle void InitializeConstructs( void *theEnv) { #if (! RUN_TIME) EnvDefineFunction2(theEnv,"clear", 'v', PTIEF ClearCommand, "ClearCommand", "00"); EnvDefineFunction2(theEnv,"reset", 'v', PTIEF ResetCommand, "ResetCommand", "00"); #if DEBUGGING_FUNCTIONS && (! BLOAD_ONLY) AddWatchItem(theEnv,"compilations",0,&ConstructData(theEnv)->WatchCompilations,30,NULL,NULL); #endif #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /**************************************/ /* ClearCommand: H/L access routine */ /* for the clear command. */ /**************************************/ globle void ClearCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"clear",EXACTLY,0) == -1) return; EnvClear(theEnv); return; } /**************************************/ /* ResetCommand: H/L access routine */ /* for the reset command. */ /**************************************/ globle void ResetCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"reset",EXACTLY,0) == -1) return; EnvReset(theEnv); return; } /******************************/ /* EnvReset: C access routine */ /* for the reset command. */ /******************************/ globle void EnvReset( void *theEnv) { struct callFunctionItem *resetPtr; /*=====================================*/ /* The reset command can't be executed */ /* while a reset is in progress. */ /*=====================================*/ if (ConstructData(theEnv)->ResetInProgress) return; ConstructData(theEnv)->ResetInProgress = TRUE; ConstructData(theEnv)->ResetReadyInProgress = TRUE; /*================================================*/ /* If the reset is performed from the top level */ /* command prompt, reset the halt execution flag. */ /*================================================*/ if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE); /*=======================================================*/ /* Call the before reset function to determine if the */ /* reset should continue. [Used by the some of the */ /* windowed interfaces to query the user whether a */ /* reset should proceed with activations on the agenda.] */ /*=======================================================*/ if ((ConstructData(theEnv)->BeforeResetFunction != NULL) ? ((*ConstructData(theEnv)->BeforeResetFunction)(theEnv) == FALSE) : FALSE) { ConstructData(theEnv)->ResetReadyInProgress = FALSE; ConstructData(theEnv)->ResetInProgress = FALSE; return; } ConstructData(theEnv)->ResetReadyInProgress = FALSE; /*===========================*/ /* Call each reset function. */ /*===========================*/ for (resetPtr = ConstructData(theEnv)->ListOfResetFunctions; (resetPtr != NULL) && (GetHaltExecution(theEnv) == FALSE); resetPtr = resetPtr->next) { if (resetPtr->environmentAware) { (*resetPtr->func)(theEnv); } else { (* (void (*)(void)) resetPtr->func)(); } } /*============================================*/ /* Set the current module to the MAIN module. */ /*============================================*/ EnvSetCurrentModule(theEnv,(void *) EnvFindDefmodule(theEnv,"MAIN")); /*===========================================*/ /* Perform periodic cleanup if the reset was */ /* issued from an embedded controller. */ /*===========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*===================================*/ /* A reset is no longer in progress. */ /*===================================*/ ConstructData(theEnv)->ResetInProgress = FALSE; } /************************************/ /* SetBeforeResetFunction: Sets the */ /* value of BeforeResetFunction. */ /************************************/ globle int (*SetBeforeResetFunction(void *theEnv, int (*theFunction)(void *)))(void *) { int (*tempFunction)(void *); tempFunction = ConstructData(theEnv)->BeforeResetFunction; ConstructData(theEnv)->BeforeResetFunction = theFunction; return(tempFunction); } /****************************************/ /* EnvAddResetFunction: Adds a function */ /* to ListOfResetFunctions. */ /****************************************/ globle intBool EnvAddResetFunction( void *theEnv, const char *name, void (*functionPtr)(void *), int priority) { ConstructData(theEnv)->ListOfResetFunctions = AddFunctionToCallList(theEnv,name,priority, functionPtr, ConstructData(theEnv)->ListOfResetFunctions,TRUE); return(TRUE); } /**********************************************/ /* EnvRemoveResetFunction: Removes a function */ /* from the ListOfResetFunctions. */ /**********************************************/ globle intBool EnvRemoveResetFunction( void *theEnv, const char *name) { int found; ConstructData(theEnv)->ListOfResetFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfResetFunctions,&found); if (found) return(TRUE); return(FALSE); } /*******************************************/ /* EnvIncrementClearReadyLocks: Increments */ /* the number of clear ready locks. */ /*******************************************/ globle void EnvIncrementClearReadyLocks( void *theEnv) { ConstructData(theEnv)->ClearReadyLocks++; } /*******************************************/ /* EnvDecrementClearReadyLocks: Decrements */ /* the number of clear locks. */ /*******************************************/ globle void EnvDecrementClearReadyLocks( void *theEnv) { if (ConstructData(theEnv)->ClearReadyLocks > 0) { ConstructData(theEnv)->ClearReadyLocks--; } } /*****************************************************/ /* EnvClear: C access routine for the clear command. */ /*****************************************************/ globle void EnvClear( void *theEnv) { struct callFunctionItem *theFunction; /*==========================================*/ /* Activate the watch router which captures */ /* trace output so that it is not displayed */ /* during a clear. */ /*==========================================*/ #if DEBUGGING_FUNCTIONS EnvActivateRouter(theEnv,WTRACE); #endif /*===================================*/ /* Determine if a clear is possible. */ /*===================================*/ ConstructData(theEnv)->ClearReadyInProgress = TRUE; if ((ConstructData(theEnv)->ClearReadyLocks > 0) || (ConstructData(theEnv)->DanglingConstructs > 0) || (ClearReady(theEnv) == FALSE)) { PrintErrorID(theEnv,"CONSTRCT",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Some constructs are still in use. Clear cannot continue.\n"); #if DEBUGGING_FUNCTIONS EnvDeactivateRouter(theEnv,WTRACE); #endif ConstructData(theEnv)->ClearReadyInProgress = FALSE; return; } ConstructData(theEnv)->ClearReadyInProgress = FALSE; /*===========================*/ /* Call all clear functions. */ /*===========================*/ ConstructData(theEnv)->ClearInProgress = TRUE; for (theFunction = ConstructData(theEnv)->ListOfClearFunctions; theFunction != NULL; theFunction = theFunction->next) { if (theFunction->environmentAware) { (*theFunction->func)(theEnv); } else { (* (void (*)(void)) theFunction->func)(); } } /*=============================*/ /* Deactivate the watch router */ /* for capturing output. */ /*=============================*/ #if DEBUGGING_FUNCTIONS EnvDeactivateRouter(theEnv,WTRACE); #endif /*===========================================*/ /* Perform periodic cleanup if the clear was */ /* issued from an embedded controller. */ /*===========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*===========================*/ /* Clear has been completed. */ /*===========================*/ ConstructData(theEnv)->ClearInProgress = FALSE; #if DEFRULE_CONSTRUCT if ((DefruleData(theEnv)->RightPrimeJoins != NULL) || (DefruleData(theEnv)->LeftPrimeJoins != NULL)) { SystemError(theEnv,"CONSTRCT",1); } #endif /*============================*/ /* Perform reset after clear. */ /*============================*/ EnvReset(theEnv); } /*********************************************************/ /* ClearReady: Returns TRUE if a clear can be performed, */ /* otherwise FALSE. Note that this is destructively */ /* determined (e.g. facts will be deleted as part of */ /* the determination). */ /*********************************************************/ globle intBool ClearReady( void *theEnv) { struct callFunctionItem *theFunction; int (*tempFunction)(void *); for (theFunction = ConstructData(theEnv)->ListOfClearReadyFunctions; theFunction != NULL; theFunction = theFunction->next) { tempFunction = (int (*)(void *)) theFunction->func; if ((*tempFunction)(theEnv) == FALSE) { return(FALSE); } } return(TRUE); } /******************************************/ /* AddClearReadyFunction: Adds a function */ /* to ListOfClearReadyFunctions. */ /******************************************/ globle intBool AddClearReadyFunction( void *theEnv, const char *name, int (*functionPtr)(void *), int priority) { ConstructData(theEnv)->ListOfClearReadyFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfClearReadyFunctions,TRUE); return(1); } /************************************************/ /* RemoveClearReadyFunction: Removes a function */ /* from the ListOfClearReadyFunctions. */ /************************************************/ globle intBool RemoveClearReadyFunction( void *theEnv, const char *name) { int found; ConstructData(theEnv)->ListOfClearReadyFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfClearReadyFunctions,&found); if (found) return(TRUE); return(FALSE); } /****************************************/ /* EnvAddClearFunction: Adds a function */ /* to ListOfClearFunctions. */ /****************************************/ globle intBool EnvAddClearFunction( void *theEnv, const char *name, void (*functionPtr)(void *), int priority) { ConstructData(theEnv)->ListOfClearFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfClearFunctions,TRUE); return(1); } /**********************************************/ /* EnvRemoveClearFunction: Removes a function */ /* from the ListOfClearFunctions. */ /**********************************************/ globle intBool EnvRemoveClearFunction( void *theEnv, const char *name) { int found; ConstructData(theEnv)->ListOfClearFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfClearFunctions,&found); if (found) return(TRUE); return(FALSE); } /***********************************************/ /* ExecutingConstruct: Returns TRUE if a */ /* construct is currently being executed, */ /* otherwise FALSE. */ /***********************************************/ globle int ExecutingConstruct( void *theEnv) { return(ConstructData(theEnv)->Executing); } /********************************************/ /* SetExecutingConstruct: Sets the value of */ /* the executing variable indicating that */ /* actions such as reset, clear, etc */ /* should not be performed. */ /********************************************/ globle void SetExecutingConstruct( void *theEnv, int value) { ConstructData(theEnv)->Executing = value; } /*******************************************************/ /* DeinstallConstructHeader: Decrements the busy count */ /* of a construct name and frees its pretty print */ /* representation string (both of which are stored */ /* in the generic construct header). */ /*******************************************************/ globle void DeinstallConstructHeader( void *theEnv, struct constructHeader *theHeader) { DecrementSymbolCount(theEnv,theHeader->name); if (theHeader->ppForm != NULL) { rm(theEnv,(void *) theHeader->ppForm, sizeof(char) * (strlen(theHeader->ppForm) + 1)); theHeader->ppForm = NULL; } if (theHeader->usrData != NULL) { ClearUserDataList(theEnv,theHeader->usrData); theHeader->usrData = NULL; } } /**************************************************/ /* DestroyConstructHeader: Frees the pretty print */ /* representation string and user data (both of */ /* which are stored in the generic construct */ /* header). */ /**************************************************/ globle void DestroyConstructHeader( void *theEnv, struct constructHeader *theHeader) { if (theHeader->ppForm != NULL) { rm(theEnv,(void *) theHeader->ppForm, sizeof(char) * (strlen(theHeader->ppForm) + 1)); theHeader->ppForm = NULL; } if (theHeader->usrData != NULL) { ClearUserDataList(theEnv,theHeader->usrData); theHeader->usrData = NULL; } } /*****************************************************/ /* AddConstruct: Adds a construct and its associated */ /* parsing function to the ListOfConstructs. */ /*****************************************************/ globle struct construct *AddConstruct( void *theEnv, const char *name, const char *pluralName, int (*parseFunction)(void *,const char *), void *(*findFunction)(void *,const char *), SYMBOL_HN *(*getConstructNameFunction)(struct constructHeader *), const char *(*getPPFormFunction)(void *,struct constructHeader *), struct defmoduleItemHeader *(*getModuleItemFunction)(struct constructHeader *), void *(*getNextItemFunction)(void *,void *), void (*setNextItemFunction)(struct constructHeader *,struct constructHeader *), intBool (*isConstructDeletableFunction)(void *,void *), int (*deleteFunction)(void *,void *), void (*freeFunction)(void *,void *)) { struct construct *newPtr; /*=============================*/ /* Allocate and initialize the */ /* construct data structure. */ /*=============================*/ newPtr = get_struct(theEnv,construct); newPtr->constructName = name; newPtr->pluralName = pluralName; newPtr->parseFunction = parseFunction; newPtr->findFunction = findFunction; newPtr->getConstructNameFunction = getConstructNameFunction; newPtr->getPPFormFunction = getPPFormFunction; newPtr->getModuleItemFunction = getModuleItemFunction; newPtr->getNextItemFunction = getNextItemFunction; newPtr->setNextItemFunction = setNextItemFunction; newPtr->isConstructDeletableFunction = isConstructDeletableFunction; newPtr->deleteFunction = deleteFunction; newPtr->freeFunction = freeFunction; /*===============================*/ /* Add the construct to the list */ /* of constructs and return it. */ /*===============================*/ newPtr->next = ConstructData(theEnv)->ListOfConstructs; ConstructData(theEnv)->ListOfConstructs = newPtr; return(newPtr); } /************************************/ /* AddSaveFunction: Adds a function */ /* to the ListOfSaveFunctions. */ /************************************/ globle intBool AddSaveFunction( void *theEnv, const char *name, void (*functionPtr)(void *,void *,const char *), int priority) { #if (! RUN_TIME) && (! BLOAD_ONLY) ConstructData(theEnv)->ListOfSaveFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfSaveFunctions,TRUE); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif return(1); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool AddClearFunction( const char *name, void (*functionPtr)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); ConstructData(theEnv)->ListOfClearFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfClearFunctions,FALSE); return(1); } globle intBool AddResetFunction( const char *name, void (*functionPtr)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); ConstructData(theEnv)->ListOfResetFunctions = AddFunctionToCallList(theEnv,name,priority,(void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfResetFunctions,FALSE); return(TRUE); } globle void Clear() { EnvClear(GetCurrentEnvironment()); } globle intBool RemoveClearFunction( const char *name) { return EnvRemoveClearFunction(GetCurrentEnvironment(),name); } globle intBool RemoveResetFunction( const char *name) { return EnvRemoveResetFunction(GetCurrentEnvironment(),name); } globle void Reset() { EnvReset(GetCurrentEnvironment()); } #if (! RUN_TIME) && (! BLOAD_ONLY) globle int Save( const char *fileName) { return EnvSave(GetCurrentEnvironment(),fileName); } #endif #endif clips_core_source_630/core/._dffctpsr.h0000755000175000017500000000040712373731204016435 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._modulpsr.h0000755000175000017500000000040712374020224016461 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._classpsr.c0000755000175000017500000000040712461252524016450 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insmult.h0000755000175000017500000000472212373756340016114 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_insmult #define _H_insmult #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSMULT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if (! RUN_TIME) LOCALE void SetupInstanceMultifieldCommands(void *); #endif LOCALE void MVSlotReplaceCommand(void *,DATA_OBJECT *); LOCALE void MVSlotInsertCommand(void *,DATA_OBJECT *); LOCALE void MVSlotDeleteCommand(void *,DATA_OBJECT *); LOCALE intBool DirectMVReplaceCommand(void *); LOCALE intBool DirectMVInsertCommand(void *); LOCALE intBool DirectMVDeleteCommand(void *); #endif /* _H_insmult */ clips_core_source_630/core/bmathfun.c0000755000175000017500000006742512373706603016226 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* BASIC MATH FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for numerous basic math */ /* functions including +, *, -, /, integer, float, div, */ /* abs,set-auto-float-dividend, get-auto-float-dividend, */ /* min, and max. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _BMATHFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "router.h" #include "bmathfun.h" #define BMATHFUN_DATA 6 struct basicMathFunctionData { intBool AutoFloatDividend; }; #define BasicMathFunctionData(theEnv) ((struct basicMathFunctionData *) GetEnvironmentData(theEnv,BMATHFUN_DATA)) /***************************************************************/ /* BasicMathFunctionDefinitions: Defines basic math functions. */ /***************************************************************/ globle void BasicMathFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,BMATHFUN_DATA,sizeof(struct basicMathFunctionData),NULL); BasicMathFunctionData(theEnv)->AutoFloatDividend = TRUE; #if ! RUN_TIME EnvDefineFunction2(theEnv,"+", 'n',PTIEF AdditionFunction, "AdditionFunction", "2*n"); EnvDefineFunction2(theEnv,"*", 'n', PTIEF MultiplicationFunction, "MultiplicationFunction", "2*n"); EnvDefineFunction2(theEnv,"-", 'n', PTIEF SubtractionFunction, "SubtractionFunction", "2*n"); EnvDefineFunction2(theEnv,"/", 'n', PTIEF DivisionFunction, "DivisionFunction", "2*n"); EnvDefineFunction2(theEnv,"div", 'g', PTIEF DivFunction, "DivFunction", "2*n"); EnvDefineFunction2(theEnv,"set-auto-float-dividend", 'b', SetAutoFloatDividendCommand, "SetAutoFloatDividendCommand", "11"); EnvDefineFunction2(theEnv,"get-auto-float-dividend", 'b', GetAutoFloatDividendCommand, "GetAutoFloatDividendCommand", "00"); EnvDefineFunction2(theEnv,"integer", 'g', PTIEF IntegerFunction, "IntegerFunction", "11n"); EnvDefineFunction2(theEnv,"float", 'd', PTIEF FloatFunction, "FloatFunction", "11n"); EnvDefineFunction2(theEnv,"abs", 'n', PTIEF AbsFunction, "AbsFunction", "11n"); EnvDefineFunction2(theEnv,"min", 'n', PTIEF MinFunction, "MinFunction", "2*n"); EnvDefineFunction2(theEnv,"max", 'n', PTIEF MaxFunction, "MaxFunction", "2*n"); #endif } /**********************************/ /* AdditionFunction: H/L access */ /* routine for the + function. */ /**********************************/ globle void AdditionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 0.0; long long ltotal = 0LL; intBool useFloatTotal = FALSE; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; /*=================================================*/ /* Loop through each of the arguments adding it to */ /* a running total. If a floating point number is */ /* encountered, then do all subsequent operations */ /* using floating point values. */ /*=================================================*/ theExpression = GetFirstArgument(); while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"+",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (useFloatTotal) { ftotal += ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal += ValueToLong(theArgument.value); } else { ftotal = (double) ltotal + ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /****************************************/ /* MultiplicationFunction: CLIPS access */ /* routine for the * function. */ /****************************************/ globle void MultiplicationFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 1.0; long long ltotal = 1LL; intBool useFloatTotal = FALSE; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; /*===================================================*/ /* Loop through each of the arguments multiplying it */ /* by a running product. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. */ /*===================================================*/ theExpression = GetFirstArgument(); while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"*",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (useFloatTotal) { ftotal *= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal *= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal * ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /*************************************/ /* SubtractionFunction: CLIPS access */ /* routine for the - function. */ /*************************************/ globle void SubtractionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 0.0; long long ltotal = 0LL; intBool useFloatTotal = FALSE; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; /*=================================================*/ /* Get the first argument. This number which will */ /* be the starting total from which all subsequent */ /* arguments will subtracted. */ /*=================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"-",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { ltotal = ValueToLong(theArgument.value); } else { ftotal = ValueToDouble(theArgument.value); useFloatTotal = TRUE; } pos++; } /*===================================================*/ /* Loop through each of the arguments subtracting it */ /* from a running total. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. */ /*===================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"-",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (useFloatTotal) { ftotal -= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal -= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal - ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /***********************************/ /* DivisionFunction: CLIPS access */ /* routine for the / function. */ /***********************************/ globle void DivisionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 1.0; long long ltotal = 1LL; intBool useFloatTotal; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; useFloatTotal = BasicMathFunctionData(theEnv)->AutoFloatDividend; /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. If the auto float dividend */ /* feature is enable, then this number is converted */ /* to a float if it is an integer. */ /*===================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { ltotal = ValueToLong(theArgument.value); } else { ftotal = ValueToDouble(theArgument.value); useFloatTotal = TRUE; } pos++; } /*====================================================*/ /* Loop through each of the arguments dividing it */ /* into a running product. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. Each argument is */ /* checked to prevent a divide by zero error. */ /*====================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if ((theArgument.type == INTEGER) ? (ValueToLong(theArgument.value) == 0L) : ((theArgument.type == FLOAT) ? ValueToDouble(theArgument.value) == 0.0 : FALSE)) { DivideByZeroErrorMessage(theEnv,"/"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,1.0); return; } if (useFloatTotal) { ftotal /= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal /= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal / ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /*************************************/ /* DivFunction: H/L access routine */ /* for the div function. */ /*************************************/ globle long long DivFunction( void *theEnv) { long long total = 1LL; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; long long theNumber; /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. */ /*===================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { total = ValueToLong(theArgument.value); } else { total = (long long) ValueToDouble(theArgument.value); } pos++; } /*=====================================================*/ /* Loop through each of the arguments dividing it into */ /* a running product. Floats are converted to integers */ /* and each argument is checked to prevent a divide by */ /* zero error. */ /*=====================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) theNumber = ValueToLong(theArgument.value); else if (theArgument.type == FLOAT) theNumber = (long long) ValueToDouble(theArgument.value); else theNumber = 1; if (theNumber == 0LL) { DivideByZeroErrorMessage(theEnv,"div"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } if (theArgument.type == INTEGER) { total /= ValueToLong(theArgument.value); } else { total = total / (long long) ValueToDouble(theArgument.value); } pos++; } /*======================================================*/ /* The result of the div function is always an integer. */ /*======================================================*/ return(total); } /*****************************************************/ /* SetAutoFloatDividendCommand: H/L access routine */ /* for the set-auto-float-dividend command. */ /*****************************************************/ globle int SetAutoFloatDividendCommand( void *theEnv) { int oldValue; DATA_OBJECT theArgument; /*===============================*/ /* Remember the present setting. */ /*===============================*/ oldValue = BasicMathFunctionData(theEnv)->AutoFloatDividend; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-auto-float-dividend",EXACTLY,1) == -1) { return(oldValue); } EnvRtnUnknown(theEnv,1,&theArgument); /*============================================================*/ /* The symbol FALSE disables the auto float dividend feature. */ /*============================================================*/ if ((theArgument.value == EnvFalseSymbol(theEnv)) && (theArgument.type == SYMBOL)) { BasicMathFunctionData(theEnv)->AutoFloatDividend = FALSE; } else { BasicMathFunctionData(theEnv)->AutoFloatDividend = TRUE; } /*======================================*/ /* Return the old value of the feature. */ /*======================================*/ return(oldValue); } /*****************************************************/ /* GetAutoFloatDividendCommand: H/L access routine */ /* for the get-auto-float-dividend command. */ /*****************************************************/ globle int GetAutoFloatDividendCommand( void *theEnv) { /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ EnvArgCountCheck(theEnv,"get-auto-float-dividend",EXACTLY,0); /*=============================*/ /* Return the current setting. */ /*=============================*/ return(BasicMathFunctionData(theEnv)->AutoFloatDividend); } /*************************************************/ /* EnvGetAutoFloatDividend: C access routine for */ /* the get-auto-float-dividend command. */ /*************************************************/ globle intBool EnvGetAutoFloatDividend( void *theEnv) { return(BasicMathFunctionData(theEnv)->AutoFloatDividend); } /*************************************************/ /* EnvSetAutoFloatDividend: C access routine for */ /* the set-auto-float-dividend command. */ /*************************************************/ globle intBool EnvSetAutoFloatDividend( void *theEnv, int value) { int ov; ov = BasicMathFunctionData(theEnv)->AutoFloatDividend; BasicMathFunctionData(theEnv)->AutoFloatDividend = value; return(ov); } /*****************************************/ /* IntegerFunction: H/L access routine */ /* for the integer function. */ /*****************************************/ globle long long IntegerFunction( void *theEnv) { DATA_OBJECT valstruct; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"integer",EXACTLY,1) == -1) return(0LL); /*================================================================*/ /* Check for the correct type of argument. Note that ArgTypeCheck */ /* will convert floats to integers when an integer is requested */ /* (which is the purpose of the integer function). */ /*================================================================*/ if (EnvArgTypeCheck(theEnv,"integer",1,INTEGER,&valstruct) == FALSE) return(0LL); /*===================================================*/ /* Return the numeric value converted to an integer. */ /*===================================================*/ return(ValueToLong(valstruct.value)); } /***************************************/ /* FloatFunction: H/L access routine */ /* for the float function. */ /***************************************/ globle double FloatFunction( void *theEnv) { DATA_OBJECT valstruct; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"float",EXACTLY,1) == -1) return(0.0); /*================================================================*/ /* Check for the correct type of argument. Note that ArgTypeCheck */ /* will convert integers to floats when a float is requested */ /* (which is the purpose of the float function). */ /*================================================================*/ if (EnvArgTypeCheck(theEnv,"float",1,FLOAT,&valstruct) == FALSE) return(0.0); /*================================================*/ /* Return the numeric value converted to a float. */ /*================================================*/ return(ValueToDouble(valstruct.value)); } /*************************************/ /* AbsFunction: H/L access routine */ /* for the abs function. */ /*************************************/ globle void AbsFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"abs",EXACTLY,1) == -1) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*======================================*/ /* Check that the argument is a number. */ /*======================================*/ if (EnvArgTypeCheck(theEnv,"abs",1,INTEGER_OR_FLOAT,returnValue) == FALSE) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*==========================================*/ /* Return the absolute value of the number. */ /*==========================================*/ if (returnValue->type == INTEGER) { if (ValueToLong(returnValue->value) < 0L) { returnValue->value = (void *) EnvAddLong(theEnv,- ValueToLong(returnValue->value)); } } else if (ValueToDouble(returnValue->value) < 0.0) { returnValue->value = (void *) EnvAddDouble(theEnv,- ValueToDouble(returnValue->value)); } } /*************************************/ /* MinFunction: H/L access routine */ /* for the min function. */ /*************************************/ globle void MinFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT argValue; int numberOfArguments, i; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"min",AT_LEAST,1)) == -1) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*============================================*/ /* Check that the first argument is a number. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"min",1,INTEGER_OR_FLOAT,returnValue) == FALSE) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*===========================================================*/ /* Loop through the remaining arguments, first checking each */ /* argument to see that it is a number, and then determining */ /* if the argument is less than the previous arguments and */ /* is thus the minimum value. */ /*===========================================================*/ for (i = 2 ; i <= numberOfArguments ; i++) { if (EnvArgTypeCheck(theEnv,"min",i,INTEGER_OR_FLOAT,&argValue) == FALSE) return; if (returnValue->type == INTEGER) { if (argValue.type == INTEGER) { if (ValueToLong(returnValue->value) > ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if ((double) ValueToLong(returnValue->value) > ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } else { if (argValue.type == INTEGER) { if (ValueToDouble(returnValue->value) > (double) ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if (ValueToDouble(returnValue->value) > ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } } return; } /*************************************/ /* MaxFunction: H/L access routine */ /* for the max function. */ /*************************************/ globle void MaxFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT argValue; int numberOfArguments, i; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"max",AT_LEAST,1)) == -1) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*============================================*/ /* Check that the first argument is a number. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"max",1,INTEGER_OR_FLOAT,returnValue) == FALSE) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*===========================================================*/ /* Loop through the remaining arguments, first checking each */ /* argument to see that it is a number, and then determining */ /* if the argument is greater than the previous arguments */ /* and is thus the maximum value. */ /*===========================================================*/ for (i = 2 ; i <= numberOfArguments ; i++) { if (EnvArgTypeCheck(theEnv,"max",i,INTEGER_OR_FLOAT,&argValue) == FALSE) return; if (returnValue->type == INTEGER) { if (argValue.type == INTEGER) { if (ValueToLong(returnValue->value) < ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if ((double) ValueToLong(returnValue->value) < ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } else { if (argValue.type == INTEGER) { if (ValueToDouble(returnValue->value) < (double) ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if (ValueToDouble(returnValue->value) < ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } } return; } #if ALLOW_ENVIRONMENT_GLOBALS globle intBool GetAutoFloatDividend() { return EnvGetAutoFloatDividend(GetCurrentEnvironment()); } globle intBool SetAutoFloatDividend( int value) { return EnvSetAutoFloatDividend(GetCurrentEnvironment(),value); } #endif clips_core_source_630/core/cstrccom.h0000755000175000017500000001455112461253173016231 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* CONSTRUCT COMMAND HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added ConstructsDeletable function. */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_cstrccom #define _H_cstrccom #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if (! RUN_TIME) LOCALE void AddConstructToModule(struct constructHeader *); #endif LOCALE intBool DeleteNamedConstruct(void *,const char *,struct construct *); LOCALE void *FindNamedConstructInModule(void *,const char *,struct construct *); LOCALE void *FindNamedConstructInModuleOrImports(void *,const char *,struct construct *); LOCALE void UndefconstructCommand(void *,const char *,struct construct *); LOCALE int PPConstruct(void *,const char *,const char *,struct construct *); LOCALE SYMBOL_HN *GetConstructModuleCommand(void *,const char *,struct construct *); LOCALE struct defmodule *GetConstructModule(void *,const char *,struct construct *); LOCALE intBool Undefconstruct(void *,void *,struct construct *); LOCALE void SaveConstruct(void *,void *,const char *,struct construct *); LOCALE const char *GetConstructNameString(struct constructHeader *); LOCALE const char *EnvGetConstructNameString(void *,struct constructHeader *); LOCALE const char *GetConstructModuleName(struct constructHeader *); LOCALE SYMBOL_HN *GetConstructNamePointer(struct constructHeader *); LOCALE void GetConstructListFunction(void *,const char *,DATA_OBJECT_PTR, struct construct *); LOCALE void GetConstructList(void *,DATA_OBJECT_PTR,struct construct *, struct defmodule *); LOCALE void ListConstructCommand(void *,const char *,struct construct *); LOCALE void ListConstruct(void *,struct construct *,const char *,struct defmodule *); LOCALE void SetNextConstruct(struct constructHeader *,struct constructHeader *); LOCALE struct defmoduleItemHeader *GetConstructModuleItem(struct constructHeader *); LOCALE const char *GetConstructPPForm(void *,struct constructHeader *); LOCALE void PPConstructCommand(void *,const char *,struct construct *); LOCALE struct constructHeader *GetNextConstructItem(void *,struct constructHeader *,int); LOCALE struct defmoduleItemHeader *GetConstructModuleItemByIndex(void *,struct defmodule *,int); LOCALE void FreeConstructHeaderModule(void *,struct defmoduleItemHeader *, struct construct *); LOCALE long DoForAllConstructs(void *, void (*)(void *,struct constructHeader *,void *), int,int,void *); LOCALE void DoForAllConstructsInModule(void *,void *, void (*)(void *,struct constructHeader *,void *), int,int,void *); LOCALE void InitializeConstructHeader(void *,const char *,struct constructHeader *,SYMBOL_HN *); LOCALE void SetConstructPPForm(void *,struct constructHeader *,const char *); LOCALE void *LookupConstruct(void *,struct construct *,const char *,intBool); #if DEBUGGING_FUNCTIONS LOCALE unsigned ConstructPrintWatchAccess(void *,struct construct *,const char *, EXPRESSION *, unsigned (*)(void *,void *), void (*)(void *,unsigned,void *)); LOCALE unsigned ConstructSetWatchAccess(void *,struct construct *,unsigned, EXPRESSION *, unsigned (*)(void *,void *), void (*)(void *,unsigned,void *)); #endif LOCALE intBool ConstructsDeletable(void *); #endif clips_core_source_630/core/parsefun.c0000755000175000017500000003375512375756073016254 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PARSING FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several parsing related */ /* functions including... */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed function declaration issue when */ /* BLOAD_ONLY compiler flag is set to 1. */ /* */ /*************************************************************/ #define _PARSEFUN_SOURCE_ #include "setup.h" #include #include "argacces.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "memalloc.h" #include "multifld.h" #include "prcdrpsr.h" #include "router.h" #include "strngrtr.h" #include "utility.h" #include "parsefun.h" #define PARSEFUN_DATA 11 struct parseFunctionData { char *ErrorString; size_t ErrorCurrentPosition; size_t ErrorMaximumPosition; char *WarningString; size_t WarningCurrentPosition; size_t WarningMaximumPosition; }; #define ParseFunctionData(theEnv) ((struct parseFunctionData *) GetEnvironmentData(theEnv,PARSEFUN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static int FindErrorCapture(void *,const char *); static int PrintErrorCapture(void *,const char *,const char *); static void DeactivateErrorCapture(void *); static void SetErrorCaptureValues(void *,DATA_OBJECT_PTR); #endif /*****************************************/ /* ParseFunctionDefinitions: Initializes */ /* the parsing related functions. */ /*****************************************/ globle void ParseFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,PARSEFUN_DATA,sizeof(struct parseFunctionData),NULL); #if ! RUN_TIME EnvDefineFunction2(theEnv,"check-syntax",'u',PTIEF CheckSyntaxFunction,"CheckSyntaxFunction","11s"); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /*******************************************/ /* CheckSyntaxFunction: H/L access routine */ /* for the check-syntax function. */ /*******************************************/ globle void CheckSyntaxFunction( void *theEnv, DATA_OBJECT *returnValue) { DATA_OBJECT theArg; /*===============================*/ /* Set up a default return value */ /* (TRUE for problems found). */ /*===============================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); /*=====================================================*/ /* Function check-syntax expects exactly one argument. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"check-syntax",EXACTLY,1) == -1) return; /*========================================*/ /* The argument should be of type STRING. */ /*========================================*/ if (EnvArgTypeCheck(theEnv,"check-syntax",1,STRING,&theArg) == FALSE) { return; } /*===================*/ /* Check the syntax. */ /*===================*/ CheckSyntax(theEnv,DOToString(theArg),returnValue); } /*********************************/ /* CheckSyntax: C access routine */ /* for the build function. */ /*********************************/ globle int CheckSyntax( void *theEnv, const char *theString, DATA_OBJECT_PTR returnValue) { const char *name; struct token theToken; struct expr *top; short rv; /*==============================*/ /* Set the default return value */ /* (TRUE for problems found). */ /*==============================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); /*===========================================*/ /* Create a string source router so that the */ /* string can be used as an input source. */ /*===========================================*/ if (OpenStringSource(theEnv,"check-syntax",theString,0) == 0) { return(TRUE); } /*=================================*/ /* Only expressions and constructs */ /* can have their syntax checked. */ /*=================================*/ GetToken(theEnv,"check-syntax",&theToken); if (theToken.type != LPAREN) { CloseStringSource(theEnv,"check-syntax"); SetpValue(returnValue,EnvAddSymbol(theEnv,"MISSING-LEFT-PARENTHESIS")); return(TRUE); } /*========================================*/ /* The next token should be the construct */ /* type or function name. */ /*========================================*/ GetToken(theEnv,"check-syntax",&theToken); if (theToken.type != SYMBOL) { CloseStringSource(theEnv,"check-syntax"); SetpValue(returnValue,EnvAddSymbol(theEnv,"EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS")); return(TRUE); } name = ValueToString(theToken.value); /*==============================================*/ /* Set up a router to capture the error output. */ /*==============================================*/ EnvAddRouter(theEnv,"error-capture",40, FindErrorCapture, PrintErrorCapture, NULL, NULL, NULL); /*================================*/ /* Determine if it's a construct. */ /*================================*/ if (FindConstruct(theEnv,name)) { ConstructData(theEnv)->CheckSyntaxMode = TRUE; rv = (short) ParseConstruct(theEnv,name,"check-syntax"); GetToken(theEnv,"check-syntax",&theToken); ConstructData(theEnv)->CheckSyntaxMode = FALSE; if (rv) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); CloseStringSource(theEnv,"check-syntax"); if ((rv != FALSE) || (ParseFunctionData(theEnv)->WarningString != NULL)) { SetErrorCaptureValues(theEnv,returnValue); DeactivateErrorCapture(theEnv); return(TRUE); } if (theToken.type != STOP) { SetpValue(returnValue,EnvAddSymbol(theEnv,"EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS")); DeactivateErrorCapture(theEnv); return(TRUE); } SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); DeactivateErrorCapture(theEnv); return(FALSE); } /*=======================*/ /* Parse the expression. */ /*=======================*/ top = Function2Parse(theEnv,"check-syntax",name); GetToken(theEnv,"check-syntax",&theToken); ClearParsedBindNames(theEnv); CloseStringSource(theEnv,"check-syntax"); if (top == NULL) { SetErrorCaptureValues(theEnv,returnValue); DeactivateErrorCapture(theEnv); return(TRUE); } if (theToken.type != STOP) { SetpValue(returnValue,EnvAddSymbol(theEnv,"EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS")); DeactivateErrorCapture(theEnv); ReturnExpression(theEnv,top); return(TRUE); } DeactivateErrorCapture(theEnv); ReturnExpression(theEnv,top); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return(FALSE); } /**************************************************/ /* DeactivateErrorCapture: Deactivates the error */ /* capture router and the strings used to store */ /* the captured information. */ /**************************************************/ static void DeactivateErrorCapture( void *theEnv) { if (ParseFunctionData(theEnv)->ErrorString != NULL) { rm(theEnv,ParseFunctionData(theEnv)->ErrorString,ParseFunctionData(theEnv)->ErrorMaximumPosition); ParseFunctionData(theEnv)->ErrorString = NULL; } if (ParseFunctionData(theEnv)->WarningString != NULL) { rm(theEnv,ParseFunctionData(theEnv)->WarningString,ParseFunctionData(theEnv)->WarningMaximumPosition); ParseFunctionData(theEnv)->WarningString = NULL; } ParseFunctionData(theEnv)->ErrorCurrentPosition = 0; ParseFunctionData(theEnv)->ErrorMaximumPosition = 0; ParseFunctionData(theEnv)->WarningCurrentPosition = 0; ParseFunctionData(theEnv)->WarningMaximumPosition = 0; EnvDeleteRouter(theEnv,"error-capture"); } /******************************************************************/ /* SetErrorCaptureValues: Stores the error/warnings captured when */ /* parsing an expression or construct into a multifield value. */ /* The first field contains the output sent to the WERROR */ /* logical name and the second field contains the output sent */ /* to the WWARNING logical name. FALSE is stored in either */ /* position if no output was sent to those logical names. */ /******************************************************************/ static void SetErrorCaptureValues( void *theEnv, DATA_OBJECT_PTR returnValue) { struct multifield *theMultifield; theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,2L); if (ParseFunctionData(theEnv)->ErrorString != NULL) { SetMFType(theMultifield,1,STRING); SetMFValue(theMultifield,1,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->ErrorString)); } else { SetMFType(theMultifield,1,SYMBOL); SetMFValue(theMultifield,1,EnvFalseSymbol(theEnv)); } if (ParseFunctionData(theEnv)->WarningString != NULL) { SetMFType(theMultifield,2,STRING); SetMFValue(theMultifield,2,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->WarningString)); } else { SetMFType(theMultifield,2,SYMBOL); SetMFValue(theMultifield,2,EnvFalseSymbol(theEnv)); } SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,2); SetpValue(returnValue,(void *) theMultifield); } /**********************************/ /* FindErrorCapture: Find routine */ /* for the check-syntax router. */ /**********************************/ static int FindErrorCapture( void *theEnv, const char *logicalName) { #if MAC_XCD #pragma unused(theEnv) #endif if ((strcmp(logicalName,WERROR) == 0) || (strcmp(logicalName,WWARNING) == 0)) { return(TRUE); } return(FALSE); } /************************************/ /* PrintErrorCapture: Print routine */ /* for the check-syntax router. */ /************************************/ static int PrintErrorCapture( void *theEnv, const char *logicalName, const char *str) { if (strcmp(logicalName,WERROR) == 0) { ParseFunctionData(theEnv)->ErrorString = AppendToString(theEnv,str,ParseFunctionData(theEnv)->ErrorString, &ParseFunctionData(theEnv)->ErrorCurrentPosition, &ParseFunctionData(theEnv)->ErrorMaximumPosition); } else if (strcmp(logicalName,WWARNING) == 0) { ParseFunctionData(theEnv)->WarningString = AppendToString(theEnv,str,ParseFunctionData(theEnv)->WarningString, &ParseFunctionData(theEnv)->WarningCurrentPosition, &ParseFunctionData(theEnv)->WarningMaximumPosition); } return(1); } #else /****************************************************/ /* CheckSyntaxFunction: This is the non-functional */ /* stub provided for use with a run-time version. */ /****************************************************/ globle void CheckSyntaxFunction( void *theEnv, DATA_OBJECT *returnValue) { PrintErrorID(theEnv,"PARSEFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function check-syntax does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); } /************************************************/ /* CheckSyntax: This is the non-functional stub */ /* provided for use with a run-time version. */ /************************************************/ globle int CheckSyntax( void *theEnv, const char *theString, DATA_OBJECT_PTR returnValue) { PrintErrorID(theEnv,"PARSEFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function check-syntax does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); return(TRUE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips_core_source_630/core/retract.h0000755000175000017500000000630412500146515016050 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RETRACT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the removal of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /* Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Removed pseudo-facts used in not CEs. */ /* */ /*************************************************************/ #ifndef _H_retract #define _H_retract #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RETRACT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct rdriveinfo { struct partialMatch *link; struct joinNode *jlist; struct rdriveinfo *next; }; LOCALE void NetworkRetract(void *,struct patternMatch *); LOCALE void ReturnPartialMatch(void *,struct partialMatch *); LOCALE void DestroyPartialMatch(void *,struct partialMatch *); LOCALE void FlushGarbagePartialMatches(void *); LOCALE void DeletePartialMatches(void *,struct partialMatch *); LOCALE void PosEntryRetractBeta(void *,struct partialMatch *,struct partialMatch *,int); LOCALE void PosEntryRetractAlpha(void *,struct partialMatch *,int); LOCALE intBool PartialMatchWillBeDeleted(void *,struct partialMatch *); #endif /* _H_retract */ clips_core_source_630/core/objrtgen.h0000755000175000017500000000532412374023162016220 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* 6.30: Added support for hashed memories and other */ /* join network changes. */ /* */ /*************************************************************/ #ifndef _H_objrtgen #define _H_objrtgen #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && (! BLOAD_ONLY) #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTGEN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ReplaceGetJNObjectValue(void *,EXPRESSION *,struct lhsParseNode *,int); LOCALE EXPRESSION *GenGetJNObjectValue(void *,struct lhsParseNode *,int); LOCALE EXPRESSION *ObjectJNVariableComparison(void *,struct lhsParseNode *,struct lhsParseNode *,int); LOCALE EXPRESSION *GenObjectPNConstantCompare(void *,struct lhsParseNode *); LOCALE void ReplaceGetPNObjectValue(void *,EXPRESSION *,struct lhsParseNode *); LOCALE EXPRESSION *GenGetPNObjectValue(void *,struct lhsParseNode *); LOCALE EXPRESSION *ObjectPNVariableComparison(void *,struct lhsParseNode *,struct lhsParseNode *); LOCALE void GenObjectLengthTest(void *,struct lhsParseNode *); LOCALE void GenObjectZeroLengthTest(void *,struct lhsParseNode *); #endif /* DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* _H_objrtgen */ clips_core_source_630/core/reorder.c0000755000175000017500000021151712461264174016055 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 06/14/14 */ /* */ /* REORDER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines necessary for converting the */ /* the LHS of a rule into an appropriate form suitable for */ /* the KB Rete topology. This includes transforming the */ /* LHS so there is at most one "or" CE (and this is the */ /* first CE of the LHS if it is used), adding initial */ /* patterns to the LHS (if no LHS is specified or a "test" */ /* or "not" CE is the first pattern within an "and" CE), */ /* removing redundant CEs, and determining appropriate */ /* information on nesting for implementing joins from the */ /* right. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Support for join network changes. */ /* */ /* Changes to the algorithm for processing */ /* not/and CE groups. */ /* */ /* Additional optimizations for combining */ /* conditional elements. */ /* */ /* Added support for hashed alpha memories. */ /* */ /*************************************************************/ #define _REORDER_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "cstrnutl.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "pattern.h" #include "prntutil.h" #include "router.h" #include "rulelhs.h" #if DEVELOPER && DEBUGGING_FUNCTIONS #include "watch.h" #include "rulepsr.h" #endif #include "reorder.h" struct variableReference { struct symbolHashNode *name; int depth; struct variableReference *next; }; struct groupReference { struct lhsParseNode *theGroup; int depth; struct groupReference *next; }; /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct lhsParseNode *ReverseAndOr(void *,struct lhsParseNode *,struct lhsParseNode *,int); static struct lhsParseNode *PerformReorder1(void *,struct lhsParseNode *,int *,int); static struct lhsParseNode *PerformReorder2(void *,struct lhsParseNode *,int *,int); static struct lhsParseNode *CompressCEs(void *,struct lhsParseNode *,int *,int); static void IncrementNandDepth(void *,struct lhsParseNode *,int); static struct lhsParseNode *CreateInitialPattern(void *); static struct lhsParseNode *ReorderDriver(void *,struct lhsParseNode *,int *,int,int); static struct lhsParseNode *AddRemainingInitialPatterns(void *,struct lhsParseNode *); static struct lhsParseNode *AssignPatternIndices(struct lhsParseNode *,short,int,short); static void PropagateIndexSlotPatternValues(struct lhsParseNode *, short,short, struct symbolHashNode *, short); static void PropagateJoinDepth(struct lhsParseNode *,short); static void PropagateNandDepth(struct lhsParseNode *,int,int); static void MarkExistsNands(struct lhsParseNode *); static int PropagateWhichCE(struct lhsParseNode *,int); /* static void PrintNodes(void *,const char *,struct lhsParseNode *); */ /********************************************/ /* ReorderPatterns: Reorders a group of CEs */ /* to accommodate KB Rete topology. */ /********************************************/ globle struct lhsParseNode *ReorderPatterns( void *theEnv, struct lhsParseNode *theLHS, int *anyChange) { struct lhsParseNode *newLHS, *tempLHS, *lastLHS; /*=============================================*/ /* If the LHS of the rule was left unspecified */ /* (e.g., (defrule x => ...)), then nothing */ /* more needs to be done. */ /*=============================================*/ if (theLHS == NULL) return(theLHS); /*===========================================================*/ /* The LHS of a rule is enclosed within an implied "and" CE. */ /*===========================================================*/ newLHS = GetLHSParseNode(theEnv); newLHS->type = AND_CE; newLHS->right = theLHS; /*==============================================================*/ /* Mark the nodes to indicate which CE they're associated with. */ /*==============================================================*/ PropagateWhichCE(newLHS,0); /*=======================================================*/ /* Reorder the patterns to support the KB Rete topology. */ /*=======================================================*/ newLHS = ReorderDriver(theEnv,newLHS,anyChange,1,1); newLHS = ReorderDriver(theEnv,newLHS,anyChange,2,1); /*===========================================*/ /* The top level and CE may have disappeared */ /* as a result of pattern compression. */ /*===========================================*/ if (newLHS->type == OR_CE) { for (tempLHS = newLHS->right, lastLHS = NULL; tempLHS != NULL; lastLHS = tempLHS, tempLHS = tempLHS->bottom) { if (tempLHS->type != AND_CE) { theLHS = GetLHSParseNode(theEnv); theLHS->type = AND_CE; theLHS->right = tempLHS; theLHS->bottom = tempLHS->bottom; tempLHS->bottom = NULL; if (lastLHS == NULL) { newLHS->right = theLHS; } else { lastLHS->bottom = theLHS; } tempLHS = theLHS; } } } else if (newLHS->type != AND_CE) { theLHS = newLHS; newLHS = GetLHSParseNode(theEnv); newLHS->type = AND_CE; newLHS->right = theLHS; } /*================================================*/ /* Mark exist not/and groups within the patterns. */ /*================================================*/ if (newLHS->type == OR_CE) { for (theLHS = newLHS->right; theLHS != NULL; theLHS = theLHS->bottom) { MarkExistsNands(theLHS->right); } } else { MarkExistsNands(newLHS->right); } /*=====================================================*/ /* Add initial patterns where needed (such as before a */ /* "test" CE or "not" CE which is the first CE within */ /* an "and" CE). */ /*=====================================================*/ AddInitialPatterns(theEnv,newLHS); /*===========================================================*/ /* Number the user specified patterns. Patterns added while */ /* analyzing the rule (such as placing initial-fact patterns */ /* before not CEs) are not numbered so that there is no */ /* confusion when an error message refers to a CE. Also */ /* propagate field and slot values throughout each pattern. */ /*===========================================================*/ if (newLHS->type == OR_CE) theLHS = newLHS->right; else theLHS = newLHS; for (; theLHS != NULL; theLHS = theLHS->bottom) { AssignPatternIndices(theLHS->right,1,1,0); } /*===========================*/ /* Return the processed LHS. */ /*===========================*/ return(newLHS); } /******************************************/ /* ReorderDriver: Reorders a group of CEs */ /* to accommodate KB Rete topology. */ /******************************************/ static struct lhsParseNode *ReorderDriver( void *theEnv, struct lhsParseNode *theLHS, int *anyChange, int pass, int depth) { struct lhsParseNode *argPtr; struct lhsParseNode *before, *save; int change, newChange; *anyChange = FALSE; /*===================================*/ /* Continue processing the LHS until */ /* no more changes have been made. */ /*===================================*/ change = TRUE; while (change) { /*==================================*/ /* No change yet on this iteration. */ /*==================================*/ change = FALSE; /*=======================================*/ /* Reorder the current level of the LHS. */ /*=======================================*/ if ((theLHS->type == AND_CE) || (theLHS->type == NOT_CE) || (theLHS->type == OR_CE)) { if (pass == 1) theLHS = PerformReorder1(theEnv,theLHS,&newChange,depth); else theLHS = PerformReorder2(theEnv,theLHS,&newChange,depth); if (newChange) { *anyChange = TRUE; change = TRUE; } theLHS = CompressCEs(theEnv,theLHS,&newChange,depth); if (newChange) { *anyChange = TRUE; change = TRUE; } } /*=====================================================*/ /* Recursively reorder CEs at lower levels in the LHS. */ /*=====================================================*/ before = NULL; argPtr = theLHS->right; while (argPtr != NULL) { /*==================================*/ /* Remember the next CE to reorder. */ /*==================================*/ save = argPtr->bottom; /*============================================*/ /* Reorder the current CE at the lower level. */ /*============================================*/ if ((argPtr->type == AND_CE) || (argPtr->type == NOT_CE) || (argPtr->type == OR_CE)) { if (before == NULL) { argPtr->bottom = NULL; theLHS->right = ReorderDriver(theEnv,argPtr,&newChange,pass,depth+1); theLHS->right->bottom = save; before = theLHS->right; } else { argPtr->bottom = NULL; before->bottom = ReorderDriver(theEnv,argPtr,&newChange,pass,depth+1); before->bottom->bottom = save; before = before->bottom; } if (newChange) { *anyChange = TRUE; change = TRUE; } } else { before = argPtr; } /*====================================*/ /* Move on to the next CE to reorder. */ /*====================================*/ argPtr = save; } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /********************/ /* MarkExistsNands: */ /********************/ static void MarkExistsNands( struct lhsParseNode *theLHS) { int currentDepth = 1; struct lhsParseNode *tmpLHS; while (theLHS != NULL) { if (IsExistsSubjoin(theLHS,currentDepth)) { theLHS->existsNand = TRUE; for (tmpLHS = theLHS; tmpLHS != NULL; tmpLHS = tmpLHS->bottom) { tmpLHS->beginNandDepth--; if (tmpLHS->endNandDepth <= currentDepth) { break; } else { tmpLHS->endNandDepth--; } } } currentDepth = theLHS->endNandDepth; theLHS = theLHS->bottom; } } /****************************************************************/ /* AddInitialPatterns: Add initial patterns to CEs where needed */ /* (such as before a "test" CE or "not" CE which is the first */ /* CE within an "and" CE). */ /****************************************************************/ globle void AddInitialPatterns( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *thePattern; /*====================================================*/ /* If there are multiple disjuncts for the rule, then */ /* add initial patterns to each disjunct separately. */ /*====================================================*/ if (theLHS->type == OR_CE) { for (thePattern = theLHS->right; thePattern != NULL; thePattern = thePattern->bottom) { AddInitialPatterns(theEnv,thePattern); } return; } /*================================*/ /* Handle the remaining patterns. */ /*================================*/ theLHS->right = AddRemainingInitialPatterns(theEnv,theLHS->right); } /***********************************************************/ /* PerformReorder1: Reorders a group of CEs to accommodate */ /* KB Rete topology. The first pass of this function */ /* transforms or CEs into equivalent forms. */ /***********************************************************/ static struct lhsParseNode *PerformReorder1( void *theEnv, struct lhsParseNode *theLHS, int *newChange, int depth) { struct lhsParseNode *argPtr, *lastArg, *nextArg; struct lhsParseNode *tempArg, *newNode; int count; int change; /*======================================================*/ /* Loop through the CEs as long as changes can be made. */ /*======================================================*/ change = TRUE; *newChange = FALSE; while (change) { change = FALSE; count = 1; lastArg = NULL; for (argPtr = theLHS->right; argPtr != NULL;) { /*=============================================================*/ /* Convert and/or CE combinations into or/and CE combinations. */ /*=============================================================*/ if ((theLHS->type == AND_CE) && (argPtr->type == OR_CE)) { theLHS = ReverseAndOr(theEnv,theLHS,argPtr->right,count); change = TRUE; *newChange = TRUE; break; } /*==============================================================*/ /* Convert not/or CE combinations into and/not CE combinations. */ /*==============================================================*/ else if ((theLHS->type == NOT_CE) && (argPtr->type == OR_CE)) { change = TRUE; *newChange = TRUE; tempArg = argPtr->right; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); theLHS->type = AND_CE; theLHS->right = tempArg; while (tempArg != NULL) { newNode = GetLHSParseNode(theEnv); CopyLHSParseNode(theEnv,newNode,tempArg,FALSE); newNode->right = tempArg->right; newNode->bottom = NULL; tempArg->type = NOT_CE; tempArg->negated = FALSE; tempArg->exists = FALSE; tempArg->existsNand = FALSE; tempArg->logical = FALSE; tempArg->value = NULL; tempArg->expression = NULL; tempArg->secondaryExpression = NULL; tempArg->right = newNode; tempArg = tempArg->bottom; } break; } /*=====================================*/ /* Remove duplication of or CEs within */ /* or CEs and and CEs within and CEs. */ /*=====================================*/ else if (((theLHS->type == OR_CE) && (argPtr->type == OR_CE)) || ((theLHS->type == AND_CE) && (argPtr->type == AND_CE))) { if (argPtr->logical) theLHS->logical = TRUE; change = TRUE; *newChange = TRUE; tempArg = argPtr->right; nextArg = argPtr->bottom; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); if (lastArg == NULL) { theLHS->right = tempArg; } else { lastArg->bottom = tempArg; } argPtr = tempArg; while (tempArg->bottom != NULL) tempArg = tempArg->bottom; tempArg->bottom = nextArg; } /*===================================================*/ /* If no changes are needed, move on to the next CE. */ /*===================================================*/ else { count++; lastArg = argPtr; argPtr = argPtr->bottom; } } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /***********************************************************/ /* PerformReorder2: Reorders a group of CEs to accommodate */ /* KB Rete topology. The second pass performs all other */ /* transformations not associated with the or CE. */ /***********************************************************/ static struct lhsParseNode *PerformReorder2( void *theEnv, struct lhsParseNode *theLHS, int *newChange, int depth) { struct lhsParseNode *argPtr; int change; /*======================================================*/ /* Loop through the CEs as long as changes can be made. */ /*======================================================*/ change = TRUE; *newChange = FALSE; while (change) { change = FALSE; for (argPtr = theLHS->right; argPtr != NULL;) { /*=======================================================*/ /* A sequence of three not CEs grouped within each other */ /* can be replaced with a single not CE. For example, */ /* (not (not (not (a)))) can be replaced with (not (a)). */ /*=======================================================*/ if ((theLHS->type == NOT_CE) && (argPtr->type == NOT_CE) && (argPtr->right != NULL) && (argPtr->right->type == NOT_CE)) { change = TRUE; *newChange = TRUE; theLHS->right = argPtr->right->right; argPtr->right->right = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*==========================================*/ /* Replace two not CEs containing a pattern */ /* CE with an exists pattern CE. */ /*==========================================*/ else if ((theLHS->type == NOT_CE) && (argPtr->type == NOT_CE) && (argPtr->right != NULL) && (argPtr->right->type == PATTERN_CE)) { change = TRUE; *newChange = TRUE; CopyLHSParseNode(theEnv,theLHS,argPtr->right,FALSE); theLHS->negated = TRUE; theLHS->exists = TRUE; theLHS->existsNand = FALSE; theLHS->right = argPtr->right->right; argPtr->right->networkTest = NULL; argPtr->right->externalNetworkTest = NULL; argPtr->right->secondaryNetworkTest = NULL; argPtr->right->externalRightHash = NULL; argPtr->right->externalLeftHash = NULL; argPtr->right->leftHash = NULL; argPtr->right->rightHash = NULL; argPtr->right->betaHash = NULL; argPtr->right->expression = NULL; argPtr->right->secondaryExpression = NULL; argPtr->right->userData = NULL; argPtr->right->right = NULL; argPtr->right->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*======================================*/ /* Replace not CEs containing a pattern */ /* CE with a negated pattern CE. */ /*======================================*/ else if ((theLHS->type == NOT_CE) && (argPtr->type == PATTERN_CE)) { change = TRUE; *newChange = TRUE; CopyLHSParseNode(theEnv,theLHS,argPtr,FALSE); theLHS->negated = TRUE; theLHS->exists = FALSE; theLHS->existsNand = FALSE; theLHS->right = argPtr->right; argPtr->networkTest = NULL; argPtr->externalNetworkTest = NULL; argPtr->secondaryNetworkTest = NULL; argPtr->externalRightHash = NULL; argPtr->externalLeftHash = NULL; argPtr->constantSelector = NULL; argPtr->constantValue = NULL; argPtr->leftHash = NULL; argPtr->rightHash = NULL; argPtr->betaHash = NULL; argPtr->expression = NULL; argPtr->secondaryExpression = NULL; argPtr->userData = NULL; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*============================================================*/ /* Replace "and" and "not" CEs contained within a not CE with */ /* just the and CE, but increment the nand depths of the */ /* pattern contained within. */ /*============================================================*/ else if ((theLHS->type == NOT_CE) && ((argPtr->type == AND_CE) || (argPtr->type == NOT_CE))) { change = TRUE; *newChange = TRUE; theLHS->type = argPtr->type; theLHS->negated = argPtr->negated; theLHS->exists = argPtr->exists; theLHS->existsNand = argPtr->existsNand; theLHS->value = argPtr->value; theLHS->logical = argPtr->logical; theLHS->right = argPtr->right; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); IncrementNandDepth(theEnv,theLHS->right,TRUE); break; } /*===================================================*/ /* If no changes are needed, move on to the next CE. */ /*===================================================*/ else { argPtr = argPtr->bottom; } } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /**************************************************/ /* ReverseAndOr: Switches and/or CEs into */ /* equivalent or/and CEs. For example: */ /* */ /* (and (or a b) (or c d)) */ /* */ /* would be converted to */ /* */ /* (or (and a (or c d)) (and b (or c d))), */ /* */ /* if the "or" CE being expanded was (or a b). */ /**************************************************/ static struct lhsParseNode *ReverseAndOr( void *theEnv, struct lhsParseNode *listOfCEs, struct lhsParseNode *orCE, int orPosition) { int count; struct lhsParseNode *listOfExpandedOrCEs = NULL; struct lhsParseNode *lastExpandedOrCE = NULL; struct lhsParseNode *copyOfCEs, *replaceCE; /*========================================================*/ /* Loop through each of the CEs contained within the "or" */ /* CE that is being expanded into the enclosing "and" CE. */ /*========================================================*/ while (orCE != NULL) { /*===============================*/ /* Make a copy of the and/or CE. */ /*===============================*/ copyOfCEs = CopyLHSParseNodes(theEnv,listOfCEs); /*====================================================*/ /* Get a pointer to the "or" CE being expanded in the */ /* copy just made based on the position of the "or" */ /* CE in the original and/or CE (e.g., 1st, 2nd). */ /*====================================================*/ for (count = 1, replaceCE = copyOfCEs->right; count != orPosition; count++, replaceCE = replaceCE->bottom) { /* Do Nothing*/ } /*===================================================*/ /* Delete the contents of the "or" CE being expanded */ /* in the copy of the and/or CE. From the example */ /* above, (and (or a b) (or c d)) would be replaced */ /* with (and (or) (or c d)). Note that the "or" CE */ /* is still left as a placeholder. */ /*===================================================*/ ReturnLHSParseNodes(theEnv,replaceCE->right); /*======================================================*/ /* Copy the current CE being examined in the "or" CE to */ /* the placeholder left in the and/or CE. From the */ /* example above, (and (or) (or c d)) would be replaced */ /* with (and a (or c d)) if the "a" pattern from the */ /* "or" CE was being examined or (and b (or c d)) if */ /* the "b" pattern from the "or" CE was being examined. */ /*======================================================*/ CopyLHSParseNode(theEnv,replaceCE,orCE,TRUE); replaceCE->right = CopyLHSParseNodes(theEnv,orCE->right); /*====================================*/ /* Add the newly expanded "and" CE to */ /* the list of CEs already expanded. */ /*====================================*/ if (lastExpandedOrCE == NULL) { listOfExpandedOrCEs = copyOfCEs; copyOfCEs->bottom = NULL; lastExpandedOrCE = copyOfCEs; } else { lastExpandedOrCE->bottom = copyOfCEs; copyOfCEs->bottom = NULL; lastExpandedOrCE = copyOfCEs; } /*=======================================================*/ /* Move on to the next CE in the "or" CE being expanded. */ /*=======================================================*/ orCE = orCE->bottom; } /*=====================================================*/ /* Release the original and/or CE list to free memory. */ /*=====================================================*/ ReturnLHSParseNodes(theEnv,listOfCEs); /*================================================*/ /* Wrap an or CE around the list of expanded CEs. */ /*================================================*/ copyOfCEs = GetLHSParseNode(theEnv); copyOfCEs->type = OR_CE; copyOfCEs->right = listOfExpandedOrCEs; /*================================*/ /* Return the newly expanded CEs. */ /*================================*/ return(copyOfCEs); } /****************/ /* CompressCEs: */ /****************/ static struct lhsParseNode *CompressCEs( void *theEnv, struct lhsParseNode *theLHS, int *newChange, int depth) { struct lhsParseNode *argPtr, *lastArg, *nextArg; struct lhsParseNode *tempArg; int change; struct expr *e1, *e2; /*======================================================*/ /* Loop through the CEs as long as changes can be made. */ /*======================================================*/ change = TRUE; *newChange = FALSE; while (change) { change = FALSE; lastArg = NULL; for (argPtr = theLHS->right; argPtr != NULL;) { /*=====================================*/ /* Remove duplication of or CEs within */ /* or CEs and and CEs within and CEs. */ /*=====================================*/ if (((theLHS->type == OR_CE) && (argPtr->type == OR_CE)) || ((theLHS->type == AND_CE) && (argPtr->type == AND_CE))) { if (argPtr->logical) theLHS->logical = TRUE; change = TRUE; *newChange = TRUE; tempArg = argPtr->right; nextArg = argPtr->bottom; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); if (lastArg == NULL) { theLHS->right = tempArg; } else { lastArg->bottom = tempArg; } argPtr = tempArg; while (tempArg->bottom != NULL) tempArg = tempArg->bottom; tempArg->bottom = nextArg; } /*=======================================================*/ /* Replace not CEs containing a test CE with just a test */ /* CE with the original test CE condition negated. */ /*=======================================================*/ else if ((theLHS->type == NOT_CE) && (argPtr->type == TEST_CE)) { change = TRUE; *newChange = TRUE; tempArg = GetLHSParseNode(theEnv); tempArg->type = FCALL; tempArg->value = ExpressionData(theEnv)->PTR_NOT; tempArg->bottom = argPtr->expression; argPtr->expression = tempArg; CopyLHSParseNode(theEnv,theLHS,argPtr,TRUE); ReturnLHSParseNodes(theEnv,argPtr); theLHS->right = NULL; break; } /*==============================*/ /* Two adjacent test CEs within */ /* an and CE can be combined. */ /*==============================*/ else if ((theLHS->type == AND_CE) && (argPtr->type == TEST_CE) && ((argPtr->bottom != NULL) ? argPtr->bottom->type == TEST_CE : FALSE) && (argPtr->beginNandDepth == argPtr->endNandDepth) && (argPtr->endNandDepth == argPtr->bottom->beginNandDepth)) { change = TRUE; *newChange = TRUE; argPtr->expression = CombineLHSParseNodes(theEnv,argPtr->expression,argPtr->bottom->expression); argPtr->bottom->expression = NULL; tempArg = argPtr->bottom; argPtr->bottom = tempArg->bottom; tempArg->bottom = NULL; ReturnLHSParseNodes(theEnv,tempArg); } /*========================================================*/ /* A test CE can be attached to the preceding pattern CE. */ /*========================================================*/ else if ((theLHS->type == AND_CE) && (argPtr->type == PATTERN_CE) && ((argPtr->bottom != NULL) ? argPtr->bottom->type == TEST_CE : FALSE) && (argPtr->negated == FALSE) && (argPtr->exists == FALSE) && (argPtr->beginNandDepth == argPtr->endNandDepth) && (argPtr->endNandDepth == argPtr->bottom->beginNandDepth)) { int endNandDepth; change = TRUE; *newChange = TRUE; endNandDepth = argPtr->bottom->endNandDepth; if (argPtr->negated || argPtr->exists) { e1 = LHSParseNodesToExpression(theEnv,argPtr->secondaryExpression); e2 = LHSParseNodesToExpression(theEnv,argPtr->bottom->expression); e1 = CombineExpressions(theEnv,e1,e2); ReturnLHSParseNodes(theEnv,argPtr->secondaryExpression); argPtr->secondaryExpression = ExpressionToLHSParseNodes(theEnv,e1); ReturnExpression(theEnv,e1); } else { argPtr->expression = CombineLHSParseNodes(theEnv,argPtr->expression,argPtr->bottom->expression); argPtr->bottom->expression = NULL; } if ((theLHS->right == argPtr) && ((argPtr->beginNandDepth - 1) == endNandDepth)) { if (argPtr->negated) { argPtr->negated = FALSE; argPtr->exists = TRUE; e1 = LHSParseNodesToExpression(theEnv,argPtr->secondaryExpression); e1 = NegateExpression(theEnv,e1); ReturnLHSParseNodes(theEnv,argPtr->secondaryExpression); argPtr->secondaryExpression = ExpressionToLHSParseNodes(theEnv,e1); ReturnExpression(theEnv,e1); } else if (argPtr->exists) { argPtr->negated = TRUE; argPtr->exists = FALSE; e1 = LHSParseNodesToExpression(theEnv,argPtr->secondaryExpression); e1 = NegateExpression(theEnv,e1); ReturnLHSParseNodes(theEnv,argPtr->secondaryExpression); argPtr->secondaryExpression = ExpressionToLHSParseNodes(theEnv,e1); ReturnExpression(theEnv,e1); } else { argPtr->negated = TRUE; } PropagateNandDepth(argPtr,endNandDepth,endNandDepth); } /*========================================*/ /* Detach the test CE from its parent and */ /* dispose of the data structures. */ /*========================================*/ tempArg = argPtr->bottom; argPtr->bottom = tempArg->bottom; tempArg->bottom = NULL; ReturnLHSParseNodes(theEnv,tempArg); } /*=====================================*/ /* Replace and CEs containing a single */ /* test CE with just a test CE. */ /*=====================================*/ else if ((theLHS->type == AND_CE) && (argPtr->type == TEST_CE) && (theLHS->right == argPtr) && (argPtr->bottom == NULL)) { change = TRUE; *newChange = TRUE; CopyLHSParseNode(theEnv,theLHS,argPtr,TRUE); theLHS->right = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*=======================================================*/ /* Replace and CEs containing a single pattern CE with */ /* just a pattern CE if this is not the top most and CE. */ /*=======================================================*/ else if ((theLHS->type == AND_CE) && (argPtr->type == PATTERN_CE) && (theLHS->right == argPtr) && (argPtr->bottom == NULL) && (depth > 1)) { change = TRUE; *newChange = TRUE; CopyLHSParseNode(theEnv,theLHS,argPtr,FALSE); theLHS->right = argPtr->right; argPtr->networkTest = NULL; argPtr->externalNetworkTest = NULL; argPtr->secondaryNetworkTest = NULL; argPtr->externalRightHash = NULL; argPtr->externalLeftHash = NULL; argPtr->constantSelector = NULL; argPtr->constantValue = NULL; argPtr->leftHash = NULL; argPtr->rightHash = NULL; argPtr->betaHash = NULL; argPtr->expression = NULL; argPtr->secondaryExpression = NULL; argPtr->userData = NULL; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*===================================================*/ /* If no changes are needed, move on to the next CE. */ /*===================================================*/ else { lastArg = argPtr; argPtr = argPtr->bottom; } } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /*********************************************************************/ /* CopyLHSParseNodes: Copies a linked group of conditional elements. */ /*********************************************************************/ globle struct lhsParseNode *CopyLHSParseNodes( void *theEnv, struct lhsParseNode *listOfCEs) { struct lhsParseNode *newList; if (listOfCEs == NULL) { return(NULL); } newList = get_struct(theEnv,lhsParseNode); CopyLHSParseNode(theEnv,newList,listOfCEs,TRUE); newList->right = CopyLHSParseNodes(theEnv,listOfCEs->right); newList->bottom = CopyLHSParseNodes(theEnv,listOfCEs->bottom); return(newList); } /**********************************************************/ /* CopyLHSParseNode: Copies a single conditional element. */ /**********************************************************/ globle void CopyLHSParseNode( void *theEnv, struct lhsParseNode *dest, struct lhsParseNode *src, int duplicate) { dest->type = src->type; dest->value = src->value; dest->negated = src->negated; dest->exists = src->exists; dest->existsNand = src->existsNand; dest->bindingVariable = src->bindingVariable; dest->withinMultifieldSlot = src->withinMultifieldSlot; dest->multifieldSlot = src->multifieldSlot; dest->multiFieldsBefore = src->multiFieldsBefore; dest->multiFieldsAfter = src->multiFieldsAfter; dest->singleFieldsBefore = src->singleFieldsBefore; dest->singleFieldsAfter = src->singleFieldsAfter; dest->logical = src->logical; dest->userCE = src->userCE; dest->marked = src->marked; dest->whichCE = src->whichCE; dest->referringNode = src->referringNode; dest->patternType = src->patternType; dest->pattern = src->pattern; dest->index = src->index; dest->slot = src->slot; dest->slotNumber = src->slotNumber; dest->beginNandDepth = src->beginNandDepth; dest->endNandDepth = src->endNandDepth; dest->joinDepth = src->joinDepth; /*==========================================================*/ /* The duplicate flag controls whether pointers to existing */ /* data structures are used when copying some slots or if */ /* new copies of the data structures are made. */ /*==========================================================*/ if (duplicate) { dest->networkTest = CopyExpression(theEnv,src->networkTest); dest->externalNetworkTest = CopyExpression(theEnv,src->externalNetworkTest); dest->secondaryNetworkTest = CopyExpression(theEnv,src->secondaryNetworkTest); dest->externalRightHash = CopyExpression(theEnv,src->externalRightHash); dest->externalLeftHash = CopyExpression(theEnv,src->externalLeftHash); dest->constantSelector = CopyExpression(theEnv,src->constantSelector); dest->constantValue = CopyExpression(theEnv,src->constantValue); dest->leftHash = CopyExpression(theEnv,src->leftHash); dest->betaHash = CopyExpression(theEnv,src->betaHash); dest->rightHash = CopyExpression(theEnv,src->rightHash); if (src->userData == NULL) { dest->userData = NULL; } else if (src->patternType->copyUserDataFunction == NULL) { dest->userData = src->userData; } else { dest->userData = (*src->patternType->copyUserDataFunction)(theEnv,src->userData); } dest->expression = CopyLHSParseNodes(theEnv,src->expression); dest->secondaryExpression = CopyLHSParseNodes(theEnv,src->secondaryExpression); dest->constraints = CopyConstraintRecord(theEnv,src->constraints); if (dest->constraints != NULL) dest->derivedConstraints = TRUE; else dest->derivedConstraints = FALSE; } else { dest->networkTest = src->networkTest; dest->externalNetworkTest = src->externalNetworkTest; dest->secondaryNetworkTest = src->secondaryNetworkTest; dest->externalRightHash = src->externalRightHash; dest->externalLeftHash = src->externalLeftHash; dest->constantSelector = src->constantSelector; dest->constantValue = src->constantValue; dest->leftHash = src->leftHash; dest->betaHash = src->betaHash; dest->rightHash = src->rightHash; dest->userData = src->userData; dest->expression = src->expression; dest->secondaryExpression = src->secondaryExpression; dest->derivedConstraints = FALSE; dest->constraints = src->constraints; } } /****************************************************/ /* GetLHSParseNode: Creates an empty node structure */ /* used for building conditional elements. */ /****************************************************/ globle struct lhsParseNode *GetLHSParseNode( void *theEnv) { struct lhsParseNode *newNode; newNode = get_struct(theEnv,lhsParseNode); newNode->type = UNKNOWN_VALUE; newNode->value = NULL; newNode->negated = FALSE; newNode->exists = FALSE; newNode->existsNand = FALSE; newNode->bindingVariable = FALSE; newNode->withinMultifieldSlot = FALSE; newNode->multifieldSlot = FALSE; newNode->multiFieldsBefore = 0; newNode->multiFieldsAfter = 0; newNode->singleFieldsBefore = 0; newNode->singleFieldsAfter = 0; newNode->logical = FALSE; newNode->derivedConstraints = FALSE; newNode->userCE = TRUE; newNode->marked = FALSE; newNode->whichCE = 0; newNode->constraints = NULL; newNode->referringNode = NULL; newNode->patternType = NULL; newNode->pattern = -1; newNode->index = -1; newNode->slot = NULL; newNode->slotNumber = -1; newNode->beginNandDepth = 1; newNode->endNandDepth = 1; newNode->joinDepth = 0; newNode->userData = NULL; newNode->networkTest = NULL; newNode->externalNetworkTest = NULL; newNode->secondaryNetworkTest = NULL; newNode->externalRightHash = NULL; newNode->externalLeftHash = NULL; newNode->constantSelector = NULL; newNode->constantValue = NULL; newNode->leftHash = NULL; newNode->betaHash = NULL; newNode->rightHash = NULL; newNode->expression = NULL; newNode->secondaryExpression = NULL; newNode->right = NULL; newNode->bottom = NULL; return(newNode); } /********************************************************/ /* ReturnLHSParseNodes: Returns a multiply linked list */ /* of lhsParseNode structures to the memory manager. */ /********************************************************/ globle void ReturnLHSParseNodes( void *theEnv, struct lhsParseNode *waste) { if (waste != NULL) { ReturnExpression(theEnv,waste->networkTest); ReturnExpression(theEnv,waste->externalNetworkTest); ReturnExpression(theEnv,waste->secondaryNetworkTest); ReturnExpression(theEnv,waste->externalRightHash); ReturnExpression(theEnv,waste->externalLeftHash); ReturnExpression(theEnv,waste->constantSelector); ReturnExpression(theEnv,waste->constantValue); ReturnExpression(theEnv,waste->leftHash); ReturnExpression(theEnv,waste->betaHash); ReturnExpression(theEnv,waste->rightHash); ReturnLHSParseNodes(theEnv,waste->right); ReturnLHSParseNodes(theEnv,waste->bottom); ReturnLHSParseNodes(theEnv,waste->expression); ReturnLHSParseNodes(theEnv,waste->secondaryExpression); if (waste->derivedConstraints) RemoveConstraint(theEnv,waste->constraints); if ((waste->userData != NULL) && (waste->patternType->returnUserDataFunction != NULL)) { (*waste->patternType->returnUserDataFunction)(theEnv,waste->userData); } rtn_struct(theEnv,lhsParseNode,waste); } } /********************************************************/ /* ExpressionToLHSParseNodes: Copies an expression into */ /* the equivalent lhsParseNode data structures. */ /********************************************************/ globle struct lhsParseNode *ExpressionToLHSParseNodes( void *theEnv, struct expr *expressionList) { struct lhsParseNode *newList, *theList; struct FunctionDefinition *theFunction; int i, theRestriction; /*===========================================*/ /* A NULL expression requires no conversion. */ /*===========================================*/ if (expressionList == NULL) return(NULL); /*====================================*/ /* Recursively convert the expression */ /* to lhsParseNode data structures. */ /*====================================*/ newList = GetLHSParseNode(theEnv); newList->type = expressionList->type; newList->value = expressionList->value; newList->right = ExpressionToLHSParseNodes(theEnv,expressionList->nextArg); newList->bottom = ExpressionToLHSParseNodes(theEnv,expressionList->argList); /*==================================================*/ /* If the expression is a function call, then store */ /* the constraint information for the functions */ /* arguments in the lshParseNode data structures. */ /*==================================================*/ if (newList->type != FCALL) return(newList); theFunction = (struct FunctionDefinition *) newList->value; for (theList = newList->bottom, i = 1; theList != NULL; theList = theList->right, i++) { if (theList->type == SF_VARIABLE) { theRestriction = GetNthRestriction(theFunction,i); theList->constraints = ArgumentTypeToConstraintRecord(theEnv,theRestriction); theList->derivedConstraints = TRUE; } } /*==================================*/ /* Return the converted expression. */ /*==================================*/ return(newList); } /******************************************************************/ /* LHSParseNodesToExpression: Copies lhsParseNode data structures */ /* into the equivalent expression data structures. */ /******************************************************************/ globle struct expr *LHSParseNodesToExpression( void *theEnv, struct lhsParseNode *nodeList) { struct expr *newList; if (nodeList == NULL) { return(NULL); } newList = get_struct(theEnv,expr); newList->type = nodeList->type; newList->value = nodeList->value; newList->nextArg = LHSParseNodesToExpression(theEnv,nodeList->right); newList->argList = LHSParseNodesToExpression(theEnv,nodeList->bottom); return(newList); } /************************************************************/ /* IncrementNandDepth: Increments the nand depth of a group */ /* of CEs. The nand depth is used to indicate the nesting */ /* of not/and or not/not CEs which are implemented using */ /* joins from the right. A single pattern within a "not" */ /* CE does not require a join from the right and its nand */ /* depth is normally not increased (except when it's */ /* within a not/and or not/not CE. The begin nand depth */ /* indicates the current nesting for a CE. The end nand */ /* depth indicates the nand depth in the following CE */ /* (assuming that the next CE is not the beginning of a */ /* new group of nand CEs). All but the last CE in a nand */ /* group should have the same begin and end nand depths. */ /* Since a single CE can be the last CE of several nand */ /* groups, it is possible to have an end nand depth that */ /* is more than 1 less than the begin nand depth of the */ /* CE. */ /************************************************************/ static void IncrementNandDepth( void *theEnv, struct lhsParseNode *theLHS, int lastCE) { /*======================================*/ /* Loop through each CE in the group of */ /* CEs having its nand depth increased. */ /*======================================*/ for (; theLHS != NULL; theLHS = theLHS->bottom) { /*=========================================================*/ /* Increment the begin nand depth of pattern and test CEs. */ /* The last CE in the original list doesn't have its end */ /* nand depth incremented. All other last CEs in other CEs */ /* entered recursively do have their end depth incremented */ /* (unless the last CE in the recursively entered CE is */ /* the same last CE as contained in the original group */ /* when this function was first entered). */ /*=========================================================*/ if ((theLHS->type == PATTERN_CE) || (theLHS->type == TEST_CE)) { theLHS->beginNandDepth++; if (lastCE == FALSE) theLHS->endNandDepth++; else if (theLHS->bottom != NULL) theLHS->endNandDepth++; } /*==============================================*/ /* Recursively increase the nand depth of other */ /* CEs contained within the CE having its nand */ /* depth increased. */ /*==============================================*/ else if ((theLHS->type == AND_CE) || (theLHS->type == NOT_CE)) { IncrementNandDepth(theEnv,theLHS->right, (lastCE ? (theLHS->bottom == NULL) : FALSE)); } /*=====================================*/ /* All or CEs should have been removed */ /* from the LHS at this point. */ /*=====================================*/ else if (theLHS->type == OR_CE) { SystemError(theEnv,"REORDER",1); } } } /***********************************************************/ /* CreateInitialPattern: Creates a default pattern used in */ /* the LHS of a rule under certain cirmustances (such as */ /* when a "not" or "test" CE is the first CE in an "and" */ /* CE or when no CEs are specified in the LHS of a rule. */ /***********************************************************/ static struct lhsParseNode *CreateInitialPattern( void *theEnv) { struct lhsParseNode *topNode; /*==========================================*/ /* Create the top most node of the pattern. */ /*==========================================*/ topNode = GetLHSParseNode(theEnv); topNode->type = PATTERN_CE; topNode->userCE = FALSE; topNode->bottom = NULL; return(topNode); } /*****************************************************************/ /* AddRemainingInitialPatterns: Finishes adding initial patterns */ /* where needed on the LHS of a rule. Assumes that an initial */ /* pattern has been added to the beginning of the rule if one */ /* was needed. */ /*****************************************************************/ static struct lhsParseNode *AddRemainingInitialPatterns( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *lastNode = NULL, *thePattern, *rv = theLHS; int currentDepth = 1; while (theLHS != NULL) { if ((theLHS->type == TEST_CE) && (theLHS->beginNandDepth > currentDepth)) { thePattern = CreateInitialPattern(theEnv); thePattern->beginNandDepth = theLHS->beginNandDepth; thePattern->endNandDepth = theLHS->beginNandDepth; thePattern->logical = theLHS->logical; thePattern->existsNand = theLHS->existsNand; theLHS->existsNand = FALSE; thePattern->bottom = theLHS; if (lastNode == NULL) { rv = thePattern; } else { lastNode->bottom = thePattern; } } lastNode = theLHS; currentDepth = theLHS->endNandDepth; theLHS = theLHS->bottom; } return(rv); } /*************************************************************/ /* AssignPatternIndices: For each pattern CE in the LHS of a */ /* rule, determines the pattern index for the CE. A simple */ /* 1 to N numbering can't be used since a join from the */ /* right only counts as a single CE to other CEs outside */ /* the lexical scope of the join from the right. For */ /* example, the patterns in the following LHS */ /* */ /* (a) (not (b) (c) (d)) (e) */ /* */ /* would be assigned the following numbers: a-1, b-2, c-3, */ /* d-4, and e-3. */ /*************************************************************/ static struct lhsParseNode *AssignPatternIndices( struct lhsParseNode *theLHS, short startIndex, int nandDepth, short joinDepth) { struct lhsParseNode *theField; /*====================================*/ /* Loop through the CEs at this level */ /* assigning each CE a pattern index. */ /*====================================*/ while (theLHS != NULL) { /*============================================================*/ /* If we're entering a group of CEs requiring a join from the */ /* right, compute the pattern indices for that group and then */ /* proceed with the next CE in this group. A join from the */ /* right only counts as one CE on this level regardless of */ /* the number of CEs it contains. If the end of this level is */ /* encountered while processing the join from right, then */ /* return to the previous level. */ /*============================================================*/ if (theLHS->beginNandDepth > nandDepth) { theLHS = AssignPatternIndices(theLHS,startIndex,theLHS->beginNandDepth,joinDepth); if (theLHS->endNandDepth < nandDepth) return(theLHS); startIndex++; joinDepth++; } /*=====================================================*/ /* A test CE is not assigned a pattern index, however, */ /* if it is the last CE at the end of this level, then */ /* return to the previous level. If this is the first */ /* CE in a group, it will have a join created so the */ /* depth should be incremented. */ /*=====================================================*/ else if (theLHS->type == TEST_CE) { if (joinDepth == 0) { joinDepth++; } theLHS->joinDepth = joinDepth - 1; PropagateJoinDepth(theLHS->expression,(short) (joinDepth - 1)); PropagateNandDepth(theLHS->expression,theLHS->beginNandDepth,theLHS->endNandDepth); if (theLHS->endNandDepth < nandDepth) return(theLHS); } /*==========================================================*/ /* The fields of a pattern CE need to be assigned a pattern */ /* index, field index, and/or slot names. If this CE is the */ /* last CE at the end of this level, then return to the */ /* previous level. */ /*==========================================================*/ else if (theLHS->type == PATTERN_CE) { if (theLHS->expression != NULL) { PropagateJoinDepth(theLHS->expression,(short) joinDepth); PropagateNandDepth(theLHS->expression,theLHS->beginNandDepth,theLHS->endNandDepth); } theLHS->pattern = startIndex; theLHS->joinDepth = joinDepth; PropagateJoinDepth(theLHS->right,joinDepth); PropagateNandDepth(theLHS->right,theLHS->beginNandDepth,theLHS->endNandDepth); for (theField = theLHS->right; theField != NULL; theField = theField->right) { theField->pattern = startIndex; PropagateIndexSlotPatternValues(theField,theField->pattern, theField->index,theField->slot, theField->slotNumber); } if (theLHS->endNandDepth < nandDepth) return(theLHS); startIndex++; joinDepth++; } /*=========================*/ /* Move on to the next CE. */ /*=========================*/ theLHS = theLHS->bottom; } /*========================================*/ /* There are no more CEs left to process. */ /* Return to the previous level. */ /*========================================*/ return(NULL); } /***********************************************************/ /* PropagateIndexSlotPatternValues: Assigns pattern, field */ /* and slot identifiers to a field in a pattern. */ /***********************************************************/ static void PropagateIndexSlotPatternValues( struct lhsParseNode *theField, short thePattern, short theIndex, struct symbolHashNode *theSlot, short theSlotNumber) { struct lhsParseNode *tmpNode, *andField; /*=============================================*/ /* A NULL field does not have to be processed. */ /*=============================================*/ if (theField == NULL) return; /*=====================================================*/ /* Assign the appropriate identifiers for a multifield */ /* slot by calling this routine recursively. */ /*=====================================================*/ if (theField->multifieldSlot) { theField->pattern = thePattern; if (theIndex > 0) theField->index = theIndex; theField->slot = theSlot; theField->slotNumber = theSlotNumber; for (tmpNode = theField->bottom; tmpNode != NULL; tmpNode = tmpNode->right) { tmpNode->pattern = thePattern; tmpNode->slot = theSlot; PropagateIndexSlotPatternValues(tmpNode,thePattern,tmpNode->index, theSlot,theSlotNumber); } return; } /*=======================================================*/ /* Loop through each of the or'ed constraints (connected */ /* by a |) in this field of the pattern. */ /*=======================================================*/ for (theField = theField->bottom; theField != NULL; theField = theField->bottom) { /*===========================================================*/ /* Loop through each of the and'ed constraints (connected by */ /* a &) in this field of the pattern. Assign the pattern, */ /* field, and slot identifiers. */ /*===========================================================*/ for (andField = theField; andField != NULL; andField = andField->right) { andField->pattern = thePattern; if (theIndex > 0) andField->index = theIndex; andField->slot = theSlot; andField->slotNumber = theSlotNumber; } } } /***************************************************/ /* AssignPatternMarkedFlag: Recursively assigns */ /* value to the marked field of a LHSParseNode. */ /***************************************************/ globle void AssignPatternMarkedFlag( struct lhsParseNode *theField, short markedValue) { while (theField != NULL) { theField->marked = markedValue; if (theField->bottom != NULL) { AssignPatternMarkedFlag(theField->bottom,markedValue); } if (theField->expression != NULL) { AssignPatternMarkedFlag(theField->expression,markedValue); } if (theField->secondaryExpression != NULL) { AssignPatternMarkedFlag(theField->secondaryExpression,markedValue); } theField = theField->right; } } /*****************************************************************/ /* PropagateJoinDepth: Recursively assigns a joinDepth to each */ /* node in a LHS node by following the right and bottom links. */ /*****************************************************************/ static void PropagateJoinDepth( struct lhsParseNode *theField, short joinDepth) { while (theField != NULL) { theField->joinDepth = joinDepth; if (theField->bottom != NULL) { PropagateJoinDepth(theField->bottom,joinDepth); } if (theField->expression != NULL) { PropagateJoinDepth(theField->expression,joinDepth); } if (theField->secondaryExpression != NULL) { PropagateJoinDepth(theField->secondaryExpression,joinDepth); } theField = theField->right; } } /**************************************************************/ /* PropagateNandDepth: Recursively assigns the not/and (nand) */ /* depth to each node in a LHS node by following the right, */ /* bottom, and expression links. */ /**************************************************************/ static void PropagateNandDepth( struct lhsParseNode *theField, int beginDepth, int endDepth) { if (theField == NULL) return; for (; theField != NULL; theField = theField->right) { theField->beginNandDepth = beginDepth; theField->endNandDepth = endDepth; PropagateNandDepth(theField->expression,beginDepth,endDepth); PropagateNandDepth(theField->secondaryExpression,beginDepth,endDepth); PropagateNandDepth(theField->bottom,beginDepth,endDepth); } } /*****************************************/ /* PropagateWhichCE: Recursively assigns */ /* an index indicating the user CE. */ /*****************************************/ static int PropagateWhichCE( struct lhsParseNode *theField, int whichCE) { while (theField != NULL) { if ((theField->type == PATTERN_CE) || (theField->type == TEST_CE)) { whichCE++; } theField->whichCE = whichCE; whichCE = PropagateWhichCE(theField->right,whichCE); PropagateWhichCE(theField->expression,whichCE); theField = theField->bottom; } return whichCE; } /********************/ /* IsExistsSubjoin: */ /********************/ globle int IsExistsSubjoin( struct lhsParseNode *theLHS, int parentDepth) { int startDepth = theLHS->beginNandDepth; if ((startDepth - parentDepth) != 2) { return(FALSE); } while (theLHS->endNandDepth >= startDepth) { theLHS = theLHS->bottom; } if (theLHS->endNandDepth <= parentDepth) { return(TRUE); } return(FALSE); } /***************************************************************************/ /* CombineLHSParseNodes: Combines two expressions into a single equivalent */ /* expression. Mainly serves to merge expressions containing "and" */ /* and "or" expressions without unnecessary duplication of the "and" */ /* and "or" expressions (i.e., two "and" expressions can be merged by */ /* placing them as arguments within another "and" expression, but it */ /* is more efficient to add the arguments of one of the "and" */ /* expressions to the list of arguments for the other and expression). */ /***************************************************************************/ globle struct lhsParseNode *CombineLHSParseNodes( void *theEnv, struct lhsParseNode *expr1, struct lhsParseNode *expr2) { struct lhsParseNode *tempPtr; /*===========================================================*/ /* If the 1st expression is NULL, return the 2nd expression. */ /*===========================================================*/ if (expr1 == NULL) return(expr2); /*===========================================================*/ /* If the 2nd expression is NULL, return the 1st expression. */ /*===========================================================*/ if (expr2 == NULL) return(expr1); /*============================================================*/ /* If the 1st expression is an "and" expression, and the 2nd */ /* expression is not an "and" expression, then include the */ /* 2nd expression in the argument list of the 1st expression. */ /*============================================================*/ if ((expr1->value == ExpressionData(theEnv)->PTR_AND) && (expr2->value != ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr1->bottom; if (tempPtr == NULL) { rtn_struct(theEnv,lhsParseNode,expr1); return(expr2); } while (tempPtr->right != NULL) { tempPtr = tempPtr->right; } tempPtr->right = expr2; return(expr1); } /*============================================================*/ /* If the 2nd expression is an "and" expression, and the 1st */ /* expression is not an "and" expression, then include the */ /* 1st expression in the argument list of the 2nd expression. */ /*============================================================*/ if ((expr1->value != ExpressionData(theEnv)->PTR_AND) && (expr2->value == ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr2->bottom; if (tempPtr == NULL) { rtn_struct(theEnv,lhsParseNode,expr2); return(expr1); } expr2->bottom = expr1; expr1->right = tempPtr; return(expr2); } /*===========================================================*/ /* If both expressions are "and" expressions, then add the */ /* 2nd expression to the argument list of the 1st expression */ /* and throw away the extraneous "and" expression. */ /*===========================================================*/ if ((expr1->value == ExpressionData(theEnv)->PTR_AND) && (expr2->value == ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr1->bottom; if (tempPtr == NULL) { rtn_struct(theEnv,lhsParseNode,expr1); return(expr2); } while (tempPtr->right != NULL) { tempPtr = tempPtr->right; } tempPtr->right = expr2->bottom; rtn_struct(theEnv,lhsParseNode,expr2); return(expr1); } /*=====================================================*/ /* If neither expression is an "and" expression, then */ /* create an "and" expression and add both expressions */ /* to the argument list of that "and" expression. */ /*=====================================================*/ tempPtr = GetLHSParseNode(theEnv); tempPtr->type = FCALL; tempPtr->value = ExpressionData(theEnv)->PTR_AND; tempPtr->bottom = expr1; expr1->right = expr2; return(tempPtr); } /**********************************************/ /* PrintNodes: Debugging routine which prints */ /* the representation of a CE. */ /**********************************************/ /* static void PrintNodes( void *theEnv, const char *fileid, struct lhsParseNode *theNode) { if (theNode == NULL) return; while (theNode != NULL) { switch (theNode->type) { case PATTERN_CE: EnvPrintRouter(theEnv,fileid,"("); if (theNode->negated) EnvPrintRouter(theEnv,fileid,"n"); if (theNode->exists) EnvPrintRouter(theEnv,fileid,"x"); if (theNode->logical) EnvPrintRouter(theEnv,fileid,"l"); PrintLongInteger(theEnv,fileid,(long long) theNode->beginNandDepth); EnvPrintRouter(theEnv,fileid,"-"); PrintLongInteger(theEnv,fileid,(long long) theNode->endNandDepth); EnvPrintRouter(theEnv,fileid," "); EnvPrintRouter(theEnv,fileid,ValueToString(theNode->right->bottom->value)); EnvPrintRouter(theEnv,fileid,")"); break; case TEST_CE: EnvPrintRouter(theEnv,fileid,"(test "); PrintLongInteger(theEnv,fileid,(long long) theNode->beginNandDepth); EnvPrintRouter(theEnv,fileid,"-"); PrintLongInteger(theEnv,fileid,(long long) theNode->endNandDepth); EnvPrintRouter(theEnv,fileid,")"); break; case NOT_CE: if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(lnot "); else EnvPrintRouter(theEnv,fileid,"(not ");; PrintNodes(theEnv,fileid,theNode->right); EnvPrintRouter(theEnv,fileid,")"); break; case OR_CE: if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(lor "); else EnvPrintRouter(theEnv,fileid,"(or "); PrintNodes(theEnv,fileid,theNode->right); EnvPrintRouter(theEnv,fileid,")"); break; case AND_CE: if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(land "); else EnvPrintRouter(theEnv,fileid,"(and "); PrintNodes(theEnv,fileid,theNode->right); EnvPrintRouter(theEnv,fileid,")"); break; default: EnvPrintRouter(theEnv,fileid,"(unknown)"); break; } theNode = theNode->bottom; if (theNode != NULL) EnvPrintRouter(theEnv,fileid," "); } return; } */ #endif clips_core_source_630/core/classpsr.h0000755000175000017500000000524512373714253016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support to allow CreateClassScopeMap to */ /* be used by other functions. */ /* */ /* Changed integer type/precision. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_classpsr #define _H_classpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDefclass(void *,const char *); #if DEFMODULE_CONSTRUCT LOCALE void *CreateClassScopeMap(void *,DEFCLASS *); #endif #endif #endif clips_core_source_630/core/bload.c0000755000175000017500000006635212500721260015465 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for loading constructs */ /* from a binary file. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _BLOAD_SOURCE_ #include "setup.h" #include "argacces.h" #include "bsave.h" #include "constrct.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "router.h" #include "utility.h" #include "bload.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct FunctionDefinition **ReadNeededFunctions(void *,long *,int *); static struct FunctionDefinition *FastFindFunction(void *,const char *,struct FunctionDefinition *); static int ClearBload(void *); static void AbortBload(void *); static int BloadOutOfMemoryFunction(void *,size_t); static void DeallocateBloadData(void *); /**********************************************/ /* InitializeBloadData: Allocates environment */ /* data for the bload command. */ /**********************************************/ globle void InitializeBloadData( void *theEnv) { AllocateEnvironmentData(theEnv,BLOAD_DATA,sizeof(struct bloadData),NULL); AddEnvironmentCleanupFunction(theEnv,"bload",DeallocateBloadData,-1500); EnvAddClearFunction(theEnv,"bload",(void (*)(void *)) ClearBload,10000); BloadData(theEnv)->BinaryPrefixID = "\1\2\3\4CLIPS"; BloadData(theEnv)->BinaryVersionID = "V6.30"; } /************************************************/ /* DeallocateBloadData: Deallocates environment */ /* data for the bload command. */ /************************************************/ static void DeallocateBloadData( void *theEnv) { DeallocateCallList(theEnv,BloadData(theEnv)->BeforeBloadFunctions); DeallocateCallList(theEnv,BloadData(theEnv)->AfterBloadFunctions); DeallocateCallList(theEnv,BloadData(theEnv)->ClearBloadReadyFunctions); DeallocateCallList(theEnv,BloadData(theEnv)->AbortBloadFunctions); } /******************************/ /* EnvBload: C access routine */ /* for the bload command. */ /******************************/ globle int EnvBload( void *theEnv, const char *fileName) { long numberOfFunctions; unsigned long space; int error; char IDbuffer[20]; char constructBuffer[CONSTRUCT_HEADER_SIZE]; struct BinaryItem *biPtr; struct callFunctionItem *bfPtr; /*================*/ /* Open the file. */ /*================*/ if (GenOpenReadBinary(theEnv,"bload",fileName) == 0) return(FALSE); /*=====================================*/ /* Determine if this is a binary file. */ /*=====================================*/ GenReadBinary(theEnv,IDbuffer,(unsigned long) strlen(BloadData(theEnv)->BinaryPrefixID) + 1); if (strcmp(IDbuffer,BloadData(theEnv)->BinaryPrefixID) != 0) { PrintErrorID(theEnv,"BLOAD",2,FALSE); EnvPrintRouter(theEnv,WERROR,"File "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR," is not a binary construct file.\n"); GenCloseBinary(theEnv); return(FALSE); } /*=======================================*/ /* Determine if it's a binary file using */ /* a format from a different version. */ /*=======================================*/ GenReadBinary(theEnv,IDbuffer,(unsigned long) strlen(BloadData(theEnv)->BinaryVersionID) + 1); if (strcmp(IDbuffer,BloadData(theEnv)->BinaryVersionID) != 0) { PrintErrorID(theEnv,"BLOAD",3,FALSE); EnvPrintRouter(theEnv,WERROR,"File "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR," is an incompatible binary construct file.\n"); GenCloseBinary(theEnv); return(FALSE); } /*====================*/ /* Clear environment. */ /*====================*/ if (BloadData(theEnv)->BloadActive) { if (ClearBload(theEnv) == FALSE) { GenCloseBinary(theEnv); return(FALSE); } } /*=================================*/ /* Determine if the KB environment */ /* was successfully cleared. */ /*=================================*/ if (ClearReady(theEnv) == FALSE) { GenCloseBinary(theEnv); EnvPrintRouter(theEnv,WERROR,"The "); EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME); EnvPrintRouter(theEnv,WERROR," environment could not be cleared.\n"); EnvPrintRouter(theEnv,WERROR,"Binary load cannot continue.\n"); return(FALSE); } /*==================================*/ /* Call the list of functions to be */ /* executed before a bload occurs. */ /*==================================*/ ConstructData(theEnv)->ClearInProgress = TRUE; for (bfPtr = BloadData(theEnv)->BeforeBloadFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { (*bfPtr->func)(theEnv); } else { (* (void (*)(void)) bfPtr->func)(); } } ConstructData(theEnv)->ClearInProgress = FALSE; /*====================================================*/ /* Read in the functions needed by this binary image. */ /*====================================================*/ BloadData(theEnv)->FunctionArray = ReadNeededFunctions(theEnv,&numberOfFunctions,&error); if (error) { GenCloseBinary(theEnv); AbortBload(theEnv); return(FALSE); } /*================================================*/ /* Read in the atoms needed by this binary image. */ /*================================================*/ ReadNeededAtomicValues(theEnv); /*===========================================*/ /* Determine the number of expressions to be */ /* read and allocate the appropriate space */ /*===========================================*/ AllocateExpressions(theEnv); /*==========================================================*/ /* Read in the memory requirements of the constructs stored */ /* in this binary image and allocate the necessary space */ /*==========================================================*/ for (GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE); strncmp(constructBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE) != 0; GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE)) { intBool found; /*================================================*/ /* Search for the construct type in the list of */ /* binary items. If found, allocate the storage */ /* needed by the construct for this binary image. */ /*================================================*/ found = FALSE; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (strncmp(biPtr->name,constructBuffer,CONSTRUCT_HEADER_SIZE) == 0) { if (biPtr->bloadStorageFunction != NULL) { (*biPtr->bloadStorageFunction)(theEnv); found = TRUE; } break; } } /*==========================================*/ /* If the construct type wasn't found, skip */ /* the storage binary load information for */ /* this construct. */ /*==========================================*/ if (! found) { GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long)); GetSeekCurBinary(theEnv,(long) space); if (space != 0) { EnvPrintRouter(theEnv,WDIALOG,"\nSkipping "); EnvPrintRouter(theEnv,WDIALOG,constructBuffer); EnvPrintRouter(theEnv,WDIALOG," constructs because of unavailability\n"); } } } /*======================================*/ /* Refresh the pointers in expressions. */ /*======================================*/ RefreshExpressions(theEnv); /*==========================*/ /* Read in the constraints. */ /*==========================*/ ReadNeededConstraints(theEnv); /*======================================================*/ /* Read in the constructs stored in this binary image. */ /*======================================================*/ for (GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE); strncmp(constructBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE) != 0; GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE)) { intBool found; /*==================================================*/ /* Search for the function to load the construct */ /* into the previously allocated storage. If found, */ /* call the function to load the construct. */ /*==================================================*/ found = FALSE; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (strncmp(biPtr->name,constructBuffer,CONSTRUCT_HEADER_SIZE) == 0) { if (biPtr->bloadFunction != NULL) { (*biPtr->bloadFunction)(theEnv); found = TRUE; } break; } } /*==========================================*/ /* If the construct type wasn't found, skip */ /* the binary data for this construct. */ /*==========================================*/ if (! found) { GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long)); GetSeekCurBinary(theEnv,(long) space); } } /*=================*/ /* Close the file. */ /*=================*/ GenCloseBinary(theEnv); /*========================================*/ /* Free up temporary storage used for the */ /* function and atomic value information. */ /*========================================*/ if (BloadData(theEnv)->FunctionArray != NULL) { genfree(theEnv,(void *) BloadData(theEnv)->FunctionArray, sizeof(struct FunctionDefinition *) * numberOfFunctions); } FreeAtomicValueStorage(theEnv); /*==================================*/ /* Call the list of functions to be */ /* executed after a bload occurs. */ /*==================================*/ for (bfPtr = BloadData(theEnv)->AfterBloadFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { (*bfPtr->func)(theEnv); } else { (* (void (*)(void)) bfPtr->func)(); } } /*=======================================*/ /* Add a clear function to remove binary */ /* load when a clear command is issued. */ /*=======================================*/ BloadData(theEnv)->BloadActive = TRUE; /*=============================*/ /* Return TRUE to indicate the */ /* binary load was successful. */ /*=============================*/ return(TRUE); } /************************************************************ NAME : BloadandRefresh DESCRIPTION : Loads and refreshes objects - will bload all objects at once, if possible, but will aslo work in increments if memory is restricted INPUTS : 1) the number of objects to bload and update 2) the size of one object 3) An update function which takes a bloaded object buffer and the index of the object to refresh as arguments RETURNS : Nothing useful SIDE EFFECTS : Objects bloaded and updated NOTES : Assumes binary file pointer is positioned for bloads of the objects ************************************************************/ globle void BloadandRefresh( void *theEnv, long objcnt, size_t objsz, void (*objupdate)(void *,void *,long)) { register long i,bi; char *buf; long objsmaxread,objsread; size_t space; int (*oldOutOfMemoryFunction)(void *,size_t); if (objcnt == 0L) return; oldOutOfMemoryFunction = EnvSetOutOfMemoryFunction(theEnv,BloadOutOfMemoryFunction); objsmaxread = objcnt; do { space = objsmaxread * objsz; buf = (char *) genalloc(theEnv,space); if (buf == NULL) { if ((objsmaxread / 2) == 0) { if ((*oldOutOfMemoryFunction)(theEnv,space) == TRUE) { EnvSetOutOfMemoryFunction(theEnv,oldOutOfMemoryFunction); return; } } else objsmaxread /= 2; } } while (buf == NULL); EnvSetOutOfMemoryFunction(theEnv,oldOutOfMemoryFunction); i = 0L; do { objsread = (objsmaxread > (objcnt - i)) ? (objcnt - i) : objsmaxread; GenReadBinary(theEnv,(void *) buf,objsread * objsz); for (bi = 0L ; bi < objsread ; bi++ , i++) (*objupdate)(theEnv,buf + objsz * bi,i); } while (i < objcnt); genfree(theEnv,(void *) buf,space); } /**********************************************/ /* ReadNeededFunctions: Reads in the names of */ /* functions needed by the binary image. */ /**********************************************/ static struct FunctionDefinition **ReadNeededFunctions( void *theEnv, long int *numberOfFunctions, int *error) { char *functionNames, *namePtr; unsigned long int space; size_t temp; long i; struct FunctionDefinition **newFunctionArray, *functionPtr; int functionsNotFound = 0; /*===================================================*/ /* Determine the number of function names to be read */ /* and the space required for them. */ /*===================================================*/ GenReadBinary(theEnv,numberOfFunctions,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (*numberOfFunctions == 0) { *error = FALSE; return(NULL); } /*=======================================*/ /* Allocate area for strings to be read. */ /*=======================================*/ functionNames = (char *) genalloc(theEnv,space); GenReadBinary(theEnv,(void *) functionNames,space); /*====================================================*/ /* Store the function pointers in the function array. */ /*====================================================*/ temp = (unsigned long) sizeof(struct FunctionDefinition *) * *numberOfFunctions; newFunctionArray = (struct FunctionDefinition **) genalloc(theEnv,temp); namePtr = functionNames; functionPtr = NULL; for (i = 0; i < *numberOfFunctions; i++) { if ((functionPtr = FastFindFunction(theEnv,namePtr,functionPtr)) == NULL) { if (! functionsNotFound) { PrintErrorID(theEnv,"BLOAD",6,FALSE); EnvPrintRouter(theEnv,WERROR,"The following undefined functions are "); EnvPrintRouter(theEnv,WERROR,"referenced by this binary image:\n"); } EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,namePtr); EnvPrintRouter(theEnv,WERROR,"\n"); functionsNotFound = 1; } newFunctionArray[i] = functionPtr; namePtr += strlen(namePtr) + 1; } /*==========================================*/ /* Free the memory used by the name buffer. */ /*==========================================*/ genfree(theEnv,(void *) functionNames,space); /*==================================================*/ /* If any of the required functions were not found, */ /* then free the memory used by the function array. */ /*==================================================*/ if (functionsNotFound) { genfree(theEnv,(void *) newFunctionArray,temp); newFunctionArray = NULL; } /*===================================*/ /* Set globals to appropriate values */ /* and return the function array. */ /*===================================*/ *error = functionsNotFound; return(newFunctionArray); } /*****************************************/ /* FastFindFunction: Search the function */ /* list for a specific function. */ /*****************************************/ static struct FunctionDefinition *FastFindFunction( void *theEnv, const char *functionName, struct FunctionDefinition *lastFunction) { struct FunctionDefinition *theList, *theFunction; /*========================*/ /* Get the function list. */ /*========================*/ theList = GetFunctionList(theEnv); if (theList == NULL) { return(NULL); } /*=======================================*/ /* If we completed a previous function */ /* search, start where we last left off. */ /*=======================================*/ if (lastFunction != NULL) { theFunction = lastFunction->next; } else { theFunction = theList; } /*======================================================*/ /* Traverse the rest of the function list searching for */ /* the named function wrapping around if necessary. */ /*======================================================*/ while (strcmp(functionName,ValueToString(theFunction->callFunctionName)) != 0) { theFunction = theFunction->next; if (theFunction == lastFunction) return(NULL); if (theFunction == NULL) theFunction = theList; } /*=======================*/ /* Return the pointer to */ /* the found function. */ /*=======================*/ return(theFunction); } /******************************************/ /* Bloaded: Returns TRUE if the current */ /* environment is the result of a bload */ /* command, otherwise returns FALSE. */ /******************************************/ globle intBool Bloaded( void *theEnv) { return(BloadData(theEnv)->BloadActive); } /*************************************/ /* ClearBload: Clears a binary image */ /* from the KB environment. */ /*************************************/ static int ClearBload( void *theEnv) { struct BinaryItem *biPtr; struct callFunctionItem *bfPtr; int ready,error; /*======================================*/ /* If bload is not active, then there's */ /* no need to clear bload data. */ /*======================================*/ if (! BloadData(theEnv)->BloadActive) { return TRUE; } /*=================================================*/ /* Make sure it's safe to clear the bloaded image. */ /*=================================================*/ error = FALSE; for (bfPtr = BloadData(theEnv)->ClearBloadReadyFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { ready = (* ((int (*)(void *)) bfPtr->func))(theEnv); } else { ready = (* ((int (*)(void)) bfPtr->func))(); } if (ready == FALSE) { if (! error) { PrintErrorID(theEnv,"BLOAD",5,FALSE); EnvPrintRouter(theEnv,WERROR, "Some constructs are still in use by the current binary image:\n"); } EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,bfPtr->name); EnvPrintRouter(theEnv,WERROR,"\n"); error = TRUE; } } /*==================================================*/ /* If some constructs are still in use and can't be */ /* cleared, indicate the binary load can't continue */ /* and return FALSE to indicate this condition. */ /*==================================================*/ if (error == TRUE) { EnvPrintRouter(theEnv,WERROR,"Binary clear cannot continue.\n"); return(FALSE); } /*=============================*/ /* Call bload clear functions. */ /*=============================*/ for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->clearFunction != NULL) (*biPtr->clearFunction)(theEnv); } /*===========================*/ /* Free bloaded expressions. */ /*===========================*/ ClearBloadedExpressions(theEnv); /*===========================*/ /* Free bloaded constraints. */ /*===========================*/ ClearBloadedConstraints(theEnv); /*==================================*/ /* Remove the bload clear function. */ /*==================================*/ BloadData(theEnv)->BloadActive = FALSE; /*====================================*/ /* Return TRUE to indicate the binary */ /* image was successfully cleared. */ /*====================================*/ return(TRUE); } /*************************************************/ /* AbortBload: Cleans up effects of before-bload */ /* functions in event of failure. */ /*************************************************/ static void AbortBload( void *theEnv) { struct callFunctionItem *bfPtr; for (bfPtr = BloadData(theEnv)->AbortBloadFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { (*bfPtr->func)(theEnv); } else { (* (void (*)(void)) bfPtr->func)(); } } } /********************************************/ /* AddBeforeBloadFunction: Adds a function */ /* to the list of functions called before */ /* a binary load occurs. */ /********************************************/ globle void AddBeforeBloadFunction( void *theEnv, const char *name, void (*func)(void *), int priority) { BloadData(theEnv)->BeforeBloadFunctions = AddFunctionToCallList(theEnv,name,priority,func,BloadData(theEnv)->BeforeBloadFunctions,TRUE); } /*******************************************/ /* AddAfterBloadFunction: Adds a function */ /* to the list of functions called after */ /* a binary load occurs. */ /*******************************************/ globle void AddAfterBloadFunction( void *theEnv, const char *name, void (*func)(void *), int priority) { BloadData(theEnv)->AfterBloadFunctions = AddFunctionToCallList(theEnv,name,priority,func,BloadData(theEnv)->AfterBloadFunctions,TRUE); } /**************************************************/ /* AddClearBloadReadyFunction: Adds a function to */ /* the list of functions called to determine if */ /* a binary image can be cleared. */ /**************************************************/ globle void AddClearBloadReadyFunction( void *theEnv, const char *name, int (*func)(void *), int priority) { BloadData(theEnv)->ClearBloadReadyFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) func, BloadData(theEnv)->ClearBloadReadyFunctions,TRUE); } /*********************************************/ /* AddAbortBloadFunction: Adds a function to */ /* the list of functions called if a bload */ /* has to be aborted. */ /*********************************************/ globle void AddAbortBloadFunction( void *theEnv, const char *name, void (*func)(void *), int priority) { BloadData(theEnv)->AbortBloadFunctions = AddFunctionToCallList(theEnv,name,priority,func,BloadData(theEnv)->AbortBloadFunctions,TRUE); } /******************************************************* NAME : BloadOutOfMemoryFunction DESCRIPTION : Memory function used by bload to prevent exiting when out of memory - used by BloadandRefresh INPUTS : The memory request size (unused) RETURNS : TRUE (indicates a failure and for the memory functions to simply return a NULL pointer) SIDE EFFECTS : None NOTES : None *******************************************************/ static int BloadOutOfMemoryFunction( void *theEnv, size_t size) { #if MAC_XCD #pragma unused(size,theEnv) #endif return(TRUE); } /*****************************************************/ /* CannotLoadWithBloadMessage: Generic error message */ /* for indicating that a construct can't be loaded */ /* when a binary image is active. */ /*****************************************************/ globle void CannotLoadWithBloadMessage( void *theEnv, const char *constructName) { PrintErrorID(theEnv,"BLOAD",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot load "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," construct with binary load in effect.\n"); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle int Bload( const char *fileName) { return EnvBload(GetCurrentEnvironment(),fileName); } #endif #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) */ /**************************************/ /* BloadCommand: H/L access routine */ /* for the bload command. */ /**************************************/ globle int BloadCommand( void *theEnv) { #if (! RUN_TIME) && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) const char *fileName; if (EnvArgCountCheck(theEnv,"bload",EXACTLY,1) == -1) return(FALSE); fileName = GetFileName(theEnv,"bload",1); if (fileName != NULL) return(EnvBload(theEnv,fileName)); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif return(FALSE); } clips_core_source_630/core/._rulebin.h0000755000175000017500000000040712374024070016257 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/memalloc.h0000755000175000017500000002317612500720752016204 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* MEMORY ALLOCATION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Memory allocation routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed HaltExecution check from the */ /* EnvReleaseMem function. DR0863 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed genlongalloc/genlongfree functions. */ /* */ /* Added get_mem and rtn_mem macros. */ /* */ /* Converted API macros to function calls. */ /* */ /* Removed deallocating message parameter from */ /* EnvReleaseMem. */ /* */ /* Removed support for BLOCK_MEMORY. */ /* */ /*************************************************************/ #ifndef _H_memalloc #include #define _H_memalloc struct chunkInfo; struct blockInfo; struct memoryPtr; #ifndef MEM_TABLE_SIZE #define MEM_TABLE_SIZE 500 #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MEMORY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct chunkInfo { struct chunkInfo *prevChunk; struct chunkInfo *nextFree; struct chunkInfo *lastFree; long int size; }; struct blockInfo { struct blockInfo *nextBlock; struct blockInfo *prevBlock; struct chunkInfo *nextFree; long int size; }; struct memoryPtr { struct memoryPtr *next; }; #if (MEM_TABLE_SIZE > 0) /* * Normal memory management case */ #define get_struct(theEnv,type) \ ((MemoryData(theEnv)->MemoryTable[sizeof(struct type)] == NULL) ? \ ((struct type *) genalloc(theEnv,sizeof(struct type))) :\ ((MemoryData(theEnv)->TempMemoryPtr = MemoryData(theEnv)->MemoryTable[sizeof(struct type)]),\ MemoryData(theEnv)->MemoryTable[sizeof(struct type)] = MemoryData(theEnv)->TempMemoryPtr->next,\ ((struct type *) MemoryData(theEnv)->TempMemoryPtr))) #define rtn_struct(theEnv,type,struct_ptr) \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[sizeof(struct type)], \ MemoryData(theEnv)->MemoryTable[sizeof(struct type)] = MemoryData(theEnv)->TempMemoryPtr) #define rtn_sized_struct(theEnv,size,struct_ptr) \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[size], \ MemoryData(theEnv)->MemoryTable[size] = MemoryData(theEnv)->TempMemoryPtr) #define get_var_struct(theEnv,type,vsize) \ ((((sizeof(struct type) + vsize) < MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize] == NULL) : 1) ? \ ((struct type *) genalloc(theEnv,(sizeof(struct type) + vsize))) :\ ((MemoryData(theEnv)->TempMemoryPtr = MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize]),\ MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize] = MemoryData(theEnv)->TempMemoryPtr->next,\ ((struct type *) MemoryData(theEnv)->TempMemoryPtr))) #define rtn_var_struct(theEnv,type,vsize,struct_ptr) \ (MemoryData(theEnv)->TempSize = sizeof(struct type) + vsize, \ ((MemoryData(theEnv)->TempSize < MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize], \ MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize] = MemoryData(theEnv)->TempMemoryPtr) : \ (genfree(theEnv,(void *) struct_ptr,MemoryData(theEnv)->TempSize),(struct memoryPtr *) struct_ptr))) #define get_mem(theEnv,size) \ (((size < MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->MemoryTable[size] == NULL) : 1) ? \ ((struct type *) genalloc(theEnv,(size_t) (size))) :\ ((MemoryData(theEnv)->TempMemoryPtr = MemoryData(theEnv)->MemoryTable[size]),\ MemoryData(theEnv)->MemoryTable[size] = MemoryData(theEnv)->TempMemoryPtr->next,\ ((struct type *) MemoryData(theEnv)->TempMemoryPtr))) #define rtn_mem(theEnv,size,ptr) \ (MemoryData(theEnv)->TempSize = size, \ ((MemoryData(theEnv)->TempSize < MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize], \ MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize] = MemoryData(theEnv)->TempMemoryPtr) : \ (genfree(theEnv,(void *) ptr,MemoryData(theEnv)->TempSize),(struct memoryPtr *) ptr))) #else // MEM_TABLE_SIZE == 0 /* * Debug case (routes all memory management through genalloc/genfree to take advantage of * platform, memory debugging aids) */ #define get_struct(theEnv,type) ((struct type *) genalloc(theEnv,sizeof(struct type))) #define rtn_struct(theEnv,type,struct_ptr) (genfree(theEnv,struct_ptr,sizeof(struct type))) #define rtn_sized_struct(theEnv,size,struct_ptr) (genfree(theEnv,struct_ptr,size)) #define get_var_struct(theEnv,type,vsize) ((struct type *) genalloc(theEnv,(sizeof(struct type) + vsize))) #define rtn_var_struct(theEnv,type,vsize,struct_ptr) (genfree(theEnv,struct_ptr,sizeof(struct type)+vsize)) #define get_mem(theEnv,size) ((struct type *) genalloc(theEnv,(size_t) (size))) #define rtn_mem(theEnv,size,ptr) (genfree(theEnv,ptr,size)) #endif #define GenCopyMemory(type,cnt,dst,src) \ memcpy((void *) (dst),(void *) (src),sizeof(type) * (size_t) (cnt)) #define MEMORY_DATA 59 struct memoryData { long int MemoryAmount; long int MemoryCalls; intBool ConserveMemory; int (*OutOfMemoryFunction)(void *,size_t); struct memoryPtr *TempMemoryPtr; struct memoryPtr **MemoryTable; size_t TempSize; }; #define MemoryData(theEnv) ((struct memoryData *) GetEnvironmentData(theEnv,MEMORY_DATA)) LOCALE void InitializeMemory(void *); LOCALE void *genalloc(void *,size_t); LOCALE int DefaultOutOfMemoryFunction(void *,size_t); LOCALE int (*EnvSetOutOfMemoryFunction(void *,int (*)(void *,size_t)))(void *,size_t); LOCALE int genfree(void *,void *,size_t); LOCALE void *genrealloc(void *,void *,size_t,size_t); LOCALE long EnvMemUsed(void *); LOCALE long EnvMemRequests(void *); LOCALE long UpdateMemoryUsed(void *,long int); LOCALE long UpdateMemoryRequests(void *,long int); LOCALE long EnvReleaseMem(void *,long); LOCALE void *gm1(void *,size_t); LOCALE void *gm2(void *,size_t); LOCALE void *gm3(void *,size_t); LOCALE int rm(void *,void *,size_t); LOCALE int rm3(void *,void *,size_t); LOCALE unsigned long PoolSize(void *); LOCALE unsigned long ActualPoolSize(void *); LOCALE void *RequestChunk(void *,size_t); LOCALE int ReturnChunk(void *,void *,size_t); LOCALE intBool EnvSetConserveMemory(void *,intBool); LOCALE intBool EnvGetConserveMemory(void *); LOCALE void genmemcpy(char *,char *,unsigned long); LOCALE void ReturnAllBlocks(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool GetConserveMemory(void); LOCALE long int MemRequests(void); LOCALE long int MemUsed(void); LOCALE long int ReleaseMem(long); LOCALE intBool SetConserveMemory(intBool); LOCALE int (*SetOutOfMemoryFunction(int (*)(void *,size_t)))(void *,size_t); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_memalloc */ clips_core_source_630/core/._watch.h0000755000175000017500000000040712373740561015736 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltpsr.h0000755000175000017500000000040712373754332016516 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltlhs.c0000755000175000017500000003014712373754203016257 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE LHS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses LHS deftemplate patterns. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for rete network exists node. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _TMPLTLHS_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "symbol.h" #include "scanner.h" #include "exprnpsr.h" #include "router.h" #include "constrnt.h" #include "constrct.h" #include "reorder.h" #include "pattern.h" #include "factrhs.h" #include "modulutl.h" #include "tmpltutl.h" #include "tmpltdef.h" #include "tmpltlhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct lhsParseNode *GetLHSSlots(void *,const char *,struct token *,struct deftemplate *,int *); static struct lhsParseNode *GetSingleLHSSlot(void *,const char *,struct token *, struct templateSlot *,int *,short); static intBool MultiplyDefinedLHSSlots(void *,struct lhsParseNode *,SYMBOL_HN *); /*********************************************/ /* DeftemplateLHSParse: Parses a LHS pattern */ /* that uses the deftemplate format. */ /*********************************************/ globle struct lhsParseNode *DeftemplateLHSParse( void *theEnv, const char *readSource, struct deftemplate *theDeftemplate) { struct lhsParseNode *head, *firstSlot; struct token theToken; int error; /*===============================================================*/ /* Make sure the deftemplate name is not connected to subfields. */ /*===============================================================*/ GetToken(theEnv,readSource,&theToken); if ((theToken.type == OR_CONSTRAINT) || (theToken.type == AND_CONSTRAINT)) { SyntaxErrorMessage(theEnv,"deftemplate patterns"); return(NULL); } /*===================================================*/ /* Create the pattern node for the deftemplate name. */ /*===================================================*/ head = GetLHSParseNode(theEnv); head->type = SF_WILDCARD; head->negated = FALSE; head->exists = FALSE; head->index = 0; head->slotNumber = 1; head->bottom = GetLHSParseNode(theEnv); head->bottom->type = SYMBOL; head->bottom->negated = FALSE; head->bottom->exists = FALSE; head->bottom->value = (void *) theDeftemplate->header.name; /*==========================================*/ /* Get the other fields in the deftemplate. */ /*==========================================*/ error = FALSE; firstSlot = GetLHSSlots(theEnv,readSource,&theToken,theDeftemplate,&error); if (error) { ReturnLHSParseNodes(theEnv,firstSlot); ReturnLHSParseNodes(theEnv,head); return(NULL); } /*=========================*/ /* Return the LHS pattern. */ /*=========================*/ head->right = firstSlot; return(head); } /******************************************/ /* GetLHSSlots: Retrieves all of the slot */ /* values used in a LHS pattern. */ /******************************************/ static struct lhsParseNode *GetLHSSlots( void *theEnv, const char *readSource, struct token *tempToken, struct deftemplate *theDeftemplate, int *error) { struct lhsParseNode *firstSlot = NULL, *nextSlot, *lastSlot = NULL; struct templateSlot *slotPtr; short position; /*=======================================================*/ /* Continue parsing slot definitions until the pattern's */ /* closing right parenthesis is encountered. */ /*=======================================================*/ while (tempToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,tempToken->printForm); /*=================================================*/ /* Slot definitions begin with a left parenthesis. */ /*=================================================*/ if (tempToken->type != LPAREN) { *error = TRUE; SyntaxErrorMessage(theEnv,"deftemplate patterns"); ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*====================*/ /* Get the slot name. */ /*====================*/ GetToken(theEnv,readSource,tempToken); if (tempToken->type != SYMBOL) { *error = TRUE; SyntaxErrorMessage(theEnv,"deftemplate patterns"); ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*==========================================================*/ /* Determine if the slot name is valid for the deftemplate. */ /*==========================================================*/ if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempToken->value,&position)) == NULL) { *error = TRUE; InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempToken->value), ValueToString(theDeftemplate->header.name),TRUE); ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*============================================*/ /* Determine if the slot is multiply defined. */ /*============================================*/ if (MultiplyDefinedLHSSlots(theEnv,firstSlot,(SYMBOL_HN *) tempToken->value) == TRUE) { *error = TRUE; ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*==============================================================*/ /* Get the pattern matching values used in the slot definition. */ /*==============================================================*/ nextSlot = GetSingleLHSSlot(theEnv,readSource,tempToken,slotPtr,error,(short) (position+1)); if (*error) { ReturnLHSParseNodes(theEnv,firstSlot); ReturnLHSParseNodes(theEnv,nextSlot); return(NULL); } /*=====================================*/ /* Add the slot definition to the list */ /* of slot definitions already parsed. */ /*=====================================*/ if (lastSlot == NULL) { firstSlot = nextSlot; } else { lastSlot->right = nextSlot; } while (nextSlot->right != NULL) nextSlot = nextSlot->right; lastSlot = nextSlot; /*==============================*/ /* Begin parsing the next slot. */ /*==============================*/ GetToken(theEnv,readSource,tempToken); } /*===========================================================*/ /* Return all the slot definitions found in the lhs pattern. */ /*===========================================================*/ return(firstSlot); } /*****************************************************/ /* GetSingleLHSSlot: Get the pattern matching values */ /* to be associated with a slot name. */ /*****************************************************/ static struct lhsParseNode *GetSingleLHSSlot( void *theEnv, const char *readSource, struct token *tempToken, struct templateSlot *slotPtr, int *error, short position) { struct lhsParseNode *nextSlot; SYMBOL_HN *slotName; /*================================================*/ /* Get the slot name and read in the first token. */ /*================================================*/ slotName = (SYMBOL_HN *) tempToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,tempToken); /*====================================*/ /* Get value for a single field slot. */ /*====================================*/ if (slotPtr->multislot == FALSE) { /*=======================*/ /* Get the single value. */ /*=======================*/ nextSlot = RestrictionParse(theEnv,readSource,tempToken,FALSE, slotPtr->slotName,(short) (position - 1), slotPtr->constraints,0); if (nextSlot == NULL) { *error = TRUE; return(NULL); } /*======================================*/ /* Multi field wildcards and variables */ /* not allowed in a single field slot. */ /*======================================*/ if ((nextSlot->type == MF_VARIABLE) || (nextSlot->type == MULTIFIELD)) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); *error = TRUE; ReturnLHSParseNodes(theEnv,nextSlot); return(NULL); } } /*===================================*/ /* Get values for a multifield slot. */ /*===================================*/ else { nextSlot = RestrictionParse(theEnv,readSource,tempToken,TRUE,slotName,(short) (position - 1), slotPtr->constraints,1); if (nextSlot == NULL) { *error = TRUE; return(NULL); } } /*========================================================*/ /* The slot definition must end with a right parenthesis. */ /*========================================================*/ if (tempToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,tempToken->printForm); SyntaxErrorMessage(theEnv,"deftemplate patterns"); *error = TRUE; ReturnLHSParseNodes(theEnv,nextSlot); return(NULL); } /*===============================================*/ /* Fix the pretty print output if the multifield */ /* slot contained no restrictions. */ /*===============================================*/ if ((nextSlot->bottom == NULL) && slotPtr->multislot) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } /*=================================*/ /* Add the slot values to the slot */ /* structure and return it. */ /*=================================*/ return(nextSlot); } /******************************************************/ /* MultiplyDefinedLHSSlots: Determines if a slot name */ /* was used more than once in a LHS pattern. */ /******************************************************/ static intBool MultiplyDefinedLHSSlots( void *theEnv, struct lhsParseNode *theSlots, SYMBOL_HN *slotName) { for (; theSlots != NULL; theSlots = theSlots->right) { if (theSlots->slot == slotName) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(slotName)); return(TRUE); } } return(FALSE); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */ clips_core_source_630/core/._factmch.h0000755000175000017500000000040712373742651016237 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/constant.h0000755000175000017500000001735212502204536016242 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/05/15 */ /* */ /* CONSTANTS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Moved default type constants (NO_DEFAULT, */ /* STATIC_DEFAULT, and DYNAMIC_DEFAULT) to */ /* constant.h */ /* */ /* Added DATA_OBJECT_ARRAY primitive type. */ /* */ /* Added NESTED_RHS constant. */ /* */ /*************************************************************/ #ifndef _H_constant #define _H_constant #ifndef FALSE #define FALSE 0 #endif #ifndef TRUE #define TRUE 1 #endif #define EXACTLY 0 #define AT_LEAST 1 #define NO_MORE_THAN 2 #define RANGE 3 #define OFF 0 #define ON 1 #define LHS 0 #define RHS 1 #define NESTED_RHS 2 #define NEGATIVE 0 #define POSITIVE 1 #define EOS '\0' #define INSIDE 0 #define OUTSIDE 1 #define LESS_THAN 0 #define GREATER_THAN 1 #define EQUAL 2 #define GLOBAL_SAVE 0 #define LOCAL_SAVE 1 #define VISIBLE_SAVE 2 #define NO_DEFAULT 0 #define STATIC_DEFAULT 1 #define DYNAMIC_DEFAULT 2 #ifndef WPROMPT_STRING #define WPROMPT_STRING "wclips" #endif #ifndef APPLICATION_NAME #define APPLICATION_NAME "CLIPS" #endif #ifndef COMMAND_PROMPT #define COMMAND_PROMPT "CLIPS> " #endif #ifndef VERSION_STRING #define VERSION_STRING "6.30" #endif #ifndef CREATION_DATE_STRING #define CREATION_DATE_STRING "3/17/15" #endif #ifndef BANNER_STRING #define BANNER_STRING " CLIPS (6.30 3/17/15)\n" #endif /*************************/ /* TOKEN AND TYPE VALUES */ /*************************/ #define OBJECT_TYPE_NAME "OBJECT" #define USER_TYPE_NAME "USER" #define PRIMITIVE_TYPE_NAME "PRIMITIVE" #define NUMBER_TYPE_NAME "NUMBER" #define INTEGER_TYPE_NAME "INTEGER" #define FLOAT_TYPE_NAME "FLOAT" #define SYMBOL_TYPE_NAME "SYMBOL" #define STRING_TYPE_NAME "STRING" #define MULTIFIELD_TYPE_NAME "MULTIFIELD" #define LEXEME_TYPE_NAME "LEXEME" #define ADDRESS_TYPE_NAME "ADDRESS" #define EXTERNAL_ADDRESS_TYPE_NAME "EXTERNAL-ADDRESS" #define FACT_ADDRESS_TYPE_NAME "FACT-ADDRESS" #define INSTANCE_TYPE_NAME "INSTANCE" #define INSTANCE_NAME_TYPE_NAME "INSTANCE-NAME" #define INSTANCE_ADDRESS_TYPE_NAME "INSTANCE-ADDRESS" /*************************************************************************/ /* The values of these constants should not be changed. They are set to */ /* start after the primitive type codes in CONSTANT.H. These codes are */ /* used to let the generic function bsave image be used whether COOL is */ /* present or not. */ /*************************************************************************/ #define OBJECT_TYPE_CODE 9 #define PRIMITIVE_TYPE_CODE 10 #define NUMBER_TYPE_CODE 11 #define LEXEME_TYPE_CODE 12 #define ADDRESS_TYPE_CODE 13 #define INSTANCE_TYPE_CODE 14 /****************************************************/ /* The first 9 primitive types need to retain their */ /* values!! Sorted arrays depend on their values!! */ /****************************************************/ #define FLOAT 0 #define INTEGER 1 #define SYMBOL 2 #define STRING 3 #define MULTIFIELD 4 #define EXTERNAL_ADDRESS 5 #define FACT_ADDRESS 6 #define INSTANCE_ADDRESS 7 #define INSTANCE_NAME 8 #define FCALL 30 #define GCALL 31 #define PCALL 32 #define GBL_VARIABLE 33 #define MF_GBL_VARIABLE 34 #define SF_VARIABLE 35 #define MF_VARIABLE 36 #define SF_WILDCARD 37 #define MF_WILDCARD 38 #define BITMAPARRAY 39 #define DATA_OBJECT_ARRAY 40 #define FACT_PN_CMP1 50 #define FACT_JN_CMP1 51 #define FACT_JN_CMP2 52 #define FACT_SLOT_LENGTH 53 #define FACT_PN_VAR1 54 #define FACT_PN_VAR2 55 #define FACT_PN_VAR3 56 #define FACT_JN_VAR1 57 #define FACT_JN_VAR2 58 #define FACT_JN_VAR3 59 #define FACT_PN_CONSTANT1 60 #define FACT_PN_CONSTANT2 61 #define FACT_STORE_MULTIFIELD 62 #define DEFTEMPLATE_PTR 63 #define OBJ_GET_SLOT_PNVAR1 70 #define OBJ_GET_SLOT_PNVAR2 71 #define OBJ_GET_SLOT_JNVAR1 72 #define OBJ_GET_SLOT_JNVAR2 73 #define OBJ_SLOT_LENGTH 74 #define OBJ_PN_CONSTANT 75 #define OBJ_PN_CMP1 76 #define OBJ_JN_CMP1 77 #define OBJ_PN_CMP2 78 #define OBJ_JN_CMP2 79 #define OBJ_PN_CMP3 80 #define OBJ_JN_CMP3 81 #define DEFCLASS_PTR 82 #define HANDLER_GET 83 #define HANDLER_PUT 84 #define DEFGLOBAL_PTR 90 #define PROC_PARAM 95 #define PROC_WILD_PARAM 96 #define PROC_GET_BIND 97 #define PROC_BIND 98 #define PATTERN_CE 150 #define AND_CE 151 #define OR_CE 152 #define NOT_CE 153 #define TEST_CE 154 #define NAND_CE 155 #define EXISTS_CE 156 #define FORALL_CE 157 #define NOT_CONSTRAINT 160 #define AND_CONSTRAINT 161 #define OR_CONSTRAINT 162 #define PREDICATE_CONSTRAINT 163 #define RETURN_VALUE_CONSTRAINT 164 #define LPAREN 170 #define RPAREN 171 #define STOP 172 #define UNKNOWN_VALUE 173 #define RVOID 175 #define INTEGER_OR_FLOAT 180 #define SYMBOL_OR_STRING 181 #define INSTANCE_OR_INSTANCE_NAME 182 typedef long int FACT_ID; /*************************/ /* Macintosh Definitions */ /*************************/ #define CREATOR_STRING "CLIS" #define CREATOR_CODE 'CLIS' #endif clips_core_source_630/core/._insmult.h0000755000175000017500000000040712373756340016325 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/classpsr.c0000755000175000017500000010462412461252524016241 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* CLASS PARSER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Parsing Routines for Defclass Construct */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support to allow CreateClassScopeMap to */ /* be used by other functions. */ /* */ /* Changed integer type/precision. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "classcom.h" #include "classfun.h" #include "clsltpsr.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "inherpsr.h" #include "memalloc.h" #include "modulpsr.h" #include "modulutl.h" #include "msgpsr.h" #include "router.h" #include "scanner.h" #define _CLASSPSR_SOURCE_ #include "classpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define ROLE_RLN "role" #define ABSTRACT_RLN "abstract" #define CONCRETE_RLN "concrete" #define HANDLER_DECL "message-handler" #define SLOT_RLN "slot" #define SGL_SLOT_RLN "single-slot" #define MLT_SLOT_RLN "multislot" #define DIRECT 0 #define INHERIT 1 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ValidClassName(void *,const char *,DEFCLASS **); static intBool ParseSimpleQualifier(void *,const char *,const char *,const char *,const char *,intBool *,intBool *); static intBool ReadUntilClosingParen(void *,const char *,struct token *); static void AddClass(void *,DEFCLASS *); static void BuildSubclassLinks(void *,DEFCLASS *); static void FormInstanceTemplate(void *,DEFCLASS *); static void FormSlotNameMap(void *,DEFCLASS *); static TEMP_SLOT_LINK *MergeSlots(void *,TEMP_SLOT_LINK *,DEFCLASS *,short *,int); static void PackSlots(void *,DEFCLASS *,TEMP_SLOT_LINK *); static void CreatePublicSlotMessageHandlers(void *,DEFCLASS *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************************** NAME : ParseDefclass DESCRIPTION : (defclass ...) is a construct (as opposed to a function), thus no variables may be used. This means classes may only be STATICALLY defined (like rules). INPUTS : The logical name of the router for the parser input RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid class definition into Class Table. NOTES : H/L Syntax : (defclass [] (is-a +) *) :== (slot *) | (role abstract|concrete) | (pattern-match reactive|non-reactive) These are for documentation only: (message-handler []) :== (default ) | (default-dynamic ) | (storage shared|local) | (access read-only|read-write|initialize-only) | (propagation no-inherit|inherit) | (source composite|exclusive) (pattern-match reactive|non-reactive) (visibility public|private) (override-message ) (type ...) | (cardinality ...) | (allowed-symbols ...) | (allowed-strings ...) | (allowed-numbers ...) | (allowed-integers ...) | (allowed-floats ...) | (allowed-values ...) | (allowed-instance-names ...) | (allowed-classes ...) | (range ...) ::= ?NONE | ?VARIABLE | * ***************************************************************************************/ globle int ParseDefclass( void *theEnv, const char *readSource) { SYMBOL_HN *cname; DEFCLASS *cls; PACKED_CLASS_LINKS *sclasses,*preclist; TEMP_SLOT_LINK *slots = NULL; int roleSpecified = FALSE, abstract = FALSE, parseError; #if DEFRULE_CONSTRUCT int patternMatchSpecified = FALSE, reactive = TRUE; #endif SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defclass "); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defclass"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defclass", EnvFindDefclassInModule,NULL,"#",TRUE, TRUE,TRUE,FALSE); if (cname == NULL) return(TRUE); if (ValidClassName(theEnv,ValueToString(cname),&cls) == FALSE) return(TRUE); sclasses = ParseSuperclasses(theEnv,readSource,cname); if (sclasses == NULL) return(TRUE); preclist = FindPrecedenceList(theEnv,cls,sclasses); if (preclist == NULL) { DeletePackedClassLinks(theEnv,sclasses,TRUE); return(TRUE); } parseError = FALSE; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,"("); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ROLE_RLN) == 0) { if (ParseSimpleQualifier(theEnv,readSource,ROLE_RLN,CONCRETE_RLN,ABSTRACT_RLN, &roleSpecified,&abstract) == FALSE) { parseError = TRUE; break; } } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_RLN) == 0) { if (ParseSimpleQualifier(theEnv,readSource,MATCH_RLN,NONREACTIVE_RLN,REACTIVE_RLN, &patternMatchSpecified,&reactive) == FALSE) { parseError = TRUE; break; } } #endif else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,FALSE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SGL_SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,TRUE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MLT_SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,TRUE,TRUE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),HANDLER_DECL) == 0) { if (ReadUntilClosingParen(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken) == FALSE) { parseError = TRUE; break; } } else { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if ((GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) || (parseError == TRUE)) { DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(TRUE); } SavePPBuffer(theEnv,"\n"); /* ========================================================================= The abstract/reactive qualities of a class are inherited if not specified ========================================================================= */ if (roleSpecified == FALSE) { if (preclist->classArray[1]->system && /* Change to cause */ (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* default role of */ { abstract = FALSE; } /* classes to be concrete. */ else { abstract = preclist->classArray[1]->abstract; } } #if DEFRULE_CONSTRUCT if (patternMatchSpecified == FALSE) { if ((preclist->classArray[1]->system) && /* Change to cause */ (! abstract) && /* default pattern-match */ (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* of classes to be */ { reactive = TRUE; } /* reactive. */ else { reactive = preclist->classArray[1]->reactive; } } /* ================================================================ An abstract class cannot have direct instances, thus it makes no sense for it to be reactive since it will have no objects to respond to pattern-matching ================================================================ */ if (abstract && reactive) { PrintErrorID(theEnv,"CLASSPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"An abstract class cannot be reactive.\n"); DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(TRUE); } #endif /* ======================================================= If we're only checking syntax, don't add the successfully parsed defclass to the KB. ======================================================= */ if (ConstructData(theEnv)->CheckSyntaxMode) { DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(FALSE); } cls = NewClass(theEnv,cname); cls->abstract = abstract; #if DEFRULE_CONSTRUCT cls->reactive = reactive; #endif cls->directSuperclasses.classCount = sclasses->classCount; cls->directSuperclasses.classArray = sclasses->classArray; /* ======================================================= This is a hack to let functions which need to iterate over a class AND its superclasses to conveniently do so The real precedence list starts in position 1 ======================================================= */ preclist->classArray[0] = cls; cls->allSuperclasses.classCount = preclist->classCount; cls->allSuperclasses.classArray = preclist->classArray; rtn_struct(theEnv,packedClassLinks,sclasses); rtn_struct(theEnv,packedClassLinks,preclist); /* ================================= Shove slots into contiguous array ================================= */ if (slots != NULL) PackSlots(theEnv,cls,slots); AddClass(theEnv,cls); return(FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : ValidClassName DESCRIPTION : Determines if a new class of the given name can be defined in the current module INPUTS : 1) The new class name 2) Buffer to hold class address RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed if not OK NOTES : GetConstructNameAndComment() (called before this function) ensures that the defclass name does not conflict with one from another module ***********************************************************/ static intBool ValidClassName( void *theEnv, const char *theClassName, DEFCLASS **theDefclass) { *theDefclass = (DEFCLASS *) EnvFindDefclassInModule(theEnv,theClassName); if (*theDefclass != NULL) { /* =================================== System classes (which are visible in all modules) cannot be redefined =================================== */ if ((*theDefclass)->system) { PrintErrorID(theEnv,"CLASSPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot redefine a predefined system class.\n"); return(FALSE); } /* =============================================== A class in the current module can only be redefined if it is not in use, e.g., instances, generic function method restrictions, etc. =============================================== */ if ((EnvIsDefclassDeletable(theEnv,(void *) *theDefclass) == FALSE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { PrintErrorID(theEnv,"CLASSPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) *theDefclass)); EnvPrintRouter(theEnv,WERROR," class cannot be redefined while\n"); EnvPrintRouter(theEnv,WERROR," outstanding references to it still exist.\n"); return(FALSE); } } return(TRUE); } /*************************************************************** NAME : ParseSimpleQualifier DESCRIPTION : Parses abstract/concrete role and pattern-matching reactivity for class INPUTS : 1) The input logical name 2) The name of the qualifier being parsed 3) The qualifier value indicating that the qualifier should be false 4) The qualifier value indicating that the qualifier should be TRUE 5) A pointer to a bitmap indicating if the qualifier has already been parsed 6) A buffer to store the value of the qualifier RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Bitmap and qualifier buffers set Messages printed on errors NOTES : None ***************************************************************/ static intBool ParseSimpleQualifier( void *theEnv, const char *readSource, const char *classQualifier, const char *clearRelation, const char *setRelation, intBool *alreadyTestedFlag, intBool *binaryFlag) { if (*alreadyTestedFlag) { PrintErrorID(theEnv,"CLASSPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Class "); EnvPrintRouter(theEnv,WERROR,classQualifier); EnvPrintRouter(theEnv,WERROR," already declared.\n"); return(FALSE); } SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) goto ParseSimpleQualifierError; if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),setRelation) == 0) *binaryFlag = TRUE; else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),clearRelation) == 0) *binaryFlag = FALSE; else goto ParseSimpleQualifierError; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) goto ParseSimpleQualifierError; *alreadyTestedFlag = TRUE; return(TRUE); ParseSimpleQualifierError: SyntaxErrorMessage(theEnv,"defclass"); return(FALSE); } /*************************************************** NAME : ReadUntilClosingParen DESCRIPTION : Skips over tokens until a ')' is encountered. INPUTS : 1) The logical input source 2) A buffer for scanned tokens RETURNS : TRUE if ')' read, FALSE otherwise SIDE EFFECTS : Tokens read NOTES : Expects first token after opening paren has already been scanned ***************************************************/ static intBool ReadUntilClosingParen( void *theEnv, const char *readSource, struct token *inputToken) { int cnt = 1,lparen_read = FALSE; do { if (lparen_read == FALSE) SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,inputToken); if (inputToken->type == STOP) { SyntaxErrorMessage(theEnv,"message-handler declaration"); return(FALSE); } else if (inputToken->type == LPAREN) { lparen_read = TRUE; cnt++; } else if (inputToken->type == RPAREN) { cnt--; if (lparen_read == FALSE) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } lparen_read = FALSE; } else lparen_read = FALSE; } while (cnt > 0); return(TRUE); } /***************************************************************************** NAME : AddClass DESCRIPTION : Determines the precedence list of the new class. If it is valid, the routine checks to see if the class already exists. If it does not, all the subclass links are made from the class's direct superclasses, and the class is inserted in the hash table. If it does, all sublclasses are deleted. An error will occur if any instances of the class (direct or indirect) exist. If all checks out, the old definition is replaced by the new. INPUTS : The new class description RETURNS : Nothing useful SIDE EFFECTS : The class is deleted if there is an error. NOTES : No change in the class graph state will occur if there were any errors. Assumes class is not busy!!! *****************************************************************************/ static void AddClass( void *theEnv, DEFCLASS *cls) { DEFCLASS *ctmp; #if DEBUGGING_FUNCTIONS int oldTraceInstances = FALSE, oldTraceSlots = FALSE; #endif /* =============================================== If class does not already exist, insert and form progeny links with all direct superclasses =============================================== */ cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls)); ctmp = (DEFCLASS *) EnvFindDefclassInModule(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); if (ctmp != NULL) { #if DEBUGGING_FUNCTIONS oldTraceInstances = ctmp->traceInstances; oldTraceSlots = ctmp->traceSlots; #endif DeleteClassUAG(theEnv,ctmp); } PutClassInTable(theEnv,cls); BuildSubclassLinks(theEnv,cls); InstallClass(theEnv,cls,TRUE); AddConstructToModule((struct constructHeader *) cls); FormInstanceTemplate(theEnv,cls); FormSlotNameMap(theEnv,cls); AssignClassID(theEnv,cls); #if DEBUGGING_FUNCTIONS if (cls->abstract) { cls->traceInstances = FALSE; cls->traceSlots = FALSE; } else { if (oldTraceInstances) cls->traceInstances = TRUE; if (oldTraceSlots) cls->traceSlots = TRUE; } #endif #if DEBUGGING_FUNCTIONS if (EnvGetConserveMemory(theEnv) == FALSE) EnvSetDefclassPPForm(theEnv,(void *) cls,CopyPPBuffer(theEnv)); #endif #if DEFMODULE_CONSTRUCT /* ========================================= Create a bitmap indicating whether this class is in scope or not for every module ========================================= */ cls->scopeMap = (BITMAP_HN *) CreateClassScopeMap(theEnv,cls); #endif /* ============================================== Define get- and put- handlers for public slots ============================================== */ CreatePublicSlotMessageHandlers(theEnv,cls); } /******************************************************* NAME : BuildSubclassLinks DESCRIPTION : Follows the list of superclasses for a class and puts the class in each of the superclasses' subclass list. INPUTS : The address of the class RETURNS : Nothing useful SIDE EFFECTS : The subclass lists for every superclass are modified. NOTES : Assumes the superclass list is formed. *******************************************************/ static void BuildSubclassLinks( void *theEnv, DEFCLASS *cls) { long i; for (i = 0 ; i < cls->directSuperclasses.classCount ; i++) AddClassLink(theEnv,&cls->directSuperclasses.classArray[i]->directSubclasses,cls,-1); } /********************************************************** NAME : FormInstanceTemplate DESCRIPTION : Forms a contiguous array of instance slots for use in creating instances later Also used in determining instance slot indices a priori during handler defns INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Contiguous array of instance slots formed NOTES : None **********************************************************/ static void FormInstanceTemplate( void *theEnv, DEFCLASS *cls) { TEMP_SLOT_LINK *islots = NULL,*stmp; short scnt = 0; long i; /* ======================== Get direct class's slots ======================== */ islots = MergeSlots(theEnv,islots,cls,&scnt,DIRECT); /* =================================================================== Get all inherited slots - a more specific slot takes precedence over more general, i.e. the first class in the precedence list with a particular slot gets to specify its default value =================================================================== */ for (i = 1 ; i < cls->allSuperclasses.classCount ; i++) islots = MergeSlots(theEnv,islots,cls->allSuperclasses.classArray[i],&scnt,INHERIT); /* =================================================== Allocate a contiguous array to store all the slots. =================================================== */ cls->instanceSlotCount = scnt; cls->localInstanceSlotCount = 0; if (scnt > 0) cls->instanceTemplate = (SLOT_DESC **) gm2(theEnv,(scnt * sizeof(SLOT_DESC *))); for (i = 0 ; i < scnt ; i++) { stmp = islots; islots = islots->nxt; cls->instanceTemplate[i] = stmp->desc; if (stmp->desc->shared == 0) cls->localInstanceSlotCount++; rtn_struct(theEnv,tempSlotLink,stmp); } } /********************************************************** NAME : FormSlotNameMap DESCRIPTION : Forms a mapping of the slot name ids into the instance template. Given the slot name id, this map provides a much faster lookup of a slot. The id is stored statically in object patterns and can be looked up via a hash table at runtime as well. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Contiguous array of integers formed The position in the array corresponding to a slot name id holds an the index into the instance template array holding the slot The max slot name id for the class is also stored to make deletion of the slots easier NOTES : Assumes the instance template has already been formed **********************************************************/ static void FormSlotNameMap( void *theEnv, DEFCLASS *cls) { long i; cls->maxSlotNameID = 0; cls->slotNameMap = NULL; if (cls->instanceSlotCount == 0) return; for (i = 0 ; i < cls->instanceSlotCount ; i++) if (cls->instanceTemplate[i]->slotName->id > cls->maxSlotNameID) cls->maxSlotNameID = cls->instanceTemplate[i]->slotName->id; cls->slotNameMap = (unsigned *) gm2(theEnv,(sizeof(unsigned) * (cls->maxSlotNameID + 1))); for (i = 0 ; i <= cls->maxSlotNameID ; i++) cls->slotNameMap[i] = 0; for (i = 0 ; i < cls->instanceSlotCount ; i++) cls->slotNameMap[cls->instanceTemplate[i]->slotName->id] = i + 1; } /******************************************************************** NAME : MergeSlots DESCRIPTION : Adds non-duplicate slots to list and increments slot count for the class instance template INPUTS : 1) The old slot list 2) The address of class containing new slots 3) Caller's buffer for # of slots 4) A flag indicating whether the new list of slots is from the direct parent-class or not. RETURNS : The address of the new expanded list, or NULL for an empty list SIDE EFFECTS : The list is expanded Caller's slot count is adjusted. NOTES : Lists are assumed to contain no duplicates *******************************************************************/ static TEMP_SLOT_LINK *MergeSlots( void *theEnv, TEMP_SLOT_LINK *old, DEFCLASS *cls, short *scnt, int src) { TEMP_SLOT_LINK *cur,*tmp; register int i; SLOT_DESC *newSlot; /* ====================================== Process the slots in reverse order since we are pushing them onto a stack ====================================== */ for (i = (int) (cls->slotCount - 1) ; i >= 0 ; i--) { newSlot = &cls->slots[i]; /* ========================================== A class can prevent it slots from being propagated to all but its direct instances ========================================== */ if ((newSlot->noInherit == 0) ? TRUE : (src == DIRECT)) { cur = old; while ((cur != NULL) ? (newSlot->slotName != cur->desc->slotName) : FALSE) cur = cur->nxt; if (cur == NULL) { tmp = get_struct(theEnv,tempSlotLink); tmp->desc = newSlot; tmp->nxt = old; old = tmp; (*scnt)++; } } } return(old); } /*********************************************************************** NAME : PackSlots DESCRIPTION : Groups class-slots into a contiguous array "slots" field points to array "slotCount" field set INPUTS : 1) The class 2) The list of slots RETURNS : Nothing useful SIDE EFFECTS : Temporary list deallocated, contiguous array allocated, and nxt pointers linked Class pointer set for slots NOTES : Assumes class->slotCount == 0 && class->slots == NULL ***********************************************************************/ static void PackSlots( void *theEnv, DEFCLASS *cls, TEMP_SLOT_LINK *slots) { TEMP_SLOT_LINK *stmp,*sprv; long i; stmp = slots; while (stmp != NULL) { stmp->desc->cls = cls; cls->slotCount++; stmp = stmp->nxt; } cls->slots = (SLOT_DESC *) gm2(theEnv,(sizeof(SLOT_DESC) * cls->slotCount)); stmp = slots; for (i = 0 ; i < cls->slotCount ; i++) { sprv = stmp; stmp = stmp->nxt; GenCopyMemory(SLOT_DESC,1,&(cls->slots[i]),sprv->desc); cls->slots[i].sharedValue.desc = &(cls->slots[i]); cls->slots[i].sharedValue.value = NULL; rtn_struct(theEnv,slotDescriptor,sprv->desc); rtn_struct(theEnv,tempSlotLink,sprv); } } #if DEFMODULE_CONSTRUCT /******************************************************** NAME : CreateClassScopeMap DESCRIPTION : Creates a bitmap where each bit position corresponds to a module id. If the bit is set, the class is in scope for that module, otherwise it is not. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Scope bitmap created and attached NOTES : Uses FindImportedConstruct() ********************************************************/ globle void *CreateClassScopeMap( void *theEnv, DEFCLASS *theDefclass) { unsigned scopeMapSize; char *scopeMap; const char *className; struct defmodule *matchModule, *theModule; int moduleID,count; void *theBitMap; className = ValueToString(theDefclass->header.name); matchModule = theDefclass->header.whichModule->theModule; scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1)); scopeMap = (char *) gm2(theEnv,scopeMapSize); ClearBitString((void *) scopeMap,scopeMapSize); SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL) ; theModule != NULL ; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleID = (int) theModule->bsaveID; if (FindImportedConstruct(theEnv,"defclass",matchModule, className,&count,TRUE,NULL) != NULL) SetBitMap(scopeMap,moduleID); } RestoreCurrentModule(theEnv); theBitMap = (BITMAP_HN *) EnvAddBitMap(theEnv,scopeMap,scopeMapSize); IncrementBitMapCount(theBitMap); rm(theEnv,(void *) scopeMap,scopeMapSize); return(theBitMap); } #endif /***************************************************************************** NAME : CreatePublicSlotMessageHandlers DESCRIPTION : Creates a get- and put- handler for every public slot in a class. The syntax of the message-handlers created are: (defmessage-handler get- primary () ?self:) For single-field slots: (defmessage-handler put- primary (?value) (bind ?self: ?value)) For multifield slots: (defmessage-handler put- primary ($?value) (bind ?self: ?value)) INPUTS : The defclass RETURNS : Nothing useful SIDE EFFECTS : Message-handlers created NOTES : None ******************************************************************************/ static void CreatePublicSlotMessageHandlers( void *theEnv, DEFCLASS *theDefclass) { long i; register SLOT_DESC *sd; for (i = 0 ; i < theDefclass->slotCount ; i++) { sd = &theDefclass->slots[i]; CreateGetAndPutHandlers(theEnv,sd); } for (i = 0 ; i < theDefclass->handlerCount ; i++) theDefclass->handlers[i].system = TRUE; } #endif clips_core_source_630/core/._drive.h0000755000175000017500000000040712500146076015732 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._msgpass.h0000755000175000017500000000040712374017650016302 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._insfun.c0000755000175000017500000000040712500146515016114 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/bload.h0000755000175000017500000000750012373706605015476 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_bload #define _H_bload #ifndef _H_utility #include "utility.h" #endif #ifndef _H_extnfunc #include "extnfunc.h" #endif #ifndef _H_exprnbin #include "exprnbin.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_sysdep #include "sysdep.h" #endif #ifndef _H_symblbin #include "symblbin.h" #endif #define BLOAD_DATA 38 struct bloadData { const char *BinaryPrefixID; const char *BinaryVersionID; struct FunctionDefinition **FunctionArray; int BloadActive; struct callFunctionItem *BeforeBloadFunctions; struct callFunctionItem *AfterBloadFunctions; struct callFunctionItem *ClearBloadReadyFunctions; struct callFunctionItem *AbortBloadFunctions; }; #define BloadData(theEnv) ((struct bloadData *) GetEnvironmentData(theEnv,BLOAD_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _BLOAD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define FunctionPointer(i) ((struct FunctionDefinition *) (((i) == -1L) ? NULL : BloadData(theEnv)->FunctionArray[i])) LOCALE void InitializeBloadData(void *); LOCALE int BloadCommand(void *); LOCALE intBool EnvBload(void *,const char *); LOCALE void BloadandRefresh(void *,long,size_t,void (*)(void *,void *,long)); LOCALE intBool Bloaded(void *); LOCALE void AddBeforeBloadFunction(void *,const char *,void (*)(void *),int); LOCALE void AddAfterBloadFunction(void *,const char *,void (*)(void *),int); LOCALE void AddClearBloadReadyFunction(void *,const char *,int (*)(void *),int); LOCALE void AddAbortBloadFunction(void *,const char *,void (*)(void *),int); LOCALE void CannotLoadWithBloadMessage(void *,const char *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE int Bload(const char *); #endif #endif clips_core_source_630/core/._pattern.h0000755000175000017500000000040712500146515016274 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._prccode.h0000755000175000017500000000040712373743664016256 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._parsefun.h0000755000175000017500000000040712373743671016460 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/pprint.h0000755000175000017500000000621512373743666015743 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* PRETTY PRINT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for processing the pretty print */ /* representation of constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Used genstrcpy instead of strcpy. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_pprint #define _H_pprint #define PRETTY_PRINT_DATA 52 struct prettyPrintData { int PPBufferStatus; int PPBufferEnabled; int IndentationDepth; size_t PPBufferPos; size_t PPBufferMax; size_t PPBackupOnce; size_t PPBackupTwice; char *PrettyPrintBuffer; }; #define PrettyPrintData(theEnv) ((struct prettyPrintData *) GetEnvironmentData(theEnv,PRETTY_PRINT_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PPRINT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializePrettyPrintData(void *); LOCALE void FlushPPBuffer(void *); LOCALE void DestroyPPBuffer(void *); LOCALE void SavePPBuffer(void *,const char *); LOCALE void PPBackup(void *); LOCALE char *CopyPPBuffer(void *); LOCALE char *GetPPBuffer(void *); LOCALE void PPCRAndIndent(void *); LOCALE void IncrementIndentDepth(void *,int); LOCALE void DecrementIndentDepth(void *,int); LOCALE void SetIndentDepth(void *,int); LOCALE void SetPPBufferStatus(void *,int); LOCALE int GetPPBufferStatus(void *); LOCALE int SetPPBufferEnabled(void *,int); LOCALE int GetPPBufferEnabled(void *); #endif clips_core_source_630/core/._dffnxbin.h0000755000175000017500000000040712373731204016420 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtgen.c0000755000175000017500000000040712374023163016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulecstr.c0000755000175000017500000010011412374023476016245 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE CONSTRAINTS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for detecting constraint */ /* conflicts in the LHS and RHS of rules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /*************************************************************/ #define _RULECSTR_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "analysis.h" #include "cstrnchk.h" #include "cstrnops.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "extnfunc.h" #include "prcdrpsr.h" #include "reorder.h" #include "router.h" #include "rulepsr.h" #include "rulecstr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool CheckForUnmatchableConstraints(void *,struct lhsParseNode *,int); static intBool MultifieldCardinalityViolation(void *,struct lhsParseNode *); static struct lhsParseNode *UnionVariableConstraints(void *,struct lhsParseNode *, struct lhsParseNode *); static struct lhsParseNode *AddToVariableConstraints(void *,struct lhsParseNode *, struct lhsParseNode *); static void ConstraintConflictMessage(void *,struct symbolHashNode *, int,int,struct symbolHashNode *); static intBool CheckArgumentForConstraintError(void *,struct expr *,struct expr*, int,struct FunctionDefinition *, struct lhsParseNode *); /***********************************************************/ /* CheckForUnmatchableConstraints: Determines if a LHS CE */ /* node contains unmatchable constraints. Return TRUE if */ /* there are unmatchable constraints, otherwise FALSE. */ /***********************************************************/ static intBool CheckForUnmatchableConstraints( void *theEnv, struct lhsParseNode *theNode, int whichCE) { if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE); if (UnmatchableConstraint(theNode->constraints)) { ConstraintConflictMessage(theEnv,(SYMBOL_HN *) theNode->value,whichCE, theNode->index,theNode->slot); return(TRUE); } return(FALSE); } /******************************************************/ /* ConstraintConflictMessage: Error message used when */ /* a constraint restriction for a slot prevents any */ /* value from matching the pattern constraint. */ /******************************************************/ static void ConstraintConflictMessage( void *theEnv, struct symbolHashNode *variableName, int thePattern, int theField, struct symbolHashNode *theSlot) { /*=========================*/ /* Print the error header. */ /*=========================*/ PrintErrorID(theEnv,"RULECSTR",1,TRUE); /*======================================================*/ /* Print the variable name (if available) and CE number */ /* for which the constraint violation occurred. */ /*======================================================*/ if (variableName != NULL) { EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(variableName)); EnvPrintRouter(theEnv,WERROR," in CE #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } else { EnvPrintRouter(theEnv,WERROR,"Pattern #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } /*=======================================*/ /* Print the slot name or field position */ /* in which the violation occurred. */ /*=======================================*/ if (theSlot == NULL) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theSlot)); } /*======================================*/ /* Print the rest of the error message. */ /*======================================*/ EnvPrintRouter(theEnv,WERROR,"\nhas constraint conflicts which make the pattern unmatchable.\n"); } /***************************************************************/ /* MultifieldCardinalityViolation: Determines if a cardinality */ /* violation has occurred for a LHS CE node. */ /***************************************************************/ static intBool MultifieldCardinalityViolation( void *theEnv, struct lhsParseNode *theNode) { struct lhsParseNode *tmpNode; struct expr *tmpMax; long minFields = 0; long maxFields = 0; int posInfinity = FALSE; CONSTRAINT_RECORD *newConstraint, *tempConstraint; /*================================*/ /* A single field slot can't have */ /* a cardinality violation. */ /*================================*/ if (theNode->multifieldSlot == FALSE) return(FALSE); /*=============================================*/ /* Determine the minimum and maximum number of */ /* fields the slot could contain based on the */ /* slot constraints found in the pattern. */ /*=============================================*/ for (tmpNode = theNode->bottom; tmpNode != NULL; tmpNode = tmpNode->right) { /*====================================================*/ /* A single field variable increases both the minimum */ /* and maximum number of fields by one. */ /*====================================================*/ if ((tmpNode->type == SF_VARIABLE) || (tmpNode->type == SF_WILDCARD)) { minFields++; maxFields++; } /*=================================================*/ /* Otherwise a multifield wildcard or variable has */ /* been encountered. If it is constrained then use */ /* minimum and maximum number of fields constraint */ /* associated with this LHS node. */ /*=================================================*/ else if (tmpNode->constraints != NULL) { /*=======================================*/ /* The lowest minimum of all the min/max */ /* pairs will be the first in the list. */ /*=======================================*/ if (tmpNode->constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity) { minFields += (long) ValueToLong(tmpNode->constraints->minFields->value); } /*=========================================*/ /* The greatest maximum of all the min/max */ /* pairs will be the last in the list. */ /*=========================================*/ tmpMax = tmpNode->constraints->maxFields; while (tmpMax->nextArg != NULL) tmpMax = tmpMax->nextArg; if (tmpMax->value == SymbolData(theEnv)->PositiveInfinity) { posInfinity = TRUE; } else { maxFields += (long) ValueToLong(tmpMax->value); } } /*================================================*/ /* Otherwise an unconstrained multifield wildcard */ /* or variable increases the maximum number of */ /* fields to positive infinity. */ /*================================================*/ else { posInfinity = TRUE; } } /*==================================================================*/ /* Create a constraint record for the cardinality of the sum of the */ /* cardinalities of the restrictions inside the multifield slot. */ /*==================================================================*/ if (theNode->constraints == NULL) tempConstraint = GetConstraintRecord(theEnv); else tempConstraint = CopyConstraintRecord(theEnv,theNode->constraints); ReturnExpression(theEnv,tempConstraint->minFields); ReturnExpression(theEnv,tempConstraint->maxFields); tempConstraint->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long long) minFields)); if (posInfinity) tempConstraint->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity); else tempConstraint->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long long) maxFields)); /*================================================================*/ /* Determine the final cardinality for the multifield slot by */ /* intersecting the cardinality sum of the restrictions within */ /* the multifield slot with the original cardinality of the slot. */ /*================================================================*/ newConstraint = IntersectConstraints(theEnv,theNode->constraints,tempConstraint); if (theNode->derivedConstraints) RemoveConstraint(theEnv,theNode->constraints); RemoveConstraint(theEnv,tempConstraint); theNode->constraints = newConstraint; theNode->derivedConstraints = TRUE; /*===================================================================*/ /* Determine if the final cardinality for the slot can be satisfied. */ /*===================================================================*/ if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE); if (UnmatchableConstraint(newConstraint)) return(TRUE); return(FALSE); } /***************************************************/ /* ProcessConnectedConstraints: Examines a single */ /* connected constraint searching for constraint */ /* violations. */ /***************************************************/ globle intBool ProcessConnectedConstraints( void *theEnv, struct lhsParseNode *theNode, struct lhsParseNode *multifieldHeader, struct lhsParseNode *patternHead) { struct constraintRecord *orConstraints = NULL, *andConstraints; struct constraintRecord *tmpConstraints, *rvConstraints; struct lhsParseNode *orNode, *andNode; struct expr *tmpExpr; /*============================================*/ /* Loop through all of the or (|) constraints */ /* found in the connected constraint. */ /*============================================*/ for (orNode = theNode->bottom; orNode != NULL; orNode = orNode->bottom) { /*=================================================*/ /* Intersect all of the &'ed constraints together. */ /*=================================================*/ andConstraints = NULL; for (andNode = orNode; andNode != NULL; andNode = andNode->right) { if (! andNode->negated) { if (andNode->type == RETURN_VALUE_CONSTRAINT) { if (andNode->expression->type == FCALL) { rvConstraints = FunctionCallToConstraintRecord(theEnv,andNode->expression->value); tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,rvConstraints); RemoveConstraint(theEnv,tmpConstraints); RemoveConstraint(theEnv,rvConstraints); } } else if (ConstantType(andNode->type)) { tmpExpr = GenConstant(theEnv,andNode->type,andNode->value); rvConstraints = ExpressionToConstraintRecord(theEnv,tmpExpr); tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,rvConstraints); RemoveConstraint(theEnv,tmpConstraints); RemoveConstraint(theEnv,rvConstraints); ReturnExpression(theEnv,tmpExpr); } else if (andNode->constraints != NULL) { tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,andNode->constraints); RemoveConstraint(theEnv,tmpConstraints); } } } /*===========================================================*/ /* Intersect the &'ed constraints with the slot constraints. */ /*===========================================================*/ tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,theNode->constraints); RemoveConstraint(theEnv,tmpConstraints); /*===============================================================*/ /* Remove any negated constants from the list of allowed values. */ /*===============================================================*/ for (andNode = orNode; andNode != NULL; andNode = andNode->right) { if ((andNode->negated) && ConstantType(andNode->type)) { RemoveConstantFromConstraint(theEnv,andNode->type,andNode->value,andConstraints); } } /*=======================================================*/ /* Union the &'ed constraints with the |'ed constraints. */ /*=======================================================*/ tmpConstraints = orConstraints; orConstraints = UnionConstraints(theEnv,orConstraints,andConstraints); RemoveConstraint(theEnv,tmpConstraints); RemoveConstraint(theEnv,andConstraints); } /*===============================================*/ /* Replace the constraints for the slot with the */ /* constraints derived from the connected */ /* constraints (which should be a subset. */ /*===============================================*/ if (orConstraints != NULL) { if (theNode->derivedConstraints) RemoveConstraint(theEnv,theNode->constraints); theNode->constraints = orConstraints; theNode->derivedConstraints = TRUE; } /*==================================*/ /* Check for constraint violations. */ /*==================================*/ if (CheckForUnmatchableConstraints(theEnv,theNode,(int) patternHead->whichCE)) { return(TRUE); } /*=========================================*/ /* If the constraints are for a multifield */ /* slot, check for cardinality violations. */ /*=========================================*/ if ((multifieldHeader != NULL) && (theNode->right == NULL)) { if (MultifieldCardinalityViolation(theEnv,multifieldHeader)) { ConstraintViolationErrorMessage(theEnv,"The group of restrictions", NULL,FALSE, (int) patternHead->whichCE, multifieldHeader->slot, multifieldHeader->index, CARDINALITY_VIOLATION, multifieldHeader->constraints,TRUE); return(TRUE); } } /*=======================================*/ /* Return FALSE indicating no constraint */ /* violations were detected. */ /*=======================================*/ return(FALSE); } /**************************************************/ /* ConstraintReferenceErrorMessage: Generic error */ /* message for LHS constraint violation errors */ /* that occur within an expression. */ /**************************************************/ globle void ConstraintReferenceErrorMessage( void *theEnv, struct symbolHashNode *theVariable, struct lhsParseNode *theExpression, int whichArgument, int whichCE, struct symbolHashNode *slotName, int theField) { struct expr *temprv; PrintErrorID(theEnv,"RULECSTR",2,TRUE); /*==========================*/ /* Print the variable name. */ /*==========================*/ EnvPrintRouter(theEnv,WERROR,"Previous variable bindings of ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable)); EnvPrintRouter(theEnv,WERROR," caused the type restrictions"); /*============================*/ /* Print the argument number. */ /*============================*/ EnvPrintRouter(theEnv,WERROR,"\nfor argument #"); PrintLongInteger(theEnv,WERROR,(long int) whichArgument); /*=======================*/ /* Print the expression. */ /*=======================*/ EnvPrintRouter(theEnv,WERROR," of the expression "); temprv = LHSParseNodesToExpression(theEnv,theExpression); ReturnExpression(theEnv,temprv->nextArg); temprv->nextArg = NULL; PrintExpression(theEnv,WERROR,temprv); EnvPrintRouter(theEnv,WERROR,"\n"); ReturnExpression(theEnv,temprv); /*========================================*/ /* Print out the index of the conditional */ /* element and the slot name or field */ /* index where the violation occured. */ /*========================================*/ EnvPrintRouter(theEnv,WERROR,"found in CE #"); PrintLongInteger(theEnv,WERROR,(long int) theExpression->whichCE); if (slotName == NULL) { if (theField > 0) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(slotName)); } EnvPrintRouter(theEnv,WERROR," to be violated.\n"); } /********************************************************/ /* AddToVariableConstraints: Adds the constraints for a */ /* variable to a list of constraints. If the variable */ /* is already in the list, the constraints for the */ /* variable are intersected with the new constraints. */ /********************************************************/ static struct lhsParseNode *AddToVariableConstraints( void *theEnv, struct lhsParseNode *oldList, struct lhsParseNode *newItems) { CONSTRAINT_RECORD *newConstraints; struct lhsParseNode *temp, *trace; /*=================================================*/ /* Loop through each of the new constraints adding */ /* it to the list if it's not already present or */ /* modifying the constraint if it is. */ /*=================================================*/ while (newItems != NULL) { /*==========================================*/ /* Get the next item since the next pointer */ /* value (right) needs to be set to NULL. */ /*==========================================*/ temp = newItems->right; newItems->right = NULL; /*===================================*/ /* Search the list for the variable. */ /*===================================*/ for (trace = oldList; trace != NULL; trace = trace->right) { /*=========================================*/ /* If the variable is already in the list, */ /* modify the constraint already there to */ /* include the new constraint. */ /*=========================================*/ if (trace->value == newItems->value) { newConstraints = IntersectConstraints(theEnv,trace->constraints, newItems->constraints); RemoveConstraint(theEnv,trace->constraints); trace->constraints = newConstraints; ReturnLHSParseNodes(theEnv,newItems); break; } } /*=================================*/ /* Add the variable constraints to */ /* the list if it wasn't found. */ /*=================================*/ if (trace == NULL) { newItems->right = oldList; oldList = newItems; } /*===========================*/ /* Move on to the next item. */ /*===========================*/ newItems = temp; } return(oldList); } /***********************************************************/ /* UnionVariableConstraints: Unions two lists of variable */ /* constraints. If a variable appears in one list but */ /* not the other, then the variable is unconstrained and */ /* thus not included in the unioned list. */ /***********************************************************/ static struct lhsParseNode *UnionVariableConstraints( void *theEnv, struct lhsParseNode *list1, struct lhsParseNode *list2) { struct lhsParseNode *list3 = NULL, *trace, *temp; /*===================================*/ /* Loop through all of the variables */ /* in the first list. */ /*===================================*/ while (list1 != NULL) { /*=============================================*/ /* Search for the variable in the second list. */ /*=============================================*/ for (trace = list2; trace != NULL; trace = trace->right) { /*============================================*/ /* If the variable is found in both lists, */ /* union the constraints and add the variable */ /* to the new list being constructed. */ /*============================================*/ if (list1->value == trace->value) { temp = GetLHSParseNode(theEnv); temp->derivedConstraints = TRUE; temp->value = list1->value; temp->constraints = UnionConstraints(theEnv,list1->constraints,trace->constraints); temp->right = list3; list3 = temp; break; } } /*==============================*/ /* Move on to the next variable */ /* in the first list. */ /*==============================*/ temp = list1->right; list1->right = NULL; ReturnLHSParseNodes(theEnv,list1); list1 = temp; } /*====================================*/ /* Free the items in the second list. */ /*====================================*/ ReturnLHSParseNodes(theEnv,list2); /*======================*/ /* Return the new list. */ /*======================*/ return(list3); } /*****************************************************************/ /* GetExpressionVarConstraints: Given an expression stored using */ /* the LHS parse node data structures, determines and returns */ /* the constraints on variables caused by that expression. For */ /* example, the expression (+ ?x 1) would imply a numeric type */ /* constraint for the variable ?x since the addition function */ /* expects numeric arguments. */ /*****************************************************************/ globle struct lhsParseNode *GetExpressionVarConstraints( void *theEnv, struct lhsParseNode *theExpression) { struct lhsParseNode *list1 = NULL, *list2; for (; theExpression != NULL; theExpression = theExpression->bottom) { if (theExpression->right != NULL) { list2 = GetExpressionVarConstraints(theEnv,theExpression->right); list1 = AddToVariableConstraints(theEnv,list2,list1); } if (theExpression->type == SF_VARIABLE) { list2 = GetLHSParseNode(theEnv); if (theExpression->referringNode != NULL) { list2->type = theExpression->referringNode->type; } else { list2->type = SF_VARIABLE; } list2->value = theExpression->value; list2->derivedConstraints = TRUE; list2->constraints = CopyConstraintRecord(theEnv,theExpression->constraints); list1 = AddToVariableConstraints(theEnv,list2,list1); } } return(list1); } /***********************************************/ /* DeriveVariableConstraints: Derives the list */ /* of variable constraints associated with a */ /* single connected constraint. */ /***********************************************/ globle struct lhsParseNode *DeriveVariableConstraints( void *theEnv, struct lhsParseNode *theNode) { struct lhsParseNode *orNode, *andNode; struct lhsParseNode *list1, *list2, *list3 = NULL; int first = TRUE; /*===============================*/ /* Process the constraints for a */ /* single connected constraint. */ /*===============================*/ for (orNode = theNode->bottom; orNode != NULL; orNode = orNode->bottom) { /*=================================================*/ /* Intersect all of the &'ed constraints together. */ /*=================================================*/ list2 = NULL; for (andNode = orNode; andNode != NULL; andNode = andNode->right) { if ((andNode->type == RETURN_VALUE_CONSTRAINT) || (andNode->type == PREDICATE_CONSTRAINT)) { list1 = GetExpressionVarConstraints(theEnv,andNode->expression); list2 = AddToVariableConstraints(theEnv,list2,list1); } } if (first) { list3 = list2; first = FALSE; } else { list3 = UnionVariableConstraints(theEnv,list3,list2); } } return(list3); } /*******************************************/ /* CheckRHSForConstraintErrors: Checks the */ /* RHS of a rule for constraint errors. */ /*******************************************/ globle intBool CheckRHSForConstraintErrors( void *theEnv, struct expr *expressionList, struct lhsParseNode *theLHS) { struct FunctionDefinition *theFunction; int i; struct expr *lastOne = NULL, *checkList, *tmpPtr; if (expressionList == NULL) return(FALSE); for (checkList = expressionList; checkList != NULL; checkList = checkList->nextArg) { expressionList = checkList->argList; i = 1; if (checkList->type == FCALL) { lastOne = checkList; theFunction = (struct FunctionDefinition *) checkList->value; } else { theFunction = NULL; } while (expressionList != NULL) { if (CheckArgumentForConstraintError(theEnv,expressionList,lastOne,i, theFunction,theLHS)) { return(TRUE); } i++; tmpPtr = expressionList->nextArg; expressionList->nextArg = NULL; if (CheckRHSForConstraintErrors(theEnv,expressionList,theLHS)) { expressionList->nextArg = tmpPtr; return(TRUE); } expressionList->nextArg = tmpPtr; expressionList = expressionList->nextArg; } } return(FALSE); } /*************************************************************/ /* CheckArgumentForConstraintError: Checks a single argument */ /* found in the RHS of a rule for constraint errors. */ /* Returns TRUE if an error is detected, otherwise FALSE. */ /*************************************************************/ static intBool CheckArgumentForConstraintError( void *theEnv, struct expr *expressionList, struct expr *lastOne, int i, struct FunctionDefinition *theFunction, struct lhsParseNode *theLHS) { int theRestriction; CONSTRAINT_RECORD *constraint1, *constraint2, *constraint3, *constraint4; struct lhsParseNode *theVariable; struct expr *tmpPtr; int rv = FALSE; /*=============================================================*/ /* Skip anything that isn't a variable or isn't an argument to */ /* a user defined function (i.e. deffunctions and generic have */ /* no constraint information so they aren't checked). */ /*=============================================================*/ if ((expressionList->type != SF_VARIABLE) || (theFunction == NULL)) { return (rv); } /*===========================================*/ /* Get the restrictions for the argument and */ /* convert them to a constraint record. */ /*===========================================*/ theRestriction = GetNthRestriction(theFunction,i); constraint1 = ArgumentTypeToConstraintRecord(theEnv,theRestriction); /*================================================*/ /* Look for the constraint record associated with */ /* binding the variable in the LHS of the rule. */ /*================================================*/ theVariable = FindVariable((SYMBOL_HN *) expressionList->value,theLHS); if (theVariable != NULL) { if (theVariable->type == MF_VARIABLE) { constraint2 = GetConstraintRecord(theEnv); SetConstraintType(MULTIFIELD,constraint2); } else if (theVariable->constraints == NULL) { constraint2 = GetConstraintRecord(theEnv); } else { constraint2 = CopyConstraintRecord(theEnv,theVariable->constraints); } } else { constraint2 = NULL; } /*================================================*/ /* Look for the constraint record associated with */ /* binding the variable on the RHS of the rule. */ /*================================================*/ constraint3 = FindBindConstraints(theEnv,(SYMBOL_HN *) expressionList->value); /*====================================================*/ /* Union the LHS and RHS variable binding constraints */ /* (the variable must satisfy one or the other). */ /*====================================================*/ constraint3 = UnionConstraints(theEnv,constraint3,constraint2); /*====================================================*/ /* Intersect the LHS/RHS variable binding constraints */ /* with the function argument restriction constraints */ /* (the variable must satisfy both). */ /*====================================================*/ constraint4 = IntersectConstraints(theEnv,constraint3,constraint1); /*====================================*/ /* Check for unmatchable constraints. */ /*====================================*/ if (UnmatchableConstraint(constraint4) && EnvGetStaticConstraintChecking(theEnv)) { PrintErrorID(theEnv,"RULECSTR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Previous variable bindings of ?"); EnvPrintRouter(theEnv,WERROR,ValueToString((SYMBOL_HN *) expressionList->value)); EnvPrintRouter(theEnv,WERROR," caused the type restrictions"); EnvPrintRouter(theEnv,WERROR,"\nfor argument #"); PrintLongInteger(theEnv,WERROR,(long int) i); EnvPrintRouter(theEnv,WERROR," of the expression "); tmpPtr = lastOne->nextArg; lastOne->nextArg = NULL; PrintExpression(theEnv,WERROR,lastOne); lastOne->nextArg = tmpPtr; EnvPrintRouter(theEnv,WERROR,"\nfound in the rule's RHS to be violated.\n"); rv = TRUE; } /*===========================================*/ /* Free the temporarily created constraints. */ /*===========================================*/ RemoveConstraint(theEnv,constraint1); RemoveConstraint(theEnv,constraint2); RemoveConstraint(theEnv,constraint3); RemoveConstraint(theEnv,constraint4); /*========================================*/ /* Return TRUE if unmatchable constraints */ /* were detected, otherwise FALSE. */ /*========================================*/ return(rv); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips_core_source_630/core/._dffctbin.c0000755000175000017500000000040712373721210016370 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factcmp.h0000755000175000017500000000365112373743676016046 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_factcmp #define _H_factcmp #ifndef _H_pattern #include "pattern.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactPatternsCompilerSetup(void *); LOCALE void FactPatternNodeReference(void *,void *,FILE *,int,int); #endif /* _H_factcmp */ clips_core_source_630/core/._msgfun.h0000755000175000017500000000040712374017656016132 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._proflfun.c0000755000175000017500000000040712375756071016463 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._drive.c0000755000175000017500000000040712500146076015725 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._scanner.c0000755000175000017500000000040712373755546016265 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/proflfun.h0000755000175000017500000001154112373743632016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRUCT PROFILING FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modified OutputProfileInfo to allow a before */ /* and after prefix so that a string buffer does */ /* not need to be created to contain the entire */ /* prefix. This allows a buffer overflow problem */ /* to be corrected. DR0857. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Used gensprintf instead of sprintf. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_proflfun #define _H_proflfun #ifdef LOCALE #undef LOCALE #endif #ifdef _PROFLFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #include "userdata.h" struct constructProfileInfo { struct userData usrData; long numberOfEntries; unsigned int childCall : 1; double startTime; double totalSelfTime; double totalWithChildrenTime; }; struct profileFrameInfo { unsigned int parentCall : 1; unsigned int profileOnExit : 1; double parentStartTime; struct constructProfileInfo *oldProfileFrame; }; #define PROFLFUN_DATA 15 struct profileFunctionData { double ProfileStartTime; double ProfileEndTime; double ProfileTotalTime; int LastProfileInfo; double PercentThreshold; struct userDataRecord ProfileDataInfo; unsigned char ProfileDataID; int ProfileUserFunctions; int ProfileConstructs; struct constructProfileInfo *ActiveProfileFrame; const char *OutputString; }; #define ProfileFunctionData(theEnv) ((struct profileFunctionData *) GetEnvironmentData(theEnv,PROFLFUN_DATA)) LOCALE void ConstructProfilingFunctionDefinitions(void *); LOCALE void ProfileCommand(void *); LOCALE void ProfileInfoCommand(void *); LOCALE void StartProfile(void *, struct profileFrameInfo *, struct userData **, intBool); LOCALE void EndProfile(void *,struct profileFrameInfo *); LOCALE void ProfileResetCommand(void *); LOCALE void ResetProfileInfo(struct constructProfileInfo *); LOCALE double SetProfilePercentThresholdCommand(void *); LOCALE double SetProfilePercentThreshold(void *,double); LOCALE double GetProfilePercentThresholdCommand(void *); LOCALE double GetProfilePercentThreshold(void *); LOCALE intBool Profile(void *,const char *); LOCALE void DeleteProfileData(void *,void *); LOCALE void *CreateProfileData(void *); LOCALE const char *SetProfileOutputString(void *,const char *); #endif /* _H_proflfun */ clips_core_source_630/core/._router.c0000755000175000017500000000040712424475506016144 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insfile.h0000755000175000017500000001174512464554105016051 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_insfile #define _H_insfile #ifndef _H_expressn #include "expressn.h" #endif #define INSTANCE_FILE_DATA 30 #if BLOAD_INSTANCES || BSAVE_INSTANCES struct instanceFileData { const char *InstanceBinaryPrefixID; const char *InstanceBinaryVersionID; unsigned long BinaryInstanceFileSize; #if BLOAD_INSTANCES unsigned long BinaryInstanceFileOffset; char *CurrentReadBuffer; unsigned long CurrentReadBufferSize; unsigned long CurrentReadBufferOffset; #endif }; #define InstanceFileData(theEnv) ((struct instanceFileData *) GetEnvironmentData(theEnv,INSTANCE_FILE_DATA)) #endif /* BLOAD_INSTANCES || BSAVE_INSTANCES */ #ifdef LOCALE #undef LOCALE #endif #ifdef _INSFILE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupInstanceFileCommands(void *); LOCALE long SaveInstancesCommand(void *); LOCALE long LoadInstancesCommand(void *); LOCALE long RestoreInstancesCommand(void *); LOCALE long EnvSaveInstancesDriver(void *,const char *,int,EXPRESSION *,intBool); LOCALE long EnvSaveInstances(void *,const char *,int); #if BSAVE_INSTANCES LOCALE long BinarySaveInstancesCommand(void *); LOCALE long EnvBinarySaveInstancesDriver(void *,const char *,int,EXPRESSION *,intBool); LOCALE long EnvBinarySaveInstances(void *,const char *,int); #endif #if BLOAD_INSTANCES LOCALE long BinaryLoadInstancesCommand(void *); LOCALE long EnvBinaryLoadInstances(void *,const char *); #endif LOCALE long EnvLoadInstances(void *,const char *); LOCALE long EnvLoadInstancesFromString(void *,const char *,int); LOCALE long EnvRestoreInstances(void *,const char *); LOCALE long EnvRestoreInstancesFromString(void *,const char *,int); #if ALLOW_ENVIRONMENT_GLOBALS #if BLOAD_INSTANCES LOCALE long BinaryLoadInstances(const char *); #endif #if BSAVE_INSTANCES LOCALE long BinarySaveInstances(const char *,int); #endif LOCALE long LoadInstances(const char *); LOCALE long LoadInstancesFromString(const char *,int); LOCALE long RestoreInstances(const char *); LOCALE long RestoreInstancesFromString(const char *,int); LOCALE long SaveInstances(const char *,int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_insfile */ clips_core_source_630/core/objrtmch.c0000755000175000017500000016406512374023161016220 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* OBJECT PATTERN MATCHER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: RETE Network Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Modified the QueueObjectMatchAction function */ /* so that instance retract actions always occur */ /* before instance assert and modify actions. */ /* This prevents the pattern matching process */ /* from attempting the evaluation of a join */ /* expression that accesses the slots of a */ /* retracted instance. */ /* */ /* Added support for hashed alpha memories. */ /* */ /* Support for long long integers. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #include "classfun.h" #include "memalloc.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "lgcldpnd.h" #include "multifld.h" #if (! RUN_TIME) && (! BLOAD_ONLY) #include "incrrset.h" #endif #include "reteutil.h" #include "ruledlt.h" #include "reorder.h" #include "retract.h" #include "router.h" #include "objrtfnx.h" #define _OBJRTMCH_SOURCE_ #include "objrtmch.h" #include "insmngr.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void QueueObjectMatchAction(void *,int,INSTANCE_TYPE *,int); static SLOT_BITMAP *QueueModifySlotMap(void *,SLOT_BITMAP *,int); static void ReturnObjectMatchAction(void *,OBJECT_MATCH_ACTION *); static void ProcessObjectMatchQueue(void *); static void MarkObjectPatternNetwork(void *,SLOT_BITMAP *); static intBool CompareSlotBitMaps(SLOT_BITMAP *,SLOT_BITMAP *); static void ObjectPatternMatch(void *,int,OBJECT_PATTERN_NODE *,struct multifieldMarker *); static void ProcessPatternNode(void *,int,OBJECT_PATTERN_NODE *,struct multifieldMarker *); static void CreateObjectAlphaMatch(void *,OBJECT_ALPHA_NODE *); static intBool EvaluateObjectPatternTest(void *,int,struct multifieldMarker *,EXPRESSION *, OBJECT_PATTERN_NODE *); static void ObjectAssertAction(void *,INSTANCE_TYPE *); static void ObjectModifyAction(void *,INSTANCE_TYPE *,SLOT_BITMAP *); static void ObjectRetractAction(void *,INSTANCE_TYPE *,SLOT_BITMAP *); static void ObjectPatternNetErrorMessage(void *,OBJECT_PATTERN_NODE *); static void TraceErrorToObjectPattern(void *,int,OBJECT_PATTERN_NODE *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************** NAME : ObjectMatchDelay DESCRIPTION : H/L interface for SetDelayObjectPatternMatching INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : DelayObjectPatternMatching set and Rete network updates delayed until pattern-matching is completed NOTES : H/L Syntax: (object-pattern-match-delay *) ***************************************************************************/ globle void ObjectMatchDelay( void *theEnv, DATA_OBJECT *result) { register int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); EvaluateExpression(theEnv,GetFirstArgument(),result); if (EvaluationData(theEnv)->EvaluationError) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); SetDelayObjectPatternMatching(theEnv,ov); SetEvaluationError(theEnv,TRUE); } else SetDelayObjectPatternMatching(theEnv,ov); } /*************************************************** NAME : SetDelayObjectPatternMatching DESCRIPTION : Sets the flag determining if Rete network activity is to be delayed for objects or not INPUTS : The value of the flag RETURNS : The old value of the flag SIDE EFFECTS : DelayObjectPatternMatching set NOTES : When the delay is set to FALSE, all pending Rete network updates are performed ***************************************************/ globle intBool SetDelayObjectPatternMatching( void *theEnv, int value) { intBool oldval; oldval = ObjectReteData(theEnv)->DelayObjectPatternMatching; if (value) ObjectReteData(theEnv)->DelayObjectPatternMatching = TRUE; else { ObjectReteData(theEnv)->DelayObjectPatternMatching = FALSE; ObjectNetworkAction(theEnv,0,NULL,-1); } return(oldval); } /*************************************************** NAME : GetDelayObjectPatternMatching DESCRIPTION : Gets the flag determining if Rete network activity is to be delayed for objects or not INPUTS : None RETURNS : The flag SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool GetDelayObjectPatternMatching( void *theEnv) { return(ObjectReteData(theEnv)->DelayObjectPatternMatching); } /******************************************************** NAME : ObjectNetworkPointer DESCRIPTION : Returns the first object network pattern node INPUTS : None RETURNS : The top of the object pattern network SIDE EFFECTS : None NOTES : None ********************************************************/ globle OBJECT_PATTERN_NODE *ObjectNetworkPointer( void *theEnv) { return(ObjectReteData(theEnv)->ObjectPatternNetworkPointer); } /******************************************************** NAME : ObjectNetworkTerminalPointer DESCRIPTION : Returns the first terminal pattern node INPUTS : None RETURNS : The last node of a pattern SIDE EFFECTS : None NOTES : None ********************************************************/ globle OBJECT_ALPHA_NODE *ObjectNetworkTerminalPointer( void *theEnv) { return(ObjectReteData(theEnv)->ObjectPatternNetworkTerminalPointer); } /*************************************************** NAME : SetObjectNetworkPointer DESCRIPTION : Sets the object pattern network to the given network INPUTS : Top of the new pattern network RETURNS : Nothing useful SIDE EFFECTS : ObjectPatternNetworkPointer set NOTES : None ***************************************************/ globle void SetObjectNetworkPointer( void *theEnv, OBJECT_PATTERN_NODE *value) { ObjectReteData(theEnv)->ObjectPatternNetworkPointer = value; } /******************************************************* NAME : SetObjectNetworkTerminalPointer DESCRIPTION : Sets the global list of terminal pattern nodes (the ones containing the bitmaps) to the given node INPUTS : The last node of a pattern RETURNS : Nothing useful SIDE EFFECTS : ObjectPatternNetworkTerminalPointer set NOTES : None *******************************************************/ globle void SetObjectNetworkTerminalPointer( void *theEnv, OBJECT_ALPHA_NODE *value) { ObjectReteData(theEnv)->ObjectPatternNetworkTerminalPointer = value; } /************************************************************************ NAME : ObjectNetworkAction DESCRIPTION : Main driver for pattern-matching on objects If the pattern-matching is current delayed or another object is currently being pattern-matched, the requested match action is queued for later processing. Otherwise, the match action is performed and the Rete network is updated. INPUTS : 1) The match action type OBJECT_ASSERT (1) OBJECT_RETRACT (2) OBJECT_MODIFY (3) 2) The instance to be matched (can be NULL if only want pending actions to be performed) 3) The name id of the slot being updated (can be -1) If this argument is -1, it is assumed that any pattern which could match this instance must be checked. Otherwise, only the patterns which explicitly match on the named slot will be checked. RETURNS : Nothing useful SIDE EFFECTS : Action queued or Rete network updated NOTES : None ************************************************************************/ globle void ObjectNetworkAction( void *theEnv, int type, INSTANCE_TYPE *ins, int slotNameID) { SLOT_BITMAP *tmpMap; if (EngineData(theEnv)->JoinOperationInProgress) return; EngineData(theEnv)->JoinOperationInProgress = TRUE; /* ================================================ For purposes of conflict resolution, all objects which have had pattern-matching delayed will have the same relative timestamp, i.e., the inference engine thinks they all just appeared simultaneously When delay is off, however, each object gets the new and current timestamp as expected. ================================================ */ ObjectReteData(theEnv)->UseEntityTimeTag = DefruleData(theEnv)->CurrentEntityTimeTag++; /* ================================================== If pattern-matching is delayed (by use of the set-object-pattern-match-delay function), then the instance should be marked for later processing (when the delay is turned off). ================================================== */ if (ins != NULL) { /* 6.05 Bug Fix */ ins->reteSynchronized = FALSE; if (ObjectReteData(theEnv)->DelayObjectPatternMatching == FALSE) switch (type) { case OBJECT_ASSERT : ObjectAssertAction(theEnv,ins); break; case OBJECT_RETRACT : ObjectRetractAction(theEnv,ins,NULL); break; default : tmpMap = QueueModifySlotMap(theEnv,NULL,slotNameID); ObjectModifyAction(theEnv,ins,tmpMap); rm(theEnv,(void *) tmpMap,SlotBitMapSize(tmpMap)); } else QueueObjectMatchAction(theEnv,type,ins,slotNameID); } /* ======================================== Process all pending actions in the queue All updates will use the same timestamp ======================================== */ ProcessObjectMatchQueue(theEnv); EngineData(theEnv)->JoinOperationInProgress = FALSE; ForceLogicalRetractions(theEnv); /*=========================================*/ /* Free partial matches that were released */ /* by the assertion of the fact. */ /*=========================================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ResetObjectMatchTimeTags DESCRIPTION : If CurrentObjectMatchTimeTag + 1 would cause an overflow, CurrentObjectMatchTimeTag is reset to 0L and all time tags in object pattern nodes are reset. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : CurrentObjectMatchTimeTag reset to 0, and all match time tags reset These tags are used to recognize valid pattern nodes on a match NOTES : None ***************************************************/ globle void ResetObjectMatchTimeTags( void *theEnv) { OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *lastLevel; /* ============================================ If the current tag incremented by one would not cause an overflow, then we can leave things alone. ============================================ */ if ((ObjectReteData(theEnv)->CurrentObjectMatchTimeTag + 1L) > ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) return; ObjectReteData(theEnv)->CurrentObjectMatchTimeTag = 0L; alphaPtr = ObjectNetworkTerminalPointer(theEnv); while (alphaPtr != NULL) { alphaPtr->matchTimeTag = 0L; lastLevel = alphaPtr->patternNode; while (lastLevel != NULL) { if (lastLevel->matchTimeTag == 0L) break; lastLevel->matchTimeTag = 0L; lastLevel = lastLevel->lastLevel; } alphaPtr = alphaPtr->nxtTerminal; } } /*************************************************** NAME : QueueObjectMatchAction DESCRIPTION : Posts a Rete network match event for later processing INPUTS : 1) The match action type OBJECT_ASSERT (1) OBJECT_RETRACT (2) OBJECT_MODIFY (3) 2) The instance to be matched 3) The name id of the slot being updated (can be -1) RETURNS : Nothing useful SIDE EFFECTS : Queue updated NOTES : None ***************************************************/ static void QueueObjectMatchAction( void *theEnv, int type, INSTANCE_TYPE *ins, int slotNameID) { OBJECT_MATCH_ACTION *prv,*cur,*newMatch; OBJECT_MATCH_ACTION *prvRetract = NULL; /* DR0873 */ prv = NULL; cur = ObjectReteData(theEnv)->ObjectMatchActionQueue; while (cur != NULL) { /* =========================================================== Here are the possibilities for the first Rete event already on the queue as compared with the new event for an object: Assert/Retract --> Delete assert event Ignore retract event Assert/Modify --> Ignore modify event Modify/Modify --> Merge new modify event Modify/Retract --> Delete modify event Queue the retract event =========================================================== */ if (cur->ins == ins) { /* =================================================== An action for initially asserting the newly created object to all applicable patterns =================================================== */ if (cur->type == OBJECT_ASSERT) { if (type == OBJECT_RETRACT) { /* =================================================== If we are retracting the entire object, then we can remove the assert action (and all modifies as well) and ignore the retract action (basically the object came and went before the Rete network had a chance to see it) =================================================== */ if (prv == NULL) ObjectReteData(theEnv)->ObjectMatchActionQueue = cur->nxt; else prv->nxt = cur->nxt; cur->ins->busy--; ReturnObjectMatchAction(theEnv,cur); } /* ================================================= If this is a modify action, then we can ignore it since the assert action will encompass it ================================================= */ } /* =================================================== If the object is being deleted after a slot modify, drop the modify event and replace with the retract =================================================== */ else if (type == OBJECT_RETRACT) { cur->type = OBJECT_RETRACT; if (cur->slotNameIDs != NULL) { rm(theEnv,(void *) cur->slotNameIDs,SlotBitMapSize(cur->slotNameIDs)); cur->slotNameIDs = NULL; } } /* ==================================================== If a modify event for this slot is already on the queue, ignore this one. Otherwise, merge the slot id ==================================================== */ else cur->slotNameIDs = QueueModifySlotMap(theEnv,cur->slotNameIDs,slotNameID); return; } if (cur->type == OBJECT_RETRACT) /* DR0873 */ { prvRetract = cur; } /* DR0873 */ prv = cur; cur = cur->nxt; } /* ================================================ If there are no actions for the instance already on the queue, the new action is simply appended. ================================================ */ newMatch = get_struct(theEnv,objectMatchAction); newMatch->type = type; newMatch->nxt = NULL; /* If we get here, cur should be NULL */ newMatch->slotNameIDs = (type != OBJECT_MODIFY) ? NULL : QueueModifySlotMap(theEnv,NULL,slotNameID); newMatch->ins = ins; newMatch->ins->busy++; /* DR0873 Begin */ /* Retract operations must be processed before assert and */ /* modify actions, otherwise the pattern matching process */ /* might attempt to access the slots of a retract instance. */ if (type == OBJECT_RETRACT) { if (prvRetract == NULL) { newMatch->nxt = ObjectReteData(theEnv)->ObjectMatchActionQueue; ObjectReteData(theEnv)->ObjectMatchActionQueue = newMatch; } else { newMatch->nxt = prvRetract->nxt; prvRetract->nxt = newMatch; } } else /* DR0873 End */ if (prv == NULL) ObjectReteData(theEnv)->ObjectMatchActionQueue = newMatch; else prv->nxt = newMatch; } /**************************************************** NAME : QueueModifySlotMap DESCRIPTION : Sets the bitmap for a queued object modify Rete network action INPUTS : 1) The old bitmap (can be NULL) 2) The canonical slot id to set RETURNS : The (new) bitmap SIDE EFFECTS : Bitmap allocated/reallocated if necessary, and slot id bit set NOTES : If the bitmap must be (re)allocated, this routine allocates twice the room necessary for the current id to allow for growth. ****************************************************/ static SLOT_BITMAP *QueueModifySlotMap( void *theEnv, SLOT_BITMAP *oldMap, int slotNameID) { SLOT_BITMAP *newMap; unsigned short newmaxid; unsigned oldsz,newsz; if ((oldMap == NULL) ? TRUE : (slotNameID > oldMap->maxid)) { newmaxid = (unsigned short) (slotNameID * 2); newsz = sizeof(SLOT_BITMAP) + (sizeof(char) * (newmaxid / BITS_PER_BYTE)); newMap = (SLOT_BITMAP *) gm2(theEnv,newsz); ClearBitString((void *) newMap,newsz); if (oldMap != NULL) { oldsz = SlotBitMapSize(oldMap); GenCopyMemory(char,oldsz,newMap,oldMap); rm(theEnv,(void *) oldMap,oldsz); } newMap->maxid = newmaxid; } else newMap = oldMap; SetBitMap(newMap->map,slotNameID); return(newMap); } /*************************************************** NAME : ReturnObjectMatchAction DESCRIPTION : Deallocates and object match action structure and associated slot bitmap (if any) INPUTS : The queued match action item RETURNS : Nothing useful SIDE EFFECTS : Object match action item deleted NOTES : None ***************************************************/ static void ReturnObjectMatchAction( void *theEnv, OBJECT_MATCH_ACTION *omaPtr) { if (omaPtr->slotNameIDs != NULL) rm(theEnv,(void *) omaPtr->slotNameIDs,SlotBitMapSize(omaPtr->slotNameIDs)); rtn_struct(theEnv,objectMatchAction,omaPtr); } /*************************************************** NAME : ProcessObjectMatchQueue DESCRIPTION : Processes all outstanding object Rete network update events INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pattern-matching on objects NOTES : None ***************************************************/ static void ProcessObjectMatchQueue( void *theEnv) { OBJECT_MATCH_ACTION *cur; while ((ObjectReteData(theEnv)->ObjectMatchActionQueue != NULL) && (ObjectReteData(theEnv)->DelayObjectPatternMatching == FALSE)) { cur = ObjectReteData(theEnv)->ObjectMatchActionQueue; ObjectReteData(theEnv)->ObjectMatchActionQueue = cur->nxt; switch(cur->type) { case OBJECT_ASSERT : ObjectAssertAction(theEnv,cur->ins); break; case OBJECT_RETRACT : ObjectRetractAction(theEnv,cur->ins,cur->slotNameIDs); break; default : ObjectModifyAction(theEnv,cur->ins,cur->slotNameIDs); } cur->ins->busy--; ReturnObjectMatchAction(theEnv,cur); } } /****************************************************** NAME : MarkObjectPatternNetwork DESCRIPTION : Iterates through all terminal pattern nodes checking class and slot bitmaps. If a pattern is applicable to the object/slot change, then all the nodes belonging to the pattern are marked as needing to be examined by the pattern matcher. INPUTS : The bitmap of ids of the slots being changed (NULL if this is an assert for the for the entire object) RETURNS : Nothing useful SIDE EFFECTS : Applicable pattern nodes marked NOTES : Incremental reset status is also checked here ******************************************************/ static void MarkObjectPatternNetwork( void *theEnv, SLOT_BITMAP *slotNameIDs) { OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *upper; CLASS_BITMAP *clsset; unsigned id; ResetObjectMatchTimeTags(theEnv); ObjectReteData(theEnv)->CurrentObjectMatchTimeTag++; alphaPtr = ObjectNetworkTerminalPointer(theEnv); id = ObjectReteData(theEnv)->CurrentPatternObject->cls->id; while (alphaPtr != NULL) { /* ============================================================= If an incremental reset is in progress, make sure that the pattern has been marked for initialization before proceeding. ============================================================= */ #if (! RUN_TIME) && (! BLOAD_ONLY) if (EngineData(theEnv)->IncrementalResetInProgress && (alphaPtr->header.initialize == FALSE)) { alphaPtr = alphaPtr->nxtTerminal; continue; } #endif /* ============================================ Check the class bitmap to see if the pattern pattern is applicable to the object at all ============================================ */ clsset = (CLASS_BITMAP *) ValueToBitMap(alphaPtr->classbmp); if ((id > (unsigned) clsset->maxid) ? FALSE : TestBitMap(clsset->map,id)) { /* =================================================== If we are doing an assert, then we need to check all patterns which satsify the class bitmap (The retraction has already been done in this case) =================================================== */ if (slotNameIDs == NULL) { alphaPtr->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; for (upper = alphaPtr->patternNode ; upper != NULL ; upper = upper->lastLevel) { if (upper->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) break; else upper->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; } } /* =================================================== If we are doing a slot modify, then we need to check only the subset of patterns which satisfy the class bitmap AND actually match on the slot in question. =================================================== */ else if (alphaPtr->slotbmp != NULL) { if (CompareSlotBitMaps(slotNameIDs, (SLOT_BITMAP *) ValueToBitMap(alphaPtr->slotbmp))) { alphaPtr->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; for (upper = alphaPtr->patternNode ; upper != NULL ; upper = upper->lastLevel) { if (upper->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) break; else upper->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; } } } } alphaPtr = alphaPtr->nxtTerminal; } } /*************************************************** NAME : CompareSlotBitMaps DESCRIPTION : Compares two slot bitmaps by bitwising and'ing byte per byte up to the length of the smaller map. INPUTS : The two slot bitmaps RETURNS : TRUE if any common bits are set in both maps, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ static intBool CompareSlotBitMaps( SLOT_BITMAP *smap1, SLOT_BITMAP *smap2) { unsigned short i,maxByte; maxByte = (unsigned short) (((smap1->maxid < smap2->maxid) ? smap1->maxid : smap2->maxid) / BITS_PER_BYTE); for (i = 0 ; i <= maxByte ; i++) if (smap1->map[i] & smap2->map[i]) return(TRUE); return(FALSE); } /********************************************************************************** NAME : ObjectPatternMatch DESCRIPTION : Iterates through all the pattern nodes on one level in the pattern network. A node is only processed if it can lead to a terminating class bitmap node which applies to the object being matched. This allows for a significant reduction in the number of patterns considered. INPUTS : 1) The offset of the slot position from the pattern index 2) The pattern node being examined 3) The end of the list of multifield markers for the pattern RETURNS : Nothing useful SIDE EFFECTS : The pattern tests are evaluated and the child nodes may be processed (which may cause a whole series of Rete network updates). NOTES : Several globals are used to keep track of the current slot being examined: CurrentPatternMarks - the series of multifield markers CurrentPatternObject - the object being pattern-matched CurrentPatternObjectSlot - the current slot being examined CurrentObjectSlotLength - the cardinality of the slot value An optimization is performed when evaluating constant tests on a slot value field. All pattern nodes on a level which restrict the same slot are grouped together. Those which are constant tests are placed at the far right. Thus, as soon as one of these constant tests succeeds, the remaining nodes for that slot on this level can be skipped **********************************************************************************/ static void ObjectPatternMatch( void *theEnv, int offset, OBJECT_PATTERN_NODE *patternTop, struct multifieldMarker *endMark) { register unsigned saveSlotLength; register INSTANCE_SLOT *saveSlot; OBJECT_PATTERN_NODE *blockedNode; while (patternTop != NULL) { /*=============================================================*/ /* MarkObjectPatternNetwork() has already marked pattern nodes */ /* which need processing according to the class bitmaps, slot */ /* updates and incremental reset status. */ /*=============================================================*/ if (patternTop->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) { /*===========================================*/ /* Make sure we are examining the correct */ /* slot of the object for this pattern node. */ /*===========================================*/ if ((patternTop->slotNameID == ISA_ID) || (patternTop->slotNameID == NAME_ID)) { ObjectReteData(theEnv)->CurrentPatternObjectSlot = NULL; ObjectReteData(theEnv)->CurrentObjectSlotLength = 1; offset = 0; } else if ((ObjectReteData(theEnv)->CurrentPatternObjectSlot == NULL) ? TRUE : (ObjectReteData(theEnv)->CurrentPatternObjectSlot->desc->slotName->id != patternTop->slotNameID)) { /*=======================================================*/ /* Need to reset the indices for the multifield */ /* markers now that we have moved onto a different slot. */ /*=======================================================*/ ObjectReteData(theEnv)->CurrentPatternObjectSlot = ObjectReteData(theEnv)->CurrentPatternObject->slotAddresses[ObjectReteData(theEnv)->CurrentPatternObject->cls->slotNameMap [patternTop->slotNameID] - 1]; offset = 0; if (ObjectReteData(theEnv)->CurrentPatternObjectSlot->desc->multiple) ObjectReteData(theEnv)->CurrentObjectSlotLength = GetInstanceSlotLength(ObjectReteData(theEnv)->CurrentPatternObjectSlot); else ObjectReteData(theEnv)->CurrentObjectSlotLength = 1; } /*==========================================================*/ /* Process the pattern node. If it is satisfied by the */ /* the instance, ProcessPatternNode() will recursively pass */ /* all of its children nodes through ObjectPatternMatch(). */ /*==========================================================*/ saveSlotLength = ObjectReteData(theEnv)->CurrentObjectSlotLength; saveSlot = ObjectReteData(theEnv)->CurrentPatternObjectSlot; ProcessPatternNode(theEnv,offset,patternTop,endMark); ObjectReteData(theEnv)->CurrentObjectSlotLength = saveSlotLength; ObjectReteData(theEnv)->CurrentPatternObjectSlot = saveSlot; } /*============================================================*/ /* Move on to the siblings of this node - if the current node */ /* was a constant test that succeeded, skip further sibling */ /* nodes (which test on the same field in the pattern) which */ /* match on the same slot since they are all constant tests */ /* as well and will, of course fail. */ /*============================================================*/ if (patternTop->blocked == TRUE) { patternTop->blocked = FALSE; blockedNode = patternTop; patternTop = patternTop->rightNode; while (patternTop != NULL) { if ((patternTop->slotNameID != blockedNode->slotNameID) || (patternTop->whichField != blockedNode->whichField)) break; patternTop = patternTop->rightNode; } } else patternTop = patternTop->rightNode; } } /********************************************************************************** NAME : ProcessPatternNode DESCRIPTION : Determines if a pattern node satsifies the corresponding slot value field(s) in an object. If it does, ObjectPatternMatch() is recursively called to process the child nodes of this node. In this mutual recursion between ObjectPatternMatch() and ProcessPatternNode(), the nodes of all applicable patterns are processed to completion. ObjectPatternMatch() enters an object into a pattern's aplha memory when the traversal reaches a terminal class bitmap node. INPUTS : 1) The offset of the slot index from the pattern index 2) The pattern node being examined 3) The end of the list of multifield markers for the pattern RETURNS : Nothing useful SIDE EFFECTS : The pattern tests are evaluated and the child nodes may be processed (which may cause a whole series of Rete network updates). NOTES : Several globals are used to keep track of the current slot being examined: CurrentPatternMarks - the series of multifield markers CurrentPatternObject - the object being pattern-matched CurrentPatternObjectSlot - the current slot being examined CurrentObjectSlotLength - the cardinality of the slot value **********************************************************************************/ static void ProcessPatternNode( void *theEnv, int offset, OBJECT_PATTERN_NODE *patternNode, struct multifieldMarker *endMark) { int patternSlotField,objectSlotField; unsigned objectSlotLength; int repeatCount; INSTANCE_SLOT *objectSlot; struct multifieldMarker *newMark; DATA_OBJECT theResult; OBJECT_PATTERN_NODE *tempPtr; patternSlotField = patternNode->whichField; objectSlotField = patternSlotField + offset; /*============================================*/ /* If this is a test on the class or the name */ /* of the object, process it separately. */ /*============================================*/ if (ObjectReteData(theEnv)->CurrentPatternObjectSlot == NULL) { if (patternNode->selector) /* TBD Necessary? */ { if (EvaluateObjectPatternTest(theEnv,objectSlotField,NULL,patternNode->networkTest->nextArg,patternNode)) { EvaluateExpression(theEnv,patternNode->networkTest,&theResult); tempPtr = (OBJECT_PATTERN_NODE *) FindHashedPatternNode(theEnv,patternNode,theResult.type,theResult.value); if (tempPtr != NULL) { if (tempPtr->alphaNode != NULL) { CreateObjectAlphaMatch(theEnv,tempPtr->alphaNode); } ObjectPatternMatch(theEnv,offset,tempPtr->nextLevel,endMark); } } } else if ((patternNode->networkTest == NULL) ? TRUE : (EvaluateObjectPatternTest(theEnv,objectSlotField,NULL, (EXPRESSION *) patternNode->networkTest,patternNode))) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,offset,patternNode->nextLevel,endMark); } return; } /*===================================*/ /* Check a single-field restriction. */ /*===================================*/ if (patternNode->multifieldNode == 0) { if (patternNode->selector) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,NULL,patternNode->networkTest->nextArg,patternNode)) { EvaluateExpression(theEnv,patternNode->networkTest,&theResult); tempPtr = (OBJECT_PATTERN_NODE *) FindHashedPatternNode(theEnv,patternNode,theResult.type,theResult.value); if (tempPtr != NULL) { if (tempPtr->alphaNode != NULL) { CreateObjectAlphaMatch(theEnv,tempPtr->alphaNode); } ObjectPatternMatch(theEnv,offset,tempPtr->nextLevel,endMark); } } } else if ((patternNode->networkTest == NULL) ? TRUE : EvaluateObjectPatternTest(theEnv,objectSlotField,NULL, (EXPRESSION *) patternNode->networkTest,patternNode)) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,offset,patternNode->nextLevel,endMark); } return; } /*==============================================================*/ /* Check a multifield restriction. Add a marker for this field */ /* which has indices indicating to which values in the object */ /* slot the multifield pattern node is bound. */ /*==============================================================*/ newMark = get_struct(theEnv,multifieldMarker); newMark->whichField = patternSlotField; newMark->where.whichSlot = (void *) ObjectReteData(theEnv)->CurrentPatternObjectSlot->desc->slotName->name; newMark->startPosition = objectSlotField; newMark->next = NULL; if (ObjectReteData(theEnv)->CurrentPatternObjectMarks == NULL) ObjectReteData(theEnv)->CurrentPatternObjectMarks = newMark; else endMark->next = newMark; /*============================================================*/ /* If there are further pattern restrictions on this slot, */ /* try pattern-matching for all possible bound values of the */ /* multifield pattern node: from no values to all values from */ /* the starting position of the multifield to the end of the */ /* object slot. Otherwise, bind the multifield to all the */ /* remaining fields in the slot value and continue with */ /* pattern-matching. */ /*============================================================*/ if (patternNode->endSlot == FALSE) { objectSlotLength = ObjectReteData(theEnv)->CurrentObjectSlotLength; objectSlot = ObjectReteData(theEnv)->CurrentPatternObjectSlot; newMark->endPosition = newMark->startPosition - 1; repeatCount = (int) (objectSlotLength - newMark->startPosition - patternNode->leaveFields + 2); while (repeatCount > 0) { if (patternNode->selector) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,newMark,patternNode->networkTest->nextArg,patternNode)) { EvaluateExpression(theEnv,patternNode->networkTest,&theResult); tempPtr = (OBJECT_PATTERN_NODE *) FindHashedPatternNode(theEnv,patternNode,theResult.type,theResult.value); if (tempPtr != NULL) { if (tempPtr->alphaNode != NULL) { CreateObjectAlphaMatch(theEnv,tempPtr->alphaNode); } ObjectPatternMatch(theEnv,(int) (offset + (newMark->endPosition - objectSlotField)), tempPtr->nextLevel,newMark); ObjectReteData(theEnv)->CurrentObjectSlotLength = objectSlotLength; ObjectReteData(theEnv)->CurrentPatternObjectSlot = objectSlot; } } } else if ((patternNode->networkTest == NULL) ? TRUE : EvaluateObjectPatternTest(theEnv,objectSlotField,newMark, (EXPRESSION *) patternNode->networkTest,patternNode)) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,(int) (offset + (newMark->endPosition - objectSlotField)), patternNode->nextLevel,newMark); ObjectReteData(theEnv)->CurrentObjectSlotLength = objectSlotLength; ObjectReteData(theEnv)->CurrentPatternObjectSlot = objectSlot; } newMark->endPosition++; repeatCount--; } } else { newMark->endPosition = (long) ObjectReteData(theEnv)->CurrentObjectSlotLength - patternNode->leaveFields; // Bug fix: added leaveFields if (patternNode->selector) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,newMark,patternNode->networkTest->nextArg,patternNode)) { EvaluateExpression(theEnv,patternNode->networkTest,&theResult); tempPtr = (OBJECT_PATTERN_NODE *) FindHashedPatternNode(theEnv,patternNode,theResult.type,theResult.value); if (tempPtr != NULL) { if (tempPtr->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,tempPtr->alphaNode); ObjectPatternMatch(theEnv,0,tempPtr->nextLevel,newMark); } } } else if ((patternNode->networkTest == NULL) ? TRUE : EvaluateObjectPatternTest(theEnv,objectSlotField,newMark, (EXPRESSION *) patternNode->networkTest,patternNode)) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,0,patternNode->nextLevel,newMark); } } /*=========================================*/ /* Delete the temporary multifield marker. */ /*=========================================*/ if (ObjectReteData(theEnv)->CurrentPatternObjectMarks == newMark) ObjectReteData(theEnv)->CurrentPatternObjectMarks = NULL; else endMark->next = NULL; rtn_struct(theEnv,multifieldMarker,newMark); } /*************************************************** NAME : CreateObjectAlphaMatch DESCRIPTION : Places an instance in the alpha memory of a pattern and drives the partial match through the join network INPUTS : The alpha memory node RETURNS : Nothing useful SIDE EFFECTS : Join network updated NOTES : None ***************************************************/ static void CreateObjectAlphaMatch( void *theEnv, OBJECT_ALPHA_NODE *alphaPtr) { struct joinNode *listOfJoins; struct partialMatch *theMatch; struct patternMatch *newMatch; unsigned long hashValue; while (alphaPtr != NULL) { if (alphaPtr->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) { hashValue = ComputeRightHashValue(theEnv,&alphaPtr->header); /* =================================================== If we have reached the class bitmap of the pattern, place the object in the alpha memory of each of the terminal nodes underneath and drive the partial matches through the join network. Insert the instance into the alpha memory of this pattern and mark it as busy =================================================== */ ObjectReteData(theEnv)->CurrentPatternObject->busy++; theMatch = CreateAlphaMatch(theEnv,(void *) ObjectReteData(theEnv)->CurrentPatternObject, ObjectReteData(theEnv)->CurrentPatternObjectMarks, (struct patternNodeHeader *) alphaPtr,hashValue); theMatch->owner = alphaPtr; /* ====================================== Attach the partial match to the object to ease later retraction ====================================== */ newMatch = get_struct(theEnv,patternMatch); newMatch->next = (struct patternMatch *) ObjectReteData(theEnv)->CurrentPatternObject->partialMatchList; newMatch->matchingPattern = (struct patternNodeHeader *) alphaPtr; newMatch->theMatch = theMatch; ObjectReteData(theEnv)->CurrentPatternObject->partialMatchList = (void *) newMatch; /* ================================================ Drive the partial match through the join network ================================================ */ listOfJoins = alphaPtr->header.entryJoin; while (listOfJoins != NULL) { NetworkAssert(theEnv,theMatch,listOfJoins); listOfJoins = listOfJoins->rightMatchNode; } } alphaPtr = alphaPtr->nxtInGroup; } } /****************************************************** NAME : EvaluateObjectPatternTest DESCRIPTION : Evaluates the pattern network test expression for a node INPUTS : 1) The actual index of the slot value field currently being examined 2) The multifield marker (if any) for the pattern node being exmained 3) The pattern network test expression 4) The pattern node being examined RETURNS : TRUE if the node passes the test, FALSE otherwise SIDE EFFECTS : Evaluation of the test EvaluationError and HaltExecution are always set to FALSE NOTES : Assumes networkTest != NULL ******************************************************/ static intBool EvaluateObjectPatternTest( void *theEnv, int objectSlotField, struct multifieldMarker *selfSlotMarker, EXPRESSION *networkTest, OBJECT_PATTERN_NODE *patternNode) { DATA_OBJECT vresult; int rv; if (networkTest == NULL) return(TRUE); if (networkTest->type == OBJ_PN_CONSTANT) { struct expr *oldArgument; oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = networkTest; rv = ObjectCmpConstantFunction(theEnv,networkTest->value,&vresult); EvaluationData(theEnv)->CurrentExpression = oldArgument; if (rv) { if (((struct ObjectCmpPNConstant *) ValueToBitMap(networkTest->value))->pass) patternNode->blocked = TRUE; return(TRUE); } return(FALSE); } /* ========================================================= Evaluate or expressions expressed in the format: (or ... ) Returns TRUE (1.0) if any of the expression are TRUE, otherwise returns false (0.0). ========================================================= */ if (networkTest->value == ExpressionData(theEnv)->PTR_OR) { networkTest = networkTest->argList; while (networkTest != NULL) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,selfSlotMarker,networkTest,patternNode)) { /* ============================================ A node can be blocked ONLY if there were one positive constant test on that node ============================================ */ patternNode->blocked = FALSE; return(TRUE); } patternNode->blocked = FALSE; networkTest = networkTest->nextArg; } return(FALSE); } /* ========================================================== Evaluate and expressions expressed in the format: (and ... ) Returns false (0.0) if any of the expression are false, otherwise returns TRUE (1.0). ========================================================== */ else if (networkTest->value == ExpressionData(theEnv)->PTR_AND) { networkTest = networkTest->argList; while (networkTest != NULL) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,selfSlotMarker,networkTest,patternNode) == FALSE) { patternNode->blocked = FALSE; return(FALSE); } patternNode->blocked = FALSE; networkTest = networkTest->nextArg; } return(TRUE); } /* ======================================================= Evaluate all other expressions using EvaluateExpression ======================================================= */ else { EvaluationData(theEnv)->HaltExecution = FALSE; if (EvaluateExpression(theEnv,networkTest,&vresult)) { ObjectPatternNetErrorMessage(theEnv,patternNode); EvaluationData(theEnv)->EvaluationError = FALSE; EvaluationData(theEnv)->HaltExecution = FALSE; return(FALSE); } if ((vresult.value != EnvFalseSymbol(theEnv)) || (vresult.type != SYMBOL)) return(TRUE); } return(FALSE); } /*************************************************** NAME : ObjectAssertAction DESCRIPTION : Filters an instance through the object pattern network INPUTS : The instance RETURNS : Nothing useful SIDE EFFECTS : Instance matched NOTES : None ***************************************************/ static void ObjectAssertAction( void *theEnv, INSTANCE_TYPE *ins) { ins->header.timeTag = ObjectReteData(theEnv)->UseEntityTimeTag; ObjectReteData(theEnv)->CurrentPatternObject = ins; ObjectReteData(theEnv)->CurrentPatternObjectSlot = NULL; MarkObjectPatternNetwork(theEnv,NULL); ObjectPatternMatch(theEnv,0,ObjectNetworkPointer(theEnv),NULL); ins->reteSynchronized = TRUE; } /********************************************************************** NAME : ObjectModifyAction DESCRIPTION : Removes an instance from patterns (and attached joins) applicable to specified slot(s), and then filters same instance through object pattern network (only against patterns which explicitly match on named slot(s)) INPUTS : 1) The instance 2) The bitmap of slot ids RETURNS : Nothing useful SIDE EFFECTS : Instance retracted/asserted NOTES : None **********************************************************************/ static void ObjectModifyAction( void *theEnv, INSTANCE_TYPE *ins, SLOT_BITMAP *slotNameIDs) { ins->header.timeTag = ObjectReteData(theEnv)->UseEntityTimeTag; ObjectRetractAction(theEnv,ins,slotNameIDs); ObjectReteData(theEnv)->CurrentPatternObject = ins; ObjectReteData(theEnv)->CurrentPatternObjectSlot = NULL; MarkObjectPatternNetwork(theEnv,slotNameIDs); ObjectPatternMatch(theEnv,0,ObjectNetworkPointer(theEnv),NULL); ins->reteSynchronized = TRUE; } /**************************************************** NAME : ObjectRetractAction DESCRIPTION : Retracts the instance from the applicable patterns for the object (if the slotNameID != -1, then the instance is only retracted from the alpha memories of the patterns which actually match on that slot) INPUTS : 1) The instance 2) The slot bitmap for a modify (NULL if the instance is actually being removed) RETURNS : Nothing useful SIDE EFFECTS : Retractions performed NOTES : None ****************************************************/ static void ObjectRetractAction( void *theEnv, INSTANCE_TYPE *ins, SLOT_BITMAP *slotNameIDs) { struct patternMatch *prvMatch,*tmpMatch, *deleteMatch,*lastDeleteMatch; OBJECT_ALPHA_NODE *alphaPtr; void *saveDependents; if (slotNameIDs == NULL) { if (ins->partialMatchList != NULL) { tmpMatch = (struct patternMatch *) ins->partialMatchList; while (tmpMatch != NULL) { ins->busy--; tmpMatch = tmpMatch->next; } NetworkRetract(theEnv,(struct patternMatch *) ins->partialMatchList); ins->partialMatchList = NULL; } } else { deleteMatch = NULL; lastDeleteMatch = NULL; prvMatch = NULL; tmpMatch = (struct patternMatch *) ins->partialMatchList; while (tmpMatch != NULL) { alphaPtr = (OBJECT_ALPHA_NODE *) tmpMatch->matchingPattern; if (alphaPtr->slotbmp != NULL) { if (CompareSlotBitMaps(slotNameIDs, (SLOT_BITMAP *) ValueToBitMap(alphaPtr->slotbmp))) { ins->busy--; if (prvMatch == NULL) ins->partialMatchList = (void *) tmpMatch->next; else prvMatch->next = tmpMatch->next; if (!deleteMatch) deleteMatch = tmpMatch; else lastDeleteMatch->next = tmpMatch; lastDeleteMatch = tmpMatch; tmpMatch = tmpMatch->next; lastDeleteMatch->next = NULL; } else { prvMatch = tmpMatch; tmpMatch = tmpMatch->next; } } else { prvMatch = tmpMatch; tmpMatch = tmpMatch->next; } } /* ============================================= We need to preserve any logical dependencies of this object and reattach them after doing the retract. Otherwise, the Rete network will believe the object is gone and remove the links from the partial matches upon which this object is logically dependent. ============================================= */ if (deleteMatch != NULL) { saveDependents = ins->header.dependents; ins->header.dependents = NULL; NetworkRetract(theEnv,deleteMatch); ins->header.dependents = saveDependents; } } ins->reteSynchronized = TRUE; } /***************************************************** NAME : ObjectPatternNetErrorMessage DESCRIPTION : Prints out a locational error message when an evaluation error occurs during object pattern-matching INPUTS : The pattern node RETURNS : Nothing useful SIDE EFFECTS : Error message displayed NOTES : None *****************************************************/ static void ObjectPatternNetErrorMessage( void *theEnv, OBJECT_PATTERN_NODE *patternPtr) { PrintErrorID(theEnv,"OBJRTMCH",1,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred in the object pattern network\n"); EnvPrintRouter(theEnv,WERROR," Currently active instance: ["); EnvPrintRouter(theEnv,WERROR,ValueToString(ObjectReteData(theEnv)->CurrentPatternObject->name)); EnvPrintRouter(theEnv,WERROR,"]\n"); EnvPrintRouter(theEnv,WERROR," Problem resides in slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(FindIDSlotName(theEnv,patternPtr->slotNameID))); EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long long) patternPtr->whichField); EnvPrintRouter(theEnv,WERROR,"\n"); TraceErrorToObjectPattern(theEnv,TRUE,patternPtr); EnvPrintRouter(theEnv,WERROR,"\n"); } /********************************************************* NAME : TraceErrorToObjectPattern DESCRIPTION : Used by ObjectPatternNetErrorMessage() to print the rule(s) which contain an object pattern. INPUTS : 1) A flag indicating if this is the node in which the error actually occurred or not 2) The pattern node RETURNS : Nothing useful SIDE EFFECTS : Error message displayed NOTES : None *********************************************************/ static void TraceErrorToObjectPattern( void *theEnv, int errorNode, OBJECT_PATTERN_NODE *patternPtr) { struct joinNode *joinPtr; while (patternPtr != NULL) { if (patternPtr->alphaNode != NULL) { joinPtr = patternPtr->alphaNode->header.entryJoin; while (joinPtr != NULL) { TraceErrorToRule(theEnv,joinPtr," "); joinPtr = joinPtr->rightMatchNode; } } TraceErrorToObjectPattern(theEnv,FALSE,patternPtr->nextLevel); if (errorNode) break; patternPtr = patternPtr->rightNode; } } #endif clips_core_source_630/core/._factqpsr.h0000644000175000017500000000040712374022553016443 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._insquery.h0000755000175000017500000000040712373756332016512 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._insmngr.h0000755000175000017500000000040712373756346016315 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insquery.c0000755000175000017500000013073212500141166016256 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Query Functions for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if INSTANCE_SET_QUERIES #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "envrnmnt.h" #include "memalloc.h" #include "exprnpsr.h" #include "insfun.h" #include "insmngr.h" #include "insqypsr.h" #include "prcdrfun.h" #include "router.h" #include "utility.h" #define _INSQUERY_SOURCE_ #include "insquery.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PushQueryCore(void *); static void PopQueryCore(void *); static QUERY_CORE *FindQueryCore(void *,int); static QUERY_CLASS *DetermineQueryClasses(void *,EXPRESSION *,const char *,unsigned *); static QUERY_CLASS *FormChain(void *,const char *,DATA_OBJECT *); static void DeleteQueryClasses(void *,QUERY_CLASS *); static int TestForFirstInChain(void *,QUERY_CLASS *,int); static int TestForFirstInstanceInClass(void *,struct defmodule *,int,DEFCLASS *,QUERY_CLASS *,int); static void TestEntireChain(void *,QUERY_CLASS *,int); static void TestEntireClass(void *,struct defmodule *,int,DEFCLASS *,QUERY_CLASS *,int); static void AddSolution(void *); static void PopQuerySoln(void *); /**************************************************** NAME : SetupQuery DESCRIPTION : Initializes instance query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupQuery( void *theEnv) { AllocateEnvironmentData(theEnv,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL); #if ! RUN_TIME InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING); IncrementSymbolCount(InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); EnvDefineFunction2(theEnv,"(query-instance)",'o', PTIEF GetQueryInstance,"GetQueryInstance",NULL); EnvDefineFunction2(theEnv,"(query-instance-slot)",'u', PTIEF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL); EnvDefineFunction2(theEnv,"any-instancep",'b',PTIEF AnyInstances,"AnyInstances",NULL); AddFunctionParser(theEnv,"any-instancep",ParseQueryNoAction); EnvDefineFunction2(theEnv,"find-instance",'m', PTIEF QueryFindInstance,"QueryFindInstance",NULL); AddFunctionParser(theEnv,"find-instance",ParseQueryNoAction); EnvDefineFunction2(theEnv,"find-all-instances",'m', PTIEF QueryFindAllInstances,"QueryFindAllInstances",NULL); AddFunctionParser(theEnv,"find-all-instances",ParseQueryNoAction); EnvDefineFunction2(theEnv,"do-for-instance",'u', PTIEF QueryDoForInstance,"QueryDoForInstance",NULL); AddFunctionParser(theEnv,"do-for-instance",ParseQueryAction); EnvDefineFunction2(theEnv,"do-for-all-instances",'u', PTIEF QueryDoForAllInstances,"QueryDoForAllInstances",NULL); AddFunctionParser(theEnv,"do-for-all-instances",ParseQueryAction); EnvDefineFunction2(theEnv,"delayed-do-for-all-instances",'u', PTIEF DelayedQueryDoForAllInstances, "DelayedQueryDoForAllInstances",NULL); AddFunctionParser(theEnv,"delayed-do-for-all-instances",ParseQueryAction); #endif } /************************************************************* NAME : GetQueryInstance DESCRIPTION : Internal function for referring to instance array on instance-queries INPUTS : None RETURNS : The name of the specified instance-set member SIDE EFFECTS : None NOTES : H/L Syntax : ((query-instance) ) *************************************************************/ globle void *GetQueryInstance( void *theEnv) { register QUERY_CORE *core; core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument()))); return(GetFullInstanceName(theEnv,core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))])); } /*************************************************************************** NAME : GetQueryInstanceSlot DESCRIPTION : Internal function for referring to slots of instances in instance array on instance-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-instance-slot) ) **************************************************************************/ globle void GetQueryInstanceSlot( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; DATA_OBJECT temp; QUERY_CORE *core; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument()))); ins = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))]; EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"instance-set query"); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } } /* ============================================================================= ============================================================================= Following are the instance query functions : any-instancep : Determines if any instances satisfy the query find-instance : Finds first (set of) instance(s) which satisfies the query and stores it in a multi-field find-all-instances : Finds all (sets of) instances which satisfy the the query and stores them in a multi-field do-for-instance : Executes a given action for the first (set of) instance(s) which satisfy the query do-for-all-instances : Executes an action for all instances which satisfy the query as they are found delayed-do-for-all-instances : Same as above - except that the list of instances which satisfy the query is formed before any actions are executed Instance candidate search algorithm : All permutations of first restriction class instances with other restriction class instances (Rightmost are varied first) All permutations of first restriction class's subclasses' instances with other restriction class instances. And so on... For any one class, instances are examined in the order they were defined Example : (defclass a (is-a standard-user)) (defclass b (is-a standard-user)) (defclass c (is-a standard-user)) (defclass d (is-a a b)) (make-instance a1 of a) (make-instance a2 of a) (make-instance b1 of b) (make-instance b2 of b) (make-instance c1 of c) (make-instance c2 of c) (make-instance d1 of d) (make-instance d2 of d) (any-instancep ((?a a b) (?b c)) ) The permutations (?a ?b) would be examined in the following order : (a1 c1),(a1 c2),(a2 c1),(a2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2), (b1 c1),(b1 c2),(b2 c1),(b2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2) Notice the duplication because d is a subclass of both and a and b. ============================================================================= ============================================================================= */ /****************************************************************************** NAME : AnyInstances DESCRIPTION : Determines if there any existing instances which satisfy the query INPUTS : None RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle intBool AnyInstances( void *theEnv) { QUERY_CLASS *qclasses; unsigned rcnt; int TestResult; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "any-instancep",&rcnt); if (qclasses == NULL) return(FALSE); PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); TestResult = TestForFirstInChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); return(TestResult); } /****************************************************************************** NAME : QueryFindInstance DESCRIPTION : Finds the first set of instances which satisfy the query and stores their names in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindInstance( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt,i; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "find-instance",&rcnt); if (qclasses == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); if (TestForFirstInChain(theEnv,qclasses,0) == TRUE) { result->value = (void *) EnvCreateMultifield(theEnv,rcnt); SetpDOEnd(result,rcnt); for (i = 1 ; i <= rcnt ; i++) { SetMFType(result->value,i,INSTANCE_NAME); SetMFValue(result->value,i,GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->solns[i - 1])); } } else result->value = (void *) EnvCreateMultifield(theEnv,0L); InstanceQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryFindAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindAllInstances( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; register unsigned i,j; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "find-all-instances",&rcnt); if (qclasses == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = NULL; InstanceQueryData(theEnv)->QueryCore->soln_set = NULL; InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt; InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = FALSE; result->value = (void *) EnvCreateMultifield(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_cnt * rcnt); while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++) { SetMFType(result->value,j,INSTANCE_NAME); SetMFValue(result->value,j,GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i])); } result->end = (long) j-2; PopQuerySoln(theEnv); } rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryDoForInstance DESCRIPTION : Finds the first set of instances which satisfy the query and executes a user-action with that set INPUTS : None RETURNS : Caller's result buffer SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). Also the action expression is executed zero or once. Caller's result buffer holds result of user-action NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ globle void QueryDoForInstance( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-instance",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; if (TestForFirstInChain(theEnv,qclasses,0) == TRUE) EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,result); InstanceQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryDoForAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and executes a user-function for each set as it is found INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. Also, the action is executed for every instance set. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ globle void QueryDoForAllInstances( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-all-instances",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; InstanceQueryData(theEnv)->QueryCore->result = result; ValueInstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); TestEntireChain(theEnv,qclasses,0); ValueDeinstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); InstanceQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : DelayedQueryDoForAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and and exceutes a user-action for each set This function differs from QueryDoForAllInstances() in that it forms the complete list of query satisfactions BEFORE executing any actions. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. The action is executed for evry query satisfaction. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void DelayedQueryDoForAllInstances( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; register unsigned i; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "delayed-do-for-all-instances",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = NULL; InstanceQueryData(theEnv)->QueryCore->soln_set = NULL; InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt; InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = FALSE; InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 ; i < rcnt ; i++) InstanceQueryData(theEnv)->QueryCore->solns[i] = InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i]; PopQuerySoln(theEnv); EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,result); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) PopQuerySoln(theEnv); break; } CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : PushQueryCore DESCRIPTION : Pushes the current QueryCore onto stack INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Allocates new stack node and changes QueryCoreStack NOTES : None *******************************************************/ static void PushQueryCore( void *theEnv) { QUERY_STACK *qptr; qptr = get_struct(theEnv,query_stack); qptr->core = InstanceQueryData(theEnv)->QueryCore; qptr->nxt = InstanceQueryData(theEnv)->QueryCoreStack; InstanceQueryData(theEnv)->QueryCoreStack = qptr; } /****************************************************** NAME : PopQueryCore DESCRIPTION : Pops top of QueryCore stack and restores QueryCore to this core INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack node deallocated, QueryCoreStack changed and QueryCore reset NOTES : Assumes stack is not empty ******************************************************/ static void PopQueryCore( void *theEnv) { QUERY_STACK *qptr; InstanceQueryData(theEnv)->QueryCore = InstanceQueryData(theEnv)->QueryCoreStack->core; qptr = InstanceQueryData(theEnv)->QueryCoreStack; InstanceQueryData(theEnv)->QueryCoreStack = InstanceQueryData(theEnv)->QueryCoreStack->nxt; rtn_struct(theEnv,query_stack,qptr); } /*************************************************** NAME : FindQueryCore DESCRIPTION : Looks up a QueryCore Stack Frame Depth 0 is current frame 1 is next deepest, etc. INPUTS : Depth RETURNS : Address of query core stack frame SIDE EFFECTS : None NOTES : None ***************************************************/ static QUERY_CORE *FindQueryCore( void *theEnv, int depth) { QUERY_STACK *qptr; if (depth == 0) return(InstanceQueryData(theEnv)->QueryCore); qptr = InstanceQueryData(theEnv)->QueryCoreStack; while (depth > 1) { qptr = qptr->nxt; depth--; } return(qptr->core); } /********************************************************** NAME : DetermineQueryClasses DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) The parse class expression chain 2) The name of the function being executed 3) Caller's buffer for restriction count (# of separate lists) RETURNS : The query list, or NULL on errors SIDE EFFECTS : Memory allocated for list Busy count incremented for all classes NOTES : Each restriction is linked by nxt pointer, multiple classes in a restriction are linked by the chain pointer. Rcnt caller's buffer is set to reflect the total number of chains Assumes classExp is not NULL and that each restriction chain is terminated with the QUERY_DELIMITER_SYMBOL "(QDS)" **********************************************************/ static QUERY_CLASS *DetermineQueryClasses( void *theEnv, EXPRESSION *classExp, const char *func, unsigned *rcnt) { QUERY_CLASS *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp; int new_list = FALSE; DATA_OBJECT temp; *rcnt = 0; while (classExp != NULL) { if (EvaluateExpression(theEnv,classExp,&temp)) { DeleteQueryClasses(theEnv,clist); return(NULL); } if ((temp.type == SYMBOL) && (temp.value == (void *) InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL)) { new_list = TRUE; (*rcnt)++; } else if ((tmp = FormChain(theEnv,func,&temp)) != NULL) { if (clist == NULL) clist = cnxt = cchain = tmp; else if (new_list == TRUE) { new_list = FALSE; cnxt->nxt = tmp; cnxt = cchain = tmp; } else cchain->chain = tmp; while (cchain->chain != NULL) cchain = cchain->chain; } else { SyntaxErrorMessage(theEnv,"instance-set query class restrictions"); DeleteQueryClasses(theEnv,clist); SetEvaluationError(theEnv,TRUE); return(NULL); } classExp = classExp->nextArg; } return(clist); } /************************************************************* NAME : FormChain DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) Name of calling function for error msgs 2) Data object - must be a symbol or a multifield value containing all symbols The symbols must be names of existing classes RETURNS : The query chain, or NULL on errors SIDE EFFECTS : Memory allocated for chain Busy count incremented for all classes NOTES : None *************************************************************/ static QUERY_CLASS *FormChain( void *theEnv, const char *func, DATA_OBJECT *val) { DEFCLASS *cls; QUERY_CLASS *head,*bot,*tmp; register long i,end; /* 6.04 Bug Fix */ const char *className; struct defmodule *currentModule; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (val->type == DEFCLASS_PTR) { IncrementDefclassBusyCount(theEnv,(void *) val->value); head = get_struct(theEnv,query_class); head->cls = (DEFCLASS *) val->value; if (DefclassInScope(theEnv,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; head->chain = NULL; head->nxt = NULL; return(head); } if (val->type == SYMBOL) { /* =============================================== Allow instance-set query restrictions to have a module specifier as part of the class name, but search imported defclasses too if a module specifier is not given =============================================== */ cls = LookupDefclassByMdlOrScope(theEnv,DOPToString(val)); if (cls == NULL) { ClassExistError(theEnv,func,DOPToString(val)); return(NULL); } IncrementDefclassBusyCount(theEnv,(void *) cls); head = get_struct(theEnv,query_class); head->cls = cls; if (DefclassInScope(theEnv,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; head->chain = NULL; head->nxt = NULL; return(head); } if (val->type == MULTIFIELD) { head = bot = NULL; end = GetpDOEnd(val); for (i = GetpDOBegin(val) ; i <= end ; i++) { if (GetMFType(val->value,i) == SYMBOL) { className = ValueToString(GetMFValue(val->value,i)); cls = LookupDefclassByMdlOrScope(theEnv,className); if (cls == NULL) { ClassExistError(theEnv,func,className); DeleteQueryClasses(theEnv,head); return(NULL); } } else { DeleteQueryClasses(theEnv,head); return(NULL); } IncrementDefclassBusyCount(theEnv,(void *) cls); tmp = get_struct(theEnv,query_class); tmp->cls = cls; if (DefclassInScope(theEnv,tmp->cls,currentModule)) tmp->theModule = currentModule; else tmp->theModule = tmp->cls->header.whichModule->theModule; tmp->chain = NULL; tmp->nxt = NULL; if (head == NULL) head = tmp; else bot->chain = tmp; bot = tmp; } return(head); } return(NULL); } /****************************************************** NAME : DeleteQueryClasses DESCRIPTION : Deletes a query class-list INPUTS : The query list address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated Busy count decremented for all classes NOTES : None ******************************************************/ static void DeleteQueryClasses( void *theEnv, QUERY_CLASS *qlist) { QUERY_CLASS *tmp; while (qlist != NULL) { while (qlist->chain != NULL) { tmp = qlist->chain; qlist->chain = qlist->chain->chain; DecrementDefclassBusyCount(theEnv,(void *) tmp->cls); rtn_struct(theEnv,query_class,tmp); } tmp = qlist; qlist = qlist->nxt; DecrementDefclassBusyCount(theEnv,(void *) tmp->cls); rtn_struct(theEnv,query_class,tmp); } } /************************************************************ NAME : TestForFirstInChain DESCRIPTION : Processes all classes in a restriction chain until success or done INPUTS : 1) The current chain 2) The index of the chain restriction (e.g. the 4th query-variable) RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Sets current restriction class Instance variable values set NOTES : None ************************************************************/ static int TestForFirstInChain( void *theEnv, QUERY_CLASS *qchain, int indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = FALSE; if ((id = GetTraversalID(theEnv)) == -1) return(FALSE); if (TestForFirstInstanceInClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx)) { ReleaseTraversalID(theEnv); return(TRUE); } ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); } /***************************************************************** NAME : TestForFirstInstanceInClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until success or done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Instance variable values set NOTES : None *****************************************************************/ static int TestForFirstInstanceInClass( void *theEnv, struct defmodule *theModule, int id, DEFCLASS *cls, QUERY_CLASS *qchain, int indx) { long i; INSTANCE_TYPE *ins; DATA_OBJECT temp; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; if (TestTraversalID(cls->traversalRecord,id)) return(FALSE); SetTraversalID(cls->traversalRecord,id); if (DefclassInScope(theEnv,cls,theModule) == FALSE) return(FALSE); oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; ins = cls->instanceList; while (ins != NULL) { InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins; if (qchain->nxt != NULL) { ins->busy++; if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE) { ins->busy--; break; } ins->busy--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) break; } else { ins->busy++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp); ins->busy--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) break; } CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); ins = ins->nxtClass; while ((ins != NULL) ? (ins->garbage == 1) : FALSE) ins = ins->nxtClass; } RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); if (ins != NULL) return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) ? FALSE : TRUE); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { if (TestForFirstInstanceInClass(theEnv,theModule,id,cls->directSubclasses.classArray[i], qchain,indx)) return(TRUE); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); } /************************************************************ NAME : TestEntireChain DESCRIPTION : Processes all classes in a restriction chain until done INPUTS : 1) The current chain 2) The index of the chain restriction (i.e. the 4th query-variable) RETURNS : Nothing useful SIDE EFFECTS : Sets current restriction class Query instance variables set Solution sets stored in global list NOTES : None ************************************************************/ static void TestEntireChain( void *theEnv, QUERY_CLASS *qchain, int indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = FALSE; if ((id = GetTraversalID(theEnv)) == -1) return; TestEntireClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx); ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return; } } /***************************************************************** NAME : TestEntireClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireClass( void *theEnv, struct defmodule *theModule, int id, DEFCLASS *cls, QUERY_CLASS *qchain, int indx) { long i; INSTANCE_TYPE *ins; DATA_OBJECT temp; struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; if (TestTraversalID(cls->traversalRecord,id)) return; SetTraversalID(cls->traversalRecord,id); if (DefclassInScope(theEnv,cls,theModule) == FALSE) return; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); newGarbageFrame.priorFrame = oldGarbageFrame; UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; ins = cls->instanceList; while (ins != NULL) { InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins; if (qchain->nxt != NULL) { ins->busy++; TestEntireChain(theEnv,qchain->nxt,indx+1); ins->busy--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) break; } else { ins->busy++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp); ins->busy--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) { if (InstanceQueryData(theEnv)->QueryCore->action != NULL) { ins->busy++; ValueDeinstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,InstanceQueryData(theEnv)->QueryCore->result); ValueInstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); ins->busy--; if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { InstanceQueryData(theEnv)->AbortQuery = TRUE; break; } if (EvaluationData(theEnv)->HaltExecution == TRUE) break; } else AddSolution(theEnv); } } ins = ins->nxtClass; while ((ins != NULL) ? (ins->garbage == 1) : FALSE) ins = ins->nxtClass; CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL); CallPeriodicTasks(theEnv); if (ins != NULL) return; for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { TestEntireClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],qchain,indx); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return; } } /*************************************************************************** NAME : AddSolution DESCRIPTION : Adds the current instance set to a global list of solutions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Global list and count updated NOTES : Solutions are stored as sequential arrays of INSTANCE_TYPE * ***************************************************************************/ static void AddSolution( void *theEnv) { QUERY_SOLN *new_soln; register unsigned i; new_soln = (QUERY_SOLN *) gm2(theEnv,(int) sizeof(QUERY_SOLN)); new_soln->soln = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * (InstanceQueryData(theEnv)->QueryCore->soln_size))); for (i = 0 ; i < InstanceQueryData(theEnv)->QueryCore->soln_size ; i++) new_soln->soln[i] = InstanceQueryData(theEnv)->QueryCore->solns[i]; new_soln->nxt = NULL; if (InstanceQueryData(theEnv)->QueryCore->soln_set == NULL) InstanceQueryData(theEnv)->QueryCore->soln_set = new_soln; else InstanceQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln; InstanceQueryData(theEnv)->QueryCore->soln_bottom = new_soln; InstanceQueryData(theEnv)->QueryCore->soln_cnt++; } /*************************************************** NAME : PopQuerySoln DESCRIPTION : Deallocates the topmost solution set for an instance-set query INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Solution set deallocated NOTES : Assumes QueryCore->soln_set != 0 ***************************************************/ static void PopQuerySoln( void *theEnv) { InstanceQueryData(theEnv)->QueryCore->soln_bottom = InstanceQueryData(theEnv)->QueryCore->soln_set; InstanceQueryData(theEnv)->QueryCore->soln_set = InstanceQueryData(theEnv)->QueryCore->soln_set->nxt; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->soln_bottom->soln, (sizeof(INSTANCE_TYPE *) * InstanceQueryData(theEnv)->QueryCore->soln_size)); rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN)); } #endif clips_core_source_630/core/._factrhs.c0000755000175000017500000000040712464742046016256 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/factqury.h0000644000175000017500000000740512373743674016263 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Added fact-set queries. */ /* */ /* 6.24: Corrected errors when compiling as a C++ file. */ /* DR0868 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed garbage collection algorithm. */ /* */ /* Fixes for run-time use of query functions. */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_factqury #define _H_factqury #if FACT_SET_QUERIES #ifndef _H_factmngr #include "factmngr.h" #endif typedef struct query_template { struct deftemplate *templatePtr; struct query_template *chain, *nxt; } QUERY_TEMPLATE; typedef struct query_soln { struct fact **soln; struct query_soln *nxt; } QUERY_SOLN; typedef struct query_core { struct fact **solns; EXPRESSION *query,*action; QUERY_SOLN *soln_set,*soln_bottom; unsigned soln_size,soln_cnt; DATA_OBJECT *result; } QUERY_CORE; typedef struct query_stack { QUERY_CORE *core; struct query_stack *nxt; } QUERY_STACK; #define FACT_QUERY_DATA 63 struct factQueryData { SYMBOL_HN *QUERY_DELIMETER_SYMBOL; QUERY_CORE *QueryCore; QUERY_STACK *QueryCoreStack; int AbortQuery; }; #define FactQueryData(theEnv) ((struct factQueryData *) GetEnvironmentData(theEnv,FACT_QUERY_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTQURY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define QUERY_DELIMETER_STRING "(QDS)" LOCALE void SetupFactQuery(void *); LOCALE void GetQueryFact(void *,DATA_OBJECT *); LOCALE void GetQueryFactSlot(void *,DATA_OBJECT *); LOCALE intBool AnyFacts(void *); LOCALE void QueryFindFact(void *,DATA_OBJECT *); LOCALE void QueryFindAllFacts(void *,DATA_OBJECT *); LOCALE void QueryDoForFact(void *,DATA_OBJECT *); LOCALE void QueryDoForAllFacts(void *,DATA_OBJECT *); LOCALE void DelayedQueryDoForAllFacts(void *,DATA_OBJECT *); #endif /* FACT_SET_QUERIES */ #endif /* _H_factqury */ clips_core_source_630/core/._tmpltfun.c0000755000175000017500000000040712375756705016505 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrnchk.h0000755000175000017500000000040712375676605016460 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/insfile.c0000755000175000017500000017220112464554105016037 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* INSTANCE LOAD/SAVE (ASCII/BINARY) MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: File load/save routines for instances */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* For save-instances, bsave-instances, and */ /* bload-instances, the class name does not */ /* have to be in scope if the module name is */ /* specified. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "extnfunc.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "inspsr.h" #include "object.h" #include "router.h" #include "strngrtr.h" #include "symblbin.h" #include "sysdep.h" #include "envrnmnt.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "factmngr.h" #endif #define _INSFILE_SOURCE_ #include "insfile.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MAX_BLOCK_SIZE 10240 /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ struct bsaveSlotValue { long slotName; unsigned valueCount; }; struct bsaveSlotValueAtom { unsigned short type; long value; }; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static long InstancesSaveCommandParser(void *,const char *,long (*)(void *,const char *,int, EXPRESSION *,intBool)); static DATA_OBJECT *ProcessSaveClassList(void *,const char *,EXPRESSION *,int,intBool); static void ReturnSaveClassList(void *,DATA_OBJECT *); static long SaveOrMarkInstances(void *,void *,int,DATA_OBJECT *,intBool,intBool, void (*)(void *,void *,INSTANCE_TYPE *)); static long SaveOrMarkInstancesOfClass(void *,void *,struct defmodule *,int,DEFCLASS *, intBool,int,void (*)(void *,void *,INSTANCE_TYPE *)); static void SaveSingleInstanceText(void *,void *,INSTANCE_TYPE *); static void ProcessFileErrorMessage(void *,const char *,const char *); #if BSAVE_INSTANCES static void WriteBinaryHeader(void *,FILE *); static void MarkSingleInstance(void *,void *,INSTANCE_TYPE *); static void MarkNeededAtom(void *,int,void *); static void SaveSingleInstanceBinary(void *,void *,INSTANCE_TYPE *); static void SaveAtomBinary(void *,unsigned short,void *,FILE *); #endif static long LoadOrRestoreInstances(void *,const char *,int,int); #if BLOAD_INSTANCES static intBool VerifyBinaryHeader(void *,const char *); static intBool LoadSingleBinaryInstance(void *); static void BinaryLoadInstanceError(void *,SYMBOL_HN *,DEFCLASS *); static void CreateSlotValue(void *,DATA_OBJECT *,struct bsaveSlotValueAtom *,unsigned long); static void *GetBinaryAtomValue(void *,struct bsaveSlotValueAtom *); static void BufferedRead(void *,void *,unsigned long); static void FreeReadBuffer(void *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupInstanceFileCommands DESCRIPTION : Defines function interfaces for saving instances to files INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions defined to KB NOTES : None ***************************************************/ globle void SetupInstanceFileCommands( void *theEnv) { #if BLOAD_INSTANCES || BSAVE_INSTANCES AllocateEnvironmentData(theEnv,INSTANCE_FILE_DATA,sizeof(struct instanceFileData),NULL); InstanceFileData(theEnv)->InstanceBinaryPrefixID = "\5\6\7CLIPS"; InstanceFileData(theEnv)->InstanceBinaryVersionID = "V6.00"; #endif #if (! RUN_TIME) EnvDefineFunction2(theEnv,"save-instances",'l',PTIEF SaveInstancesCommand, "SaveInstancesCommand","1*wk"); EnvDefineFunction2(theEnv,"load-instances",'l',PTIEF LoadInstancesCommand, "LoadInstancesCommand","11k"); EnvDefineFunction2(theEnv,"restore-instances",'l',PTIEF RestoreInstancesCommand, "RestoreInstancesCommand","11k"); #if BSAVE_INSTANCES EnvDefineFunction2(theEnv,"bsave-instances",'l',PTIEF BinarySaveInstancesCommand, "BinarySaveInstancesCommand","1*wk"); #endif #if BLOAD_INSTANCES EnvDefineFunction2(theEnv,"bload-instances",'l',PTIEF BinaryLoadInstancesCommand, "BinaryLoadInstancesCommand","11k"); #endif #endif } /**************************************************************************** NAME : SaveInstancesCommand DESCRIPTION : H/L interface for saving current instances to a file INPUTS : None RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to named file NOTES : H/L Syntax : (save-instances [local|visible [[inherit] +]]) ****************************************************************************/ globle long SaveInstancesCommand( void *theEnv) { return(InstancesSaveCommandParser(theEnv,"save-instances",EnvSaveInstancesDriver)); } /****************************************************** NAME : LoadInstancesCommand DESCRIPTION : H/L interface for loading instances from a file INPUTS : None RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from named file NOTES : H/L Syntax : (load-instances ) ******************************************************/ globle long LoadInstancesCommand( void *theEnv) { const char *fileFound; DATA_OBJECT temp; long instanceCount; if (EnvArgTypeCheck(theEnv,"load-instances",1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); instanceCount = EnvLoadInstances(theEnv,fileFound); if (EvaluationData(theEnv)->EvaluationError) ProcessFileErrorMessage(theEnv,"load-instances",fileFound); return(instanceCount); } /*************************************************** NAME : EnvLoadInstances DESCRIPTION : Loads instances from named file INPUTS : The name of the input file RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from file NOTES : None ***************************************************/ globle long EnvLoadInstances( void *theEnv, const char *file) { return(LoadOrRestoreInstances(theEnv,file,TRUE,TRUE)); } /*************************************************** NAME : EnvLoadInstancesFromString DESCRIPTION : Loads instances from given string INPUTS : 1) The input string 2) Index of char in string after last valid char (-1 for all chars) RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from string NOTES : Uses string routers ***************************************************/ globle long EnvLoadInstancesFromString( void *theEnv, const char *theString, int theMax) { long theCount; const char * theStrRouter = "*** load-instances-from-string ***"; if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) : (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax))) return(-1L); theCount = LoadOrRestoreInstances(theEnv,theStrRouter,TRUE,FALSE); CloseStringSource(theEnv,theStrRouter); return(theCount); } /********************************************************* NAME : RestoreInstancesCommand DESCRIPTION : H/L interface for loading instances from a file w/o messages INPUTS : None RETURNS : The number of instances restored SIDE EFFECTS : Instances loaded from named file NOTES : H/L Syntax : (restore-instances ) *********************************************************/ globle long RestoreInstancesCommand( void *theEnv) { const char *fileFound; DATA_OBJECT temp; long instanceCount; if (EnvArgTypeCheck(theEnv,"restore-instances",1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); instanceCount = EnvRestoreInstances(theEnv,fileFound); if (EvaluationData(theEnv)->EvaluationError) ProcessFileErrorMessage(theEnv,"restore-instances",fileFound); return(instanceCount); } /*************************************************** NAME : EnvRestoreInstances DESCRIPTION : Restores instances from named file INPUTS : The name of the input file RETURNS : The number of instances restored SIDE EFFECTS : Instances restored from file NOTES : None ***************************************************/ globle long EnvRestoreInstances( void *theEnv, const char *file) { return(LoadOrRestoreInstances(theEnv,file,FALSE,TRUE)); } /*************************************************** NAME : EnvRestoreInstancesFromString DESCRIPTION : Restores instances from given string INPUTS : 1) The input string 2) Index of char in string after last valid char (-1 for all chars) RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from string NOTES : Uses string routers ***************************************************/ globle long EnvRestoreInstancesFromString( void *theEnv, const char *theString, int theMax) { long theCount; const char *theStrRouter = "*** load-instances-from-string ***"; if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) : (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax))) return(-1L); theCount = LoadOrRestoreInstances(theEnv,theStrRouter,FALSE,FALSE); CloseStringSource(theEnv,theStrRouter); return(theCount); } #if BLOAD_INSTANCES /******************************************************* NAME : BinaryLoadInstancesCommand DESCRIPTION : H/L interface for loading instances from a binary file INPUTS : None RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from named binary file NOTES : H/L Syntax : (bload-instances ) *******************************************************/ globle long BinaryLoadInstancesCommand( void *theEnv) { const char *fileFound; DATA_OBJECT temp; long instanceCount; if (EnvArgTypeCheck(theEnv,"bload-instances",1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); instanceCount = EnvBinaryLoadInstances(theEnv,fileFound); if (EvaluationData(theEnv)->EvaluationError) ProcessFileErrorMessage(theEnv,"bload-instances",fileFound); return(instanceCount); } /**************************************************** NAME : EnvBinaryLoadInstances DESCRIPTION : Loads instances quickly from a binary file INPUTS : The file name RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded w/o message-passing NOTES : None ****************************************************/ globle long EnvBinaryLoadInstances( void *theEnv, const char *theFile) { long i,instanceCount; if (GenOpenReadBinary(theEnv,"bload-instances",theFile) == 0) { SetEvaluationError(theEnv,TRUE); return(-1L); } if (VerifyBinaryHeader(theEnv,theFile) == FALSE) { GenCloseBinary(theEnv); SetEvaluationError(theEnv,TRUE); return(-1L); } EnvIncrementGCLocks(theEnv); ReadNeededAtomicValues(theEnv); InstanceFileData(theEnv)->BinaryInstanceFileOffset = 0L; GenReadBinary(theEnv,(void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &instanceCount,sizeof(long)); for (i = 0L ; i < instanceCount ; i++) { if (LoadSingleBinaryInstance(theEnv) == FALSE) { FreeReadBuffer(theEnv); FreeAtomicValueStorage(theEnv); GenCloseBinary(theEnv); SetEvaluationError(theEnv,TRUE); EnvDecrementGCLocks(theEnv); return(i); } } FreeReadBuffer(theEnv); FreeAtomicValueStorage(theEnv); GenCloseBinary(theEnv); EnvDecrementGCLocks(theEnv); return(instanceCount); } #endif /******************************************************* NAME : EnvSaveInstances DESCRIPTION : Saves current instances to named file INPUTS : 1) The name of the output file 2) A flag indicating whether to save local (current module only) or visible instances LOCAL_SAVE or VISIBLE_SAVE 3) A list of expressions containing the names of classes for which instances are to be saved 4) A flag indicating if the subclasses of specified classes shoudl also be processed RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to file NOTES : None *******************************************************/ globle long EnvSaveInstances( void *theEnv, const char *file, int saveCode) { return EnvSaveInstancesDriver(theEnv,file,saveCode,NULL,TRUE); } /******************************************************* NAME : EnvSaveInstancesDriver DESCRIPTION : Saves current instances to named file INPUTS : 1) The name of the output file 2) A flag indicating whether to save local (current module only) or visible instances LOCAL_SAVE or VISIBLE_SAVE 3) A list of expressions containing the names of classes for which instances are to be saved 4) A flag indicating if the subclasses of specified classes shoudl also be processed RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to file NOTES : None *******************************************************/ globle long EnvSaveInstancesDriver( void *theEnv, const char *file, int saveCode, EXPRESSION *classExpressionList, intBool inheritFlag) { FILE *sfile = NULL; int oldPEC,oldATS,oldIAN; DATA_OBJECT *classList; long instanceCount; classList = ProcessSaveClassList(theEnv,"save-instances",classExpressionList, saveCode,inheritFlag); if ((classList == NULL) && (classExpressionList != NULL)) return(0L); SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList, inheritFlag,TRUE,NULL); if ((sfile = GenOpen(theEnv,file,"w")) == NULL) { OpenErrorMessage(theEnv,"save-instances",file); ReturnSaveClassList(theEnv,classList); SetEvaluationError(theEnv,TRUE); return(0L); } oldPEC = PrintUtilityData(theEnv)->PreserveEscapedCharacters; PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE; oldATS = PrintUtilityData(theEnv)->AddressesToStrings; PrintUtilityData(theEnv)->AddressesToStrings = TRUE; oldIAN = PrintUtilityData(theEnv)->InstanceAddressesToNames; PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE; SetFastSave(theEnv,sfile); instanceCount = SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList, inheritFlag,TRUE,SaveSingleInstanceText); GenClose(theEnv,sfile); SetFastSave(theEnv,NULL); PrintUtilityData(theEnv)->PreserveEscapedCharacters = oldPEC; PrintUtilityData(theEnv)->AddressesToStrings = oldATS; PrintUtilityData(theEnv)->InstanceAddressesToNames = oldIAN; ReturnSaveClassList(theEnv,classList); return(instanceCount); } #if BSAVE_INSTANCES /**************************************************************************** NAME : BinarySaveInstancesCommand DESCRIPTION : H/L interface for saving current instances to a binary file INPUTS : None RETURNS : The number of instances saved SIDE EFFECTS : Instances saved (in binary format) to named file NOTES : H/L Syntax : (bsave-instances [local|visible [[inherit] +]]) *****************************************************************************/ globle long BinarySaveInstancesCommand( void *theEnv) { return(InstancesSaveCommandParser(theEnv,"bsave-instances",EnvBinarySaveInstancesDriver)); } /******************************************************* NAME : EnvBinarySaveInstances DESCRIPTION : Saves current instances to binary file INPUTS : 1) The name of the output file 2) A flag indicating whether to save local (current module only) or visible instances LOCAL_SAVE or VISIBLE_SAVE RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to file NOTES : None *******************************************************/ globle long EnvBinarySaveInstances( void *theEnv, const char *file, int saveCode) { return EnvBinarySaveInstancesDriver(theEnv,file,saveCode,NULL,TRUE); } /******************************************************* NAME : EnvBinarySaveInstancesDriver DESCRIPTION : Saves current instances to binary file INPUTS : 1) The name of the output file 2) A flag indicating whether to save local (current module only) or visible instances LOCAL_SAVE or VISIBLE_SAVE 3) A list of expressions containing the names of classes for which instances are to be saved 4) A flag indicating if the subclasses of specified classes shoudl also be processed RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to file NOTES : None *******************************************************/ globle long EnvBinarySaveInstancesDriver( void *theEnv, const char *file, int saveCode, EXPRESSION *classExpressionList, intBool inheritFlag) { DATA_OBJECT *classList; FILE *bsaveFP; long instanceCount; classList = ProcessSaveClassList(theEnv,"bsave-instances",classExpressionList, saveCode,inheritFlag); if ((classList == NULL) && (classExpressionList != NULL)) return(0L); InstanceFileData(theEnv)->BinaryInstanceFileSize = 0L; InitAtomicValueNeededFlags(theEnv); instanceCount = SaveOrMarkInstances(theEnv,NULL,saveCode,classList,inheritFlag, FALSE,MarkSingleInstance); if ((bsaveFP = GenOpen(theEnv,file,"wb")) == NULL) { OpenErrorMessage(theEnv,"bsave-instances",file); ReturnSaveClassList(theEnv,classList); SetEvaluationError(theEnv,TRUE); return(0L); } WriteBinaryHeader(theEnv,bsaveFP); WriteNeededAtomicValues(theEnv,bsaveFP); fwrite((void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long),1,bsaveFP); fwrite((void *) &instanceCount,sizeof(long),1,bsaveFP); SetAtomicValueIndices(theEnv,FALSE); SaveOrMarkInstances(theEnv,(void *) bsaveFP,saveCode,classList, inheritFlag,FALSE,SaveSingleInstanceBinary); RestoreAtomicValueBuckets(theEnv); GenClose(theEnv,bsaveFP); ReturnSaveClassList(theEnv,classList); return(instanceCount); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /****************************************************** NAME : InstancesSaveCommandParser DESCRIPTION : Argument parser for save-instances and bsave-instances INPUTS : 1) The name of the calling function 2) A pointer to the support function to call for the save/bsave RETURNS : The number of instances saved SIDE EFFECTS : Instances saved/bsaved NOTES : None ******************************************************/ static long InstancesSaveCommandParser( void *theEnv, const char *functionName, long (*saveFunction)(void *,const char *,int,EXPRESSION *,intBool)) { const char *fileFound; DATA_OBJECT temp; int argCount,saveCode = LOCAL_SAVE; EXPRESSION *classList = NULL; intBool inheritFlag = FALSE; if (EnvArgTypeCheck(theEnv,functionName,1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); argCount = EnvRtnArgCount(theEnv); if (argCount > 1) { if (EnvArgTypeCheck(theEnv,functionName,2,SYMBOL,&temp) == FALSE) { ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\""); SetEvaluationError(theEnv,TRUE); return(0L); } if (strcmp(DOToString(temp),"local") == 0) saveCode = LOCAL_SAVE; else if (strcmp(DOToString(temp),"visible") == 0) saveCode = VISIBLE_SAVE; else { ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\""); SetEvaluationError(theEnv,TRUE); return(0L); } classList = GetFirstArgument()->nextArg->nextArg; /* =========================== Check for "inherit" keyword Must be at least one class name following =========================== */ if ((classList != NULL) ? (classList->nextArg != NULL) : FALSE) { if ((classList->type != SYMBOL) ? FALSE : (strcmp(ValueToString(classList->value),"inherit") == 0)) { inheritFlag = TRUE; classList = classList->nextArg; } } } return((*saveFunction)(theEnv,fileFound,saveCode,classList,inheritFlag)); } /**************************************************** NAME : ProcessSaveClassList DESCRIPTION : Evaluates a list of class name expressions and stores them in a data object list INPUTS : 1) The name of the calling function 2) The class expression list 3) A flag indicating if only local or all visible instances are being saved 4) A flag indicating if inheritance relationships should be checked between classes RETURNS : The evaluated class pointer data objects - NULL on errors SIDE EFFECTS : Data objects allocated and classes validated NOTES : None ****************************************************/ static DATA_OBJECT *ProcessSaveClassList( void *theEnv, const char *functionName, EXPRESSION *classExps, int saveCode, intBool inheritFlag) { DATA_OBJECT *head = NULL,*prv,*newItem,tmp; DEFCLASS *theDefclass; struct defmodule *currentModule; int argIndex = inheritFlag ? 4 : 3; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); while (classExps != NULL) { if (EvaluateExpression(theEnv,classExps,&tmp)) goto ProcessClassListError; if (tmp.type != SYMBOL) goto ProcessClassListError; if (saveCode == LOCAL_SAVE) theDefclass = LookupDefclassAnywhere(theEnv,currentModule,DOToString(tmp)); else //theDefclass = LookupDefclassInScope(theEnv,DOToString(tmp)); { theDefclass = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); } if (theDefclass == NULL) goto ProcessClassListError; else if (theDefclass->abstract && (inheritFlag == FALSE)) goto ProcessClassListError; prv = newItem = head; while (newItem != NULL) { if (newItem->value == (void *) theDefclass) goto ProcessClassListError; else if (inheritFlag) { if (HasSuperclass((DEFCLASS *) newItem->value,theDefclass) || HasSuperclass(theDefclass,(DEFCLASS *) newItem->value)) goto ProcessClassListError; } prv = newItem; newItem = newItem->next; } newItem = get_struct(theEnv,dataObject); newItem->type = DEFCLASS_PTR; newItem->value = (void *) theDefclass; newItem->next = NULL; if (prv == NULL) head = newItem; else prv->next = newItem; argIndex++; classExps = classExps->nextArg; } return(head); ProcessClassListError: if (inheritFlag) ExpectedTypeError1(theEnv,functionName,argIndex,"valid class name"); else ExpectedTypeError1(theEnv,functionName,argIndex,"valid concrete class name"); ReturnSaveClassList(theEnv,head); SetEvaluationError(theEnv,TRUE); return(NULL); } /**************************************************** NAME : ReturnSaveClassList DESCRIPTION : Deallocates the class data object list created by ProcessSaveClassList INPUTS : The class data object list RETURNS : Nothing useful SIDE EFFECTS : Class data object returned NOTES : None ****************************************************/ static void ReturnSaveClassList( void *theEnv, DATA_OBJECT *classList) { DATA_OBJECT *tmp; while (classList != NULL) { tmp = classList; classList = classList->next; rtn_struct(theEnv,dataObject,tmp); } } /*************************************************** NAME : SaveOrMarkInstances DESCRIPTION : Iterates through all specified instances either marking needed atoms or writing instances in binary/text format INPUTS : 1) NULL (for marking), logical name (for text saves) file pointer (for binary saves) 2) A cope flag indicating LOCAL or VISIBLE saves only 3) A list of data objects containing the names of classes of instances to be saved 4) A flag indicating whether to include subclasses of arg #3 5) A flag indicating if the iteration can be interrupted or not 6) The access function to mark or save an instance (can be NULL if only counting instances) RETURNS : The number of instances saved SIDE EFFECTS : Instances amrked or saved NOTES : None ***************************************************/ static long SaveOrMarkInstances( void *theEnv, void *theOutput, int saveCode, DATA_OBJECT *classList, intBool inheritFlag, intBool interruptOK, void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *)) { struct defmodule *currentModule; int traversalID; DATA_OBJECT *tmp; INSTANCE_TYPE *ins; long instanceCount = 0L; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (classList != NULL) { traversalID = GetTraversalID(theEnv); if (traversalID != -1) { for (tmp = classList ; (! ((tmp == NULL) || (EvaluationData(theEnv)->HaltExecution && interruptOK))) ; tmp = tmp->next) instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode, (DEFCLASS *) tmp->value,inheritFlag, traversalID,saveInstanceFunc); ReleaseTraversalID(theEnv); } } else { for (ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,NULL) ; (ins != NULL) && (EvaluationData(theEnv)->HaltExecution != TRUE) ; ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,(void *) ins)) { if ((saveCode == VISIBLE_SAVE) ? TRUE : (ins->cls->header.whichModule->theModule == currentModule)) { if (saveInstanceFunc != NULL) (*saveInstanceFunc)(theEnv,theOutput,ins); instanceCount++; } } } return(instanceCount); } /*************************************************** NAME : SaveOrMarkInstancesOfClass DESCRIPTION : Saves off the direct (and indirect) instance of the specified class INPUTS : 1) The logical name of the output (or file pointer for binary output) 2) The current module 3) A flag indicating local or visible saves 4) The defclass 5) A flag indicating whether to save subclass instances or not 6) A traversal id for marking visited classes 7) A pointer to the instance manipulation function to call (can be NULL for only counting instances) RETURNS : The number of instances saved SIDE EFFECTS : Appropriate instances saved NOTES : None ***************************************************/ static long SaveOrMarkInstancesOfClass( void *theEnv, void *theOutput, struct defmodule *currentModule, int saveCode, DEFCLASS *theDefclass, intBool inheritFlag, int traversalID, void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *)) { INSTANCE_TYPE *theInstance; DEFCLASS *subclass; long i; long instanceCount = 0L; if (TestTraversalID(theDefclass->traversalRecord,traversalID)) return(instanceCount); SetTraversalID(theDefclass->traversalRecord,traversalID); if (((saveCode == LOCAL_SAVE) && (theDefclass->header.whichModule->theModule == currentModule)) || ((saveCode == VISIBLE_SAVE) && DefclassInScope(theEnv,theDefclass,currentModule))) { for (theInstance = (INSTANCE_TYPE *) EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,NULL) ; theInstance != NULL ; theInstance = (INSTANCE_TYPE *) EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,(void *) theInstance)) { if (saveInstanceFunc != NULL) (*saveInstanceFunc)(theEnv,theOutput,theInstance); instanceCount++; } } if (inheritFlag) { for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++) { subclass = theDefclass->directSubclasses.classArray[i]; instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode, subclass,TRUE,traversalID, saveInstanceFunc); } } return(instanceCount); } /*************************************************** NAME : SaveSingleInstanceText DESCRIPTION : Writes given instance to file INPUTS : 1) The logical name of the output 2) The instance to save RETURNS : Nothing useful SIDE EFFECTS : Instance written NOTES : None ***************************************************/ static void SaveSingleInstanceText( void *theEnv, void *vLogicalName, INSTANCE_TYPE *theInstance) { long i; INSTANCE_SLOT *sp; const char *logicalName = (const char *) vLogicalName; EnvPrintRouter(theEnv,logicalName,"(["); EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->name)); EnvPrintRouter(theEnv,logicalName,"] of "); EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->cls->header.name)); for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; EnvPrintRouter(theEnv,logicalName,"\n ("); EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name)); if (sp->type != MULTIFIELD) { EnvPrintRouter(theEnv,logicalName," "); PrintAtom(theEnv,logicalName,(int) sp->type,sp->value); } else if (GetInstanceSlotLength(sp) != 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0, (long) (GetInstanceSlotLength(sp) - 1),FALSE); } EnvPrintRouter(theEnv,logicalName,")"); } EnvPrintRouter(theEnv,logicalName,")\n\n"); } #if BSAVE_INSTANCES /*************************************************** NAME : WriteBinaryHeader DESCRIPTION : Writes identifying string to instance binary file to assist in later verification INPUTS : The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Binary prefix headers written NOTES : None ***************************************************/ static void WriteBinaryHeader( void *theEnv, FILE *bsaveFP) { fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryPrefixID, (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1),1,bsaveFP); fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryVersionID, (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1),1,bsaveFP); } /*************************************************** NAME : MarkSingleInstance DESCRIPTION : Marks all the atoms needed in the slot values of an instance INPUTS : 1) The output (ignored) 2) The instance RETURNS : Nothing useful SIDE EFFECTS : Instance slot value atoms marked NOTES : None ***************************************************/ static void MarkSingleInstance( void *theEnv, void *theOutput, INSTANCE_TYPE *theInstance) { #if MAC_XCD #pragma unused(theOutput) #endif INSTANCE_SLOT *sp; long i, j; InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) (sizeof(long) * 2); theInstance->name->neededSymbol = TRUE; theInstance->cls->header.name->neededSymbol = TRUE; InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) ((sizeof(long) * 2) + (sizeof(struct bsaveSlotValue) * theInstance->cls->instanceSlotCount) + sizeof(unsigned long) + sizeof(unsigned)); for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; sp->desc->slotName->name->neededSymbol = TRUE; if (sp->desc->multiple) { for (j = 1 ; j <= GetInstanceSlotLength(sp) ; j++) MarkNeededAtom(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j)); } else MarkNeededAtom(theEnv,(int) sp->type,sp->value); } } /*************************************************** NAME : MarkNeededAtom DESCRIPTION : Marks an integer/float/symbol as being need by a set of instances INPUTS : 1) The type of atom 2) The value of the atom RETURNS : Nothing useful SIDE EFFECTS : Atom marked for saving NOTES : None ***************************************************/ static void MarkNeededAtom( void *theEnv, int type, void *value) { InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) sizeof(struct bsaveSlotValueAtom); /* ===================================== Assumes slot value atoms can only be floats, integers, symbols, strings, instance-names, instance-addresses, fact-addresses or external-addresses ===================================== */ switch (type) { case SYMBOL: case STRING: case INSTANCE_NAME: ((SYMBOL_HN *) value)->neededSymbol = TRUE; break; case FLOAT: ((FLOAT_HN *) value)->neededFloat = TRUE; break; case INTEGER: ((INTEGER_HN *) value)->neededInteger = TRUE; break; case INSTANCE_ADDRESS: GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->neededSymbol = TRUE; break; } } /**************************************************** NAME : SaveSingleInstanceBinary DESCRIPTION : Writes given instance to binary file INPUTS : 1) Binary file pointer 2) The instance to save RETURNS : Nothing useful SIDE EFFECTS : Instance written NOTES : None ****************************************************/ static void SaveSingleInstanceBinary( void *theEnv, void *vBsaveFP, INSTANCE_TYPE *theInstance) { long nameIndex; long i,j; INSTANCE_SLOT *sp; FILE *bsaveFP = (FILE *) vBsaveFP; struct bsaveSlotValue bs; long totalValueCount = 0L; long slotLen; /* =========================== Write out the instance name =========================== */ nameIndex = (long) theInstance->name->bucket; fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP); /* ======================== Write out the class name ======================== */ nameIndex = (long) theInstance->cls->header.name->bucket; fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP); /* ====================================== Write out the number of slot-overrides ====================================== */ fwrite((void *) &theInstance->cls->instanceSlotCount, (int) sizeof(short),1,bsaveFP); /* ========================================= Write out the slot names and value counts ========================================= */ for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; /* =============================================== Write out the number of atoms in the slot value =============================================== */ bs.slotName = (long) sp->desc->slotName->name->bucket; bs.valueCount = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1; fwrite((void *) &bs,(int) sizeof(struct bsaveSlotValue),1,bsaveFP); totalValueCount += (unsigned long) bs.valueCount; } /* ================================== Write out the number of slot value atoms for the whole instance ================================== */ if (theInstance->cls->instanceSlotCount != 0) // (totalValueCount != 0L) : Bug fix if any slots, write out count fwrite((void *) &totalValueCount,(int) sizeof(unsigned long),1,bsaveFP); /* ============================== Write out the slot value atoms ============================== */ for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; slotLen = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1; /* ========================================= Write out the type and index of each atom ========================================= */ if (sp->desc->multiple) { for (j = 1 ; j <= slotLen ; j++) SaveAtomBinary(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j),bsaveFP); } else SaveAtomBinary(theEnv,(unsigned short) sp->type,sp->value,bsaveFP); } } /*************************************************** NAME : SaveAtomBinary DESCRIPTION : Writes out an instance slot value atom to the binary file INPUTS : 1) The atom type 2) The atom value 3) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : atom written NOTES : ***************************************************/ static void SaveAtomBinary( void *theEnv, unsigned short type, void *value, FILE *bsaveFP) { struct bsaveSlotValueAtom bsa; /* ===================================== Assumes slot value atoms can only be floats, integers, symbols, strings, instance-names, instance-addresses, fact-addresses or external-addresses ===================================== */ bsa.type = type; switch (type) { case SYMBOL: case STRING: case INSTANCE_NAME: bsa.value = (long) ((SYMBOL_HN *) value)->bucket; break; case FLOAT: bsa.value = (long) ((FLOAT_HN *) value)->bucket; break; case INTEGER: bsa.value = (long) ((INTEGER_HN *) value)->bucket; break; case INSTANCE_ADDRESS: bsa.type = INSTANCE_NAME; bsa.value = (long) GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->bucket; break; default: bsa.value = -1L; } fwrite((void *) &bsa,(int) sizeof(struct bsaveSlotValueAtom),1,bsaveFP); } #endif /********************************************************************** NAME : LoadOrRestoreInstances DESCRIPTION : Loads instances from named file INPUTS : 1) The name of the input file 2) An integer flag indicating whether or not to use message-passing to create the new instances and delete old versions 3) An integer flag indicating if arg #1 is a file name or the name of a string router RETURNS : The number of instances loaded/restored SIDE EFFECTS : Instances loaded from file NOTES : None **********************************************************************/ static long LoadOrRestoreInstances( void *theEnv, const char *file, int usemsgs, int isFileName) { DATA_OBJECT temp; FILE *sfile = NULL,*svload = NULL; const char *ilog; EXPRESSION *top; int svoverride; long instanceCount = 0L; if (isFileName) { if ((sfile = GenOpen(theEnv,file,"r")) == NULL) { SetEvaluationError(theEnv,TRUE); return(-1L); } svload = GetFastLoad(theEnv); ilog = (char *) sfile; SetFastLoad(theEnv,sfile); } else { ilog = file; } top = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken); svoverride = InstanceData(theEnv)->MkInsMsgPass; InstanceData(theEnv)->MkInsMsgPass = usemsgs; while ((GetType(DefclassData(theEnv)->ObjectParseToken) != STOP) && (EvaluationData(theEnv)->HaltExecution != TRUE)) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"instance definition"); rtn_struct(theEnv,expr,top); if (isFileName) { GenClose(theEnv,sfile); SetFastLoad(theEnv,svload); } SetEvaluationError(theEnv,TRUE); InstanceData(theEnv)->MkInsMsgPass = svoverride; return(instanceCount); } if (ParseSimpleInstance(theEnv,top,ilog) == NULL) { if (isFileName) { GenClose(theEnv,sfile); SetFastLoad(theEnv,svload); } InstanceData(theEnv)->MkInsMsgPass = svoverride; SetEvaluationError(theEnv,TRUE); return(instanceCount); } ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,&temp); ExpressionDeinstall(theEnv,top); if (! EvaluationData(theEnv)->EvaluationError) instanceCount++; ReturnExpression(theEnv,top->argList); top->argList = NULL; GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken); } rtn_struct(theEnv,expr,top); if (isFileName) { GenClose(theEnv,sfile); SetFastLoad(theEnv,svload); } InstanceData(theEnv)->MkInsMsgPass = svoverride; return(instanceCount); } /*************************************************** NAME : ProcessFileErrorMessage DESCRIPTION : Prints an error message when a file containing text or binary instances cannot be processed. INPUTS : The name of the input file and the function which opened it. RETURNS : No value SIDE EFFECTS : None NOTES : None ***************************************************/ static void ProcessFileErrorMessage( void *theEnv, const char *functionName, const char *fileName) { PrintErrorID(theEnv,"INSFILE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," could not completely process file "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR,".\n"); } #if BLOAD_INSTANCES /******************************************************* NAME : VerifyBinaryHeader DESCRIPTION : Reads the prefix and version headers from a file to verify that the input is a valid binary instances file INPUTS : The name of the file RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Input prefix and version read NOTES : Assumes file already open with GenOpenReadBinary *******************************************************/ static intBool VerifyBinaryHeader( void *theEnv, const char *theFile) { char buf[20]; GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1)); if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryPrefixID) != 0) { PrintErrorID(theEnv,"INSFILE",2,FALSE); EnvPrintRouter(theEnv,WERROR,theFile); EnvPrintRouter(theEnv,WERROR," file is not a binary instances file.\n"); return(FALSE); } GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1)); if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryVersionID) != 0) { PrintErrorID(theEnv,"INSFILE",3,FALSE); EnvPrintRouter(theEnv,WERROR,theFile); EnvPrintRouter(theEnv,WERROR," file is not a compatible binary instances file.\n"); return(FALSE); } return(TRUE); } /*************************************************** NAME : LoadSingleBinaryInstance DESCRIPTION : Reads the binary data for a new instance and its slot values and creates/initializes the instance INPUTS : None RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Binary data read and instance created NOTES : Uses global GenReadBinary(theEnv,) ***************************************************/ static intBool LoadSingleBinaryInstance( void *theEnv) { SYMBOL_HN *instanceName, *className; short slotCount; DEFCLASS *theDefclass; INSTANCE_TYPE *newInstance; struct bsaveSlotValue *bsArray; struct bsaveSlotValueAtom *bsaArray = NULL; long nameIndex; unsigned long totalValueCount; long i, j; INSTANCE_SLOT *sp; DATA_OBJECT slotValue,junkValue; /* ===================== Get the instance name ===================== */ BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long)); instanceName = SymbolPointer(nameIndex); /* ================== Get the class name ================== */ BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long)); className = SymbolPointer(nameIndex); /* ================== Get the slot count ================== */ BufferedRead(theEnv,(void *) &slotCount,(unsigned long) sizeof(short)); /* ============================= Make sure the defclass exists and check the slot count ============================= */ //theDefclass = LookupDefclassInScope(theEnv,ValueToString(className)); theDefclass = LookupDefclassByMdlOrScope(theEnv,ValueToString(className)); if (theDefclass == NULL) { ClassExistError(theEnv,"bload-instances",ValueToString(className)); return(FALSE); } if (theDefclass->instanceSlotCount != slotCount) { BinaryLoadInstanceError(theEnv,instanceName,theDefclass); return(FALSE); } /* =================================== Create the new unitialized instance =================================== */ newInstance = BuildInstance(theEnv,instanceName,theDefclass,FALSE); if (newInstance == NULL) { BinaryLoadInstanceError(theEnv,instanceName,theDefclass); return(FALSE); } if (slotCount == 0) return(TRUE); /* ==================================== Read all slot override info and slot value atoms into big arrays ==================================== */ bsArray = (struct bsaveSlotValue *) gm2(theEnv,(sizeof(struct bsaveSlotValue) * slotCount)); BufferedRead(theEnv,(void *) bsArray,(unsigned long) (sizeof(struct bsaveSlotValue) * slotCount)); BufferedRead(theEnv,(void *) &totalValueCount,(unsigned long) sizeof(unsigned long)); if (totalValueCount != 0L) { bsaArray = (struct bsaveSlotValueAtom *) gm3(theEnv,(long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); BufferedRead(theEnv,(void *) bsaArray, (unsigned long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); } /* ========================= Insert the values for the slot overrides ========================= */ for (i = 0 , j = 0L ; i < slotCount ; i++) { /* =========================================================== Here is another check for the validity of the binary file - the order of the slots in the file should match the order in the class definition =========================================================== */ sp = newInstance->slotAddresses[i]; if (sp->desc->slotName->name != SymbolPointer(bsArray[i].slotName)) goto LoadError; CreateSlotValue(theEnv,&slotValue,(struct bsaveSlotValueAtom *) &bsaArray[j], bsArray[i].valueCount); if (PutSlotValue(theEnv,newInstance,sp,&slotValue,&junkValue,"bload-instances") == FALSE) goto LoadError; j += (unsigned long) bsArray[i].valueCount; } rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount)); if (totalValueCount != 0L) rm3(theEnv,(void *) bsaArray, (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); return(TRUE); LoadError: BinaryLoadInstanceError(theEnv,instanceName,theDefclass); QuashInstance(theEnv,newInstance); rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount)); rm3(theEnv,(void *) bsaArray, (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); return(FALSE); } /*************************************************** NAME : BinaryLoadInstanceError DESCRIPTION : Prints out an error message when an instance could not be successfully loaded from a binary file INPUTS : 1) The instance name 2) The defclass RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ static void BinaryLoadInstanceError( void *theEnv, SYMBOL_HN *instanceName, DEFCLASS *theDefclass) { PrintErrorID(theEnv,"INSFILE",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function bload-instances unable to load instance ["); EnvPrintRouter(theEnv,WERROR,ValueToString(instanceName)); EnvPrintRouter(theEnv,WERROR,"] of class "); PrintClassName(theEnv,WERROR,theDefclass,TRUE); } /*************************************************** NAME : CreateSlotValue DESCRIPTION : Creates a data object value from the binary slot value atom data INPUTS : 1) A data object buffer 2) The slot value atoms array 3) The number of values to put in the data object RETURNS : Nothing useful SIDE EFFECTS : Data object initialized (if more than one value, a multifield is created) NOTES : None ***************************************************/ static void CreateSlotValue( void *theEnv, DATA_OBJECT *result, struct bsaveSlotValueAtom *bsaValues, unsigned long valueCount) { register unsigned i; if (valueCount == 0) { result->type = MULTIFIELD; result->value = EnvCreateMultifield(theEnv,0L); result->begin = 0; result->end = -1; } else if (valueCount == 1) { result->type = bsaValues[0].type; result->value = GetBinaryAtomValue(theEnv,&bsaValues[0]); } else { result->type = MULTIFIELD; result->value = EnvCreateMultifield(theEnv,valueCount); result->begin = 0; SetpDOEnd(result,valueCount); for (i = 1 ; i <= valueCount ; i++) { SetMFType(result->value,i,(short) bsaValues[i-1].type); SetMFValue(result->value,i,GetBinaryAtomValue(theEnv,&bsaValues[i-1])); } } } /*************************************************** NAME : GetBinaryAtomValue DESCRIPTION : Uses the binary index of an atom to find the ephemeris value INPUTS : The binary type and index RETURNS : The symbol/etc. pointer SIDE EFFECTS : None NOTES : None ***************************************************/ static void *GetBinaryAtomValue( void *theEnv, struct bsaveSlotValueAtom *ba) { switch (ba->type) { case SYMBOL: case STRING: case INSTANCE_NAME: return((void *) SymbolPointer(ba->value)); case FLOAT: return((void *) FloatPointer(ba->value)); case INTEGER: return((void *) IntegerPointer(ba->value)); case FACT_ADDRESS: #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT return((void *) &FactData(theEnv)->DummyFact); #else return(NULL); #endif case EXTERNAL_ADDRESS: return(NULL); default: { SystemError(theEnv,"INSFILE",1); EnvExitRouter(theEnv,EXIT_FAILURE); } } return(NULL); } /*************************************************** NAME : BufferedRead DESCRIPTION : Reads data from binary file (Larger blocks than requested size may be read and buffered) INPUTS : 1) The buffer 2) The buffer size RETURNS : Nothing useful SIDE EFFECTS : Data stored in buffer NOTES : None ***************************************************/ static void BufferedRead( void *theEnv, void *buf, unsigned long bufsz) { unsigned long i,amountLeftToRead; if (InstanceFileData(theEnv)->CurrentReadBuffer != NULL) { amountLeftToRead = InstanceFileData(theEnv)->CurrentReadBufferSize - InstanceFileData(theEnv)->CurrentReadBufferOffset; if (bufsz <= amountLeftToRead) { for (i = 0L ; i < bufsz ; i++) ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset]; InstanceFileData(theEnv)->CurrentReadBufferOffset += bufsz; if (InstanceFileData(theEnv)->CurrentReadBufferOffset == InstanceFileData(theEnv)->CurrentReadBufferSize) FreeReadBuffer(theEnv); } else { if (InstanceFileData(theEnv)->CurrentReadBufferOffset < InstanceFileData(theEnv)->CurrentReadBufferSize) { for (i = 0L ; i < amountLeftToRead ; i++) ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset]; bufsz -= amountLeftToRead; buf = (void *) (((char *) buf) + amountLeftToRead); } FreeReadBuffer(theEnv); BufferedRead(theEnv,buf,bufsz); } } else { if (bufsz > MAX_BLOCK_SIZE) { InstanceFileData(theEnv)->CurrentReadBufferSize = bufsz; if (bufsz > (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset)) { SystemError(theEnv,"INSFILE",2); EnvExitRouter(theEnv,EXIT_FAILURE); } } else if (MAX_BLOCK_SIZE > (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset)) InstanceFileData(theEnv)->CurrentReadBufferSize = InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset; else InstanceFileData(theEnv)->CurrentReadBufferSize = (unsigned long) MAX_BLOCK_SIZE; InstanceFileData(theEnv)->CurrentReadBuffer = (char *) genalloc(theEnv,InstanceFileData(theEnv)->CurrentReadBufferSize); GenReadBinary(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize); for (i = 0L ; i < bufsz ; i++) ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i]; InstanceFileData(theEnv)->CurrentReadBufferOffset = bufsz; InstanceFileData(theEnv)->BinaryInstanceFileOffset += InstanceFileData(theEnv)->CurrentReadBufferSize; } } /***************************************************** NAME : FreeReadBuffer DESCRIPTION : Deallocates buffer for binary reads INPUTS : None RETURNS : Nothing usefu SIDE EFFECTS : Binary global read buffer deallocated NOTES : None *****************************************************/ static void FreeReadBuffer( void *theEnv) { if (InstanceFileData(theEnv)->CurrentReadBufferSize != 0L) { genfree(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize); InstanceFileData(theEnv)->CurrentReadBuffer = NULL; InstanceFileData(theEnv)->CurrentReadBufferSize = 0L; } } #endif /* BLOAD_INSTANCES */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS #if BLOAD_INSTANCES globle long BinaryLoadInstances( const char *theFile) { return EnvBinaryLoadInstances(GetCurrentEnvironment(),theFile); } #endif #if BSAVE_INSTANCES globle long BinarySaveInstances( const char *file, int saveCode) { return EnvBinarySaveInstances(GetCurrentEnvironment(),file,saveCode); } #endif globle long LoadInstances( const char *file) { return EnvLoadInstances(GetCurrentEnvironment(),file); } globle long LoadInstancesFromString( const char *theString, int theMax) { return EnvLoadInstancesFromString(GetCurrentEnvironment(),theString,theMax); } globle long RestoreInstances( const char *file) { return EnvRestoreInstances(GetCurrentEnvironment(),file); } globle long RestoreInstancesFromString( const char *theString, int theMax) { return EnvRestoreInstancesFromString(GetCurrentEnvironment(),theString,theMax); } globle long SaveInstances( const char *file, int saveCode) { return EnvSaveInstances(GetCurrentEnvironment(),file,saveCode); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* OBJECT_SYSTEM */ clips_core_source_630/core/ruledlt.h0000755000175000017500000000456212374024356016072 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* RULE DELETION MODULE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for deleting a rule including */ /* freeing the defrule data structures and removing the */ /* appropriate joins from the join network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added support for hashed memories. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /*************************************************************/ #ifndef _H_ruledlt #define _H_ruledlt #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEDLT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ReturnDefrule(void *,void *); LOCALE void DestroyDefrule(void *,void *); #endif /* _H_ruledlt */ clips_core_source_630/core/._cstrnutl.c0000755000175000017500000000040712462771770016506 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._bmathfun.h0000755000175000017500000000040712373706601016431 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtfnx.h0000755000175000017500000000040712374023164016456 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/genrccmp.h0000755000175000017500000000513112373753411016206 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added pragmas to remove unused parameter */ /* warnings. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_genrccmp #define _H_genrccmp #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "genrcfun.h" LOCALE void SetupGenericsCompiler(void *); LOCALE void PrintGenericFunctionReference(void *,FILE *,DEFGENERIC *,int,int); LOCALE void DefgenericCModuleReference(void *,FILE *,int,int,int); #endif /* _H_genrccmp */ clips_core_source_630/core/msgpass.c0000755000175000017500000014544312455255047016076 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/13/15 */ /* */ /* OBJECT MESSAGE DISPATCH CODE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: The return value of DirectMessage indicates */ /* whether an execution error has occurred. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* It's no longer necessary for a defclass to be */ /* in scope in order to sent a message to an */ /* instance of that class. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #include #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "constrct.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "insfun.h" #include "msgcom.h" #include "msgfun.h" #include "multifld.h" #include "prcdrfun.h" #include "prccode.h" #include "proflfun.h" #include "router.h" #include "strngfun.h" #include "utility.h" #include "commline.h" #define _MSGPASS_SOURCE_ #include "msgpass.h" #include "inscom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool PerformMessage(void *,DATA_OBJECT *,EXPRESSION *,SYMBOL_HN *); static HANDLER_LINK *FindApplicableHandlers(void *,DEFCLASS *,SYMBOL_HN *); static void CallHandlers(void *,DATA_OBJECT *); static void EarlySlotBindError(void *,INSTANCE_TYPE *,DEFCLASS *,unsigned); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : DirectMessage DESCRIPTION : Plugs in given instance and performs specified message INPUTS : 1) Message symbolic name 2) The instance address 3) Address of DATA_OBJECT buffer (NULL if don't care) 4) Message argument expressions RETURNS : Returns FALSE is an execution error occurred or execution is halted, otherwise TRUE SIDE EFFECTS : Side effects of message execution NOTES : None *****************************************************/ globle intBool DirectMessage( void *theEnv, SYMBOL_HN *msg, INSTANCE_TYPE *ins, DATA_OBJECT *resultbuf, EXPRESSION *remargs) { EXPRESSION args; DATA_OBJECT temp; if (resultbuf == NULL) resultbuf = &temp; args.nextArg = remargs; args.argList = NULL; args.type = INSTANCE_ADDRESS; args.value = (void *) ins; return PerformMessage(theEnv,resultbuf,&args,msg); } /*************************************************** NAME : EnvSend DESCRIPTION : C Interface for sending messages to instances INPUTS : 1) The data object of the instance 2) The message name-string 3) The message arguments string (Constants only) 4) Caller's buffer for result RETURNS : Nothing useful SIDE EFFECTS : Executes message and stores result caller's buffer NOTES : None ***************************************************/ globle void EnvSend( void *theEnv, DATA_OBJECT *idata, const char *msg, const char *args, DATA_OBJECT *result) { int error; EXPRESSION *iexp; SYMBOL_HN *msym; if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } SetEvaluationError(theEnv,FALSE); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); msym = FindSymbolHN(theEnv,msg); if (msym == NULL) { PrintNoHandlerError(theEnv,msg); SetEvaluationError(theEnv,TRUE); return; } iexp = GenConstant(theEnv,idata->type,idata->value); iexp->nextArg = ParseConstantArguments(theEnv,args,&error); if (error == TRUE) { ReturnExpression(theEnv,iexp); SetEvaluationError(theEnv,TRUE); return; } PerformMessage(theEnv,result,iexp,msym); ReturnExpression(theEnv,iexp); } /***************************************************** NAME : DestroyHandlerLinks DESCRIPTION : Iteratively deallocates handler-links INPUTS : The handler-link list RETURNS : Nothing useful SIDE EFFECTS : Deallocation of links NOTES : None *****************************************************/ globle void DestroyHandlerLinks( void *theEnv, HANDLER_LINK *mhead) { HANDLER_LINK *tmp; while (mhead != NULL) { tmp = mhead; mhead = mhead->nxt; tmp->hnd->busy--; DecrementDefclassBusyCount(theEnv,(void *) tmp->hnd->cls); rtn_struct(theEnv,messageHandlerLink,tmp); } } /*********************************************************************** NAME : SendCommand DESCRIPTION : Determines the applicable handler(s) and sets up the core calling frame. Then calls the core frame. INPUTS : Caller's space for storing the result of the handler(s) RETURNS : Nothing useful SIDE EFFECTS : Any side-effects caused by the execution of handlers in the core framework NOTES : H/L Syntax : (send *) ***********************************************************************/ globle void SendCommand( void *theEnv, DATA_OBJECT *result) { EXPRESSION args; SYMBOL_HN *msg; DATA_OBJECT temp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"send",2,SYMBOL,&temp) == FALSE) return; msg = (SYMBOL_HN *) temp.value; /* ============================================= Get the instance or primitive for the message ============================================= */ args.type = GetFirstArgument()->type; args.value = GetFirstArgument()->value; args.argList = GetFirstArgument()->argList; args.nextArg = GetFirstArgument()->nextArg->nextArg; PerformMessage(theEnv,result,&args,msg); } /*************************************************** NAME : GetNthMessageArgument DESCRIPTION : Returns the address of the nth (starting at 1) which is an argument of the current message dispatch INPUTS : None RETURNS : The message argument SIDE EFFECTS : None NOTES : The active instance is always stored as the first argument (0) in the call frame of the message ***************************************************/ globle DATA_OBJECT *GetNthMessageArgument( void *theEnv, int n) { return(&ProceduralPrimitiveData(theEnv)->ProcParamArray[n]); } /***************************************************** NAME : NextHandlerAvailable DESCRIPTION : Determines if there the currently executing handler can call a shadowed handler Used before calling call-next-handler INPUTS : None RETURNS : TRUE if shadow ready, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax: (next-handlerp) *****************************************************/ globle int NextHandlerAvailable( void *theEnv) { if (MessageHandlerData(theEnv)->CurrentCore == NULL) return(FALSE); if (MessageHandlerData(theEnv)->CurrentCore->hnd->type == MAROUND) return((MessageHandlerData(theEnv)->NextInCore != NULL) ? TRUE : FALSE); if ((MessageHandlerData(theEnv)->CurrentCore->hnd->type == MPRIMARY) && (MessageHandlerData(theEnv)->NextInCore != NULL)) return((MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) ? TRUE : FALSE); return(FALSE); } /******************************************************** NAME : CallNextHandler DESCRIPTION : This function allows around-handlers to execute the rest of the core frame. It also allows primary handlers to execute shadowed primaries. The original handler arguments are left intact. INPUTS : The caller's result-value buffer RETURNS : Nothing useful SIDE EFFECTS : The core frame is called and any appropriate changes are made when used in an around handler See CallHandlers() But when call-next-handler is called from a primary, the same shadowed primary is called over and over again for repeated calls to call-next-handler. NOTES : H/L Syntax: (call-next-handler) OR (override-next-handler ...) ********************************************************/ globle void CallNextHandler( void *theEnv, DATA_OBJECT *result) { EXPRESSION args; int overridep; HANDLER_LINK *oldNext,*oldCurrent; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; if (NextHandlerAvailable(theEnv) == FALSE) { PrintErrorID(theEnv,"MSGPASS",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Shadowed message-handlers not applicable in current context.\n"); SetEvaluationError(theEnv,TRUE); return; } if (EvaluationData(theEnv)->CurrentExpression->value == (void *) FindFunction(theEnv,"override-next-handler")) { overridep = 1; args.type = ProceduralPrimitiveData(theEnv)->ProcParamArray[0].type; if (args.type != MULTIFIELD) args.value = (void *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value; else args.value = (void *) &ProceduralPrimitiveData(theEnv)->ProcParamArray[0]; args.nextArg = GetFirstArgument(); args.argList = NULL; PushProcParameters(theEnv,&args,CountArguments(&args), ValueToString(MessageHandlerData(theEnv)->CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationData(theEnv)->EvaluationError) { ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; return; } } else overridep = 0; oldNext = MessageHandlerData(theEnv)->NextInCore; oldCurrent = MessageHandlerData(theEnv)->CurrentCore; if (MessageHandlerData(theEnv)->CurrentCore->hnd->type == MAROUND) { if (MessageHandlerData(theEnv)->NextInCore->hnd->type == MAROUND) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif } else CallHandlers(theEnv,result); } else { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif } MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; if (overridep) PopProcParameters(theEnv); ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; } /************************************************************************* NAME : FindApplicableOfName DESCRIPTION : Groups all handlers of all types of the specified class of the specified name into the applicable handler list INPUTS : 1) The class address 2-3) The tops and bottoms of the four handler type lists: around, before, primary and after 4) The message name symbol RETURNS : Nothing useful SIDE EFFECTS : Modifies the handler lists to include applicable handlers NOTES : None *************************************************************************/ globle void FindApplicableOfName( void *theEnv, DEFCLASS *cls, HANDLER_LINK *tops[4], HANDLER_LINK *bots[4], SYMBOL_HN *mname) { register int i; register int e; HANDLER *hnd; unsigned *arr; HANDLER_LINK *tmp; i = FindHandlerNameGroup(cls,mname); if (i == -1) return; e = ((int) cls->handlerCount) - 1; hnd = cls->handlers; arr = cls->handlerOrderMap; for ( ; i <= e ; i++) { if (hnd[arr[i]].name != mname) break; tmp = get_struct(theEnv,messageHandlerLink); hnd[arr[i]].busy++; IncrementDefclassBusyCount(theEnv,(void *) hnd[arr[i]].cls); tmp->hnd = &hnd[arr[i]]; if (tops[tmp->hnd->type] == NULL) { tmp->nxt = NULL; tops[tmp->hnd->type] = bots[tmp->hnd->type] = tmp; } else if (tmp->hnd->type == MAFTER) { tmp->nxt = tops[tmp->hnd->type]; tops[tmp->hnd->type] = tmp; } else { bots[tmp->hnd->type]->nxt = tmp; bots[tmp->hnd->type] = tmp; tmp->nxt = NULL; } } } /************************************************************************* NAME : JoinHandlerLinks DESCRIPTION : Joins the queues of different handlers together INPUTS : 1-2) The tops and bottoms of the four handler type lists: around, before, primary and after 3) The message name symbol RETURNS : The top of the joined lists, NULL on errors SIDE EFFECTS : Links all the handler type lists together, or all the lists are destroyed if there are no primary handlers NOTES : None *************************************************************************/ globle HANDLER_LINK *JoinHandlerLinks( void *theEnv, HANDLER_LINK *tops[4], HANDLER_LINK *bots[4], SYMBOL_HN *mname) { register int i; HANDLER_LINK *mlink; if (tops[MPRIMARY] == NULL) { PrintNoHandlerError(theEnv,ValueToString(mname)); for (i = MAROUND ; i <= MAFTER ; i++) DestroyHandlerLinks(theEnv,tops[i]); SetEvaluationError(theEnv,TRUE); return(NULL); } mlink = tops[MPRIMARY]; if (tops[MBEFORE] != NULL) { bots[MBEFORE]->nxt = mlink; mlink = tops[MBEFORE]; } if (tops[MAROUND] != NULL) { bots[MAROUND]->nxt = mlink; mlink = tops[MAROUND]; } bots[MPRIMARY]->nxt = tops[MAFTER]; return(mlink); } /*************************************************** NAME : PrintHandlerSlotGetFunction DESCRIPTION : Developer access function for printing direct slot references in message-handlers INPUTS : 1) The logical name of the output 2) The bitmap expression RETURNS : Nothing useful SIDE EFFECTS : Expression printed NOTES : None ***************************************************/ globle void PrintHandlerSlotGetFunction( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; SLOT_DESC *sd; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"?self:["); theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name)); EnvPrintRouter(theEnv,logicalName,"]"); sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID] - 1]; EnvPrintRouter(theEnv,logicalName,ValueToString(sd->slotName->name)); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************************** NAME : HandlerSlotGetFunction DESCRIPTION : Access function for handling the statically-bound direct slot references in message-handlers INPUTS : 1) The bitmap expression 2) A data object buffer RETURNS : TRUE if OK, FALSE on errors SIDE EFFECTS : Data object buffer gets value of slot. On errors, buffer gets symbol FALSE, EvaluationError is set and error messages are printed NOTES : It is possible for a handler (attached to a superclass of the currently active instance) containing these static references to be called for an instance which does not contain the slots (e.g., an instance of a subclass where the original slot was no-inherit or the subclass overrode the original slot) ***************************************************/ globle intBool HandlerSlotGetFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; INSTANCE_TYPE *theInstance; INSTANCE_SLOT *sp; unsigned instanceSlotIndex; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); theInstance = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value; theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; if (theInstance->garbage) { StaleInstanceAddress(theEnv,"for slot get",0); theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (theInstance->cls == theDefclass) { instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; sp = theInstance->slotAddresses[instanceSlotIndex - 1]; } else { if (theReference->slotID > theInstance->cls->maxSlotNameID) goto HandlerGetError; instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; if (instanceSlotIndex == 0) goto HandlerGetError; instanceSlotIndex--; sp = theInstance->slotAddresses[instanceSlotIndex]; if (sp->desc->cls != theDefclass) goto HandlerGetError; } theResult->type = (unsigned short) sp->type; theResult->value = sp->value; if (sp->type == MULTIFIELD) { theResult->begin = 0; SetpDOEnd(theResult,GetInstanceSlotLength(sp)); } return(TRUE); HandlerGetError: EarlySlotBindError(theEnv,theInstance,theDefclass,theReference->slotID); theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*************************************************** NAME : PrintHandlerSlotPutFunction DESCRIPTION : Developer access function for printing direct slot bindings in message-handlers INPUTS : 1) The logical name of the output 2) The bitmap expression RETURNS : Nothing useful SIDE EFFECTS : Expression printed NOTES : None ***************************************************/ globle void PrintHandlerSlotPutFunction( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; SLOT_DESC *sd; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(bind ?self:["); theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name)); EnvPrintRouter(theEnv,logicalName,"]"); sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID] - 1]; EnvPrintRouter(theEnv,logicalName,ValueToString(sd->slotName->name)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logicalName," "); PrintExpression(theEnv,logicalName,GetFirstArgument()); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************************** NAME : HandlerSlotPutFunction DESCRIPTION : Access function for handling the statically-bound direct slot bindings in message-handlers INPUTS : 1) The bitmap expression 2) A data object buffer RETURNS : TRUE if OK, FALSE on errors SIDE EFFECTS : Data object buffer gets symbol TRUE and slot is set. On errors, buffer gets symbol FALSE, EvaluationError is set and error messages are printed NOTES : It is possible for a handler (attached to a superclass of the currently active instance) containing these static references to be called for an instance which does not contain the slots (e.g., an instance of a subclass where the original slot was no-inherit or the subclass overrode the original slot) ***************************************************/ globle intBool HandlerSlotPutFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; INSTANCE_TYPE *theInstance; INSTANCE_SLOT *sp; unsigned instanceSlotIndex; DATA_OBJECT theSetVal; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); theInstance = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value; theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; if (theInstance->garbage) { StaleInstanceAddress(theEnv,"for slot put",0); theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (theInstance->cls == theDefclass) { instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; sp = theInstance->slotAddresses[instanceSlotIndex - 1]; } else { if (theReference->slotID > theInstance->cls->maxSlotNameID) goto HandlerPutError; instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; if (instanceSlotIndex == 0) goto HandlerPutError; instanceSlotIndex--; sp = theInstance->slotAddresses[instanceSlotIndex]; if (sp->desc->cls != theDefclass) goto HandlerPutError; } /* ======================================================= The slot has already been verified not to be read-only. However, if it is initialize-only, we need to make sure that we are initializing the instance (something we could not verify at parse-time) ======================================================= */ if (sp->desc->initializeOnly && (!theInstance->initializeInProgress)) { SlotAccessViolationError(theEnv,ValueToString(sp->desc->slotName->name), TRUE,(void *) theInstance); goto HandlerPutError2; } /* ====================================== No arguments means to use the special NoParamValue to reset the slot to its default value ====================================== */ if (GetFirstArgument()) { if (EvaluateAndStoreInDataObject(theEnv,(int) sp->desc->multiple, GetFirstArgument(),&theSetVal,TRUE) == FALSE) goto HandlerPutError2; } else { SetDOBegin(theSetVal,1); SetDOEnd(theSetVal,0); SetType(theSetVal,MULTIFIELD); SetValue(theSetVal,ProceduralPrimitiveData(theEnv)->NoParamValue); } if (PutSlotValue(theEnv,theInstance,sp,&theSetVal,theResult,NULL) == FALSE) goto HandlerPutError2; return(TRUE); HandlerPutError: EarlySlotBindError(theEnv,theInstance,theDefclass,theReference->slotID); HandlerPutError2: theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /***************************************************** NAME : DynamicHandlerGetSlot DESCRIPTION : Directly references a slot's value (uses dynamic binding to lookup slot) INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set NOTES : H/L Syntax: (get ) *****************************************************/ globle void DynamicHandlerGetSlot( void *theEnv, DATA_OBJECT *result) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; DATA_OBJECT temp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (CheckCurrentMessage(theEnv,"dynamic-get",TRUE) == FALSE) return; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"dynamic-get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } ins = GetActiveInstance(theEnv); sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"dynamic-get"); return; } if ((sp->desc->publicVisibility == 0) && (MessageHandlerData(theEnv)->CurrentCore->hnd->cls != sp->desc->cls)) { SlotVisibilityViolationError(theEnv,sp->desc,MessageHandlerData(theEnv)->CurrentCore->hnd->cls); SetEvaluationError(theEnv,TRUE); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } } /*********************************************************** NAME : DynamicHandlerPutSlot DESCRIPTION : Directly puts a slot's value (uses dynamic binding to lookup slot) INPUTS : Data obejct buffer for holding slot value RETURNS : Nothing useful SIDE EFFECTS : Slot modified - and caller's buffer set to value (or symbol FALSE on errors) NOTES : H/L Syntax: (put *) ***********************************************************/ globle void DynamicHandlerPutSlot( void *theEnv, DATA_OBJECT *theResult) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; DATA_OBJECT temp; theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); if (CheckCurrentMessage(theEnv,"dynamic-put",TRUE) == FALSE) return; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"dynamic-put",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } ins = GetActiveInstance(theEnv); sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"dynamic-put"); return; } if ((sp->desc->noWrite == 0) ? FALSE : ((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress))) { SlotAccessViolationError(theEnv,ValueToString(sp->desc->slotName->name), TRUE,(void *) ins); SetEvaluationError(theEnv,TRUE); return; } if ((sp->desc->publicVisibility == 0) && (MessageHandlerData(theEnv)->CurrentCore->hnd->cls != sp->desc->cls)) { SlotVisibilityViolationError(theEnv,sp->desc,MessageHandlerData(theEnv)->CurrentCore->hnd->cls); SetEvaluationError(theEnv,TRUE); return; } if (GetFirstArgument()->nextArg) { if (EvaluateAndStoreInDataObject(theEnv,(int) sp->desc->multiple, GetFirstArgument()->nextArg,&temp,TRUE) == FALSE) return; } else { SetpDOBegin(&temp,1); SetpDOEnd(&temp,0); SetpType(&temp,MULTIFIELD); SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue); } PutSlotValue(theEnv,ins,sp,&temp,theResult,NULL); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : PerformMessage DESCRIPTION : Calls core framework for a message INPUTS : 1) Caller's result buffer 2) Message argument expressions (including implicit object) 3) Message name RETURNS : Returns FALSE is an execution error occurred or execution is halted, otherwise TRUE SIDE EFFECTS : Any side-effects of message execution and caller's result buffer set NOTES : It's no longer necessary for a defclass to be in scope in order to sent a message to an instance of that class. *****************************************************/ static intBool PerformMessage( void *theEnv, DATA_OBJECT *result, EXPRESSION *args, SYMBOL_HN *mname) { int oldce; /* HANDLER_LINK *oldCore; */ DEFCLASS *cls = NULL; INSTANCE_TYPE *ins = NULL; SYMBOL_HN *oldName; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif struct garbageFrame newGarbageFrame; struct garbageFrame *oldGarbageFrame; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return FALSE; oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame; memset(&newGarbageFrame,0,sizeof(struct garbageFrame)); UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); oldName = MessageHandlerData(theEnv)->CurrentMessageName; MessageHandlerData(theEnv)->CurrentMessageName = mname; EvaluationData(theEnv)->CurrentEvaluationDepth++; PushProcParameters(theEnv,args,CountArguments(args), ValueToString(MessageHandlerData(theEnv)->CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationData(theEnv)->EvaluationError) { EvaluationData(theEnv)->CurrentEvaluationDepth--; MessageHandlerData(theEnv)->CurrentMessageName = oldName; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return FALSE; } if (ProceduralPrimitiveData(theEnv)->ProcParamArray->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,"send",0); SetEvaluationError(theEnv,TRUE); } //else if (DefclassInScope(theEnv,ins->cls,(struct defmodule *) EnvGetCurrentModule(theEnv)) == FALSE) // NoInstanceError(theEnv,ValueToString(ins->name),"send"); else { cls = ins->cls; ins->busy++; } } else if (ProceduralPrimitiveData(theEnv)->ProcParamArray->type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value); if (ins == NULL) { PrintErrorID(theEnv,"MSGPASS",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No such instance "); EnvPrintRouter(theEnv,WERROR,ValueToString((SYMBOL_HN *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value)); EnvPrintRouter(theEnv,WERROR," in function send.\n"); SetEvaluationError(theEnv,TRUE); } else { ProceduralPrimitiveData(theEnv)->ProcParamArray->value = (void *) ins; ProceduralPrimitiveData(theEnv)->ProcParamArray->type = INSTANCE_ADDRESS; cls = ins->cls; ins->busy++; } } else if ((cls = DefclassData(theEnv)->PrimitiveClassMap[ProceduralPrimitiveData(theEnv)->ProcParamArray->type]) == NULL) { SystemError(theEnv,"MSGPASS",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (EvaluationData(theEnv)->EvaluationError) { PopProcParameters(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth--; MessageHandlerData(theEnv)->CurrentMessageName = oldName; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return FALSE; } /* oldCore = MessageHandlerData(theEnv)->TopOfCore; */ if (MessageHandlerData(theEnv)->TopOfCore != NULL) { MessageHandlerData(theEnv)->TopOfCore->nxtInStack = MessageHandlerData(theEnv)->OldCore; } MessageHandlerData(theEnv)->OldCore = MessageHandlerData(theEnv)->TopOfCore; MessageHandlerData(theEnv)->TopOfCore = FindApplicableHandlers(theEnv,cls,mname); if (MessageHandlerData(theEnv)->TopOfCore != NULL) { HANDLER_LINK *oldCurrent,*oldNext; oldCurrent = MessageHandlerData(theEnv)->CurrentCore; oldNext = MessageHandlerData(theEnv)->NextInCore; if (MessageHandlerData(theEnv)->TopOfCore->hnd->type == MAROUND) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->TopOfCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->TopOfCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,BEGIN_TRACE); if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,END_TRACE); #endif } else { MessageHandlerData(theEnv)->CurrentCore = NULL; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->TopOfCore; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,BEGIN_TRACE); #endif CallHandlers(theEnv,result); #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,END_TRACE); #endif } DestroyHandlerLinks(theEnv,MessageHandlerData(theEnv)->TopOfCore); MessageHandlerData(theEnv)->CurrentCore = oldCurrent; MessageHandlerData(theEnv)->NextInCore = oldNext; } /* MessageHandlerData(theEnv)->TopOfCore = oldCore; */ MessageHandlerData(theEnv)->TopOfCore = MessageHandlerData(theEnv)->OldCore; if (MessageHandlerData(theEnv)->OldCore != NULL) { MessageHandlerData(theEnv)->OldCore = MessageHandlerData(theEnv)->OldCore->nxtInStack; } ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if (ins != NULL) ins->busy--; /* ================================== Restore the original calling frame ================================== */ PopProcParameters(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth--; MessageHandlerData(theEnv)->CurrentMessageName = oldName; RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); if (EvaluationData(theEnv)->EvaluationError) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return FALSE; } return TRUE; } /***************************************************************************** NAME : FindApplicableHandlers DESCRIPTION : Given a message name, this routine forms the "core frame" for the message : a list of all applicable class handlers. An applicable class handler is one whose name matches the message and whose class matches the instance. The list is in the following order : All around handlers (from most specific to most general) All before handlers (from most specific to most general) All primary handlers (from most specific to most general) All after handlers (from most general to most specific) INPUTS : 1) The class of the instance (or primitive) for the message 2) The message name RETURNS : NULL if no applicable handlers or errors, the list of handlers otherwise SIDE EFFECTS : Links are allocated for the list NOTES : The instance is the first thing on the ProcParamArray The number of arguments is in ProcParamArraySize *****************************************************************************/ static HANDLER_LINK *FindApplicableHandlers( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname) { register int i; HANDLER_LINK *tops[4],*bots[4]; for (i = MAROUND ; i <= MAFTER ; i++) tops[i] = bots[i] = NULL; for (i = 0 ; i < cls->allSuperclasses.classCount ; i++) FindApplicableOfName(theEnv,cls->allSuperclasses.classArray[i],tops,bots,mname); return(JoinHandlerLinks(theEnv,tops,bots,mname)); } /*************************************************************** NAME : CallHandlers DESCRIPTION : Moves though the current message frame for a send-message as follows : Call all before handlers and ignore their return values. Call the first primary handler and ignore the rest. The return value of the handler frame is this message's value. Call all after handlers and ignore their return values. INPUTS : Caller's buffer for the return value of the message RETURNS : Nothing useful SIDE EFFECTS : The handlers are evaluated. NOTES : IMPORTANT : The global NextInCore should be pointing to the first handler to be executed. ***************************************************************/ static void CallHandlers( void *theEnv, DATA_OBJECT *result) { HANDLER_LINK *oldCurrent = NULL,*oldNext = NULL; /* prevents warning */ DATA_OBJECT temp; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif if (EvaluationData(theEnv)->HaltExecution) return; oldCurrent = MessageHandlerData(theEnv)->CurrentCore; oldNext = MessageHandlerData(theEnv)->NextInCore; while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MBEFORE) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, &temp,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } } if (MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) { MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; if (MessageHandlerData(theEnv)->NextInCore == NULL) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } } } while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MAFTER) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, &temp,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } } MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; } /******************************************************** NAME : EarlySlotBindError DESCRIPTION : Prints out an error message when a message-handler from a superclass which contains a static-bind slot access is not valid for the currently active instance (i.e. the instance is not using the superclass's slot) INPUTS : 1) The currently active instance 2) The defclass holding the invalid slot 3) The canonical id of the slot RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ********************************************************/ static void EarlySlotBindError( void *theEnv, INSTANCE_TYPE *theInstance, DEFCLASS *theDefclass, unsigned slotID) { SLOT_DESC *sd; sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[slotID] - 1]; PrintErrorID(theEnv,"MSGPASS",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Static reference to slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sd->slotName->name)); EnvPrintRouter(theEnv,WERROR," of class "); PrintClassName(theEnv,WERROR,theDefclass,FALSE); EnvPrintRouter(theEnv,WERROR," does not apply to "); PrintInstanceNameAndClass(theEnv,WERROR,theInstance,TRUE); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void Send( DATA_OBJECT *idata, const char *msg, const char *args, DATA_OBJECT *result) { EnvSend(GetCurrentEnvironment(),idata,msg,args,result); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* OBJECT_SYSTEM */ clips_core_source_630/core/symblcmp.h0000755000175000017500000000541512373755525016253 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* SYMBOL CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* atomic data values: symbols, integers, floats, and */ /* bit maps. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_symblcmp #define _H_symblcmp #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SYMBLCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PrintSymbolReference(void *,FILE *,SYMBOL_HN *); LOCALE void PrintFloatReference(void *,FILE *,FLOAT_HN *); LOCALE void PrintIntegerReference(void *,FILE *,INTEGER_HN *); LOCALE void PrintBitMapReference(void *,FILE *,BITMAP_HN *); LOCALE void AtomicValuesToCode(void *,const char *,const char *,char *); #endif /* _H_symblcmp */ clips_core_source_630/core/._prcdrfun.c0000755000175000017500000000040712373743663016454 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulecom.h0000755000175000017500000001275112374672752016075 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFRULE COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the matches command. Also provides the */ /* the developer commands show-joins and rule-complexity. */ /* Also provides the initialization routine which */ /* registers rule commands found in other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* INCREMENTAL_RESET, and LOGICAL_DEPENDENCIES */ /* compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added support for hashed memories. */ /* */ /* Improvements to matches command. */ /* */ /* Add join-activity and join-activity-reset */ /* commands. */ /* */ /* Added get-beta-memory-resizing and */ /* set-beta-memory-resizing functions. */ /* */ /* Added timetag function. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_rulecom #define _H_rulecom #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULECOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct joinInformation { int whichCE; struct joinNode *theJoin; int patternBegin; int patternEnd; int marked; struct betaMemory *theMemory; struct joinNode *nextJoin; }; #define VERBOSE 0 #define SUCCINCT 1 #define TERSE 2 LOCALE intBool EnvGetBetaMemoryResizing(void *); LOCALE intBool EnvSetBetaMemoryResizing(void *,intBool); LOCALE int GetBetaMemoryResizingCommand(void *); LOCALE int SetBetaMemoryResizingCommand(void *); LOCALE void EnvMatches(void *,void *,int,DATA_OBJECT *); LOCALE void EnvJoinActivity(void *,void *,int,DATA_OBJECT *); LOCALE void DefruleCommands(void *); LOCALE void MatchesCommand(void *,DATA_OBJECT *); LOCALE void JoinActivityCommand(void *,DATA_OBJECT *); LOCALE long long TimetagFunction(void *); LOCALE long EnvAlphaJoinCount(void *,void *); LOCALE long EnvBetaJoinCount(void *,void *); LOCALE struct joinInformation *EnvCreateJoinArray(void *,long); LOCALE void EnvFreeJoinArray(void *,struct joinInformation *,long); LOCALE void EnvAlphaJoins(void *,void *,long,struct joinInformation *); LOCALE void EnvBetaJoins(void *,void *,long,struct joinInformation *); LOCALE void JoinActivityResetCommand(void *); #if DEVELOPER LOCALE void ShowJoinsCommand(void *); LOCALE long RuleComplexityCommand(void *); LOCALE void ShowAlphaHashTable(void *); #endif #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS LOCALE void Matches(void *,int,DATA_OBJECT *); LOCALE void JoinActivity(void *,int,DATA_OBJECT *); #endif LOCALE intBool GetBetaMemoryResizing(void); LOCALE intBool SetBetaMemoryResizing(int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_rulecom */ clips_core_source_630/core/genrcfun.h0000755000175000017500000001517712424473411016226 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when DEBUGGING_FUNCTIONS */ /* is set to 0 and PROFILING_FUNCTIONS is set to */ /* 1. */ /* */ /* Fixed typing issue when OBJECT_SYSTEM */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #ifndef _H_genrcfun #define _H_genrcfun typedef struct defgenericModule DEFGENERIC_MODULE; typedef struct restriction RESTRICTION; typedef struct method DEFMETHOD; typedef struct defgeneric DEFGENERIC; #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #if OBJECT_SYSTEM #ifndef _H_object #include "object.h" #endif #endif struct defgenericModule { struct defmoduleItemHeader header; }; struct restriction { void **types; EXPRESSION *query; short tcnt; }; struct method { short index; unsigned busy; short restrictionCount; short minRestrictions; short maxRestrictions; short localVarCount; unsigned system : 1; unsigned trace : 1; RESTRICTION *restrictions; EXPRESSION *actions; char *ppForm; struct userData *usrData; }; struct defgeneric { struct constructHeader header; unsigned busy,trace; DEFMETHOD *methods; short mcnt; short new_index; }; #define DEFGENERIC_DATA 27 struct defgenericData { struct construct *DefgenericConstruct; int DefgenericModuleIndex; ENTITY_RECORD GenericEntityRecord; #if DEBUGGING_FUNCTIONS unsigned WatchGenerics; unsigned WatchMethods; #endif DEFGENERIC *CurrentGeneric; DEFMETHOD *CurrentMethod; DATA_OBJECT *GenericCurrentArgument; #if (! RUN_TIME) && (! BLOAD_ONLY) unsigned OldGenericBusySave; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefgenericCodeItem; #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct token GenericInputToken; #endif }; #define DefgenericData(theEnv) ((struct defgenericData *) GetEnvironmentData(theEnv,DEFGENERIC_DATA)) #define SaveBusyCount(gfunc) (DefgenericData(theEnv)->OldGenericBusySave = gfunc->busy) #define RestoreBusyCount(gfunc) (gfunc->busy = DefgenericData(theEnv)->OldGenericBusySave) #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ! RUN_TIME LOCALE intBool ClearDefgenericsReady(void *); LOCALE void *AllocateDefgenericModule(void *); LOCALE void FreeDefgenericModule(void *,void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int ClearDefmethods(void *); LOCALE int RemoveAllExplicitMethods(void *,DEFGENERIC *); LOCALE void RemoveDefgeneric(void *,void *); LOCALE int ClearDefgenerics(void *); LOCALE void MethodAlterError(void *,DEFGENERIC *); LOCALE void DeleteMethodInfo(void *,DEFGENERIC *,DEFMETHOD *); LOCALE void DestroyMethodInfo(void *,DEFGENERIC *,DEFMETHOD *); LOCALE int MethodsExecuting(DEFGENERIC *); #endif #if ! OBJECT_SYSTEM LOCALE intBool SubsumeType(int,int); #endif LOCALE long FindMethodByIndex(DEFGENERIC *,long); #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS LOCALE void PrintMethod(void *,char *,size_t,DEFMETHOD *); #endif #if DEBUGGING_FUNCTIONS LOCALE void PreviewGeneric(void *); #endif LOCALE DEFGENERIC *CheckGenericExists(void *,const char *,const char *); LOCALE long CheckMethodExists(void *,const char *,DEFGENERIC *,long); #if ! OBJECT_SYSTEM LOCALE const char *TypeName(void *,int); #endif LOCALE void PrintGenericName(void *,const char *,DEFGENERIC *); #endif /* _H_genrcfun */ clips_core_source_630/core/moduldef.c0000755000175000017500000007067712424473405016222 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* DEFMODULE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defmodule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defmodule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _MODULDEF_SOURCE_ #include "setup.h" #include #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "constant.h" #include "router.h" #include "extnfunc.h" #include "argacces.h" #include "constrct.h" #include "modulpsr.h" #include "modulcmp.h" #include "modulbsc.h" #include "utility.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "modulbin.h" #endif #include "moduldef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) static void ReturnDefmodule(void *,struct defmodule *,intBool); #endif static void DeallocateDefmoduleData(void *); /**************************************************************/ /* InitializeDefmodules: Initializes the defmodule construct. */ /**************************************************************/ globle void AllocateDefmoduleGlobals( void *theEnv) { AllocateEnvironmentData(theEnv,DEFMODULE_DATA,sizeof(struct defmoduleData),NULL); AddEnvironmentCleanupFunction(theEnv,"defmodules",DeallocateDefmoduleData,-1000); DefmoduleData(theEnv)->CallModuleChangeFunctions = TRUE; DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; } /****************************************************/ /* DeallocateDefmoduleData: Deallocates environment */ /* data for the defmodule construct. */ /****************************************************/ static void DeallocateDefmoduleData( void *theEnv) { struct moduleStackItem *tmpMSPtr, *nextMSPtr; struct moduleItem *tmpMIPtr, *nextMIPtr; #if (! RUN_TIME) && (! BLOAD_ONLY) struct defmodule *tmpDMPtr, *nextDMPtr; struct portConstructItem *tmpPCPtr, *nextPCPtr; #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) int i; size_t space; #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) for (i = 0; i < DefmoduleData(theEnv)->BNumberOfDefmodules; i++) { if (DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray != NULL) { rm(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray, sizeof(void *) * GetNumberOfModuleItems(theEnv)); } } space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule); if (space != 0) { genfree(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray,space); DefmoduleData(theEnv)->ListOfDefmodules = NULL; } space = DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem); if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->PortItemArray,space); #endif #if (! RUN_TIME) && (! BLOAD_ONLY) tmpDMPtr = DefmoduleData(theEnv)->ListOfDefmodules; while (tmpDMPtr != NULL) { nextDMPtr = tmpDMPtr->next; ReturnDefmodule(theEnv,tmpDMPtr,TRUE); tmpDMPtr = nextDMPtr; } tmpPCPtr = DefmoduleData(theEnv)->ListOfPortConstructItems; while (tmpPCPtr != NULL) { nextPCPtr = tmpPCPtr->next; rtn_struct(theEnv,portConstructItem,tmpPCPtr); tmpPCPtr = nextPCPtr; } #endif tmpMSPtr = DefmoduleData(theEnv)->ModuleStack; while (tmpMSPtr != NULL) { nextMSPtr = tmpMSPtr->next; rtn_struct(theEnv,moduleStackItem,tmpMSPtr); tmpMSPtr = nextMSPtr; } tmpMIPtr = DefmoduleData(theEnv)->ListOfModuleItems; while (tmpMIPtr != NULL) { nextMIPtr = tmpMIPtr->next; rtn_struct(theEnv,moduleItem,tmpMIPtr); tmpMIPtr = nextMIPtr; } #if (! RUN_TIME) && (! BLOAD_ONLY) DeallocateCallList(theEnv,DefmoduleData(theEnv)->AfterModuleDefinedFunctions); #endif DeallocateCallList(theEnv,DefmoduleData(theEnv)->AfterModuleChangeFunctions); } /**************************************************************/ /* InitializeDefmodules: Initializes the defmodule construct. */ /**************************************************************/ globle void InitializeDefmodules( void *theEnv) { DefmoduleBasicCommands(theEnv); #if (! RUN_TIME) CreateMainModule(theEnv); #endif #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) AddConstruct(theEnv,"defmodule","defmodules",ParseDefmodule,NULL,NULL,NULL,NULL, NULL,NULL,NULL,NULL,NULL); #endif #if (! RUN_TIME) && DEFMODULE_CONSTRUCT EnvDefineFunction2(theEnv,"get-current-module", 'w', PTIEF GetCurrentModuleCommand, "GetCurrentModuleCommand", "00"); EnvDefineFunction2(theEnv,"set-current-module", 'w', PTIEF SetCurrentModuleCommand, "SetCurrentModuleCommand", "11w"); #endif } /******************************************************/ /* RegisterModuleItem: Called to register a construct */ /* which can be placed within a module. */ /******************************************************/ globle int RegisterModuleItem( void *theEnv, const char *theItem, void *(*allocateFunction)(void *), void (*freeFunction)(void *,void *), void *(*bloadModuleReference)(void *,int), void (*constructsToCModuleReference)(void *,FILE *,int,int,int), void *(*findFunction)(void *,const char *)) { struct moduleItem *newModuleItem; newModuleItem = get_struct(theEnv,moduleItem); newModuleItem->name = theItem; newModuleItem->allocateFunction = allocateFunction; newModuleItem->freeFunction = freeFunction; newModuleItem->bloadModuleReference = bloadModuleReference; newModuleItem->constructsToCModuleReference = constructsToCModuleReference; newModuleItem->findFunction = findFunction; newModuleItem->moduleIndex = DefmoduleData(theEnv)->NumberOfModuleItems++; newModuleItem->next = NULL; if (DefmoduleData(theEnv)->LastModuleItem == NULL) { DefmoduleData(theEnv)->ListOfModuleItems = newModuleItem; DefmoduleData(theEnv)->LastModuleItem = newModuleItem; } else { DefmoduleData(theEnv)->LastModuleItem->next = newModuleItem; DefmoduleData(theEnv)->LastModuleItem = newModuleItem; } return(newModuleItem->moduleIndex); } /***********************************************************/ /* GetListOfModuleItems: Returns the list of module items. */ /***********************************************************/ globle struct moduleItem *GetListOfModuleItems( void *theEnv) { return (DefmoduleData(theEnv)->ListOfModuleItems); } /***************************************************************/ /* GetNumberOfModuleItems: Returns the number of module items. */ /***************************************************************/ globle int GetNumberOfModuleItems( void *theEnv) { return (DefmoduleData(theEnv)->NumberOfModuleItems); } /********************************************************/ /* FindModuleItem: Finds the module item data structure */ /* corresponding to the specified name. */ /********************************************************/ globle struct moduleItem *FindModuleItem( void *theEnv, const char *theName) { struct moduleItem *theModuleItem; for (theModuleItem = DefmoduleData(theEnv)->ListOfModuleItems; theModuleItem != NULL; theModuleItem = theModuleItem->next) { if (strcmp(theModuleItem->name,theName) == 0) return(theModuleItem); } return(NULL); } /******************************************/ /* EnvGetCurrentModule: Returns a pointer */ /* to the current module. */ /******************************************/ globle void *EnvGetCurrentModule( void *theEnv) { return ((void *) DefmoduleData(theEnv)->CurrentModule); } /**************************************************************/ /* EnvSetCurrentModule: Sets the value of the current module. */ /**************************************************************/ globle void *EnvSetCurrentModule( void *theEnv, void *vNewValue) { struct defmodule *newValue = (struct defmodule *) vNewValue; struct callFunctionItem *changeFunctions; void *rv; /*=============================================*/ /* Change the current module to the specified */ /* module and save the previous current module */ /* for the return value. */ /*=============================================*/ rv = (void *) DefmoduleData(theEnv)->CurrentModule; DefmoduleData(theEnv)->CurrentModule = newValue; /*==========================================================*/ /* Call the list of registered functions that need to know */ /* when the module has changed. The module change functions */ /* should only be called if this is a "real" module change. */ /* Many routines temporarily change the module to look for */ /* constructs, etc. The SaveCurrentModule function will */ /* disable the change functions from being called. */ /*==========================================================*/ if (DefmoduleData(theEnv)->CallModuleChangeFunctions) { DefmoduleData(theEnv)->ModuleChangeIndex++; changeFunctions = DefmoduleData(theEnv)->AfterModuleChangeFunctions; while (changeFunctions != NULL) { (* (void (*)(void *)) changeFunctions->func)(theEnv); changeFunctions = changeFunctions->next; } } /*=====================================*/ /* Return the previous current module. */ /*=====================================*/ return(rv); } /********************************************************/ /* SaveCurrentModule: Saves current module on stack and */ /* prevents SetCurrentModule() from calling change */ /* functions */ /********************************************************/ globle void SaveCurrentModule( void *theEnv) { MODULE_STACK_ITEM *tmp; tmp = get_struct(theEnv,moduleStackItem); tmp->changeFlag = DefmoduleData(theEnv)->CallModuleChangeFunctions; DefmoduleData(theEnv)->CallModuleChangeFunctions = FALSE; tmp->theModule = DefmoduleData(theEnv)->CurrentModule; tmp->next = DefmoduleData(theEnv)->ModuleStack; DefmoduleData(theEnv)->ModuleStack = tmp; } /**********************************************************/ /* RestoreCurrentModule: Restores saved module and resets */ /* ability of SetCurrentModule() to call changed */ /* functions to previous state */ /**********************************************************/ globle void RestoreCurrentModule( void *theEnv) { MODULE_STACK_ITEM *tmp; tmp = DefmoduleData(theEnv)->ModuleStack; DefmoduleData(theEnv)->ModuleStack = tmp->next; DefmoduleData(theEnv)->CallModuleChangeFunctions = tmp->changeFlag; DefmoduleData(theEnv)->CurrentModule = tmp->theModule; rtn_struct(theEnv,moduleStackItem,tmp); } /*************************************************************/ /* GetModuleItem: Returns the data pointer for the specified */ /* module item in the specified module. If no module is */ /* indicated, then the module item for the current module */ /* is returned. */ /*************************************************************/ globle void *GetModuleItem( void *theEnv, struct defmodule *theModule, int moduleItemIndex) { if (theModule == NULL) { if (DefmoduleData(theEnv)->CurrentModule == NULL) return(NULL); theModule = DefmoduleData(theEnv)->CurrentModule; } if (theModule->itemsArray == NULL) return (NULL); return ((void *) theModule->itemsArray[moduleItemIndex]); } /************************************************************/ /* SetModuleItem: Sets the data pointer for the specified */ /* module item in the specified module. If no module is */ /* indicated, then the module item for the current module */ /* is returned. */ /************************************************************/ globle void SetModuleItem( void *theEnv, struct defmodule *theModule, int moduleItemIndex, void *newValue) { if (theModule == NULL) { if (DefmoduleData(theEnv)->CurrentModule == NULL) return; theModule = DefmoduleData(theEnv)->CurrentModule; } if (theModule->itemsArray == NULL) return; theModule->itemsArray[moduleItemIndex] = (struct defmoduleItemHeader *) newValue; } /******************************************************/ /* CreateMainModule: Creates the default MAIN module. */ /******************************************************/ globle void CreateMainModule( void *theEnv) { struct defmodule *newDefmodule; struct moduleItem *theItem; int i; struct defmoduleItemHeader *theHeader; /*=======================================*/ /* Allocate the defmodule data structure */ /* and name it the MAIN module. */ /*=======================================*/ newDefmodule = get_struct(theEnv,defmodule); newDefmodule->name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"MAIN"); IncrementSymbolCount(newDefmodule->name); newDefmodule->next = NULL; newDefmodule->ppForm = NULL; newDefmodule->importList = NULL; newDefmodule->exportList = NULL; newDefmodule->bsaveID = 0L; newDefmodule->usrData = NULL; /*==================================*/ /* Initialize the array for storing */ /* the module's construct lists. */ /*==================================*/ if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL; else { newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->allocateFunction == NULL) { newDefmodule->itemsArray[i] = NULL; } else { newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->allocateFunction)(theEnv); theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i]; theHeader->theModule = newDefmodule; theHeader->firstItem = NULL; theHeader->lastItem = NULL; } } } /*=======================================*/ /* Add the module to the list of modules */ /* and make it the current module. */ /*=======================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT SetNumberOfDefmodules(theEnv,1L); #endif DefmoduleData(theEnv)->LastDefmodule = newDefmodule; DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule; EnvSetCurrentModule(theEnv,(void *) newDefmodule); } /*********************************************************************/ /* SetListOfDefmodules: Sets the list of defmodules to the specified */ /* value. Normally used when initializing a run-time module or */ /* when bloading a binary file to install the list of defmodules. */ /*********************************************************************/ globle void SetListOfDefmodules( void *theEnv, void *defmodulePtr) { DefmoduleData(theEnv)->ListOfDefmodules = (struct defmodule *) defmodulePtr; DefmoduleData(theEnv)->LastDefmodule = DefmoduleData(theEnv)->ListOfDefmodules; if (DefmoduleData(theEnv)->LastDefmodule == NULL) return; while (DefmoduleData(theEnv)->LastDefmodule->next != NULL) DefmoduleData(theEnv)->LastDefmodule = DefmoduleData(theEnv)->LastDefmodule->next; } /********************************************************************/ /* EnvGetNextDefmodule: If passed a NULL pointer, returns the first */ /* defmodule in the ListOfDefmodules. Otherwise returns the next */ /* defmodule following the defmodule passed as an argument. */ /********************************************************************/ globle void *EnvGetNextDefmodule( void *theEnv, void *defmodulePtr) { if (defmodulePtr == NULL) { return((void *) DefmoduleData(theEnv)->ListOfDefmodules); } else { return((void *) (((struct defmodule *) defmodulePtr)->next)); } } /*****************************************/ /* EnvGetDefmoduleName: Returns the name */ /* of the specified defmodule. */ /*****************************************/ globle const char *EnvGetDefmoduleName( void *theEnv, void *defmodulePtr) { #if MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(((struct defmodule *) defmodulePtr)->name)); } /***************************************************/ /* EnvGetDefmodulePPForm: Returns the pretty print */ /* representation of the specified defmodule. */ /***************************************************/ globle const char *EnvGetDefmodulePPForm( void *theEnv, void *defmodulePtr) { #if MAC_XCD #pragma unused(theEnv) #endif return(((struct defmodule *) defmodulePtr)->ppForm); } #if (! RUN_TIME) /***********************************************/ /* RemoveAllDefmodules: Removes all defmodules */ /* from the current environment. */ /***********************************************/ globle void RemoveAllDefmodules( void *theEnv) { struct defmodule *nextDefmodule; while (DefmoduleData(theEnv)->ListOfDefmodules != NULL) { nextDefmodule = DefmoduleData(theEnv)->ListOfDefmodules->next; ReturnDefmodule(theEnv,DefmoduleData(theEnv)->ListOfDefmodules,FALSE); DefmoduleData(theEnv)->ListOfDefmodules = nextDefmodule; } DefmoduleData(theEnv)->CurrentModule = NULL; DefmoduleData(theEnv)->LastDefmodule = NULL; } /************************************************************/ /* ReturnDefmodule: Returns the data structures associated */ /* with a defmodule construct to the pool of free memory. */ /************************************************************/ static void ReturnDefmodule( void *theEnv, struct defmodule *theDefmodule, intBool environmentClear) { int i; struct moduleItem *theItem; struct portItem *theSpec, *nextSpec; /*=====================================================*/ /* Set the current module to the module being deleted. */ /*=====================================================*/ if (theDefmodule == NULL) return; if (! environmentClear) { EnvSetCurrentModule(theEnv,(void *) theDefmodule); } /*============================================*/ /* Call the free functions for the constructs */ /* belonging to this module. */ /*============================================*/ if (theDefmodule->itemsArray != NULL) { if (! environmentClear) { for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->freeFunction != NULL) { (*theItem->freeFunction)(theEnv,theDefmodule->itemsArray[i]); } } } rm(theEnv,theDefmodule->itemsArray,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); } /*======================================================*/ /* Decrement the symbol count for the defmodule's name. */ /*======================================================*/ if (! environmentClear) { DecrementSymbolCount(theEnv,theDefmodule->name); } /*====================================*/ /* Free the items in the import list. */ /*====================================*/ theSpec = theDefmodule->importList; while (theSpec != NULL) { nextSpec = theSpec->next; if (! environmentClear) { if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName); if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType); if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName); } rtn_struct(theEnv,portItem,theSpec); theSpec = nextSpec; } /*====================================*/ /* Free the items in the export list. */ /*====================================*/ theSpec = theDefmodule->exportList; while (theSpec != NULL) { nextSpec = theSpec->next; if (! environmentClear) { if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName); if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType); if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName); } rtn_struct(theEnv,portItem,theSpec); theSpec = nextSpec; } /*=========================================*/ /* Free the defmodule pretty print string. */ /*=========================================*/ if (theDefmodule->ppForm != NULL) { rm(theEnv,theDefmodule->ppForm, (int) sizeof(char) * (strlen(theDefmodule->ppForm) + 1)); } /*=======================*/ /* Return the user data. */ /*=======================*/ ClearUserDataList(theEnv,theDefmodule->usrData); /*======================================*/ /* Return the defmodule data structure. */ /*======================================*/ rtn_struct(theEnv,defmodule,theDefmodule); } #endif /* (! RUN_TIME) */ /**********************************************************************/ /* EnvFindDefmodule: Searches for a defmodule in the list of defmodules. */ /* Returns a pointer to the defmodule if found, otherwise NULL. */ /**********************************************************************/ globle void *EnvFindDefmodule( void *theEnv, const char *defmoduleName) { struct defmodule *defmodulePtr; SYMBOL_HN *findValue; if ((findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,defmoduleName)) == NULL) return(NULL); defmodulePtr = DefmoduleData(theEnv)->ListOfDefmodules; while (defmodulePtr != NULL) { if (defmodulePtr->name == findValue) { return((void *) defmodulePtr); } defmodulePtr = defmodulePtr->next; } return(NULL); } /*************************************************/ /* GetCurrentModuleCommand: H/L access routine */ /* for the get-current-module command. */ /*************************************************/ globle void *GetCurrentModuleCommand( void *theEnv) { struct defmodule *theModule; EnvArgCountCheck(theEnv,"get-current-module",EXACTLY,0); theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return((SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(theModule->name))); } /*************************************************/ /* SetCurrentModuleCommand: H/L access routine */ /* for the set-current-module command. */ /*************************************************/ globle void *SetCurrentModuleCommand( void *theEnv) { DATA_OBJECT argPtr; const char *argument; struct defmodule *theModule; SYMBOL_HN *defaultReturn; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); defaultReturn = (SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(((struct defmodule *) EnvGetCurrentModule(theEnv))->name)); if (EnvArgCountCheck(theEnv,"set-current-module",EXACTLY,1) == -1) { return(defaultReturn); } if (EnvArgTypeCheck(theEnv,"set-current-module",1,SYMBOL,&argPtr) == FALSE) { return(defaultReturn); } argument = DOToString(argPtr); /*================================================*/ /* Set the current module to the specified value. */ /*================================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument); return(defaultReturn); } EnvSetCurrentModule(theEnv,(void *) theModule); /*================================*/ /* Return the new current module. */ /*================================*/ return((SYMBOL_HN *) defaultReturn); } /*************************************************/ /* AddAfterModuleChangeFunction: Adds a function */ /* to the list of functions to be called after */ /* a module change occurs. */ /*************************************************/ globle void AddAfterModuleChangeFunction( void *theEnv, const char *name, void (*func)(void *), int priority) { DefmoduleData(theEnv)->AfterModuleChangeFunctions = AddFunctionToCallList(theEnv,name,priority,func,DefmoduleData(theEnv)->AfterModuleChangeFunctions,TRUE); } /************************************************/ /* IllegalModuleSpecifierMessage: Error message */ /* for the illegal use of a module specifier. */ /************************************************/ globle void IllegalModuleSpecifierMessage( void *theEnv) { PrintErrorID(theEnv,"MODULDEF",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Illegal use of the module specifier.\n"); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void *FindDefmodule( const char *defmoduleName) { return EnvFindDefmodule(GetCurrentEnvironment(),defmoduleName); } globle void *GetCurrentModule() { return EnvGetCurrentModule(GetCurrentEnvironment()); } globle const char *GetDefmoduleName( void *defmodulePtr) { return EnvGetDefmoduleName(GetCurrentEnvironment(),defmodulePtr); } globle const char *GetDefmodulePPForm( void *defmodulePtr) { return EnvGetDefmodulePPForm(GetCurrentEnvironment(),defmodulePtr); } globle void *GetNextDefmodule( void *defmodulePtr) { return EnvGetNextDefmodule(GetCurrentEnvironment(),defmodulePtr); } globle void *SetCurrentModule( void *vNewValue) { return EnvSetCurrentModule(GetCurrentEnvironment(),vNewValue); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/facthsh.c0000755000175000017500000003273412373742654016043 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT HASHING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for maintaining a fact hash */ /* table so that duplication of facts can quickly be */ /* determined. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Fact hash table is resizable. */ /* */ /* Changed integer type/precision. */ /* */ /* Added FactWillBeAsserted. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #define _FACTHSH_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include "constant.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "envrnmnt.h" #if DEFRULE_CONSTRUCT #include "lgcldpnd.h" #endif #include "facthsh.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct fact *FactExists(void *,struct fact *,unsigned long); static struct factHashEntry **CreateFactHashTable(void *,unsigned long); static void ResizeFactHashTable(void *); static void ResetFactHashTable(void *); /************************************************/ /* HashFact: Returns the hash value for a fact. */ /************************************************/ unsigned long HashFact( struct fact *theFact) { unsigned long count = 0; /*============================================*/ /* Get a hash value for the deftemplate name. */ /*============================================*/ count += (unsigned long) theFact->whichDeftemplate->header.name->bucket * 73981; /*=================================================*/ /* Add in the hash value for the rest of the fact. */ /*=================================================*/ count += HashMultifield(&theFact->theProposition,0); /*================================*/ /* Make sure the hash value falls */ /* in the appropriate range. */ /*================================*/ theFact->hashValue = count; /*========================*/ /* Return the hash value. */ /*========================*/ return(count); } /**********************************************/ /* FactExists: Determines if a specified fact */ /* already exists in the fact hash table. */ /**********************************************/ static struct fact *FactExists( void *theEnv, struct fact *theFact, unsigned long hashValue) { struct factHashEntry *theFactHash; hashValue = (hashValue % FactData(theEnv)->FactHashTableSize); for (theFactHash = FactData(theEnv)->FactHashTable[hashValue]; theFactHash != NULL; theFactHash = theFactHash->next) { if (theFact->hashValue != theFactHash->theFact->hashValue) { continue; } if ((theFact->whichDeftemplate == theFactHash->theFact->whichDeftemplate) ? MultifieldsEqual(&theFact->theProposition, &theFactHash->theFact->theProposition) : FALSE) { return(theFactHash->theFact); } } return(NULL); } /************************************************************/ /* AddHashedFact: Adds a fact entry to the fact hash table. */ /************************************************************/ globle void AddHashedFact( void *theEnv, struct fact *theFact, unsigned long hashValue) { struct factHashEntry *newhash, *temp; if (FactData(theEnv)->NumberOfFacts > FactData(theEnv)->FactHashTableSize) { ResizeFactHashTable(theEnv); } newhash = get_struct(theEnv,factHashEntry); newhash->theFact = theFact; hashValue = (hashValue % FactData(theEnv)->FactHashTableSize); temp = FactData(theEnv)->FactHashTable[hashValue]; FactData(theEnv)->FactHashTable[hashValue] = newhash; newhash->next = temp; } /******************************************/ /* RemoveHashedFact: Removes a fact entry */ /* from the fact hash table. */ /******************************************/ globle intBool RemoveHashedFact( void *theEnv, struct fact *theFact) { unsigned long hashValue; struct factHashEntry *hptr, *prev; hashValue = HashFact(theFact); hashValue = (hashValue % FactData(theEnv)->FactHashTableSize); for (hptr = FactData(theEnv)->FactHashTable[hashValue], prev = NULL; hptr != NULL; hptr = hptr->next) { if (hptr->theFact == theFact) { if (prev == NULL) { FactData(theEnv)->FactHashTable[hashValue] = hptr->next; rtn_struct(theEnv,factHashEntry,hptr); if (FactData(theEnv)->NumberOfFacts == 1) { ResetFactHashTable(theEnv); } return(1); } else { prev->next = hptr->next; rtn_struct(theEnv,factHashEntry,hptr); if (FactData(theEnv)->NumberOfFacts == 1) { ResetFactHashTable(theEnv); } return(1); } } prev = hptr; } return(0); } /****************************************************/ /* FactWillBeAsserted: Determines if a fact will be */ /* asserted based on the duplication settings. */ /****************************************************/ globle intBool FactWillBeAsserted( void *theEnv, void *theFact) { struct fact *tempPtr; unsigned long hashValue; if (FactData(theEnv)->FactDuplication) return(TRUE); hashValue = HashFact((struct fact *) theFact); tempPtr = FactExists(theEnv,(struct fact *) theFact,hashValue); if (tempPtr == NULL) return(TRUE); return(FALSE); } /*****************************************************/ /* HandleFactDuplication: Determines if a fact to be */ /* added to the fact-list is a duplicate entry and */ /* takes appropriate action based on the current */ /* setting of the fact-duplication flag. */ /*****************************************************/ globle unsigned long HandleFactDuplication( void *theEnv, void *theFact, intBool *duplicate) { struct fact *tempPtr; unsigned long hashValue; *duplicate = FALSE; hashValue = HashFact((struct fact *) theFact); if (FactData(theEnv)->FactDuplication) return(hashValue); tempPtr = FactExists(theEnv,(struct fact *) theFact,hashValue); if (tempPtr == NULL) return(hashValue); ReturnFact(theEnv,(struct fact *) theFact); #if DEFRULE_CONSTRUCT AddLogicalDependencies(theEnv,(struct patternEntity *) tempPtr,TRUE); #endif *duplicate = TRUE; return(0); } /*******************************************/ /* EnvGetFactDuplication: C access routine */ /* for the get-fact-duplication command. */ /*******************************************/ globle intBool EnvGetFactDuplication( void *theEnv) { return(FactData(theEnv)->FactDuplication); } /*******************************************/ /* EnvSetFactDuplication: C access routine */ /* for the set-fact-duplication command. */ /*******************************************/ globle intBool EnvSetFactDuplication( void *theEnv, int value) { int ov; ov = FactData(theEnv)->FactDuplication; FactData(theEnv)->FactDuplication = value; return(ov); } /**************************************************/ /* InitializeFactHashTable: Initializes the table */ /* entries in the fact hash table to NULL. */ /**************************************************/ globle void InitializeFactHashTable( void *theEnv) { FactData(theEnv)->FactHashTable = CreateFactHashTable(theEnv,SIZE_FACT_HASH); FactData(theEnv)->FactHashTableSize = SIZE_FACT_HASH; } /*******************************************************************/ /* CreateFactHashTable: Creates and initializes a fact hash table. */ /*******************************************************************/ static struct factHashEntry **CreateFactHashTable( void *theEnv, unsigned long tableSize) { unsigned long i; struct factHashEntry **theTable; theTable = (struct factHashEntry **) gm3(theEnv,sizeof (struct factHashEntry *) * tableSize); if (theTable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE); for (i = 0; i < tableSize; i++) theTable[i] = NULL; return(theTable); } /*******************************************************************/ /* ResizeFactHashTable: */ /*******************************************************************/ static void ResizeFactHashTable( void *theEnv) { unsigned long i, newSize, newLocation; struct factHashEntry **theTable, **newTable; struct factHashEntry *theEntry, *nextEntry; theTable = FactData(theEnv)->FactHashTable; newSize = (FactData(theEnv)->FactHashTableSize * 2) + 1; newTable = CreateFactHashTable(theEnv,newSize); /*========================================*/ /* Copy the old entries to the new table. */ /*========================================*/ for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++) { theEntry = theTable[i]; while (theEntry != NULL) { nextEntry = theEntry->next; newLocation = theEntry->theFact->hashValue % newSize; theEntry->next = newTable[newLocation]; newTable[newLocation] = theEntry; theEntry = nextEntry; } } /*=====================================================*/ /* Replace the old hash table with the new hash table. */ /*=====================================================*/ rm3(theEnv,theTable,sizeof(struct factHashEntry *) * FactData(theEnv)->FactHashTableSize); FactData(theEnv)->FactHashTableSize = newSize; FactData(theEnv)->FactHashTable = newTable; } /*******************************************************************/ /* ResetFactHashTable: */ /*******************************************************************/ static void ResetFactHashTable( void *theEnv) { struct factHashEntry **newTable; /*=============================================*/ /* Don't reset the table unless the hash table */ /* has been expanded from its original size. */ /*=============================================*/ if (FactData(theEnv)->FactHashTableSize == SIZE_FACT_HASH) { return; } /*=======================*/ /* Create the new table. */ /*=======================*/ newTable = CreateFactHashTable(theEnv,SIZE_FACT_HASH); /*=====================================================*/ /* Replace the old hash table with the new hash table. */ /*=====================================================*/ rm3(theEnv,FactData(theEnv)->FactHashTable,sizeof(struct factHashEntry *) * FactData(theEnv)->FactHashTableSize); FactData(theEnv)->FactHashTableSize = SIZE_FACT_HASH; FactData(theEnv)->FactHashTable = newTable; } #if DEVELOPER /*****************************************************/ /* ShowFactHashTable: Displays the number of entries */ /* in each slot of the fact hash table. */ /*****************************************************/ globle void ShowFactHashTable( void *theEnv) { int i, count; struct factHashEntry *theEntry; char buffer[20]; for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++) { for (theEntry = FactData(theEnv)->FactHashTable[i], count = 0; theEntry != NULL; theEntry = theEntry->next) { count++; } if (count != 0) { gensprintf(buffer,"%4d: %4d\n",i,count); EnvPrintRouter(theEnv,WDISPLAY,buffer); } } } #endif /* DEVELOPER */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle intBool GetFactDuplication() { return EnvGetFactDuplication(GetCurrentEnvironment()); } globle intBool SetFactDuplication( int value) { return EnvSetFactDuplication(GetCurrentEnvironment(),value); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips_core_source_630/core/._developr.c0000755000175000017500000000040712373721332016436 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/envrnmnt.h0000755000175000017500000001255012373740012016253 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* ENVRNMNT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for supporting multiple environments. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.24: Added code to CreateEnvironment to free */ /* already allocated data if one of the malloc */ /* calls fail. */ /* */ /* Modified AllocateEnvironmentData to print a */ /* message if it was unable to allocate memory. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added CreateRuntimeEnvironment function. */ /* */ /* Added support for context information when an */ /* environment is created (i.e a pointer from the */ /* CLIPS environment to its parent environment). */ /* */ /* 6.30: Added support for passing context information */ /* to user defined functions and callback */ /* functions. */ /* */ /* Support for hashing EXTERNAL_ADDRESS data */ /* type. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_envrnmnt #define _H_envrnmnt #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _ENVRNMNT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define USER_ENVIRONMENT_DATA 70 #define MAXIMUM_ENVIRONMENT_POSITIONS 100 struct environmentCleanupFunction { const char *name; void (*func)(void *); int priority; struct environmentCleanupFunction *next; }; struct environmentData { unsigned int initialized : 1; unsigned long environmentIndex; void *context; void *routerContext; void *functionContext; void *callbackContext; void **theData; void (**cleanupFunctions)(void *); struct environmentCleanupFunction *listOfCleanupEnvironmentFunctions; struct environmentData *next; }; typedef struct environmentData ENVIRONMENT_DATA; typedef struct environmentData * ENVIRONMENT_DATA_PTR; #define GetEnvironmentData(theEnv,position) (((struct environmentData *) theEnv)->theData[position]) #define SetEnvironmentData(theEnv,position,value) (((struct environmentData *) theEnv)->theData[position] = value) LOCALE intBool AllocateEnvironmentData(void *,unsigned int,unsigned long,void (*)(void *)); LOCALE intBool DeallocateEnvironmentData(void); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void SetCurrentEnvironment(void *); LOCALE intBool SetCurrentEnvironmentByIndex(unsigned long); LOCALE void *GetEnvironmentByIndex(unsigned long); LOCALE void *GetCurrentEnvironment(void); LOCALE unsigned long GetEnvironmentIndex(void *); #endif LOCALE void *CreateEnvironment(void); LOCALE void *CreateRuntimeEnvironment(struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **); LOCALE intBool DestroyEnvironment(void *); LOCALE intBool AddEnvironmentCleanupFunction(void *,const char *,void (*)(void *),int); LOCALE void *GetEnvironmentContext(void *); LOCALE void *SetEnvironmentContext(void *,void *); LOCALE void *GetEnvironmentRouterContext(void *); LOCALE void *SetEnvironmentRouterContext(void *,void *); LOCALE void *GetEnvironmentFunctionContext(void *); LOCALE void *SetEnvironmentFunctionContext(void *,void *); LOCALE void *GetEnvironmentCallbackContext(void *); LOCALE void *SetEnvironmentCallbackContext(void *,void *); #endif /* _H_envrnmnt */ clips_core_source_630/core/clsltpsr.h0000755000175000017500000000505512373714250016261 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_clsltpsr #define _H_clsltpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #define MATCH_RLN "pattern-match" #define REACTIVE_RLN "reactive" #define NONREACTIVE_RLN "non-reactive" #ifndef _H_object #include "object.h" #endif typedef struct tempSlotLink { SLOT_DESC *desc; struct tempSlotLink *nxt; } TEMP_SLOT_LINK; #ifdef LOCALE #undef LOCALE #endif #ifdef _CLSLTPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE TEMP_SLOT_LINK *ParseSlot(void *,const char *,TEMP_SLOT_LINK *,PACKED_CLASS_LINKS *,int,int); LOCALE void DeleteSlots(void *,TEMP_SLOT_LINK *); #ifndef _CLSLTPSR_SOURCE_ #endif #endif #endif clips_core_source_630/core/._pprint.h0000755000175000017500000000040712373743666016155 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffnxfun.c0000755000175000017500000000040712464742046016442 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/modulutl.h0000755000175000017500000000716512374017664016272 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing module/construct */ /* names and searching through modules for specific */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Used genstrncpy instead of strncpy. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_modulutl #define _H_modulutl #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULUTL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE unsigned FindModuleSeparator(const char *); LOCALE SYMBOL_HN *ExtractModuleName(void *,unsigned,const char *); LOCALE SYMBOL_HN *ExtractConstructName(void *,unsigned,const char *); LOCALE const char *ExtractModuleAndConstructName(void *,const char *); LOCALE void *FindImportedConstruct(void *,const char *,struct defmodule *, const char *,int *,int,struct defmodule *); LOCALE void AmbiguousReferenceErrorMessage(void *,const char *,const char *); LOCALE void MarkModulesAsUnvisited(void *); LOCALE intBool AllImportedModulesVisited(void *,struct defmodule *); LOCALE void ListItemsDriver(void *, const char *,struct defmodule *, const char *,const char *, void *(*)(void *,void *), const char *(*)(void *), void (*)(void *,const char *,void *), int (*)(void *,void *)); LOCALE long DoForAllModules(void *, void (*)(struct defmodule *,void *), int,void *); LOCALE intBool ConstructExported(void *,const char *,struct symbolHashNode *,struct symbolHashNode *); #endif /* _H_modulutl */ clips_core_source_630/core/classinf.h0000755000175000017500000001362712373714260016222 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_classinf #define _H_classinf #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSINF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ClassAbstractPCommand(void *); #if DEFRULE_CONSTRUCT LOCALE intBool ClassReactivePCommand(void *); #endif LOCALE void *ClassInfoFnxArgs(void *,const char *,int *); LOCALE void ClassSlotsCommand(void *,DATA_OBJECT *); LOCALE void ClassSuperclassesCommand(void *,DATA_OBJECT *); LOCALE void ClassSubclassesCommand(void *,DATA_OBJECT *); LOCALE void GetDefmessageHandlersListCmd(void *,DATA_OBJECT *); LOCALE void SlotFacetsCommand(void *,DATA_OBJECT *); LOCALE void SlotSourcesCommand(void *,DATA_OBJECT *); LOCALE void SlotTypesCommand(void *,DATA_OBJECT *); LOCALE void SlotAllowedValuesCommand(void *,DATA_OBJECT *); LOCALE void SlotAllowedClassesCommand(void *,DATA_OBJECT *); LOCALE void SlotRangeCommand(void *,DATA_OBJECT *); LOCALE void SlotCardinalityCommand(void *,DATA_OBJECT *); LOCALE intBool EnvClassAbstractP(void *,void *); #if DEFRULE_CONSTRUCT LOCALE intBool EnvClassReactiveP(void *,void *); #endif LOCALE void EnvClassSlots(void *,void *,DATA_OBJECT *,int); LOCALE void EnvGetDefmessageHandlerList(void *,void *,DATA_OBJECT *,int); LOCALE void EnvClassSuperclasses(void *,void *,DATA_OBJECT *,int); LOCALE void EnvClassSubclasses(void *,void *,DATA_OBJECT *,int); LOCALE void ClassSubclassAddresses(void *,void *,DATA_OBJECT *,int); LOCALE void EnvSlotFacets(void *,void *,const char *,DATA_OBJECT *); LOCALE void EnvSlotSources(void *,void *,const char *,DATA_OBJECT *); LOCALE void EnvSlotTypes(void *,void *,const char *,DATA_OBJECT *); LOCALE void EnvSlotAllowedValues(void *,void *,const char *,DATA_OBJECT *); LOCALE void EnvSlotAllowedClasses(void *,void *,const char *,DATA_OBJECT *); LOCALE void EnvSlotRange(void *,void *,const char *,DATA_OBJECT *); LOCALE void EnvSlotCardinality(void *,void *,const char *,DATA_OBJECT *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool ClassAbstractP(void *); #if DEFRULE_CONSTRUCT LOCALE intBool ClassReactiveP(void *); #endif LOCALE void ClassSlots(void *,DATA_OBJECT *,int); LOCALE void ClassSubclasses(void *,DATA_OBJECT *,int); LOCALE void ClassSuperclasses(void *,DATA_OBJECT *,int); LOCALE void SlotAllowedValues(void *,const char *,DATA_OBJECT *); LOCALE void SlotAllowedClasses(void *,const char *,DATA_OBJECT *); LOCALE void SlotCardinality(void *,const char *,DATA_OBJECT *); LOCALE void SlotFacets(void *,const char *,DATA_OBJECT *); LOCALE void SlotRange(void *,const char *,DATA_OBJECT *); LOCALE void SlotSources(void *,const char *,DATA_OBJECT *); LOCALE void SlotTypes(void *,const char *,DATA_OBJECT *); LOCALE void GetDefmessageHandlerList(void *,DATA_OBJECT *,int); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_classinf */ clips_core_source_630/core/globlcom.h0000755000175000017500000000574312374672752016230 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFGLOBAL COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_globlcom #define _H_globlcom #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefglobalCommandDefinitions(void *); LOCALE int SetResetGlobalsCommand(void *); LOCALE intBool EnvSetResetGlobals(void *,int); LOCALE int GetResetGlobalsCommand(void *); LOCALE intBool EnvGetResetGlobals(void *); LOCALE void ShowDefglobalsCommand(void *); LOCALE void EnvShowDefglobals(void *,const char *,void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool GetResetGlobals(void); LOCALE intBool SetResetGlobals(int); #if DEBUGGING_FUNCTIONS LOCALE void ShowDefglobals(const char *,void *); #endif #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_globlcom */ clips_core_source_630/core/._incrrset.c0000755000175000017500000000040712500146515016443 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/filecom.c0000755000175000017500000012426312461762345016035 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* FILE COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for file commands including */ /* batch, dribble-on, dribble-off, save, load, bsave, and */ /* bload. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* Bebe Ly */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added code for capturing errors/warnings. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when BLOAD_ONLY compiler */ /* flag is set to 1. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ #define _FILECOM_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "argacces.h" #include "constrct.h" #include "commline.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "prcdrfun.h" #include "router.h" #include "strngrtr.h" #include "sysdep.h" #include "utility.h" #include "filecom.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bsave.h" #include "bload.h" #endif /***************/ /* STRUCTURES */ /***************/ struct batchEntry { int batchType; void *inputSource; const char *theString; const char *fileName; long lineNumber; struct batchEntry *next; }; /***************/ /* DEFINITIONS */ /***************/ #define FILE_BATCH 0 #define STRING_BATCH 1 #define BUFFER_SIZE 120 #define FILECOM_DATA 14 struct fileCommandData { #if DEBUGGING_FUNCTIONS FILE *DribbleFP; char *DribbleBuffer; size_t DribbleCurrentPosition; size_t DribbleMaximumPosition; int (*DribbleStatusFunction)(void *,int); #endif int BatchType; void *BatchSource; char *BatchBuffer; size_t BatchCurrentPosition; size_t BatchMaximumPosition; struct batchEntry *TopOfBatchList; struct batchEntry *BottomOfBatchList; char *batchPriorParsingFile; }; #define FileCommandData(theEnv) ((struct fileCommandData *) GetEnvironmentData(theEnv,FILECOM_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEBUGGING_FUNCTIONS static int FindDribble(void *,const char *); static int GetcDribble(void *,const char *); static int UngetcDribble(void *,int,const char *); static int ExitDribble(void *,int); static int PrintDribble(void *,const char *,const char *); static void PutcDribbleBuffer(void *,int); #endif static int FindBatch(void *,const char *); static int GetcBatch(void *,const char *); static int UngetcBatch(void *,int,const char *); static int ExitBatch(void *,int); static void AddBatch(void *,int,void *,int,const char *,const char *); static void DeallocateFileCommandData(void *); /***************************************/ /* FileCommandDefinitions: Initializes */ /* file commands. */ /***************************************/ globle void FileCommandDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,FILECOM_DATA,sizeof(struct fileCommandData),DeallocateFileCommandData); #if ! RUN_TIME #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"batch",'b',PTIEF BatchCommand,"BatchCommand","11k"); EnvDefineFunction2(theEnv,"batch*",'b',PTIEF BatchStarCommand,"BatchStarCommand","11k"); EnvDefineFunction2(theEnv,"dribble-on",'b',PTIEF DribbleOnCommand,"DribbleOnCommand","11k"); EnvDefineFunction2(theEnv,"dribble-off",'b',PTIEF DribbleOffCommand,"DribbleOffCommand","00"); EnvDefineFunction2(theEnv,"save",'b',PTIEF SaveCommand,"SaveCommand","11k"); #endif EnvDefineFunction2(theEnv,"load",'b',PTIEF LoadCommand,"LoadCommand","11k"); EnvDefineFunction2(theEnv,"load*",'b',PTIEF LoadStarCommand,"LoadStarCommand","11k"); #if BLOAD_AND_BSAVE EnvDefineFunction2(theEnv,"bsave",'b', PTIEF BsaveCommand,"BsaveCommand","11k"); #endif #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE InitializeBsaveData(theEnv); InitializeBloadData(theEnv); EnvDefineFunction2(theEnv,"bload",'b',PTIEF BloadCommand,"BloadCommand","11k"); #endif #endif } /******************************************************/ /* DeallocateFileCommandData: Deallocates environment */ /* data for file commands. */ /******************************************************/ static void DeallocateFileCommandData( void *theEnv) { struct batchEntry *theEntry, *nextEntry; theEntry = FileCommandData(theEnv)->TopOfBatchList; while (theEntry != NULL) { nextEntry = theEntry->next; if (theEntry->batchType == FILE_BATCH) { GenClose(theEnv,(FILE *) FileCommandData(theEnv)->TopOfBatchList->inputSource); } else { rm(theEnv,(void *) theEntry->theString,strlen(theEntry->theString) + 1); } rtn_struct(theEnv,batchEntry,theEntry); theEntry = nextEntry; } if (FileCommandData(theEnv)->BatchBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); } DeleteString(theEnv,FileCommandData(theEnv)->batchPriorParsingFile); FileCommandData(theEnv)->batchPriorParsingFile = NULL; #if DEBUGGING_FUNCTIONS if (FileCommandData(theEnv)->DribbleBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->DribbleBuffer,FileCommandData(theEnv)->DribbleMaximumPosition); } if (FileCommandData(theEnv)->DribbleFP != NULL) { GenClose(theEnv,FileCommandData(theEnv)->DribbleFP); } #endif } #if DEBUGGING_FUNCTIONS /*****************************************************/ /* FindDribble: Find routine for the dribble router. */ /*****************************************************/ static int FindDribble( void *theEnv, const char *logicalName) { #if MAC_XCD #pragma unused(theEnv) #endif if ( (strcmp(logicalName,STDOUT) == 0) || (strcmp(logicalName,STDIN) == 0) || (strcmp(logicalName,WPROMPT) == 0) || (strcmp(logicalName,WTRACE) == 0) || (strcmp(logicalName,WERROR) == 0) || (strcmp(logicalName,WWARNING) == 0) || (strcmp(logicalName,WDISPLAY) == 0) || (strcmp(logicalName,WDIALOG) == 0) ) { return(TRUE); } return(FALSE); } /*******************************************************/ /* PrintDribble: Print routine for the dribble router. */ /*******************************************************/ static int PrintDribble( void *theEnv, const char *logicalName, const char *str) { int i; /*======================================*/ /* Send the output to the dribble file. */ /*======================================*/ for (i = 0 ; str[i] != EOS ; i++) { PutcDribbleBuffer(theEnv,str[i]); } /*===========================================================*/ /* Send the output to any routers interested in printing it. */ /*===========================================================*/ EnvDeactivateRouter(theEnv,"dribble"); EnvPrintRouter(theEnv,logicalName,str); EnvActivateRouter(theEnv,"dribble"); return(1); } /*****************************************************/ /* GetcDribble: Getc routine for the dribble router. */ /*****************************************************/ static int GetcDribble( void *theEnv, const char *logicalName) { int rv; /*===========================================*/ /* Deactivate the dribble router and get the */ /* character from another active router. */ /*===========================================*/ EnvDeactivateRouter(theEnv,"dribble"); rv = EnvGetcRouter(theEnv,logicalName); EnvActivateRouter(theEnv,"dribble"); /*==========================================*/ /* Put the character retrieved from another */ /* router into the dribble buffer. */ /*==========================================*/ PutcDribbleBuffer(theEnv,rv); /*=======================*/ /* Return the character. */ /*=======================*/ return(rv); } /***********************************************************/ /* PutcDribbleBuffer: Putc routine for the dribble router. */ /***********************************************************/ static void PutcDribbleBuffer( void *theEnv, int rv) { /*===================================================*/ /* Receiving an end-of-file character will cause the */ /* contents of the dribble buffer to be flushed. */ /*===================================================*/ if (rv == EOF) { if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); FileCommandData(theEnv)->DribbleCurrentPosition = 0; FileCommandData(theEnv)->DribbleBuffer[0] = EOS; } } /*===========================================================*/ /* If we aren't receiving command input, then the character */ /* just received doesn't need to be placed in the dribble */ /* buffer--It can be written directly to the file. This will */ /* occur for example when the command prompt is being */ /* printed (the AwaitingInput variable will be FALSE because */ /* command input has not been receivied yet). Before writing */ /* the character to the file, the dribble buffer is flushed. */ /*===========================================================*/ else if (RouterData(theEnv)->AwaitingInput == FALSE) { if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); FileCommandData(theEnv)->DribbleCurrentPosition = 0; FileCommandData(theEnv)->DribbleBuffer[0] = EOS; } fputc(rv,FileCommandData(theEnv)->DribbleFP); } /*=====================================================*/ /* Otherwise, add the character to the dribble buffer. */ /*=====================================================*/ else { FileCommandData(theEnv)->DribbleBuffer = ExpandStringWithChar(theEnv,rv,FileCommandData(theEnv)->DribbleBuffer, &FileCommandData(theEnv)->DribbleCurrentPosition, &FileCommandData(theEnv)->DribbleMaximumPosition, FileCommandData(theEnv)->DribbleMaximumPosition+BUFFER_SIZE); } } /*********************************************************/ /* UngetcDribble: Ungetc routine for the dribble router. */ /*********************************************************/ static int UngetcDribble( void *theEnv, int ch, const char *logicalName) { int rv; /*===============================================*/ /* Remove the character from the dribble buffer. */ /*===============================================*/ if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) FileCommandData(theEnv)->DribbleCurrentPosition--; FileCommandData(theEnv)->DribbleBuffer[FileCommandData(theEnv)->DribbleCurrentPosition] = EOS; /*=============================================*/ /* Deactivate the dribble router and pass the */ /* ungetc request to the other active routers. */ /*=============================================*/ EnvDeactivateRouter(theEnv,"dribble"); rv = EnvUngetcRouter(theEnv,ch,logicalName); EnvActivateRouter(theEnv,"dribble"); /*==========================================*/ /* Return the result of the ungetc request. */ /*==========================================*/ return(rv); } /*****************************************************/ /* ExitDribble: Exit routine for the dribble router. */ /*****************************************************/ static int ExitDribble( void *theEnv, int num) { #if MAC_XCD #pragma unused(num) #endif if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); } if (FileCommandData(theEnv)->DribbleFP != NULL) GenClose(theEnv,FileCommandData(theEnv)->DribbleFP); return(1); } /******************************************/ /* DribbleOnCommand: H/L access routine */ /* for the dribble-on command. */ /******************************************/ globle int DribbleOnCommand( void *theEnv) { const char *fileName; if (EnvArgCountCheck(theEnv,"dribble-on",EXACTLY,1) == -1) return(FALSE); if ((fileName = GetFileName(theEnv,"dribble-on",1)) == NULL) return(FALSE); return (EnvDribbleOn(theEnv,fileName)); } /**********************************/ /* EnvDribbleOn: C access routine */ /* for the dribble-on command. */ /**********************************/ globle intBool EnvDribbleOn( void *theEnv, const char *fileName) { /*==============================*/ /* If a dribble file is already */ /* open, then close it. */ /*==============================*/ if (FileCommandData(theEnv)->DribbleFP != NULL) { EnvDribbleOff(theEnv); } /*========================*/ /* Open the dribble file. */ /*========================*/ FileCommandData(theEnv)->DribbleFP = GenOpen(theEnv,fileName,"w"); if (FileCommandData(theEnv)->DribbleFP == NULL) { OpenErrorMessage(theEnv,"dribble-on",fileName); return(0); } /*============================*/ /* Create the dribble router. */ /*============================*/ EnvAddRouter(theEnv,"dribble", 40, FindDribble, PrintDribble, GetcDribble, UngetcDribble, ExitDribble); FileCommandData(theEnv)->DribbleCurrentPosition = 0; /*================================================*/ /* Call the dribble status function. This is used */ /* by some of the machine specific interfaces to */ /* do things such as changing the wording of menu */ /* items from "Turn Dribble On..." to */ /* "Turn Dribble Off..." */ /*================================================*/ if (FileCommandData(theEnv)->DribbleStatusFunction != NULL) { (*FileCommandData(theEnv)->DribbleStatusFunction)(theEnv,TRUE); } /*=====================================*/ /* Return TRUE to indicate the dribble */ /* file was successfully opened. */ /*=====================================*/ return(TRUE); } /*************************************************/ /* EnvDribbleActive: Returns TRUE if the dribble */ /* router is active, otherwise FALSE> */ /*************************************************/ globle intBool EnvDribbleActive( void *theEnv) { if (FileCommandData(theEnv)->DribbleFP != NULL) return(TRUE); return(FALSE); } /*******************************************/ /* DribbleOffCommand: H/L access routine */ /* for the dribble-off command. */ /*******************************************/ globle int DribbleOffCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"dribble-off",EXACTLY,0) == -1) return(FALSE); return(EnvDribbleOff(theEnv)); } /***********************************/ /* EnvDribbleOff: C access routine */ /* for the dribble-off command. */ /***********************************/ globle intBool EnvDribbleOff( void *theEnv) { int rv = 0; /*================================================*/ /* Call the dribble status function. This is used */ /* by some of the machine specific interfaces to */ /* do things such as changing the wording of menu */ /* items from "Turn Dribble On..." to */ /* "Turn Dribble Off..." */ /*================================================*/ if (FileCommandData(theEnv)->DribbleStatusFunction != NULL) { (*FileCommandData(theEnv)->DribbleStatusFunction)(theEnv,FALSE); } /*=======================================*/ /* Close the dribble file and deactivate */ /* the dribble router. */ /*=======================================*/ if (FileCommandData(theEnv)->DribbleFP != NULL) { if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); } EnvDeleteRouter(theEnv,"dribble"); if (GenClose(theEnv,FileCommandData(theEnv)->DribbleFP) == 0) rv = 1; } else { rv = 1; } FileCommandData(theEnv)->DribbleFP = NULL; /*============================================*/ /* Free the space used by the dribble buffer. */ /*============================================*/ if (FileCommandData(theEnv)->DribbleBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->DribbleBuffer,FileCommandData(theEnv)->DribbleMaximumPosition); FileCommandData(theEnv)->DribbleBuffer = NULL; } FileCommandData(theEnv)->DribbleCurrentPosition = 0; FileCommandData(theEnv)->DribbleMaximumPosition = 0; /*============================================*/ /* Return TRUE if the dribble file was closed */ /* without error, otherwise return FALSE. */ /*============================================*/ return(rv); } /*****************************************************/ /* SetDribbleStatusFunction: Sets the function which */ /* is called whenever the dribble router is turned */ /* on or off. */ /*****************************************************/ globle void SetDribbleStatusFunction( void *theEnv, int (*fnptr)(void *,int)) { FileCommandData(theEnv)->DribbleStatusFunction = fnptr; } #endif /* DEBUGGING_FUNCTIONS */ /*************************************************/ /* FindBatch: Find routine for the batch router. */ /*************************************************/ static int FindBatch( void *theEnv, const char *logicalName) { #if MAC_XCD #pragma unused(theEnv) #endif if (strcmp(logicalName,STDIN) == 0) { return(TRUE); } return(FALSE); } /*************************************************/ /* GetcBatch: Getc routine for the batch router. */ /*************************************************/ static int GetcBatch( void *theEnv, const char *logicalName) { return(LLGetcBatch(theEnv,logicalName,FALSE)); } /***************************************************/ /* LLGetcBatch: Lower level routine for retrieving */ /* a character when a batch file is active. */ /***************************************************/ globle int LLGetcBatch( void *theEnv, const char *logicalName, int returnOnEOF) { int rv = EOF, flag = 1; /*=================================================*/ /* Get a character until a valid character appears */ /* or no more batch files are left. */ /*=================================================*/ while ((rv == EOF) && (flag == 1)) { if (FileCommandData(theEnv)->BatchType == FILE_BATCH) { rv = getc((FILE *) FileCommandData(theEnv)->BatchSource); } else { rv = EnvGetcRouter(theEnv,(char *) FileCommandData(theEnv)->BatchSource); } if (rv == EOF) { if (FileCommandData(theEnv)->BatchCurrentPosition > 0) EnvPrintRouter(theEnv,STDOUT,(char *) FileCommandData(theEnv)->BatchBuffer); flag = RemoveBatch(theEnv); } } /*=========================================================*/ /* If the character retrieved is an end-of-file character, */ /* then there are no batch files with character input */ /* remaining. Remove the batch router. */ /*=========================================================*/ if (rv == EOF) { if (FileCommandData(theEnv)->BatchCurrentPosition > 0) EnvPrintRouter(theEnv,STDOUT,(char *) FileCommandData(theEnv)->BatchBuffer); EnvDeleteRouter(theEnv,"batch"); RemoveBatch(theEnv); if (returnOnEOF == TRUE) { return (EOF); } else { return(EnvGetcRouter(theEnv,logicalName)); } } /*========================================*/ /* Add the character to the batch buffer. */ /*========================================*/ FileCommandData(theEnv)->BatchBuffer = ExpandStringWithChar(theEnv,(char) rv,FileCommandData(theEnv)->BatchBuffer,&FileCommandData(theEnv)->BatchCurrentPosition, &FileCommandData(theEnv)->BatchMaximumPosition,FileCommandData(theEnv)->BatchMaximumPosition+BUFFER_SIZE); /*======================================*/ /* If a carriage return is encountered, */ /* then flush the batch buffer. */ /*======================================*/ if ((char) rv == '\n') { EnvPrintRouter(theEnv,STDOUT,(char *) FileCommandData(theEnv)->BatchBuffer); FileCommandData(theEnv)->BatchCurrentPosition = 0; if ((FileCommandData(theEnv)->BatchBuffer != NULL) && (FileCommandData(theEnv)->BatchMaximumPosition > BUFFER_SIZE)) { rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); FileCommandData(theEnv)->BatchMaximumPosition = 0; FileCommandData(theEnv)->BatchBuffer = NULL; } } /*=============================*/ /* Increment the line counter. */ /*=============================*/ if (((char) rv == '\r') || ((char) rv == '\n')) { IncrementLineCount(theEnv); } /*=====================================================*/ /* Return the character retrieved from the batch file. */ /*=====================================================*/ return(rv); } /*****************************************************/ /* UngetcBatch: Ungetc routine for the batch router. */ /*****************************************************/ static int UngetcBatch( void *theEnv, int ch, const char *logicalName) { #if MAC_XCD #pragma unused(logicalName) #endif if (FileCommandData(theEnv)->BatchCurrentPosition > 0) FileCommandData(theEnv)->BatchCurrentPosition--; if (FileCommandData(theEnv)->BatchBuffer != NULL) FileCommandData(theEnv)->BatchBuffer[FileCommandData(theEnv)->BatchCurrentPosition] = EOS; if (FileCommandData(theEnv)->BatchType == FILE_BATCH) { return(ungetc(ch,(FILE *) FileCommandData(theEnv)->BatchSource)); } return(EnvUngetcRouter(theEnv,ch,(char *) FileCommandData(theEnv)->BatchSource)); } /*************************************************/ /* ExitBatch: Exit routine for the batch router. */ /*************************************************/ static int ExitBatch( void *theEnv, int num) { #if MAC_XCD #pragma unused(num) #endif CloseAllBatchSources(theEnv); return(1); } /**************************************/ /* BatchCommand: H/L access routine */ /* for the batch command. */ /**************************************/ globle int BatchCommand( void *theEnv) { const char *fileName; if (EnvArgCountCheck(theEnv,"batch",EXACTLY,1) == -1) return(FALSE); if ((fileName = GetFileName(theEnv,"batch",1)) == NULL) return(FALSE); return(OpenBatch(theEnv,fileName,FALSE)); } /**************************************************/ /* Batch: C access routine for the batch command. */ /**************************************************/ globle int Batch( void *theEnv, const char *fileName) { return(OpenBatch(theEnv,fileName,FALSE)); } /***********************************************/ /* OpenBatch: Adds a file to the list of files */ /* opened with the batch command. */ /***********************************************/ globle int OpenBatch( void *theEnv, const char *fileName, int placeAtEnd) { FILE *theFile; /*======================*/ /* Open the batch file. */ /*======================*/ theFile = GenOpen(theEnv,fileName,"r"); if (theFile == NULL) { OpenErrorMessage(theEnv,"batch",fileName); return(FALSE); } /*============================*/ /* Create the batch router if */ /* it doesn't already exist. */ /*============================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { EnvAddRouter(theEnv,"batch", 20, FindBatch, NULL, GetcBatch, UngetcBatch, ExitBatch); } /*===============================================================*/ /* If a batch file is already open, save its current line count. */ /*===============================================================*/ if (FileCommandData(theEnv)->TopOfBatchList != NULL) { FileCommandData(theEnv)->TopOfBatchList->lineNumber = GetLineCount(theEnv); } #if (! RUN_TIME) && (! BLOAD_ONLY) /*========================================================================*/ /* If this is the first batch file, remember the prior parsing file name. */ /*========================================================================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { FileCommandData(theEnv)->batchPriorParsingFile = CopyString(theEnv,EnvGetParsingFileName(theEnv)); } /*=======================================================*/ /* Create the error capture router if it does not exist. */ /*=======================================================*/ EnvSetParsingFileName(theEnv,fileName); SetLineCount(theEnv,0); CreateErrorCaptureRouter(theEnv); #endif /*====================================*/ /* Add the newly opened batch file to */ /* the list of batch files opened. */ /*====================================*/ AddBatch(theEnv,placeAtEnd,(void *) theFile,FILE_BATCH,NULL,fileName); /*===================================*/ /* Return TRUE to indicate the batch */ /* file was successfully opened. */ /*===================================*/ return(TRUE); } /*****************************************************************/ /* OpenStringBatch: Opens a string source for batch processing. */ /* The memory allocated for the argument stringName must be */ /* deallocated by the user. The memory allocated for theString */ /* will be deallocated by the batch routines when batch */ /* processing for the string is completed. */ /*****************************************************************/ globle int OpenStringBatch( void *theEnv, const char *stringName, const char *theString, int placeAtEnd) { if (OpenStringSource(theEnv,stringName,theString,0) == 0) { return(0); } if (FileCommandData(theEnv)->TopOfBatchList == NULL) { EnvAddRouter(theEnv,"batch", 20, FindBatch, NULL, GetcBatch, UngetcBatch, ExitBatch); } AddBatch(theEnv,placeAtEnd,(void *) stringName,STRING_BATCH,theString,NULL); return(1); } /*******************************************************/ /* AddBatch: Creates the batch file data structure and */ /* adds it to the list of opened batch files. */ /*******************************************************/ static void AddBatch( void *theEnv, int placeAtEnd, void *theSource, int type, const char *theString, const char *theFileName) { struct batchEntry *bptr; /*=========================*/ /* Create the batch entry. */ /*=========================*/ bptr = get_struct(theEnv,batchEntry); bptr->batchType = type; bptr->inputSource = theSource; bptr->theString = theString; bptr->fileName = CopyString(theEnv,theFileName); bptr->lineNumber = 0; bptr->next = NULL; /*============================*/ /* Add the entry to the list. */ /*============================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { FileCommandData(theEnv)->TopOfBatchList = bptr; FileCommandData(theEnv)->BottomOfBatchList = bptr; FileCommandData(theEnv)->BatchType = type; FileCommandData(theEnv)->BatchSource = theSource; FileCommandData(theEnv)->BatchCurrentPosition = 0; } else if (placeAtEnd == FALSE) { bptr->next = FileCommandData(theEnv)->TopOfBatchList; FileCommandData(theEnv)->TopOfBatchList = bptr; FileCommandData(theEnv)->BatchType = type; FileCommandData(theEnv)->BatchSource = theSource; FileCommandData(theEnv)->BatchCurrentPosition = 0; } else { FileCommandData(theEnv)->BottomOfBatchList->next = bptr; FileCommandData(theEnv)->BottomOfBatchList = bptr; } } /******************************************************************/ /* RemoveBatch: Removes the top entry on the list of batch files. */ /******************************************************************/ globle int RemoveBatch( void *theEnv) { struct batchEntry *bptr; int rv, fileBatch = FALSE; if (FileCommandData(theEnv)->TopOfBatchList == NULL) return(FALSE); /*==================================================*/ /* Close the source from which batch input is read. */ /*==================================================*/ if (FileCommandData(theEnv)->TopOfBatchList->batchType == FILE_BATCH) { fileBatch = TRUE; GenClose(theEnv,(FILE *) FileCommandData(theEnv)->TopOfBatchList->inputSource); #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); DeleteErrorCaptureRouter(theEnv); #endif } else { CloseStringSource(theEnv,(char *) FileCommandData(theEnv)->TopOfBatchList->inputSource); rm(theEnv,(void *) FileCommandData(theEnv)->TopOfBatchList->theString, strlen(FileCommandData(theEnv)->TopOfBatchList->theString) + 1); } /*=================================*/ /* Remove the entry from the list. */ /*=================================*/ DeleteString(theEnv,(char *) FileCommandData(theEnv)->TopOfBatchList->fileName); bptr = FileCommandData(theEnv)->TopOfBatchList; FileCommandData(theEnv)->TopOfBatchList = FileCommandData(theEnv)->TopOfBatchList->next; rtn_struct(theEnv,batchEntry,bptr); /*========================================================*/ /* If there are no batch files remaining to be processed, */ /* then free the space used by the batch buffer. */ /*========================================================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { FileCommandData(theEnv)->BottomOfBatchList = NULL; FileCommandData(theEnv)->BatchSource = NULL; if (FileCommandData(theEnv)->BatchBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); FileCommandData(theEnv)->BatchBuffer = NULL; } FileCommandData(theEnv)->BatchCurrentPosition = 0; FileCommandData(theEnv)->BatchMaximumPosition = 0; rv = 0; #if (! RUN_TIME) && (! BLOAD_ONLY) if (fileBatch) { EnvSetParsingFileName(theEnv,FileCommandData(theEnv)->batchPriorParsingFile); DeleteString(theEnv,FileCommandData(theEnv)->batchPriorParsingFile); FileCommandData(theEnv)->batchPriorParsingFile = NULL; } #endif } /*===========================================*/ /* Otherwise move on to the next batch file. */ /*===========================================*/ else { FileCommandData(theEnv)->BatchType = FileCommandData(theEnv)->TopOfBatchList->batchType; FileCommandData(theEnv)->BatchSource = FileCommandData(theEnv)->TopOfBatchList->inputSource; FileCommandData(theEnv)->BatchCurrentPosition = 0; rv = 1; #if (! RUN_TIME) && (! BLOAD_ONLY) if (FileCommandData(theEnv)->TopOfBatchList->batchType == FILE_BATCH) { EnvSetParsingFileName(theEnv,FileCommandData(theEnv)->TopOfBatchList->fileName); } SetLineCount(theEnv,FileCommandData(theEnv)->TopOfBatchList->lineNumber); #endif } /*====================================================*/ /* Return TRUE if a batch file if there are remaining */ /* batch files to be processed, otherwise FALSE. */ /*====================================================*/ return(rv); } /****************************************/ /* BatchActive: Returns TRUE if a batch */ /* file is open, otherwise FALSE. */ /****************************************/ globle intBool BatchActive( void *theEnv) { if (FileCommandData(theEnv)->TopOfBatchList != NULL) return(TRUE); return(FALSE); } /******************************************************/ /* CloseAllBatchSources: Closes all open batch files. */ /******************************************************/ globle void CloseAllBatchSources( void *theEnv) { /*================================================*/ /* Free the batch buffer if it contains anything. */ /*================================================*/ if (FileCommandData(theEnv)->BatchBuffer != NULL) { if (FileCommandData(theEnv)->BatchCurrentPosition > 0) EnvPrintRouter(theEnv,STDOUT,(char *) FileCommandData(theEnv)->BatchBuffer); rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); FileCommandData(theEnv)->BatchBuffer = NULL; FileCommandData(theEnv)->BatchCurrentPosition = 0; FileCommandData(theEnv)->BatchMaximumPosition = 0; } /*==========================*/ /* Delete the batch router. */ /*==========================*/ EnvDeleteRouter(theEnv,"batch"); /*=====================================*/ /* Close each of the open batch files. */ /*=====================================*/ while (RemoveBatch(theEnv)) { /* Do Nothing */ } } /******************************************/ /* BatchStarCommand: H/L access routine */ /* for the batch* command. */ /******************************************/ globle int BatchStarCommand( void *theEnv) { const char *fileName; if (EnvArgCountCheck(theEnv,"batch*",EXACTLY,1) == -1) return(FALSE); if ((fileName = GetFileName(theEnv,"batch*",1)) == NULL) return(FALSE); return(EnvBatchStar(theEnv,fileName)); } #if ! RUN_TIME /**********************************************************/ /* EnvBatchStar: C access routine for the batch* command. */ /**********************************************************/ globle int EnvBatchStar( void *theEnv, const char *fileName) { int inchar; FILE *theFile; char *theString = NULL; size_t position = 0; size_t maxChars = 0; #if (! RUN_TIME) && (! BLOAD_ONLY) char *oldParsingFileName; long oldLineCountValue; #endif /*======================*/ /* Open the batch file. */ /*======================*/ theFile = GenOpen(theEnv,fileName,"r"); if (theFile == NULL) { OpenErrorMessage(theEnv,"batch",fileName); return(FALSE); } /*======================================*/ /* Setup for capturing errors/warnings. */ /*======================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) oldParsingFileName = CopyString(theEnv,EnvGetParsingFileName(theEnv)); EnvSetParsingFileName(theEnv,fileName); CreateErrorCaptureRouter(theEnv); oldLineCountValue = SetLineCount(theEnv,1); #endif /*========================*/ /* Reset the error state. */ /*========================*/ SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); /*=============================================*/ /* Evaluate commands from the file one by one. */ /*=============================================*/ while ((inchar = getc(theFile)) != EOF) { theString = ExpandStringWithChar(theEnv,inchar,theString,&position, &maxChars,maxChars+80); if (CompleteCommand(theString) != 0) { FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,OFF); RouteCommand(theEnv,theString,FALSE); FlushPPBuffer(theEnv); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushBindList(theEnv); genfree(theEnv,theString,(unsigned) maxChars); theString = NULL; maxChars = 0; position = 0; #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); #endif } if ((inchar == '\r') || (inchar == '\n')) { IncrementLineCount(theEnv); } } if (theString != NULL) { genfree(theEnv,theString,(unsigned) maxChars); } /*=======================*/ /* Close the batch file. */ /*=======================*/ GenClose(theEnv,theFile); /*========================================*/ /* Cleanup for capturing errors/warnings. */ /*========================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); DeleteErrorCaptureRouter(theEnv); SetLineCount(theEnv,oldLineCountValue); EnvSetParsingFileName(theEnv,oldParsingFileName); DeleteString(theEnv,oldParsingFileName); #endif return(TRUE); } #else /**************************************************/ /* EnvBatchStar: This is the non-functional stub */ /* provided for use with a run-time version. */ /**************************************************/ globle int EnvBatchStar( void *theEnv, const char *fileName) { PrintErrorID(theEnv,"FILECOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function batch* does not work in run time modules.\n"); return(FALSE); } #endif /***********************************************************/ /* LoadCommand: H/L access routine for the load command. */ /***********************************************************/ globle int LoadCommand( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) const char *theFileName; int rv; if (EnvArgCountCheck(theEnv,"load",EXACTLY,1) == -1) return(FALSE); if ((theFileName = GetFileName(theEnv,"load",1)) == NULL) return(FALSE); SetPrintWhileLoading(theEnv,TRUE); if ((rv = EnvLoad(theEnv,theFileName)) == FALSE) { SetPrintWhileLoading(theEnv,FALSE); OpenErrorMessage(theEnv,"load",theFileName); return(FALSE); } SetPrintWhileLoading(theEnv,FALSE); if (rv == -1) return(FALSE); return(TRUE); #else EnvPrintRouter(theEnv,WDIALOG,"Load is not available in this environment\n"); return(FALSE); #endif } /****************************************************************/ /* LoadStarCommand: H/L access routine for the load* command. */ /****************************************************************/ globle int LoadStarCommand( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) const char *theFileName; int rv; if (EnvArgCountCheck(theEnv,"load*",EXACTLY,1) == -1) return(FALSE); if ((theFileName = GetFileName(theEnv,"load*",1)) == NULL) return(FALSE); if ((rv = EnvLoad(theEnv,theFileName)) == FALSE) { OpenErrorMessage(theEnv,"load*",theFileName); return(FALSE); } if (rv == -1) return(FALSE); return(TRUE); #else EnvPrintRouter(theEnv,WDIALOG,"Load* is not available in this environment\n"); return(FALSE); #endif } #if DEBUGGING_FUNCTIONS /***********************************************************/ /* SaveCommand: H/L access routine for the save command. */ /***********************************************************/ globle int SaveCommand( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) const char *theFileName; if (EnvArgCountCheck(theEnv,"save",EXACTLY,1) == -1) return(FALSE); if ((theFileName = GetFileName(theEnv,"save",1)) == NULL) return(FALSE); if (EnvSave(theEnv,theFileName) == FALSE) { OpenErrorMessage(theEnv,"save",theFileName); return(FALSE); } return(TRUE); #else EnvPrintRouter(theEnv,WDIALOG,"Save is not available in this environment\n"); return(FALSE); #endif } #endif /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS globle intBool DribbleActive() { return EnvDribbleActive(GetCurrentEnvironment()); } globle intBool DribbleOn( const char *fileName) { return EnvDribbleOn(GetCurrentEnvironment(),fileName); } globle intBool DribbleOff() { return EnvDribbleOff(GetCurrentEnvironment()); } #endif /* DEBUGGING_FUNCTIONS */ globle int BatchStar( const char *fileName) { return EnvBatchStar(GetCurrentEnvironment(),fileName); } #endif /* ALLOW_ENVIRONMENT_GLOBALS */ clips_core_source_630/core/dffnxpsr.c0000755000175000017500000004347512461252076016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Deffunction Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* If the last construct in a loaded file is a */ /* deffunction or defmethod with no closing right */ /* parenthesis, an error should be issued, but is */ /* not. DR0872 */ /* */ /* Added pragmas to prevent unused variable */ /* warnings. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* ENVIRONMENT_API_ONLY no longer supported. */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #include "constant.h" #include "cstrcpsr.h" #include "constrct.h" #include "dffnxfun.h" #include "envrnmnt.h" #include "expressn.h" #include "exprnpsr.h" #include "extnfunc.h" #include "memalloc.h" #include "prccode.h" #include "router.h" #include "scanner.h" #include "symbol.h" #define _DFFNXPSR_SOURCE_ #include "dffnxpsr.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ValidDeffunctionName(void *,const char *); static DEFFUNCTION *AddDeffunction(void *,SYMBOL_HN *,EXPRESSION *,int,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************** NAME : ParseDeffunction DESCRIPTION : Parses the deffunction construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Creates valid deffunction definition NOTES : H/L Syntax : (deffunction [] (* []) *) ***************************************************************************/ globle intBool ParseDeffunction( void *theEnv, const char *readSource) { SYMBOL_HN *deffunctionName; EXPRESSION *actions; EXPRESSION *parameterList; SYMBOL_HN *wildcard; int min,max,lvars,DeffunctionError = FALSE; short overwrite = FALSE, owMin = 0, owMax = 0; DEFFUNCTION *dptr; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(deffunction "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"deffunctions"); return(TRUE); } #endif /* ===================================================== Parse the name and comment fields of the deffunction. ===================================================== */ deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction", EnvFindDeffunctionInModule,NULL, "!",TRUE,TRUE,TRUE,FALSE); if (deffunctionName == NULL) return(TRUE); if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE) return(TRUE); /*==========================*/ /* Parse the argument list. */ /*==========================*/ parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard, &min,&max,&DeffunctionError,NULL); if (DeffunctionError) return(TRUE); /*===================================================================*/ /* Go ahead and add the deffunction so it can be recursively called. */ /*===================================================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { dptr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(deffunctionName)); if (dptr == NULL) { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } else { overwrite = TRUE; owMin = (short) dptr->minNumberOfParameters; owMax = (short) dptr->maxNumberOfParameters; dptr->minNumberOfParameters = min; dptr->maxNumberOfParameters = max; } } else { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } if (dptr == NULL) { ReturnExpression(theEnv,parameterList); return(TRUE); } /*==================================================*/ /* Parse the actions contained within the function. */ /*==================================================*/ PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"deffunction",readSource, &DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard, NULL,NULL,&lvars,NULL); /*=============================================================*/ /* Check for the closing right parenthesis of the deffunction. */ /*=============================================================*/ if ((DeffunctionData(theEnv)->DFInputToken.type != RPAREN) && /* DR0872 */ (actions != NULL)) { SyntaxErrorMessage(theEnv,"deffunction"); ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } if (actions == NULL) { ReturnExpression(theEnv,parameterList); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffunction to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(FALSE); } /*=============================*/ /* Reformat the closing token. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm); SavePPBuffer(theEnv,"\n"); /*======================*/ /* Add the deffunction. */ /*======================*/ AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE); ReturnExpression(theEnv,parameterList); return(DeffunctionError); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************ NAME : ValidDeffunctionName DESCRIPTION : Determines if a new deffunction of the given name can be defined in the current module INPUTS : The new deffunction name RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed if not OK NOTES : GetConstructNameAndComment() (called before this function) ensures that the deffunction name does not conflict with one from another module ************************************************************/ static intBool ValidDeffunctionName( void *theEnv, const char *theDeffunctionName) { struct constructHeader *theDeffunction; #if DEFGENERIC_CONSTRUCT struct defmodule *theModule; struct constructHeader *theDefgeneric; #endif /* ============================================ A deffunction cannot be named the same as a construct type, e.g, defclass, defrule, etc. ============================================ */ if (FindConstruct(theEnv,theDeffunctionName) != NULL) { PrintErrorID(theEnv,"DFFNXPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n"); return(FALSE); } /* ============================================ A deffunction cannot be named the same as a pre-defined system function, e.g, watch, list-defrules, etc. ============================================ */ if (FindFunction(theEnv,theDeffunctionName) != NULL) { PrintErrorID(theEnv,"DFFNXPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n"); return(FALSE); } #if DEFGENERIC_CONSTRUCT /* ============================================ A deffunction cannot be named the same as a generic function (either in this module or imported from another) ============================================ */ theDefgeneric = (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName); if (theDefgeneric != NULL) { theModule = GetConstructModuleItem(theDefgeneric)->theModule; if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { PrintErrorID(theEnv,"DFFNXPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgeneric "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric)); EnvPrintRouter(theEnv,WERROR," imported from module "); EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n"); return(FALSE); } else { PrintErrorID(theEnv,"DFFNXPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n"); } return(FALSE); } #endif theDeffunction = (struct constructHeader *) EnvFindDeffunctionInModule(theEnv,theDeffunctionName); if (theDeffunction != NULL) { /* =========================================== And a deffunction in the current module can only be redefined if it is not executing. =========================================== */ if (((DEFFUNCTION *) theDeffunction)->executing) { PrintErrorID(theEnv,"DFNXPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction)); EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n"); return(FALSE); } } return(TRUE); } /**************************************************** NAME : AddDeffunction DESCRIPTION : Adds a deffunction to the list of deffunctions INPUTS : 1) The symbolic name 2) The action expressions 3) The minimum number of arguments 4) The maximum number of arguments (can be -1) 5) The number of local variables 6) A flag indicating if this is a header call so that the deffunction can be recursively called RETURNS : The new deffunction (NULL on errors) SIDE EFFECTS : Deffunction structures allocated NOTES : Assumes deffunction is not executing ****************************************************/ static DEFFUNCTION *AddDeffunction( void *theEnv, SYMBOL_HN *name, EXPRESSION *actions, int min, int max, int lvars, int headerp) { DEFFUNCTION *dfuncPtr; unsigned oldbusy; #if DEBUGGING_FUNCTIONS unsigned DFHadWatch = FALSE; #else #if MAC_XCD #pragma unused(headerp) #endif #endif /*===============================================================*/ /* If the deffunction doesn't exist, create a new structure to */ /* contain it and add it to the List of deffunctions. Otherwise, */ /* use the existing structure and remove the pretty print form */ /* and interpretive code. */ /*===============================================================*/ dfuncPtr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(name)); if (dfuncPtr == NULL) { dfuncPtr = get_struct(theEnv,deffunctionStruct); InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name); IncrementSymbolCount(name); dfuncPtr->code = NULL; dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; dfuncPtr->busy = 0; dfuncPtr->executing = 0; } else { #if DEBUGGING_FUNCTIONS DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr); #endif dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; oldbusy = dfuncPtr->busy; ExpressionDeinstall(theEnv,dfuncPtr->code); dfuncPtr->busy = oldbusy; ReturnPackedExpression(theEnv,dfuncPtr->code); dfuncPtr->code = NULL; EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,NULL); /* ======================================= Remove the deffunction from the list so that it can be added at the end ======================================= */ RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr); } AddConstructToModule((struct constructHeader *) dfuncPtr); /* ================================== Install the new interpretive code. ================================== */ if (actions != NULL) { /* =============================== If a deffunction is recursive, do not increment its busy count based on self-references =============================== */ oldbusy = dfuncPtr->busy; ExpressionInstall(theEnv,actions); dfuncPtr->busy = oldbusy; dfuncPtr->code = actions; } /* =============================================================== Install the pretty print form if memory is not being conserved. =============================================================== */ #if DEBUGGING_FUNCTIONS EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr); if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE)) EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,CopyPPBuffer(theEnv)); #endif return(dfuncPtr); } #endif /* DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ clips_core_source_630/core/analysis.c0000755000175000017500000013301012374672752016235 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* ANALYSIS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Analyzes LHS patterns to check for semantic */ /* errors and to determine variable comparisons and other */ /* tests which must be performed either in the pattern or */ /* join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Join network rework and optimizations. */ /* */ /*************************************************************/ #define _ANALYSIS_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "constant.h" #include "symbol.h" #include "memalloc.h" #include "exprnpsr.h" #include "reorder.h" #include "generate.h" #include "pattern.h" #include "router.h" #include "ruledef.h" #include "cstrnchk.h" #include "cstrnutl.h" #include "cstrnops.h" #include "rulecstr.h" #include "modulutl.h" #include "analysis.h" #include "watch.h" #include "rulepsr.h" #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int GetVariables(void *,struct lhsParseNode *,int,struct nandFrame *); static intBool UnboundVariablesInPattern(void *,struct lhsParseNode *,int); static int PropagateVariableToNodes(void *, struct lhsParseNode *, int, struct symbolHashNode *, struct lhsParseNode *, int,int,int); static struct lhsParseNode *CheckExpression(void *, struct lhsParseNode *, struct lhsParseNode *, int, struct symbolHashNode *, int); static void VariableReferenceErrorMessage(void *, struct symbolHashNode *, struct lhsParseNode *, int, struct symbolHashNode *, int); static int ProcessField(void *theEnv, struct lhsParseNode *, struct lhsParseNode *, struct lhsParseNode *, int, struct nandFrame *); static int ProcessVariable(void *, struct lhsParseNode *, struct lhsParseNode *, struct lhsParseNode *, int, struct nandFrame *); static void VariableMixingErrorMessage(void *,struct symbolHashNode *); static int PropagateVariableDriver(void *, struct lhsParseNode *, struct lhsParseNode *, struct lhsParseNode *, int,struct symbolHashNode *, struct lhsParseNode *, int,int); static int TestCEAnalysis(void *,struct lhsParseNode *,struct lhsParseNode *,int,int *,struct nandFrame *); static void ReleaseNandFrames(void *,struct nandFrame *); /******************************************************************/ /* VariableAnalysis: Propagates variables references to other */ /* variables in the LHS and determines if there are any illegal */ /* variable references (e.g. referring to an unbound variable). */ /* The propagation of variable references simply means all */ /* subsequent references of a variable are made to "point" back */ /* to the variable being propagated. */ /******************************************************************/ globle int VariableAnalysis( void *theEnv, struct lhsParseNode *patternPtr) { int errorFlag = FALSE; struct nandFrame *theNandFrames = NULL, *tempNandPtr; int currentDepth = 1; /*======================================================*/ /* Loop through all of the CEs in the rule to determine */ /* which variables refer to other variables and whether */ /* any semantic errors exist when refering to variables */ /* (such as referring to a variable that was not */ /* previously bound). */ /*======================================================*/ while (patternPtr != NULL) { /*==================================*/ /* If the nand depth is increasing, */ /* create a new nand frame. */ /*==================================*/ while (patternPtr->beginNandDepth > currentDepth) { tempNandPtr = get_struct(theEnv,nandFrame); tempNandPtr->nandCE = patternPtr; tempNandPtr->depth = currentDepth; tempNandPtr->next = theNandFrames; theNandFrames = tempNandPtr; currentDepth++; } /*=========================================================*/ /* If a pattern CE is encountered, propagate any variables */ /* found in the pattern and note any illegal references to */ /* other variables. */ /*=========================================================*/ if (patternPtr->type == PATTERN_CE) { /*====================================================*/ /* Determine if the fact address associated with this */ /* pattern illegally refers to other variables. */ /*====================================================*/ if ((patternPtr->value != NULL) && (patternPtr->referringNode != NULL)) { errorFlag = TRUE; if (patternPtr->referringNode->index == -1) { PrintErrorID(theEnv,"ANALYSIS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Duplicate pattern-address ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(patternPtr->value)); EnvPrintRouter(theEnv,WERROR," found in CE #"); PrintLongInteger(theEnv,WERROR,(long) patternPtr->whichCE); EnvPrintRouter(theEnv,WERROR,".\n"); } else { PrintErrorID(theEnv,"ANALYSIS",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Pattern-address ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(patternPtr->value)); EnvPrintRouter(theEnv,WERROR," used in CE #"); PrintLongInteger(theEnv,WERROR,(long) patternPtr->whichCE); EnvPrintRouter(theEnv,WERROR," was previously bound within a pattern CE.\n"); } } /*====================================================*/ /* Propagate the pattern and field location of bound */ /* variables found in this pattern to other variables */ /* in the same semantic scope as the bound variable. */ /*====================================================*/ if (GetVariables(theEnv,patternPtr,PATTERN_CE,theNandFrames)) { ReleaseNandFrames(theEnv,theNandFrames); return(TRUE); } /*==========================================================*/ /* Analyze any test CE that's been attached to the pattern. */ /*==========================================================*/ if (TestCEAnalysis(theEnv,patternPtr,patternPtr->expression,FALSE,&errorFlag,theNandFrames) == TRUE) { ReleaseNandFrames(theEnv,theNandFrames); return TRUE; } if (TestCEAnalysis(theEnv,patternPtr,patternPtr->secondaryExpression,TRUE,&errorFlag,theNandFrames) == TRUE) { ReleaseNandFrames(theEnv,theNandFrames); return TRUE; } } /*==============================================================*/ /* If a test CE is encountered, make sure that all references */ /* to variables have been previously bound. If they are bound */ /* then replace the references to variables with function calls */ /* to retrieve the variables. */ /*==============================================================*/ else if (patternPtr->type == TEST_CE) { if (TestCEAnalysis(theEnv,patternPtr,patternPtr->expression,FALSE,&errorFlag,theNandFrames) == TRUE) { ReleaseNandFrames(theEnv,theNandFrames); return TRUE; } } /*==================================*/ /* If the nand depth is decreasing, */ /* release the nand frames. */ /*==================================*/ while (patternPtr->endNandDepth < currentDepth) { tempNandPtr = theNandFrames->next; rtn_struct(theEnv,nandFrame,theNandFrames); theNandFrames = tempNandPtr; currentDepth--; } /*=====================================================*/ /* Move on to the next pattern in the LHS of the rule. */ /*=====================================================*/ patternPtr = patternPtr->bottom; } /*==========================================*/ /* Return the error status of the analysis. */ /*==========================================*/ return(errorFlag); } /******************************************************/ /* ReleaseNandFrames: Releases a list of nand frames. */ /******************************************************/ static void ReleaseNandFrames( void *theEnv, struct nandFrame *theFrames) { struct nandFrame *tmpFrame; while (theFrames != NULL) { tmpFrame = theFrames->next; rtn_struct(theEnv,nandFrame,theFrames); theFrames = tmpFrame; } } /*******************************************************************/ /* TestCEAnalysis: If a test CE is encountered, make sure that all */ /* references to variables have been previously bound. If they */ /* are bound then replace the references to variables with */ /* function calls to retrieve the variables. */ /*******************************************************************/ static int TestCEAnalysis( void *theEnv, struct lhsParseNode *patternPtr, struct lhsParseNode *theExpression, int secondary, int *errorFlag, struct nandFrame *theNandFrames) { struct lhsParseNode *rv, *theList, *tempList, *tempRight; if (theExpression == NULL) return FALSE; /*=====================================================*/ /* Verify that all variables were referenced properly. */ /*=====================================================*/ rv = CheckExpression(theEnv,theExpression,NULL,(int) patternPtr->whichCE,NULL,0); /*====================================================================*/ /* Temporarily disconnect the right nodes. If this is a pattern node */ /* with an attached test CE, we only want to propagate to following */ /* patterns, not to nodes of this pattern which preceded the test CE. */ /*====================================================================*/ tempRight = patternPtr->right; patternPtr->right = NULL; /*=========================================================*/ /* Determine the type and value constraints implied by the */ /* expression and propagate these constraints to other */ /* variables in the LHS. For example, the expression */ /* (+ ?x 1) implies that ?x is a number. */ /*=========================================================*/ theList = GetExpressionVarConstraints(theEnv,theExpression); for (tempList = theList; tempList != NULL; tempList = tempList->right) { if (PropagateVariableDriver(theEnv,patternPtr,patternPtr,NULL,SF_VARIABLE, (SYMBOL_HN *) tempList->value,tempList,FALSE,TEST_CE)) { ReturnLHSParseNodes(theEnv,theList); patternPtr->right = tempRight; return(TRUE); } } ReturnLHSParseNodes(theEnv,theList); /*============================*/ /* Reconnect the right nodes. */ /*============================*/ patternPtr->right = tempRight; /*========================================================*/ /* If the variables in the expression were all referenced */ /* properly, then create the expression to use in the */ /* join network. */ /*========================================================*/ if (rv != NULL) { *errorFlag = TRUE; } else if (secondary) { patternPtr->secondaryNetworkTest = CombineExpressions(theEnv,patternPtr->secondaryNetworkTest,GetvarReplace(theEnv,theExpression,FALSE,theNandFrames)); } else { patternPtr->networkTest = CombineExpressions(theEnv,patternPtr->networkTest,GetvarReplace(theEnv,theExpression,FALSE,theNandFrames)); } return FALSE; } /****************************************************************/ /* GetVariables: Loops through each field/slot within a pattern */ /* and propagates the pattern and field location of bound */ /* variables found in the pattern to other variables within */ /* the same semantic scope as the bound variables. */ /****************************************************************/ static int GetVariables( void *theEnv, struct lhsParseNode *thePattern, int patternHeadType, struct nandFrame *theNandFrames) { struct lhsParseNode *patternHead = thePattern; struct lhsParseNode *multifieldHeader = NULL; /*======================================================*/ /* Loop through all the fields/slots found in a pattern */ /* looking for binding instances of variables. */ /*======================================================*/ while (thePattern != NULL) { /*================================================*/ /* A multifield slot contains a sublist of fields */ /* that must be traversed and checked. */ /*================================================*/ if (thePattern->multifieldSlot) { multifieldHeader = thePattern; thePattern = thePattern->bottom; } /*==================================================*/ /* Propagate the binding occurences of single field */ /* variables, multifield variables, and fact */ /* addresses to other occurences of the variable. */ /* If an error is encountered, return TRUE. */ /*==================================================*/ if (thePattern != NULL) { if ((thePattern->type == SF_VARIABLE) || (thePattern->type == MF_VARIABLE) || ((thePattern->type == PATTERN_CE) && (thePattern->value != NULL))) { if (ProcessVariable(theEnv,thePattern,multifieldHeader,patternHead,patternHeadType,theNandFrames)) { return(TRUE); } } else { if (ProcessField(theEnv,thePattern,multifieldHeader,patternHead,patternHeadType,theNandFrames)) { return(TRUE); } } } /*===============================================*/ /* Move on to the next field/slot in the pattern */ /* or to the next field in a multifield slot. */ /*===============================================*/ if (thePattern == NULL) { thePattern = multifieldHeader; } else if ((thePattern->right == NULL) && (multifieldHeader != NULL)) { thePattern = multifieldHeader; multifieldHeader = NULL; } thePattern = thePattern->right; } /*===============================*/ /* Return FALSE to indicate that */ /* no errors were detected. */ /*===============================*/ return(FALSE); } /******************************************************/ /* ProcessVariable: Processes a single occurence of a */ /* variable by propagating references to it. */ /******************************************************/ static int ProcessVariable( void *theEnv, struct lhsParseNode *thePattern, struct lhsParseNode *multifieldHeader, struct lhsParseNode *patternHead, int patternHeadType, struct nandFrame *theNandFrames) { int theType; struct symbolHashNode *theVariable; struct constraintRecord *theConstraints; /*=============================================================*/ /* If a pattern address is being propagated, then treat it as */ /* a single field pattern variable and create a constraint */ /* which indicates that is must be a fact or instance address. */ /* This code will have to be modified for new data types which */ /* can match patterns. */ /*=============================================================*/ if (thePattern->type == PATTERN_CE) { theType = SF_VARIABLE; theVariable = (struct symbolHashNode *) thePattern->value; if (thePattern->derivedConstraints) RemoveConstraint(theEnv,thePattern->constraints); theConstraints = GetConstraintRecord(theEnv); thePattern->constraints = theConstraints; thePattern->constraints->anyAllowed = FALSE; thePattern->constraints->instanceAddressesAllowed = TRUE; thePattern->constraints->factAddressesAllowed = TRUE; thePattern->derivedConstraints = TRUE; } /*===================================================*/ /* Otherwise a pattern variable is being propagated. */ /*===================================================*/ else { theType = thePattern->type; theVariable = (struct symbolHashNode *) thePattern->value; } /*===================================================*/ /* Propagate the variable location to any additional */ /* fields associated with the binding variable. */ /*===================================================*/ if (thePattern->type != PATTERN_CE) { PropagateVariableToNodes(theEnv,thePattern->bottom,theType,theVariable, thePattern,patternHead->beginNandDepth, TRUE,FALSE); if (ProcessField(theEnv,thePattern,multifieldHeader,patternHead,patternHeadType,theNandFrames)) { return(TRUE); } } /*=================================================================*/ /* Propagate the constraints to other fields, slots, and patterns. */ /*=================================================================*/ return(PropagateVariableDriver(theEnv,patternHead,thePattern,multifieldHeader,theType, theVariable,thePattern,TRUE,patternHeadType)); } /*******************************************/ /* PropagateVariableDriver: Driver routine */ /* for propagating variable references. */ /*******************************************/ static int PropagateVariableDriver( void *theEnv, struct lhsParseNode *patternHead, struct lhsParseNode *theNode, struct lhsParseNode *multifieldHeader, int theType, struct symbolHashNode *variableName, struct lhsParseNode *theReference, int assignReference, int patternHeadType) { /*===================================================*/ /* Propagate the variable location to any additional */ /* constraints associated with the binding variable. */ /*===================================================*/ if (multifieldHeader != NULL) { if (PropagateVariableToNodes(theEnv,multifieldHeader->right,theType,variableName, theReference,patternHead->beginNandDepth,assignReference,FALSE)) { VariableMixingErrorMessage(theEnv,variableName); return(TRUE); } } /*========================================================*/ /* Propagate the variable location to fields/slots in the */ /* same pattern which appear after the binding variable. */ /*========================================================*/ if (PropagateVariableToNodes(theEnv,theNode->right,theType,variableName,theReference, patternHead->beginNandDepth,assignReference,FALSE)) { VariableMixingErrorMessage(theEnv,variableName); return(TRUE); } /*==============================================*/ /* Propagate the variable location to any test */ /* CEs which have been attached to the pattern. */ /*==============================================*/ if (PropagateVariableToNodes(theEnv,patternHead->expression,theType,variableName,theReference, patternHead->beginNandDepth,assignReference,TRUE)) { return(TRUE); } if (PropagateVariableToNodes(theEnv,patternHead->secondaryExpression,theType,variableName,theReference, patternHead->beginNandDepth,assignReference,TRUE)) { return(TRUE); } /*======================================================*/ /* Propagate values to other patterns if the pattern in */ /* which the variable is found is not a "not" CE or the */ /* last pattern within a nand CE. */ /*======================================================*/ if (((patternHead->type == PATTERN_CE) || (patternHead->type == TEST_CE)) && (patternHead->negated == FALSE) && (patternHead->exists == FALSE) && (patternHead->beginNandDepth <= patternHead->endNandDepth)) { int ignoreVariableMixing; /*============================================================*/ /* If the variables are propagated from a test CE, then don't */ /* check for mixing of single and multifield variables (since */ /* previously bound multifield variables typically have the $ */ /* removed when passed as an argument to a function unless */ /* sequence expansion is desired). */ /*============================================================*/ if (patternHeadType == TEST_CE) ignoreVariableMixing = TRUE; else ignoreVariableMixing = FALSE; /*==========================*/ /* Propagate the reference. */ /*==========================*/ if (PropagateVariableToNodes(theEnv,patternHead->bottom,theType,variableName,theReference, patternHead->beginNandDepth,assignReference, ignoreVariableMixing)) { VariableMixingErrorMessage(theEnv,variableName); return(TRUE); } } /*==============================================*/ /* Return FALSE to indicate that no errors were */ /* generated by the variable propagation. */ /*==============================================*/ return(FALSE); } /********************************************************/ /* ProcessField: Processes a field or slot of a pattern */ /* which does not contain a binding variable. */ /********************************************************/ static int ProcessField( void *theEnv, struct lhsParseNode *thePattern, struct lhsParseNode *multifieldHeader, struct lhsParseNode *patternHead, int patternHeadType, struct nandFrame *theNandFrames) { struct lhsParseNode *theList, *tempList; /*====================================================*/ /* Nothing needs to be done for the node representing */ /* the entire pattern. Return FALSE to indicate that */ /* no errors were generated. */ /*====================================================*/ if (thePattern->type == PATTERN_CE) return(FALSE); /*====================================================================*/ /* Derive a set of constraints based on values found in the slot or */ /* field. For example, if a slot can only contain the values 1, 2, or */ /* 3, the field constraint ~2 would generate a constraint record that */ /* only allows the value 1 or 3. Once generated, the constraints are */ /* propagated to other slots and fields. */ /*====================================================================*/ theList = DeriveVariableConstraints(theEnv,thePattern); for (tempList = theList; tempList != NULL; tempList = tempList->right) { if (PropagateVariableDriver(theEnv,patternHead,thePattern,multifieldHeader,tempList->type, (SYMBOL_HN *) tempList->value,tempList,FALSE,patternHeadType)) { ReturnLHSParseNodes(theEnv,theList); return(TRUE); } } ReturnLHSParseNodes(theEnv,theList); /*===========================================================*/ /* Check for "variable referenced, but not previously bound" */ /* errors. Return TRUE if this type of error is detected. */ /*===========================================================*/ if (UnboundVariablesInPattern(theEnv,thePattern,(int) patternHead->whichCE)) { return(TRUE); } /*==================================================*/ /* Check for constraint errors for this slot/field. */ /* If the slot/field has unmatchable constraints */ /* then return TRUE to indicate a semantic error. */ /*==================================================*/ if (ProcessConnectedConstraints(theEnv,thePattern,multifieldHeader,patternHead)) { return(TRUE); } /*==============================================================*/ /* Convert the slot/field constraint to a series of expressions */ /* that will be used in the pattern and join networks. */ /*==============================================================*/ FieldConversion(theEnv,thePattern,patternHead,theNandFrames); /*=========================================================*/ /* Return FALSE to indicate that no errors were generated. */ /*=========================================================*/ return(FALSE); } /*************************************************************/ /* PropagateVariableToNodes: Propagates variable references */ /* to all other variables within the semantic scope of the */ /* bound variable. That is, a variable reference cannot be */ /* beyond an enclosing not/and CE combination. The */ /* restriction of propagating variables beyond an enclosing */ /* not CE is handled within the GetVariables function. */ /*************************************************************/ static int PropagateVariableToNodes( void *theEnv, struct lhsParseNode *theNode, int theType, struct symbolHashNode *variableName, struct lhsParseNode *theReference, int startDepth, int assignReference, int ignoreVariableTypes) { struct constraintRecord *tempConstraints; /*===========================================*/ /* Traverse the nodes using the bottom link. */ /*===========================================*/ while (theNode != NULL) { /*==================================================*/ /* If the field/slot contains a predicate or return */ /* value constraint, then propagate the variable to */ /* the expression associated with that constraint. */ /*==================================================*/ if (theNode->expression != NULL) { PropagateVariableToNodes(theEnv,theNode->expression,theType,variableName, theReference,startDepth,assignReference,TRUE); } if (theNode->secondaryExpression != NULL) { PropagateVariableToNodes(theEnv,theNode->secondaryExpression,theType,variableName, theReference,startDepth,assignReference,TRUE); } /*======================================================*/ /* If the field/slot is a single or multifield variable */ /* with the same name as the propagated variable, */ /* then propagate the variable location to this node. */ /*======================================================*/ else if (((theNode->type == SF_VARIABLE) || (theNode->type == MF_VARIABLE)) && (theNode->value == (void *) variableName)) { /*======================================================*/ /* Check for mixing of single and multifield variables. */ /*======================================================*/ if (ignoreVariableTypes == FALSE) { if (((theType == SF_VARIABLE) && (theNode->type == MF_VARIABLE)) || ((theType == MF_VARIABLE) && (theNode->type == SF_VARIABLE))) { return(TRUE); } } /*======================================================*/ /* Intersect the propagated variable's constraints with */ /* the current constraints for this field/slot. */ /*======================================================*/ if ((theReference->constraints != NULL) && (! theNode->negated)) { tempConstraints = theNode->constraints; theNode->constraints = IntersectConstraints(theEnv,theReference->constraints, tempConstraints); if (theNode->derivedConstraints) { RemoveConstraint(theEnv,tempConstraints); } theNode->derivedConstraints = TRUE; } /*=====================================================*/ /* Don't propagate the variable if it originates from */ /* a different type of pattern object and the variable */ /* reference has already been resolved. */ /*=====================================================*/ if (assignReference) { if (theNode->referringNode == NULL) { theNode->referringNode = theReference; } else if (theReference->pattern == theNode->pattern) { theNode->referringNode = theReference; } else if (theReference->patternType == theNode->patternType) { theNode->referringNode = theReference; } } } /*========================================================*/ /* If the field/slot is the node representing the entire */ /* pattern, then propagate the variable location to the */ /* fact address associated with the pattern (if it is the */ /* same variable name). */ /*========================================================*/ else if ((theNode->type == PATTERN_CE) && (theNode->value == (void *) variableName) && (assignReference == TRUE)) { if (theType == MF_VARIABLE) return(TRUE); theNode->referringNode = theReference; } /*=====================================================*/ /* Propagate the variable to other fields contained */ /* within the same & field constraint or same pattern. */ /*=====================================================*/ if (theNode->right != NULL) { if (PropagateVariableToNodes(theEnv,theNode->right,theType,variableName, theReference,startDepth,assignReference,ignoreVariableTypes)) { return(TRUE); } } /*============================================================*/ /* Propagate the variable to other patterns within the same */ /* semantic scope (if dealing with the node for an entire */ /* pattern) or to the next | field constraint within a field. */ /*============================================================*/ if ((theNode->type == PATTERN_CE) || (theNode->type == TEST_CE)) { if (theNode->endNandDepth < startDepth) theNode = NULL; else theNode = theNode->bottom; } else { theNode = theNode->bottom; } } /*========================================================*/ /* Return FALSE to indicate that no errors were detected. */ /*========================================================*/ return(FALSE); } /*************************************************************/ /* UnboundVariablesInPattern: Verifies that variables within */ /* a slot/field have been referenced properly (i.e. that */ /* variables have been previously bound if they are not a */ /* binding occurrence). */ /*************************************************************/ static intBool UnboundVariablesInPattern( void *theEnv, struct lhsParseNode *theSlot, int pattern) { struct lhsParseNode *andField; struct lhsParseNode *rv; int result; struct lhsParseNode *orField; struct symbolHashNode *slotName; CONSTRAINT_RECORD *theConstraints; int theField; /*===================================================*/ /* If a multifield slot is being checked, then check */ /* each of the fields grouped with the multifield. */ /*===================================================*/ if (theSlot->multifieldSlot) { theSlot = theSlot->bottom; while (theSlot != NULL) { if (UnboundVariablesInPattern(theEnv,theSlot,pattern)) { return(TRUE); } theSlot = theSlot->right; } return(FALSE); } /*=======================*/ /* Check a single field. */ /*=======================*/ slotName = theSlot->slot; theField = theSlot->index; theConstraints = theSlot->constraints; /*===========================================*/ /* Loop through each of the '|' constraints. */ /*===========================================*/ for (orField = theSlot->bottom; orField != NULL; orField = orField->bottom) { /*===========================================*/ /* Loop through each of the fields connected */ /* by the '&' within the '|' constraint. */ /*===========================================*/ for (andField = orField; andField != NULL; andField = andField->right) { /*=======================================================*/ /* If this is not a binding occurence of a variable and */ /* there is no previous binding occurence of a variable, */ /* then generate an error message for a variable that is */ /* referred to but not bound. */ /*=======================================================*/ if (((andField->type == SF_VARIABLE) || (andField->type == MF_VARIABLE)) && (andField->referringNode == NULL)) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) andField->value,NULL,pattern, slotName,theField); return(TRUE); } /*==============================================*/ /* Check predicate and return value constraints */ /* to insure that all variables used within the */ /* constraint have been previously bound. */ /*==============================================*/ else if ((andField->type == PREDICATE_CONSTRAINT) || (andField->type == RETURN_VALUE_CONSTRAINT)) { rv = CheckExpression(theEnv,andField->expression,NULL,pattern,slotName,theField); if (rv != NULL) return(TRUE); } /*========================================================*/ /* If static constraint checking is being performed, then */ /* determine if constant values have violated the set of */ /* derived constraints for the slot/field (based on the */ /* deftemplate definition and propagated constraints). */ /*========================================================*/ else if (((andField->type == INTEGER) || (andField->type == FLOAT) || (andField->type == SYMBOL) || (andField->type == STRING) || (andField->type == INSTANCE_NAME)) && EnvGetStaticConstraintChecking(theEnv)) { result = ConstraintCheckValue(theEnv,andField->type,andField->value,theConstraints); if (result != NO_VIOLATION) { ConstraintViolationErrorMessage(theEnv,"A literal restriction value", NULL,FALSE,pattern, slotName,theField,result, theConstraints,TRUE); return(TRUE); } } } } /*===============================*/ /* Return FALSE to indicate that */ /* no errors were detected. */ /*===============================*/ return(FALSE); } /******************************************************************/ /* CheckExpression: Verifies that variables within an expression */ /* have been referenced properly. All variables within an */ /* expression must have been previously bound. */ /******************************************************************/ static struct lhsParseNode *CheckExpression( void *theEnv, struct lhsParseNode *exprPtr, struct lhsParseNode *lastOne, int whichCE, struct symbolHashNode *slotName, int theField) { struct lhsParseNode *rv; int i = 1; while (exprPtr != NULL) { /*===============================================================*/ /* Check that single field variables contained in the expression */ /* were previously defined in the LHS. Also check to see if the */ /* variable has unmatchable constraints. */ /*===============================================================*/ if (exprPtr->type == SF_VARIABLE) { if (exprPtr->referringNode == NULL) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne, whichCE,slotName,theField); return(exprPtr); } else if ((UnmatchableConstraint(exprPtr->constraints)) && EnvGetStaticConstraintChecking(theEnv)) { ConstraintReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne,i, whichCE,slotName,theField); return(exprPtr); } } /*==================================================*/ /* Check that multifield variables contained in the */ /* expression were previously defined in the LHS. */ /*==================================================*/ else if ((exprPtr->type == MF_VARIABLE) && (exprPtr->referringNode == NULL)) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne, whichCE,slotName,theField); return(exprPtr); } /*=====================================================*/ /* Check that global variables are referenced properly */ /* (i.e. if you reference a global variable, it must */ /* already be defined by a defglobal construct). */ /*=====================================================*/ #if DEFGLOBAL_CONSTRUCT else if (exprPtr->type == GBL_VARIABLE) { int count; if (FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(exprPtr->value), &count,TRUE,NULL) == NULL) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne, whichCE,slotName,theField); return(exprPtr); } } #endif /*============================================*/ /* Recursively check other function calls to */ /* insure variables are referenced correctly. */ /*============================================*/ else if (((exprPtr->type == FCALL) #if DEFGENERIC_CONSTRUCT || (exprPtr->type == GCALL) #endif #if DEFFUNCTION_CONSTRUCT || (exprPtr->type == PCALL) #endif ) && (exprPtr->bottom != NULL)) { if ((rv = CheckExpression(theEnv,exprPtr->bottom,exprPtr,whichCE,slotName,theField)) != NULL) { return(rv); } } /*=============================================*/ /* Move on to the next part of the expression. */ /*=============================================*/ i++; exprPtr = exprPtr->right; } /*================================================*/ /* Return NULL to indicate no error was detected. */ /*================================================*/ return(NULL); } /********************************************************/ /* VariableReferenceErrorMessage: Generic error message */ /* for referencing a variable before it is defined. */ /********************************************************/ static void VariableReferenceErrorMessage( void *theEnv, struct symbolHashNode *theVariable, struct lhsParseNode *theExpression, int whichCE, struct symbolHashNode *slotName, int theField) { struct expr *temprv; /*=============================*/ /* Print the error message ID. */ /*=============================*/ PrintErrorID(theEnv,"ANALYSIS",4,TRUE); /*=================================*/ /* Print the name of the variable. */ /*=================================*/ EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable)); EnvPrintRouter(theEnv,WERROR," "); /*=================================================*/ /* If the variable was found inside an expression, */ /* then print the expression. */ /*=================================================*/ if (theExpression != NULL) { whichCE = theExpression->whichCE; temprv = LHSParseNodesToExpression(theEnv,theExpression); ReturnExpression(theEnv,temprv->nextArg); temprv->nextArg = NULL; EnvPrintRouter(theEnv,WERROR,"found in the expression "); PrintExpression(theEnv,WERROR,temprv); EnvPrintRouter(theEnv,WERROR,"\n"); ReturnExpression(theEnv,temprv); } /*====================================================*/ /* Print the CE in which the variable was referenced. */ /*====================================================*/ EnvPrintRouter(theEnv,WERROR,"was referenced in CE #"); PrintLongInteger(theEnv,WERROR,(long int) whichCE); /*=====================================*/ /* Identify the slot or field in which */ /* the variable was found. */ /*=====================================*/ if (slotName == NULL) { if (theField > 0) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(slotName)); } EnvPrintRouter(theEnv,WERROR," before being defined.\n"); } /************************************************************/ /* VariableMixingErrorMessage: Prints the error message for */ /* the illegal mixing of single and multifield variables */ /* on the LHS of a rule. */ /************************************************************/ static void VariableMixingErrorMessage( void *theEnv, struct symbolHashNode *theVariable) { PrintErrorID(theEnv,"ANALYSIS",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable)); EnvPrintRouter(theEnv,WERROR," is used as both a single and multifield variable in the LHS\n"); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips_core_source_630/core/._bload.c0000755000175000017500000000040712500721260015667 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._envrnmnt.c0000755000175000017500000000040712500720752016462 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._evaluatn.h0000755000175000017500000000040712464554105016445 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._insfile.h0000755000175000017500000000040712464554105016257 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltbin.c0000755000175000017500000000040712373754243016456 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._msgcom.h0000755000175000017500000000040712424473402016107 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._rulecstr.c0000755000175000017500000000040712374023476016466 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._cstrncmp.h0000755000175000017500000000040712373714215016456 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrcbin.c0000755000175000017500000001314112373714232016210 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRUCT BINARY LOAD/SAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary load/save functions for construct */ /* headers. */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include "setup.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "envrnmnt.h" #if BLOAD_AND_BSAVE #include "bsave.h" #endif #include "moduldef.h" #define _CSTRCBIN_SOURCE_ #include "cstrcbin.h" #if BLOAD_AND_BSAVE /*************************************************** NAME : MarkConstructHeaderNeededItems DESCRIPTION : Marks symbols and other ephemerals needed by a construct header, and sets the binary-save id for the construct INPUTS : 1) The construct header 2) The binary-save id to assign RETURNS : Nothing useful SIDE EFFECTS : Id set and items marked NOTES : None ***************************************************/ globle void MarkConstructHeaderNeededItems( struct constructHeader *theConstruct, long theBsaveID) { theConstruct->name->neededSymbol = TRUE; theConstruct->bsaveID = theBsaveID; } /****************************************************** NAME : AssignBsaveConstructHeaderVals DESCRIPTION : Assigns value to the construct header for saving in the binary file INPUTS : 1) The binary-save buffer for the construct header values 2) The actual construct header RETURNS : Nothing useful SIDE EFFECTS : Binary-save buffer for construct header written with appropriate values NOTES : Assumes that module items for this construct were saved in the same order as the defmodules. The defmodule binary-save id is used for the whichModule id of this construct. ******************************************************/ globle void AssignBsaveConstructHeaderVals( struct bsaveConstructHeader *theBsaveConstruct, struct constructHeader *theConstruct) { theBsaveConstruct->name = (long) theConstruct->name->bucket; theBsaveConstruct->whichModule = theConstruct->whichModule->theModule->bsaveID; if (theConstruct->next != NULL) theBsaveConstruct->next = ((struct constructHeader *) theConstruct->next)->bsaveID; else theBsaveConstruct->next = -1L; } #endif /* BLOAD_AND_BSAVE */ /*************************************************** NAME : UpdateConstructHeader DESCRIPTION : Determines field values for construct header from binary-load buffer INPUTS : 1) The binary-load data for the construct header 2) The actual construct header 3) The size of a defmodule item for this construct 4) The array of all defmodule items for this construct 5) The size of this construct 6) The array of these constructs RETURNS : Nothing useful SIDE EFFECTS : Header values set NOTES : None ***************************************************/ LOCALE void UpdateConstructHeader( void *theEnv, struct bsaveConstructHeader *theBsaveConstruct, struct constructHeader *theConstruct, int itemModuleSize, void *itemModuleArray, int itemSize, void *itemArray) { long moduleOffset, itemOffset; moduleOffset = itemModuleSize * theBsaveConstruct->whichModule; theConstruct->whichModule = (struct defmoduleItemHeader *) &((char *) itemModuleArray)[moduleOffset]; theConstruct->name = SymbolPointer(theBsaveConstruct->name); IncrementSymbolCount(theConstruct->name); if (theBsaveConstruct->next != -1L) { itemOffset = itemSize * theBsaveConstruct->next; theConstruct->next = (struct constructHeader *) &((char *) itemArray)[itemOffset]; } else theConstruct->next = NULL; theConstruct->ppForm = NULL; theConstruct->bsaveID = 0L; theConstruct->usrData = NULL; } /******************************************************* NAME : UnmarkConstructHeader DESCRIPTION : Releases any ephemerals (symbols, etc.) of a construct header for removal INPUTS : The construct header RETURNS : Nothing useful SIDE EFFECTS : Busy counts fo ephemerals decremented NOTES : None *******************************************************/ globle void UnmarkConstructHeader( void *theEnv, struct constructHeader *theConstruct) { DecrementSymbolCount(theEnv,theConstruct->name); } #endif /* BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE */ clips_core_source_630/core/proflfun.c0000755000175000017500000007337712375756071016266 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* CONSTRUCT PROFILING FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for profiling the amount of */ /* time spent in constructs and user defined functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modified OutputProfileInfo to allow a before */ /* and after prefix so that a string buffer does */ /* not need to be created to contain the entire */ /* prefix. This allows a buffer overflow problem */ /* to be corrected. DR0857. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /* 6.30: Used gensprintf instead of sprintf. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _PROFLFUN_SOURCE_ #include "setup.h" #if PROFILING_FUNCTIONS #include "argacces.h" #include "classcom.h" #include "dffnxfun.h" #include "envrnmnt.h" #include "extnfunc.h" #include "genrccom.h" #include "genrcfun.h" #include "memalloc.h" #include "msgcom.h" #include "router.h" #include "sysdep.h" #include "proflfun.h" #include #define NO_PROFILE 0 #define USER_FUNCTIONS 1 #define CONSTRUCTS_CODE 2 #define OUTPUT_STRING "%-40s %7ld %15.6f %8.2f%% %15.6f %8.2f%%\n" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool OutputProfileInfo(void *,const char *,struct constructProfileInfo *, const char *,const char *,const char *,const char **); static void OutputUserFunctionsInfo(void *); static void OutputConstructsCodeInfo(void *); #if (! RUN_TIME) static void ProfileClearFunction(void *); #endif /******************************************************/ /* ConstructProfilingFunctionDefinitions: Initializes */ /* the construct profiling functions. */ /******************************************************/ globle void ConstructProfilingFunctionDefinitions( void *theEnv) { struct userDataRecord profileDataInfo = { 0, CreateProfileData, DeleteProfileData }; AllocateEnvironmentData(theEnv,PROFLFUN_DATA,sizeof(struct profileFunctionData),NULL); memcpy(&ProfileFunctionData(theEnv)->ProfileDataInfo,&profileDataInfo,sizeof(struct userDataRecord)); ProfileFunctionData(theEnv)->LastProfileInfo = NO_PROFILE; ProfileFunctionData(theEnv)->PercentThreshold = 0.0; ProfileFunctionData(theEnv)->OutputString = OUTPUT_STRING; #if ! RUN_TIME EnvDefineFunction2(theEnv,"profile",'v', PTIEF ProfileCommand,"ProfileCommand","11w"); EnvDefineFunction2(theEnv,"profile-info",'v', PTIEF ProfileInfoCommand,"ProfileInfoCommand","01w"); EnvDefineFunction2(theEnv,"profile-reset",'v', PTIEF ProfileResetCommand,"ProfileResetCommand","00"); EnvDefineFunction2(theEnv,"set-profile-percent-threshold",'d', PTIEF SetProfilePercentThresholdCommand, "SetProfilePercentThresholdCommand","11n"); EnvDefineFunction2(theEnv,"get-profile-percent-threshold",'d', PTIEF GetProfilePercentThresholdCommand, "GetProfilePercentThresholdCommand","00"); ProfileFunctionData(theEnv)->ProfileDataID = InstallUserDataRecord(theEnv,&ProfileFunctionData(theEnv)->ProfileDataInfo); EnvAddClearFunction(theEnv,"profile",ProfileClearFunction,0); #endif } /**********************************/ /* CreateProfileData: Allocates a */ /* profile user data structure. */ /**********************************/ globle void *CreateProfileData( void *theEnv) { struct constructProfileInfo *theInfo; theInfo = (struct constructProfileInfo *) genalloc(theEnv,sizeof(struct constructProfileInfo)); theInfo->numberOfEntries = 0; theInfo->childCall = FALSE; theInfo->startTime = 0.0; theInfo->totalSelfTime = 0.0; theInfo->totalWithChildrenTime = 0.0; return(theInfo); } /**************************************/ /* DeleteProfileData: */ /**************************************/ globle void DeleteProfileData( void *theEnv, void *theData) { genfree(theEnv,theData,sizeof(struct constructProfileInfo)); } /**************************************/ /* ProfileCommand: H/L access routine */ /* for the profile command. */ /**************************************/ globle void ProfileCommand( void *theEnv) { const char *argument; DATA_OBJECT theValue; if (EnvArgCountCheck(theEnv,"profile",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"profile",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); if (! Profile(theEnv,argument)) { ExpectedTypeError1(theEnv,"profile",1,"symbol with value constructs, user-functions, or off"); return; } return; } /******************************/ /* Profile: C access routine */ /* for the profile command. */ /******************************/ globle intBool Profile( void *theEnv, const char *argument) { /*======================================================*/ /* If the argument is the symbol "user-functions", then */ /* user-defined functions should be profiled. If the */ /* argument is the symbol "constructs", then */ /* deffunctions, generic functions, message-handlers, */ /* and rule RHS actions are profiled. */ /*======================================================*/ if (strcmp(argument,"user-functions") == 0) { ProfileFunctionData(theEnv)->ProfileStartTime = gentime(); ProfileFunctionData(theEnv)->ProfileUserFunctions = TRUE; ProfileFunctionData(theEnv)->ProfileConstructs = FALSE; ProfileFunctionData(theEnv)->LastProfileInfo = USER_FUNCTIONS; } else if (strcmp(argument,"constructs") == 0) { ProfileFunctionData(theEnv)->ProfileStartTime = gentime(); ProfileFunctionData(theEnv)->ProfileUserFunctions = FALSE; ProfileFunctionData(theEnv)->ProfileConstructs = TRUE; ProfileFunctionData(theEnv)->LastProfileInfo = CONSTRUCTS_CODE; } /*======================================================*/ /* Otherwise, if the argument is the symbol "off", then */ /* don't profile constructs and user-defined functions. */ /*======================================================*/ else if (strcmp(argument,"off") == 0) { ProfileFunctionData(theEnv)->ProfileEndTime = gentime(); ProfileFunctionData(theEnv)->ProfileTotalTime += (ProfileFunctionData(theEnv)->ProfileEndTime - ProfileFunctionData(theEnv)->ProfileStartTime); ProfileFunctionData(theEnv)->ProfileUserFunctions = FALSE; ProfileFunctionData(theEnv)->ProfileConstructs = FALSE; } /*=====================================================*/ /* Otherwise, generate an error since the only allowed */ /* arguments are "on" or "off." */ /*=====================================================*/ else { return(FALSE); } return(TRUE); } /******************************************/ /* ProfileInfoCommand: H/L access routine */ /* for the profile-info command. */ /******************************************/ globle void ProfileInfoCommand( void *theEnv) { int argCount; DATA_OBJECT theValue; char buffer[512]; /*===================================*/ /* The profile-info command expects */ /* at most a single symbol argument. */ /*===================================*/ if ((argCount = EnvArgCountCheck(theEnv,"profile",NO_MORE_THAN,1)) == -1) return; /*===========================================*/ /* The first profile-info argument indicates */ /* the field on which sorting is performed. */ /*===========================================*/ if (argCount == 1) { if (EnvArgTypeCheck(theEnv,"profile",1,SYMBOL,&theValue) == FALSE) return; } /*==================================*/ /* If code is still being profiled, */ /* update the profile end time. */ /*==================================*/ if (ProfileFunctionData(theEnv)->ProfileUserFunctions || ProfileFunctionData(theEnv)->ProfileConstructs) { ProfileFunctionData(theEnv)->ProfileEndTime = gentime(); ProfileFunctionData(theEnv)->ProfileTotalTime += (ProfileFunctionData(theEnv)->ProfileEndTime - ProfileFunctionData(theEnv)->ProfileStartTime); } /*==================================*/ /* Print the profiling information. */ /*==================================*/ if (ProfileFunctionData(theEnv)->LastProfileInfo != NO_PROFILE) { gensprintf(buffer,"Profile elapsed time = %g seconds\n", ProfileFunctionData(theEnv)->ProfileTotalTime); EnvPrintRouter(theEnv,WDISPLAY,buffer); if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) { EnvPrintRouter(theEnv,WDISPLAY,"Function Name "); } else if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) { EnvPrintRouter(theEnv,WDISPLAY,"Construct Name "); } EnvPrintRouter(theEnv,WDISPLAY,"Entries Time % Time+Kids %+Kids\n"); if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) { EnvPrintRouter(theEnv,WDISPLAY,"------------- "); } else if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) { EnvPrintRouter(theEnv,WDISPLAY,"-------------- "); } EnvPrintRouter(theEnv,WDISPLAY,"------- ------ ----- --------- ------\n"); } if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) OutputUserFunctionsInfo(theEnv); if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) OutputConstructsCodeInfo(theEnv); } /**********************************************/ /* StartProfile: Initiates bookkeeping needed */ /* to profile a construct or function. */ /**********************************************/ globle void StartProfile( void *theEnv, struct profileFrameInfo *theFrame, struct userData **theList, intBool checkFlag) { double startTime, addTime; struct constructProfileInfo *profileInfo; if (! checkFlag) { theFrame->profileOnExit = FALSE; return; } profileInfo = (struct constructProfileInfo *) FetchUserData(theEnv,ProfileFunctionData(theEnv)->ProfileDataID,theList); theFrame->profileOnExit = TRUE; theFrame->parentCall = FALSE; startTime = gentime(); theFrame->oldProfileFrame = ProfileFunctionData(theEnv)->ActiveProfileFrame; if (ProfileFunctionData(theEnv)->ActiveProfileFrame != NULL) { addTime = startTime - ProfileFunctionData(theEnv)->ActiveProfileFrame->startTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->totalSelfTime += addTime; } ProfileFunctionData(theEnv)->ActiveProfileFrame = profileInfo; ProfileFunctionData(theEnv)->ActiveProfileFrame->numberOfEntries++; ProfileFunctionData(theEnv)->ActiveProfileFrame->startTime = startTime; if (! ProfileFunctionData(theEnv)->ActiveProfileFrame->childCall) { theFrame->parentCall = TRUE; theFrame->parentStartTime = startTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->childCall = TRUE; } } /*******************************************/ /* EndProfile: Finishes bookkeeping needed */ /* to profile a construct or function. */ /*******************************************/ globle void EndProfile( void *theEnv, struct profileFrameInfo *theFrame) { double endTime, addTime; if (! theFrame->profileOnExit) return; endTime = gentime(); if (theFrame->parentCall) { addTime = endTime - theFrame->parentStartTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->totalWithChildrenTime += addTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->childCall = FALSE; } ProfileFunctionData(theEnv)->ActiveProfileFrame->totalSelfTime += (endTime - ProfileFunctionData(theEnv)->ActiveProfileFrame->startTime); if (theFrame->oldProfileFrame != NULL) { theFrame->oldProfileFrame->startTime = endTime; } ProfileFunctionData(theEnv)->ActiveProfileFrame = theFrame->oldProfileFrame; } /******************************************/ /* OutputProfileInfo: Prints out a single */ /* line of profile information. */ /******************************************/ static intBool OutputProfileInfo( void *theEnv, const char *itemName, struct constructProfileInfo *profileInfo, const char *printPrefixBefore, const char *printPrefix, const char *printPrefixAfter, const char **banner) { double percent = 0.0, percentWithKids = 0.0; char buffer[512]; if (profileInfo == NULL) return(FALSE); if (profileInfo->numberOfEntries == 0) return(FALSE); if (ProfileFunctionData(theEnv)->ProfileTotalTime != 0.0) { percent = (profileInfo->totalSelfTime * 100.0) / ProfileFunctionData(theEnv)->ProfileTotalTime; if (percent < 0.005) percent = 0.0; percentWithKids = (profileInfo->totalWithChildrenTime * 100.0) / ProfileFunctionData(theEnv)->ProfileTotalTime; if (percentWithKids < 0.005) percentWithKids = 0.0; } if (percent < ProfileFunctionData(theEnv)->PercentThreshold) return(FALSE); if ((banner != NULL) && (*banner != NULL)) { EnvPrintRouter(theEnv,WDISPLAY,*banner); *banner = NULL; } if (printPrefixBefore != NULL) { EnvPrintRouter(theEnv,WDISPLAY,printPrefixBefore); } if (printPrefix != NULL) { EnvPrintRouter(theEnv,WDISPLAY,printPrefix); } if (printPrefixAfter != NULL) { EnvPrintRouter(theEnv,WDISPLAY,printPrefixAfter); } if (strlen(itemName) >= 40) { EnvPrintRouter(theEnv,WDISPLAY,itemName); EnvPrintRouter(theEnv,WDISPLAY,"\n"); itemName = ""; } gensprintf(buffer,ProfileFunctionData(theEnv)->OutputString, itemName, (long) profileInfo->numberOfEntries, (double) profileInfo->totalSelfTime, (double) percent, (double) profileInfo->totalWithChildrenTime, (double) percentWithKids); EnvPrintRouter(theEnv,WDISPLAY,buffer); return(TRUE); } /*******************************************/ /* ProfileResetCommand: H/L access routine */ /* for the profile-reset command. */ /*******************************************/ globle void ProfileResetCommand( void *theEnv) { struct FunctionDefinition *theFunction; int i; #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *theDeffunction; #endif #if DEFRULE_CONSTRUCT struct defrule *theDefrule; #endif #if DEFGENERIC_CONSTRUCT DEFGENERIC *theDefgeneric; unsigned int methodIndex; DEFMETHOD *theMethod; #endif #if OBJECT_SYSTEM DEFCLASS *theDefclass; HANDLER *theHandler; unsigned handlerIndex; #endif ProfileFunctionData(theEnv)->ProfileStartTime = 0.0; ProfileFunctionData(theEnv)->ProfileEndTime = 0.0; ProfileFunctionData(theEnv)->ProfileTotalTime = 0.0; ProfileFunctionData(theEnv)->LastProfileInfo = NO_PROFILE; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theFunction->usrData)); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,EvaluationData(theEnv)->PrimitivesArray[i]->usrData)); } } #if DEFFUNCTION_CONSTRUCT for (theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); theDeffunction != NULL; theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDeffunction->header.usrData)); } #endif #if DEFRULE_CONSTRUCT for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefrule->header.usrData)); } #endif #if DEFGENERIC_CONSTRUCT for (theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); theDefgeneric != NULL; theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefgeneric->header.usrData)); for (methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,0); methodIndex != 0; methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,methodIndex)) { theMethod = GetDefmethodPointer(theDefgeneric,methodIndex); ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theMethod->usrData)); } } #endif #if OBJECT_SYSTEM for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); theDefclass != NULL; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,theDefclass)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefclass->header.usrData)); for (handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,0); handlerIndex != 0; handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,handlerIndex)) { theHandler = GetDefmessageHandlerPointer(theDefclass,handlerIndex); ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theHandler->usrData)); } } #endif } /*************************************************/ /* ResetProfileInfo: Sets the initial values for */ /* a constructProfileInfo data structure. */ /*************************************************/ globle void ResetProfileInfo( struct constructProfileInfo *profileInfo) { if (profileInfo == NULL) return; profileInfo->numberOfEntries = 0; profileInfo->childCall = FALSE; profileInfo->startTime = 0.0; profileInfo->totalSelfTime = 0.0; profileInfo->totalWithChildrenTime = 0.0; } /*************************************************/ /* OutputUserFunctionsInfo: */ /*************************************************/ static void OutputUserFunctionsInfo( void *theEnv) { struct FunctionDefinition *theFunction; int i; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { OutputProfileInfo(theEnv,ValueToString(theFunction->callFunctionName), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, theFunction->usrData), NULL,NULL,NULL,NULL); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { OutputProfileInfo(theEnv,EvaluationData(theEnv)->PrimitivesArray[i]->name, (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, EvaluationData(theEnv)->PrimitivesArray[i]->usrData), NULL,NULL,NULL,NULL); } } } /*************************************************/ /* OutputConstructsCodeInfo: */ /*************************************************/ static void OutputConstructsCodeInfo( void *theEnv) { #if (! DEFFUNCTION_CONSTRUCT) && (! DEFGENERIC_CONSTRUCT) && (! OBJECT_SYSTEM) && (! DEFRULE_CONSTRUCT) #pragma unused(theEnv) #endif #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *theDeffunction; #endif #if DEFRULE_CONSTRUCT struct defrule *theDefrule; #endif #if DEFGENERIC_CONSTRUCT DEFGENERIC *theDefgeneric; DEFMETHOD *theMethod; unsigned methodIndex; char methodBuffer[512]; #endif #if OBJECT_SYSTEM DEFCLASS *theDefclass; HANDLER *theHandler; unsigned handlerIndex; #endif #if DEFGENERIC_CONSTRUCT || OBJECT_SYSTEM const char *prefix, *prefixBefore, *prefixAfter; #endif const char *banner; banner = "\n*** Deffunctions ***\n\n"; #if DEFFUNCTION_CONSTRUCT for (theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); theDeffunction != NULL; theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction)) { OutputProfileInfo(theEnv,EnvGetDeffunctionName(theEnv,theDeffunction), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDeffunction->header.usrData), NULL,NULL,NULL,&banner); } #endif banner = "\n*** Defgenerics ***\n"; #if DEFGENERIC_CONSTRUCT for (theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); theDefgeneric != NULL; theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric)) { prefixBefore = "\n"; prefix = EnvGetDefgenericName(theEnv,theDefgeneric); prefixAfter = "\n"; for (methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,0); methodIndex != 0; methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,methodIndex)) { theMethod = GetDefmethodPointer(theDefgeneric,methodIndex); EnvGetDefmethodDescription(theEnv,methodBuffer,510,theDefgeneric,methodIndex); if (OutputProfileInfo(theEnv,methodBuffer, (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theMethod->usrData), prefixBefore,prefix,prefixAfter,&banner)) { prefixBefore = NULL; prefix = NULL; prefixAfter = NULL; } } } #endif banner = "\n*** Defclasses ***\n"; #if OBJECT_SYSTEM for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); theDefclass != NULL; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,theDefclass)) { prefixAfter = "\n"; prefix = EnvGetDefclassName(theEnv,theDefclass); prefixBefore = "\n"; for (handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,0); handlerIndex != 0; handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,handlerIndex)) { theHandler = GetDefmessageHandlerPointer(theDefclass,handlerIndex); if (OutputProfileInfo(theEnv,EnvGetDefmessageHandlerName(theEnv,theDefclass,handlerIndex), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, theHandler->usrData), prefixBefore,prefix,prefixAfter,&banner)) { prefixBefore = NULL; prefix = NULL; prefixAfter = NULL; } } } #endif banner = "\n*** Defrules ***\n\n"; #if DEFRULE_CONSTRUCT for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { OutputProfileInfo(theEnv,EnvGetDefruleName(theEnv,theDefrule), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefrule->header.usrData), NULL,NULL,NULL,&banner); } #endif } /*********************************************************/ /* SetProfilePercentThresholdCommand: H/L access routine */ /* for the set-profile-percent-threshold command. */ /*********************************************************/ globle double SetProfilePercentThresholdCommand( void *theEnv) { DATA_OBJECT theValue; double newThreshold; if (EnvArgCountCheck(theEnv,"set-profile-percent-threshold",EXACTLY,1) == -1) { return(ProfileFunctionData(theEnv)->PercentThreshold); } if (EnvArgTypeCheck(theEnv,"set-profile-percent-threshold",1,INTEGER_OR_FLOAT,&theValue) == FALSE) { return(ProfileFunctionData(theEnv)->PercentThreshold); } if (GetType(theValue) == INTEGER) { newThreshold = (double) DOToLong(theValue); } else { newThreshold = (double) DOToDouble(theValue); } if ((newThreshold < 0.0) || (newThreshold > 100.0)) { ExpectedTypeError1(theEnv,"set-profile-percent-threshold",1, "number in the range 0 to 100"); return(-1.0); } return(SetProfilePercentThreshold(theEnv,newThreshold)); } /****************************************************/ /* SetProfilePercentThreshold: C access routine for */ /* the set-profile-percent-threshold command. */ /****************************************************/ globle double SetProfilePercentThreshold( void *theEnv, double value) { double oldPercentThreshhold; if ((value < 0.0) || (value > 100.0)) { return(-1.0); } oldPercentThreshhold = ProfileFunctionData(theEnv)->PercentThreshold; ProfileFunctionData(theEnv)->PercentThreshold = value; return(oldPercentThreshhold); } /*********************************************************/ /* GetProfilePercentThresholdCommand: H/L access routine */ /* for the get-profile-percent-threshold command. */ /*********************************************************/ globle double GetProfilePercentThresholdCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-profile-percent-threshold",EXACTLY,0); return(ProfileFunctionData(theEnv)->PercentThreshold); } /****************************************************/ /* GetProfilePercentThreshold: C access routine for */ /* the get-profile-percent-threshold command. */ /****************************************************/ globle double GetProfilePercentThreshold( void *theEnv) { return(ProfileFunctionData(theEnv)->PercentThreshold); } /**********************************************************/ /* SetProfileOutputString: Sets the output string global. */ /**********************************************************/ globle const char *SetProfileOutputString( void *theEnv, const char *value) { const char *oldOutputString; if (value == NULL) { return(ProfileFunctionData(theEnv)->OutputString); } oldOutputString = ProfileFunctionData(theEnv)->OutputString; ProfileFunctionData(theEnv)->OutputString = value; return(oldOutputString); } #if (! RUN_TIME) /******************************************************************/ /* ProfileClearFunction: Profiling clear routine for use with the */ /* clear command. Removes user data attached to user functions. */ /******************************************************************/ static void ProfileClearFunction( void *theEnv) { struct FunctionDefinition *theFunction; int i; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { theFunction->usrData = DeleteUserData(theEnv,ProfileFunctionData(theEnv)->ProfileDataID,theFunction->usrData); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { EvaluationData(theEnv)->PrimitivesArray[i]->usrData = DeleteUserData(theEnv,ProfileFunctionData(theEnv)->ProfileDataID,EvaluationData(theEnv)->PrimitivesArray[i]->usrData); } } } #endif #endif /* PROFILING_FUNCTIONS */ clips_core_source_630/core/._filertr.c0000755000175000017500000000040712461762346016275 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/developr.h0000755000175000017500000000526712373721363016243 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEVELOPER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Changed garbage collection algorithm. */ /* Functions enable-gc-heuristics and */ /* disable-gc-heuristics are no longer supported. */ /* */ /* Changed integer type/precision. */ /* */ /*************************************************************/ #ifndef _H_developr #define _H_developr #ifdef LOCALE #undef LOCALE #endif #ifdef _DEVELOPR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeveloperCommands(void *); LOCALE void PrimitiveTablesInfo(void *); LOCALE void PrimitiveTablesUsage(void *); #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT LOCALE void ShowFactPatternNetwork(void *); LOCALE intBool ValidateFactIntegrity(void *); #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void PrintObjectPatternNetwork(void *); #endif #if OBJECT_SYSTEM LOCALE void InstanceTableUsage(void *); #endif #if DEFRULE_CONSTRUCT LOCALE void ValidateBetaMemories(void *); #endif #endif /* _H_developr */ clips_core_source_630/core/._strngfun.h0000755000175000017500000000040712373755535016505 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._prntutil.c0000755000175000017500000000040712424474566016512 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objrtbin.c0000755000175000017500000005270212374023204016211 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions Defrule */ /* Object Pattern Network */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* ResetObjectMatchTimeTags did not pass in the */ /* environment argument when BLOAD_ONLY was set. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Added support for hashed alpha memories. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "memalloc.h" #include "insfun.h" #include "objrtmch.h" #include "reteutil.h" #include "rulebin.h" #define _OBJRTBIN_SOURCE_ #include "objrtbin.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef unsigned long UNLN; typedef struct bsaveObjectPatternNode { unsigned multifieldNode : 1; unsigned endSlot : 1; unsigned selector : 1; unsigned whichField : 8; unsigned short leaveFields; unsigned slotNameID; long networkTest, nextLevel, lastLevel, leftNode, rightNode, alphaNode; } BSAVE_OBJECT_PATTERN_NODE; typedef struct bsaveObjectAlphaNode { struct bsavePatternNodeHeader header; long classbmp, slotbmp, patternNode, nxtInGroup, nxtTerminal; } BSAVE_OBJECT_ALPHA_NODE; #define BsaveObjectPatternIndex(op) ((op != NULL) ? op->bsaveID : -1L) #define BsaveObjectAlphaIndex(ap) ((ap != NULL) ? ap->bsaveID : -1L) #define ObjectPatternPointer(i) ((i == -1L) ? NULL : (OBJECT_PATTERN_NODE *) &ObjectReteBinaryData(theEnv)->PatternArray[i]) #define ObjectAlphaPointer(i) ((i == -1L) ? NULL : (OBJECT_ALPHA_NODE *) &ObjectReteBinaryData(theEnv)->AlphaArray[i]) /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveObjectPatternsFind(void *); static void BsaveStorageObjectPatterns(void *,FILE *); static void BsaveObjectPatterns(void *,FILE *); #endif static void BloadStorageObjectPatterns(void *); static void BloadObjectPatterns(void *); static void UpdateAlpha(void *,void *,long); static void UpdatePattern(void *,void *,long); static void ClearBloadObjectPatterns(void *); static void DeallocateObjectReteBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupObjectPatternsBload DESCRIPTION : Initializes data structures and routines for binary loads of generic function constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupObjectPatternsBload( void *theEnv) { AllocateEnvironmentData(theEnv,OBJECTRETEBIN_DATA,sizeof(struct objectReteBinaryData),DeallocateObjectReteBinaryData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"object patterns",0,BsaveObjectPatternsFind,NULL, BsaveStorageObjectPatterns,BsaveObjectPatterns, BloadStorageObjectPatterns,BloadObjectPatterns, ClearBloadObjectPatterns); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"object patterns",0,NULL,NULL,NULL,NULL, BloadStorageObjectPatterns,BloadObjectPatterns, ClearBloadObjectPatterns); #endif } /***********************************************************/ /* DeallocateObjectReteBinaryData: Deallocates environment */ /* data for object rete binary functionality. */ /***********************************************************/ static void DeallocateObjectReteBinaryData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) size_t space; long i; for (i = 0; i < ObjectReteBinaryData(theEnv)->AlphaNodeCount; i++) { DestroyAlphaMemory(theEnv,&ObjectReteBinaryData(theEnv)->AlphaArray[i].header,FALSE); } space = ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(struct objectAlphaNode); if (space != 0) genfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->AlphaArray,space); space = ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(struct objectPatternNode); if (space != 0) genfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->PatternArray,space); #endif } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************** NAME : BsaveObjectPatternsFind DESCRIPTION : Sets the Bsave IDs for the object pattern data structures and determines how much space (including padding) is necessary for the alpha node bitmPS INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Counts written NOTES : None ***************************************************/ static void BsaveObjectPatternsFind( void *theEnv) { OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *patternPtr; SaveBloadCount(theEnv,ObjectReteBinaryData(theEnv)->AlphaNodeCount); SaveBloadCount(theEnv,ObjectReteBinaryData(theEnv)->PatternNodeCount); ObjectReteBinaryData(theEnv)->AlphaNodeCount = 0L; alphaPtr = ObjectNetworkTerminalPointer(theEnv); while (alphaPtr != NULL) { alphaPtr->classbmp->neededBitMap = TRUE; if (alphaPtr->slotbmp != NULL) alphaPtr->slotbmp->neededBitMap = TRUE; alphaPtr->bsaveID = ObjectReteBinaryData(theEnv)->AlphaNodeCount++; alphaPtr = alphaPtr->nxtTerminal; } ObjectReteBinaryData(theEnv)->PatternNodeCount = 0L; patternPtr = ObjectNetworkPointer(theEnv); while (patternPtr != NULL) { patternPtr->bsaveID = ObjectReteBinaryData(theEnv)->PatternNodeCount++; if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; if (patternPtr == NULL) return; } patternPtr = patternPtr->rightNode; } else patternPtr = patternPtr->nextLevel; } } /**************************************************** NAME : BsaveStorageObjectPatterns DESCRIPTION : Writes out the number of bytes required for object pattern bitmaps, and the number of object pattern alpha an intermediate nodes INPUTS : Bsave file stream pointer RETURNS : Nothing useful SIDE EFFECTS : Counts written NOTES : None ****************************************************/ static void BsaveStorageObjectPatterns( void *theEnv, FILE *fp) { size_t space; space = sizeof(long) * 2; GenWrite(&space,sizeof(size_t),fp); GenWrite(&ObjectReteBinaryData(theEnv)->AlphaNodeCount,sizeof(long),fp); GenWrite(&ObjectReteBinaryData(theEnv)->PatternNodeCount,sizeof(long),fp); } /*************************************************** NAME : BsaveObjectPatterns DESCRIPTION : Writes ouyt object pattern data structures to binary save file INPUTS : Bsave file stream pointer RETURNS : Nothing useful SIDE EFFECTS : Data structures written NOTES : Extra padding written with alpha node bitmaps to ensure correct alignment of structues on bload ***************************************************/ static void BsaveObjectPatterns( void *theEnv, FILE *fp) { size_t space; OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *patternPtr; BSAVE_OBJECT_ALPHA_NODE dummyAlpha; BSAVE_OBJECT_PATTERN_NODE dummyPattern; space = (sizeof(BSAVE_OBJECT_ALPHA_NODE) * ObjectReteBinaryData(theEnv)->AlphaNodeCount) + (sizeof(BSAVE_OBJECT_PATTERN_NODE) * ObjectReteBinaryData(theEnv)->PatternNodeCount); GenWrite(&space,sizeof(size_t),fp); /* ========================================== Write out the alpha terminal pattern nodes ========================================== */ alphaPtr = ObjectNetworkTerminalPointer(theEnv); while (alphaPtr != NULL) { AssignBsavePatternHeaderValues(theEnv,&dummyAlpha.header,&alphaPtr->header); dummyAlpha.classbmp = (long) alphaPtr->classbmp->bucket; if (alphaPtr->slotbmp != NULL) dummyAlpha.slotbmp = (long) alphaPtr->slotbmp->bucket; else dummyAlpha.slotbmp = -1L; dummyAlpha.patternNode = BsaveObjectPatternIndex(alphaPtr->patternNode); dummyAlpha.nxtInGroup = BsaveObjectAlphaIndex(alphaPtr->nxtInGroup); dummyAlpha.nxtTerminal = BsaveObjectAlphaIndex(alphaPtr->nxtTerminal); GenWrite(&dummyAlpha,sizeof(BSAVE_OBJECT_ALPHA_NODE),fp); alphaPtr = alphaPtr->nxtTerminal; } /* ======================================== Write out the intermediate pattern nodes ======================================== */ patternPtr = ObjectNetworkPointer(theEnv); while (patternPtr != NULL) { dummyPattern.multifieldNode = patternPtr->multifieldNode; dummyPattern.whichField = patternPtr->whichField; dummyPattern.leaveFields = patternPtr->leaveFields; dummyPattern.endSlot = patternPtr->endSlot; dummyPattern.selector = patternPtr->selector; dummyPattern.slotNameID = patternPtr->slotNameID; dummyPattern.networkTest = HashedExpressionIndex(theEnv,patternPtr->networkTest); dummyPattern.nextLevel = BsaveObjectPatternIndex(patternPtr->nextLevel); dummyPattern.lastLevel = BsaveObjectPatternIndex(patternPtr->lastLevel); dummyPattern.leftNode = BsaveObjectPatternIndex(patternPtr->leftNode); dummyPattern.rightNode = BsaveObjectPatternIndex(patternPtr->rightNode); dummyPattern.alphaNode = BsaveObjectAlphaIndex(patternPtr->alphaNode); GenWrite(&dummyPattern,sizeof(BSAVE_OBJECT_PATTERN_NODE),fp); if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; if (patternPtr == NULL) { RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->AlphaNodeCount); RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->PatternNodeCount); return; } } patternPtr = patternPtr->rightNode; } else patternPtr = patternPtr->nextLevel; } RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->AlphaNodeCount); RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->PatternNodeCount); } #endif /*************************************************** NAME : BloadStorageObjectPatterns DESCRIPTION : Reads in the storage requirements for the object patterns in this bload image INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Counts read and arrays allocated NOTES : None ***************************************************/ static void BloadStorageObjectPatterns( void *theEnv) { size_t space; long counts[2]; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); GenReadBinary(theEnv,(void *) counts,space); ObjectReteBinaryData(theEnv)->AlphaNodeCount = counts[0]; ObjectReteBinaryData(theEnv)->PatternNodeCount = counts[1]; if (ObjectReteBinaryData(theEnv)->AlphaNodeCount == 0L) ObjectReteBinaryData(theEnv)->AlphaArray = NULL; else { space = (ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(OBJECT_ALPHA_NODE)); ObjectReteBinaryData(theEnv)->AlphaArray = (OBJECT_ALPHA_NODE *) genalloc(theEnv,space); } if (ObjectReteBinaryData(theEnv)->PatternNodeCount == 0L) ObjectReteBinaryData(theEnv)->PatternArray = NULL; else { space = (ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(OBJECT_PATTERN_NODE)); ObjectReteBinaryData(theEnv)->PatternArray = (OBJECT_PATTERN_NODE *) genalloc(theEnv,space); } } /**************************************************** NAME : BloadObjectPatterns DESCRIPTION : Reads in all object pattern data structures from binary image and updates pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Binary data structures updated NOTES : Assumes storage allocated previously ****************************************************/ static void BloadObjectPatterns( void *theEnv) { size_t space; long i; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; /* ================================================ Read in the alpha and intermediate pattern nodes ================================================ */ BloadandRefresh(theEnv,ObjectReteBinaryData(theEnv)->AlphaNodeCount,sizeof(BSAVE_OBJECT_ALPHA_NODE),UpdateAlpha); BloadandRefresh(theEnv,ObjectReteBinaryData(theEnv)->PatternNodeCount,sizeof(BSAVE_OBJECT_PATTERN_NODE),UpdatePattern); for (i = 0; i < ObjectReteBinaryData(theEnv)->PatternNodeCount; i++) { if ((ObjectReteBinaryData(theEnv)->PatternArray[i].lastLevel != NULL) && (ObjectReteBinaryData(theEnv)->PatternArray[i].lastLevel->selector)) { AddHashedPatternNode(theEnv,ObjectReteBinaryData(theEnv)->PatternArray[i].lastLevel, &ObjectReteBinaryData(theEnv)->PatternArray[i], ObjectReteBinaryData(theEnv)->PatternArray[i].networkTest->type, ObjectReteBinaryData(theEnv)->PatternArray[i].networkTest->value); } } /* ======================= Set the global pointers ======================= */ SetObjectNetworkTerminalPointer(theEnv,(OBJECT_ALPHA_NODE *) &ObjectReteBinaryData(theEnv)->AlphaArray[0]); SetObjectNetworkPointer(theEnv,(OBJECT_PATTERN_NODE *) &ObjectReteBinaryData(theEnv)->PatternArray[0]); } /*************************************************** NAME : UpdateAlpha DESCRIPTION : Updates all the pointers for an alpha node based on the binary image indices INPUTS : 1) A pointer to the binary image alpha node buffer 2) The index of the actual alpha node in the array RETURNS : Nothing useful SIDE EFFECTS : Alpha node updated NOTES : None ***************************************************/ static void UpdateAlpha( void *theEnv, void *buf, long obji) { BSAVE_OBJECT_ALPHA_NODE *bap; OBJECT_ALPHA_NODE *ap; bap = (BSAVE_OBJECT_ALPHA_NODE *) buf; ap = (OBJECT_ALPHA_NODE *) &ObjectReteBinaryData(theEnv)->AlphaArray[obji]; UpdatePatternNodeHeader(theEnv,&ap->header,&bap->header); ap->matchTimeTag = 0L; ap->classbmp = BitMapPointer(bap->classbmp); if (bap->slotbmp != -1L) { ap->slotbmp = BitMapPointer(bap->slotbmp); IncrementBitMapCount(ap->slotbmp); } else ap->slotbmp = NULL; IncrementBitMapCount(ap->classbmp); ap->patternNode = ObjectPatternPointer(bap->patternNode); ap->nxtInGroup = ObjectAlphaPointer(bap->nxtInGroup); ap->nxtTerminal = ObjectAlphaPointer(bap->nxtTerminal); ap->bsaveID = 0L; } /*************************************************** NAME : UpdatePattern DESCRIPTION : Updates all the pointers for a pattern node based on the binary image indices INPUTS : 1) A pointer to the binary image pattern node buffer 2) The index of the actual pattern node in the array RETURNS : Nothing useful SIDE EFFECTS : Pattern node updated NOTES : None ***************************************************/ static void UpdatePattern( void *theEnv, void *buf, long obji) { BSAVE_OBJECT_PATTERN_NODE *bop; OBJECT_PATTERN_NODE *op; bop = (BSAVE_OBJECT_PATTERN_NODE *) buf; op = (OBJECT_PATTERN_NODE *) &ObjectReteBinaryData(theEnv)->PatternArray[obji]; op->blocked = FALSE; op->multifieldNode = bop->multifieldNode; op->whichField = bop->whichField; op->leaveFields = bop->leaveFields; op->endSlot = bop->endSlot; op->selector = bop->selector; op->matchTimeTag = 0L; op->slotNameID = bop->slotNameID; op->networkTest = HashedExpressionPointer(bop->networkTest); op->nextLevel = ObjectPatternPointer(bop->nextLevel); op->lastLevel = ObjectPatternPointer(bop->lastLevel); op->leftNode = ObjectPatternPointer(bop->leftNode); op->rightNode = ObjectPatternPointer(bop->rightNode); op->alphaNode = ObjectAlphaPointer(bop->alphaNode); op->bsaveID = 0L; } /*************************************************** NAME : ClearBloadObjectPatterns DESCRIPTION : Releases all emmory associated with binary image object patterns INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory released and global network pointers set to NULL NOTES : None ***************************************************/ static void ClearBloadObjectPatterns( void *theEnv) { size_t space; register long i; for (i = 0; i < ObjectReteBinaryData(theEnv)->PatternNodeCount; i++) { if ((ObjectReteBinaryData(theEnv)->PatternArray[i].lastLevel != NULL) && (ObjectReteBinaryData(theEnv)->PatternArray[i].lastLevel->selector)) { RemoveHashedPatternNode(theEnv,ObjectReteBinaryData(theEnv)->PatternArray[i].lastLevel, &ObjectReteBinaryData(theEnv)->PatternArray[i], ObjectReteBinaryData(theEnv)->PatternArray[i].networkTest->type, ObjectReteBinaryData(theEnv)->PatternArray[i].networkTest->value); } } /* ================================================ All instances have been deleted by this point so we don't need to worry about clearing partial matches ================================================ */ for (i = 0L ; i < ObjectReteBinaryData(theEnv)->AlphaNodeCount ; i++) { DecrementBitMapCount(theEnv,ObjectReteBinaryData(theEnv)->AlphaArray[i].classbmp); if (ObjectReteBinaryData(theEnv)->AlphaArray[i].slotbmp != NULL) DecrementBitMapCount(theEnv,ObjectReteBinaryData(theEnv)->AlphaArray[i].slotbmp); } if (ObjectReteBinaryData(theEnv)->AlphaNodeCount != 0L) { space = (ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(OBJECT_ALPHA_NODE)); genfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->AlphaArray,space); ObjectReteBinaryData(theEnv)->AlphaArray = NULL; ObjectReteBinaryData(theEnv)->AlphaNodeCount = 0; space = (ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(OBJECT_PATTERN_NODE)); genfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->PatternArray,space); ObjectReteBinaryData(theEnv)->PatternArray = NULL; ObjectReteBinaryData(theEnv)->PatternNodeCount = 0; } SetObjectNetworkTerminalPointer(theEnv,NULL); SetObjectNetworkPointer(theEnv,NULL); #if BLOAD_ONLY ResetObjectMatchTimeTags(theEnv); #endif } #endif clips_core_source_630/core/._dffnxexe.h0000755000175000017500000000040712373731201016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._envrnmnt.h0000755000175000017500000000040712373740012016466 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objbin.c0000755000175000017500000015742212374023220015646 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Classes and their */ /* message-handlers */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "classcom.h" #include "classfun.h" #include "classini.h" #include "cstrcbin.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "insfun.h" #include "memalloc.h" #include "modulbin.h" #include "msgcom.h" #include "msgfun.h" #include "prntutil.h" #include "router.h" #define _OBJBIN_SOURCE_ #include "objbin.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define SlotIndex(p) (((p) != NULL) ? (p)->bsaveIndex : -1L) #define SlotNameIndex(p) (p)->bsaveIndex #define LinkPointer(i) (((i) == -1L) ? NULL : (DEFCLASS **) &ObjectBinaryData(theEnv)->LinkArray[i]) #define SlotPointer(i) (((i) == -1L) ? NULL : (SLOT_DESC *) &ObjectBinaryData(theEnv)->SlotArray[i]) #define TemplateSlotPointer(i) (((i) == -1L) ? NULL : (SLOT_DESC **) &ObjectBinaryData(theEnv)->TmpslotArray[i]) #define OrderedSlotPointer(i) (((i) == -1L) ? NULL : (unsigned *) &ObjectBinaryData(theEnv)->MapslotArray[i]) #define SlotNamePointer(i) ((SLOT_NAME *) &ObjectBinaryData(theEnv)->SlotNameArray[i]) #define HandlerPointer(i) (((i) == -1L) ? NULL : (HANDLER *) &ObjectBinaryData(theEnv)->HandlerArray[i]) #define OrderedHandlerPointer(i) (((i) == -1L) ? NULL : (unsigned *) &ObjectBinaryData(theEnv)->MaphandlerArray[i]) typedef struct bsaveDefclassModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFCLASS_MODULE; typedef struct bsavePackedClassLinks { long classCount; long classArray; } BSAVE_PACKED_CLASS_LINKS; typedef struct bsaveDefclass { struct bsaveConstructHeader header; unsigned abstract : 1; unsigned reactive : 1; unsigned system : 1; unsigned id; BSAVE_PACKED_CLASS_LINKS directSuperclasses, directSubclasses, allSuperclasses; short slotCount,localInstanceSlotCount, instanceSlotCount,maxSlotNameID; short handlerCount; long slots, instanceTemplate, slotNameMap, handlers, scopeMap; } BSAVE_DEFCLASS; typedef struct bsaveSlotName { short id; unsigned hashTableIndex; long name, putHandlerName; } BSAVE_SLOT_NAME; typedef struct bsaveSlotDescriptor { unsigned shared : 1; unsigned multiple : 1; unsigned composite : 1; unsigned noInherit : 1; unsigned noWrite : 1; unsigned initializeOnly : 1; unsigned dynamicDefault : 1; unsigned noDefault : 1; unsigned reactive : 1; unsigned publicVisibility : 1; unsigned createReadAccessor : 1; unsigned createWriteAccessor : 1; long cls, slotName, defaultValue, constraint, overrideMessage; } BSAVE_SLOT_DESC; typedef struct bsaveMessageHandler { unsigned system : 1; unsigned type : 2; short minParams, maxParams, localVarCount; long name, cls, actions; } BSAVE_HANDLER; typedef struct handlerBsaveInfo { HANDLER *handlers; unsigned *handlerOrderMap; unsigned handlerCount; } HANDLER_BSAVE_INFO; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveObjectsFind(void *); static void MarkDefclassItems(void *,struct constructHeader *,void *); static void BsaveObjectsExpressions(void *,FILE *); static void BsaveDefaultSlotExpressions(void *,struct constructHeader *,void *); static void BsaveHandlerActionExpressions(void *,struct constructHeader *,void *); static void BsaveStorageObjects(void *,FILE *); static void BsaveObjects(void *,FILE *); static void BsaveDefclass(void *,struct constructHeader *,void *); static void BsaveClassLinks(void *,struct constructHeader *,void *); static void BsaveSlots(void *,struct constructHeader *,void *); static void BsaveTemplateSlots(void *,struct constructHeader *,void *); static void BsaveSlotMap(void *,struct constructHeader *,void *); static void BsaveHandlers(void *,struct constructHeader *,void *); static void BsaveHandlerMap(void *,struct constructHeader *,void *); #endif static void BloadStorageObjects(void *); static void BloadObjects(void *); static void UpdatePrimitiveClassesMap(void *); static void UpdateDefclassModule(void *,void *,long); static void UpdateDefclass(void *,void *,long); static void UpdateLink(void *,void *,long); static void UpdateSlot(void *,void *,long); static void UpdateSlotName(void *,void *,long); static void UpdateTemplateSlot(void *,void *,long); static void UpdateHandler(void *,void *,long); static void ClearBloadObjects(void *); static void DeallocateObjectBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupObjectsBload DESCRIPTION : Initializes data structures and routines for binary loads of generic function constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupObjectsBload( void *theEnv) { AllocateEnvironmentData(theEnv,OBJECTBIN_DATA,sizeof(struct objectBinaryData),DeallocateObjectBinaryData); AddAbortBloadFunction(theEnv,"defclass",CreateSystemClasses,0); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defclass",0,BsaveObjectsFind,BsaveObjectsExpressions, BsaveStorageObjects,BsaveObjects, BloadStorageObjects,BloadObjects, ClearBloadObjects); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"defclass",0,NULL,NULL,NULL,NULL, BloadStorageObjects,BloadObjects, ClearBloadObjects); #endif } /*******************************************************/ /* DeallocateObjectBinaryData: Deallocates environment */ /* data for object binary functionality. */ /*******************************************************/ static void DeallocateObjectBinaryData( void *theEnv) { size_t space; long i; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) space = (sizeof(DEFCLASS_MODULE) * ObjectBinaryData(theEnv)->ModuleCount); if (space != 0) genfree(theEnv,(void *) ObjectBinaryData(theEnv)->ModuleArray,space); if (ObjectBinaryData(theEnv)->ClassCount != 0) { if (DefclassData(theEnv)->ClassIDMap != NULL) { rm(theEnv,(void *) DefclassData(theEnv)->ClassIDMap,(sizeof(DEFCLASS *) * DefclassData(theEnv)->AvailClassID)); } for (i = 0L ; i < ObjectBinaryData(theEnv)->SlotCount ; i++) { if ((ObjectBinaryData(theEnv)->SlotArray[i].defaultValue != NULL) && (ObjectBinaryData(theEnv)->SlotArray[i].dynamicDefault == 0)) { rtn_struct(theEnv,dataObject,ObjectBinaryData(theEnv)->SlotArray[i].defaultValue); } } space = (sizeof(DEFCLASS) * ObjectBinaryData(theEnv)->ClassCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->DefclassArray,space); } space = (sizeof(DEFCLASS *) * ObjectBinaryData(theEnv)->LinkCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->LinkArray,space); } space = (sizeof(SLOT_DESC) * ObjectBinaryData(theEnv)->SlotCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotArray,space); } space = (sizeof(SLOT_NAME) * ObjectBinaryData(theEnv)->SlotNameCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotNameArray,space); } space = (sizeof(SLOT_DESC *) * ObjectBinaryData(theEnv)->TemplateSlotCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->TmpslotArray,space); } space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->MapslotArray,space); } } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { space = (sizeof(HANDLER) * ObjectBinaryData(theEnv)->HandlerCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->HandlerArray,space); space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); genfree(theEnv,(void *) ObjectBinaryData(theEnv)->MaphandlerArray,space); } } #endif } /*************************************************** NAME : BloadDefclassModuleReference DESCRIPTION : Returns a pointer to the appropriate defclass module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDefclassModuleReference( void *theEnv, int theIndex) { return ((void *) &ObjectBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveObjectsFind DESCRIPTION : For all classes and their message-handlers, this routine marks all the needed symbols and system functions. Also, it also counts the number of expression structures needed. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols are marked in their structures NOTES : Also sets bsaveIndex for each class (assumes classes will be bsaved in order of binary list) ***************************************************************************/ static void BsaveObjectsFind( void *theEnv) { register unsigned i; SLOT_NAME *snp; /* ======================================================== The counts need to be saved in case a bload is in effect ======================================================== */ SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->ClassCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->LinkCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->SlotNameCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->SlotCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->TemplateSlotCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->SlotNameMapCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->HandlerCount); ObjectBinaryData(theEnv)->ModuleCount= 0L; ObjectBinaryData(theEnv)->ClassCount = 0L; ObjectBinaryData(theEnv)->SlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameCount = 0L; ObjectBinaryData(theEnv)->LinkCount = 0L; ObjectBinaryData(theEnv)->TemplateSlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameMapCount = 0L; ObjectBinaryData(theEnv)->HandlerCount = 0L; /* ============================================== Mark items needed by defclasses in all modules ============================================== */ ObjectBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDefclassItems,DefclassData(theEnv)->DefclassModuleIndex, FALSE,NULL); /* ============================================= Mark items needed by canonicalized slot names ============================================= */ for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) for (snp = DefclassData(theEnv)->SlotNameTable[i] ; snp != NULL ; snp = snp->nxt) { if ((snp->id != ISA_ID) && (snp->id != NAME_ID)) { snp->bsaveIndex = ObjectBinaryData(theEnv)->SlotNameCount++; snp->name->neededSymbol = TRUE; snp->putHandlerName->neededSymbol = TRUE; } } } /*************************************************** NAME : MarkDefclassItems DESCRIPTION : Marks needed items for a defclass INPUTS : 1) The defclass 2) User buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Bsave indices set and needed ephemerals marked NOTES : None ***************************************************/ static void MarkDefclassItems( void *theEnv, struct constructHeader *theDefclass, void *buf) { #if MAC_XCD #pragma unused(buf) #endif DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; EXPRESSION *tmpexp; MarkConstructHeaderNeededItems(&cls->header,ObjectBinaryData(theEnv)->ClassCount++); ObjectBinaryData(theEnv)->LinkCount += cls->directSuperclasses.classCount + cls->directSubclasses.classCount + cls->allSuperclasses.classCount; #if DEFMODULE_CONSTRUCT cls->scopeMap->neededBitMap = TRUE; #endif /* =================================================== Mark items needed by slot default value expressions =================================================== */ for (i = 0 ; i < cls->slotCount ; i++) { cls->slots[i].bsaveIndex = ObjectBinaryData(theEnv)->SlotCount++; cls->slots[i].overrideMessage->neededSymbol = TRUE; if (cls->slots[i].defaultValue != NULL) { if (cls->slots[i].dynamicDefault) { ExpressionData(theEnv)->ExpressionCount += ExpressionSize((EXPRESSION *) cls->slots[i].defaultValue); MarkNeededItems(theEnv,(EXPRESSION *) cls->slots[i].defaultValue); } else { /* ================================================= Static default values are stotred as data objects and must be converted into expressions ================================================= */ tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(tmpexp); MarkNeededItems(theEnv,tmpexp); ReturnExpression(theEnv,tmpexp); } } } /* ======================================== Count canonical slots needed by defclass ======================================== */ ObjectBinaryData(theEnv)->TemplateSlotCount += (long) cls->instanceSlotCount; if (cls->instanceSlotCount != 0) ObjectBinaryData(theEnv)->SlotNameMapCount += (long) cls->maxSlotNameID + 1; /* =============================================== Mark items needed by defmessage-handler actions =============================================== */ for (i = 0 ; i < cls->handlerCount ; i++) { cls->handlers[i].name->neededSymbol = TRUE; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(cls->handlers[i].actions); MarkNeededItems(theEnv,cls->handlers[i].actions); } ObjectBinaryData(theEnv)->HandlerCount += (long) cls->handlerCount; } /*************************************************** NAME : BsaveObjectsExpressions DESCRIPTION : Writes out all expressions needed by classes and handlers INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveObjectsExpressions( void *theEnv, FILE *fp) { if ((ObjectBinaryData(theEnv)->ClassCount == 0L) && (ObjectBinaryData(theEnv)->HandlerCount == 0L)) return; /* ================================================ Save the defclass slot default value expressions ================================================ */ DoForAllConstructs(theEnv,BsaveDefaultSlotExpressions,DefclassData(theEnv)->DefclassModuleIndex, FALSE,(void *) fp); /* ============================================== Save the defmessage-handler action expressions ============================================== */ DoForAllConstructs(theEnv,BsaveHandlerActionExpressions,DefclassData(theEnv)->DefclassModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveDefaultSlotExpressions DESCRIPTION : Writes expressions for default slot values to binary file INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Slot value expressions written NOTES : None ***************************************************/ static void BsaveDefaultSlotExpressions( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; EXPRESSION *tmpexp; for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].defaultValue != NULL) { if (cls->slots[i].dynamicDefault) BsaveExpression(theEnv,(EXPRESSION *) cls->slots[i].defaultValue,(FILE *) buf); else { /* ================================================= Static default values are stotred as data objects and must be converted into expressions ================================================= */ tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue); BsaveExpression(theEnv,tmpexp,(FILE *) buf); ReturnExpression(theEnv,tmpexp); } } } } /*************************************************** NAME : BsaveHandlerActionExpressions DESCRIPTION : Writes expressions for handler actions to binary file INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Handler actions expressions written NOTES : None ***************************************************/ static void BsaveHandlerActionExpressions( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; for (i = 0 ; i < cls->handlerCount ; i++) BsaveExpression(theEnv,cls->handlers[i].actions,(FILE *) buf); } /************************************************************************************* NAME : BsaveStorageObjects DESCRIPTION : Writes out number of each type of structure required for COOL Space required for counts (unsigned long) Number of class modules (long) Number of classes (long) Number of links to classes (long) Number of slots (long) Number of instance template slots (long) Number of handlers (long) Number of definstances (long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveStorageObjects( void *theEnv, FILE *fp) { size_t space; long maxClassID; if ((ObjectBinaryData(theEnv)->ClassCount == 0L) && (ObjectBinaryData(theEnv)->HandlerCount == 0L)) { space = 0L; GenWrite((void *) &space,sizeof(size_t),fp); return; } space = sizeof(long) * 9; GenWrite((void *) &space,sizeof(size_t),fp); // 64-bit issue changed long to size_t GenWrite((void *) &ObjectBinaryData(theEnv)->ModuleCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->ClassCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->LinkCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->SlotNameCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->SlotCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->TemplateSlotCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->SlotNameMapCount,sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->HandlerCount,sizeof(long),fp); maxClassID = DefclassData(theEnv)->MaxClassID; GenWrite((void *) &maxClassID,sizeof(long),fp); } /************************************************************************************* NAME : BsaveObjects DESCRIPTION : Writes out classes and message-handlers in binary format Space required (unsigned long) Followed by the data structures in order INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveObjects( void *theEnv, FILE *fp) { size_t space; struct defmodule *theModule; DEFCLASS_MODULE *theModuleItem; BSAVE_DEFCLASS_MODULE dummy_mitem; BSAVE_SLOT_NAME dummy_slot_name; SLOT_NAME *snp; register unsigned i; if ((ObjectBinaryData(theEnv)->ClassCount == 0L) && (ObjectBinaryData(theEnv)->HandlerCount == 0L)) { space = 0L; GenWrite((void *) &space,sizeof(size_t),fp); return; } space = (ObjectBinaryData(theEnv)->ModuleCount * sizeof(BSAVE_DEFCLASS_MODULE)) + (ObjectBinaryData(theEnv)->ClassCount * sizeof(BSAVE_DEFCLASS)) + (ObjectBinaryData(theEnv)->LinkCount * sizeof(long)) + (ObjectBinaryData(theEnv)->SlotCount * sizeof(BSAVE_SLOT_DESC)) + (ObjectBinaryData(theEnv)->SlotNameCount * sizeof(BSAVE_SLOT_NAME)) + (ObjectBinaryData(theEnv)->TemplateSlotCount * sizeof(long)) + (ObjectBinaryData(theEnv)->SlotNameMapCount * sizeof(unsigned)) + (ObjectBinaryData(theEnv)->HandlerCount * sizeof(BSAVE_HANDLER)) + (ObjectBinaryData(theEnv)->HandlerCount * sizeof(unsigned)); GenWrite((void *) &space,sizeof(size_t),fp); ObjectBinaryData(theEnv)->ClassCount = 0L; ObjectBinaryData(theEnv)->LinkCount = 0L; ObjectBinaryData(theEnv)->SlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameCount = 0L; ObjectBinaryData(theEnv)->TemplateSlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameMapCount = 0L; ObjectBinaryData(theEnv)->HandlerCount = 0L; /* ================================= Write out each defclass module ================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFCLASS_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"defclass")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_mitem.header,&theModuleItem->header); GenWrite((void *) &dummy_mitem,sizeof(BSAVE_DEFCLASS_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ===================== Write out the classes ===================== */ DoForAllConstructs(theEnv,BsaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ========================= Write out the class links ========================= */ ObjectBinaryData(theEnv)->LinkCount = 0L; DoForAllConstructs(theEnv,BsaveClassLinks,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* =============================== Write out the slot name entries =============================== */ for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) for (snp = DefclassData(theEnv)->SlotNameTable[i] ; snp != NULL ; snp = snp->nxt) { if ((snp->id != ISA_ID) && (snp->id != NAME_ID)) { dummy_slot_name.id = snp->id; dummy_slot_name.hashTableIndex = snp->hashTableIndex; dummy_slot_name.name = (long) snp->name->bucket; dummy_slot_name.putHandlerName = (long) snp->putHandlerName->bucket; GenWrite((void *) &dummy_slot_name,sizeof(BSAVE_SLOT_NAME),fp); } } /* =================== Write out the slots =================== */ DoForAllConstructs(theEnv,BsaveSlots,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ===================================== Write out the template instance slots ===================================== */ DoForAllConstructs(theEnv,BsaveTemplateSlots,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ============================================= Write out the ordered instance slot name maps ============================================= */ DoForAllConstructs(theEnv,BsaveSlotMap,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ============================== Write out the message-handlers ============================== */ DoForAllConstructs(theEnv,BsaveHandlers,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ========================================== Write out the ordered message-handler maps ========================================== */ DoForAllConstructs(theEnv,BsaveHandlerMap,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->ClassCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->LinkCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->SlotCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->SlotNameCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->TemplateSlotCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->SlotNameMapCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->HandlerCount); } /*************************************************** NAME : BsaveDefclass DESCRIPTION : Writes defclass binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass binary data written NOTES : None ***************************************************/ static void BsaveDefclass( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; BSAVE_DEFCLASS dummy_class; AssignBsaveConstructHeaderVals(&dummy_class.header,&cls->header); dummy_class.abstract = cls->abstract; dummy_class.reactive = cls->reactive; dummy_class.system = cls->system; dummy_class.id = cls->id; dummy_class.slotCount = cls->slotCount; dummy_class.instanceSlotCount = cls->instanceSlotCount; dummy_class.localInstanceSlotCount = cls->localInstanceSlotCount; dummy_class.maxSlotNameID = cls->maxSlotNameID; dummy_class.handlerCount = cls->handlerCount; dummy_class.directSuperclasses.classCount = cls->directSuperclasses.classCount; dummy_class.directSubclasses.classCount = cls->directSubclasses.classCount; dummy_class.allSuperclasses.classCount = cls->allSuperclasses.classCount; if (cls->directSuperclasses.classCount != 0) { dummy_class.directSuperclasses.classArray = ObjectBinaryData(theEnv)->LinkCount; ObjectBinaryData(theEnv)->LinkCount += cls->directSuperclasses.classCount; } else dummy_class.directSuperclasses.classArray = -1L; if (cls->directSubclasses.classCount != 0) { dummy_class.directSubclasses.classArray = ObjectBinaryData(theEnv)->LinkCount; ObjectBinaryData(theEnv)->LinkCount += cls->directSubclasses.classCount; } else dummy_class.directSubclasses.classArray = -1L; if (cls->allSuperclasses.classCount != 0) { dummy_class.allSuperclasses.classArray = ObjectBinaryData(theEnv)->LinkCount; ObjectBinaryData(theEnv)->LinkCount += cls->allSuperclasses.classCount; } else dummy_class.allSuperclasses.classArray = -1L; if (cls->slots != NULL) { dummy_class.slots = ObjectBinaryData(theEnv)->SlotCount; ObjectBinaryData(theEnv)->SlotCount += (long) cls->slotCount; } else dummy_class.slots = -1L; if (cls->instanceTemplate != NULL) { dummy_class.instanceTemplate = ObjectBinaryData(theEnv)->TemplateSlotCount; ObjectBinaryData(theEnv)->TemplateSlotCount += (long) cls->instanceSlotCount; dummy_class.slotNameMap = ObjectBinaryData(theEnv)->SlotNameMapCount; ObjectBinaryData(theEnv)->SlotNameMapCount += (long) cls->maxSlotNameID + 1; } else { dummy_class.instanceTemplate = -1L; dummy_class.slotNameMap = -1L; } if (cls->handlers != NULL) { dummy_class.handlers = ObjectBinaryData(theEnv)->HandlerCount; ObjectBinaryData(theEnv)->HandlerCount += (long) cls->handlerCount; } else dummy_class.handlers = -1L; #if DEFMODULE_CONSTRUCT dummy_class.scopeMap = (long) cls->scopeMap->bucket; #else dummy_class.scopeMap = -1L; #endif GenWrite((void *) &dummy_class,sizeof(BSAVE_DEFCLASS),(FILE *) buf); } /*************************************************** NAME : BsaveClassLinks DESCRIPTION : Writes class links binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass links binary data written NOTES : None ***************************************************/ static void BsaveClassLinks( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; long dummy_class_index; for (i = 0 ; i < cls->directSuperclasses.classCount ; i++) { dummy_class_index = DefclassIndex(cls->directSuperclasses.classArray[i]); GenWrite((void *) &dummy_class_index,sizeof(long),(FILE *) buf); } ObjectBinaryData(theEnv)->LinkCount += cls->directSuperclasses.classCount; for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { dummy_class_index = DefclassIndex(cls->directSubclasses.classArray[i]); GenWrite((void *) &dummy_class_index,sizeof(long),(FILE *) buf); } ObjectBinaryData(theEnv)->LinkCount += cls->directSubclasses.classCount; for (i = 0 ; i < cls->allSuperclasses.classCount ; i++) { dummy_class_index = DefclassIndex(cls->allSuperclasses.classArray[i]); GenWrite((void *) &dummy_class_index,sizeof(long),(FILE *) buf); } ObjectBinaryData(theEnv)->LinkCount += cls->allSuperclasses.classCount; } /*************************************************** NAME : BsaveSlots DESCRIPTION : Writes class slots binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass slots binary data written NOTES : None ***************************************************/ static void BsaveSlots( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; BSAVE_SLOT_DESC dummy_slot; SLOT_DESC *sp; EXPRESSION *tmpexp; for (i = 0 ; i < cls->slotCount ; i++) { sp = &cls->slots[i]; dummy_slot.dynamicDefault = sp->dynamicDefault; dummy_slot.noDefault = sp->noDefault; dummy_slot.shared = sp->shared; dummy_slot.multiple = sp->multiple; dummy_slot.composite = sp->composite; dummy_slot.noInherit = sp->noInherit; dummy_slot.noWrite = sp->noWrite; dummy_slot.initializeOnly = sp->initializeOnly; dummy_slot.reactive = sp->reactive; dummy_slot.publicVisibility = sp->publicVisibility; dummy_slot.createReadAccessor = sp->createReadAccessor; dummy_slot.createWriteAccessor = sp->createWriteAccessor; dummy_slot.cls = DefclassIndex(sp->cls); dummy_slot.slotName = SlotNameIndex(sp->slotName); dummy_slot.overrideMessage = (long) sp->overrideMessage->bucket; if (sp->defaultValue != NULL) { dummy_slot.defaultValue = ExpressionData(theEnv)->ExpressionCount; if (sp->dynamicDefault) ExpressionData(theEnv)->ExpressionCount += ExpressionSize((EXPRESSION *) sp->defaultValue); else { tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) sp->defaultValue); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(tmpexp); ReturnExpression(theEnv,tmpexp); } } else dummy_slot.defaultValue = -1L; dummy_slot.constraint = ConstraintIndex(sp->constraint); GenWrite((void *) &dummy_slot,sizeof(BSAVE_SLOT_DESC),(FILE *) buf); } } /************************************************************** NAME : BsaveTemplateSlots DESCRIPTION : Writes class instance template binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass instance template binary data written NOTES : None **************************************************************/ static void BsaveTemplateSlots( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; long tsp; #if MAC_XCD #pragma unused(theEnv) #endif for (i = 0 ; i < cls->instanceSlotCount ; i++) { tsp = SlotIndex(cls->instanceTemplate[i]); GenWrite((void *) &tsp,sizeof(long),(FILE *) buf); } } /*************************************************************** NAME : BsaveSlotMap DESCRIPTION : Writes class canonical slot map binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass canonical slot map binary data written NOTES : None ***************************************************************/ static void BsaveSlotMap( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; #if MAC_XCD #pragma unused(theEnv) #endif if (cls->instanceSlotCount != 0) GenWrite((void *) cls->slotNameMap, (sizeof(unsigned) * (cls->maxSlotNameID + 1)),(FILE *) buf); } /************************************************************ NAME : BsaveHandlers DESCRIPTION : Writes class message-handlers binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass message-handler binary data written NOTES : None ************************************************************/ static void BsaveHandlers( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; long i; BSAVE_HANDLER dummy_handler; HANDLER *hnd; for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; dummy_handler.system = hnd->system; dummy_handler.type = hnd->type; dummy_handler.minParams = hnd->minParams; dummy_handler.maxParams = hnd->maxParams; dummy_handler.localVarCount = hnd->localVarCount; dummy_handler.cls = DefclassIndex(hnd->cls); dummy_handler.name = (long) hnd->name->bucket; if (hnd->actions != NULL) { dummy_handler.actions = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(hnd->actions); } else dummy_handler.actions = -1L; GenWrite((void *) &dummy_handler,sizeof(BSAVE_HANDLER),(FILE *) buf); } } /**************************************************************** NAME : BsaveHandlerMap DESCRIPTION : Writes class message-handler map binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass message-handler map binary data written NOTES : None ****************************************************************/ static void BsaveHandlerMap( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; #if MAC_XCD #pragma unused(theEnv) #endif GenWrite((void *) cls->handlerOrderMap, (sizeof(unsigned) * cls->handlerCount),(FILE *) buf); } #endif /*********************************************************************** NAME : BloadStorageObjects DESCRIPTION : This routine reads class and handler information from a binary file in five chunks: Class count Handler count Class array Handler array INPUTS : Notthing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures Bload fails if there are still classes in the system!! ***********************************************************************/ static void BloadStorageObjects( void *theEnv) { size_t space; long counts[9]; if ((DefclassData(theEnv)->ClassIDMap != NULL) || (DefclassData(theEnv)->MaxClassID != 0)) { SystemError(theEnv,"OBJBIN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) { ObjectBinaryData(theEnv)->ClassCount = ObjectBinaryData(theEnv)->HandlerCount = 0L; return; } GenReadBinary(theEnv,(void *) counts,space); ObjectBinaryData(theEnv)->ModuleCount = counts[0]; ObjectBinaryData(theEnv)->ClassCount = counts[1]; ObjectBinaryData(theEnv)->LinkCount = counts[2]; ObjectBinaryData(theEnv)->SlotNameCount = counts[3]; ObjectBinaryData(theEnv)->SlotCount = counts[4]; ObjectBinaryData(theEnv)->TemplateSlotCount = counts[5]; ObjectBinaryData(theEnv)->SlotNameMapCount = counts[6]; ObjectBinaryData(theEnv)->HandlerCount = counts[7]; DefclassData(theEnv)->MaxClassID = (unsigned short) counts[8]; DefclassData(theEnv)->AvailClassID = (unsigned short) counts[8]; if (ObjectBinaryData(theEnv)->ModuleCount != 0L) { space = (sizeof(DEFCLASS_MODULE) * ObjectBinaryData(theEnv)->ModuleCount); ObjectBinaryData(theEnv)->ModuleArray = (DEFCLASS_MODULE *) genalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->ClassCount != 0L) { space = (sizeof(DEFCLASS) * ObjectBinaryData(theEnv)->ClassCount); ObjectBinaryData(theEnv)->DefclassArray = (DEFCLASS *) genalloc(theEnv,space); DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * DefclassData(theEnv)->MaxClassID)); } if (ObjectBinaryData(theEnv)->LinkCount != 0L) { space = (sizeof(DEFCLASS *) * ObjectBinaryData(theEnv)->LinkCount); ObjectBinaryData(theEnv)->LinkArray = (DEFCLASS * *) genalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->SlotCount != 0L) { space = (sizeof(SLOT_DESC) * ObjectBinaryData(theEnv)->SlotCount); ObjectBinaryData(theEnv)->SlotArray = (SLOT_DESC *) genalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->SlotNameCount != 0L) { space = (sizeof(SLOT_NAME) * ObjectBinaryData(theEnv)->SlotNameCount); ObjectBinaryData(theEnv)->SlotNameArray = (SLOT_NAME *) genalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->TemplateSlotCount != 0L) { space = (sizeof(SLOT_DESC *) * ObjectBinaryData(theEnv)->TemplateSlotCount); ObjectBinaryData(theEnv)->TmpslotArray = (SLOT_DESC * *) genalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->SlotNameMapCount != 0L) { space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); ObjectBinaryData(theEnv)->MapslotArray = (unsigned *) genalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { space = (sizeof(HANDLER) * ObjectBinaryData(theEnv)->HandlerCount); ObjectBinaryData(theEnv)->HandlerArray = (HANDLER *) genalloc(theEnv,space); space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); ObjectBinaryData(theEnv)->MaphandlerArray = (unsigned *) genalloc(theEnv,space); } } /*************************************************************** NAME : BloadObjects DESCRIPTION : This routine moves through the class and handler binary arrays updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished **************************************************************/ static void BloadObjects( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; if (ObjectBinaryData(theEnv)->ModuleCount != 0L) BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->ModuleCount,sizeof(BSAVE_DEFCLASS_MODULE),UpdateDefclassModule); if (ObjectBinaryData(theEnv)->ClassCount != 0L) { BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->ClassCount,sizeof(BSAVE_DEFCLASS),UpdateDefclass); BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->LinkCount,sizeof(long),UpdateLink); // 64-bit bug fix: DEFCLASS * replaced with long BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->SlotNameCount,sizeof(BSAVE_SLOT_NAME),UpdateSlotName); BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->SlotCount,sizeof(BSAVE_SLOT_DESC),UpdateSlot); if (ObjectBinaryData(theEnv)->TemplateSlotCount != 0L) BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->TemplateSlotCount,sizeof(long),UpdateTemplateSlot); if (ObjectBinaryData(theEnv)->SlotNameMapCount != 0L) { space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); GenReadBinary(theEnv,(void *) ObjectBinaryData(theEnv)->MapslotArray,space); } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->HandlerCount,sizeof(BSAVE_HANDLER),UpdateHandler); space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); GenReadBinary(theEnv,(void *) ObjectBinaryData(theEnv)->MaphandlerArray,space); } UpdatePrimitiveClassesMap(theEnv); } } /*************************************************** NAME : UpdatePrimitiveClassesMap DESCRIPTION : Resets the pointers for the global primitive classes map INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : PrimitiveClassMap pointers set into bload array NOTES : Looks at first nine primitive type codes in the source file CONSTANT.H ***************************************************/ static void UpdatePrimitiveClassesMap( void *theEnv) { register unsigned i; for (i = 0 ; i < OBJECT_TYPE_CODE ; i++) DefclassData(theEnv)->PrimitiveClassMap[i] = (DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[i]; } /********************************************************* Refresh update routines for bsaved COOL structures *********************************************************/ static void UpdateDefclassModule( void *theEnv, void *buf, long obji) { BSAVE_DEFCLASS_MODULE *bdptr; bdptr = (BSAVE_DEFCLASS_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&ObjectBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFCLASS),(void *) ObjectBinaryData(theEnv)->DefclassArray); } static void UpdateDefclass( void *theEnv, void *buf, long obji) { BSAVE_DEFCLASS *bcls; DEFCLASS *cls; bcls = (BSAVE_DEFCLASS *) buf; cls = (DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[obji]; UpdateConstructHeader(theEnv,&bcls->header,&cls->header, (int) sizeof(DEFCLASS_MODULE),(void *) ObjectBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFCLASS),(void *) ObjectBinaryData(theEnv)->DefclassArray); cls->abstract = bcls->abstract; cls->reactive = bcls->reactive; cls->system = bcls->system; cls->id = bcls->id; DefclassData(theEnv)->ClassIDMap[cls->id] = cls; #if DEBUGGING_FUNCTIONS cls->traceInstances = DefclassData(theEnv)->WatchInstances; cls->traceSlots = DefclassData(theEnv)->WatchSlots; #endif cls->slotCount = bcls->slotCount; cls->instanceSlotCount = bcls->instanceSlotCount; cls->localInstanceSlotCount = bcls->localInstanceSlotCount; cls->maxSlotNameID = bcls->maxSlotNameID; cls->handlerCount = bcls->handlerCount; cls->directSuperclasses.classCount =bcls->directSuperclasses.classCount; cls->directSuperclasses.classArray = LinkPointer(bcls->directSuperclasses.classArray); cls->directSubclasses.classCount =bcls->directSubclasses.classCount; cls->directSubclasses.classArray = LinkPointer(bcls->directSubclasses.classArray); cls->allSuperclasses.classCount =bcls->allSuperclasses.classCount; cls->allSuperclasses.classArray = LinkPointer(bcls->allSuperclasses.classArray); cls->slots = SlotPointer(bcls->slots); cls->instanceTemplate = TemplateSlotPointer(bcls->instanceTemplate); cls->slotNameMap = OrderedSlotPointer(bcls->slotNameMap); cls->instanceList = NULL; cls->handlers = HandlerPointer(bcls->handlers); cls->handlerOrderMap = OrderedHandlerPointer(bcls->handlers); cls->installed = 1; cls->busy = 0; cls->instanceList = NULL; cls->instanceListBottom = NULL; #if DEFMODULE_CONSTRUCT cls->scopeMap = BitMapPointer(bcls->scopeMap); IncrementBitMapCount(cls->scopeMap); #else cls->scopeMap = NULL; #endif PutClassInTable(theEnv,cls); } static void UpdateLink( void *theEnv, void *buf, long obji) { long *blink; blink = (long *) buf; ObjectBinaryData(theEnv)->LinkArray[obji] = DefclassPointer(*blink); } static void UpdateSlot( void *theEnv, void *buf, long obji) { SLOT_DESC *sp; BSAVE_SLOT_DESC *bsp; sp = (SLOT_DESC *) &ObjectBinaryData(theEnv)->SlotArray[obji]; bsp = (BSAVE_SLOT_DESC *) buf; sp->dynamicDefault = bsp->dynamicDefault; sp->noDefault = bsp->noDefault; sp->shared = bsp->shared; sp->multiple = bsp->multiple; sp->composite = bsp->composite; sp->noInherit = bsp->noInherit; sp->noWrite = bsp->noWrite; sp->initializeOnly = bsp->initializeOnly; sp->reactive = bsp->reactive; sp->publicVisibility = bsp->publicVisibility; sp->createReadAccessor = bsp->createReadAccessor; sp->createWriteAccessor = bsp->createWriteAccessor; sp->cls = DefclassPointer(bsp->cls); sp->slotName = SlotNamePointer(bsp->slotName); sp->overrideMessage = SymbolPointer(bsp->overrideMessage); IncrementSymbolCount(sp->overrideMessage); if (bsp->defaultValue != -1L) { if (sp->dynamicDefault) sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue); else { sp->defaultValue = (void *) get_struct(theEnv,dataObject); EvaluateAndStoreInDataObject(theEnv,(int) sp->multiple,ExpressionPointer(bsp->defaultValue), (DATA_OBJECT *) sp->defaultValue,TRUE); ValueInstall(theEnv,(DATA_OBJECT *) sp->defaultValue); } } else sp->defaultValue = NULL; sp->constraint = ConstraintPointer(bsp->constraint); sp->sharedCount = 0; sp->sharedValue.value = NULL; sp->bsaveIndex = 0L; if (sp->shared) { sp->sharedValue.desc = sp; sp->sharedValue.value = NULL; } } static void UpdateSlotName( void *theEnv, void *buf, long obji) { SLOT_NAME *snp; BSAVE_SLOT_NAME *bsnp; bsnp = (BSAVE_SLOT_NAME *) buf; snp = (SLOT_NAME *) &ObjectBinaryData(theEnv)->SlotNameArray[obji]; snp->id = bsnp->id; snp->name = SymbolPointer(bsnp->name); IncrementSymbolCount(snp->name); snp->putHandlerName = SymbolPointer(bsnp->putHandlerName); IncrementSymbolCount(snp->putHandlerName); snp->hashTableIndex = bsnp->hashTableIndex; snp->nxt = DefclassData(theEnv)->SlotNameTable[snp->hashTableIndex]; DefclassData(theEnv)->SlotNameTable[snp->hashTableIndex] = snp; } static void UpdateTemplateSlot( void *theEnv, void *buf, long obji) { ObjectBinaryData(theEnv)->TmpslotArray[obji] = SlotPointer(* (long *) buf); } static void UpdateHandler( void *theEnv, void *buf, long obji) { HANDLER *hnd; BSAVE_HANDLER *bhnd; hnd = (HANDLER *) &ObjectBinaryData(theEnv)->HandlerArray[obji]; bhnd = (BSAVE_HANDLER *) buf; hnd->system = bhnd->system; hnd->type = bhnd->type; hnd->minParams = bhnd->minParams; hnd->maxParams = bhnd->maxParams; hnd->localVarCount = bhnd->localVarCount; hnd->cls = DefclassPointer(bhnd->cls); hnd->name = SymbolPointer(bhnd->name); IncrementSymbolCount(hnd->name); hnd->actions = ExpressionPointer(bhnd->actions); hnd->ppForm = NULL; hnd->busy = 0; hnd->mark = 0; hnd->usrData = NULL; #if DEBUGGING_FUNCTIONS hnd->trace = MessageHandlerData(theEnv)->WatchHandlers; #endif } /*************************************************************** NAME : ClearBloadObjects DESCRIPTION : Release all binary-loaded class and handler structure arrays (and others) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : None ***************************************************************/ static void ClearBloadObjects( void *theEnv) { register long i; size_t space; space = (sizeof(DEFCLASS_MODULE) * ObjectBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genfree(theEnv,(void *) ObjectBinaryData(theEnv)->ModuleArray,space); ObjectBinaryData(theEnv)->ModuleArray = NULL; ObjectBinaryData(theEnv)->ModuleCount = 0L; if (ObjectBinaryData(theEnv)->ClassCount != 0L) { rm(theEnv,(void *) DefclassData(theEnv)->ClassIDMap,(sizeof(DEFCLASS *) * DefclassData(theEnv)->AvailClassID)); DefclassData(theEnv)->ClassIDMap = NULL; DefclassData(theEnv)->MaxClassID = 0; DefclassData(theEnv)->AvailClassID = 0; for (i = 0L ; i < ObjectBinaryData(theEnv)->ClassCount ; i++) { UnmarkConstructHeader(theEnv,&ObjectBinaryData(theEnv)->DefclassArray[i].header); #if DEFMODULE_CONSTRUCT DecrementBitMapCount(theEnv,ObjectBinaryData(theEnv)->DefclassArray[i].scopeMap); #endif RemoveClassFromTable(theEnv,(DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[i]); } for (i = 0L ; i < ObjectBinaryData(theEnv)->SlotCount ; i++) { DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->SlotArray[i].overrideMessage); if ((ObjectBinaryData(theEnv)->SlotArray[i].defaultValue != NULL) && (ObjectBinaryData(theEnv)->SlotArray[i].dynamicDefault == 0)) { ValueDeinstall(theEnv,(DATA_OBJECT *) ObjectBinaryData(theEnv)->SlotArray[i].defaultValue); rtn_struct(theEnv,dataObject,ObjectBinaryData(theEnv)->SlotArray[i].defaultValue); } } for (i = 0L ; i < ObjectBinaryData(theEnv)->SlotNameCount ; i++) { DefclassData(theEnv)->SlotNameTable[ObjectBinaryData(theEnv)->SlotNameArray[i].hashTableIndex] = NULL; DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->SlotNameArray[i].name); DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->SlotNameArray[i].putHandlerName); } space = (sizeof(DEFCLASS) * ObjectBinaryData(theEnv)->ClassCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->DefclassArray,space); ObjectBinaryData(theEnv)->DefclassArray = NULL; ObjectBinaryData(theEnv)->ClassCount = 0L; } space = (sizeof(DEFCLASS *) * ObjectBinaryData(theEnv)->LinkCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->LinkArray,space); ObjectBinaryData(theEnv)->LinkArray = NULL; ObjectBinaryData(theEnv)->LinkCount = 0L; } space = (sizeof(SLOT_DESC) * ObjectBinaryData(theEnv)->SlotCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotArray,space); ObjectBinaryData(theEnv)->SlotArray = NULL; ObjectBinaryData(theEnv)->SlotCount = 0L; } space = (sizeof(SLOT_NAME) * ObjectBinaryData(theEnv)->SlotNameCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotNameArray,space); ObjectBinaryData(theEnv)->SlotNameArray = NULL; ObjectBinaryData(theEnv)->SlotNameCount = 0L; } space = (sizeof(SLOT_DESC *) * ObjectBinaryData(theEnv)->TemplateSlotCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->TmpslotArray,space); ObjectBinaryData(theEnv)->TmpslotArray = NULL; ObjectBinaryData(theEnv)->TemplateSlotCount = 0L; } space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->MapslotArray,space); ObjectBinaryData(theEnv)->MapslotArray = NULL; ObjectBinaryData(theEnv)->SlotNameMapCount = 0L; } } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { for (i = 0L ; i < ObjectBinaryData(theEnv)->HandlerCount ; i++) DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->HandlerArray[i].name); space = (sizeof(HANDLER) * ObjectBinaryData(theEnv)->HandlerCount); if (space != 0L) { genfree(theEnv,(void *) ObjectBinaryData(theEnv)->HandlerArray,space); ObjectBinaryData(theEnv)->HandlerArray = NULL; space = (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); genfree(theEnv,(void *) ObjectBinaryData(theEnv)->MaphandlerArray,space); ObjectBinaryData(theEnv)->MaphandlerArray = NULL; ObjectBinaryData(theEnv)->HandlerCount = 0L; } } } #endif clips_core_source_630/core/msgfun.h0000755000175000017500000001122412374017656015714 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Message-passing support functions */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_msgfun #define _H_msgfun typedef struct handlerSlotReference { long classID; long slotID; } HANDLER_SLOT_REFERENCE; #ifndef _H_object #include "object.h" #endif #include "msgpass.h" #define BEGIN_TRACE ">>" #define END_TRACE "<<" /* ================================================================================= Message-handler types - don't change these values: a string array depends on them ================================================================================= */ #define MAROUND 0 #define MBEFORE 1 #define MPRIMARY 2 #define MAFTER 3 #define MERROR 4 #define LOOKUP_HANDLER_INDEX 0 #define LOOKUP_HANDLER_ADDRESS 1 #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void UnboundHandlerErr(void *); LOCALE void PrintNoHandlerError(void *,const char *); LOCALE int CheckHandlerArgCount(void *); LOCALE void SlotAccessViolationError(void *,const char *,intBool,void *); LOCALE void SlotVisibilityViolationError(void *,SLOT_DESC *,DEFCLASS *); #if ! RUN_TIME LOCALE void NewSystemHandler(void *,const char *,const char *,const char *,int); LOCALE HANDLER *InsertHandlerHeader(void *,DEFCLASS *,SYMBOL_HN *,int); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE HANDLER *NewHandler(void); LOCALE int HandlersExecuting(DEFCLASS *); LOCALE int DeleteHandler(void *,DEFCLASS *,SYMBOL_HN *,int,int); LOCALE void DeallocateMarkedHandlers(void *,DEFCLASS *); #endif LOCALE unsigned HandlerType(void *,const char *,const char *); LOCALE int CheckCurrentMessage(void *,const char *,int); LOCALE void PrintHandler(void *,const char *,HANDLER *,int); LOCALE HANDLER *FindHandlerByAddress(DEFCLASS *,SYMBOL_HN *,unsigned); LOCALE int FindHandlerByIndex(DEFCLASS *,SYMBOL_HN *,unsigned); LOCALE int FindHandlerNameGroup(DEFCLASS *,SYMBOL_HN *); LOCALE void HandlerDeleteError(void *,const char *); #if DEBUGGING_FUNCTIONS LOCALE void DisplayCore(void *,const char *,HANDLER_LINK *,int); LOCALE HANDLER_LINK *FindPreviewApplicableHandlers(void *,DEFCLASS *,SYMBOL_HN *); LOCALE void WatchMessage(void *,const char *,const char *); LOCALE void WatchHandler(void *,const char *,HANDLER_LINK *,const char *); #endif #endif /* _H_msgfun */ clips_core_source_630/core/._constrnt.c0000755000175000017500000000040712373714236016475 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/tmpltbin.c0000755000175000017500000006332012373754243016244 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFTEMPLATE BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* deftemplate construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for deftemplate slot facets. */ /* */ /*************************************************************/ #define _TMPLTBIN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "bload.h" #include "bsave.h" #include "factbin.h" #include "cstrnbin.h" #include "factmngr.h" #include "tmpltpsr.h" #include "tmpltdef.h" #include "tmpltutl.h" #include "envrnmnt.h" #include "tmpltbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDeftemplateModule(void *,void *,long); static void UpdateDeftemplate(void *,void *,long); static void UpdateDeftemplateSlot(void *,void *,long); static void ClearBload(void *); static void DeallocateDeftemplateBloadData(void *); /***********************************************/ /* DeftemplateBinarySetup: Installs the binary */ /* save/load feature for deftemplates. */ /***********************************************/ globle void DeftemplateBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,TMPLTBIN_DATA,sizeof(struct deftemplateBinaryData),DeallocateDeftemplateBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"deftemplate",0,BsaveFind,NULL, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"deftemplate",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /***********************************************************/ /* DeallocateDeftemplateBloadData: Deallocates environment */ /* data for the deftemplate bsave functionality. */ /***********************************************************/ static void DeallocateDeftemplateBloadData( void *theEnv) { size_t space; space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space); space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space); space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space); } #if BLOAD_AND_BSAVE /**************************************************************/ /* BsaveFind: Counts the number of data structures which must */ /* be saved in the binary image for the deftemplates in the */ /* current environment. */ /**************************************************************/ static void BsaveFind( void *theEnv) { struct deftemplate *theDeftemplate; struct templateSlot *theSlot; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DeftemplateBinaryData(theEnv)->NumberOfDeftemplates); SaveBloadCount(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots); SaveBloadCount(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateModules); /*==================================================*/ /* Set the count of deftemplates, deftemplate slots */ /* and deftemplate module data structures to zero. */ /*==================================================*/ DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*============================================*/ /* Set the current module to the module being */ /* examined and increment the number of */ /* deftemplate modules encountered. */ /*============================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); DeftemplateBinaryData(theEnv)->NumberOfTemplateModules++; /*======================================================*/ /* Loop through each deftemplate in the current module. */ /*======================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*======================================================*/ /* Initialize the construct header for the binary save. */ /*======================================================*/ MarkConstructHeaderNeededItems(&theDeftemplate->header, DeftemplateBinaryData(theEnv)->NumberOfDeftemplates++); /*=============================================================*/ /* Loop through each slot in the deftemplate, incrementing the */ /* slot count and marking the slot names as needed symbols. */ /*=============================================================*/ for (theSlot = theDeftemplate->slotList; theSlot != NULL; theSlot = theSlot->next) { DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots++; theSlot->slotName->neededSymbol = TRUE; } } } } /*********************************************************/ /* BsaveStorage: Writes out the storage requirements for */ /* all deftemplate structures to the binary file. */ /*********************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { size_t space; /*========================================================================*/ /* Three data structures are saved as part of a deftemplate binary image: */ /* the deftemplate data structure, the deftemplateModule data structure, */ /* and the templateSlot data structure. The data structures associated */ /* with default values and constraints are not save with the deftemplate */ /* portion of the binary image. */ /*========================================================================*/ space = sizeof(long) * 3; GenWrite(&space,sizeof(size_t),fp); GenWrite(&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,sizeof(long int),fp); GenWrite(&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,sizeof(long int),fp); GenWrite(&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,sizeof(long int),fp); } /***********************************************/ /* BsaveBinaryItem: Writes out all deftemplate */ /* structures to the binary file. */ /***********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { size_t space; struct deftemplate *theDeftemplate; struct bsaveDeftemplate tempDeftemplate; struct templateSlot *theSlot; struct bsaveTemplateSlot tempTemplateSlot; struct bsaveDeftemplateModule tempTemplateModule; struct defmodule *theModule; struct deftemplateModule *theModuleItem; /*============================================================*/ /* Write out the amount of space taken up by the deftemplate, */ /* deftemplateModule, and templateSlot data structures in the */ /* binary image. */ /*============================================================*/ space = (DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct bsaveDeftemplate)) + (DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct bsaveTemplateSlot)) + (DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct bsaveDeftemplateModule)); GenWrite(&space,sizeof(size_t),fp); /*===================================================*/ /* Write out each deftemplate module data structure. */ /*===================================================*/ DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct deftemplateModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"deftemplate")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&tempTemplateModule.header, &theModuleItem->header); GenWrite(&tempTemplateModule,sizeof(struct bsaveDeftemplateModule),fp); } /*============================================*/ /* Write out each deftemplate data structure. */ /*============================================*/ DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { AssignBsaveConstructHeaderVals(&tempDeftemplate.header, &theDeftemplate->header); tempDeftemplate.implied = theDeftemplate->implied; tempDeftemplate.numberOfSlots = theDeftemplate->numberOfSlots; tempDeftemplate.patternNetwork = BsaveFactPatternIndex(theDeftemplate->patternNetwork); if (theDeftemplate->slotList != NULL) { tempDeftemplate.slotList = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; } else tempDeftemplate.slotList = -1L; GenWrite(&tempDeftemplate,sizeof(struct bsaveDeftemplate),fp); DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots += theDeftemplate->numberOfSlots; } } /*=============================================*/ /* Write out each templateSlot data structure. */ /*=============================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { for (theSlot = theDeftemplate->slotList; theSlot != NULL; theSlot = theSlot->next) { tempTemplateSlot.constraints = ConstraintIndex(theSlot->constraints); tempTemplateSlot.slotName = theSlot->slotName->bucket; tempTemplateSlot.multislot = theSlot->multislot; tempTemplateSlot.noDefault = theSlot->noDefault; tempTemplateSlot.defaultPresent = theSlot->defaultPresent; tempTemplateSlot.defaultDynamic = theSlot->defaultDynamic; tempTemplateSlot.defaultList = HashedExpressionIndex(theEnv,theSlot->defaultList); tempTemplateSlot.facetList = HashedExpressionIndex(theEnv,theSlot->facetList); if (theSlot->next != NULL) tempTemplateSlot.next = 0L; else tempTemplateSlot.next = -1L; GenWrite(&tempTemplateSlot,sizeof(struct bsaveTemplateSlot),fp); } } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of deftemplates, deftemplate modules, and deftemplate slots */ /* in the binary image (these were overwritten by the binary */ /* save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates); RestoreBloadCount(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots); RestoreBloadCount(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules); } #endif /* BLOAD_AND_BSAVE */ /****************************************************/ /* BloadStorage: Allocates storage requirements for */ /* the deftemplates used by this binary image. */ /****************************************************/ static void BloadStorage( void *theEnv) { size_t space; /*=========================================================*/ /* Determine the number of deftemplate, deftemplateModule, */ /* and templateSlot data structures to be read. */ /*=========================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,sizeof(long int)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,sizeof(long int)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,sizeof(long int)); /*====================================*/ /* Allocate the space needed for the */ /* deftemplateModule data structures. */ /*====================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfTemplateModules == 0) { DeftemplateBinaryData(theEnv)->DeftemplateArray = NULL; DeftemplateBinaryData(theEnv)->SlotArray = NULL; DeftemplateBinaryData(theEnv)->ModuleArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); DeftemplateBinaryData(theEnv)->ModuleArray = (struct deftemplateModule *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* deftemplate data structures. */ /*===================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfDeftemplates == 0) { DeftemplateBinaryData(theEnv)->DeftemplateArray = NULL; DeftemplateBinaryData(theEnv)->SlotArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); DeftemplateBinaryData(theEnv)->DeftemplateArray = (struct deftemplate *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* templateSlot data structures. */ /*===================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots == 0) { DeftemplateBinaryData(theEnv)->SlotArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); DeftemplateBinaryData(theEnv)->SlotArray = (struct templateSlot *) genalloc(theEnv,space); } /********************************************************/ /* BloadBinaryItem: Loads and refreshes the deftemplate */ /* constructs used by this binary image. */ /********************************************************/ static void BloadBinaryItem( void *theEnv) { size_t space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); /*===============================================*/ /* Read in the deftemplateModule data structures */ /* and refresh the pointers. */ /*===============================================*/ BloadandRefresh(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,sizeof(struct bsaveDeftemplateModule), UpdateDeftemplateModule); /*===============================================*/ /* Read in the deftemplateModule data structures */ /* and refresh the pointers. */ /*===============================================*/ BloadandRefresh(theEnv,DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,sizeof(struct bsaveDeftemplate), UpdateDeftemplate); /*==========================================*/ /* Read in the templateSlot data structures */ /* and refresh the pointers. */ /*==========================================*/ BloadandRefresh(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,sizeof(struct bsaveTemplateSlot), UpdateDeftemplateSlot); } /**************************************************/ /* UpdateDeftemplateModule: Bload refresh routine */ /* for deftemplateModule data structures. */ /**************************************************/ static void UpdateDeftemplateModule( void *theEnv, void *buf, long obji) { struct bsaveDeftemplateModule *bdmPtr; bdmPtr = (struct bsaveDeftemplateModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DeftemplateBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct deftemplate), (void *) DeftemplateBinaryData(theEnv)->DeftemplateArray); } /********************************************/ /* UpdateDeftemplate: Bload refresh routine */ /* for deftemplate data structures. */ /********************************************/ static void UpdateDeftemplate( void *theEnv, void *buf, long obji) { struct deftemplate *theDeftemplate; struct bsaveDeftemplate *bdtPtr; bdtPtr = (struct bsaveDeftemplate *) buf; theDeftemplate = (struct deftemplate *) &DeftemplateBinaryData(theEnv)->DeftemplateArray[obji]; UpdateConstructHeader(theEnv,&bdtPtr->header,&theDeftemplate->header, (int) sizeof(struct deftemplateModule),(void *) DeftemplateBinaryData(theEnv)->ModuleArray, (int) sizeof(struct deftemplate),(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray); if (bdtPtr->slotList != -1L) { theDeftemplate->slotList = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[bdtPtr->slotList]; } else { theDeftemplate->slotList = NULL; } if (bdtPtr->patternNetwork != -1L) { theDeftemplate->patternNetwork = (struct factPatternNode *) BloadFactPatternPointer(bdtPtr->patternNetwork); } else { theDeftemplate->patternNetwork = NULL; } theDeftemplate->implied = bdtPtr->implied; #if DEBUGGING_FUNCTIONS theDeftemplate->watch = FactData(theEnv)->WatchFacts; #endif theDeftemplate->inScope = FALSE; theDeftemplate->numberOfSlots = (unsigned short) bdtPtr->numberOfSlots; theDeftemplate->factList = NULL; theDeftemplate->lastFact = NULL; } /************************************************/ /* UpdateDeftemplateSlot: Bload refresh routine */ /* for templateSlot data structures. */ /************************************************/ static void UpdateDeftemplateSlot( void *theEnv, void *buf, long obji) { struct templateSlot *theSlot; struct bsaveTemplateSlot *btsPtr; btsPtr = (struct bsaveTemplateSlot *) buf; theSlot = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji]; theSlot->slotName = SymbolPointer(btsPtr->slotName); IncrementSymbolCount(theSlot->slotName); theSlot->defaultList = HashedExpressionPointer(btsPtr->defaultList); theSlot->facetList = HashedExpressionPointer(btsPtr->facetList); theSlot->constraints = ConstraintPointer(btsPtr->constraints); theSlot->multislot = btsPtr->multislot; theSlot->noDefault = btsPtr->noDefault; theSlot->defaultPresent = btsPtr->defaultPresent; theSlot->defaultDynamic = btsPtr->defaultDynamic; if (btsPtr->next != -1L) { theSlot->next = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji + 1]; } else { theSlot->next = NULL; } } /*****************************************/ /* ClearBload: Deftemplate clear routine */ /* when a binary load is in effect. */ /*****************************************/ static void ClearBload( void *theEnv) { size_t space; int i; /*=============================================*/ /* Decrement in use counters for atomic values */ /* contained in the construct headers. */ /*=============================================*/ for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfDeftemplates; i++) { UnmarkConstructHeader(theEnv,&DeftemplateBinaryData(theEnv)->DeftemplateArray[i].header); } /*=======================================*/ /* Decrement in use counters for symbols */ /* used as slot names. */ /*=======================================*/ for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; i++) { DecrementSymbolCount(theEnv,DeftemplateBinaryData(theEnv)->SlotArray[i].slotName); } /*======================================================================*/ /* Deallocate the space used for the deftemplateModule data structures. */ /*======================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space); DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0; /*================================================================*/ /* Deallocate the space used for the deftemplate data structures. */ /*================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space); DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; /*=================================================================*/ /* Deallocate the space used for the templateSlot data structures. */ /*=================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space); DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; /*======================================*/ /* Create the initial-fact deftemplate. */ /*======================================*/ #if (! BLOAD_ONLY) CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); #endif } /************************************************************/ /* BloadDeftemplateModuleReference: Returns the deftemplate */ /* module pointer for use with the bload function. */ /************************************************************/ globle void *BloadDeftemplateModuleReference( void *theEnv, int theIndex) { return ((void *) &DeftemplateBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips_core_source_630/core/iofun.c0000755000175000017500000014735712476444662015555 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/26/15 */ /* */ /* I/O FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several I/O functions */ /* including printout, read, open, close, remove, rename, */ /* format, and readline. */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* Gary D. Riley */ /* Bebe Ly */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added the get-char, set-locale, and */ /* read-number functions. */ /* */ /* Modified printing of floats in the format */ /* function to use the locale from the set-locale */ /* function. */ /* */ /* Moved IllegalLogicalNameMessage function to */ /* argacces.c. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Removed the undocumented use of t in the */ /* printout command to perform the same function */ /* as crlf. */ /* */ /* Replaced EXT_IO and BASIC_IO compiler flags */ /* with IO_FUNCTIONS compiler flag. */ /* */ /* Added rb and ab and removed r+ modes for the */ /* open function. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Added put-char function. */ /* */ /* Added SetFullCRLF which allows option to */ /* specify crlf as \n or \r\n. */ /* */ /* Added AwaitingInput flag. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added STDOUT and STDIN logical name */ /* definitions. */ /* */ /*************************************************************/ #define _IOFUN_SOURCE_ #include "setup.h" #if IO_FUNCTIONS #include #include #include #endif #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "router.h" #include "strngrtr.h" #include "filertr.h" #include "argacces.h" #include "extnfunc.h" #include "scanner.h" #include "constant.h" #include "memalloc.h" #include "commline.h" #include "sysdep.h" #include "utility.h" #include "iofun.h" /***************/ /* DEFINITIONS */ /***************/ #define FORMAT_MAX 512 #define FLAG_MAX 80 /********************/ /* ENVIRONMENT DATA */ /********************/ #define IO_FUNCTION_DATA 64 struct IOFunctionData { void *locale; intBool useFullCRLF; }; #define IOFunctionData(theEnv) ((struct IOFunctionData *) GetEnvironmentData(theEnv,IO_FUNCTION_DATA)) /****************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /****************************************/ #if IO_FUNCTIONS static void ReadTokenFromStdin(void *,struct token *); static const char *ControlStringCheck(void *,int); static char FindFormatFlag(const char *,size_t *,char *,size_t); static const char *PrintFormatFlag(void *,const char *,int,int); static char *FillBuffer(void *,const char *,size_t *,size_t *); static void ReadNumber(void *,const char *,struct token *,int); #endif /**************************************/ /* IOFunctionDefinitions: Initializes */ /* the I/O functions. */ /**************************************/ globle void IOFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,IO_FUNCTION_DATA,sizeof(struct IOFunctionData),NULL); #if IO_FUNCTIONS IOFunctionData(theEnv)->useFullCRLF = FALSE; IOFunctionData(theEnv)->locale = (SYMBOL_HN *) EnvAddSymbol(theEnv,setlocale(LC_ALL,NULL)); IncrementSymbolCount(IOFunctionData(theEnv)->locale); #endif #if ! RUN_TIME #if IO_FUNCTIONS EnvDefineFunction2(theEnv,"printout", 'v', PTIEF PrintoutFunction, "PrintoutFunction", "1*"); EnvDefineFunction2(theEnv,"read", 'u', PTIEF ReadFunction, "ReadFunction", "*1"); EnvDefineFunction2(theEnv,"open", 'b', OpenFunction, "OpenFunction", "23*k"); EnvDefineFunction2(theEnv,"close", 'b', CloseFunction, "CloseFunction", "*1"); EnvDefineFunction2(theEnv,"get-char", 'i', GetCharFunction, "GetCharFunction", "*1"); EnvDefineFunction2(theEnv,"put-char", 'v', PTIEF PutCharFunction, "PutCharFunction", "12"); EnvDefineFunction2(theEnv,"remove", 'b', RemoveFunction, "RemoveFunction", "11k"); EnvDefineFunction2(theEnv,"rename", 'b', RenameFunction, "RenameFunction", "22k"); EnvDefineFunction2(theEnv,"format", 's', PTIEF FormatFunction, "FormatFunction", "2**us"); EnvDefineFunction2(theEnv,"readline", 'k', PTIEF ReadlineFunction, "ReadlineFunction", "*1"); EnvDefineFunction2(theEnv,"set-locale", 'u', PTIEF SetLocaleFunction, "SetLocaleFunction", "*1"); EnvDefineFunction2(theEnv,"read-number", 'u', PTIEF ReadNumberFunction, "ReadNumberFunction", "*1"); #endif #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if IO_FUNCTIONS /******************************************/ /* PrintoutFunction: H/L access routine */ /* for the printout function. */ /******************************************/ globle void PrintoutFunction( void *theEnv) { const char *dummyid; int i, argCount; DATA_OBJECT theArgument; /*=======================================================*/ /* The printout function requires at least one argument. */ /*=======================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"printout",AT_LEAST,1)) == -1) return; /*=====================================================*/ /* Get the logical name to which output is to be sent. */ /*=====================================================*/ dummyid = GetLogicalName(theEnv,1,STDOUT); if (dummyid == NULL) { IllegalLogicalNameMessage(theEnv,"printout"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } /*============================================================*/ /* Determine if any router recognizes the output destination. */ /*============================================================*/ if (strcmp(dummyid,"nil") == 0) { return; } else if (QueryRouters(theEnv,dummyid) == FALSE) { UnrecognizedRouterMessage(theEnv,dummyid); return; } /*===============================================*/ /* Print each of the arguments sent to printout. */ /*===============================================*/ for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theArgument); if (EvaluationData(theEnv)->HaltExecution) break; switch(GetType(theArgument)) { case SYMBOL: if (strcmp(DOToString(theArgument),"crlf") == 0) { if (IOFunctionData(theEnv)->useFullCRLF) { EnvPrintRouter(theEnv,dummyid,"\r\n"); } else { EnvPrintRouter(theEnv,dummyid,"\n"); } } else if (strcmp(DOToString(theArgument),"tab") == 0) { EnvPrintRouter(theEnv,dummyid,"\t"); } else if (strcmp(DOToString(theArgument),"vtab") == 0) { EnvPrintRouter(theEnv,dummyid,"\v"); } else if (strcmp(DOToString(theArgument),"ff") == 0) { EnvPrintRouter(theEnv,dummyid,"\f"); } /* else if (strcmp(DOToString(theArgument),"t") == 0) { if (IOFunctionData(theEnv)->useFullCRLF) { EnvPrintRouter(theEnv,dummyid,"\r\n"); } else { EnvPrintRouter(theEnv,dummyid,"\n"); } } */ else { EnvPrintRouter(theEnv,dummyid,DOToString(theArgument)); } break; case STRING: EnvPrintRouter(theEnv,dummyid,DOToString(theArgument)); break; default: PrintDataObject(theEnv,dummyid,&theArgument); break; } } } /*****************************************************/ /* SetFullCRLF: Set the flag which indicates whether */ /* crlf is treated just as '\n' or '\r\n'. */ /*****************************************************/ globle intBool SetFullCRLF( void *theEnv, intBool value) { intBool oldValue = IOFunctionData(theEnv)->useFullCRLF; IOFunctionData(theEnv)->useFullCRLF = value; return(oldValue); } /*************************************************************/ /* ReadFunction: H/L access routine for the read function. */ /*************************************************************/ globle void ReadFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct token theToken; int numberOfArguments; const char *logicalName = NULL; /*===============================================*/ /* Check for an appropriate number of arguments. */ /*===============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"read",NO_MORE_THAN,1)) == -1) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*======================================================*/ /* Determine the logical name from which input is read. */ /*======================================================*/ if (numberOfArguments == 0) { logicalName = STDIN; } else if (numberOfArguments == 1) { logicalName = GetLogicalName(theEnv,1,STDIN); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"read"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } } /*============================================*/ /* Check to see that the logical name exists. */ /*============================================*/ if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*=======================================*/ /* Collect input into string if the read */ /* source is stdin, else just get token. */ /*=======================================*/ if (strcmp(logicalName,STDIN) == 0) { ReadTokenFromStdin(theEnv,&theToken); } else { GetToken(theEnv,logicalName,&theToken); } RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = FALSE; /*====================================================*/ /* Copy the token to the return value data structure. */ /*====================================================*/ returnValue->type = theToken.type; if ((theToken.type == FLOAT) || (theToken.type == STRING) || #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == SYMBOL) || (theToken.type == INTEGER)) { returnValue->value = theToken.value; } else if (theToken.type == STOP) { returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); } else if (theToken.type == UNKNOWN_VALUE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } else { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm); } return; } /********************************************************/ /* ReadTokenFromStdin: Special routine used by the read */ /* function to read a token from standard input. */ /********************************************************/ static void ReadTokenFromStdin( void *theEnv, struct token *theToken) { char *inputString; size_t inputStringSize; int inchar; /*=============================================*/ /* Continue processing until a token is found. */ /*=============================================*/ theToken->type = STOP; while (theToken->type == STOP) { /*===========================================*/ /* Initialize the variables used for storing */ /* the characters retrieved from stdin. */ /*===========================================*/ inputString = NULL; RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; inputStringSize = 0; inchar = EnvGetcRouter(theEnv,STDIN); /*========================================================*/ /* Continue reading characters until a carriage return is */ /* entered or the user halts execution (usually with */ /* control-c). Waiting for the carriage return prevents */ /* the input from being prematurely parsed (such as when */ /* a space is entered after a symbol has been typed). */ /*========================================================*/ while ((inchar != '\n') && (inchar != '\r') && (inchar != EOF) && (! GetHaltExecution(theEnv))) { inputString = ExpandStringWithChar(theEnv,inchar,inputString,&RouterData(theEnv)->CommandBufferInputCount, &inputStringSize,inputStringSize + 80); inchar = EnvGetcRouter(theEnv,STDIN); } /*==================================================*/ /* Open a string input source using the characters */ /* retrieved from stdin and extract the first token */ /* contained in the string. */ /*==================================================*/ OpenStringSource(theEnv,"read",inputString,0); GetToken(theEnv,"read",theToken); CloseStringSource(theEnv,"read"); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); /*===========================================*/ /* Pressing control-c (or comparable action) */ /* aborts the read function. */ /*===========================================*/ if (GetHaltExecution(theEnv)) { theToken->type = STRING; theToken->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } /*====================================================*/ /* Return the EOF symbol if the end of file for stdin */ /* has been encountered. This typically won't occur, */ /* but is possible (for example by pressing control-d */ /* in the UNIX operating system). */ /*====================================================*/ if ((theToken->type == STOP) && (inchar == EOF)) { theToken->type = SYMBOL; theToken->value = (void *) EnvAddSymbol(theEnv,"EOF"); } } } /*************************************************************/ /* OpenFunction: H/L access routine for the open function. */ /*************************************************************/ globle int OpenFunction( void *theEnv) { int numberOfArguments; const char *fileName, *logicalName, *accessMode = NULL; DATA_OBJECT theArgument; /*========================================*/ /* Check for a valid number of arguments. */ /*========================================*/ if ((numberOfArguments = EnvArgRangeCheck(theEnv,"open",2,3)) == -1) return(0); /*====================*/ /* Get the file name. */ /*====================*/ if ((fileName = GetFileName(theEnv,"open",1)) == NULL) return(0); /*=======================================*/ /* Get the logical name to be associated */ /* with the opened file. */ /*=======================================*/ logicalName = GetLogicalName(theEnv,2,NULL); if (logicalName == NULL) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); IllegalLogicalNameMessage(theEnv,"open"); return(0); } /*==================================*/ /* Check to see if the logical name */ /* is already in use. */ /*==================================*/ if (FindFile(theEnv,logicalName)) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"IOFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Logical name "); EnvPrintRouter(theEnv,WERROR,logicalName); EnvPrintRouter(theEnv,WERROR," already in use.\n"); return(0); } /*===========================*/ /* Get the file access mode. */ /*===========================*/ if (numberOfArguments == 2) { accessMode = "r"; } else if (numberOfArguments == 3) { if (EnvArgTypeCheck(theEnv,"open",3,STRING,&theArgument) == FALSE) return(0); accessMode = DOToString(theArgument); } /*=====================================*/ /* Check for a valid file access mode. */ /*=====================================*/ if ((strcmp(accessMode,"r") != 0) && (strcmp(accessMode,"w") != 0) && (strcmp(accessMode,"a") != 0) && (strcmp(accessMode,"rb") != 0) && (strcmp(accessMode,"wb") != 0) && (strcmp(accessMode,"ab") != 0)) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"open",3,"string with value \"r\", \"w\", \"a\", \"rb\", \"wb\", or \"ab\""); return(0); } /*================================================*/ /* Open the named file and associate it with the */ /* specified logical name. Return TRUE if the */ /* file was opened successfully, otherwise FALSE. */ /*================================================*/ return(OpenAFile(theEnv,fileName,accessMode,logicalName)); } /***************************************************************/ /* CloseFunction: H/L access routine for the close function. */ /***************************************************************/ globle int CloseFunction( void *theEnv) { int numberOfArguments; const char *logicalName; /*======================================*/ /* Check for valid number of arguments. */ /*======================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"close",NO_MORE_THAN,1)) == -1) return(0); /*=====================================================*/ /* If no arguments are specified, then close all files */ /* opened with the open command. Return TRUE if all */ /* files were closed successfully, otherwise FALSE. */ /*=====================================================*/ if (numberOfArguments == 0) return(CloseAllFiles(theEnv)); /*================================*/ /* Get the logical name argument. */ /*================================*/ logicalName = GetLogicalName(theEnv,1,NULL); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"close"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(0); } /*========================================================*/ /* Close the file associated with the specified logical */ /* name. Return TRUE if the file was closed successfully, */ /* otherwise false. */ /*========================================================*/ return(CloseFile(theEnv,logicalName)); } /***************************************/ /* GetCharFunction: H/L access routine */ /* for the get-char function. */ /***************************************/ globle int GetCharFunction( void *theEnv) { int numberOfArguments; const char *logicalName; if ((numberOfArguments = EnvArgCountCheck(theEnv,"get-char",NO_MORE_THAN,1)) == -1) { return(-1); } if (numberOfArguments == 0 ) { logicalName = STDIN; } else { logicalName = GetLogicalName(theEnv,1,STDIN); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"get-char"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } } if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } return(EnvGetcRouter(theEnv,logicalName)); } /***************************************/ /* PutCharFunction: H/L access routine */ /* for the put-char function. */ /***************************************/ globle void PutCharFunction( void *theEnv) { int numberOfArguments; const char *logicalName; DATA_OBJECT theValue; long long theChar; FILE *theFile; if ((numberOfArguments = EnvArgRangeCheck(theEnv,"put-char",1,2)) == -1) { return; } /*=======================*/ /* Get the logical name. */ /*=======================*/ if (numberOfArguments == 1) { logicalName = STDOUT; } else { logicalName = GetLogicalName(theEnv,1,STDOUT); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"put-char"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } } if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } /*===========================*/ /* Get the character to put. */ /*===========================*/ if (numberOfArguments == 1) { if (EnvArgTypeCheck(theEnv,"put-char",1,INTEGER,&theValue) == FALSE) return; } else { if (EnvArgTypeCheck(theEnv,"put-char",2,INTEGER,&theValue) == FALSE) return; } theChar = DOToLong(theValue); /*===================================================*/ /* If the "fast load" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* we can bypass the router and directly output the */ /* value. */ /*===================================================*/ theFile = FindFptr(theEnv,logicalName); if (theFile != NULL) { putc((int) theChar,theFile); } } /****************************************/ /* RemoveFunction: H/L access routine */ /* for the remove function. */ /****************************************/ globle int RemoveFunction( void *theEnv) { const char *theFileName; /*======================================*/ /* Check for valid number of arguments. */ /*======================================*/ if (EnvArgCountCheck(theEnv,"remove",EXACTLY,1) == -1) return(FALSE); /*====================*/ /* Get the file name. */ /*====================*/ if ((theFileName = GetFileName(theEnv,"remove",1)) == NULL) return(FALSE); /*==============================================*/ /* Remove the file. Return TRUE if the file was */ /* sucessfully removed, otherwise FALSE. */ /*==============================================*/ return(genremove(theFileName)); } /****************************************/ /* RenameFunction: H/L access routine */ /* for the rename function. */ /****************************************/ globle int RenameFunction( void *theEnv) { const char *oldFileName, *newFileName; /*========================================*/ /* Check for a valid number of arguments. */ /*========================================*/ if (EnvArgCountCheck(theEnv,"rename",EXACTLY,2) == -1) return(FALSE); /*===========================*/ /* Check for the file names. */ /*===========================*/ if ((oldFileName = GetFileName(theEnv,"rename",1)) == NULL) return(FALSE); if ((newFileName = GetFileName(theEnv,"rename",2)) == NULL) return(FALSE); /*==============================================*/ /* Rename the file. Return TRUE if the file was */ /* sucessfully renamed, otherwise FALSE. */ /*==============================================*/ return(genrename(oldFileName,newFileName)); } /****************************************/ /* FormatFunction: H/L access routine */ /* for the format function. */ /****************************************/ globle void *FormatFunction( void *theEnv) { int argCount; size_t start_pos; const char *formatString; const char *logicalName; char formatFlagType; int f_cur_arg = 3; size_t form_pos = 0; char percentBuffer[FLAG_MAX]; char *fstr = NULL; size_t fmaxm = 0; size_t fpos = 0; void *hptr; const char *theString; /*======================================*/ /* Set default return value for errors. */ /*======================================*/ hptr = EnvAddSymbol(theEnv,""); /*=========================================*/ /* Format requires at least two arguments: */ /* a logical name and a format string. */ /*=========================================*/ if ((argCount = EnvArgCountCheck(theEnv,"format",AT_LEAST,2)) == -1) { return(hptr); } /*========================================*/ /* First argument must be a logical name. */ /*========================================*/ if ((logicalName = GetLogicalName(theEnv,1,STDOUT)) == NULL) { IllegalLogicalNameMessage(theEnv,"format"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(hptr); } if (strcmp(logicalName,"nil") == 0) { /* do nothing */ } else if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); return(hptr); } /*=====================================================*/ /* Second argument must be a string. The appropriate */ /* number of arguments specified by the string must be */ /* present in the argument list. */ /*=====================================================*/ if ((formatString = ControlStringCheck(theEnv,argCount)) == NULL) { return (hptr); } /*========================================*/ /* Search the format string, printing the */ /* format flags as they are encountered. */ /*========================================*/ while (formatString[form_pos] != '\0') { if (formatString[form_pos] != '%') { start_pos = form_pos; while ((formatString[form_pos] != '%') && (formatString[form_pos] != '\0')) { form_pos++; } fstr = AppendNToString(theEnv,&formatString[start_pos],fstr,form_pos-start_pos,&fpos,&fmaxm); } else { form_pos++; formatFlagType = FindFormatFlag(formatString,&form_pos,percentBuffer,FLAG_MAX); if (formatFlagType != ' ') { if ((theString = PrintFormatFlag(theEnv,percentBuffer,f_cur_arg,formatFlagType)) == NULL) { if (fstr != NULL) rm(theEnv,fstr,fmaxm); return (hptr); } fstr = AppendToString(theEnv,theString,fstr,&fpos,&fmaxm); if (fstr == NULL) return(hptr); f_cur_arg++; } else { fstr = AppendToString(theEnv,percentBuffer,fstr,&fpos,&fmaxm); if (fstr == NULL) return(hptr); } } } if (fstr != NULL) { hptr = EnvAddSymbol(theEnv,fstr); if (strcmp(logicalName,"nil") != 0) EnvPrintRouter(theEnv,logicalName,fstr); rm(theEnv,fstr,fmaxm); } else { hptr = EnvAddSymbol(theEnv,""); } return(hptr); } /*********************************************************************/ /* ControlStringCheck: Checks the 2nd parameter which is the format */ /* control string to see if there are enough matching arguments. */ /*********************************************************************/ static const char *ControlStringCheck( void *theEnv, int argCount) { DATA_OBJECT t_ptr; const char *str_array; char print_buff[FLAG_MAX]; size_t i; int per_count; char formatFlag; if (EnvArgTypeCheck(theEnv,"format",2,STRING,&t_ptr) == FALSE) return(NULL); per_count = 0; str_array = ValueToString(t_ptr.value); for (i= 0 ; str_array[i] != '\0' ; ) { if (str_array[i] == '%') { i++; formatFlag = FindFormatFlag(str_array,&i,print_buff,FLAG_MAX); if (formatFlag == '-') { PrintErrorID(theEnv,"IOFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid format flag \""); EnvPrintRouter(theEnv,WERROR,print_buff); EnvPrintRouter(theEnv,WERROR,"\" specified in format function.\n"); SetEvaluationError(theEnv,TRUE); return (NULL); } else if (formatFlag != ' ') { per_count++; } } else { i++; } } if (per_count != (argCount - 2)) { ExpectedCountError(theEnv,"format",EXACTLY,per_count+2); SetEvaluationError(theEnv,TRUE); return (NULL); } return(str_array); } /***********************************************/ /* FindFormatFlag: This function searches for */ /* a format flag in the format string. */ /***********************************************/ static char FindFormatFlag( const char *formatString, size_t *a, char *formatBuffer, size_t bufferMax) { char inchar, formatFlagType; size_t copy_pos = 0; /*====================================================*/ /* Set return values to the default value. A blank */ /* character indicates that no format flag was found */ /* which requires a parameter. */ /*====================================================*/ formatFlagType = ' '; /*=====================================================*/ /* The format flags for carriage returns, line feeds, */ /* horizontal and vertical tabs, and the percent sign, */ /* do not require a parameter. */ /*=====================================================*/ if (formatString[*a] == 'n') { gensprintf(formatBuffer,"\n"); (*a)++; return(formatFlagType); } else if (formatString[*a] == 'r') { gensprintf(formatBuffer,"\r"); (*a)++; return(formatFlagType); } else if (formatString[*a] == 't') { gensprintf(formatBuffer,"\t"); (*a)++; return(formatFlagType); } else if (formatString[*a] == 'v') { gensprintf(formatBuffer,"\v"); (*a)++; return(formatFlagType); } else if (formatString[*a] == '%') { gensprintf(formatBuffer,"%%"); (*a)++; return(formatFlagType); } /*======================================================*/ /* Identify the format flag which requires a parameter. */ /*======================================================*/ formatBuffer[copy_pos++] = '%'; formatBuffer[copy_pos] = '\0'; while ((formatString[*a] != '%') && (formatString[*a] != '\0') && (copy_pos < (bufferMax - 5))) { inchar = formatString[*a]; (*a)++; if ( (inchar == 'd') || (inchar == 'o') || (inchar == 'x') || (inchar == 'u')) { formatFlagType = inchar; formatBuffer[copy_pos++] = 'l'; formatBuffer[copy_pos++] = 'l'; formatBuffer[copy_pos++] = inchar; formatBuffer[copy_pos] = '\0'; return(formatFlagType); } else if ( (inchar == 'c') || (inchar == 's') || (inchar == 'e') || (inchar == 'f') || (inchar == 'g') ) { formatBuffer[copy_pos++] = inchar; formatBuffer[copy_pos] = '\0'; formatFlagType = inchar; return(formatFlagType); } /*=======================================================*/ /* If the type hasn't been read, then this should be the */ /* -M.N part of the format specification (where M and N */ /* are integers). */ /*=======================================================*/ if ( (! isdigit(inchar)) && (inchar != '.') && (inchar != '-') ) { formatBuffer[copy_pos++] = inchar; formatBuffer[copy_pos] = '\0'; return('-'); } formatBuffer[copy_pos++] = inchar; formatBuffer[copy_pos] = '\0'; } return(formatFlagType); } /**********************************************************************/ /* PrintFormatFlag: Prints out part of the total format string along */ /* with the argument for that part of the format string. */ /**********************************************************************/ static const char *PrintFormatFlag( void *theEnv, const char *formatString, int whichArg, int formatType) { DATA_OBJECT theResult; const char *theString; char *printBuffer; size_t theLength; void *oldLocale; /*=================*/ /* String argument */ /*=================*/ switch (formatType) { case 's': if (EnvArgTypeCheck(theEnv,"format",whichArg,SYMBOL_OR_STRING,&theResult) == FALSE) return(NULL); theLength = strlen(formatString) + strlen(ValueToString(theResult.value)) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); gensprintf(printBuffer,formatString,ValueToString(theResult.value)); break; case 'c': EnvRtnUnknown(theEnv,whichArg,&theResult); if ((GetType(theResult) == STRING) || (GetType(theResult) == SYMBOL)) { theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); gensprintf(printBuffer,formatString,(ValueToString(theResult.value))[0]); } else if (GetType(theResult) == INTEGER) { theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); gensprintf(printBuffer,formatString,(char) DOToLong(theResult)); } else { ExpectedTypeError1(theEnv,"format",whichArg,"symbol, string, or integer"); return(NULL); } break; case 'd': case 'x': case 'o': case 'u': if (EnvArgTypeCheck(theEnv,"format",whichArg,INTEGER_OR_FLOAT,&theResult) == FALSE) return(NULL); theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); oldLocale = EnvAddSymbol(theEnv,setlocale(LC_NUMERIC,NULL)); setlocale(LC_NUMERIC,ValueToString(IOFunctionData(theEnv)->locale)); if (GetType(theResult) == FLOAT) { gensprintf(printBuffer,formatString,(long long) ValueToDouble(theResult.value)); } else { gensprintf(printBuffer,formatString,(long long) ValueToLong(theResult.value)); } setlocale(LC_NUMERIC,ValueToString(oldLocale)); break; case 'f': case 'g': case 'e': if (EnvArgTypeCheck(theEnv,"format",whichArg,INTEGER_OR_FLOAT,&theResult) == FALSE) return(NULL); theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); oldLocale = EnvAddSymbol(theEnv,setlocale(LC_NUMERIC,NULL)); setlocale(LC_NUMERIC,ValueToString(IOFunctionData(theEnv)->locale)); if (GetType(theResult) == FLOAT) { gensprintf(printBuffer,formatString,ValueToDouble(theResult.value)); } else { gensprintf(printBuffer,formatString,(double) ValueToLong(theResult.value)); } setlocale(LC_NUMERIC,ValueToString(oldLocale)); break; default: EnvPrintRouter(theEnv,WERROR," Error in format, the conversion character"); EnvPrintRouter(theEnv,WERROR," for formatted output is not valid\n"); return(FALSE); } theString = ValueToString(EnvAddSymbol(theEnv,printBuffer)); rm(theEnv,printBuffer,sizeof(char) * theLength); return(theString); } /******************************************/ /* ReadlineFunction: H/L access routine */ /* for the readline function. */ /******************************************/ globle void ReadlineFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { char *buffer; size_t line_max = 0; int numberOfArguments; const char *logicalName; returnValue->type = STRING; if ((numberOfArguments = EnvArgCountCheck(theEnv,"readline",NO_MORE_THAN,1)) == -1) { returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } if (numberOfArguments == 0 ) { logicalName = STDIN; } else { logicalName = GetLogicalName(theEnv,1,STDIN); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"readline"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } } if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; buffer = FillBuffer(theEnv,logicalName,&RouterData(theEnv)->CommandBufferInputCount,&line_max); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = FALSE; if (GetHaltExecution(theEnv)) { returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); if (buffer != NULL) rm(theEnv,buffer,(int) sizeof (char) * line_max); return; } if (buffer == NULL) { returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); returnValue->type = SYMBOL; return; } returnValue->value = (void *) EnvAddSymbol(theEnv,buffer); rm(theEnv,buffer,(int) sizeof (char) * line_max); return; } /*************************************************************/ /* FillBuffer: Read characters from a specified logical name */ /* and places them into a buffer until a carriage return */ /* or end-of-file character is read. */ /*************************************************************/ static char *FillBuffer( void *theEnv, const char *logicalName, size_t *currentPosition, size_t *maximumSize) { int c; char *buf = NULL; /*================================*/ /* Read until end of line or eof. */ /*================================*/ c = EnvGetcRouter(theEnv,logicalName); if (c == EOF) { return(NULL); } /*==================================*/ /* Grab characters until cr or eof. */ /*==================================*/ while ((c != '\n') && (c != '\r') && (c != EOF) && (! GetHaltExecution(theEnv))) { buf = ExpandStringWithChar(theEnv,c,buf,currentPosition,maximumSize,*maximumSize+80); c = EnvGetcRouter(theEnv,logicalName); } /*==================*/ /* Add closing EOS. */ /*==================*/ buf = ExpandStringWithChar(theEnv,EOS,buf,currentPosition,maximumSize,*maximumSize+80); return (buf); } /*****************************************/ /* SetLocaleFunction: H/L access routine */ /* for the set-locale function. */ /*****************************************/ globle void SetLocaleFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theResult; int numArgs; /*======================================*/ /* Check for valid number of arguments. */ /*======================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"set-locale",NO_MORE_THAN,1)) == -1) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=================================*/ /* If there are no arguments, just */ /* return the current locale. */ /*=================================*/ if (numArgs == 0) { returnValue->type = STRING; returnValue->value = IOFunctionData(theEnv)->locale; return; } /*=================*/ /* Get the locale. */ /*=================*/ if (EnvArgTypeCheck(theEnv,"set-locale",1,STRING,&theResult) == FALSE) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=====================================*/ /* Return the old value of the locale. */ /*=====================================*/ returnValue->type = STRING; returnValue->value = IOFunctionData(theEnv)->locale; /*======================================================*/ /* Change the value of the locale to the one specified. */ /*======================================================*/ DecrementSymbolCount(theEnv,(struct symbolHashNode *) IOFunctionData(theEnv)->locale); IOFunctionData(theEnv)->locale = DOToPointer(theResult); IncrementSymbolCount(IOFunctionData(theEnv)->locale); } /******************************************/ /* ReadNumberFunction: H/L access routine */ /* for the read-number function. */ /******************************************/ globle void ReadNumberFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct token theToken; int numberOfArguments; const char *logicalName = NULL; /*===============================================*/ /* Check for an appropriate number of arguments. */ /*===============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"read",NO_MORE_THAN,1)) == -1) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*======================================================*/ /* Determine the logical name from which input is read. */ /*======================================================*/ if (numberOfArguments == 0) { logicalName = STDIN; } else if (numberOfArguments == 1) { logicalName = GetLogicalName(theEnv,1,STDIN); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"read"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } } /*============================================*/ /* Check to see that the logical name exists. */ /*============================================*/ if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*=======================================*/ /* Collect input into string if the read */ /* source is stdin, else just get token. */ /*=======================================*/ if (strcmp(logicalName,STDIN) == 0) { ReadNumber(theEnv,logicalName,&theToken,TRUE); } else { ReadNumber(theEnv,logicalName,&theToken,FALSE); } RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = FALSE; /*====================================================*/ /* Copy the token to the return value data structure. */ /*====================================================*/ returnValue->type = theToken.type; if ((theToken.type == FLOAT) || (theToken.type == STRING) || #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == SYMBOL) || (theToken.type == INTEGER)) { returnValue->value = theToken.value; } else if (theToken.type == STOP) { returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); } else if (theToken.type == UNKNOWN_VALUE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } else { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm); } return; } /********************************************/ /* ReadNumber: Special routine used by the */ /* read-number function to read a number. */ /********************************************/ static void ReadNumber( void *theEnv, const char *logicalName, struct token *theToken, int isStdin) { char *inputString; char *charPtr = NULL; size_t inputStringSize; int inchar; long long theLong; double theDouble; void *oldLocale; theToken->type = STOP; /*===========================================*/ /* Initialize the variables used for storing */ /* the characters retrieved from stdin. */ /*===========================================*/ inputString = NULL; RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = TRUE; inputStringSize = 0; inchar = EnvGetcRouter(theEnv,logicalName); /*====================================*/ /* Skip whitespace before any number. */ /*====================================*/ while (isspace(inchar) && (inchar != EOF) && (! GetHaltExecution(theEnv))) { inchar = EnvGetcRouter(theEnv,logicalName); } /*=============================================================*/ /* Continue reading characters until whitespace is found again */ /* (for anything other than stdin) or a CR/LF (for stdin). */ /*=============================================================*/ while ((((! isStdin) && (! isspace(inchar))) || (isStdin && (inchar != '\n') && (inchar != '\r'))) && (inchar != EOF) && (! GetHaltExecution(theEnv))) { inputString = ExpandStringWithChar(theEnv,inchar,inputString,&RouterData(theEnv)->CommandBufferInputCount, &inputStringSize,inputStringSize + 80); inchar = EnvGetcRouter(theEnv,logicalName); } /*===========================================*/ /* Pressing control-c (or comparable action) */ /* aborts the read-number function. */ /*===========================================*/ if (GetHaltExecution(theEnv)) { theToken->type = STRING; theToken->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); return; } /*====================================================*/ /* Return the EOF symbol if the end of file for stdin */ /* has been encountered. This typically won't occur, */ /* but is possible (for example by pressing control-d */ /* in the UNIX operating system). */ /*====================================================*/ if (inchar == EOF) { theToken->type = SYMBOL; theToken->value = (void *) EnvAddSymbol(theEnv,"EOF"); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); return; } /*==================================================*/ /* Open a string input source using the characters */ /* retrieved from stdin and extract the first token */ /* contained in the string. */ /*==================================================*/ /*=======================================*/ /* Change the locale so that numbers are */ /* converted using the localized format. */ /*=======================================*/ oldLocale = EnvAddSymbol(theEnv,setlocale(LC_NUMERIC,NULL)); setlocale(LC_NUMERIC,ValueToString(IOFunctionData(theEnv)->locale)); /*========================================*/ /* Try to parse the number as a long. The */ /* terminating character must either be */ /* white space or the string terminator. */ /*========================================*/ #if WIN_MVC theLong = _strtoi64(inputString,&charPtr,10); #else theLong = strtoll(inputString,&charPtr,10); #endif if ((charPtr != inputString) && (isspace(*charPtr) || (*charPtr == '\0'))) { theToken->type = INTEGER; theToken->value = (void *) EnvAddLong(theEnv,theLong); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); setlocale(LC_NUMERIC,ValueToString(oldLocale)); return; } /*==========================================*/ /* Try to parse the number as a double. The */ /* terminating character must either be */ /* white space or the string terminator. */ /*==========================================*/ theDouble = strtod(inputString,&charPtr); if ((charPtr != inputString) && (isspace(*charPtr) || (*charPtr == '\0'))) { theToken->type = FLOAT; theToken->value = (void *) EnvAddDouble(theEnv,theDouble); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); setlocale(LC_NUMERIC,ValueToString(oldLocale)); return; } /*============================================*/ /* Restore the "C" locale so that any parsing */ /* of numbers uses the C format. */ /*============================================*/ setlocale(LC_NUMERIC,ValueToString(oldLocale)); /*=========================================*/ /* Return "*** READ ERROR ***" to indicate */ /* a number was not successfully parsed. */ /*=========================================*/ theToken->type = STRING; theToken->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } #endif clips_core_source_630/core/modulpsr.c0000755000175000017500000012022612374017700016246 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses a defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Fixed linkage issue when DEFMODULE_CONSTRUCT */ /* compiler flag is set to 0. */ /* */ /*************************************************************/ #define _MODULPSR_SOURCE_ #include "setup.h" #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "constant.h" #include "router.h" #include "extnfunc.h" #include "argacces.h" #include "cstrcpsr.h" #include "constrct.h" #include "modulutl.h" #include "utility.h" #include "envrnmnt.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "modulpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ParsePortSpecifications(void *, const char *,struct token *, struct defmodule *); static int ParseImportSpec(void *,const char *,struct token *, struct defmodule *); static int ParseExportSpec(void *,const char *,struct token *, struct defmodule *, struct defmodule *); static intBool DeleteDefmodule(void *,void *); static int FindMultiImportConflict(void *,struct defmodule *); static void NotExportedErrorMessage(void *,const char *,const char *,const char *); /******************************************/ /* SetNumberOfDefmodules: Sets the number */ /* of defmodules currently defined. */ /******************************************/ globle void SetNumberOfDefmodules( void *theEnv, long value) { DefmoduleData(theEnv)->NumberOfDefmodules = value; } /****************************************************/ /* AddAfterModuleChangeFunction: Adds a function to */ /* the list of functions that are to be called */ /* after a module change occurs. */ /****************************************************/ globle void AddAfterModuleDefinedFunction( void *theEnv, const char *name, void (*func)(void *), int priority) { DefmoduleData(theEnv)->AfterModuleDefinedFunctions = AddFunctionToCallList(theEnv,name,priority,func,DefmoduleData(theEnv)->AfterModuleDefinedFunctions,TRUE); } /******************************************************/ /* AddPortConstructItem: Adds an item to the list of */ /* items that can be imported/exported by a module. */ /******************************************************/ globle void AddPortConstructItem( void *theEnv, const char *theName, int theType) { struct portConstructItem *newItem; newItem = get_struct(theEnv,portConstructItem); newItem->constructName = theName; newItem->typeExpected = theType; newItem->next = DefmoduleData(theEnv)->ListOfPortConstructItems; DefmoduleData(theEnv)->ListOfPortConstructItems = newItem; } /******************************************************/ /* ParseDefmodule: Coordinates all actions necessary */ /* for the parsing and creation of a defmodule into */ /* the current environment. */ /******************************************************/ globle int ParseDefmodule( void *theEnv, const char *readSource) { SYMBOL_HN *defmoduleName; struct defmodule *newDefmodule; struct token inputToken; int i; struct moduleItem *theItem; struct portItem *portSpecs, *nextSpec; struct defmoduleItemHeader *theHeader; struct callFunctionItem *defineFunctions; struct defmodule *redefiningMainModule = NULL; int parseError; struct portItem *oldImportList = NULL, *oldExportList = NULL; short overwrite = FALSE; /*================================================*/ /* Flush the buffer which stores the pretty print */ /* representation for a module. Add the already */ /* parsed keyword defmodule to this buffer. */ /*================================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmodule "); /*===============================*/ /* Modules cannot be loaded when */ /* a binary load is in effect. */ /*===============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmodule"); return(TRUE); } #endif /*=====================================================*/ /* Parse the name and comment fields of the defmodule. */ /* Remove the defmodule if it already exists. */ /*=====================================================*/ defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule", EnvFindDefmodule,DeleteDefmodule,"+", TRUE,TRUE,FALSE,FALSE); if (defmoduleName == NULL) { return(TRUE); } if (strcmp(ValueToString(defmoduleName),"MAIN") == 0) { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); } /*==============================================*/ /* Create the defmodule structure if necessary. */ /*==============================================*/ if (redefiningMainModule == NULL) { newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName)); if (newDefmodule) { overwrite = TRUE; } else { newDefmodule = get_struct(theEnv,defmodule); newDefmodule->name = defmoduleName; newDefmodule->usrData = NULL; newDefmodule->next = NULL; } } else { overwrite = TRUE; newDefmodule = redefiningMainModule; } if (overwrite) { oldImportList = newDefmodule->importList; oldExportList = newDefmodule->exportList; } newDefmodule->importList = NULL; newDefmodule->exportList = NULL; /*===================================*/ /* Finish parsing the defmodule (its */ /* import/export specifications). */ /*===================================*/ parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule); /*====================================*/ /* Check for import/export conflicts. */ /*====================================*/ if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule); /*======================================================*/ /* If an error occured in parsing or an import conflict */ /* was detected, abort the definition of the defmodule. */ /* If we're only checking syntax, then we want to exit */ /* at this point as well. */ /*======================================================*/ if (parseError || ConstructData(theEnv)->CheckSyntaxMode) { while (newDefmodule->importList != NULL) { nextSpec = newDefmodule->importList->next; rtn_struct(theEnv,portItem,newDefmodule->importList); newDefmodule->importList = nextSpec; } while (newDefmodule->exportList != NULL) { nextSpec = newDefmodule->exportList->next; rtn_struct(theEnv,portItem,newDefmodule->exportList); newDefmodule->exportList = nextSpec; } if ((redefiningMainModule == NULL) && (! overwrite)) { rtn_struct(theEnv,defmodule,newDefmodule); } if (overwrite) { newDefmodule->importList = oldImportList; newDefmodule->exportList = oldExportList; } if (parseError) return(TRUE); return(FALSE); } /*===============================================*/ /* Increment the symbol table counts for symbols */ /* used in the defmodule data structures. */ /*===============================================*/ if (redefiningMainModule == NULL) { IncrementSymbolCount(newDefmodule->name); } else { if ((newDefmodule->importList != NULL) || (newDefmodule->exportList != NULL)) { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; } } for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next) { if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName); if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType); if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName); } for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next) { if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName); if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType); if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName); } /*====================================================*/ /* Allocate storage for the module's construct lists. */ /*====================================================*/ if (redefiningMainModule != NULL) { /* Do nothing */ } else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL; else { newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->allocateFunction == NULL) { newDefmodule->itemsArray[i] = NULL; } else { newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->allocateFunction)(theEnv); theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i]; theHeader->theModule = newDefmodule; theHeader->firstItem = NULL; theHeader->lastItem = NULL; } } } /*=======================================*/ /* Save the pretty print representation. */ /*=======================================*/ SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { newDefmodule->ppForm = NULL; } else { newDefmodule->ppForm = CopyPPBuffer(theEnv); } /*==============================================*/ /* Add the defmodule to the list of defmodules. */ /*==============================================*/ if (redefiningMainModule == NULL) { if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule; else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule; DefmoduleData(theEnv)->LastDefmodule = newDefmodule; newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++; } EnvSetCurrentModule(theEnv,(void *) newDefmodule); /*=========================================*/ /* Call any functions required by other */ /* constructs when a new module is defined */ /*=========================================*/ for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions; defineFunctions != NULL; defineFunctions = defineFunctions->next) { (* (void (*)(void *)) defineFunctions->func)(theEnv); } /*===============================================*/ /* Defmodule successfully parsed with no errors. */ /*===============================================*/ return(FALSE); } /*************************************************************/ /* DeleteDefmodule: Used by the parsing routine to determine */ /* if a module can be redefined. Only the MAIN module can */ /* be redefined (and it can only be redefined once). */ /*************************************************************/ static intBool DeleteDefmodule( void *theEnv, void *theConstruct) { if (strcmp(EnvGetDefmoduleName(theEnv,theConstruct),"MAIN") == 0) { return(DefmoduleData(theEnv)->MainModuleRedefinable); } return(FALSE); } /*********************************************************/ /* ParsePortSpecifications: Parses the import and export */ /* specifications found in a defmodule construct. */ /*********************************************************/ static int ParsePortSpecifications( void *theEnv, const char *readSource, struct token *theToken, struct defmodule *theDefmodule) { int error; /*=============================*/ /* The import and export lists */ /* are initially empty. */ /*=============================*/ theDefmodule->importList = NULL; theDefmodule->exportList = NULL; /*==========================================*/ /* Parse import/export specifications until */ /* a right parenthesis is encountered. */ /*==========================================*/ while (theToken->type != RPAREN) { /*========================================*/ /* Look for the opening left parenthesis. */ /*========================================*/ if (theToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } /*====================================*/ /* Look for the import/export keyword */ /* and call the appropriate functions */ /* for parsing the specification. */ /*====================================*/ GetToken(theEnv,readSource,theToken); if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } if (strcmp(ValueToString(theToken->value),"import") == 0) { error = ParseImportSpec(theEnv,readSource,theToken,theDefmodule); } else if (strcmp(ValueToString(theToken->value),"export") == 0) { error = ParseExportSpec(theEnv,readSource,theToken,theDefmodule,NULL); } else { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } if (error) return(TRUE); /*============================================*/ /* Begin parsing the next port specification. */ /*============================================*/ PPCRAndIndent(theEnv); GetToken(theEnv,readSource,theToken); if (theToken->type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } } /*===================================*/ /* Return FALSE to indicate no error */ /* occurred while parsing the */ /* import/export specifications. */ /*===================================*/ return(FALSE); } /**********************************************************/ /* ParseImportSpec: Parses import specifications found in */ /* a defmodule construct. */ /* */ /* ::= (import ) */ /* */ /* ::= ?ALL | */ /* ?NONE | */ /* ?ALL | */ /* ?NONE | */ /* * */ /**********************************************************/ static int ParseImportSpec( void *theEnv, const char *readSource, struct token *theToken, struct defmodule *newModule) { struct defmodule *theModule; struct portItem *thePort, *oldImportSpec; int found, count; /*===========================*/ /* Look for the module name. */ /*===========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"defmodule import specification"); return(TRUE); } /*=====================================*/ /* Verify the existence of the module. */ /*=====================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value)); return(TRUE); } /*========================================*/ /* If the specified module doesn't export */ /* any constructs, then the import */ /* specification is meaningless. */ /*========================================*/ if (theModule->exportList == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL); return(TRUE); } /*==============================================*/ /* Parse the remaining portion of the import */ /* specification and return if an error occurs. */ /*==============================================*/ oldImportSpec = newModule->importList; if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE); /*========================================================*/ /* If the ?NONE keyword was used with the import spec, */ /* then no constructs were actually imported and the */ /* import spec does not need to be checked for conflicts. */ /*========================================================*/ if (newModule->importList == oldImportSpec) return(FALSE); /*======================================================*/ /* Check to see if the construct being imported can be */ /* by the specified module. This check exported doesn't */ /* guarantee that a specific named construct actually */ /* exists. It just checks that it could be exported if */ /* it does exists. */ /*======================================================*/ if (newModule->importList->constructType != NULL) { /*=============================*/ /* Look for the construct in */ /* the module that exports it. */ /*=============================*/ found = FALSE; for (thePort = theModule->exportList; (thePort != NULL) && (! found); thePort = thePort->next) { if (thePort->constructType == NULL) found = TRUE; else if (thePort->constructType == newModule->importList->constructType) { if (newModule->importList->constructName == NULL) found = TRUE; else if (thePort->constructName == NULL) found = TRUE; else if (thePort->constructName == newModule->importList->constructName) { found = TRUE; } } } /*=======================================*/ /* If it's not exported by the specified */ /* module, print an error message. */ /*=======================================*/ if (! found) { if (newModule->importList->constructName == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(newModule->importList->constructType), NULL); } else { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(newModule->importList->constructType), ValueToString(newModule->importList->constructName)); } return(TRUE); } } /*======================================================*/ /* Verify that specific named constructs actually exist */ /* and can be seen from the module importing them. */ /*======================================================*/ SaveCurrentModule(theEnv); EnvSetCurrentModule(theEnv,(void *) newModule); for (thePort = newModule->importList; thePort != NULL; thePort = thePort->next) { if ((thePort->constructType == NULL) || (thePort->constructName == NULL)) { continue; } theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName)); EnvSetCurrentModule(theEnv,theModule); if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL, ValueToString(thePort->constructName),&count, TRUE,FALSE) == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(thePort->constructType), ValueToString(thePort->constructName)); RestoreCurrentModule(theEnv); return(TRUE); } } RestoreCurrentModule(theEnv); /*===============================================*/ /* The import list has been successfully parsed. */ /*===============================================*/ return(FALSE); } /**********************************************************/ /* ParseExportSpec: Parses export specifications found in */ /* a defmodule construct. This includes parsing the */ /* remaining specification found in an import */ /* specification after the module name. */ /**********************************************************/ static int ParseExportSpec( void *theEnv, const char *readSource, struct token *theToken, struct defmodule *newModule, struct defmodule *importModule) { struct portItem *newPort; SYMBOL_HN *theConstruct, *moduleName; struct portConstructItem *thePortConstruct; const char *errorMessage; /*===========================================*/ /* Set up some variables for error messages. */ /*===========================================*/ if (importModule != NULL) { errorMessage = "defmodule import specification"; moduleName = importModule->name; } else { errorMessage = "defmodule export specification"; moduleName = NULL; } /*=============================================*/ /* Handle the special variables ?ALL and ?NONE */ /* in the import/export specification. */ /*=============================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if (theToken->type == SF_VARIABLE) { /*==============================*/ /* Check to see if the variable */ /* is either ?ALL or ?NONE. */ /*==============================*/ if (strcmp(ValueToString(theToken->value),"ALL") == 0) { newPort = (struct portItem *) get_struct(theEnv,portItem); newPort->moduleName = moduleName; newPort->constructType = NULL; newPort->constructName = NULL; newPort->next = NULL; } else if (strcmp(ValueToString(theToken->value),"NONE") == 0) { newPort = NULL; } else { SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*=======================================================*/ /* The export/import specification must end with a right */ /* parenthesis after ?ALL or ?NONE at this point. */ /*=======================================================*/ GetToken(theEnv,readSource,theToken); if (theToken->type != RPAREN) { if (newPort != NULL) rtn_struct(theEnv,portItem,newPort); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*=====================================*/ /* Add the new specification to either */ /* the import or export list. */ /*=====================================*/ if (newPort != NULL) { if (importModule != NULL) { newPort->next = newModule->importList; newModule->importList = newPort; } else { newPort->next = newModule->exportList; newModule->exportList = newPort; } } /*============================================*/ /* Return FALSE to indicate the import/export */ /* specification was successfully parsed. */ /*============================================*/ return(FALSE); } /*========================================================*/ /* If the ?ALL and ?NONE keywords were not used, then the */ /* token must be the name of an importable construct. */ /*========================================================*/ if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } theConstruct = (SYMBOL_HN *) theToken->value; if ((thePortConstruct = ValidPortConstructItem(theEnv,ValueToString(theConstruct))) == NULL) { SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*=============================================================*/ /* If the next token is the special variable ?ALL, then all */ /* constructs of the specified type are imported/exported. If */ /* the next token is the special variable ?NONE, then no */ /* constructs of the specified type will be imported/exported. */ /*=============================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if (theToken->type == SF_VARIABLE) { /*==============================*/ /* Check to see if the variable */ /* is either ?ALL or ?NONE. */ /*==============================*/ if (strcmp(ValueToString(theToken->value),"ALL") == 0) { newPort = (struct portItem *) get_struct(theEnv,portItem); newPort->moduleName = moduleName; newPort->constructType = theConstruct; newPort->constructName = NULL; newPort->next = NULL; } else if (strcmp(ValueToString(theToken->value),"NONE") == 0) { newPort = NULL; } else { SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*=======================================================*/ /* The export/import specification must end with a right */ /* parenthesis after ?ALL or ?NONE at this point. */ /*=======================================================*/ GetToken(theEnv,readSource,theToken); if (theToken->type != RPAREN) { if (newPort != NULL) rtn_struct(theEnv,portItem,newPort); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*=====================================*/ /* Add the new specification to either */ /* the import or export list. */ /*=====================================*/ if (newPort != NULL) { if (importModule != NULL) { newPort->next = newModule->importList; newModule->importList = newPort; } else { newPort->next = newModule->exportList; newModule->exportList = newPort; } } /*============================================*/ /* Return FALSE to indicate the import/export */ /* specification was successfully parsed. */ /*============================================*/ return(FALSE); } /*============================================*/ /* There must be at least one named construct */ /* in the import/export list at this point. */ /*============================================*/ if (theToken->type == RPAREN) { SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*=====================================*/ /* Read in the list of imported items. */ /*=====================================*/ while (theToken->type != RPAREN) { if (theToken->type != thePortConstruct->typeExpected) { SyntaxErrorMessage(theEnv,errorMessage); return(TRUE); } /*========================================*/ /* Create the data structure to represent */ /* the import/export specification for */ /* the named construct. */ /*========================================*/ newPort = (struct portItem *) get_struct(theEnv,portItem); newPort->moduleName = moduleName; newPort->constructType = theConstruct; newPort->constructName = (SYMBOL_HN *) theToken->value; /*=====================================*/ /* Add the new specification to either */ /* the import or export list. */ /*=====================================*/ if (importModule != NULL) { newPort->next = newModule->importList; newModule->importList = newPort; } else { newPort->next = newModule->exportList; newModule->exportList = newPort; } /*===================================*/ /* Move on to the next import/export */ /* specification. */ /*===================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); } /*=============================*/ /* Fix up pretty print buffer. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*============================================*/ /* Return FALSE to indicate the import/export */ /* specification was successfully parsed. */ /*============================================*/ return(FALSE); } /*************************************************************/ /* ValidPortConstructItem: Returns TRUE if a given construct */ /* name is in the list of constructs which can be exported */ /* and imported, otherwise FALSE is returned. */ /*************************************************************/ globle struct portConstructItem *ValidPortConstructItem( void *theEnv, const char *theName) { struct portConstructItem *theItem; for (theItem = DefmoduleData(theEnv)->ListOfPortConstructItems; theItem != NULL; theItem = theItem->next) { if (strcmp(theName,theItem->constructName) == 0) return(theItem); } return(NULL); } /***********************************************************/ /* FindMultiImportConflict: Determines if a module imports */ /* the same named construct from more than one module */ /* (i.e. an ambiguous reference which is not allowed). */ /***********************************************************/ static int FindMultiImportConflict( void *theEnv, struct defmodule *theModule) { struct defmodule *testModule; int count; struct portConstructItem *thePCItem; struct construct *theConstruct; void *theCItem; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*============================*/ /* Loop through every module. */ /*============================*/ for (testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); testModule != NULL; testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,testModule)) { /*========================================*/ /* Loop through every construct type that */ /* can be imported/exported by a module. */ /*========================================*/ for (thePCItem = DefmoduleData(theEnv)->ListOfPortConstructItems; thePCItem != NULL; thePCItem = thePCItem->next) { EnvSetCurrentModule(theEnv,(void *) testModule); /*=====================================================*/ /* Loop through every construct of the specified type. */ /*=====================================================*/ theConstruct = FindConstruct(theEnv,thePCItem->constructName); for (theCItem = (*theConstruct->getNextItemFunction)(theEnv,NULL); theCItem != NULL; theCItem = (*theConstruct->getNextItemFunction)(theEnv,theCItem)) { /*===============================================*/ /* Check to see if the specific construct in the */ /* module can be imported with more than one */ /* reference into the module we're examining for */ /* ambiguous import specifications. */ /*===============================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); FindImportedConstruct(theEnv,thePCItem->constructName,NULL, ValueToString((*theConstruct->getConstructNameFunction) ((struct constructHeader *) theCItem)), &count,FALSE,NULL); if (count > 1) { ImportExportConflictMessage(theEnv,"defmodule",EnvGetDefmoduleName(theEnv,theModule), thePCItem->constructName, ValueToString((*theConstruct->getConstructNameFunction) ((struct constructHeader *) theCItem))); RestoreCurrentModule(theEnv); return(TRUE); } EnvSetCurrentModule(theEnv,(void *) testModule); } } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*=======================================*/ /* Return FALSE to indicate no ambiguous */ /* references were found. */ /*=======================================*/ return(FALSE); } /******************************************************/ /* NotExportedErrorMessage: Generalized error message */ /* for indicating that a construct type or specific */ /* named construct is not exported. */ /******************************************************/ static void NotExportedErrorMessage( void *theEnv, const char *theModule, const char *theConstruct, const char *theName) { PrintErrorID(theEnv,"MODULPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Module "); EnvPrintRouter(theEnv,WERROR,theModule); EnvPrintRouter(theEnv,WERROR," does not export "); if (theConstruct == NULL) EnvPrintRouter(theEnv,WERROR,"any constructs"); else if (theName == NULL) { EnvPrintRouter(theEnv,WERROR,"any "); EnvPrintRouter(theEnv,WERROR,theConstruct); EnvPrintRouter(theEnv,WERROR," constructs"); } else { EnvPrintRouter(theEnv,WERROR,"the "); EnvPrintRouter(theEnv,WERROR,theConstruct); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,theName); } EnvPrintRouter(theEnv,WERROR,".\n"); } /*************************************************************/ /* FindImportExportConflict: Determines if the definition of */ /* a construct would cause an import/export conflict. The */ /* construct is not yet defined when this function is */ /* called. TRUE is returned if an import/export conflicts */ /* is found, otherwise FALSE is returned. */ /*************************************************************/ globle int FindImportExportConflict( void *theEnv, const char *constructName, struct defmodule *matchModule, const char *findName) { struct defmodule *theModule; struct moduleItem *theModuleItem; int count; /*===========================================================*/ /* If the construct type can't be imported or exported, then */ /* it's not possible to have an import/export conflict. */ /*===========================================================*/ if (ValidPortConstructItem(theEnv,constructName) == NULL) return(FALSE); /*============================================*/ /* There module name should already have been */ /* separated fromthe construct's name. */ /*============================================*/ if (FindModuleSeparator(findName)) return(FALSE); /*===============================================================*/ /* The construct must be capable of being stored within a module */ /* (this test should never fail). The construct must also have */ /* a find function associated with it so we can actually look */ /* for import/export conflicts. */ /*===============================================================*/ if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) return(FALSE); if (theModuleItem->findFunction == NULL) return(FALSE); /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*================================================================*/ /* Look at each module and count each definition of the specified */ /* construct which is visible to the module. If more than one */ /* definition is visible, then an import/export conflict exists */ /* and TRUE is returned. */ /*================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); FindImportedConstruct(theEnv,constructName,NULL,findName,&count,TRUE,matchModule); if (count > 1) { RestoreCurrentModule(theEnv); return(TRUE); } } /*==========================================*/ /* Restore the current module. No conflicts */ /* were detected so FALSE is returned. */ /*==========================================*/ RestoreCurrentModule(theEnv); return(FALSE); } #endif /* DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */ /*********************************************/ /* GetNumberOfDefmodules: Returns the number */ /* of defmodules currently defined. */ /*********************************************/ globle long GetNumberOfDefmodules( void *theEnv) { #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) return(DefmoduleData(theEnv)->NumberOfDefmodules); #else return 1L; #endif } clips_core_source_630/core/._classcom.h0000755000175000017500000000040712464554105016432 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._immthpsr.h0000755000175000017500000000040712373755063016476 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/modulcmp.h0000755000175000017500000000461512374017706016237 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* DEFMODULE CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_modulcmp #define _H_modulcmp #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefmoduleCompilerSetup(void *); LOCALE void PrintDefmoduleReference(void *,FILE *,struct defmodule *); #endif /* _H_modulcmp */ clips_core_source_630/core/immthpsr.h0000755000175000017500000000411612373755063016262 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_immthpsr #define _H_immthpsr #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #include "genrcfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _IMMTHPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void AddImplicitMethods(void *,DEFGENERIC *); #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ #endif /* _H_immthpsr */ clips_core_source_630/core/dffctbsc.c0000755000175000017500000002700212461252076016161 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFFACTS BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deffacts */ /* construct such as clear, reset, save, undeffacts, */ /* ppdeffacts, list-deffacts, and get-deffacts-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _DFFCTBSC_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "argacces.h" #include "memalloc.h" #include "scanner.h" #include "router.h" #include "extnfunc.h" #include "constrct.h" #include "cstrccom.h" #include "factrhs.h" #include "tmpltdef.h" #include "cstrcpsr.h" #include "dffctpsr.h" #include "dffctdef.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "dffctbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dffctcmp.h" #endif #include "dffctbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ResetDeffacts(void *); static void ClearDeffacts(void *); static void SaveDeffacts(void *,void *,const char *); static void ResetDeffactsAction(void *,struct constructHeader *,void *); /***************************************************************/ /* DeffactsBasicCommands: Initializes basic deffacts commands. */ /***************************************************************/ globle void DeffactsBasicCommands( void *theEnv) { EnvAddResetFunction(theEnv,"deffacts",ResetDeffacts,0); EnvAddClearFunction(theEnv,"deffacts",ClearDeffacts,0); AddSaveFunction(theEnv,"deffacts",SaveDeffacts,10); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-deffacts-list",'m',PTIEF GetDeffactsListFunction,"GetDeffactsListFunction","01w"); EnvDefineFunction2(theEnv,"undeffacts",'v',PTIEF UndeffactsCommand,"UndeffactsCommand","11w"); EnvDefineFunction2(theEnv,"deffacts-module",'w',PTIEF DeffactsModuleFunction,"DeffactsModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-deffacts",'v', PTIEF ListDeffactsCommand,"ListDeffactsCommand","01w"); EnvDefineFunction2(theEnv,"ppdeffacts",'v',PTIEF PPDeffactsCommand,"PPDeffactsCommand","11w"); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DeffactsBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeffactsCompilerSetup(theEnv); #endif #endif } /**********************************************************/ /* ResetDeffacts: Deffacts reset routine for use with the */ /* reset command. Asserts all of the facts contained in */ /* deffacts constructs. */ /**********************************************************/ static void ResetDeffacts( void *theEnv) { DoForAllConstructs(theEnv,ResetDeffactsAction,DeffactsData(theEnv)->DeffactsModuleIndex,TRUE,NULL); } /*****************************************************/ /* ResetDeffactsAction: Action to be applied to each */ /* deffacts construct during a reset command. */ /*****************************************************/ static void ResetDeffactsAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif DATA_OBJECT result; struct deffacts *theDeffacts = (struct deffacts *) theConstruct; if (theDeffacts->assertList == NULL) return; SetEvaluationError(theEnv,FALSE); EvaluateExpression(theEnv,theDeffacts->assertList,&result); } /**********************************************************/ /* ClearDeffacts: Deffacts clear routine for use with the */ /* clear command. Creates the initial-facts deffacts. */ /**********************************************************/ static void ClearDeffacts( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) struct expr *stub; struct deffacts *newDeffacts; /*=====================================*/ /* Create the data structures for the */ /* expression (assert (initial-fact)). */ /*=====================================*/ stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert")); stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplateInModule(theEnv,"initial-fact")); ExpressionInstall(theEnv,stub); /*=============================================*/ /* Create a deffacts data structure to contain */ /* the expression and initialize it. */ /*=============================================*/ newDeffacts = get_struct(theEnv,deffacts); newDeffacts->header.whichModule = (struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL); newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"); IncrementSymbolCount(newDeffacts->header.name); newDeffacts->assertList = PackExpression(theEnv,stub); newDeffacts->header.next = NULL; newDeffacts->header.ppForm = NULL; newDeffacts->header.usrData = NULL; ReturnExpression(theEnv,stub); /*===========================================*/ /* Store the deffacts in the current module. */ /*===========================================*/ AddConstructToModule(&newDeffacts->header); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /***************************************/ /* SaveDeffacts: Deffacts save routine */ /* for use with the save command. */ /***************************************/ static void SaveDeffacts( void *theEnv, void *theModule, const char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DeffactsData(theEnv)->DeffactsConstruct); } /*******************************************/ /* UndeffactsCommand: H/L access routine */ /* for the undeffacts command. */ /*******************************************/ globle void UndeffactsCommand( void *theEnv) { UndefconstructCommand(theEnv,"undeffacts",DeffactsData(theEnv)->DeffactsConstruct); } /***********************************/ /* EnvUndeffacts: C access routine */ /* for the undeffacts command. */ /***********************************/ globle intBool EnvUndeffacts( void *theEnv, void *theDeffacts) { return(Undefconstruct(theEnv,theDeffacts,DeffactsData(theEnv)->DeffactsConstruct)); } /*************************************************/ /* GetDeffactsListFunction: H/L access routine */ /* for the get-deffacts-list function. */ /*************************************************/ globle void GetDeffactsListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-deffacts-list",returnValue,DeffactsData(theEnv)->DeffactsConstruct); } /*****************************************/ /* EnvGetDeffactsList: C access routine */ /* for the get-deffacts-list function. */ /*****************************************/ globle void EnvGetDeffactsList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DeffactsData(theEnv)->DeffactsConstruct,(struct defmodule *) theModule); } /************************************************/ /* DeffactsModuleFunction: H/L access routine */ /* for the deffacts-module function. */ /************************************************/ globle void *DeffactsModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"deffacts-module",DeffactsData(theEnv)->DeffactsConstruct)); } #if DEBUGGING_FUNCTIONS /*******************************************/ /* PPDeffactsCommand: H/L access routine */ /* for the ppdeffacts command. */ /*******************************************/ globle void PPDeffactsCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdeffacts",DeffactsData(theEnv)->DeffactsConstruct); } /************************************/ /* PPDeffacts: C access routine for */ /* the ppdeffacts command. */ /************************************/ globle int PPDeffacts( void *theEnv, const char *deffactsName, const char *logicalName) { return(PPConstruct(theEnv,deffactsName,logicalName,DeffactsData(theEnv)->DeffactsConstruct)); } /*********************************************/ /* ListDeffactsCommand: H/L access routine */ /* for the list-deffacts command. */ /*********************************************/ globle void ListDeffactsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-deffacts",DeffactsData(theEnv)->DeffactsConstruct); } /*************************************/ /* EnvListDeffacts: C access routine */ /* for the list-deffacts command. */ /*************************************/ globle void EnvListDeffacts( void *theEnv, const char *logicalName, void *theModule) { ListConstruct(theEnv,DeffactsData(theEnv)->DeffactsConstruct,logicalName,(struct defmodule *) theModule); } #endif /* DEBUGGING_FUNCTIONS */ /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void GetDeffactsList( DATA_OBJECT_PTR returnValue, void *theModule) { EnvGetDeffactsList(GetCurrentEnvironment(),returnValue,theModule); } globle intBool Undeffacts( void *theDeffacts) { return EnvUndeffacts(GetCurrentEnvironment(),theDeffacts); } #if DEBUGGING_FUNCTIONS globle void ListDeffacts( const char *logicalName, void *theModule) { EnvListDeffacts(GetCurrentEnvironment(),logicalName,theModule); } #endif #endif #endif /* DEFFACTS_CONSTRUCT */ clips_core_source_630/core/genrccom.h0000755000175000017500000002047212461252076016211 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Fixed linkage issue when DEBUGGING_FUNCTIONS */ /* is set to 0 and PROFILING_FUNCTIONS is set to */ /* 1. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #ifndef _H_genrccom #define _H_genrccom #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_genrcfun #include "genrcfun.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupGenericFunctions(void *); LOCALE void *EnvFindDefgeneric(void *,const char *); LOCALE void *EnvFindDefgenericInModule(void *,const char *); LOCALE DEFGENERIC *LookupDefgenericByMdlOrScope(void *,const char *); LOCALE DEFGENERIC *LookupDefgenericInScope(void *,const char *); LOCALE void *EnvGetNextDefgeneric(void *,void *); LOCALE long EnvGetNextDefmethod(void *,void *,long); LOCALE int EnvIsDefgenericDeletable(void *,void *); LOCALE int EnvIsDefmethodDeletable(void *,void *,long); LOCALE void UndefgenericCommand(void *); LOCALE void *GetDefgenericModuleCommand(void *); LOCALE void UndefmethodCommand(void *); LOCALE DEFMETHOD *GetDefmethodPointer(void *,long); LOCALE intBool EnvUndefgeneric(void *,void *); LOCALE intBool EnvUndefmethod(void *,void *,long); #if ! OBJECT_SYSTEM LOCALE void TypeCommand(void *,DATA_OBJECT *); #endif #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS LOCALE void EnvGetDefmethodDescription(void *,char *,size_t,void *,long); #endif #if DEBUGGING_FUNCTIONS LOCALE unsigned EnvGetDefgenericWatch(void *,void *); LOCALE void EnvSetDefgenericWatch(void *,unsigned,void *); LOCALE unsigned EnvGetDefmethodWatch(void *,void *,long); LOCALE void EnvSetDefmethodWatch(void *,unsigned,void *,long); LOCALE void PPDefgenericCommand(void *); LOCALE void PPDefmethodCommand(void *); LOCALE void ListDefmethodsCommand(void *); LOCALE const char *EnvGetDefmethodPPForm(void *,void *,long); LOCALE void ListDefgenericsCommand(void *); LOCALE void EnvListDefgenerics(void *,const char *,struct defmodule *); LOCALE void EnvListDefmethods(void *,const char *,void *); #endif LOCALE void GetDefgenericListFunction(void *,DATA_OBJECT *); LOCALE void EnvGetDefgenericList(void *,DATA_OBJECT *,struct defmodule *); LOCALE void GetDefmethodListCommand(void *,DATA_OBJECT *); LOCALE void EnvGetDefmethodList(void *,void *,DATA_OBJECT *); LOCALE void GetMethodRestrictionsCommand(void *,DATA_OBJECT *); LOCALE void EnvGetMethodRestrictions(void *,void *,long,DATA_OBJECT *); LOCALE SYMBOL_HN *GetDefgenericNamePointer(void *); LOCALE void SetNextDefgeneric(void *,void *); LOCALE const char *EnvDefgenericModule(void *,void *); LOCALE const char *EnvGetDefgenericName(void *,void *); LOCALE const char *EnvGetDefgenericPPForm(void *,void *); LOCALE SYMBOL_HN *EnvGetDefgenericNamePointer(void *,void *); LOCALE void EnvSetDefgenericPPForm(void *,void *,const char *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void SetDefgenericPPForm(void *,const char *); LOCALE const char *DefgenericModule(void *); LOCALE void *FindDefgeneric(const char *); LOCALE void GetDefgenericList(DATA_OBJECT *,struct defmodule *); LOCALE const char *GetDefgenericName(void *); LOCALE const char *GetDefgenericPPForm(void *); LOCALE void *GetNextDefgeneric(void *); LOCALE int IsDefgenericDeletable(void *); LOCALE intBool Undefgeneric(void *); LOCALE void GetDefmethodList(void *,DATA_OBJECT_PTR); LOCALE void GetMethodRestrictions(void *,long,DATA_OBJECT *); LOCALE long GetNextDefmethod(void *,long ); LOCALE int IsDefmethodDeletable(void *,long ); LOCALE intBool Undefmethod(void *,long ); #if DEBUGGING_FUNCTIONS LOCALE unsigned GetDefgenericWatch(void *); LOCALE void ListDefgenerics(const char *,struct defmodule *); LOCALE void SetDefgenericWatch(unsigned,void *); LOCALE const char *GetDefmethodPPForm(void *,long); LOCALE unsigned GetDefmethodWatch(void *,long); LOCALE void ListDefmethods(const char *,void *); LOCALE void SetDefmethodWatch(unsigned,void *,long); #endif /* DEBUGGING_FUNCTIONS */ #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS LOCALE void GetDefmethodDescription(char *,int,void *,long ); #endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */ #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_genrccom */ clips_core_source_630/core/._modulcmp.h0000755000175000017500000000040712374017706016447 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._moduldef.c0000755000175000017500000000040712424473405016417 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._inherpsr.c0000755000175000017500000000040712373755057016463 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._modulbsc.c0000755000175000017500000000040712424473406016431 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/conscomp.h0000755000175000017500000001466112373714242016240 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Modifications to use the system constant */ /* FILENAME_MAX to check file name lengths. */ /* DR0856 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Used EnvClear rather than Clear in */ /* InitCImage initialization code. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Removed SHORT_LINK_NAMES code as this option */ /* is no longer supported. */ /* */ /* Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* 6.30: Added path name argument to constructs-to-c. */ /* */ /* Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, MAC_MCW, */ /* IBM_TBC, IBM_MSC, IBM_ICB, IBM_ZTC, and */ /* IBM_SC). */ /* */ /* Use genstrcpy instead of strcpy. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_conscomp #define _H_conscomp #define ArbitraryPrefix(codeItem,i) (codeItem)->arrayNames[(i)] #define ModulePrefix(codeItem) (codeItem)->arrayNames[0] #define ConstructPrefix(codeItem) (codeItem)->arrayNames[1] #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_extnfunc #include "extnfunc.h" #endif #ifndef _H_symblcmp #include "symblcmp.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #define CONSTRUCT_COMPILER_DATA 41 struct CodeGeneratorItem { const char *name; void (*beforeFunction)(void *); void (*initFunction)(void *,FILE *,int,int); int (*generateFunction)(void *,const char *,const char *,char *,int,FILE *,int,int); int priority; char **arrayNames; int arrayCount; struct CodeGeneratorItem *next; }; struct constructCompilerData { int ImageID; FILE *HeaderFP; int MaxIndices; FILE *ExpressionFP; FILE *FixupFP; const char *FilePrefix; const char *PathName; char *FileNameBuffer; intBool ExpressionHeader; long ExpressionCount; int ExpressionVersion; int CodeGeneratorCount; struct CodeGeneratorItem *ListOfCodeGeneratorItems; }; #define ConstructCompilerData(theEnv) ((struct constructCompilerData *) GetEnvironmentData(theEnv,CONSTRUCT_COMPILER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif struct CodeGeneratorFile { const char *filePrefix; const char *pathName; char *fileNameBuffer; int id,version; }; #ifdef _CONSCOMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeConstructCompilerData(void *); LOCALE void ConstructsToCCommandDefinition(void *); LOCALE FILE *NewCFile(void *,const char *,const char *,char *,int,int,int); LOCALE int ExpressionToCode(void *,FILE *,struct expr *); LOCALE void PrintFunctionReference(void *,FILE *,struct FunctionDefinition *); LOCALE struct CodeGeneratorItem *AddCodeGeneratorItem(void *,const char *,int, void (*)(void *), void (*)(void *,FILE *,int,int), int (*)(void *,const char *,const char *,char *,int,FILE *,int,int),int); LOCALE FILE *CloseFileIfNeeded(void *,FILE *,int *,int *,int,int *,struct CodeGeneratorFile *); LOCALE FILE *OpenFileIfNeeded(void *,FILE *,const char *,const char *,char *,int,int,int *, int,FILE *,const char *,char *,int,struct CodeGeneratorFile *); LOCALE void MarkConstructBsaveIDs(void *,int); LOCALE void ConstructHeaderToCode(void *,FILE *,struct constructHeader *,int,int, int,const char *,const char *); LOCALE void ConstructModuleToCode(void *,FILE *,struct defmodule *,int,int, int,const char *); LOCALE void PrintHashedExpressionReference(void *,FILE *,struct expr *,int,int); #endif clips_core_source_630/core/exprnpsr.h0000755000175000017500000001055512374672752016310 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Module specifier can be used within an */ /* expression to refer to a deffunction or */ /* defgeneric exported by the specified module, */ /* but not necessarily imported by the current */ /* module. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_exprnpsr #define _H_exprnpsr #if (! RUN_TIME) typedef struct saved_contexts { int rtn; int brk; struct saved_contexts *nxt; } SAVED_CONTEXTS; #endif #ifndef _H_extnfunc #include "extnfunc.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRNPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct expr *Function0Parse(void *,const char *); LOCALE struct expr *Function1Parse(void *,const char *); LOCALE struct expr *Function2Parse(void *,const char *,const char *); LOCALE void PushRtnBrkContexts(void *); LOCALE void PopRtnBrkContexts(void *); LOCALE intBool ReplaceSequenceExpansionOps(void *,struct expr *,struct expr *, void *,void *); LOCALE struct expr *CollectArguments(void *,struct expr *,const char *); LOCALE struct expr *ArgumentParse(void *,const char *,int *); LOCALE struct expr *ParseAtomOrExpression(void *,const char *,struct token *); LOCALE EXPRESSION *ParseConstantArguments(void *,const char *,int *); LOCALE intBool EnvSetSequenceOperatorRecognition(void *,int); LOCALE intBool EnvGetSequenceOperatorRecognition(void *); LOCALE struct expr *GroupActions(void *,const char *,struct token *, int,const char *,int); LOCALE struct expr *RemoveUnneededProgn(void *,struct expr *); #if (! RUN_TIME) LOCALE int CheckExpressionAgainstRestrictions(void *,struct expr *, const char *,const char *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool SetSequenceOperatorRecognition(int); LOCALE intBool GetSequenceOperatorRecognition(void); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_exprnpsr */ clips_core_source_630/core/clsltpsr.c0000755000175000017500000010277312373714251016262 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CLASS PARSER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Parsing Routines for Defclass Construct */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Support for long long integers. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #include #include "classcom.h" #include "classfun.h" #include "cstrnchk.h" #include "cstrnpsr.h" #include "cstrnutl.h" #include "default.h" #include "envrnmnt.h" #include "insfun.h" #include "memalloc.h" #include "prntutil.h" #include "router.h" #include "scanner.h" #define _CLSLTPSR_SOURCE_ #include "clsltpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define DEFAULT_FACET "default" #define DYNAMIC_FACET "default-dynamic" #define VARIABLE_VAR "VARIABLE" #define STORAGE_FACET "storage" #define SLOT_SHARE_RLN "shared" #define SLOT_LOCAL_RLN "local" #define ACCESS_FACET "access" #define SLOT_RDONLY_RLN "read-only" #define SLOT_RDWRT_RLN "read-write" #define SLOT_INIT_RLN "initialize-only" #define PROPAGATION_FACET "propagation" #define SLOT_NO_INH_RLN "no-inherit" #define SLOT_INH_RLN "inherit" #define SOURCE_FACET "source" #define SLOT_COMPOSITE_RLN "composite" #define SLOT_EXCLUSIVE_RLN "exclusive" #define MATCH_FACET MATCH_RLN #define SLOT_REACTIVE_RLN REACTIVE_RLN #define SLOT_NONREACTIVE_RLN NONREACTIVE_RLN #define VISIBILITY_FACET "visibility" #define SLOT_PUBLIC_RLN "public" #define SLOT_PRIVATE_RLN "private" #define CREATE_ACCESSOR_FACET "create-accessor" #define SLOT_READ_RLN "read" #define SLOT_WRITE_RLN "write" #define SLOT_NONE_RLN "NONE" #define OVERRIDE_MSG_FACET "override-message" #define SLOT_DEFAULT_RLN "DEFAULT" #define STORAGE_BIT 0 #define FIELD_BIT 1 #define ACCESS_BIT 2 #define PROPAGATION_BIT 3 #define SOURCE_BIT 4 #define MATCH_BIT 5 #define DEFAULT_BIT 6 #define DEFAULT_DYNAMIC_BIT 7 #define VISIBILITY_BIT 8 #define CREATE_ACCESSOR_BIT 9 #define OVERRIDE_MSG_BIT 10 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static SLOT_DESC *NewSlot(void *,SYMBOL_HN *); static TEMP_SLOT_LINK *InsertSlot(void *,TEMP_SLOT_LINK *,SLOT_DESC *); static int ParseSimpleFacet(void *,const char *,char*,const char *,int,const char *, const char *,const char *,const char *,SYMBOL_HN **); static intBool ParseDefaultFacet(void *,const char *,char *,SLOT_DESC *); static void BuildCompositeFacets(void *,SLOT_DESC *,PACKED_CLASS_LINKS *,const char *, CONSTRAINT_PARSE_RECORD *); static intBool CheckForFacetConflicts(void *,SLOT_DESC *,CONSTRAINT_PARSE_RECORD *); static intBool EvaluateSlotDefaultValue(void *,SLOT_DESC *,const char *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************ NAME : ParseSlot DESCRIPTION : Parses slot definitions for a defclass statement INPUTS : 1) The logical name of the input source 2) The current slot list 3) The class precedence list for the class to which this slot is being attached (used to find facets for composite slots) 4) A flag indicating if this is a multifield slot or not 5) A flag indicating if the type of slot (single or multi) was explicitly specified or not RETURNS : The address of the list of slots, NULL if there was an error SIDE EFFECTS : The slot list is allocated NOTES : Assumes "(slot" has already been parsed. ************************************************************/ globle TEMP_SLOT_LINK *ParseSlot( void *theEnv, const char *readSource, TEMP_SLOT_LINK *slist, PACKED_CLASS_LINKS *preclist, int multiSlot, int fieldSpecified) { SLOT_DESC *slot; CONSTRAINT_PARSE_RECORD parsedConstraint; char specbits[2]; int rtnCode; SYMBOL_HN *newOverrideMsg; /* =============================================================== Bits in specbits are when slot qualifiers are specified so that duplicate or conflicting qualifiers can be detected. Shared/local bit-0 Single/multiple bit-1 Read-only/Read-write/Initialize-Only bit-2 Inherit/No-inherit bit-3 Composite/Exclusive bit-4 Reactive/Nonreactive bit-5 Default bit-6 Default-dynamic bit-7 Visibility bit-8 Override-message bit-9 =============================================================== */ SavePPBuffer(theEnv," "); specbits[0] = specbits[1] = '\0'; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { DeleteSlots(theEnv,slist); SyntaxErrorMessage(theEnv,"defclass slot"); return(NULL); } if ((DefclassData(theEnv)->ObjectParseToken.value == (void *) DefclassData(theEnv)->ISA_SYMBOL) || (DefclassData(theEnv)->ObjectParseToken.value == (void *) DefclassData(theEnv)->NAME_SYMBOL)) { DeleteSlots(theEnv,slist); SyntaxErrorMessage(theEnv,"defclass slot"); return(NULL); } slot = NewSlot(theEnv,(SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken)); slist = InsertSlot(theEnv,slist,slot); if (slist == NULL) return(NULL); if (multiSlot) slot->multiple = TRUE; if (fieldSpecified) SetBitMap(specbits,FIELD_BIT); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); IncrementIndentDepth(theEnv,3); InitializeConstraintParseRecord(&parsedConstraint); while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,"("); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass slot"); goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DEFAULT_FACET) == 0) { if (ParseDefaultFacet(theEnv,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DYNAMIC_FACET) == 0) { SetBitMap(specbits,DEFAULT_DYNAMIC_BIT); if (ParseDefaultFacet(theEnv,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ACCESS_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,ACCESS_FACET,ACCESS_BIT, SLOT_RDWRT_RLN,SLOT_RDONLY_RLN,SLOT_INIT_RLN, NULL,NULL); if (rtnCode == -1) goto ParseSlotError; else if (rtnCode == 1) slot->noWrite = 1; else if (rtnCode == 2) slot->initializeOnly = 1; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),STORAGE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,STORAGE_FACET,STORAGE_BIT, SLOT_LOCAL_RLN,SLOT_SHARE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->shared = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),PROPAGATION_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,PROPAGATION_FACET,PROPAGATION_BIT, SLOT_INH_RLN,SLOT_NO_INH_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->noInherit = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SOURCE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,SOURCE_FACET,SOURCE_BIT, SLOT_EXCLUSIVE_RLN,SLOT_COMPOSITE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->composite = rtnCode; } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,MATCH_FACET,MATCH_BIT, SLOT_NONREACTIVE_RLN,SLOT_REACTIVE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->reactive = rtnCode; } #endif else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),VISIBILITY_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,VISIBILITY_FACET,VISIBILITY_BIT, SLOT_PRIVATE_RLN,SLOT_PUBLIC_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->publicVisibility = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),CREATE_ACCESSOR_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,CREATE_ACCESSOR_FACET, CREATE_ACCESSOR_BIT, SLOT_READ_RLN,SLOT_WRITE_RLN,SLOT_RDWRT_RLN, SLOT_NONE_RLN,NULL); if (rtnCode == -1) goto ParseSlotError; if ((rtnCode == 0) || (rtnCode == 2)) slot->createReadAccessor = TRUE; if ((rtnCode == 1) || (rtnCode == 2)) slot->createWriteAccessor = TRUE; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),OVERRIDE_MSG_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,OVERRIDE_MSG_FACET,OVERRIDE_MSG_BIT, NULL,NULL,NULL,SLOT_DEFAULT_RLN,&newOverrideMsg); if (rtnCode == -1) goto ParseSlotError; if (rtnCode == 4) { DecrementSymbolCount(theEnv,slot->overrideMessage); slot->overrideMessage = newOverrideMsg; IncrementSymbolCount(slot->overrideMessage); } slot->overrideMessageSpecified = TRUE; } else if (StandardConstraint(DOToString(DefclassData(theEnv)->ObjectParseToken))) { if (ParseStandardConstraint(theEnv,readSource,DOToString(DefclassData(theEnv)->ObjectParseToken), slot->constraint,&parsedConstraint,TRUE) == FALSE) goto ParseSlotError; } else { SyntaxErrorMessage(theEnv,"defclass slot"); goto ParseSlotError; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defclass slot"); goto ParseSlotError; } if (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE) { if (! TestBitMap(specbits,CREATE_ACCESSOR_BIT)) { slot->createReadAccessor = TRUE; if (! slot->noWrite) { slot->createWriteAccessor = TRUE; } } } if (slot->composite) BuildCompositeFacets(theEnv,slot,preclist,specbits,&parsedConstraint); if (CheckForFacetConflicts(theEnv,slot,&parsedConstraint) == FALSE) goto ParseSlotError; if (CheckConstraintParseConflicts(theEnv,slot->constraint) == FALSE) goto ParseSlotError; if (EvaluateSlotDefaultValue(theEnv,slot,specbits) == FALSE) goto ParseSlotError; if ((slot->dynamicDefault == 0) && (slot->noWrite == 1) && (slot->initializeOnly == 0)) slot->shared = 1; slot->constraint = AddConstraint(theEnv,slot->constraint); DecrementIndentDepth(theEnv,3); return(slist); ParseSlotError: DecrementIndentDepth(theEnv,3); DeleteSlots(theEnv,slist); return(NULL); } /*************************************************** NAME : DeleteSlots DESCRIPTION : Deallocates a list of slots and their values INPUTS : The address of the slot list RETURNS : Nothing useful SIDE EFFECTS : The slot list is destroyed NOTES : None ***************************************************/ globle void DeleteSlots( void *theEnv, TEMP_SLOT_LINK *slots) { TEMP_SLOT_LINK *stmp; while (slots != NULL) { stmp = slots; slots = slots->nxt; DeleteSlotName(theEnv,stmp->desc->slotName); DecrementSymbolCount(theEnv,stmp->desc->overrideMessage); RemoveConstraint(theEnv,stmp->desc->constraint); if (stmp->desc->dynamicDefault == 1) { ExpressionDeinstall(theEnv,(EXPRESSION *) stmp->desc->defaultValue); ReturnPackedExpression(theEnv,(EXPRESSION *) stmp->desc->defaultValue); } else if (stmp->desc->defaultValue != NULL) { ValueDeinstall(theEnv,(DATA_OBJECT *) stmp->desc->defaultValue); rtn_struct(theEnv,dataObject,stmp->desc->defaultValue); } rtn_struct(theEnv,slotDescriptor,stmp->desc); rtn_struct(theEnv,tempSlotLink,stmp); } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************** NAME : NewSlot DESCRIPTION : Allocates and initalizes a new slot structure INPUTS : The symbolic name of the new slot RETURNS : The address of the new slot SIDE EFFECTS : None NOTES : Also adds symbols of the form get- and put- for slot accessors **************************************************************/ static SLOT_DESC *NewSlot( void *theEnv, SYMBOL_HN *name) { SLOT_DESC *slot; slot = get_struct(theEnv,slotDescriptor); slot->dynamicDefault = 1; slot->defaultSpecified = 0; slot->noDefault = 0; #if DEFRULE_CONSTRUCT slot->reactive = 1; #endif slot->noInherit = 0; slot->noWrite = 0; slot->initializeOnly = 0; slot->shared = 0; slot->multiple = 0; slot->composite = 0; slot->sharedCount = 0; slot->publicVisibility = 0; slot->createReadAccessor = FALSE; slot->createWriteAccessor = FALSE; slot->overrideMessageSpecified = 0; slot->cls = NULL; slot->defaultValue = NULL; slot->constraint = GetConstraintRecord(theEnv); slot->slotName = AddSlotName(theEnv,name,0,FALSE); slot->overrideMessage = slot->slotName->putHandlerName; IncrementSymbolCount(slot->overrideMessage); return(slot); } /********************************************************** NAME : InsertSlot DESCRIPTION : Inserts a slot into the list of slots INPUTS : 1) The current head of the slot list 2) The slot to be inserted RETURNS : The head of the slot list SIDE EFFECTS : The slot is inserted if no errors, otherwise the original list and the new slot are destroyed NOTES : None **********************************************************/ static TEMP_SLOT_LINK *InsertSlot( void *theEnv, TEMP_SLOT_LINK *slist, SLOT_DESC *slot) { TEMP_SLOT_LINK *stmp,*sprv,*tmp; tmp = get_struct(theEnv,tempSlotLink); tmp->desc = slot; tmp->nxt = NULL; if (slist == NULL) slist = tmp; else { stmp = slist; sprv = NULL; while (stmp != NULL) { if (stmp->desc->slotName == slot->slotName) { tmp->nxt = slist; DeleteSlots(theEnv,tmp); PrintErrorID(theEnv,"CLSLTPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate slots not allowed.\n"); return(NULL); } sprv = stmp; stmp = stmp->nxt; } sprv->nxt = tmp; } return(slist); } /**************************************************************** NAME : ParseSimpleFacet DESCRIPTION : Parses the following facets for a slot: access, source, propagation, storage, pattern-match, visibility and override-message INPUTS : 1) The input logical name 2) The bitmap indicating which facets have already been parsed 3) The name of the facet 4) The bit to test/set in arg #2 for this facet 5) The facet value string which indicates the facet should be false 6) The facet value string which indicates the facet should be TRUE 7) An alternate value string for use when the first two don't match (can be NULL) 7) An alternate value string for use when the first three don't match (can be NULL) (will be an SF_VARIABLE type) 9) A buffer to hold the facet value symbol (can be NULL - only set if args #5 and #6 are both NULL) RETURNS : -1 on errors 0 if first value string matched 1 if second value string matched 2 if alternate value string matched 3 if variable value string matched 4 if facet value buffer was set SIDE EFFECTS : Messages printed on errors Bitmap marked indicating facet was parsed Facet value symbol buffer set, if appropriate NOTES : None *****************************************************************/ static int ParseSimpleFacet( void *theEnv, const char *readSource, char *specbits, const char *facetName, int testBit, const char *clearRelation, const char *setRelation, const char *alternateRelation, const char *varRelation, SYMBOL_HN **facetSymbolicValue) { int rtnCode; if (TestBitMap(specbits,testBit)) { PrintErrorID(theEnv,"CLSLTPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,facetName); EnvPrintRouter(theEnv,WERROR," facet already specified.\n"); return(-1); } SetBitMap(specbits,testBit); SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); /* =============================== Check for the variable relation =============================== */ if (DefclassData(theEnv)->ObjectParseToken.type == SF_VARIABLE) { if ((varRelation == NULL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),varRelation) == 0)) rtnCode = 3; else goto ParseSimpleFacetError; } else { if (DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) goto ParseSimpleFacetError; /* =================================================== If the facet value buffer is non-NULL simply get the value and do not check any relations =================================================== */ if (facetSymbolicValue == NULL) { if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),clearRelation) == 0) rtnCode = 0; else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),setRelation) == 0) rtnCode = 1; else if ((alternateRelation == NULL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),alternateRelation) == 0)) rtnCode = 2; else goto ParseSimpleFacetError; } else { rtnCode = 4; *facetSymbolicValue = (SYMBOL_HN *) DefclassData(theEnv)->ObjectParseToken.value; } } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (DefclassData(theEnv)->ObjectParseToken.type != RPAREN) goto ParseSimpleFacetError; return(rtnCode); ParseSimpleFacetError: SyntaxErrorMessage(theEnv,"slot facet"); return(-1); } /************************************************************* NAME : ParseDefaultFacet DESCRIPTION : Parses the facet for a slot INPUTS : 1) The input logical name 2) The bitmap indicating which facets have already been parsed 3) The slot descriptor to set RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot set and parsed facet bitmap set NOTES : Syntax: (default ?NONE|*) (default-dynamic *) *************************************************************/ static intBool ParseDefaultFacet( void *theEnv, const char *readSource, char *specbits, SLOT_DESC *slot) { EXPRESSION *tmp; int error,noneSpecified,deriveSpecified; if (TestBitMap(specbits,DEFAULT_BIT)) { PrintErrorID(theEnv,"CLSLTPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"default facet already specified.\n"); return(FALSE); } SetBitMap(specbits,DEFAULT_BIT); error = FALSE; tmp = ParseDefault(theEnv,readSource,1,(int) TestBitMap(specbits,DEFAULT_DYNAMIC_BIT), 0,&noneSpecified,&deriveSpecified,&error); if (error == TRUE) return(FALSE); if (noneSpecified || deriveSpecified) { if (noneSpecified) { slot->noDefault = 1; slot->defaultSpecified = 1; } else ClearBitMap(specbits,DEFAULT_BIT); } else { slot->defaultValue = (void *) PackExpression(theEnv,tmp); ReturnExpression(theEnv,tmp); ExpressionInstall(theEnv,(EXPRESSION *) slot->defaultValue); slot->defaultSpecified = 1; } return(TRUE); } /************************************************************************** NAME : BuildCompositeFacets DESCRIPTION : Composite slots are ones that get their facets from more than one class. By default, the most specific class in object's precedence list specifies the complete set of facets for a slot. The composite facet in a slot allows facets that are not overridden by the most specific class to be obtained from other classes. Since all superclasses are predetermined before creating a new class based on them, this routine need only examine the immediately next most specific class for extra facets. Even if that slot is also composite, the other facets have already been filtered down. If the slot is no-inherit, the next most specific class must be examined. INPUTS : 1) The slot descriptor 2) The class precedence list 3) The bitmap marking which facets were specified in the original slot definition RETURNS : Nothing useful SIDE EFFECTS : Composite slot is updated to reflect facets from a less specific class NOTES : Assumes slot is composite *************************************************************************/ static void BuildCompositeFacets( void *theEnv, SLOT_DESC *sd, PACKED_CLASS_LINKS *preclist, const char *specbits, CONSTRAINT_PARSE_RECORD *parsedConstraint) { SLOT_DESC *compslot = NULL; long i; for (i = 1 ; i < preclist->classCount ; i++) { compslot = FindClassSlot(preclist->classArray[i],sd->slotName->name); if ((compslot != NULL) ? (compslot->noInherit == 0) : FALSE) break; } if (compslot != NULL) { if ((sd->defaultSpecified == 0) && (compslot->defaultSpecified == 1)) { sd->dynamicDefault = compslot->dynamicDefault; sd->noDefault = compslot->noDefault; sd->defaultSpecified = 1; if (compslot->defaultValue != NULL) { if (sd->dynamicDefault) { sd->defaultValue = (void *) PackExpression(theEnv,(EXPRESSION *) compslot->defaultValue); ExpressionInstall(theEnv,(EXPRESSION *) sd->defaultValue); } else { sd->defaultValue = (void *) get_struct(theEnv,dataObject); GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,compslot->defaultValue); ValueInstall(theEnv,(DATA_OBJECT *) sd->defaultValue); } } } if (TestBitMap(specbits,FIELD_BIT) == 0) sd->multiple = compslot->multiple; if (TestBitMap(specbits,STORAGE_BIT) == 0) sd->shared = compslot->shared; if (TestBitMap(specbits,ACCESS_BIT) == 0) { sd->noWrite = compslot->noWrite; sd->initializeOnly = compslot->initializeOnly; } #if DEFRULE_CONSTRUCT if (TestBitMap(specbits,MATCH_BIT) == 0) sd->reactive = compslot->reactive; #endif if (TestBitMap(specbits,VISIBILITY_BIT) == 0) sd->publicVisibility = compslot->publicVisibility; if (TestBitMap(specbits,CREATE_ACCESSOR_BIT) == 0) { sd->createReadAccessor = compslot->createReadAccessor; sd->createWriteAccessor = compslot->createWriteAccessor; } if ((TestBitMap(specbits,OVERRIDE_MSG_BIT) == 0) && compslot->overrideMessageSpecified) { DecrementSymbolCount(theEnv,sd->overrideMessage); sd->overrideMessage = compslot->overrideMessage; IncrementSymbolCount(sd->overrideMessage); sd->overrideMessageSpecified = TRUE; } OverlayConstraint(theEnv,parsedConstraint,sd->constraint,compslot->constraint); } } /*************************************************** NAME : CheckForFacetConflicts DESCRIPTION : Determines if all facets specified (and inherited) for a slot are consistent INPUTS : 1) The slot descriptor 2) The parse record for the type constraints on the slot RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Min and Max fields replaced in constraint for single-field slot NOTES : None ***************************************************/ static intBool CheckForFacetConflicts( void *theEnv, SLOT_DESC *sd, CONSTRAINT_PARSE_RECORD *parsedConstraint) { if (sd->multiple == 0) { if (parsedConstraint->cardinality) { PrintErrorID(theEnv,"CLSLTPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Cardinality facet can only be used with multifield slots\n"); return(FALSE); } else { ReturnExpression(theEnv,sd->constraint->minFields); ReturnExpression(theEnv,sd->constraint->maxFields); sd->constraint->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL)); sd->constraint->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL)); } } if (sd->noDefault && sd->noWrite) { PrintErrorID(theEnv,"CLSLTPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"read-only slots must have a default value\n"); return(FALSE); } if (sd->noWrite && (sd->createWriteAccessor || sd->overrideMessageSpecified)) { PrintErrorID(theEnv,"CLSLTPSR",5,TRUE); EnvPrintRouter(theEnv,WERROR,"read-only slots cannot have a write accessor\n"); return(FALSE); } if (sd->noInherit && sd->publicVisibility) { PrintErrorID(theEnv,"CLSLTPSR",6,TRUE); EnvPrintRouter(theEnv,WERROR,"no-inherit slots cannot also be public\n"); return(FALSE); } return(TRUE); } /******************************************************************** NAME : EvaluateSlotDefaultValue DESCRIPTION : Checks the default value against the slot constraints and evaluates static default values INPUTS : 1) The slot descriptor 2) The bitmap marking which facets were specified in the original slot definition RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Static default value expressions deleted and replaced with data object evaluation NOTES : On errors, slot is marked as dynamix so that DeleteSlots() will erase the slot expression ********************************************************************/ static intBool EvaluateSlotDefaultValue( void *theEnv, SLOT_DESC *sd, const char *specbits) { DATA_OBJECT temp; int oldce,olddcc,vCode; /* =================================================================== Slot default value expression is marked as dynamic until now so that DeleteSlots() would erase in the event of an error. The delay was so that the evaluation of a static default value could be delayed until all the constraints were parsed. =================================================================== */ if (TestBitMap(specbits,DEFAULT_DYNAMIC_BIT) == 0) sd->dynamicDefault = 0; if (sd->noDefault) return(TRUE); if (sd->dynamicDefault == 0) { if (TestBitMap(specbits,DEFAULT_BIT)) { oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); olddcc = EnvSetDynamicConstraintChecking(theEnv,EnvGetStaticConstraintChecking(theEnv)); vCode = EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple, (EXPRESSION *) sd->defaultValue,&temp,TRUE); if (vCode != FALSE) vCode = ValidSlotValue(theEnv,&temp,sd,NULL,"slot default value"); EnvSetDynamicConstraintChecking(theEnv,olddcc); SetExecutingConstruct(theEnv,oldce); if (vCode) { ExpressionDeinstall(theEnv,(EXPRESSION *) sd->defaultValue); ReturnPackedExpression(theEnv,(EXPRESSION *) sd->defaultValue); sd->defaultValue = (void *) get_struct(theEnv,dataObject); GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,&temp); ValueInstall(theEnv,(DATA_OBJECT *) sd->defaultValue); } else { sd->dynamicDefault = 1; return(FALSE); } } else if (sd->defaultSpecified == 0) { sd->defaultValue = (void *) get_struct(theEnv,dataObject); DeriveDefaultFromConstraints(theEnv,sd->constraint, (DATA_OBJECT *) sd->defaultValue,(int) sd->multiple,TRUE); ValueInstall(theEnv,(DATA_OBJECT *) sd->defaultValue); } } else if (EnvGetStaticConstraintChecking(theEnv)) { vCode = ConstraintCheckExpressionChain(theEnv,(EXPRESSION *) sd->defaultValue,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expression for "); PrintSlot(theEnv,WERROR,sd,NULL,"dynamic default value"); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,FALSE); return(FALSE); } } return(TRUE); } #endif clips_core_source_630/core/factlhs.h0000755000175000017500000000443012373742652016042 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT BUILD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Initialize the exists member. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_factlhs #define _H_factlhs #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTLHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int FactPatternParserFind(SYMBOL_HN *); LOCALE struct lhsParseNode *FactPatternParse(void *,const char *,struct token *); LOCALE struct lhsParseNode *SequenceRestrictionParse(void *,const char *,struct token *); LOCALE struct lhsParseNode *CreateInitialFactPattern(void *); #endif /* _H_factlhs */ clips_core_source_630/core/factmch.c0000755000175000017500000010714512373742652016025 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT MATCH MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the algorithm for pattern matching in */ /* the fact pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added support for hashed alpha memories. */ /* */ /* Fix for DR0880. 2008-01-24 */ /* */ /* Added support for hashed comparisons to */ /* constants. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /*************************************************************/ #define _FACTMCH_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "extnfunc.h" #include "factgen.h" #include "factrete.h" #include "incrrset.h" #include "memalloc.h" #include "reteutil.h" #include "router.h" #include "sysdep.h" #include "tmpltdef.h" #include "factmch.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool EvaluatePatternExpression(void *,struct factPatternNode *,struct expr *); static void TraceErrorToJoin(void *,struct factPatternNode *,int); static void ProcessFactAlphaMatch(void *,struct fact *,struct multifieldMarker *,struct factPatternNode *); static struct factPatternNode *GetNextFactPatternNode(void *,int,struct factPatternNode *); static int SkipFactPatternNode(void *,struct factPatternNode *); static void ProcessMultifieldNode(void *, struct factPatternNode *, struct multifieldMarker *, struct multifieldMarker *,int); static void PatternNetErrorMessage(void *,struct factPatternNode *); /*************************************************************************/ /* FactPatternMatch: Implements the core loop for fact pattern matching. */ /*************************************************************************/ globle void FactPatternMatch( void *theEnv, struct fact *theFact, struct factPatternNode *patternPtr, int offset, struct multifieldMarker *markers, struct multifieldMarker *endMark) { int theSlotField; int offsetSlot; DATA_OBJECT theResult; struct factPatternNode *tempPtr; /*=========================================================*/ /* If there's nothing left in the pattern network to match */ /* against, then the current traversal of the pattern */ /* network needs to back up. */ /*=========================================================*/ if (patternPtr == NULL) return; /*=======================================================*/ /* The offsetSlot variable indicates the current offset */ /* within the multifield slot being pattern matched. */ /* (Recall that a multifield wildcard or variable */ /* recursively iterates through all possible bindings.) */ /* Once a new slot starts being pattern matched, the */ /* offset is reset to zero. */ /*=======================================================*/ offsetSlot = patternPtr->whichSlot; /*================================================*/ /* Set up some global parameters for use by the */ /* Rete access functions and general convenience. */ /*================================================*/ FactData(theEnv)->CurrentPatternFact = theFact; FactData(theEnv)->CurrentPatternMarks = markers; /*============================================*/ /* Loop through each node in pattern network. */ /*============================================*/ while (patternPtr != NULL) { /*=============================================================*/ /* Determine the position of the field we're going to pattern */ /* match. If this routine has been entered recursively because */ /* of multifield wildcards or variables, then add in the */ /* additional offset caused by the values which match these */ /* multifields. This offset may be negative (if for example a */ /* a multifield matched a zero length value). */ /*=============================================================*/ theSlotField = patternPtr->whichField; if (offsetSlot == patternPtr->whichSlot) { theSlotField += offset; } /*===================================*/ /* Determine if we want to skip this */ /* node during an incremental reset. */ /*===================================*/ if (SkipFactPatternNode(theEnv,patternPtr)) { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } /*=========================================================*/ /* If this is a single field pattern node, then determine */ /* if the constraints for the node have been satisfied for */ /* the current field in the slot being examined. */ /*=========================================================*/ else if (patternPtr->header.singlefieldNode) { /*==================================================*/ /* If we're at the last slot in the pattern, make */ /* sure the number of fields in the fact correspond */ /* to the number of fields required by the pattern */ /* based on the binding of multifield variables. */ /*==================================================*/ int skipit = FALSE; if (patternPtr->header.endSlot && ((FactData(theEnv)->CurrentPatternMarks == NULL) ? FALSE : (FactData(theEnv)->CurrentPatternMarks->where.whichSlotNumber == patternPtr->whichSlot)) && (FactData(theEnv)->CurrentPatternFact->theProposition.theFields [patternPtr->whichSlot].type == MULTIFIELD)) { if ((patternPtr->leaveFields + theSlotField) != (int) ((struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields [patternPtr->whichSlot].value)->multifieldLength) { skipit = TRUE; } } if (skipit) { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } else if (patternPtr->header.selector) { if (EvaluatePatternExpression(theEnv,patternPtr,patternPtr->networkTest->nextArg)) { EvaluateExpression(theEnv,patternPtr->networkTest,&theResult); tempPtr = (struct factPatternNode *) FindHashedPatternNode(theEnv,patternPtr,theResult.type,theResult.value); } else { tempPtr = NULL; } if (tempPtr != NULL) { if (SkipFactPatternNode(theEnv,tempPtr)) { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } else { if (tempPtr->header.stopNode) { ProcessFactAlphaMatch(theEnv,theFact,markers,tempPtr); } patternPtr = GetNextFactPatternNode(theEnv,FALSE,tempPtr); } } else { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } } /*=============================================*/ /* If the constraints are satisified, then ... */ /*=============================================*/ else if (EvaluatePatternExpression(theEnv,patternPtr,patternPtr->networkTest)) { /*=======================================================*/ /* If a leaf pattern node has been successfully reached, */ /* then the pattern has been satisified. Generate an */ /* alpha match to store in the pattern node. */ /*=======================================================*/ if (patternPtr->header.stopNode) { ProcessFactAlphaMatch(theEnv,theFact,markers,patternPtr); } /*===================================*/ /* Move on to the next pattern node. */ /*===================================*/ patternPtr = GetNextFactPatternNode(theEnv,FALSE,patternPtr); } /*==============================================*/ /* Otherwise, move on to the next pattern node. */ /*==============================================*/ else { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } } /*======================================================*/ /* If this is a multifield pattern node, then determine */ /* if the constraints for the node have been satisfied */ /* for the current field in the slot being examined. */ /*======================================================*/ else if (patternPtr->header.multifieldNode) { /*========================================================*/ /* Determine if the multifield pattern node's constraints */ /* are satisfied. If we've traversed to a different slot */ /* than the one we started this routine with, then the */ /* offset into the slot is reset to zero. */ /*========================================================*/ if (offsetSlot == patternPtr->whichSlot) { ProcessMultifieldNode(theEnv,patternPtr,markers,endMark,offset); } else { ProcessMultifieldNode(theEnv,patternPtr,markers,endMark,0); } /*===================================================*/ /* Move on to the next pattern node. Since the lower */ /* branches of the pattern network have already been */ /* recursively processed by ProcessMultifieldNode, */ /* we get the next pattern node by treating this */ /* multifield pattern node as if it were a single */ /* field pattern node that failed its constraint. */ /*===================================================*/ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } } } /**************************************************************/ /* ProcessMultifieldNode: Handles recursive pattern matching */ /* when a multifield wildcard or variable is encountered as */ /* a slot constraint. The pattern matching routine is called */ /* iteratively for each possible binding of the multifield */ /* wildcard or variable. */ /**************************************************************/ static void ProcessMultifieldNode( void *theEnv, struct factPatternNode *thePattern, struct multifieldMarker *markers, struct multifieldMarker *endMark, int offset) { struct multifieldMarker *newMark, *oldMark; int repeatCount; struct multifield *theSlotValue; DATA_OBJECT theResult; struct factPatternNode *tempPtr; intBool success; /*========================================*/ /* Get a pointer to the slot value of the */ /* multifield slot being pattern matched. */ /*========================================*/ theSlotValue = (struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields[thePattern->whichSlot].value; /*===============================================*/ /* Save the value of the markers already stored. */ /*===============================================*/ oldMark = markers; /*===========================================*/ /* Create a new multifield marker and append */ /* it to the end of the current list. */ /*===========================================*/ newMark = get_struct(theEnv,multifieldMarker); newMark->whichField = thePattern->whichField - 1; newMark->where.whichSlotNumber = (short) thePattern->whichSlot; newMark->startPosition = (thePattern->whichField - 1) + offset; newMark->next = NULL; if (endMark == NULL) { markers = newMark; FactData(theEnv)->CurrentPatternMarks = markers; } else { endMark->next = newMark; } /*============================================*/ /* Handle a multifield constraint as the last */ /* constraint of a slot as a special case. */ /*============================================*/ if (thePattern->header.endSlot) { newMark->endPosition = (long) theSlotValue->multifieldLength - (thePattern->leaveFields + 1); /*=======================================================*/ /* Make sure the endPosition is never more than less one */ /* less of the startPosition (a multifield containing no */ /* values. */ /*=======================================================*/ if (newMark->endPosition < newMark->startPosition) { newMark->endPosition = newMark->startPosition - 1; } /*===========================================*/ /* Determine if the constraint is satisfied. */ /*===========================================*/ if (thePattern->header.selector) { if (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest->nextArg)) { EvaluateExpression(theEnv,thePattern->networkTest,&theResult); thePattern = (struct factPatternNode *) FindHashedPatternNode(theEnv,thePattern,theResult.type,theResult.value); if (thePattern != NULL) { success = TRUE; } else { success = FALSE; } } else { success = FALSE; } } else if ((thePattern->networkTest == NULL) ? TRUE : (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest))) { success = TRUE; } else { success = FALSE; } if (success) { /*=======================================================*/ /* If a leaf pattern node has been successfully reached, */ /* then the pattern has been satisified. Generate an */ /* alpha match to store in the pattern node. */ /*=======================================================*/ if (thePattern->header.stopNode) { ProcessFactAlphaMatch(theEnv,FactData(theEnv)->CurrentPatternFact,FactData(theEnv)->CurrentPatternMarks,thePattern); } /*=============================================*/ /* Recursively continue pattern matching based */ /* on the multifield binding just generated. */ /*=============================================*/ FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact, thePattern->nextLevel,0,FactData(theEnv)->CurrentPatternMarks,newMark); } /*================================================*/ /* Discard the multifield marker since we've done */ /* all the pattern matching for this binding of */ /* the multifield slot constraint. */ /*================================================*/ rtn_struct(theEnv,multifieldMarker,newMark); if (endMark != NULL) endMark->next = NULL; FactData(theEnv)->CurrentPatternMarks = oldMark; return; } /*==============================================*/ /* Perform matching for nodes beneath this one. */ /*==============================================*/ for (repeatCount = (long) (theSlotValue->multifieldLength - (newMark->startPosition + thePattern->leaveFields)); repeatCount >= 0; repeatCount--) { newMark->endPosition = newMark->startPosition + (repeatCount - 1); if (thePattern->header.selector) { if (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest->nextArg)) { EvaluateExpression(theEnv,thePattern->networkTest,&theResult); tempPtr = (struct factPatternNode *) FindHashedPatternNode(theEnv,thePattern,theResult.type,theResult.value); if (tempPtr != NULL) { FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact, tempPtr->nextLevel,offset + repeatCount - 1, FactData(theEnv)->CurrentPatternMarks,newMark); } } } else if ((thePattern->networkTest == NULL) ? TRUE : (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest))) { FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact, thePattern->nextLevel,offset + repeatCount - 1, FactData(theEnv)->CurrentPatternMarks,newMark); } } /*======================================================*/ /* Get rid of the marker created for a multifield node. */ /*======================================================*/ rtn_struct(theEnv,multifieldMarker,newMark); if (endMark != NULL) endMark->next = NULL; FactData(theEnv)->CurrentPatternMarks = oldMark; } /******************************************************/ /* GetNextFactPatternNode: Returns the next node in a */ /* pattern network tree to be traversed. The next */ /* node is computed using a depth first traversal. */ /******************************************************/ static struct factPatternNode *GetNextFactPatternNode( void *theEnv, int finishedMatching, struct factPatternNode *thePattern) { EvaluationData(theEnv)->EvaluationError = FALSE; /*===================================================*/ /* If pattern matching was successful at the current */ /* node in the tree and it's possible to go deeper */ /* into the tree, then move down to the next level. */ /*===================================================*/ if (finishedMatching == FALSE) { if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); } /*================================================*/ /* Keep backing up toward the root of the pattern */ /* network until a side branch can be taken. */ /*================================================*/ while ((thePattern->rightNode == NULL) || ((thePattern->lastLevel != NULL) && (thePattern->lastLevel->header.selector))) { /*========================================*/ /* Back up to check the next side branch. */ /*========================================*/ thePattern = thePattern->lastLevel; /*======================================*/ /* If we branched up from the root, the */ /* entire tree has been traversed. */ /*======================================*/ if (thePattern == NULL) return(NULL); /*======================================*/ /* Skip selector constants and pop back */ /* back to the selector node. */ /*======================================*/ if ((thePattern->lastLevel != NULL) && (thePattern->lastLevel->header.selector)) { thePattern = thePattern->lastLevel; } /*===================================================*/ /* If we branched up to a multifield node, then stop */ /* since these nodes are handled recursively. The */ /* previous call to the pattern matching algorithm */ /* on the stack will handle backing up to the nodes */ /* above the multifield node in the pattern network. */ /*===================================================*/ if (thePattern->header.multifieldNode) return(NULL); } /*==================================*/ /* Move on to the next side branch. */ /*==================================*/ return(thePattern->rightNode); } /*******************************************************/ /* ProcessFactAlphaMatch: When a fact pattern has been */ /* satisfied, this routine creates an alpha match to */ /* store in the pattern network and then sends the */ /* new alpha match through the join network. */ /*******************************************************/ static void ProcessFactAlphaMatch( void *theEnv, struct fact *theFact, struct multifieldMarker *theMarks, struct factPatternNode *thePattern) { struct partialMatch *theMatch; struct patternMatch *listOfMatches; struct joinNode *listOfJoins; unsigned long hashValue; /*============================================*/ /* Create the hash value for the alpha match. */ /*============================================*/ hashValue = ComputeRightHashValue(theEnv,&thePattern->header); /*===========================================*/ /* Create the partial match for the pattern. */ /*===========================================*/ theMatch = CreateAlphaMatch(theEnv,theFact,theMarks,(struct patternNodeHeader *) &thePattern->header,hashValue); theMatch->owner = &thePattern->header; /*=======================================================*/ /* Add the pattern to the list of matches for this fact. */ /*=======================================================*/ listOfMatches = (struct patternMatch *) theFact->list; theFact->list = (void *) get_struct(theEnv,patternMatch); ((struct patternMatch *) theFact->list)->next = listOfMatches; ((struct patternMatch *) theFact->list)->matchingPattern = (struct patternNodeHeader *) thePattern; ((struct patternMatch *) theFact->list)->theMatch = theMatch; /*================================================================*/ /* Send the partial match to the joins connected to this pattern. */ /*================================================================*/ for (listOfJoins = thePattern->header.entryJoin; listOfJoins != NULL; listOfJoins = listOfJoins->rightMatchNode) { NetworkAssert(theEnv,theMatch,listOfJoins); } } /*****************************************************************/ /* EvaluatePatternExpression: Performs a faster evaluation for */ /* fact pattern network expressions than if EvaluateExpression */ /* were used directly. */ /*****************************************************************/ static int EvaluatePatternExpression( void *theEnv, struct factPatternNode *patternPtr, struct expr *theTest) { DATA_OBJECT theResult; struct expr *oldArgument; int rv; /*=====================================*/ /* A pattern node without a constraint */ /* is always satisfied. */ /*=====================================*/ if (theTest == NULL) return(TRUE); /*======================================*/ /* Evaluate pattern network primitives. */ /*======================================*/ switch(theTest->type) { /*==============================================*/ /* This primitive compares the value stored in */ /* a single field slot to a constant for either */ /* equality or inequality. */ /*==============================================*/ case FACT_PN_CONSTANT1: oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theTest; rv = FactPNConstant1(theEnv,theTest->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; return(rv); /*=============================================*/ /* This primitive compares the value stored in */ /* a multifield slot to a constant for either */ /* equality or inequality. */ /*=============================================*/ case FACT_PN_CONSTANT2: oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theTest; rv = FactPNConstant2(theEnv,theTest->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; return(rv); /*================================================*/ /* This primitive determines if a multifield slot */ /* contains at least a certain number of fields. */ /*================================================*/ case FACT_SLOT_LENGTH: oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theTest; rv = FactSlotLength(theEnv,theTest->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; return(rv); } /*==============================================*/ /* Evaluate "or" expressions by evaluating each */ /* argument and return TRUE if any of them */ /* evaluated to TRUE, otherwise return FALSE. */ /*==============================================*/ if (theTest->value == ExpressionData(theEnv)->PTR_OR) { for (theTest = theTest->argList; theTest != NULL; theTest = theTest->nextArg) { if (EvaluatePatternExpression(theEnv,patternPtr,theTest) == TRUE) { if (EvaluationData(theEnv)->EvaluationError) return(FALSE); return(TRUE); } if (EvaluationData(theEnv)->EvaluationError) return(FALSE); } return(FALSE); } /*===============================================*/ /* Evaluate "and" expressions by evaluating each */ /* argument and return FALSE if any of them */ /* evaluated to FALSE, otherwise return TRUE. */ /*===============================================*/ else if (theTest->value == ExpressionData(theEnv)->PTR_AND) { for (theTest = theTest->argList; theTest != NULL; theTest = theTest->nextArg) { if (EvaluatePatternExpression(theEnv,patternPtr,theTest) == FALSE) { return(FALSE); } if (EvaluationData(theEnv)->EvaluationError) return(FALSE); } return(TRUE); } /*==========================================================*/ /* Evaluate all other expressions using EvaluateExpression. */ /*==========================================================*/ if (EvaluateExpression(theEnv,theTest,&theResult)) { PatternNetErrorMessage(theEnv,patternPtr); return(FALSE); } if ((theResult.value == EnvFalseSymbol(theEnv)) && (theResult.type == SYMBOL)) { return(FALSE); } return(TRUE); } /************************************************************************/ /* PatternNetErrorMessage: Prints the informational header to the error */ /* message that occurs when a error occurs as the result of */ /* evaluating an expression in the fact pattern network. Prints the */ /* fact currently being pattern matched and the field number or slot */ /* name in the pattern from which the error originated. The error is */ /* then trace to the point where the pattern enters the join network */ /* so that the names of the rule which utilize the pattern can also */ /* be printed. */ /************************************************************************/ static void PatternNetErrorMessage( void *theEnv, struct factPatternNode *patternPtr) { char buffer[60]; struct templateSlot *theSlots; int i; /*=======================================*/ /* Print the fact being pattern matched. */ /*=======================================*/ PrintErrorID(theEnv,"FACTMCH",1,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred in the fact pattern network\n"); EnvPrintRouter(theEnv,WERROR," Currently active fact: "); PrintFact(theEnv,WERROR,FactData(theEnv)->CurrentPatternFact,FALSE,FALSE); EnvPrintRouter(theEnv,WERROR,"\n"); /*==============================================*/ /* Print the field position or slot name of the */ /* pattern from which the error originated. */ /*==============================================*/ if (FactData(theEnv)->CurrentPatternFact->whichDeftemplate->implied) { gensprintf(buffer," Problem resides in field #%d\n",patternPtr->whichField); } else { theSlots = FactData(theEnv)->CurrentPatternFact->whichDeftemplate->slotList; for (i = 0; i < (int) patternPtr->whichSlot; i++) theSlots = theSlots->next; gensprintf(buffer," Problem resides in slot %s\n",ValueToString(theSlots->slotName)); } EnvPrintRouter(theEnv,WERROR,buffer); /*==========================================================*/ /* Trace the pattern to its entry point to the join network */ /* (which then traces to the defrule data structure so that */ /* the name(s) of the rule(s) utilizing the patterns can be */ /* printed). */ /*==========================================================*/ TraceErrorToJoin(theEnv,patternPtr,FALSE); EnvPrintRouter(theEnv,WERROR,"\n"); } /***************************************************************************/ /* TraceErrorToJoin: Traces the cause of an evaluation error which occured */ /* in the fact pattern network to the entry join in the join network for */ /* the pattern from which the error originated. Once the entry join is */ /* reached, the error is then traced to the defrule data structures so */ /* that the name of the rule(s) containing the pattern can be printed. */ /***************************************************************************/ static void TraceErrorToJoin( void *theEnv, struct factPatternNode *patternPtr, int traceRight) { struct joinNode *joinPtr; while (patternPtr != NULL) { if (patternPtr->header.stopNode) { for (joinPtr = patternPtr->header.entryJoin; joinPtr != NULL; joinPtr = joinPtr->rightMatchNode) { TraceErrorToRule(theEnv,joinPtr," "); } } else { TraceErrorToJoin(theEnv,patternPtr->nextLevel,TRUE); } if (traceRight) patternPtr = patternPtr->rightNode; else patternPtr = NULL; } } /***********************************************************************/ /* SkipFactPatternNode: During an incremental reset, only fact pattern */ /* nodes associated with new patterns are traversed. Given a pattern */ /* node, this routine will return TRUE if the pattern node should be */ /* traversed during incremental reset pattern matching or FALSE if */ /* the node should be skipped. */ /***********************************************************************/ static int SkipFactPatternNode( void *theEnv, struct factPatternNode *thePattern) { #if (! RUN_TIME) && (! BLOAD_ONLY) if (EngineData(theEnv)->IncrementalResetInProgress && (thePattern->header.initialize == FALSE)) { return(TRUE); } #endif return(FALSE); } /***************************************************************/ /* MarkFactPatternForIncrementalReset: Sets the initialization */ /* field of a fact pattern for use with incremental reset. */ /* This is called before an incremental reset for newly added */ /* patterns to indicate that the pattern nodes should be */ /* traversed and then after an incremental reset to indicate */ /* that the nodes were traversed ("initialized") by the */ /* incremental reset. */ /***************************************************************/ globle void MarkFactPatternForIncrementalReset( void *theEnv, struct patternNodeHeader *thePattern, int value) { struct factPatternNode *patternPtr = (struct factPatternNode *) thePattern; struct joinNode *theJoin; #if MAC_XCD #pragma unused(theEnv) #endif /*=====================================*/ /* We should be passed a valid pointer */ /* to a fact pattern network node. */ /*=====================================*/ Bogus(patternPtr == NULL); /*===============================================================*/ /* If the pattern was previously initialized, then don't bother */ /* with it unless the pattern was subsumed by another pattern */ /* and associated with a join that hasn't been initialized. */ /* DR0880 2008-01-24 */ /*===============================================================*/ if (patternPtr->header.initialize == FALSE) { for (theJoin = patternPtr->header.entryJoin; theJoin != NULL; theJoin = theJoin->rightMatchNode) { if (theJoin->initialize == FALSE) { return; } } } /*======================================================*/ /* Set the initialization field of this pattern network */ /* node and all pattern network nodes which preceed it. */ /*======================================================*/ while (patternPtr != NULL) { patternPtr->header.initialize = value; patternPtr = patternPtr->lastLevel; } } /**************************************************************/ /* FactsIncrementalReset: Incremental reset function for the */ /* fact pattern network. Asserts all facts in the fact-list */ /* so that they repeat the pattern matching process. During */ /* an incremental reset, newly added patterns should be the */ /* only active patterns in the fact pattern network. */ /**************************************************************/ globle void FactsIncrementalReset( void *theEnv) { struct fact *factPtr; for (factPtr = (struct fact *) EnvGetNextFact(theEnv,NULL); factPtr != NULL; factPtr = (struct fact *) EnvGetNextFact(theEnv,factPtr)) { EngineData(theEnv)->JoinOperationInProgress = TRUE; FactPatternMatch(theEnv,factPtr, factPtr->whichDeftemplate->patternNetwork, 0,NULL,NULL); EngineData(theEnv)->JoinOperationInProgress = FALSE; } } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips_core_source_630/core/inherpsr.h0000755000175000017500000000405112373755056016251 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_inherpsr #define _H_inherpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #ifndef _H_object #include "object.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INHERPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE PACKED_CLASS_LINKS *ParseSuperclasses(void *,const char *,SYMBOL_HN *); LOCALE PACKED_CLASS_LINKS *FindPrecedenceList(void *,DEFCLASS *,PACKED_CLASS_LINKS *); LOCALE void PackClassLinks(void *,PACKED_CLASS_LINKS *,CLASS_LINK *); #endif /* OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) */ #endif /* _H_inherpsr */ clips_core_source_630/core/._genrcfun.c0000755000175000017500000000040712424473412016425 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dffctbsc.c0000755000175000017500000000040712461252076016376 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffnxcmp.c0000755000175000017500000003244312373721244016215 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include "conscomp.h" #include "envrnmnt.h" #define _DFFNXCMP_SOURCE_ #include "dffnxcmp.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyDeffunctionsForCode(void *); static int DeffunctionsToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static void CloseDeffunctionFiles(void *,FILE *,FILE *,int); static void DeffunctionModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDeffunctionToCode(void *,FILE *,DEFFUNCTION *,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDeffunctionCompiler DESCRIPTION : Initializes the construct compiler item for deffunctions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupDeffunctionCompiler( void *theEnv) { DeffunctionData(theEnv)->DeffunctionCodeItem = AddCodeGeneratorItem(theEnv,"deffunctions",0,ReadyDeffunctionsForCode, NULL,DeffunctionsToCode,2); } /*************************************************** NAME : PrintDeffunctionReference DESCRIPTION : Prints a reference to the run-time deffunction array for the construct compiler INPUTS : 1) The file output destination 2) A pointer to the deffunction 3) The id of the run-time image 4) The maximum number of indices in any array RETURNS : Nothing useful SIDE EFFECTS : Reference printed NOTES : None ***************************************************/ globle void PrintDeffunctionReference( void *theEnv, FILE *fp, DEFFUNCTION *dfPtr, int imageID, int maxIndices) { if (dfPtr == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]",ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),imageID, (int) ((dfPtr->header.bsaveID / maxIndices) + 1), (int) (dfPtr->header.bsaveID % maxIndices)); } /**************************************************** NAME : DeffunctionCModuleReference DESCRIPTION : Prints out a reference to a deffunction module INPUTS : 1) The output file 2) The id of the module item 3) The id of the image 4) The maximum number of elements allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Deffunction module reference printed NOTES : None ****************************************************/ globle void DeffunctionCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReadyDeffunctionsForCode DESCRIPTION : Sets index of deffunctions for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None ***************************************************/ static void ReadyDeffunctionsForCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DeffunctionData(theEnv)->DeffunctionModuleIndex); } /******************************************************* NAME : DeffunctionsToCode DESCRIPTION : Writes out static array code for deffunctions INPUTS : 1) The base name of the construct set 2) The base id for this construct 3) The file pointer for the header file 4) The base id for the construct set 5) The max number of indices allowed in an array RETURNS : -1 if no deffunctions, 0 on errors, 1 if deffunctions written SIDE EFFECTS : Code written to files NOTES : None *******************************************************/ static int DeffunctionsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFFUNCTION *theDeffunction; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int deffunctionArrayCount = 0, deffunctionArrayVersion = 1; FILE *moduleFile = NULL, *deffunctionFile = NULL; /* =============================================== Include the appropriate deffunction header file =============================================== */ fprintf(headerFP,"#include \"dffnxfun.h\"\n"); /* ============================================================= Loop through all the modules and all the deffunctions writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "DEFFUNCTION_MODULE",ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices); return(0); } DeffunctionModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); while (theDeffunction != NULL) { deffunctionFile = OpenFileIfNeeded(theEnv,deffunctionFile,fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, deffunctionArrayVersion,headerFP, "DEFFUNCTION",ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem), FALSE,NULL); if (deffunctionFile == NULL) { CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices); return(0); } SingleDeffunctionToCode(theEnv,deffunctionFile,theDeffunction,imageID, maxIndices,moduleCount); deffunctionArrayCount++; deffunctionFile = CloseFileIfNeeded(theEnv,deffunctionFile,&deffunctionArrayCount, &deffunctionArrayVersion,maxIndices,NULL,NULL); theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; moduleArrayCount++; } CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices); return(1); } /*************************************************** NAME : CloseDeffunctionFiles DESCRIPTION : Closes construct compiler files for deffunction structures INPUTS : 1) The deffunction module file 2) The deffunction structure file 3) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None ***************************************************/ static void CloseDeffunctionFiles( void *theEnv, FILE *moduleFile, FILE *deffunctionFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (deffunctionFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,deffunctionFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*************************************************** NAME : DeffunctionModuleToCode DESCRIPTION : Writes out the C values for a deffunction module item INPUTS : 1) The output file 2) The module for the deffunctions 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Deffunction module item written NOTES : None ***************************************************/ static void DeffunctionModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DeffunctionData(theEnv)->DeffunctionModuleIndex,ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem)); fprintf(theFile,"}"); } /*************************************************** NAME : SingleDeffunctionToCode DESCRIPTION : Writes out a single deffunction's data to the file INPUTS : 1) The output file 2) The deffunction 3) The compile image id 4) The maximum number of elements in an array 5) The module index RETURNS : Nothing useful SIDE EFFECTS : Deffunction data written NOTES : None ***************************************************/ static void SingleDeffunctionToCode( void *theEnv, FILE *theFile, DEFFUNCTION *theDeffunction, int imageID, int maxIndices, int moduleCount) { /* ================== Deffunction Header ================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDeffunction->header,imageID,maxIndices,moduleCount, ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem), ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem)); /* ========================= Deffunction specific data ========================= */ fprintf(theFile,",0,0,0,"); ExpressionToCode(theEnv,theFile,theDeffunction->code); fprintf(theFile,",%d,%d,%d", theDeffunction->minNumberOfParameters, theDeffunction->maxNumberOfParameters, theDeffunction->numberOfLocalVars); fprintf(theFile,"}"); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips_core_source_630/core/msgfun.c0000755000175000017500000010532412374017657015715 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* OBJECT MESSAGE FUNCTIONS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Changed integer type/precision. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "envrnmnt.h" #include "extnfunc.h" #include "insfun.h" #include "msgcom.h" #include "prccode.h" #include "router.h" #define _MSGFUN_SOURCE_ #include "msgfun.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS static HANDLER_LINK *DisplayPrimaryCore(void *,const char *,HANDLER_LINK *,int); static void PrintPreviewHandler(void *,const char *,HANDLER_LINK *,int,const char *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : UnboundHandlerErr DESCRIPTION : Print out a synopis of the currently executing handler for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None ********************************************************/ globle void UnboundHandlerErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"message-handler "); PrintHandler(theEnv,WERROR,MessageHandlerData(theEnv)->CurrentCore->hnd,TRUE); } /***************************************************************** NAME : PrintNoHandlerError DESCRIPTION : Print "No primaries found" error message for send INPUTS : The name of the message RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *****************************************************************/ globle void PrintNoHandlerError( void *theEnv, const char *msg) { PrintErrorID(theEnv,"MSGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No applicable primary message-handlers found for "); EnvPrintRouter(theEnv,WERROR,msg); EnvPrintRouter(theEnv,WERROR,".\n"); } /*************************************************************** NAME : CheckHandlerArgCount DESCRIPTION : Verifies that the current argument list satisfies the current handler's parameter count restriction INPUTS : None RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors NOTES : Uses ProcParamArraySize and CurrentCore globals ***************************************************************/ globle int CheckHandlerArgCount( void *theEnv) { HANDLER *hnd; hnd = MessageHandlerData(theEnv)->CurrentCore->hnd; if ((hnd->maxParams == -1) ? (ProceduralPrimitiveData(theEnv)->ProcParamArraySize < hnd->minParams) : (ProceduralPrimitiveData(theEnv)->ProcParamArraySize != hnd->minParams)) { SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"MSGFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handler "); EnvPrintRouter(theEnv,WERROR,ValueToString(hnd->name)); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,MessageHandlerData(theEnv)->hndquals[hnd->type]); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) hnd->cls)); EnvPrintRouter(theEnv,WERROR," expected "); if (hnd->maxParams == -1) EnvPrintRouter(theEnv,WERROR,"at least "); else EnvPrintRouter(theEnv,WERROR,"exactly "); PrintLongInteger(theEnv,WERROR,(long long) (hnd->minParams-1)); EnvPrintRouter(theEnv,WERROR," argument(s).\n"); return(FALSE); } return(TRUE); } /*************************************************** NAME : SlotAccessViolationError DESCRIPTION : Prints out an error message when attempt is made to set a read-only or initialize-only slot improperly INPUTS : 1) The slot name 2) A flag indicating if the source is a class or an instance 3) A pointer to the source instance/class RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ globle void SlotAccessViolationError( void *theEnv, const char *slotName, intBool instanceFlag, void *theInstanceOrClass) { PrintErrorID(theEnv,"MSGFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,slotName); EnvPrintRouter(theEnv,WERROR," slot in "); if (instanceFlag) PrintInstanceNameAndClass(theEnv,WERROR,(INSTANCE_TYPE *) theInstanceOrClass,FALSE); else { EnvPrintRouter(theEnv,WERROR,"class "); PrintClassName(theEnv,WERROR,(DEFCLASS *) theInstanceOrClass,FALSE); } EnvPrintRouter(theEnv,WERROR,": write access denied.\n"); } /*************************************************** NAME : SlotVisibilityViolationError DESCRIPTION : Prints out an error message when attempt is made to access a private slot improperly INPUTS : 1) The slot descriptor 2) A pointer to the source class RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ globle void SlotVisibilityViolationError( void *theEnv, SLOT_DESC *sd, DEFCLASS *theDefclass) { PrintErrorID(theEnv,"MSGFUN",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Private slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sd->slotName->name)); EnvPrintRouter(theEnv,WERROR," of class "); PrintClassName(theEnv,WERROR,sd->cls,FALSE); EnvPrintRouter(theEnv,WERROR," cannot be accessed directly\n by handlers attached to class "); PrintClassName(theEnv,WERROR,theDefclass,TRUE); } #if ! RUN_TIME /****************************************************************************** NAME : NewSystemHandler DESCRIPTION : Adds a new system handler for a system class The handler is assumed to be primary and of the form: (defmessage-handler () ()) INPUTS : 1) Name-string of the system class 2) Name-string of the system handler 3) Name-string of the internal H/L function to implement this handler 4) The number of extra arguments (past the instance itself) that the handler willl accept RETURNS : Nothing useful SIDE EFFECTS : Creates the new handler and inserts it in the system class's handler array On errors, generate a system error and exits. NOTES : Does not check to see if handler already exists *******************************************************************************/ globle void NewSystemHandler( void *theEnv, const char *cname, const char *mname, const char *fname, int extraargs) { DEFCLASS *cls; HANDLER *hnd; cls = LookupDefclassInScope(theEnv,cname); hnd = InsertHandlerHeader(theEnv,cls,(SYMBOL_HN *) EnvAddSymbol(theEnv,mname),MPRIMARY); IncrementSymbolCount(hnd->name); hnd->system = 1; hnd->minParams = hnd->maxParams = (short) (extraargs + 1); hnd->localVarCount = 0; hnd->actions = get_struct(theEnv,expr); hnd->actions->argList = NULL; hnd->actions->type = FCALL; hnd->actions->value = (void *) FindFunction(theEnv,fname); hnd->actions->nextArg = NULL; } /*************************************************** NAME : InsertHandlerHeader DESCRIPTION : Allocates a new handler header and inserts it in the proper (sorted) position in the class hnd array INPUTS : 1) The class 2) The handler name 3) The handler type RETURNS : The address of the new handler header, NULL on errors SIDE EFFECTS : Class handler array reallocated and resorted NOTES : Assumes handler does not exist ***************************************************/ globle HANDLER *InsertHandlerHeader( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname, int mtype) { HANDLER *nhnd,*hnd; unsigned *narr,*arr; long i; long j,ni = -1; hnd = cls->handlers; arr = cls->handlerOrderMap; nhnd = (HANDLER *) gm2(theEnv,(sizeof(HANDLER) * (cls->handlerCount+1))); narr = (unsigned *) gm2(theEnv,(sizeof(unsigned) * (cls->handlerCount+1))); GenCopyMemory(HANDLER,cls->handlerCount,nhnd,hnd); for (i = 0 , j = 0 ; i < cls->handlerCount ; i++ , j++) { if (ni == -1) { if ((hnd[arr[i]].name->bucket > mname->bucket) ? TRUE : (hnd[arr[i]].name == mname)) { ni = i; j++; } } narr[j] = arr[i]; } if (ni == -1) ni = (int) cls->handlerCount; narr[ni] = cls->handlerCount; nhnd[cls->handlerCount].system = 0; nhnd[cls->handlerCount].type = mtype; nhnd[cls->handlerCount].busy = 0; nhnd[cls->handlerCount].mark = 0; #if DEBUGGING_FUNCTIONS nhnd[cls->handlerCount].trace = MessageHandlerData(theEnv)->WatchHandlers; #endif nhnd[cls->handlerCount].name = mname; nhnd[cls->handlerCount].cls = cls; nhnd[cls->handlerCount].minParams = 0; nhnd[cls->handlerCount].maxParams = 0; nhnd[cls->handlerCount].localVarCount = 0; nhnd[cls->handlerCount].actions = NULL; nhnd[cls->handlerCount].ppForm = NULL; nhnd[cls->handlerCount].usrData = NULL; if (cls->handlerCount != 0) { rm(theEnv,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) arr,(sizeof(unsigned) * cls->handlerCount)); } cls->handlers = nhnd; cls->handlerOrderMap = narr; cls->handlerCount++; return(&nhnd[cls->handlerCount-1]); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /***************************************************** NAME : HandlersExecuting DESCRIPTION : Determines if any message-handlers for a class are currently executing INPUTS : The class address RETURNS : TRUE if any handlers are executing, FALSE otherwise SIDE EFFECTS : None NOTES : None *****************************************************/ globle int HandlersExecuting( DEFCLASS *cls) { long i; for (i = 0 ; i < cls->handlerCount ; i++) if (cls->handlers[i].busy > 0) return(TRUE); return(FALSE); } /********************************************************************* NAME : DeleteHandler DESCRIPTION : Deletes one or more message-handlers from a class definition INPUTS : 1) The class address 2) The message-handler name (if this is * and there is no handler called *, then the delete operations will be applied to all handlers matching the type 3) The message-handler type (if this is -1, then the delete operations will be applied to all handlers matching the name 4) A flag saying whether to print error messages when handlers are not found meeting specs RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handlers deleted NOTES : If any handlers for the class are currently executing, this routine will fail **********************************************************************/ globle int DeleteHandler( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname, int mtype, int indicate_missing) { long i; HANDLER *hnd; int found,success = 1; if (cls->handlerCount == 0) { if (indicate_missing) { HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); return(0); } return(1); } if (HandlersExecuting(cls)) { HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); return(0); } if (mtype == -1) { found = FALSE; for (i = MAROUND ; i <= MAFTER ; i++) { hnd = FindHandlerByAddress(cls,mname,(unsigned) i); if (hnd != NULL) { found = TRUE; if (hnd->system == 0) hnd->mark = 1; else { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); success = 0; } } } if ((found == FALSE) ? (strcmp(ValueToString(mname),"*") == 0) : FALSE) { for (i = 0 ; i < cls->handlerCount ; i++) if (cls->handlers[i].system == 0) cls->handlers[i].mark = 1; } } else { hnd = FindHandlerByAddress(cls,mname,(unsigned) mtype); if (hnd == NULL) { if (strcmp(ValueToString(mname),"*") == 0) { for (i = 0 ; i < cls->handlerCount ; i++) if ((cls->handlers[i].type == (unsigned) mtype) && (cls->handlers[i].system == 0)) cls->handlers[i].mark = 1; } else { if (indicate_missing) HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); success = 0; } } else if (hnd->system == 0) hnd->mark = 1; else { if (indicate_missing) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); } success = 0; } } DeallocateMarkedHandlers(theEnv,cls); return(success); } /*************************************************** NAME : DeallocateMarkedHandlers DESCRIPTION : Removes any handlers from a class that have been previously marked for deletion. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Marked handlers are deleted NOTES : Assumes none of the handlers are currently executing or have a busy count != 0 for any reason ***************************************************/ globle void DeallocateMarkedHandlers( void *theEnv, DEFCLASS *cls) { short count; HANDLER *hnd,*nhnd; unsigned *arr,*narr; long i,j; for (i = 0 , count = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->mark == 1) { count++; DecrementSymbolCount(theEnv,hnd->name); ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); ClearUserDataList(theEnv,hnd->usrData); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else /* ============================================ Use the busy field to count how many message-handlers are removed before this one ============================================ */ hnd->busy = count; } if (count == 0) return; if (count == cls->handlerCount) { rm(theEnv,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); cls->handlers = NULL; cls->handlerOrderMap = NULL; cls->handlerCount = 0; } else { count = (short) (cls->handlerCount - count); hnd = cls->handlers; arr = cls->handlerOrderMap; nhnd = (HANDLER *) gm2(theEnv,(sizeof(HANDLER) * count)); narr = (unsigned *) gm2(theEnv,(sizeof(unsigned) * count)); for (i = 0 , j = 0 ; j < count ; i++) { if (hnd[arr[i]].mark == 0) { /* ============================================================== The offsets in the map need to be decremented by the number of preceding nodes which were deleted. Use the value of the busy field set in the first loop. ============================================================== */ narr[j] = arr[i] - hnd[arr[i]].busy; j++; } } for (i = 0 , j = 0 ; j < count ; i++) { if (hnd[i].mark == 0) { hnd[i].busy = 0; GenCopyMemory(HANDLER,1,&nhnd[j],&hnd[i]); j++; } } rm(theEnv,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) arr,(sizeof(unsigned) * cls->handlerCount)); cls->handlers = nhnd; cls->handlerOrderMap = narr; cls->handlerCount = count; } } #endif /***************************************************** NAME : HandlerType DESCRIPTION : Determines type of message-handler INPUTS : 1) Calling function string 2) String representing type RETURNS : MAROUND (0) for "around" MBEFORE (1) for "before" MPRIMARY (2) for "primary" MAFTER (3) for "after" MERROR (4) on errors SIDE EFFECTS : None NOTES : None *****************************************************/ globle unsigned HandlerType( void *theEnv, const char *func, const char *str) { register unsigned i; for (i = MAROUND ; i <= MAFTER ; i++) if (strcmp(str,MessageHandlerData(theEnv)->hndquals[i]) == 0) { return(i); } PrintErrorID(theEnv,"MSGFUN",7,FALSE); EnvPrintRouter(theEnv,"werror","Unrecognized message-handler type in "); EnvPrintRouter(theEnv,"werror",func); EnvPrintRouter(theEnv,"werror",".\n"); return(MERROR); } /***************************************************************** NAME : CheckCurrentMessage DESCRIPTION : Makes sure that a message is available and active for an internal message function INPUTS : 1) The name of the function checking the message 2) A flag indicating whether the object must be a class instance or not (it could be a primitive type) RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors NOTES : None *****************************************************************/ globle int CheckCurrentMessage( void *theEnv, const char *func, int ins_reqd) { register DATA_OBJECT *activeMsgArg; if (!MessageHandlerData(theEnv)->CurrentCore || (MessageHandlerData(theEnv)->CurrentCore->hnd->actions != ProceduralPrimitiveData(theEnv)->CurrentProcActions)) { PrintErrorID(theEnv,"MSGFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," may only be called from within message-handlers.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } activeMsgArg = GetNthMessageArgument(theEnv,0); if ((ins_reqd == TRUE) ? (activeMsgArg->type != INSTANCE_ADDRESS) : FALSE) { PrintErrorID(theEnv,"MSGFUN",5,FALSE); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," operates only on instances.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if ((activeMsgArg->type == INSTANCE_ADDRESS) ? (((INSTANCE_TYPE *) activeMsgArg->value)->garbage == 1) : FALSE) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return(FALSE); } return(TRUE); } /*************************************************** NAME : PrintHandler DESCRIPTION : Displays a handler synopsis INPUTS : 1) Logical name of output 2) The handler 5) Flag indicating whether to printout a terminating newline RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void PrintHandler( void *theEnv, const char *logName, HANDLER *theHandler, int crtn) { EnvPrintRouter(theEnv,logName,ValueToString(theHandler->name)); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,MessageHandlerData(theEnv)->hndquals[theHandler->type]); EnvPrintRouter(theEnv,logName," in class "); PrintClassName(theEnv,logName,theHandler->cls,crtn); } /*********************************************************** NAME : FindHandlerByAddress DESCRIPTION : Uses a binary search on a class's handler header array INPUTS : 1) The class address 2) The handler symbolic name 3) The handler type (MPRIMARY,etc.) RETURNS : The address of the found handler, NULL if not found SIDE EFFECTS : None NOTES : Assumes array is in ascending order 1st key: symbolic name of handler 2nd key: type of handler ***********************************************************/ globle HANDLER *FindHandlerByAddress( DEFCLASS *cls, SYMBOL_HN *name, unsigned type) { register int b; long i; HANDLER *hnd; unsigned *arr; if ((b = FindHandlerNameGroup(cls,name)) == -1) return(NULL); arr = cls->handlerOrderMap; hnd = cls->handlers; for (i = (unsigned) b ; i < cls->handlerCount ; i++) { if (hnd[arr[i]].name != name) return(NULL); if (hnd[arr[i]].type == type) return(&hnd[arr[i]]); } return(NULL); } /*********************************************************** NAME : FindHandlerByIndex DESCRIPTION : Uses a binary search on a class's handler header array INPUTS : 1) The class address 2) The handler symbolic name 3) The handler type (MPRIMARY,etc.) RETURNS : The index of the found handler, -1 if not found SIDE EFFECTS : None NOTES : Assumes array is in ascending order 1st key: symbolic name of handler 2nd key: type of handler ***********************************************************/ globle int FindHandlerByIndex( DEFCLASS *cls, SYMBOL_HN *name, unsigned type) { register int b; long i; HANDLER *hnd; unsigned *arr; if ((b = FindHandlerNameGroup(cls,name)) == -1) return(-1); arr = cls->handlerOrderMap; hnd = cls->handlers; for (i = (unsigned) b ; i < cls->handlerCount ; i++) { if (hnd[arr[i]].name != name) return(-1); if (hnd[arr[i]].type == type) return((int) arr[i]); } return(-1); } /***************************************************** NAME : FindHandlerNameGroup DESCRIPTION : Uses a binary search on a class's handler header array INPUTS : 1) The class address 2) The handler symbolic name RETURNS : The index of the found handler group -1 if not found SIDE EFFECTS : None NOTES : Assumes array is in ascending order 1st key: handler name symbol bucket *****************************************************/ globle int FindHandlerNameGroup( DEFCLASS *cls, SYMBOL_HN *name) { register int b,e,i,j; HANDLER *hnd; unsigned *arr; int start; if (cls->handlerCount == 0) return(-1); hnd = cls->handlers; arr = cls->handlerOrderMap; b = 0; e = (int) (cls->handlerCount-1); start = -1; do { i = (b+e)/2; if (name->bucket == hnd[arr[i]].name->bucket) { for (j = i ; j >= b ; j--) { if (hnd[arr[j]].name == name) start = j; if (hnd[arr[j]].name->bucket != name->bucket) break; } if (start != -1) return(start); for (j = i+1 ; j <= e ; j++) { if (hnd[arr[j]].name == name) return(j); if (hnd[arr[j]].name->bucket != name->bucket) return(-1); } return(-1); } else if (name->bucket < hnd[arr[i]].name->bucket) e = i-1; else b = i+1; } while (b <= e); return(-1); } /*************************************************** NAME : HandlerDeleteError DESCRIPTION : Prints out an error message when handlers cannot be deleted INPUTS : Name-string of the class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void HandlerDeleteError( void *theEnv, const char *cname) { PrintErrorID(theEnv,"MSGFUN",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handler(s) from class "); EnvPrintRouter(theEnv,WERROR,cname); EnvPrintRouter(theEnv,WERROR,".\n"); } #if DEBUGGING_FUNCTIONS /******************************************************************** NAME : DisplayCore DESCRIPTION : Gives a schematic "printout" of the core framework for a message showing arounds, primaries, shadows etc. This routine uses recursion to print indentation to indicate shadowing and where handlers begin and end execution wrt one another. INPUTS : 1) Logical name of output 2) The remaining core 3) The number of handlers this (partial) core shadows RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Expects that the core was created in PREVIEW mode, i.e. implicit handlers are SLOT_DESC addresses (in PERFORM mode they are INSTANCE_SLOT addresses) Assumes (partial) core is not empty ********************************************************************/ globle void DisplayCore( void *theEnv, const char *logicalName, HANDLER_LINK *core, int sdepth) { if (core->hnd->type == MAROUND) { PrintPreviewHandler(theEnv,logicalName,core,sdepth,BEGIN_TRACE); if (core->nxt != NULL) DisplayCore(theEnv,logicalName,core->nxt,sdepth+1); PrintPreviewHandler(theEnv,logicalName,core,sdepth,END_TRACE); } else { while ((core != NULL) ? (core->hnd->type == MBEFORE) : FALSE) { PrintPreviewHandler(theEnv,logicalName,core,sdepth,BEGIN_TRACE); PrintPreviewHandler(theEnv,logicalName,core,sdepth,END_TRACE); core = core->nxt; } if ((core != NULL) ? (core->hnd->type == MPRIMARY) : FALSE) core = DisplayPrimaryCore(theEnv,logicalName,core,sdepth); while ((core != NULL) ? (core->hnd->type == MAFTER) : FALSE) { PrintPreviewHandler(theEnv,logicalName,core,sdepth,BEGIN_TRACE); PrintPreviewHandler(theEnv,logicalName,core,sdepth,END_TRACE); core = core->nxt; } } } /******************************************************************* NAME : FindPreviewApplicableHandlers DESCRIPTION : See FindApplicableHandlers However, this function only examines classes rather than instances for implicit slot-accessors INPUTS : 1) The class address 2) The message name symbol RETURNS : The links of applicable handlers, NULL on errors SIDE EFFECTS : Links are allocated for the list NOTES : None ******************************************************************/ globle HANDLER_LINK *FindPreviewApplicableHandlers( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname) { register int i; HANDLER_LINK *tops[4],*bots[4]; for (i = MAROUND ; i <= MAFTER ; i++) tops[i] = bots[i] = NULL; for (i = 0 ; i < cls->allSuperclasses.classCount ; i++) FindApplicableOfName(theEnv,cls->allSuperclasses.classArray[i],tops,bots,mname); return(JoinHandlerLinks(theEnv,tops,bots,mname)); } /*********************************************************** NAME : WatchMessage DESCRIPTION : Prints a condensed description of a message and its arguments INPUTS : 1) The output logical name 2) BEGIN_TRACE or END_TRACE string RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the global variables ProcParamArray and CurrentMessageName ***********************************************************/ globle void WatchMessage( void *theEnv, const char *logName, const char *tstring) { EnvPrintRouter(theEnv,logName,"MSG "); EnvPrintRouter(theEnv,logName,tstring); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,ValueToString(MessageHandlerData(theEnv)->CurrentMessageName)); EnvPrintRouter(theEnv,logName," ED:"); PrintLongInteger(theEnv,logName,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,logName); } /*********************************************************** NAME : WatchHandler DESCRIPTION : Prints a condensed description of a message-handler and its arguments INPUTS : 1) The output logical name 2) The handler address 3) BEGIN_TRACE or END_TRACE string RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the global variables ProcParamArray and CurrentMessageName ***********************************************************/ globle void WatchHandler( void *theEnv, const char *logName, HANDLER_LINK *hndl, const char *tstring) { HANDLER *hnd; EnvPrintRouter(theEnv,logName,"HND "); EnvPrintRouter(theEnv,logName,tstring); EnvPrintRouter(theEnv,logName," "); hnd = hndl->hnd; PrintHandler(theEnv,WTRACE,hnd,TRUE); EnvPrintRouter(theEnv,logName," ED:"); PrintLongInteger(theEnv,logName,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,logName); } #endif /* DEBUGGING_FUNCTIONS */ /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /******************************************************************** NAME : DisplayPrimaryCore DESCRIPTION : Gives a schematic "printout" of the primary message showing other shadowed primaries This routine uses recursion to print indentation to indicate shadowing and where handlers begin and end execution wrt one another. INPUTS : 1) The logical name of the output 2) The remaining core 3) The number of handlers this (partial) core shadows RETURNS : The address of the handler following the primary group of handlers in the core SIDE EFFECTS : None NOTES : Expects that the core was created in PREVIEW mode, i.e. implicit handlers are SLOT_DESC addresses (in PERFORM mode they are INSTANCE_SLOT addresses) Assumes (partial) core is not empty ********************************************************************/ static HANDLER_LINK *DisplayPrimaryCore( void *theEnv, const char *logicalName, HANDLER_LINK *core, int pdepth) { register HANDLER_LINK *rtn; PrintPreviewHandler(theEnv,logicalName,core,pdepth,BEGIN_TRACE); if ((core->nxt != NULL) ? (core->nxt->hnd->type == MPRIMARY) : FALSE) rtn = DisplayPrimaryCore(theEnv,logicalName,core->nxt,pdepth+1); else rtn = core->nxt; PrintPreviewHandler(theEnv,logicalName,core,pdepth,END_TRACE); return(rtn); } /*************************************************** NAME : PrintPreviewHandler DESCRIPTION : Displays a message preview INPUTS : 1) The logical name of the output 2) Handler-link 3) Number of handlers shadowed 4) The trace-string RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintPreviewHandler( void *theEnv, const char *logicalName, HANDLER_LINK *cptr, int sdepth, const char *tstr) { register int i; for (i = 0 ; i < sdepth ; i++) EnvPrintRouter(theEnv,logicalName,"| "); EnvPrintRouter(theEnv,logicalName,tstr); EnvPrintRouter(theEnv,logicalName," "); PrintHandler(theEnv,logicalName,cptr->hnd,TRUE); } #endif #endif clips_core_source_630/core/._inspsr.h0000755000175000017500000000040712373756335016154 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._exprnbin.c0000755000175000017500000000040712373740005016441 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/objcmp.c0000755000175000017500000016355012374023214015657 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Object System Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added environment parameter to GenClose. */ /* */ /* 6.30: Changed integer type/precision. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added support for path name argument to */ /* constructs-to-c. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && CONSTRUCT_COMPILER && (! RUN_TIME) #include "conscomp.h" #include "classcom.h" #include "classfun.h" #include "classini.h" #include "cstrncmp.h" #include "envrnmnt.h" #include "objrtfnx.h" #include "sysdep.h" #define _OBJCMP_SOURCE_ #include "objcmp.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MODULEI 0 #define CLASSI 1 #define LINKI 2 #define SLOTI 3 #define TSLOTI 4 #define OSLOTI 5 #define HANDLERI 6 #define OHANDLERI 7 #define SAVE_ITEMS 8 /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define ClassPrefix() ConstructPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem) #define ClassLinkPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,2) #define SlotPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,3) #define TemplateSlotPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,4) #define OrderedSlotPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,5) #define HandlerPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,6) #define OrderedHandlerPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,7) #define SlotNamePrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,8) #define SlotNameHashPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,9) #define ClassHashPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,10) #define ClassIDPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,11) #define MaxClassIDPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,12) typedef struct { long classCount; unsigned short currentPartition; unsigned short slotCount; int maxIndices; } MARK_INFO; typedef union { struct { unsigned thePartition : 16; unsigned theOffset : 16; } theLocation; long theLong; } PACKED_LOCATION_INFO; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyObjectsForCode(void *); static void MarkDefclassAndSlots(void *,struct constructHeader *,void *); static void PrintSlotNameReference(void *,FILE *,SLOT_NAME *,int,int); static void InitObjectsCode(void *,FILE *,int,int); static int ObjectsToCode(void *,const char *,const char *,char *,int,FILE *,int,int); static int ClassIDMapToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int *); static int ClassHashTableToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int *); static int SlotNameHashTableToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int *); static int SlotNameEntriesToCode(void *,const char *,const char *,char *,int,FILE *,int,int,int *); static void CloseObjectFiles(void *,FILE *[SAVE_ITEMS],int [SAVE_ITEMS], struct CodeGeneratorFile [SAVE_ITEMS],int); static void DefclassModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDefclassToCode(void *,FILE *,int,int,DEFCLASS *,int, int,int,int,int,int,int, int,int,int,int,int,int); static intBool InheritanceLinksToCode(void *,FILE **,const char *,const char *,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool SlotsToCode(void *,FILE **,const char *,const char *,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool TemplateSlotsToCode(void *,FILE **,const char *,const char *,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool OrderedSlotsToCode(void *,FILE **,const char *,const char *,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool HandlersToCode(void *,FILE **,const char *,const char *,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool OrderedHandlersToCode(void *,FILE **,const char *,const char *,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupObjectsCompiler DESCRIPTION : Initializes the construct compiler item for defclasses & handlers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupObjectsCompiler( void *theEnv) { AllocateEnvironmentData(theEnv,OBJECT_COMPILER_DATA,sizeof(struct objectCompilerData),NULL); ObjectCompilerData(theEnv)->ObjectCodeItem = AddCodeGeneratorItem(theEnv,"objects",0,ReadyObjectsForCode, InitObjectsCode,ObjectsToCode,13); } /********************************************************* NAME : PrintClassReference DESCRIPTION : Writes out a reference to the class array INPUTS : 1) Output file pointer 2) Class address 3) Construct set image id 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Writes out class array reference to file NOTES : None *********************************************************/ globle void PrintClassReference( void *theEnv, FILE *fp, DEFCLASS *cls, int imageID, int maxIndices) { if (cls == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]", ClassPrefix(), imageID, (int) ((cls->header.bsaveID / maxIndices) + 1), (int) (cls->header.bsaveID % maxIndices)); } /**************************************************** NAME : DefclassCModuleReference DESCRIPTION : Prints out a reference to a defclass module INPUTS : 1) The output file 2) The id of the module item 3) The id of the image 4) The maximum number of elements allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Defclass module reference printed NOTES : None ****************************************************/ globle void DefclassCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(ObjectCompilerData(theEnv)->ObjectCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : ReadyObjectsForCode DESCRIPTION : Sets index of classes and slot name entries for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None *******************************************************/ static void ReadyObjectsForCode( void *theEnv) { MARK_INFO markInfo; register long i; register int j; SLOT_NAME *snp; markInfo.classCount = 0L; markInfo.currentPartition = 1; markInfo.slotCount = 0; /* ===================================== Gets the value of MaxIndices directly from the global in CONSCOMP.C ===================================== */ markInfo.maxIndices = ConstructCompilerData(theEnv)->MaxIndices; DoForAllConstructs(theEnv,MarkDefclassAndSlots,DefclassData(theEnv)->DefclassModuleIndex, FALSE,(void *) &markInfo); i = 0L; for (j = 0 ; j < SLOT_NAME_TABLE_HASH_SIZE ; j++) for (snp = DefclassData(theEnv)->SlotNameTable[j] ; snp != NULL ; snp = snp->nxt) snp->bsaveIndex = i++; } /************************************************************ NAME : MarkDefclassAndSlots DESCRIPTION : Sets the bsave indices of the classes for use in printing references to them later. Also, the partitions and offsets are predetermined for every slot and packed into a single long (the slot bsave index) for use in printing references to them later INPUTS : 1) The defclass 2) A buffer containing the info: a) Total number of classes counted so far b) The current partition # for slots c) The current offset in that partition d) The max # of elements in any array RETURNS : Nothing useful SIDE EFFECTS : Bsave indices of classes and slots set NOTES : The template slots are written at the same time as the real slots - thus the references must be predetermined ************************************************************/ static void MarkDefclassAndSlots( void *theEnv, struct constructHeader *vTheDefclass, void *vTheBuffer) { DEFCLASS *theDefclass = (DEFCLASS *) vTheDefclass; MARK_INFO *markInfo = (MARK_INFO *) vTheBuffer; long i; PACKED_LOCATION_INFO theLocationInfo; #if MAC_XCD #pragma unused(theEnv) #endif theDefclass->header.bsaveID = markInfo->classCount++; for (i = 0 ; i < theDefclass->slotCount ; i++) { theLocationInfo.theLocation.thePartition = markInfo->currentPartition; theLocationInfo.theLocation.theOffset = markInfo->slotCount; theDefclass->slots[i].bsaveIndex = theLocationInfo.theLong; markInfo->slotCount++; if (markInfo->slotCount >= markInfo->maxIndices) { markInfo->currentPartition++; markInfo->slotCount = 0; } } } /************************************************************* NAME : PrintSlotNameReference DESCRIPTION : Writes out a reference to the slot name array INPUTS : 1) Output file pointer 2) Slot name address 3) Construct set image id 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Writes out slot name array reference to file NOTES : None *************************************************************/ static void PrintSlotNameReference( void *theEnv, FILE *fp, SLOT_NAME *snp, int imageID, int maxIndices) { if (snp == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]", SlotNamePrefix(), imageID, (int) ((snp->bsaveIndex / maxIndices) + 1), (int) (snp->bsaveIndex % maxIndices)); } /******************************************************* NAME : InitObjectsCode DESCRIPTION : Writes out initialization code for generic functions INPUTS : 1) The initialization code file pointer 2) The construct set image id 3) The max number of indices allowed in an array for this construct set RETURNS : Nothing useful SIDE EFFECTS : Writes out initialization code NOTES : None *******************************************************/ static void InitObjectsCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_XCD #pragma unused(maxIndices) #endif fprintf(initFP," ObjectsRunTimeInitialize(theEnv,%s%d_1,%s%d_1,%s%d_1,%s%d);\n", ClassHashPrefix(),imageID,SlotNameHashPrefix(),imageID, ClassIDPrefix(),imageID,MaxClassIDPrefix(),imageID); } /************************************************************* NAME : ObjectsToCode DESCRIPTION : Writes out static array code for classes, message-handlers, and associated structures INPUTS : 1) The base name of the construct set 2) The base id for this construct 3) The file pointer for the header file 4) The base id for the construct set 5) The max number of indices allowed in an array RETURNS : -1 if no classes, 0 on errors, 1 if object system structures written SIDE EFFECTS : Code written to files NOTES : None *************************************************************/ static int ObjectsToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFCLASS *theDefclass; register int i; int moduleCount = 0; int itemArrayCounts[SAVE_ITEMS]; int itemArrayVersions[SAVE_ITEMS]; FILE *itemFiles[SAVE_ITEMS]; int itemReopenFlags[SAVE_ITEMS]; struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS]; for (i = 0 ; i < SAVE_ITEMS ; i++) { itemArrayCounts[i] = 0; itemArrayVersions[i] = 1; itemFiles[i] = NULL; itemReopenFlags[i] = FALSE; itemCodeFiles[i].filePrefix = NULL; itemCodeFiles[i].pathName = pathName; itemCodeFiles[i].fileNameBuffer = fileNameBuffer; } fprintf(headerFP,"#include \"classcom.h\"\n"); fprintf(headerFP,"#include \"classini.h\"\n"); if (ClassIDMapToCode(theEnv,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); if (ClassHashTableToCode(theEnv,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); if (SlotNameHashTableToCode(theEnv,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); if (SlotNameEntriesToCode(theEnv,fileName,pathName,fileNameBuffer,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); /* ============================================================= Loop through all the modules and all the defclasses writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); itemFiles[MODULEI] = OpenFileIfNeeded(theEnv,itemFiles[MODULEI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, itemArrayVersions[MODULEI],headerFP, "DEFCLASS_MODULE",ModulePrefix(ObjectCompilerData(theEnv)->ObjectCodeItem), itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); if (itemFiles[MODULEI] == NULL) goto ObjectCodeError; DefclassModuleToCode(theEnv,itemFiles[MODULEI],theModule,imageID,maxIndices); itemFiles[MODULEI] = CloseFileIfNeeded(theEnv,itemFiles[MODULEI],&itemArrayCounts[MODULEI], &itemArrayVersions[MODULEI],maxIndices, &itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; theDefclass != NULL ; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) theDefclass)) { itemFiles[CLASSI] = OpenFileIfNeeded(theEnv,itemFiles[CLASSI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount, itemArrayVersions[CLASSI],headerFP, "DEFCLASS",ClassPrefix(), itemReopenFlags[CLASSI],&itemCodeFiles[CLASSI]); if (itemFiles[CLASSI] == NULL) goto ObjectCodeError; SingleDefclassToCode(theEnv,itemFiles[CLASSI],imageID,maxIndices, theDefclass,moduleCount, itemArrayVersions[LINKI],itemArrayCounts[LINKI], itemArrayVersions[SLOTI],itemArrayCounts[SLOTI], itemArrayVersions[TSLOTI],itemArrayCounts[TSLOTI], itemArrayVersions[OSLOTI],itemArrayCounts[OSLOTI], itemArrayVersions[HANDLERI],itemArrayCounts[HANDLERI], itemArrayVersions[OHANDLERI],itemArrayCounts[OHANDLERI]); itemArrayCounts[CLASSI]++; itemFiles[CLASSI] = CloseFileIfNeeded(theEnv,itemFiles[CLASSI],&itemArrayCounts[CLASSI], &itemArrayVersions[CLASSI],maxIndices, &itemReopenFlags[CLASSI],&itemCodeFiles[CLASSI]); if (InheritanceLinksToCode(theEnv,&itemFiles[LINKI],fileName,pathName,fileNameBuffer,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[LINKI],&itemArrayCounts[LINKI], &itemReopenFlags[LINKI],&itemCodeFiles[LINKI]) == FALSE) goto ObjectCodeError; if (SlotsToCode(theEnv,&itemFiles[SLOTI],fileName,pathName,fileNameBuffer,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[SLOTI],&itemArrayCounts[SLOTI], &itemReopenFlags[SLOTI],&itemCodeFiles[SLOTI]) == FALSE) goto ObjectCodeError; if (TemplateSlotsToCode(theEnv,&itemFiles[TSLOTI],fileName,pathName,fileNameBuffer,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[TSLOTI],&itemArrayCounts[TSLOTI], &itemReopenFlags[TSLOTI],&itemCodeFiles[TSLOTI]) == FALSE) goto ObjectCodeError; if (OrderedSlotsToCode(theEnv,&itemFiles[OSLOTI],fileName,pathName,fileNameBuffer,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[OSLOTI],&itemArrayCounts[OSLOTI], &itemReopenFlags[OSLOTI],&itemCodeFiles[OSLOTI]) == FALSE) goto ObjectCodeError; if (HandlersToCode(theEnv,&itemFiles[HANDLERI],fileName,pathName,fileNameBuffer,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[HANDLERI],&itemArrayCounts[HANDLERI], &itemReopenFlags[HANDLERI],&itemCodeFiles[HANDLERI]) == FALSE) goto ObjectCodeError; if (OrderedHandlersToCode(theEnv,&itemFiles[OHANDLERI],fileName,pathName,fileNameBuffer,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[OHANDLERI],&itemArrayCounts[OHANDLERI], &itemReopenFlags[OHANDLERI],&itemCodeFiles[OHANDLERI]) == FALSE) goto ObjectCodeError; } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; itemArrayCounts[MODULEI]++; } CloseObjectFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(1); ObjectCodeError: CloseObjectFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(0); } /************************************************************ NAME : ClassIDMapToCode DESCRIPTION : Writes out class id map INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's file count buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Class ID Map and Max Indices Written NOTES : None ***********************************************************/ static int ClassIDMapToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *classIDMapFile = NULL; int classIDMapArrayCount, classIDMapArrayVersion = 1; classIDMapFile = OpenFileIfNeeded(theEnv,classIDMapFile,fileName,pathName,fileNameBuffer,fileID,imageID,fileCount, classIDMapArrayVersion,headerFP, "DEFCLASS *",ClassIDPrefix(),FALSE,NULL); if (classIDMapFile == NULL) return(FALSE); for (classIDMapArrayCount = 0 ; classIDMapArrayCount < DefclassData(theEnv)->MaxClassID ; classIDMapArrayCount++) { if (classIDMapArrayCount > 0) fprintf(classIDMapFile,",\n"); PrintClassReference(theEnv,classIDMapFile,DefclassData(theEnv)->ClassIDMap[classIDMapArrayCount], imageID,maxIndices); } fprintf(classIDMapFile,"};\n\n"); fprintf(classIDMapFile,"unsigned %s%d = %u;\n", MaxClassIDPrefix(),imageID,(unsigned) DefclassData(theEnv)->MaxClassID); fprintf(headerFP,"extern unsigned %s%d;\n",MaxClassIDPrefix(),imageID); GenClose(theEnv,classIDMapFile); return(TRUE); } /************************************************************ NAME : ClassHashTableToCode DESCRIPTION : Writes out class hash table INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's file count buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Class Hash Table Written NOTES : None ***********************************************************/ static int ClassHashTableToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *classHashFile = NULL; int classHashArrayCount, classHashArrayVersion = 1; classHashFile = OpenFileIfNeeded(theEnv,classHashFile,fileName,pathName,fileNameBuffer,fileID,imageID,fileCount, classHashArrayVersion,headerFP, "DEFCLASS *",ClassHashPrefix(),FALSE,NULL); if (classHashFile == NULL) return(FALSE); for (classHashArrayCount = 0 ; classHashArrayCount < CLASS_TABLE_HASH_SIZE ; classHashArrayCount++) { if (classHashArrayCount > 0) fprintf(classHashFile,",\n"); PrintClassReference(theEnv,classHashFile,DefclassData(theEnv)->ClassTable[classHashArrayCount], imageID,maxIndices); } CloseFileIfNeeded(theEnv,classHashFile,&classHashArrayCount, &classHashArrayVersion,classHashArrayCount,NULL,NULL); return(TRUE); } /************************************************************ NAME : SlotNameHashTableToCode DESCRIPTION : Writes out slot name entry hash table INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's version number buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot Name Hash Table Written NOTES : None ***********************************************************/ static int SlotNameHashTableToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *slotNameHashFile = NULL; int slotNameHashArrayCount, slotNameHashArrayVersion = 1; slotNameHashFile = OpenFileIfNeeded(theEnv,slotNameHashFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, slotNameHashArrayVersion,headerFP, "SLOT_NAME *",SlotNameHashPrefix(),FALSE,NULL); if (slotNameHashFile == NULL) return(FALSE); for (slotNameHashArrayCount = 0 ; slotNameHashArrayCount < SLOT_NAME_TABLE_HASH_SIZE ; slotNameHashArrayCount++) { if (slotNameHashArrayCount > 0) fprintf(slotNameHashFile,",\n"); PrintSlotNameReference(theEnv,slotNameHashFile,DefclassData(theEnv)->SlotNameTable[slotNameHashArrayCount], imageID,maxIndices); } CloseFileIfNeeded(theEnv,slotNameHashFile,&slotNameHashArrayCount, &slotNameHashArrayVersion,slotNameHashArrayCount, NULL,NULL); return(TRUE); } /************************************************************ NAME : SlotNameEntriesToCode DESCRIPTION : Writes out slot name entries INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's version number buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot name entries Written NOTES : None ***********************************************************/ static int SlotNameEntriesToCode( void *theEnv, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *slotNameFile = NULL; int slotNameArrayCount = 0, slotNameArrayVersion = 1; SLOT_NAME *snp; register unsigned i; for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) { for (snp = DefclassData(theEnv)->SlotNameTable[i] ; snp != NULL ; snp = snp->nxt) { slotNameFile = OpenFileIfNeeded(theEnv,slotNameFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, slotNameArrayVersion,headerFP, "SLOT_NAME",SlotNamePrefix(),FALSE,NULL); if (slotNameFile == NULL) return(FALSE); fprintf(slotNameFile,"{ %u,1,%d,",snp->hashTableIndex,snp->id); PrintSymbolReference(theEnv,slotNameFile,snp->name); fprintf(slotNameFile,","); PrintSymbolReference(theEnv,slotNameFile,snp->putHandlerName); fprintf(slotNameFile,","); PrintSlotNameReference(theEnv,slotNameFile,snp->nxt,imageID,maxIndices); fprintf(slotNameFile,",0L }"); slotNameArrayCount++; slotNameFile = CloseFileIfNeeded(theEnv,slotNameFile,&slotNameArrayCount, &slotNameArrayVersion,maxIndices,NULL,NULL); } } if (slotNameFile != NULL) CloseFileIfNeeded(theEnv,slotNameFile,&slotNameArrayCount, &slotNameArrayVersion,slotNameArrayCount,NULL,NULL); return(TRUE); } /****************************************************** NAME : CloseObjectFiles DESCRIPTION : Closes construct compiler files for defclass structures INPUTS : 1) An array containing all the pertinent file pointers 2) An array containing all the pertinent file reopen flags 3) An array containing all the pertinent file name/id/version info 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None *****************************************************/ static void CloseObjectFiles( void *theEnv, FILE *itemFiles[SAVE_ITEMS], int itemReopenFlags[SAVE_ITEMS], struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS], int maxIndices) { int count = maxIndices; int arrayVersion = 0; register int i; for (i = 0 ; i < SAVE_ITEMS ; i++) { count = maxIndices; itemFiles[i] = CloseFileIfNeeded(theEnv,itemFiles[i],&count,&arrayVersion, maxIndices,&itemReopenFlags[i], &itemCodeFiles[i]); } } /*************************************************** NAME : DefclassModuleToCode DESCRIPTION : Writes out the C values for a defclass module item INPUTS : 1) The output file 2) The module for the defclasses 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Defclass module item written NOTES : None ***************************************************/ static void DefclassModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefclassData(theEnv)->DefclassModuleIndex,ClassPrefix()); fprintf(theFile,"}"); } /**************************************************************** NAME : SingleDefclassToCode DESCRIPTION : Writes out a single defclass's data to the file INPUTS : 1) The output file 2) The compile image id 3) The maximum number of elements in an array 4) The defclass 5) The module index 6) The partition holding the defclass inheritance links 7) The relative index of the inheritance links in the partition 8) The partition holding the defclass slots 9) The relative index of the slots in the partition 10) The partition holding the defclass template slots 11) The relative index of the template slots in the partition 12) The partition holding the defclass ordered slot map 13) The relative index of the ordered slot map in the partition 14) The partition holding the defclass message-handlers 15) The relative index of the message-handlers in the partition 16) The partition holding the defclass ordered handler map 17) The relative index of the ordered handler map in the partition RETURNS : Nothing useful SIDE EFFECTS : Defclass data written NOTES : None ***************************************************************/ static void SingleDefclassToCode( void *theEnv, FILE *theFile, int imageID, int maxIndices, DEFCLASS *theDefclass, int moduleCount, int classLinkArrayVersion, int classLinkArrayCount, int slotArrayVersion, int slotArrayCount, int templateSlotArrayVersion, int templateSlotArrayCount, int orderedSlotArrayVersion, int orderedSlotArrayCount, int handlerArrayVersion, int handlerArrayCount, int orderedHandlerArrayVersion, int orderedHandlerArrayCount) { /* ================== Defclass Header ================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefclass->header,imageID,maxIndices,moduleCount, ModulePrefix(ObjectCompilerData(theEnv)->ObjectCodeItem),ClassPrefix()); /* ========================= Defclass specific data ========================= */ fprintf(theFile,",1,%u,%u,%u,0,0,%u,0,%u,\n ", theDefclass->system,theDefclass->abstract, theDefclass->reactive,(unsigned) theDefclass->id, theDefclass->hashTableIndex); if (theDefclass->directSuperclasses.classCount > 0) fprintf(theFile,"{ %u,&%s%d_%d[%d] },", (unsigned) theDefclass->directSuperclasses.classCount, ClassLinkPrefix(), imageID,classLinkArrayVersion,classLinkArrayCount); else fprintf(theFile,"{ 0,NULL },"); classLinkArrayCount += theDefclass->directSuperclasses.classCount; if (theDefclass->directSubclasses.classCount > 0) fprintf(theFile,"{ %u,&%s%d_%d[%d] },", (unsigned) theDefclass->directSubclasses.classCount, ClassLinkPrefix(), imageID,classLinkArrayVersion,classLinkArrayCount); else fprintf(theFile,"{ 0,NULL },"); classLinkArrayCount += theDefclass->directSubclasses.classCount; if (theDefclass->allSuperclasses.classCount > 0) fprintf(theFile,"{ %u,&%s%d_%d[%d] },", (unsigned) theDefclass->allSuperclasses.classCount, ClassLinkPrefix(), imageID,classLinkArrayVersion,classLinkArrayCount); else fprintf(theFile,"{ 0,NULL },\n "); if (theDefclass->slots != NULL) fprintf(theFile,"&%s%d_%d[%d],", SlotPrefix(),imageID, slotArrayVersion,slotArrayCount); else fprintf(theFile,"NULL,"); if (theDefclass->instanceTemplate != NULL) fprintf(theFile,"&%s%d_%d[%d],", TemplateSlotPrefix(),imageID, templateSlotArrayVersion,templateSlotArrayCount); else fprintf(theFile,"NULL,"); if (theDefclass->slotNameMap != NULL) fprintf(theFile,"&%s%d_%d[%d],", OrderedSlotPrefix(),imageID, orderedSlotArrayVersion,orderedSlotArrayCount); else fprintf(theFile,"NULL,"); fprintf(theFile,"%hd,%hd,%hd,%hd,NULL,NULL,\n ", theDefclass->slotCount,theDefclass->localInstanceSlotCount, theDefclass->instanceSlotCount,theDefclass->maxSlotNameID); if (theDefclass->handlers != NULL) fprintf(theFile,"&%s%d_%d[%d],", HandlerPrefix(),imageID, handlerArrayVersion,handlerArrayCount); else fprintf(theFile,"NULL,"); if (theDefclass->handlerOrderMap != NULL) fprintf(theFile,"&%s%d_%d[%d],", OrderedHandlerPrefix(),imageID, orderedHandlerArrayVersion,orderedHandlerArrayCount); else fprintf(theFile,"NULL,"); fprintf(theFile,"%hd,",theDefclass->handlerCount); PrintClassReference(theEnv,theFile,theDefclass->nxtHash,imageID,maxIndices); fprintf(theFile,","); PrintBitMapReference(theEnv,theFile,theDefclass->scopeMap); fprintf(theFile,",\"\"}"); } /*********************************************************** NAME : InheritanceLinksToCode DESCRIPTION : Prints out superclass/subclass inheritance links - all links for a particular class are guaranteed to be in the same array partition INPUTS : 1) A buffer for the inheritance links file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the links partition # 10) A buffer holding the links relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Inheritance links written NOTES : None ***********************************************************/ static intBool InheritanceLinksToCode( void *theEnv, FILE **classLinkFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *classLinkArrayVersion, int *classLinkArrayCount, int *reopenClassLinkFile, struct CodeGeneratorFile *classLinkCodeFile) { long i; int inheritanceLinkCount, linkPrinted = FALSE; inheritanceLinkCount = theDefclass->directSuperclasses.classCount + theDefclass->directSubclasses.classCount + theDefclass->allSuperclasses.classCount; if (inheritanceLinkCount == 0) return(TRUE); *classLinkFile = OpenFileIfNeeded(theEnv,*classLinkFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, *classLinkArrayVersion,headerFP, "DEFCLASS *",ClassLinkPrefix(), *reopenClassLinkFile,classLinkCodeFile); if (*classLinkFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->directSuperclasses.classCount ; i++) { if (linkPrinted) fprintf(*classLinkFile,","); PrintClassReference(theEnv,*classLinkFile, theDefclass->directSuperclasses.classArray[i], imageID,maxIndices); linkPrinted = TRUE; } for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++) { if (linkPrinted) fprintf(*classLinkFile,","); PrintClassReference(theEnv,*classLinkFile, theDefclass->directSubclasses.classArray[i], imageID,maxIndices); linkPrinted = TRUE; } for (i = 0 ; i < theDefclass->allSuperclasses.classCount ; i++) { if (linkPrinted) fprintf(*classLinkFile,","); PrintClassReference(theEnv,*classLinkFile, theDefclass->allSuperclasses.classArray[i], imageID,maxIndices); linkPrinted = TRUE; } *classLinkArrayCount += inheritanceLinkCount; *classLinkFile = CloseFileIfNeeded(theEnv,*classLinkFile,classLinkArrayCount, classLinkArrayVersion,maxIndices, reopenClassLinkFile,classLinkCodeFile); return(TRUE); } /*********************************************************** NAME : SlotsToCode DESCRIPTION : Prints out slots - all slots for a particular class are guaranteed to be in the same array partition INPUTS : 1) A buffer for the slots file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the slots partition # 10) A buffer holding the slots relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slots written NOTES : None ***********************************************************/ static intBool SlotsToCode( void *theEnv, FILE **slotFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *slotArrayVersion, int *slotArrayCount, int *reopenSlotFile, struct CodeGeneratorFile *slotCodeFile) { long i; SLOT_DESC *sd; EXPRESSION *tmpexp; PACKED_LOCATION_INFO theLocationInfo; if (theDefclass->slotCount == 0) return(TRUE); *slotFile = OpenFileIfNeeded(theEnv,*slotFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, *slotArrayVersion,headerFP, "SLOT_DESC",SlotPrefix(), *reopenSlotFile,slotCodeFile); if (*slotFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->slotCount ; i++) { sd = &theDefclass->slots[i]; if (i > 0) fprintf(*slotFile,",\n"); fprintf(*slotFile,"{ %u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,", sd->shared,sd->multiple, sd->composite,sd->noInherit, sd->noWrite,sd->initializeOnly, sd->dynamicDefault,sd->defaultSpecified, sd->noDefault,sd->reactive, sd->publicVisibility,sd->createReadAccessor, sd->createWriteAccessor,sd->overrideMessageSpecified); PrintClassReference(theEnv,*slotFile,sd->cls,imageID,maxIndices); fprintf(*slotFile,","); PrintSlotNameReference(theEnv,*slotFile,sd->slotName,imageID,maxIndices); fprintf(*slotFile,",\n "); PrintSymbolReference(theEnv,*slotFile,sd->overrideMessage); if (sd->defaultValue != NULL) { fprintf(*slotFile,",(void *) "); if (sd->dynamicDefault) ExpressionToCode(theEnv,*slotFile,(EXPRESSION *) sd->defaultValue); else { tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) sd->defaultValue); ExpressionToCode(theEnv,*slotFile,tmpexp); ReturnExpression(theEnv,tmpexp); } } else fprintf(*slotFile,",NULL"); fprintf(*slotFile,","); PrintConstraintReference(theEnv,*slotFile,sd->constraint,imageID,maxIndices); fprintf(*slotFile,",0,0L,"); if (sd->shared) { theLocationInfo.theLong = sd->sharedValue.desc->bsaveIndex; fprintf(*slotFile,"{ &%s%d_%u[%u],0,0,0,NULL } }", SlotPrefix(),imageID, theLocationInfo.theLocation.thePartition, theLocationInfo.theLocation.theOffset); } else fprintf(*slotFile,"{ NULL,0,0,0,NULL } }"); } *slotArrayCount += (int) theDefclass->slotCount; *slotFile = CloseFileIfNeeded(theEnv,*slotFile,slotArrayCount, slotArrayVersion,maxIndices, reopenSlotFile,slotCodeFile); return(TRUE); } /************************************************************* NAME : TemplateSlotsToCode DESCRIPTION : Prints out instance template - the entire instance slot template for a particular class is guaranteed to be in the same array partition INPUTS : 1) A buffer for the template file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the template partition # 10) A buffer holding the template relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Templates written NOTES : None *************************************************************/ static intBool TemplateSlotsToCode( void *theEnv, FILE **templateSlotFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *templateSlotArrayVersion, int *templateSlotArrayCount, int *reopenTemplateSlotFile, struct CodeGeneratorFile *templateSlotCodeFile) { long i; SLOT_DESC *sd; PACKED_LOCATION_INFO theLocationInfo; if (theDefclass->instanceSlotCount == 0) return(TRUE); *templateSlotFile = OpenFileIfNeeded(theEnv,*templateSlotFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, *templateSlotArrayVersion,headerFP, "SLOT_DESC *",TemplateSlotPrefix(), *reopenTemplateSlotFile,templateSlotCodeFile); if (*templateSlotFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->instanceSlotCount ; i++) { sd = theDefclass->instanceTemplate[i]; if (i > 0) fprintf(*templateSlotFile,","); theLocationInfo.theLong = sd->bsaveIndex; fprintf(*templateSlotFile,"&%s%d_%u[%u]", SlotPrefix(),imageID, theLocationInfo.theLocation.thePartition, theLocationInfo.theLocation.theOffset); } *templateSlotArrayCount += (int) theDefclass->instanceSlotCount; *templateSlotFile = CloseFileIfNeeded(theEnv,*templateSlotFile,templateSlotArrayCount, templateSlotArrayVersion,maxIndices, reopenTemplateSlotFile,templateSlotCodeFile); return(TRUE); } /************************************************************* NAME : OrderedSlotsToCode DESCRIPTION : Prints out slot name map - the entire slot name map for a particular class is guaranteed to be in the same array partition INPUTS : 1) A buffer for the slot map file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the slot map partition # 10) A buffer holding the slot map relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot maps written NOTES : None *************************************************************/ static intBool OrderedSlotsToCode( void *theEnv, FILE **orderedSlotFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *orderedSlotArrayVersion, int *orderedSlotArrayCount, int *reopenOrderedSlotFile, struct CodeGeneratorFile *orderedSlotCodeFile) { long i; if (theDefclass->instanceSlotCount == 0) return(TRUE); *orderedSlotFile = OpenFileIfNeeded(theEnv,*orderedSlotFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, *orderedSlotArrayVersion,headerFP, "unsigned",OrderedSlotPrefix(), *reopenOrderedSlotFile,orderedSlotCodeFile); if (*orderedSlotFile == NULL) return(FALSE); for (i = 0 ; i <= theDefclass->maxSlotNameID ; i++) { if (i > 0) fprintf(*orderedSlotFile,","); fprintf(*orderedSlotFile,"%u",theDefclass->slotNameMap[i]); } *orderedSlotArrayCount += (int) theDefclass->maxSlotNameID + 1; *orderedSlotFile = CloseFileIfNeeded(theEnv,*orderedSlotFile,orderedSlotArrayCount, orderedSlotArrayVersion,maxIndices, reopenOrderedSlotFile,orderedSlotCodeFile); return(TRUE); } /************************************************************* NAME : HandlersToCode DESCRIPTION : Prints out message-handlers - all message-handlers for a particular class are guaranteed to be in the same array partition INPUTS : 1) A buffer for the handler file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the handler partition # 10) A buffer holding the handler relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handlers written NOTES : None *************************************************************/ static intBool HandlersToCode( void *theEnv, FILE **handlerFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *handlerArrayVersion, int *handlerArrayCount, int *reopenHandlerFile, struct CodeGeneratorFile *handlerCodeFile) { long i; HANDLER *hnd; if (theDefclass->handlerCount == 0) return(TRUE); *handlerFile = OpenFileIfNeeded(theEnv,*handlerFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, *handlerArrayVersion,headerFP, "HANDLER",HandlerPrefix(),*reopenHandlerFile, handlerCodeFile); if (*handlerFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->handlerCount ; i++) { if (i > 0) fprintf(*handlerFile,",\n"); hnd = &theDefclass->handlers[i]; fprintf(*handlerFile,"{ %u,%u,0,0,0,",hnd->system,hnd->type); PrintSymbolReference(theEnv,*handlerFile,hnd->name); fprintf(*handlerFile,","); PrintClassReference(theEnv,*handlerFile,hnd->cls,imageID,maxIndices); fprintf(*handlerFile,",%hd,%hd,%hd,",hnd->minParams,hnd->maxParams, hnd->localVarCount); ExpressionToCode(theEnv,*handlerFile,hnd->actions); fprintf(*handlerFile,",NULL }"); } *handlerArrayCount += (int) theDefclass->handlerCount; *handlerFile = CloseFileIfNeeded(theEnv,*handlerFile,handlerArrayCount, handlerArrayVersion,maxIndices, reopenHandlerFile,handlerCodeFile); return(TRUE); } /**************************************************************** NAME : OrderedHandlersToCode DESCRIPTION : Prints out handler map - the entire handler map for a particular class is guaranteed to be in the same array partition INPUTS : 1) A buffer for the handler map file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the handler map partition # 10) A buffer holding the handler map relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler maps written NOTES : None ****************************************************************/ static intBool OrderedHandlersToCode( void *theEnv, FILE **orderedHandlerFile, const char *fileName, const char *pathName, char *fileNameBuffer, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *orderedHandlerArrayVersion, int *orderedHandlerArrayCount, int *reopenOrderedHandlerFile, struct CodeGeneratorFile *orderedHandlerCodeFile) { long i; if (theDefclass->handlerCount == 0) return(TRUE); *orderedHandlerFile = OpenFileIfNeeded(theEnv,*orderedHandlerFile,fileName,pathName,fileNameBuffer,fileID, imageID,fileCount, *orderedHandlerArrayVersion,headerFP, "unsigned",OrderedHandlerPrefix(), *reopenOrderedHandlerFile, orderedHandlerCodeFile); if (*orderedHandlerFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->handlerCount ; i++) { if (i > 0) fprintf(*orderedHandlerFile,","); fprintf(*orderedHandlerFile,"%u",theDefclass->handlerOrderMap[i]); } *orderedHandlerArrayCount += (int) theDefclass->handlerCount; *orderedHandlerFile = CloseFileIfNeeded(theEnv,*orderedHandlerFile,orderedHandlerArrayCount, orderedHandlerArrayVersion,maxIndices, reopenOrderedHandlerFile, orderedHandlerCodeFile); return(TRUE); } #endif clips_core_source_630/core/._multifld.c0000755000175000017500000000040712374717750016450 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._agenda.h0000755000175000017500000000040712424473432016044 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._setup.h0000755000175000017500000000040712502204704015754 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._objrtcmp.c0000755000175000017500000000040712374023171016433 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._bsave.h0000755000175000017500000000040712373706572015734 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/cstrnutl.c0000755000175000017500000005122712462771770016277 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for manipulating, initializing, */ /* creating, copying, and comparing constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* 6.30: Support for long long integers. */ /* */ /*************************************************************/ #define _CSTRNUTL_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "extnfunc.h" #include "scanner.h" #include "multifld.h" #include "argacces.h" #include "cstrnutl.h" /************************************************/ /* GetConstraintRecord: Creates and initializes */ /* the values of a constraint record. */ /************************************************/ globle struct constraintRecord *GetConstraintRecord( void *theEnv) { CONSTRAINT_RECORD *constraints; unsigned i; constraints = get_struct(theEnv,constraintRecord); for (i = 0 ; i < sizeof(CONSTRAINT_RECORD) ; i++) { ((char *) constraints)[i] = '\0'; } SetAnyAllowedFlags(constraints,TRUE); constraints->multifieldsAllowed = FALSE; constraints->singlefieldsAllowed = TRUE; constraints->anyRestriction = FALSE; constraints->symbolRestriction = FALSE; constraints->stringRestriction = FALSE; constraints->floatRestriction = FALSE; constraints->integerRestriction = FALSE; constraints->classRestriction = FALSE; constraints->instanceNameRestriction = FALSE; constraints->classList = NULL; constraints->restrictionList = NULL; constraints->minValue = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->NegativeInfinity); constraints->maxValue = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity); constraints->minFields = GenConstant(theEnv,INTEGER,SymbolData(theEnv)->Zero); constraints->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity); constraints->bucket = -1; constraints->count = 0; constraints->multifield = NULL; constraints->next = NULL; return(constraints); } /********************************************************/ /* SetAnyAllowedFlags: Sets the allowed type flags of a */ /* constraint record to allow all types. If passed an */ /* argument of TRUE, just the "any allowed" flag is */ /* set to TRUE. If passed an argument of FALSE, then */ /* all of the individual type flags are set to TRUE. */ /********************************************************/ globle void SetAnyAllowedFlags( CONSTRAINT_RECORD *theConstraint, int justOne) { int flag1, flag2; if (justOne) { flag1 = TRUE; flag2 = FALSE; } else { flag1 = FALSE; flag2 = TRUE; } theConstraint->anyAllowed = flag1; theConstraint->symbolsAllowed = flag2; theConstraint->stringsAllowed = flag2; theConstraint->floatsAllowed = flag2; theConstraint->integersAllowed = flag2; theConstraint->instanceNamesAllowed = flag2; theConstraint->instanceAddressesAllowed = flag2; theConstraint->externalAddressesAllowed = flag2; theConstraint->voidAllowed = flag2; theConstraint->factAddressesAllowed = flag2; } /*****************************************************/ /* CopyConstraintRecord: Copies a constraint record. */ /*****************************************************/ globle struct constraintRecord *CopyConstraintRecord( void *theEnv, CONSTRAINT_RECORD *sourceConstraint) { CONSTRAINT_RECORD *theConstraint; if (sourceConstraint == NULL) return(NULL); theConstraint = get_struct(theEnv,constraintRecord); theConstraint->anyAllowed = sourceConstraint->anyAllowed; theConstraint->symbolsAllowed = sourceConstraint->symbolsAllowed; theConstraint->stringsAllowed = sourceConstraint->stringsAllowed; theConstraint->floatsAllowed = sourceConstraint->floatsAllowed; theConstraint->integersAllowed = sourceConstraint->integersAllowed; theConstraint->instanceNamesAllowed = sourceConstraint->instanceNamesAllowed; theConstraint->instanceAddressesAllowed = sourceConstraint->instanceAddressesAllowed; theConstraint->externalAddressesAllowed = sourceConstraint->externalAddressesAllowed; theConstraint->voidAllowed = sourceConstraint->voidAllowed; theConstraint->multifieldsAllowed = sourceConstraint->multifieldsAllowed; theConstraint->singlefieldsAllowed = sourceConstraint->singlefieldsAllowed; theConstraint->factAddressesAllowed = sourceConstraint->factAddressesAllowed; theConstraint->anyRestriction = sourceConstraint->anyRestriction; theConstraint->symbolRestriction = sourceConstraint->symbolRestriction; theConstraint->stringRestriction = sourceConstraint->stringRestriction; theConstraint->floatRestriction = sourceConstraint->floatRestriction; theConstraint->integerRestriction = sourceConstraint->integerRestriction; theConstraint->classRestriction = sourceConstraint->classRestriction; theConstraint->instanceNameRestriction = sourceConstraint->instanceNameRestriction; theConstraint->classList = CopyExpression(theEnv,sourceConstraint->classList); theConstraint->restrictionList = CopyExpression(theEnv,sourceConstraint->restrictionList); theConstraint->minValue = CopyExpression(theEnv,sourceConstraint->minValue); theConstraint->maxValue = CopyExpression(theEnv,sourceConstraint->maxValue); theConstraint->minFields = CopyExpression(theEnv,sourceConstraint->minFields); theConstraint->maxFields = CopyExpression(theEnv,sourceConstraint->maxFields); theConstraint->bucket = -1; theConstraint->count = 0; theConstraint->multifield = CopyConstraintRecord(theEnv,sourceConstraint->multifield); theConstraint->next = NULL; return(theConstraint); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************************/ /* SetAnyRestrictionFlags: Sets the restriction type flags of */ /* a constraint record to indicate there are restriction on */ /* all types. If passed an argument of TRUE, just the */ /* "any restriction" flag is set to TRUE. If passed an */ /* argument of FALSE, then all of the individual type */ /* restriction flags are set to TRUE. */ /**************************************************************/ globle void SetAnyRestrictionFlags( CONSTRAINT_RECORD *theConstraint, int justOne) { int flag1, flag2; if (justOne) { flag1 = TRUE; flag2 = FALSE; } else { flag1 = FALSE; flag2 = TRUE; } theConstraint->anyRestriction = flag1; theConstraint->symbolRestriction = flag2; theConstraint->stringRestriction = flag2; theConstraint->floatRestriction = flag2; theConstraint->integerRestriction = flag2; theConstraint->instanceNameRestriction = flag2; } /*****************************************************/ /* SetConstraintType: Given a constraint type and a */ /* constraint, sets the allowed type flags for the */ /* specified type in the constraint to TRUE. */ /*****************************************************/ globle int SetConstraintType( int theType, CONSTRAINT_RECORD *constraints) { int rv = TRUE; switch(theType) { case UNKNOWN_VALUE: rv = constraints->anyAllowed; constraints->anyAllowed = TRUE; break; case SYMBOL: rv = constraints->symbolsAllowed; constraints->symbolsAllowed = TRUE; break; case STRING: rv = constraints->stringsAllowed; constraints->stringsAllowed = TRUE; break; case SYMBOL_OR_STRING: rv = (constraints->stringsAllowed | constraints->symbolsAllowed); constraints->symbolsAllowed = TRUE; constraints->stringsAllowed = TRUE; break; case INTEGER: rv = constraints->integersAllowed; constraints->integersAllowed = TRUE; break; case FLOAT: rv = constraints->floatsAllowed; constraints->floatsAllowed = TRUE; break; case INTEGER_OR_FLOAT: rv = (constraints->integersAllowed | constraints->floatsAllowed); constraints->integersAllowed = TRUE; constraints->floatsAllowed = TRUE; break; case INSTANCE_ADDRESS: rv = constraints->instanceAddressesAllowed; constraints->instanceAddressesAllowed = TRUE; break; case INSTANCE_NAME: rv = constraints->instanceNamesAllowed; constraints->instanceNamesAllowed = TRUE; break; case INSTANCE_OR_INSTANCE_NAME: rv = (constraints->instanceNamesAllowed | constraints->instanceAddressesAllowed); constraints->instanceNamesAllowed = TRUE; constraints->instanceAddressesAllowed = TRUE; break; case EXTERNAL_ADDRESS: rv = constraints->externalAddressesAllowed; constraints->externalAddressesAllowed = TRUE; break; case RVOID: rv = constraints->voidAllowed; constraints->voidAllowed = TRUE; break; case FACT_ADDRESS: rv = constraints->factAddressesAllowed; constraints->factAddressesAllowed = TRUE; break; case MULTIFIELD: rv = constraints->multifieldsAllowed; constraints->multifieldsAllowed = TRUE; break; } if (theType != UNKNOWN_VALUE) constraints->anyAllowed = FALSE; return(rv); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /*************************************************************/ /* CompareNumbers: Given two numbers (which can be integers, */ /* floats, or the symbols for positive/negative infinity) */ /* returns the relationship between the numbers (greater */ /* than, less than or equal). */ /*************************************************************/ globle int CompareNumbers( void *theEnv, int type1, void *vptr1, int type2, void *vptr2) { /*============================================*/ /* Handle the situation in which the values */ /* are exactly equal (same type, same value). */ /*============================================*/ if (vptr1 == vptr2) return(EQUAL); /*=======================================*/ /* Handle the special cases for positive */ /* and negative infinity. */ /*=======================================*/ if (vptr1 == SymbolData(theEnv)->PositiveInfinity) return(GREATER_THAN); if (vptr1 == SymbolData(theEnv)->NegativeInfinity) return(LESS_THAN); if (vptr2 == SymbolData(theEnv)->PositiveInfinity) return(LESS_THAN); if (vptr2 == SymbolData(theEnv)->NegativeInfinity) return(GREATER_THAN); /*=======================*/ /* Compare two integers. */ /*=======================*/ if ((type1 == INTEGER) && (type2 == INTEGER)) { if (ValueToLong(vptr1) < ValueToLong(vptr2)) { return(LESS_THAN); } else if (ValueToLong(vptr1) > ValueToLong(vptr2)) { return(GREATER_THAN); } return(EQUAL); } /*=====================*/ /* Compare two floats. */ /*=====================*/ if ((type1 == FLOAT) && (type2 == FLOAT)) { if (ValueToDouble(vptr1) < ValueToDouble(vptr2)) { return(LESS_THAN); } else if (ValueToDouble(vptr1) > ValueToDouble(vptr2)) { return(GREATER_THAN); } return(EQUAL); } /*================================*/ /* Compare an integer to a float. */ /*================================*/ if ((type1 == INTEGER) && (type2 == FLOAT)) { if (((double) ValueToLong(vptr1)) < ValueToDouble(vptr2)) { return(LESS_THAN); } else if (((double) ValueToLong(vptr1)) > ValueToDouble(vptr2)) { return(GREATER_THAN); } return(EQUAL); } /*================================*/ /* Compare a float to an integer. */ /*================================*/ if ((type1 == FLOAT) && (type2 == INTEGER)) { if (ValueToDouble(vptr1) < ((double) ValueToLong(vptr2))) { return(LESS_THAN); } else if (ValueToDouble(vptr1) > ((double) ValueToLong(vptr2))) { return(GREATER_THAN); } return(EQUAL); } /*===================================*/ /* One of the arguments was invalid. */ /* Return -1 to indicate an error. */ /*===================================*/ return(-1); } /****************************************************************/ /* ExpressionToConstraintRecord: Converts an expression into a */ /* constraint record. For example, an expression representing */ /* the symbol BLUE would be converted to a record with */ /* allowed types SYMBOL and allow-values BLUE. */ /****************************************************************/ globle CONSTRAINT_RECORD *ExpressionToConstraintRecord( void *theEnv, struct expr *theExpression) { CONSTRAINT_RECORD *rv; /*================================================*/ /* A NULL expression is converted to a constraint */ /* record with no values allowed. */ /*================================================*/ if (theExpression == NULL) { rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; return(rv); } /*=============================================================*/ /* Convert variables and function calls to constraint records. */ /*=============================================================*/ if ((theExpression->type == SF_VARIABLE) || (theExpression->type == MF_VARIABLE) || #if DEFGENERIC_CONSTRUCT (theExpression->type == GCALL) || #endif #if DEFFUNCTION_CONSTRUCT (theExpression->type == PCALL) || #endif (theExpression->type == GBL_VARIABLE) || (theExpression->type == MF_GBL_VARIABLE)) { rv = GetConstraintRecord(theEnv); rv->multifieldsAllowed = TRUE; return(rv); } else if (theExpression->type == FCALL) { return(FunctionCallToConstraintRecord(theEnv,theExpression->value)); } /*============================================*/ /* Convert a constant to a constraint record. */ /*============================================*/ rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; if (theExpression->type == FLOAT) { rv->floatRestriction = TRUE; rv->floatsAllowed = TRUE; } else if (theExpression->type == INTEGER) { rv->integerRestriction = TRUE; rv->integersAllowed = TRUE; } else if (theExpression->type == SYMBOL) { rv->symbolRestriction = TRUE; rv->symbolsAllowed = TRUE; } else if (theExpression->type == STRING) { rv->stringRestriction = TRUE; rv->stringsAllowed = TRUE; } else if (theExpression->type == INSTANCE_NAME) { rv->instanceNameRestriction = TRUE; rv->instanceNamesAllowed = TRUE; } else if (theExpression->type == INSTANCE_ADDRESS) { rv->instanceAddressesAllowed = TRUE; } if (rv->floatsAllowed || rv->integersAllowed || rv->symbolsAllowed || rv->stringsAllowed || rv->instanceNamesAllowed) { rv->restrictionList = GenConstant(theEnv,theExpression->type,theExpression->value); } return(rv); } /*******************************************************/ /* FunctionCallToConstraintRecord: Converts a function */ /* call to a constraint record. For example, the + */ /* function when converted would be a constraint */ /* record with allowed types INTEGER and FLOAT. */ /*******************************************************/ globle CONSTRAINT_RECORD *FunctionCallToConstraintRecord( void *theEnv, void *theFunction) { CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; switch ((char) ValueFunctionType(theFunction)) { case 'a': rv->externalAddressesAllowed = TRUE; break; case 'f': case 'd': rv->floatsAllowed = TRUE; break; case 'i': case 'g': case 'l': rv->integersAllowed = TRUE; break; case 'j': rv->instanceNamesAllowed = TRUE; rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; break; case 'k': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; break; case 'm': rv->singlefieldsAllowed = FALSE; rv->multifieldsAllowed = TRUE; break; case 'n': rv->floatsAllowed = TRUE; rv->integersAllowed = TRUE; break; case 'o': rv->instanceNamesAllowed = TRUE; break; case 's': rv->stringsAllowed = TRUE; break; case 'u': rv->anyAllowed = TRUE; rv->multifieldsAllowed = TRUE; break; case 'w': case 'c': case 'b': rv->symbolsAllowed = TRUE; break; case 'x': rv->instanceAddressesAllowed = TRUE; break; case 'y': rv->factAddressesAllowed = TRUE; break; case 'v': rv->voidAllowed = TRUE; break; } return(rv); } /*******************************************************/ /* ArgumentTypeToConstraintRecord: Converts one of the */ /* function argument types (used by DefineFunction2) */ /* to a constraint record. */ /*******************************************************/ globle CONSTRAINT_RECORD *ArgumentTypeToConstraintRecord( void *theEnv, int theRestriction) { CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; switch (theRestriction) { case 'a': rv->externalAddressesAllowed = TRUE; break; case 'e': rv->symbolsAllowed = TRUE; rv->instanceNamesAllowed = TRUE; rv->instanceAddressesAllowed = TRUE; break; case 'd': case 'f': rv->floatsAllowed = TRUE; break; case 'g': rv->integersAllowed = TRUE; rv->floatsAllowed = TRUE; rv->symbolsAllowed = TRUE; break; case 'h': rv->factAddressesAllowed = TRUE; rv->integersAllowed = TRUE; rv->symbolsAllowed = TRUE; rv->instanceNamesAllowed = TRUE; rv->instanceAddressesAllowed = TRUE; break; case 'i': case 'l': rv->integersAllowed = TRUE; break; case 'j': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; rv->instanceNamesAllowed = TRUE; break; case 'k': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; break; case 'm': rv->singlefieldsAllowed = FALSE; rv->multifieldsAllowed = TRUE; break; case 'n': rv->floatsAllowed = TRUE; rv->integersAllowed = TRUE; break; case 'o': rv->instanceNamesAllowed = TRUE; break; case 'p': rv->instanceNamesAllowed = TRUE; rv->symbolsAllowed = TRUE; break; case 'q': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; rv->multifieldsAllowed = TRUE; break; case 's': rv->stringsAllowed = TRUE; break; case 'w': rv->symbolsAllowed = TRUE; break; case 'x': rv->instanceAddressesAllowed = TRUE; break; case 'y': rv->factAddressesAllowed = TRUE; break; case 'z': rv->symbolsAllowed = TRUE; rv->factAddressesAllowed = TRUE; rv->integersAllowed = TRUE; break; case 'u': rv->anyAllowed = TRUE; rv->multifieldsAllowed = TRUE; break; case 'v': rv->voidAllowed = TRUE; break; } return(rv); } clips_core_source_630/core/._filecom.h0000755000175000017500000000040712373742633016250 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/dffctdef.c0000755000175000017500000002763512461251756016170 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFFACTS DEFINITION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic deffacts primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* deffacts data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _DFFCTDEF_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "dffctpsr.h" #include "dffctbsc.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "dffctbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dffctcmp.h" #endif #include "dffctdef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void ReturnDeffacts(void *,void *); static void InitializeDeffactsModules(void *); static void DeallocateDeffactsData(void *); #if ! RUN_TIME static void DestroyDeffactsAction(void *,struct constructHeader *,void *); #endif /***********************************************************/ /* InitializeDeffacts: Initializes the deffacts construct. */ /***********************************************************/ globle void InitializeDeffacts( void *theEnv) { AllocateEnvironmentData(theEnv,DEFFACTS_DATA,sizeof(struct deffactsData),DeallocateDeffactsData); InitializeDeffactsModules(theEnv); DeffactsBasicCommands(theEnv); DeffactsData(theEnv)->DeffactsConstruct = AddConstruct(theEnv,"deffacts","deffacts",ParseDeffacts,EnvFindDeffacts, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDeffacts,SetNextConstruct, EnvIsDeffactsDeletable,EnvUndeffacts,ReturnDeffacts); } /***************************************************/ /* DeallocateDeffactsData: Deallocates environment */ /* data for the deffacts construct. */ /***************************************************/ static void DeallocateDeffactsData( void *theEnv) { #if ! RUN_TIME struct deffactsModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDeffactsAction,DeffactsData(theEnv)->DeffactsModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct deffactsModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DeffactsData(theEnv)->DeffactsModuleIndex); rtn_struct(theEnv,deffactsModule,theModuleItem); } #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /*********************************************************/ /* DestroyDeffactsAction: Action used to remove deffacts */ /* as a result of DestroyEnvironment. */ /*********************************************************/ static void DestroyDeffactsAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffacts *theDeffacts = (struct deffacts *) theConstruct; if (theDeffacts == NULL) return; ReturnPackedExpression(theEnv,theDeffacts->assertList); DestroyConstructHeader(theEnv,&theDeffacts->header); rtn_struct(theEnv,deffacts,theDeffacts); #else #if MAC_XCD #pragma unused(theEnv,theConstruct) #endif #endif } #endif /*******************************************************/ /* InitializeDeffactsModules: Initializes the deffacts */ /* construct for use with the defmodule construct. */ /*******************************************************/ static void InitializeDeffactsModules( void *theEnv) { DeffactsData(theEnv)->DeffactsModuleIndex = RegisterModuleItem(theEnv,"deffacts", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDeffactsModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeffactsCModuleReference, #else NULL, #endif EnvFindDeffactsInModule); } /************************************************/ /* AllocateModule: Allocates a deffacts module. */ /************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,deffactsModule)); } /************************************************/ /* ReturnModule: Deallocates a deffacts module. */ /************************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeffactsData(theEnv)->DeffactsConstruct); rtn_struct(theEnv,deffactsModule,theItem); } /*************************************************************/ /* GetDeffactsModuleItem: Returns a pointer to the defmodule */ /* item for the specified deffacts or defmodule. */ /*************************************************************/ globle struct deffactsModule *GetDeffactsModuleItem( void *theEnv, struct defmodule *theModule) { return((struct deffactsModule *) GetConstructModuleItemByIndex(theEnv,theModule,DeffactsData(theEnv)->DeffactsModuleIndex)); } /**************************************************/ /* EnvFindDeffacts: Searches for a deffact in the */ /* list of deffacts. Returns a pointer to the */ /* deffact if found, otherwise NULL. */ /**************************************************/ globle void *EnvFindDeffacts( void *theEnv, const char *deffactsName) { return(FindNamedConstructInModuleOrImports(theEnv,deffactsName,DeffactsData(theEnv)->DeffactsConstruct)); } /**************************************************/ /* EnvFindDeffactsInModule: Searches for a deffact in the */ /* list of deffacts. Returns a pointer to the */ /* deffact if found, otherwise NULL. */ /**************************************************/ globle void *EnvFindDeffactsInModule( void *theEnv, const char *deffactsName) { return(FindNamedConstructInModule(theEnv,deffactsName,DeffactsData(theEnv)->DeffactsConstruct)); } /*********************************************************/ /* EnvGetNextDeffacts: If passed a NULL pointer, returns */ /* the first deffacts in the ListOfDeffacts. Otherwise */ /* returns the next deffacts following the deffacts */ /* passed as an argument. */ /*********************************************************/ globle void *EnvGetNextDeffacts( void *theEnv, void *deffactsPtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) deffactsPtr,DeffactsData(theEnv)->DeffactsModuleIndex)); } /********************************************************/ /* EnvIsDeffactsDeletable: Returns TRUE if a particular */ /* deffacts can be deleted, otherwise returns FALSE. */ /********************************************************/ globle intBool EnvIsDeffactsDeletable( void *theEnv, void *ptr) { #if MAC_XCD #pragma unused(ptr) #endif if (! ConstructsDeletable(theEnv)) { return FALSE; } if (ConstructData(theEnv)->ResetInProgress) return(FALSE); return(TRUE); } /***********************************************************/ /* ReturnDeffacts: Returns the data structures associated */ /* with a deffacts construct to the pool of free memory. */ /***********************************************************/ static void ReturnDeffacts( void *theEnv, void *vTheDeffacts) { #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffacts *theDeffacts = (struct deffacts *) vTheDeffacts; if (theDeffacts == NULL) return; ExpressionDeinstall(theEnv,theDeffacts->assertList); ReturnPackedExpression(theEnv,theDeffacts->assertList); DeinstallConstructHeader(theEnv,&theDeffacts->header); rtn_struct(theEnv,deffacts,theDeffacts); #endif } /*##################################*/ /* Additional Environment Functions */ /*##################################*/ globle const char *EnvDeffactsModule( void *theEnv, void *theDeffacts) { return GetConstructModuleName((struct constructHeader *) theDeffacts); } globle const char *EnvGetDeffactsName( void *theEnv, void *theDeffacts) { return GetConstructNameString((struct constructHeader *) theDeffacts); } globle const char *EnvGetDeffactsPPForm( void *theEnv, void *theDeffacts) { return GetConstructPPForm(theEnv,(struct constructHeader *) theDeffacts); } /*#####################################*/ /* ALLOW_ENVIRONMENT_GLOBALS Functions */ /*#####################################*/ #if ALLOW_ENVIRONMENT_GLOBALS globle void *FindDeffacts( const char *deffactsName) { return EnvFindDeffacts(GetCurrentEnvironment(),deffactsName); } globle void *GetNextDeffacts( void *deffactsPtr) { return EnvGetNextDeffacts(GetCurrentEnvironment(),deffactsPtr); } globle intBool IsDeffactsDeletable( void *ptr) { return EnvIsDeffactsDeletable(GetCurrentEnvironment(),ptr); } globle const char *DeffactsModule( void *theDeffacts) { return EnvDeffactsModule(GetCurrentEnvironment(),theDeffacts); } globle const char *GetDeffactsName( void *theDeffacts) { return EnvGetDeffactsName(GetCurrentEnvironment(),theDeffacts); } globle const char *GetDeffactsPPForm( void *theDeffacts) { return EnvGetDeffactsPPForm(GetCurrentEnvironment(),theDeffacts); } #endif #endif /* DEFFACTS_CONSTRUCT */ clips_core_source_630/core/engine.h0000755000175000017500000002251712464554105015664 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 02/04/15 */ /* */ /* ENGINE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality primarily associated with */ /* the run and focus commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* and LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added access functions to the HaltRules flag. */ /* */ /* Added EnvGetNextFocus, EnvGetFocusChanged, and */ /* EnvSetFocusChanged functions. */ /* */ /* 6.30: Added additional developer statistics to help */ /* analyze join network performance. */ /* */ /* Removed pseudo-facts used in not CEs. */ /* */ /* Added context information for run functions. */ /* */ /* Added before rule firing callback function. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Changed integer type/precision. */ /* */ /* Added EnvHalt function. */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_engine #define _H_engine #ifndef _H_lgcldpnd #include "lgcldpnd.h" #endif #ifndef _H_ruledef #include "ruledef.h" #endif #ifndef _H_network #include "network.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_retract #include "retract.h" #endif struct focus { struct defmodule *theModule; struct defruleModule *theDefruleModule; struct focus *next; }; #define ENGINE_DATA 18 struct engineData { struct defrule *ExecutingRule; intBool HaltRules; struct joinNode *TheLogicalJoin; struct partialMatch *TheLogicalBind; struct dependency *UnsupportedDataEntities; int alreadyEntered; struct callFunctionItem *ListOfRunFunctions; struct callFunctionItemWithArg *ListOfBeforeRunFunctions; struct focus *CurrentFocus; int FocusChanged; #if DEBUGGING_FUNCTIONS unsigned WatchStatistics; unsigned WatchFocus; #endif intBool IncrementalResetInProgress; intBool IncrementalResetFlag; intBool JoinOperationInProgress; struct partialMatch *GlobalLHSBinds; struct partialMatch *GlobalRHSBinds; struct joinNode *GlobalJoin; struct partialMatch *GarbagePartialMatches; struct alphaMatch *GarbageAlphaMatches; int AlreadyRunning; #if DEVELOPER long leftToRightComparisons; long rightToLeftComparisons; long leftToRightSucceeds; long rightToLeftSucceeds; long leftToRightLoops; long rightToLeftLoops; long findNextConflictingComparisons; long betaHashHTSkips; long betaHashListSkips; long unneededMarkerCompare; #endif }; #define EngineData(theEnv) ((struct engineData *) GetEnvironmentData(theEnv,ENGINE_DATA)) #define MAX_PATTERNS_CHECKED 64 #ifdef LOCALE #undef LOCALE #endif #ifdef _ENGINE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE long long EnvRun(void *,long long); LOCALE intBool EnvAddRunFunction(void *,const char *, void (*)(void *),int); LOCALE intBool EnvAddRunFunctionWithContext(void *,const char *, void (*)(void *),int,void *); LOCALE intBool EnvRemoveRunFunction(void *,const char *); LOCALE intBool EnvAddBeforeRunFunction(void *,const char *, void (*)(void *,void *),int); LOCALE intBool EnvAddBeforeRunFunctionWithContext(void *,const char *, void (*)(void *, void *),int,void *); LOCALE intBool EnvRemoveBeforeRunFunction(void *,const char *); LOCALE void InitializeEngine(void *); LOCALE void EnvSetBreak(void *,void *); LOCALE void EnvHalt(void *); LOCALE intBool EnvRemoveBreak(void *,void *); LOCALE void RemoveAllBreakpoints(void *); LOCALE void EnvShowBreaks(void *,const char *,void *); LOCALE intBool EnvDefruleHasBreakpoint(void *,void *); LOCALE void RunCommand(void *); LOCALE void SetBreakCommand(void *); LOCALE void RemoveBreakCommand(void *); LOCALE void ShowBreaksCommand(void *); LOCALE void HaltCommand(void *); LOCALE int FocusCommand(void *); LOCALE void ClearFocusStackCommand(void *); LOCALE void EnvClearFocusStack(void *); LOCALE void *EnvGetNextFocus(void *,void *); LOCALE void EnvFocus(void *,void *); LOCALE int EnvGetFocusChanged(void *); LOCALE void EnvSetFocusChanged(void *,int); LOCALE void ListFocusStackCommand(void *); LOCALE void EnvListFocusStack(void *,const char *); LOCALE void GetFocusStackFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetFocusStack(void *,DATA_OBJECT_PTR); LOCALE void *PopFocusFunction(void *); LOCALE void *GetFocusFunction(void *); LOCALE void *EnvPopFocus(void *); LOCALE void *EnvGetFocus(void *); LOCALE intBool EnvGetHaltRules(void *); LOCALE void EnvSetHaltRules(void *,intBool); LOCALE struct activation *NextActivationToFire(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool AddBeforeRunFunction(const char *,void (*)(void *),int); LOCALE intBool AddRunFunction(const char *,void (*)(void),int); LOCALE void ClearFocusStack(void); LOCALE void Focus(void *); LOCALE void GetFocusStack(DATA_OBJECT_PTR); LOCALE void *GetFocus(void); LOCALE int GetFocusChanged(void); LOCALE void *GetNextFocus(void *); LOCALE void Halt(void); LOCALE void *PopFocus(void); LOCALE intBool RemoveRunFunction(const char *); LOCALE long long Run(long long); LOCALE void SetFocusChanged(int); #if DEBUGGING_FUNCTIONS LOCALE intBool DefruleHasBreakpoint(void *); LOCALE void ListFocusStack(const char *); LOCALE intBool RemoveBreak(void *); LOCALE void SetBreak(void *); LOCALE void ShowBreaks(const char *,void *); #endif #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_engine */ clips_core_source_630/core/cstrccmp.h0000755000175000017500000000326512373714472016240 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRUCT CONSTRUCTS-TO-C HEADER */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Support functions for the constructs-to-c of */ /* construct headers and related items. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed ANSI_COMPILER compilation flag. */ /* */ /*************************************************************/ #ifndef _H_cstrccmp #define _H_cstrccmp #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif LOCALE void MarkConstructHeaders(int); #endif /* _H_cstrccmp */ clips_core_source_630/core/._argacces.c0000755000175000017500000000040712424476360016373 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._factprt.h0000755000175000017500000000040712373742644016277 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/inscom.h0000755000175000017500000001672612424473406015714 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/22/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Loading a binary instance file from a run-time */ /* program caused a bus error. DR0866 */ /* */ /* Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_inscom #define _H_inscom #ifndef _H_object #include "object.h" #endif #ifndef _H_insfun #include "insfun.h" #endif #define INSTANCE_DATA 29 struct instanceData { INSTANCE_TYPE DummyInstance; INSTANCE_TYPE **InstanceTable; int MaintainGarbageInstances; int MkInsMsgPass; int ChangesToInstances; IGARBAGE *InstanceGarbageList; struct patternEntityRecord InstanceInfo; INSTANCE_TYPE *InstanceList; unsigned long GlobalNumberOfInstances; INSTANCE_TYPE *CurrentInstance; INSTANCE_TYPE *InstanceListBottom; intBool ObjectModDupMsgValid; }; #define InstanceData(theEnv) ((struct instanceData *) GetEnvironmentData(theEnv,INSTANCE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _INSCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupInstances(void *); LOCALE intBool EnvDeleteInstance(void *,void *); LOCALE intBool EnvUnmakeInstance(void *,void *); #if DEBUGGING_FUNCTIONS LOCALE void InstancesCommand(void *); LOCALE void PPInstanceCommand(void *); LOCALE void EnvInstances(void *,const char *,void *,const char *,int); #endif LOCALE void *EnvMakeInstance(void *,const char *); LOCALE void *EnvCreateRawInstance(void *,void *,const char *); LOCALE void *EnvFindInstance(void *,void *,const char *,unsigned); LOCALE int EnvValidInstanceAddress(void *,void *); LOCALE void EnvDirectGetSlot(void *,void *,const char *,DATA_OBJECT *); LOCALE int EnvDirectPutSlot(void *,void *,const char *,DATA_OBJECT *); LOCALE const char *EnvGetInstanceName(void *,void *); LOCALE void *EnvGetInstanceClass(void *,void *); LOCALE unsigned long GetGlobalNumberOfInstances(void *); LOCALE void *EnvGetNextInstance(void *,void *); LOCALE void *GetNextInstanceInScope(void *,void *); LOCALE void *EnvGetNextInstanceInClass(void *,void *,void *); LOCALE void *EnvGetNextInstanceInClassAndSubclasses(void *,void **,void *,DATA_OBJECT *); LOCALE void EnvGetInstancePPForm(void *,char *,size_t,void *); LOCALE void ClassCommand(void *,DATA_OBJECT *); LOCALE intBool DeleteInstanceCommand(void *); LOCALE intBool UnmakeInstanceCommand(void *); LOCALE void SymbolToInstanceName(void *,DATA_OBJECT *); LOCALE void *InstanceNameToSymbol(void *); LOCALE void InstanceAddressCommand(void *,DATA_OBJECT *); LOCALE void InstanceNameCommand(void *,DATA_OBJECT *); LOCALE intBool InstanceAddressPCommand(void *); LOCALE intBool InstanceNamePCommand(void *); LOCALE intBool InstancePCommand(void *); LOCALE intBool InstanceExistPCommand(void *); LOCALE intBool CreateInstanceHandler(void *); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE const char *GetInstanceName(void *); LOCALE void *CreateRawInstance(void *,const char *); LOCALE intBool DeleteInstance(void *); LOCALE void DirectGetSlot(void *,const char *,DATA_OBJECT *); LOCALE int DirectPutSlot(void *,const char *,DATA_OBJECT *); LOCALE void *FindInstance(void *,const char *,unsigned); LOCALE void *GetInstanceClass(void *); LOCALE void GetInstancePPForm(char *,unsigned,void *); LOCALE void *GetNextInstance(void *); LOCALE void *GetNextInstanceInClass(void *,void *); LOCALE void *GetNextInstanceInClassAndSubclasses(void **,void *,DATA_OBJECT *); LOCALE void Instances(const char *,void *,const char *,int); #if DEBUGGING_FUNCTIONS LOCALE void *MakeInstance(const char *); #endif LOCALE intBool UnmakeInstance(void *); LOCALE int ValidInstanceAddress(void *); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_inscom */ clips_core_source_630/core/._globldef.h0000755000175000017500000000040712461253173016402 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltrhs.c0000755000175000017500000000033012365012263016463 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._agenda.c0000755000175000017500000000040712424473433016040 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._genrcbin.h0000755000175000017500000000040712373753414016420 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/classexm.h0000755000175000017500000001327712373714264016244 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Dantes */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: The DescribeClass macros were incorrectly */ /* defined. DR0862 */ /* */ /* Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Added EnvSlotDefaultP function. */ /* */ /* Borland C (IBM_TBC) and Metrowerks CodeWarrior */ /* (MAC_MCW, IBM_MCW) are no longer supported. */ /* */ /* Used gensprintf and genstrcat instead of */ /* sprintf and strcat. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_classexm #define _H_classexm #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSEXM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if DEBUGGING_FUNCTIONS LOCALE void BrowseClassesCommand(void *); LOCALE void EnvBrowseClasses(void *,const char *,void *); LOCALE void DescribeClassCommand(void *); LOCALE void EnvDescribeClass(void *,const char *,void *); #endif /* DEBUGGING_FUNCTIONS */ LOCALE const char *GetCreateAccessorString(void *); LOCALE void *GetDefclassModuleCommand(void *); LOCALE intBool SuperclassPCommand(void *); LOCALE intBool EnvSuperclassP(void *,void *,void *); LOCALE intBool SubclassPCommand(void *); LOCALE intBool EnvSubclassP(void *,void *,void *); LOCALE int SlotExistPCommand(void *); LOCALE intBool EnvSlotExistP(void *,void *,const char *,intBool); LOCALE int MessageHandlerExistPCommand(void *); LOCALE intBool SlotWritablePCommand(void *); LOCALE intBool EnvSlotWritableP(void *,void *,const char *); LOCALE intBool SlotInitablePCommand(void *); LOCALE intBool EnvSlotInitableP(void *,void *,const char *); LOCALE intBool SlotPublicPCommand(void *); LOCALE intBool EnvSlotPublicP(void *,void *,const char *); LOCALE intBool SlotDirectAccessPCommand(void *); LOCALE intBool EnvSlotDirectAccessP(void *,void *,const char *); LOCALE void SlotDefaultValueCommand(void *,DATA_OBJECT_PTR); LOCALE intBool EnvSlotDefaultValue(void *,void *,const char *,DATA_OBJECT_PTR); LOCALE int ClassExistPCommand(void *); LOCALE int EnvSlotDefaultP(void *,void *,const char *); #if ALLOW_ENVIRONMENT_GLOBALS #if DEBUGGING_FUNCTIONS LOCALE void BrowseClasses(const char *,void *); LOCALE void DescribeClass(const char *,void *); #endif LOCALE intBool SlotDirectAccessP(void *,const char *); LOCALE intBool SlotExistP(void *,const char *,intBool); LOCALE intBool SlotInitableP(void *,const char *); LOCALE intBool SlotPublicP(void *,const char *); LOCALE int SlotDefaultP(void *,const char *); LOCALE intBool SlotWritableP(void *,const char *); LOCALE intBool SubclassP(void *,void *); LOCALE intBool SuperclassP(void *,void *); LOCALE intBool SlotDefaultValue(void *,const char *,DATA_OBJECT_PTR); #endif /* ALLOW_ENVIRONMENT_GLOBALS */ #endif /* _H_classexm */ clips_core_source_630/core/dffctpsr.c0000755000175000017500000001432112461253173016215 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* DEFFACTS PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses a deffacts construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* GetConstructNameAndComment API change. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Changed find construct functionality so that */ /* imported modules are search when locating a */ /* named construct. */ /* */ /*************************************************************/ #define _DFFCTPSR_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "cstrcpsr.h" #include "factrhs.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "dffctdef.h" #include "dffctbsc.h" #include "dffctpsr.h" /************************************************************/ /* ParseDeffacts: Coordinates all actions necessary for the */ /* addition of a deffacts construct into the current */ /* environment. Called when parsing a construct after the */ /* deffacts keyword has been found. */ /************************************************************/ globle int ParseDeffacts( void *theEnv, const char *readSource) { #if (! RUN_TIME) && (! BLOAD_ONLY) SYMBOL_HN *deffactsName; struct expr *temp; struct deffacts *newDeffacts; int deffactsError; struct token inputToken; /*=========================*/ /* Parsing initialization. */ /*=========================*/ deffactsError = FALSE; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(deffacts "); /*==========================================================*/ /* Deffacts can not be added when a binary image is loaded. */ /*==========================================================*/ #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"deffacts"); return(TRUE); } #endif /*============================*/ /* Parse the deffacts header. */ /*============================*/ deffactsName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deffacts", EnvFindDeffactsInModule,EnvUndeffacts,"$",TRUE, TRUE,TRUE,FALSE); if (deffactsName == NULL) { return(TRUE); } /*===============================================*/ /* Parse the list of facts in the deffacts body. */ /*===============================================*/ temp = BuildRHSAssert(theEnv,readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts"); if (deffactsError == TRUE) { return(TRUE); } if (ExpressionContainsVariables(temp,FALSE)) { LocalVariableErrorMessage(theEnv,"a deffacts construct"); ReturnExpression(theEnv,temp); return(TRUE); } SavePPBuffer(theEnv,"\n"); /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffacts to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,temp); return(FALSE); } /*==========================*/ /* Create the new deffacts. */ /*==========================*/ ExpressionInstall(theEnv,temp); newDeffacts = get_struct(theEnv,deffacts); newDeffacts->header.name = deffactsName; IncrementSymbolCount(deffactsName); newDeffacts->assertList = PackExpression(theEnv,temp); newDeffacts->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"deffacts")->moduleIndex); newDeffacts->header.next = NULL; newDeffacts->header.usrData = NULL; ReturnExpression(theEnv,temp); /*=======================================================*/ /* Save the pretty print representation of the deffacts. */ /*=======================================================*/ if (EnvGetConserveMemory(theEnv) == TRUE) { newDeffacts->header.ppForm = NULL; } else { newDeffacts->header.ppForm = CopyPPBuffer(theEnv); } /*=============================================*/ /* Add the deffacts to the appropriate module. */ /*=============================================*/ AddConstructToModule(&newDeffacts->header); #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /*================================================================*/ /* Return FALSE to indicate the deffacts was successfully parsed. */ /*================================================================*/ return(FALSE); } #endif /* DEFFACTS_CONSTRUCT */ clips_core_source_630/core/lgcldpnd.c0000755000175000017500000005663512373744002016205 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* LOGICAL DEPENDENCIES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provide support routines for managing truth */ /* maintenance using the logical conditional element. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /*************************************************************/ #define _LGCLDPND_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFRULE_CONSTRUCT #include "memalloc.h" #include "router.h" #include "envrnmnt.h" #include "evaluatn.h" #include "engine.h" #include "reteutil.h" #include "pattern.h" #include "argacces.h" #include "factmngr.h" #if OBJECT_SYSTEM #include "insfun.h" #endif #include "lgcldpnd.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct dependency *DetachAssociatedDependencies(void *,struct dependency *,void *); /***********************************************************************/ /* AddLogicalDependencies: Adds the logical dependency links between a */ /* data entity (such as a fact or instance) and the partial match */ /* which logically supports that data entity. If a data entity is */ /* unconditionally asserted (i.e. the global variable TheLogicalJoin */ /* is NULL), then existing logical support for the data entity is no */ /* longer needed and it is removed. If a data entity is already */ /* unconditionally supported and that data entity is conditionally */ /* asserted (i.e. the global variable TheLogicalJoin is not NULL), */ /* then the logical support is ignored. Otherwise, the partial match */ /* is linked to the data entity and the data entity is linked to the */ /* partial match. Note that the word assert is used to refer to */ /* creating a fact with the assert command and creating an instance */ /* with the make-instance command. */ /***********************************************************************/ globle intBool AddLogicalDependencies( void *theEnv, struct patternEntity *theEntity, int existingEntity) { struct partialMatch *theBinds; struct dependency *newDependency; /*==============================================*/ /* If the rule has no logical patterns, then no */ /* dependencies have to be established. */ /*==============================================*/ if (EngineData(theEnv)->TheLogicalJoin == NULL) { if (existingEntity) RemoveEntityDependencies(theEnv,theEntity); return(TRUE); } else if (existingEntity && (theEntity->dependents == NULL)) { return(TRUE); } /*===========================================================*/ /* Retrieve the partial match in the logical join associated */ /* with activation partial match (retrieved when the run */ /* command was initiated). If the partial match's parent */ /* links have been removed, then the partial match must have */ /* been deleted by a previous RHS action and the dependency */ /* link should not be added. */ /*===========================================================*/ theBinds = EngineData(theEnv)->TheLogicalBind; if (theBinds == NULL) return(FALSE); if ((theBinds->leftParent == NULL) && (theBinds->rightParent == NULL)) { return(FALSE); } /*==============================================================*/ /* Add a dependency link between the partial match and the data */ /* entity. The dependency links are stored in the partial match */ /* behind the data entities stored in the partial match and the */ /* activation link, if any. */ /*==============================================================*/ newDependency = get_struct(theEnv,dependency); newDependency->dPtr = (void *) theEntity; newDependency->next = (struct dependency *) theBinds->dependents; theBinds->dependents = (void *) newDependency; /*================================================================*/ /* Add a dependency link between the entity and the partialMatch. */ /*================================================================*/ newDependency = get_struct(theEnv,dependency); newDependency->dPtr = (void *) theBinds; newDependency->next = (struct dependency *) theEntity->dependents; theEntity->dependents = (void *) newDependency; /*==================================================================*/ /* Return TRUE to indicate that the data entity should be asserted. */ /*==================================================================*/ return(TRUE); } /************************************************************************/ /* FindLogicalBind: Finds the partial match associated with the logical */ /* CE which will provide logical support for a data entity asserted */ /* from the currently executing rule. The function is called when */ /* creating logical support links between the data entity and */ /* supporting partial matches. */ /************************************************************************/ globle struct partialMatch *FindLogicalBind( struct joinNode *theJoin, struct partialMatch *theBinds) { struct partialMatch *compPtr; /*========================================================*/ /* Follow the parent link of the activation back through */ /* the join network until the join containing the logical */ /* partial match is found. The partial match at this */ /* join will have the dependency link assigned to it. */ /*========================================================*/ for (compPtr = theBinds; compPtr != NULL; compPtr = compPtr->leftParent) { if (compPtr->owner == theJoin) { return(compPtr); } } return(NULL); } /*********************************************************************/ /* RemoveEntityDependencies: Removes all logical support links from */ /* a pattern entity that point to partial matches or other pattern */ /* entities. Also removes the associated links from the partial */ /* matches or pattern entities which point back to the pattern */ /* entities. */ /*********************************************************************/ globle void RemoveEntityDependencies( void *theEnv, struct patternEntity *theEntity) { struct dependency *fdPtr, *nextPtr, *theList; struct partialMatch *theBinds; /*===============================*/ /* Get the list of dependencies. */ /*===============================*/ fdPtr = (struct dependency *) theEntity->dependents; /*========================================*/ /* Loop through each of the dependencies. */ /*========================================*/ while (fdPtr != NULL) { /*===============================*/ /* Remember the next dependency. */ /*===============================*/ nextPtr = fdPtr->next; /*================================================================*/ /* Remove the link between the data entity and the partial match. */ /*================================================================*/ theBinds = (struct partialMatch *) fdPtr->dPtr; theList = (struct dependency *) theBinds->dependents; theList = DetachAssociatedDependencies(theEnv,theList,(void *) theEntity); theBinds->dependents = (void *) theList; /*========================*/ /* Return the dependency. */ /*========================*/ rtn_struct(theEnv,dependency,fdPtr); /*=================================*/ /* Move on to the next dependency. */ /*=================================*/ fdPtr = nextPtr; } /*=====================================================*/ /* Set the dependency list of the data entity to NULL. */ /*=====================================================*/ theEntity->dependents = NULL; } /********************************************************************/ /* ReturnEntityDependencies: Removes all logical support links from */ /* a pattern entity. This is unidirectional. The links from the */ /* the partial match to the entity are not removed. */ /********************************************************************/ globle void ReturnEntityDependencies( void *theEnv, struct patternEntity *theEntity) { struct dependency *fdPtr, *nextPtr; fdPtr = (struct dependency *) theEntity->dependents; while (fdPtr != NULL) { nextPtr = fdPtr->next; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } theEntity->dependents = NULL; } /*******************************************************************/ /* DetachAssociatedDependencies: Removes all logical support links */ /* which pointer to a pattern entity from a list of dependencies */ /* (which may be associated with either a partial match or */ /* another pattern entity). Does not remove links which point in */ /* the other direction. */ /*******************************************************************/ static struct dependency *DetachAssociatedDependencies( void *theEnv, struct dependency *theList, void *theEntity) { struct dependency *fdPtr, *nextPtr, *lastPtr = NULL; fdPtr = theList; while (fdPtr != NULL) { if (fdPtr->dPtr == theEntity) { nextPtr = fdPtr->next; if (lastPtr == NULL) theList = nextPtr; else lastPtr->next = nextPtr; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } else { lastPtr = fdPtr; fdPtr = fdPtr->next; } } return(theList); } /**************************************************************************/ /* RemovePMDependencies: Removes all logical support links from a partial */ /* match that point to any data entities. Also removes the associated */ /* links from the data entities which point back to the partial match. */ /**************************************************************************/ globle void RemovePMDependencies( void *theEnv, struct partialMatch *theBinds) { struct dependency *fdPtr, *nextPtr, *theList; struct patternEntity *theEntity; fdPtr = (struct dependency *) theBinds->dependents; while (fdPtr != NULL) { nextPtr = fdPtr->next; theEntity = (struct patternEntity *) fdPtr->dPtr; theList = (struct dependency *) theEntity->dependents; theList = DetachAssociatedDependencies(theEnv,theList,(void *) theBinds); theEntity->dependents = (void *) theList; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } theBinds->dependents = NULL; } /************************************************************/ /* DestroyPMDependencies: Removes all logical support links */ /* from a partial match that point to any data entities. */ /************************************************************/ globle void DestroyPMDependencies( void *theEnv, struct partialMatch *theBinds) { struct dependency *fdPtr, *nextPtr; fdPtr = (struct dependency *) theBinds->dependents; while (fdPtr != NULL) { nextPtr = fdPtr->next; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } theBinds->dependents = NULL; } /************************************************************************/ /* RemoveLogicalSupport: Removes the dependency links between a partial */ /* match and the data entities it logically supports. Also removes */ /* the associated links from the data entities which point back to */ /* the partial match by calling DetachAssociatedEntityDependencies. */ /* If an entity has all of its logical support removed as a result of */ /* this procedure, the dependency link from the partial match is */ /* added to the list of unsupported data entities so that the entity */ /* will be deleted as a result of losing its logical support. */ /************************************************************************/ globle void RemoveLogicalSupport( void *theEnv, struct partialMatch *theBinds) { struct dependency *dlPtr, *tempPtr, *theList; struct patternEntity *theEntity; /*========================================*/ /* If the partial match has no associated */ /* dependencies, then return. */ /*========================================*/ if (theBinds->dependents == NULL) return; /*=======================================*/ /* Loop through each of the dependencies */ /* attached to the partial match. */ /*=======================================*/ dlPtr = (struct dependency *) theBinds->dependents; while (dlPtr != NULL) { /*===============================*/ /* Remember the next dependency. */ /*===============================*/ tempPtr = dlPtr->next; /*==========================================================*/ /* Determine the data entity associated with the dependency */ /* structure and delete its dependency references to this */ /* partial match. */ /*==========================================================*/ theEntity = (struct patternEntity *) dlPtr->dPtr; theList = (struct dependency *) theEntity->dependents; theList = DetachAssociatedDependencies(theEnv,theList,(void *) theBinds); theEntity->dependents = (void *) theList; /*==============================================================*/ /* If the data entity has lost all of its logical support, then */ /* add the dependency structure from the partial match to the */ /* list of unsupported data entities to be deleted. Otherwise, */ /* just delete the dependency structure. */ /*==============================================================*/ if (theEntity->dependents == NULL) { (*theEntity->theInfo->base.incrementBusyCount)(theEnv,theEntity); dlPtr->next = EngineData(theEnv)->UnsupportedDataEntities; EngineData(theEnv)->UnsupportedDataEntities = dlPtr; } else { rtn_struct(theEnv,dependency,dlPtr); } /*==================================*/ /* Move on to the next dependency. */ /*==================================*/ dlPtr = tempPtr; } /*=====================================*/ /* The partial match no longer has any */ /* dependencies associated with it. */ /*=====================================*/ theBinds->dependents = NULL; } /********************************************************************/ /* ForceLogicalRetractions: Deletes the data entities found on the */ /* list of items that have lost their logical support. The delete */ /* function associated with each data entity is called to delete */ /* that data entity. Calling the delete function may in turn */ /* add more data entities to the list of data entities which have */ /* lost their logical support. */ /********************************************************************/ globle void ForceLogicalRetractions( void *theEnv) { struct dependency *tempPtr; struct patternEntity *theEntity; /*===================================================*/ /* Don't reenter this function once it's called. Any */ /* new additions to the list of items to be deleted */ /* as a result of losing their logical support will */ /* be handled properly. */ /*===================================================*/ if (EngineData(theEnv)->alreadyEntered) return; EngineData(theEnv)->alreadyEntered = TRUE; /*=======================================================*/ /* Continue to delete the first item on the list as long */ /* as one exists. This is done because new items may be */ /* placed at the beginning of the list as other data */ /* entities are deleted. */ /*=======================================================*/ while (EngineData(theEnv)->UnsupportedDataEntities != NULL) { /*==========================================*/ /* Determine the data entity to be deleted. */ /*==========================================*/ theEntity = (struct patternEntity *) EngineData(theEnv)->UnsupportedDataEntities->dPtr; /*================================================*/ /* Remove the dependency structure from the list. */ /*================================================*/ tempPtr = EngineData(theEnv)->UnsupportedDataEntities; EngineData(theEnv)->UnsupportedDataEntities = EngineData(theEnv)->UnsupportedDataEntities->next; rtn_struct(theEnv,dependency,tempPtr); /*=========================*/ /* Delete the data entity. */ /*=========================*/ (*theEntity->theInfo->base.decrementBusyCount)(theEnv,theEntity); (*theEntity->theInfo->base.deleteFunction)(theEnv,theEntity); } /*============================================*/ /* Deletion of items on the list is complete. */ /*============================================*/ EngineData(theEnv)->alreadyEntered = FALSE; } /****************************************************************/ /* Dependencies: C access routine for the dependencies command. */ /****************************************************************/ globle void Dependencies( void *theEnv, struct patternEntity *theEntity) { struct dependency *fdPtr; /*=========================================*/ /* If the data entity has no dependencies, */ /* then print "None" and return. */ /*=========================================*/ if (theEntity->dependents == NULL) { EnvPrintRouter(theEnv,WDISPLAY,"None\n"); return; } /*============================================*/ /* Loop through the list of the data entities */ /* dependencies and print them. */ /*============================================*/ for (fdPtr = (struct dependency *) theEntity->dependents; fdPtr != NULL; fdPtr = fdPtr->next) { if (GetHaltExecution(theEnv) == TRUE) return; PrintPartialMatch(theEnv,WDISPLAY,(struct partialMatch *) fdPtr->dPtr); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } /************************************************************/ /* Dependents: C access routine for the dependents command. */ /************************************************************/ globle void Dependents( void *theEnv, struct patternEntity *theEntity) { struct patternEntity *entityPtr = NULL; struct patternParser *theParser = NULL; struct dependency *fdPtr; struct partialMatch *theBinds; int found = FALSE; /*=================================*/ /* Loop through every data entity. */ /*=================================*/ for (GetNextPatternEntity(theEnv,&theParser,&entityPtr); entityPtr != NULL; GetNextPatternEntity(theEnv,&theParser,&entityPtr)) { if (GetHaltExecution(theEnv) == TRUE) return; /*====================================*/ /* Loop through every dependency link */ /* associated with the data entity. */ /*====================================*/ for (fdPtr = (struct dependency *) entityPtr->dependents; fdPtr != NULL; fdPtr = fdPtr->next) { if (GetHaltExecution(theEnv) == TRUE) return; /*=====================================================*/ /* If the data entity which was the argument passed to */ /* the dependents command is contained in one of the */ /* partial matches of the data entity currently being */ /* examined, then the data entity being examined is a */ /* dependent. Print the data entity and then move on */ /* to the next data entity. */ /*=====================================================*/ theBinds = (struct partialMatch *) fdPtr->dPtr; if (FindEntityInPartialMatch(theEntity,theBinds) == TRUE) { if (found) EnvPrintRouter(theEnv,WDISPLAY,","); (*entityPtr->theInfo->base.shortPrintFunction)(theEnv,WDISPLAY,entityPtr); found = TRUE; break; } } } /*=================================================*/ /* If no dependents were found, then print "None." */ /* Otherwise print a carriage return after the */ /* list of dependents. */ /*=================================================*/ if (! found) EnvPrintRouter(theEnv,WDISPLAY,"None\n"); else EnvPrintRouter(theEnv,WDISPLAY,"\n"); } #if DEBUGGING_FUNCTIONS /*********************************************/ /* DependenciesCommand: H/L access routine */ /* for the dependencies command. */ /*********************************************/ globle void DependenciesCommand( void *theEnv) { DATA_OBJECT item; void *ptr; if (EnvArgCountCheck(theEnv,"dependencies",EXACTLY,1) == -1) return; ptr = GetFactOrInstanceArgument(theEnv,1,&item,"dependencies"); if (ptr == NULL) return; #if DEFRULE_CONSTRUCT Dependencies(theEnv,(struct patternEntity *) ptr); #else EnvPrintRouter(theEnv,WDISPLAY,"None\n"); #endif } /*******************************************/ /* DependentsCommand: H/L access routine */ /* for the dependents command. */ /*******************************************/ globle void DependentsCommand( void *theEnv) { DATA_OBJECT item; void *ptr; if (EnvArgCountCheck(theEnv,"dependents",EXACTLY,1) == -1) return; ptr = GetFactOrInstanceArgument(theEnv,1,&item,"dependents"); if (ptr == NULL) return; #if DEFRULE_CONSTRUCT Dependents(theEnv,(struct patternEntity *) ptr); #else EnvPrintRouter(theEnv,WDISPLAY,"None\n"); #endif } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFRULE_CONSTRUCT */ clips_core_source_630/core/factprt.c0000755000175000017500000003636712373742646016075 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* FACT RETE PRINT FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Print routines for the fact rete primitives. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW, */ /* MAC_MCW, and IBM_TBC). */ /* */ /* Changed integer type/precision. */ /* */ /* Updates to support new struct members. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #define _FACTPRT_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "envrnmnt.h" #include "symbol.h" #include "router.h" #include "factgen.h" #include "factprt.h" /***************************************/ /* PrintFactJNCompVars1: Print routine */ /* for the FactJNCompVars1 function. */ /***************************************/ globle void PrintFactJNCompVars1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsJN1Call *hack; hack = (struct factCompVarsJN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-cmp-vars1 "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,"= "); else EnvPrintRouter(theEnv,logicalName,"<> "); EnvPrintRouter(theEnv,logicalName,"p"); PrintLongInteger(theEnv,logicalName,(long long) hack->pattern1 + 1); if (hack->p1lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->p1rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName," s"); PrintLongInteger(theEnv,logicalName,(long long) hack->slot1); EnvPrintRouter(theEnv,logicalName," p"); PrintLongInteger(theEnv,logicalName,(long long) hack->pattern2 + 1); if (hack->p2lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->p2rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName," s"); PrintLongInteger(theEnv,logicalName,(long long) hack->slot2); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactJNCompVars2: Print routine */ /* for the FactJNCompVars2 function. */ /***************************************/ globle void PrintFactJNCompVars2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsJN2Call *hack; hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-cmp-vars2 "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,"= "); else EnvPrintRouter(theEnv,logicalName,"<> "); EnvPrintRouter(theEnv,logicalName,"p"); PrintLongInteger(theEnv,logicalName,(long long) hack->pattern1 + 1); if (hack->p1lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->p1rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName," s"); PrintLongInteger(theEnv,logicalName,(long long) hack->slot1); if (hack->fromBeginning1) EnvPrintRouter(theEnv,logicalName, " b"); else EnvPrintRouter(theEnv,logicalName," e"); EnvPrintRouter(theEnv,logicalName," f"); PrintLongInteger(theEnv,logicalName,(long long) hack->offset1); EnvPrintRouter(theEnv,logicalName," p"); PrintLongInteger(theEnv,logicalName,(long long) hack->pattern2 + 1); if (hack->p2lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->p2rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName," s"); PrintLongInteger(theEnv,logicalName,(long long) hack->slot2); if (hack->fromBeginning2) EnvPrintRouter(theEnv,logicalName," b"); else EnvPrintRouter(theEnv,logicalName," e"); EnvPrintRouter(theEnv,logicalName," f"); PrintLongInteger(theEnv,logicalName,(long long) hack->offset2); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactPNCompVars1: Print routine */ /* for the FactPNCompVars1 function. */ /***************************************/ globle void PrintFactPNCompVars1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsPN1Call *hack; hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-cmp-vars "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,"p "); else EnvPrintRouter(theEnv,logicalName,"n "); PrintLongInteger(theEnv,logicalName,(long long) hack->field1); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->field2); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /**************************************/ /* PrintFactSlotLength: Print routine */ /* for the FactSlotLength function. */ /**************************************/ globle void PrintFactSlotLength( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factCheckLengthPNCall *hack; hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(slot-length "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName," "); if (hack->exactly) EnvPrintRouter(theEnv,logicalName,"= "); else EnvPrintRouter(theEnv,logicalName,">= "); PrintLongInteger(theEnv,logicalName,(long long) hack->minLength); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactJNGetVar1: Print routine */ /* for the FactJNGetvar1 function. */ /*************************************/ globle void PrintFactJNGetVar1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarJN1Call *hack; hack = (struct factGetVarJN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-1 "); if (hack->factAddress) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->allFields) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); EnvPrintRouter(theEnv,logicalName,"p"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern + 1); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichField); EnvPrintRouter(theEnv,logicalName," s"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); if (hack->lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactJNGetVar2: Print routine */ /* for the FactJNGetvar2 function. */ /*************************************/ globle void PrintFactJNGetVar2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarJN2Call *hack; hack = (struct factGetVarJN2Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-2"); EnvPrintRouter(theEnv,logicalName," p"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern + 1); EnvPrintRouter(theEnv,logicalName," s"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); if (hack->lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactJNGetVar3: Print routine */ /* for the FactJNGetVar3 function. */ /*************************************/ globle void PrintFactJNGetVar3( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarJN3Call *hack; hack = (struct factGetVarJN3Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-3 "); if (hack->fromBeginning) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->fromEnd) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); PrintLongInteger(theEnv,logicalName,(long long) hack->beginOffset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->endOffset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName," p"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern + 1); if (hack->lhs) { EnvPrintRouter(theEnv,logicalName," L"); } else if (hack->rhs) { EnvPrintRouter(theEnv,logicalName," R"); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactPNGetVar1: Print routine */ /* for the FactPNGetvar1 function. */ /*************************************/ globle void PrintFactPNGetVar1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarPN1Call *hack; hack = (struct factGetVarPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-getvar-1 "); if (hack->factAddress) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->allFields) EnvPrintRouter(theEnv,logicalName,"t F"); else EnvPrintRouter(theEnv,logicalName,"f F"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichField); EnvPrintRouter(theEnv,logicalName," S"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactPNGetVar2: Print routine */ /* for the FactPNGetvar2 function. */ /*************************************/ globle void PrintFactPNGetVar2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarPN2Call *hack; hack = (struct factGetVarPN2Call *) ValueToBitMap(theValue);; EnvPrintRouter(theEnv,logicalName,"(fact-pn-getvar-2 S"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactPNGetVar3: Print routine */ /* for the FactPNGetvar3 function. */ /*************************************/ globle void PrintFactPNGetVar3( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarPN3Call *hack; hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-getvar-3 "); if (hack->fromBeginning) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->fromEnd) EnvPrintRouter(theEnv,logicalName,"t B"); else EnvPrintRouter(theEnv,logicalName,"f B"); PrintLongInteger(theEnv,logicalName,(long long) hack->beginOffset); EnvPrintRouter(theEnv,logicalName," E"); PrintLongInteger(theEnv,logicalName,(long long) hack->endOffset); EnvPrintRouter(theEnv,logicalName," S"); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactPNConstant1: Print routine */ /* for the FactPNConstant1 function. */ /***************************************/ globle void PrintFactPNConstant1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factConstantPN1Call *hack; hack = (struct factConstantPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant1 "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = "); else EnvPrintRouter(theEnv,logicalName," != "); PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactPNConstant2: Print routine */ /* for the FactPNConstant2 function. */ /***************************************/ globle void PrintFactPNConstant2( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factConstantPN2Call *hack; hack = (struct factConstantPN2Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant2 "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long long) hack->offset); if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = "); else EnvPrintRouter(theEnv,logicalName," != "); PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips_core_source_630/core/._emathfun.c0000755000175000017500000000040712373740017016426 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/reorder.h0000755000175000017500000001234112374023501016042 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* REORDER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines necessary for converting the */ /* the LHS of a rule into an appropriate form suitable for */ /* the KB Rete topology. This includes transforming the */ /* LHS so there is at most one "or" CE (and this is the */ /* first CE of the LHS if it is used), adding initial */ /* patterns to the LHS (if no LHS is specified or a "test" */ /* or "not" CE is the first pattern within an "and" CE), */ /* removing redundant CEs, and determining appropriate */ /* information on nesting for implementing joins from the */ /* right. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Support for join network changes. */ /* */ /* Changes to the algorithm for processing */ /* not/and CE groups. */ /* */ /* Additional optimizations for combining */ /* conditional elements. */ /* */ /* Added support for hashed alpha memories. */ /* */ /*************************************************************/ #ifndef _H_reorder #define _H_reorder struct lhsParseNode; #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_ruledef #include "ruledef.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _REORDER_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /***********************************************************************/ /* lhsParseNode structure: Stores information about the intermediate */ /* parsed representation of the lhs of a rule. */ /***********************************************************************/ struct lhsParseNode { unsigned short type; void *value; unsigned int negated : 1; unsigned int exists : 1; unsigned int existsNand : 1; unsigned int logical : 1; unsigned int multifieldSlot : 1; unsigned int bindingVariable : 1; unsigned int derivedConstraints : 1; unsigned int userCE : 1; unsigned int whichCE : 7; unsigned int marked : 1; unsigned int withinMultifieldSlot : 1; unsigned short multiFieldsBefore; unsigned short multiFieldsAfter; unsigned short singleFieldsBefore; unsigned short singleFieldsAfter; struct constraintRecord *constraints; struct lhsParseNode *referringNode; struct patternParser *patternType; short pattern; short index; struct symbolHashNode *slot; short slotNumber; int beginNandDepth; int endNandDepth; int joinDepth; struct expr *networkTest; struct expr *externalNetworkTest; struct expr *secondaryNetworkTest; struct expr *externalLeftHash; struct expr *externalRightHash; struct expr *constantSelector; struct expr *constantValue; struct expr *leftHash; struct expr *rightHash; struct expr *betaHash; struct lhsParseNode *expression; struct lhsParseNode *secondaryExpression; void *userData; struct lhsParseNode *right; struct lhsParseNode *bottom; }; LOCALE struct lhsParseNode *ReorderPatterns(void *,struct lhsParseNode *,int *); LOCALE struct lhsParseNode *CopyLHSParseNodes(void *,struct lhsParseNode *); LOCALE void CopyLHSParseNode(void *,struct lhsParseNode *,struct lhsParseNode *,int); LOCALE struct lhsParseNode *GetLHSParseNode(void *); LOCALE void ReturnLHSParseNodes(void *,struct lhsParseNode *); LOCALE struct lhsParseNode *ExpressionToLHSParseNodes(void *,struct expr *); LOCALE struct expr *LHSParseNodesToExpression(void *,struct lhsParseNode *); LOCALE void AddInitialPatterns(void *,struct lhsParseNode *); LOCALE int IsExistsSubjoin(struct lhsParseNode *,int); LOCALE struct lhsParseNode *CombineLHSParseNodes(void *,struct lhsParseNode *,struct lhsParseNode *); LOCALE void AssignPatternMarkedFlag(struct lhsParseNode *,short); #endif /* _H_reorder */ clips_core_source_630/core/exprnops.h0000755000175000017500000000574612373740001016271 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* EXPRESSION OPERATIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides utility routines for manipulating and */ /* examining expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Dantes */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Add NegateExpression function. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_exprnops #define _H_exprnops #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRNOPS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ConstantExpression(struct expr *); LOCALE void PrintExpression(void *,const char *,struct expr *); LOCALE long ExpressionSize(struct expr *); LOCALE int CountArguments(struct expr *); LOCALE struct expr *CopyExpression(void *,struct expr *); LOCALE intBool ExpressionContainsVariables(struct expr *,int); LOCALE intBool IdenticalExpression(struct expr *,struct expr *); LOCALE struct expr *GenConstant(void *,unsigned short,void *); #if ! RUN_TIME LOCALE int CheckArgumentAgainstRestriction(void *,struct expr *,int); #endif LOCALE intBool ConstantType(int); LOCALE struct expr *CombineExpressions(void *,struct expr *,struct expr *); LOCALE struct expr *AppendExpressions(struct expr *,struct expr *); LOCALE struct expr *NegateExpression(void *,struct expr *); #endif /* _H_exprnops */ clips_core_source_630/core/._globlcom.c0000755000175000017500000000040712373753366016430 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._dfinscmp.h0000755000175000017500000000040712373731171016430 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/strngfun.h0000755000175000017500000000763212373755535016277 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* STRING FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added support for UTF-8 strings to str-length, */ /* str-index, and sub-string functions. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_strngfun #define _H_strngfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _STRNGFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE int Build(const char *); LOCALE int Eval(const char *,DATA_OBJECT_PTR); #endif LOCALE int EnvBuild(void *,const char *); LOCALE int EnvEval(void *,const char *,DATA_OBJECT_PTR); LOCALE void StringFunctionDefinitions(void *); LOCALE void StrCatFunction(void *,DATA_OBJECT_PTR); LOCALE void SymCatFunction(void *,DATA_OBJECT_PTR); LOCALE long long StrLengthFunction(void *); LOCALE void UpcaseFunction(void *,DATA_OBJECT_PTR); LOCALE void LowcaseFunction(void *,DATA_OBJECT_PTR); LOCALE long long StrCompareFunction(void *); LOCALE void *SubStringFunction(void *); LOCALE void StrIndexFunction(void *,DATA_OBJECT_PTR); LOCALE void EvalFunction(void *,DATA_OBJECT_PTR); LOCALE int BuildFunction(void *); LOCALE void StringToFieldFunction(void *,DATA_OBJECT *); LOCALE void StringToField(void *,const char *,DATA_OBJECT *); #endif /* _H_strngfun */ clips_core_source_630/core/._cstrnbin.h0000755000175000017500000000040712373714222016445 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/constrnt.h0000755000175000017500000001241212374672752016273 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* CONSTRAINT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for creating and removing */ /* constraint records, adding them to the contraint hash */ /* table, and enabling and disabling static and dynamic */ /* constraint checking. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* 6.30: Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Changed integer type/precision. */ /* */ /* Converted API macros to function calls. */ /* */ /*************************************************************/ #ifndef _H_constrnt #define _H_constrnt struct constraintRecord; #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CONSTRNT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct constraintRecord { unsigned int anyAllowed : 1; unsigned int symbolsAllowed : 1; unsigned int stringsAllowed : 1; unsigned int floatsAllowed : 1; unsigned int integersAllowed : 1; unsigned int instanceNamesAllowed : 1; unsigned int instanceAddressesAllowed : 1; unsigned int externalAddressesAllowed : 1; unsigned int factAddressesAllowed : 1; unsigned int voidAllowed : 1; unsigned int anyRestriction : 1; unsigned int symbolRestriction : 1; unsigned int stringRestriction : 1; unsigned int floatRestriction : 1; unsigned int integerRestriction : 1; unsigned int classRestriction : 1; unsigned int instanceNameRestriction : 1; unsigned int multifieldsAllowed : 1; unsigned int singlefieldsAllowed : 1; unsigned short bsaveIndex; struct expr *classList; struct expr *restrictionList; struct expr *minValue; struct expr *maxValue; struct expr *minFields; struct expr *maxFields; struct constraintRecord *multifield; struct constraintRecord *next; int bucket; int count; }; typedef struct constraintRecord CONSTRAINT_RECORD; #define SIZE_CONSTRAINT_HASH 167 #define CONSTRAINT_DATA 43 struct constraintData { struct constraintRecord **ConstraintHashtable; intBool StaticConstraintChecking; intBool DynamicConstraintChecking; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) struct constraintRecord *ConstraintArray; long int NumberOfConstraints; #endif }; #define ConstraintData(theEnv) ((struct constraintData *) GetEnvironmentData(theEnv,CONSTRAINT_DATA)) LOCALE void InitializeConstraints(void *); LOCALE int GDCCommand(void *); LOCALE int SDCCommand(void *d); LOCALE int GSCCommand(void *); LOCALE int SSCCommand(void *); LOCALE intBool EnvSetDynamicConstraintChecking(void *,int); LOCALE intBool EnvGetDynamicConstraintChecking(void *); LOCALE intBool EnvSetStaticConstraintChecking(void *,int); LOCALE intBool EnvGetStaticConstraintChecking(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE unsigned long HashConstraint(struct constraintRecord *); LOCALE struct constraintRecord *AddConstraint(void *,struct constraintRecord *); #endif #if (! RUN_TIME) LOCALE void RemoveConstraint(void *,struct constraintRecord *); #endif #if ALLOW_ENVIRONMENT_GLOBALS LOCALE intBool SetDynamicConstraintChecking(int); LOCALE intBool GetDynamicConstraintChecking(void); LOCALE intBool SetStaticConstraintChecking(int); LOCALE intBool GetStaticConstraintChecking(void); #endif #endif clips_core_source_630/core/._msgpsr.h0000755000175000017500000000040712374017646016145 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._inspsr.c0000755000175000017500000000040712464742046016142 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._tmpltlhs.c0000755000175000017500000000040712373754203016470 0ustar jfsjfsMac OS X  2ÕTEXTATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/._defins.h0000755000175000017500000000040712464554105016076 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/match.h0000755000175000017500000001062012373755054015510 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 08/16/14 */ /* */ /* MATCH HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added support for hashed memories. */ /* */ /* Added additional members to partialMatch to */ /* support changes to the matching algorithm. */ /* */ /*************************************************************/ #ifndef _H_match #define _H_match struct genericMatch; struct patternMatch; struct partialMatch; struct alphaMatch; struct multifieldMarker; #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_network #include "network.h" #endif #ifndef _H_pattern #include "pattern.h" #endif /************************************************************/ /* PATTERNMATCH STRUCTURE: */ /************************************************************/ struct patternMatch { struct patternMatch *next; struct partialMatch *theMatch; struct patternNodeHeader *matchingPattern; }; /**************************/ /* genericMatch structure */ /**************************/ struct genericMatch { union { void *theValue; struct alphaMatch *theMatch; } gm; }; /************************************************************/ /* PARTIALMATCH STRUCTURE: */ /************************************************************/ struct partialMatch { unsigned int betaMemory : 1; unsigned int busy : 1; unsigned int rhsMemory : 1; unsigned short bcount; unsigned long hashValue; void *owner; void *marker; void *dependents; struct partialMatch *nextInMemory; struct partialMatch *prevInMemory; struct partialMatch *children; struct partialMatch *rightParent; struct partialMatch *nextRightChild; struct partialMatch *prevRightChild; struct partialMatch *leftParent; struct partialMatch *nextLeftChild; struct partialMatch *prevLeftChild; struct partialMatch *blockList; struct partialMatch *nextBlocked; struct partialMatch *prevBlocked; struct genericMatch binds[1]; }; /************************************************************/ /* ALPHAMATCH STRUCTURE: */ /************************************************************/ struct alphaMatch { struct patternEntity *matchingItem; struct multifieldMarker *markers; struct alphaMatch *next; unsigned long bucket; }; /************************************************************/ /* MULTIFIELDMARKER STRUCTURE: Used in the pattern matching */ /* process to mark the range of fields that the $? and */ /* $?variables match because a single pattern restriction */ /* may span zero or more fields.. */ /************************************************************/ struct multifieldMarker { int whichField; union { void *whichSlot; short int whichSlotNumber; } where; long startPosition; long endPosition; struct multifieldMarker *next; }; #define get_nth_pm_value(thePM,thePos) (thePM->binds[thePos].gm.theValue) #define get_nth_pm_match(thePM,thePos) (thePM->binds[thePos].gm.theMatch) #define set_nth_pm_value(thePM,thePos,theVal) (thePM->binds[thePos].gm.theValue = (void *) theVal) #define set_nth_pm_match(thePM,thePos,theVal) (thePM->binds[thePos].gm.theMatch = theVal) #endif /* _H_match */ clips_core_source_630/core/._classini.c0000755000175000017500000000040712500721260016413 0ustar jfsjfsMac OS X  2ÕATTR¼K¼ com.apple.TextEncodingÇ@com.apple.quarantinemacintosh;0q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/core/rulelhs.h0000755000175000017500000000364312365012263016066 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 07/25/14 */ /* */ /* DEFRULE LHS PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Coordinates parsing of the LHS conditional */ /* elements of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.30: Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /*************************************************************/ #ifndef _H_rulelhs #define _H_rulelhs #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULELHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct lhsParseNode *ParseRuleLHS(void *,const char *,struct token *,const char *,int *); LOCALE void PropagatePatternType(struct lhsParseNode *,struct patternParser *); #endif clips_core_source_630/core/strngfun.c0000755000175000017500000011120112461303304016233 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.30 01/25/15 */ /* */ /* STRING FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several string functions */ /* including str-cat, sym-cat, str-length, str-compare, */ /* upcase, lowcase, sub-string, str-index, eval, and */ /* build. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Barry Cameron */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.30: Support for long long integers. */ /* */ /* Removed conditional code for unsupported */ /* compilers/operating systems (IBM_MCW and */ /* MAC_MCW). */ /* */ /* Used gensprintf instead of sprintf. */ /* */ /* Changed integer type/precision. */ /* */ /* Changed garbage collection algorithm. */ /* */ /* Added support for UTF-8 strings to str-length, */ /* str-index, and sub-string functions. */ /* */ /* Added const qualifiers to remove C++ */ /* deprecation warnings. */ /* */ /* Added code to keep track of pointers to */ /* constructs that are contained externally to */ /* to constructs, DanglingConstructs. */ /* */ /* Fixed str-cat bug that could be invoked by */ /* (funcall str-cat). */ /* */ /*************************************************************/ #define _STRNGFUN_SOURCE_ #include "setup.h" #if STRING_FUNCTIONS #include #define _STDIO_INCLUDED_ #include #include #include "argacces.h" #include "commline.h" #include "constrct.h" #include "cstrcpsr.h" #include "engine.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "memalloc.h" #include "prcdrpsr.h" #include "router.h" #include "strngrtr.h" #include "scanner.h" #include "sysdep.h" #if DEFRULE_CONSTRUCT #include "drive.h" #endif #include "strngfun.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void StrOrSymCatFunction(void *,DATA_OBJECT_PTR,unsigned short); /******************************************/ /* StringFunctionDefinitions: Initializes */ /* the string manipulation functions. */ /******************************************/ globle void StringFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"str-cat", 'k', PTIEF StrCatFunction, "StrCatFunction", "1*"); EnvDefineFunction2(theEnv,"sym-cat", 'k', PTIEF SymCatFunction, "SymCatFunction", "1*"); EnvDefineFunction2(theEnv,"str-length", 'g', PTIEF StrLengthFunction, "StrLengthFunction", "11j"); EnvDefineFunction2(theEnv,"str-compare", 'g', PTIEF StrCompareFunction, "StrCompareFunction", "23*jji"); EnvDefineFunction2(theEnv,"upcase", 'j', PTIEF UpcaseFunction, "UpcaseFunction", "11j"); EnvDefineFunction2(theEnv,"lowcase", 'j', PTIEF LowcaseFunction, "LowcaseFunction", "11j"); EnvDefineFunction2(theEnv,"sub-string", 's', PTIEF SubStringFunction, "SubStringFunction", "33*iij"); EnvDefineFunction2(theEnv,"str-index", 'u', PTIEF StrIndexFunction, "StrIndexFunction", "22j"); EnvDefineFunction2(theEnv,"eval", 'u', PTIEF EvalFunction, "EvalFunction", "11k"); EnvDefineFunction2(theEnv,"build", 'b', PTIEF BuildFunction, "BuildFunction", "11k"); EnvDefineFunction2(theEnv,"string-to-field", 'u', PTIEF StringToFieldFunction, "StringToFieldFunction", "11j"); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif } /****************************************/ /* StrCatFunction: H/L access routine */ /* for the str-cat function. */ /****************************************/ globle void StrCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StrOrSymCatFunction(theEnv,returnValue,STRING); } /****************************************/ /* SymCatFunction: H/L access routine */ /* for the sym-cat function. */ /****************************************/ globle void SymCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StrOrSymCatFunction(theEnv,returnValue,SYMBOL); } /********************************************************/ /* StrOrSymCatFunction: Driver routine for implementing */ /* the str-cat and sym-cat functions. */ /********************************************************/ static void StrOrSymCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue, unsigned short returnType) { DATA_OBJECT theArg; int numArgs, i, total, j; char *theString; SYMBOL_HN **arrayOfStrings; SYMBOL_HN *hashPtr; const char *functionName; /*============================================*/ /* Determine the calling function name. */ /* Store the null string or the symbol nil as */ /* the return value in the event of an error. */ /*============================================*/ SetpType(returnValue,returnType); if (returnType == STRING) { functionName = "str-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); } else { functionName = "sym-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil")); } /*===============================================*/ /* Determine the number of arguments as create a */ /* string array which is large enough to store */ /* the string representation of each argument. */ /*===============================================*/ numArgs = EnvRtnArgCount(theEnv); if (numArgs == 0) return; arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs); for (i = 0; i < numArgs; i++) { arrayOfStrings[i] = NULL; } /*=============================================*/ /* Evaluate each argument and store its string */ /* representation in the string array. */ /*=============================================*/ total = 1; for (i = 1 ; i <= numArgs ; i++) { EnvRtnUnknown(theEnv,i,&theArg); switch(GetType(theArg)) { case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: hashPtr = (SYMBOL_HN *) GetValue(theArg); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case FLOAT: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case INTEGER: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; default: ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer"); SetEvaluationError(theEnv,TRUE); break; } if (EvaluationData(theEnv)->EvaluationError) { for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); return; } total += (int) strlen(ValueToString(arrayOfStrings[i - 1])); } /*=========================================================*/ /* Allocate the memory to store the concatenated string or */ /* symbol, then copy the values in the string array to the */ /* memory just allocated. */ /*=========================================================*/ theString = (char *) gm2(theEnv,(sizeof(char) * total)); j = 0; for (i = 0 ; i < numArgs ; i++) { gensprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i])); j += (int) strlen(ValueToString(arrayOfStrings[i])); } /*=========================================*/ /* Return the concatenated value and clean */ /* up the temporary memory used. */ /*=========================================*/ SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString)); rm(theEnv,theString,sizeof(char) * total); for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); } /*******************************************/ /* StrLengthFunction: H/L access routine */ /* for the str-length function. */ /*******************************************/ globle long long StrLengthFunction( void *theEnv) { DATA_OBJECT theArg; /*===================================================*/ /* Function str-length expects exactly one argument. */ /*===================================================*/ if (EnvArgCountCheck(theEnv,"str-length",EXACTLY,1) == -1) { return(-1LL); } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"str-length",1,SYMBOL_OR_STRING,&theArg) == FALSE) { return(-1LL); } /*============================================*/ /* Return the length of the string or symbol. */ /*============================================*/ return(UTF8Length(DOToString(theArg))); } /****************************************/ /* UpcaseFunction: H/L access routine */ /* for the upcase function. */ /****************************************/ globle void UpcaseFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theArg; unsigned i; size_t slen; const char *osptr; char *nsptr; /*===============================================*/ /* Function upcase expects exactly one argument. */ /*===============================================*/ if (EnvArgCountCheck(theEnv,"upcase",EXACTLY,1) == -1) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"upcase",1,SYMBOL_OR_STRING,&theArg) == FALSE) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*======================================================*/ /* Allocate temporary memory and then copy the original */ /* string or symbol to that memory, while uppercasing */ /* lower case alphabetic characters. */ /*======================================================*/ osptr = DOToString(theArg); slen = strlen(osptr) + 1; nsptr = (char *) gm2(theEnv,slen); for (i = 0 ; i < slen ; i++) { if (islower(osptr[i])) { nsptr[i] = (char) toupper(osptr[i]); } else { nsptr[i] = osptr[i]; } } /*========================================*/ /* Return the uppercased string and clean */ /* up the temporary memory used. */ /*========================================*/ SetpType(returnValue,GetType(theArg)); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr)); rm(theEnv,nsptr,slen); } /*****************************************/ /* LowcaseFunction: H/L access routine */ /* for the lowcase function. */ /*****************************************/ globle void LowcaseFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theArg; unsigned i; size_t slen; const char *osptr; char *nsptr; /*================================================*/ /* Function lowcase expects exactly one argument. */ /*================================================*/ if (EnvArgCountCheck(theEnv,"lowcase",EXACTLY,1) == -1) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*======================================================*/ /* Allocate temporary memory and then copy the original */ /* string or symbol to that memory, while lowercasing */ /* upper case alphabetic characters. */ /*======================================================*/ osptr = DOToString(theArg); slen = strlen(osptr) + 1; nsptr = (char *) gm2(theEnv,slen); for (i = 0 ; i < slen ; i++) { if (isupper(osptr[i])) { nsptr[i] = (char) tolower(osptr[i]); } else { nsptr[i] = osptr[i]; } } /*========================================*/ /* Return the lowercased string and clean */ /* up the temporary memory used. */ /*========================================*/ SetpType(returnValue,GetType(theArg)); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr)); rm(theEnv,nsptr,slen); } /********************************************/ /* StrCompareFunction: H/L access routine */ /* for the str-compare function. */ /********************************************/ globle long long StrCompareFunction( void *theEnv) { int numArgs, length; DATA_OBJECT arg1, arg2, arg3; long long returnValue; /*=======================================================*/ /* Function str-compare expects either 2 or 3 arguments. */ /*=======================================================*/ if ((numArgs = EnvArgRangeCheck(theEnv,"str-compare",2,3)) == -1) return(0L); /*=============================================================*/ /* The first two arguments should be of type symbol or string. */ /*=============================================================*/ if (EnvArgTypeCheck(theEnv,"str-compare",1,SYMBOL_OR_STRING,&arg1) == FALSE) { return(0L); } if (EnvArgTypeCheck(theEnv,"str-compare",2,SYMBOL_OR_STRING,&arg2) == FALSE) { return(0L); } /*===================================================*/ /* Compare the strings. Use the 3rd argument for the */ /* maximum length of comparison, if it is provided. */ /*===================================================*/ if (numArgs == 3) { if (EnvArgTypeCheck(theEnv,"str-compare",3,INTEGER,&arg3) == FALSE) { return(0L); } length = CoerceToInteger(GetType(arg3),GetValue(arg3)); returnValue = strncmp(DOToString(arg1),DOToString(arg2), (STD_SIZE) length); } else { returnValue = strcmp(DOToString(arg1),DOToString(arg2)); } /*========================================================*/ /* Return Values are as follows: */ /* -1 is returned if is less than . */ /* 1 is return if is greater than . */ /* 0 is returned if is equal to . */ /*========================================================*/ if (returnValue < 0) returnValue = -1; else if (returnValue > 0) returnValue = 1; return(returnValue); } /*******************************************/ /* SubStringFunction: H/L access routine */ /* for the sub-string function. */ /*******************************************/ globle void *SubStringFunction( void *theEnv) { DATA_OBJECT theArgument; const char *tempString; char *returnString; size_t start, end, i, j, length; void *returnValue; /*===================================*/ /* Check and retrieve the arguments. */ /*===================================*/ if (EnvArgCountCheck(theEnv,"sub-string",EXACTLY,3) == -1) { return((void *) EnvAddSymbol(theEnv,"")); } if (EnvArgTypeCheck(theEnv,"sub-string",1,INTEGER,&theArgument) == FALSE) { return((void *) EnvAddSymbol(theEnv,"")); } if (CoerceToLongInteger(theArgument.type,theArgument.value) < 1) { start = 0; } else { start = (size_t) CoerceToLongInteger(theArgument.type,theArgument.value) - 1; } if (EnvArgTypeCheck(theEnv,"sub-string",2,INTEGER,&theArgument) == FALSE) { return((void *) EnvAddSymbol(theEnv,"")); } if (CoerceToLongInteger(theArgument.type,theArgument.value) < 1) { return((void *) EnvAddSymbol(theEnv,"")); } else { end = (size_t) CoerceToLongInteger(theArgument.type,theArgument.value) - 1; } if (EnvArgTypeCheck(theEnv,"sub-string",3,SYMBOL_OR_STRING,&theArgument) == FALSE) { return((void *) EnvAddSymbol(theEnv,"")); } tempString = DOToString(theArgument); /*================================================*/ /* If parameters are out of range return an error */ /*================================================*/ length = UTF8Length(tempString); if (end > length) { end = length; } /*==================================*/ /* If the start is greater than the */ /* end, return a null string. */ /*==================================*/ if ((start > end) || (length == 0)) { return((void *) EnvAddSymbol(theEnv,"")); } /*=============================================*/ /* Otherwise, allocate the string and copy the */ /* designated portion of the old string to the */ /* new string. */ /*=============================================*/ else { start = UTF8Offset(tempString,start); end = UTF8Offset(tempString,end + 1) - 1; returnString = (char *) gm2(theEnv,(unsigned) (end - start + 2)); /* (end - start) inclusive + EOS */ for(j=0, i=start;i <= end; i++, j++) { *(returnString+j) = *(tempString+i); } *(returnString+j) = '\0'; } /*========================*/ /* Return the new string. */ /*========================*/ returnValue = (void *) EnvAddSymbol(theEnv,returnString); rm(theEnv,returnString,(unsigned) (end - start + 2)); return(returnValue); } /******************************************/ /* StrIndexFunction: H/L access routine */ /* for the sub-index function. */ /******************************************/ globle void StrIndexFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT theArgument1, theArgument2; const char *strg1, *strg2, *strg3; size_t i, j; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /*===================================*/ /* Check and retrieve the arguments. */ /*===================================*/ if (EnvArgCountCheck(theEnv,"str-index",EXACTLY,2) == -1) return; if (EnvArgTypeCheck(theEnv,"str-index",1,SYMBOL_OR_STRING,&theArgument1) == FALSE) return; if (EnvArgTypeCheck(theEnv,"str-index",2,SYMBOL_OR_STRING,&theArgument2) == FALSE) return; strg1 = DOToString(theArgument1); strg2 = DOToString(theArgument2); /*=================================*/ /* Find the position in string2 of */ /* string1 (counting from 1). */ /*=================================*/ if (strlen(strg1) == 0) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,(long long) UTF8Length(strg2) + 1LL); return; } strg3 = strg2; for (i=1; *strg2; i++, strg2++) { for (j=0; *(strg1+j) && *(strg1+j) == *(strg2+j); j++) { /* Do Nothing */ } if (*(strg1+j) == '\0') { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,(long long) UTF8CharNum(strg3,i)); return; } } return; } /********************************************/ /* StringToFieldFunction: H/L access routine */ /* for the string-to-field function. */ /********************************************/ globle void StringToFieldFunction( void *theEnv, DATA_OBJECT *returnValue) { DATA_OBJECT theArg; /*========================================================*/ /* Function string-to-field expects exactly one argument. */ /*========================================================*/ if (EnvArgCountCheck(theEnv,"string-to-field",EXACTLY,1) == -1) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***"); return; } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"string-to-field",1,SYMBOL_OR_STRING,&theArg) == FALSE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***"); return; } /*================================*/ /* Convert the string to an atom. */ /*================================*/ StringToField(theEnv,DOToString(theArg),returnValue); } /*************************************************************/ /* StringToField: Converts a string to an atomic data value. */ /*************************************************************/ globle void StringToField( void *theEnv, const char *theString, DATA_OBJECT *returnValue) { struct token theToken; /*====================================*/ /* Open the string as an input source */ /* and retrieve the first value. */ /*====================================*/ OpenStringSource(theEnv,"string-to-field-str",theString,0); GetToken(theEnv,"string-to-field-str",&theToken); CloseStringSource(theEnv,"string-to-field-str"); /*====================================================*/ /* Copy the token to the return value data structure. */ /*====================================================*/ returnValue->type = theToken.type; if ((theToken.type == FLOAT) || (theToken.type == STRING) || #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == SYMBOL) || (theToken.type == INTEGER)) { returnValue->value = theToken.value; } else if (theToken.type == STOP) { returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); } else if (theToken.type == UNKNOWN_VALUE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***"); } else { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm); } } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************/ /* EvalFunction: H/L access routine */ /* for the eval function. */ /**************************************/ globle void EvalFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theArg; /*=============================================*/ /* Function eval expects exactly one argument. */ /*=============================================*/ if (EnvArgCountCheck(theEnv,"eval",EXACTLY,1) == -1) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return; } /*==================================================*/ /* The argument should be of type SYMBOL or STRING. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"eval",1,SYMBOL_OR_STRING,&theArg) == FALSE) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return; } /*======================*/ /* Evaluate the string. */ /*======================*/ EnvEval(theEnv,DOToString(theArg),returnValue); } /****************************/ /* Eval: C access routine */ /* for the eval function. */ /****************************/ #if ALLOW_ENVIRONMENT_GLOBALS globle int Eval( const char *theString, DATA_OBJECT_PTR returnValue) { return EnvEval(GetCurrentEnvironment(),theString,returnValue); } #endif /*****************************/ /* EnvEval: C access routine */ /* for the eval function. */ /*****************************/ globle int EnvEval( void *theEnv, const char *theString, DATA_OBJECT_PTR returnValue) { struct expr *top; int ov; static int depth = 0; char logicalNameBuffer[20]; struct BindInfo *oldBinds; int danglingConstructs; /*======================================================*/ /* Evaluate the string. Create a different logical name */ /* for use each time the eval function is called. */ /*======================================================*/ depth++; gensprintf(logicalNameBuffer,"Eval-%d",depth); if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); depth--; return(FALSE); } /*================================================*/ /* Save the current parsing state before routines */ /* are called to parse the eval string. */ /*================================================*/ ov = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,FALSE); oldBinds = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); danglingConstructs = ConstructData(theEnv)->DanglingConstructs; /*========================================================*/ /* Parse the string argument passed to the eval function. */ /*========================================================*/ top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL); /*============================*/ /* Restore the parsing state. */ /*============================*/ SetPPBufferStatus(theEnv,ov); ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBinds); /*===========================================*/ /* Return if an error occured while parsing. */ /*===========================================*/ if (top == NULL) { SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); depth--; ConstructData(theEnv)->DanglingConstructs = danglingConstructs; return(FALSE); } /*==============================================*/ /* The sequence expansion operator must be used */ /* within the argument list of a function call. */ /*==============================================*/ if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE)) { PrintErrorID(theEnv,"MISCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n"); SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); ReturnExpression(theEnv,top); depth--; ConstructData(theEnv)->DanglingConstructs = danglingConstructs; return(FALSE); } /*=======================================*/ /* The expression to be evaluated cannot */ /* contain any local variables. */ /*=======================================*/ if (ExpressionContainsVariables(top,FALSE)) { PrintErrorID(theEnv,"STRNGFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n"); SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); ReturnExpression(theEnv,top); depth--; ConstructData(theEnv)->DanglingConstructs = danglingConstructs; return(FALSE); } /*====================================*/ /* Evaluate the expression and return */ /* the memory used to parse it. */ /*====================================*/ ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,returnValue); ExpressionDeinstall(theEnv,top); depth--; ReturnExpression(theEnv,top); CloseStringSource(theEnv,logicalNameBuffer); /*==============================================*/ /* If embedded, reset dangling construct count. */ /*==============================================*/ if ((! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { ConstructData(theEnv)->DanglingConstructs = danglingConstructs; } /*==========================================*/ /* Perform periodic cleanup if the eval was */ /* issued from an embedded controller. */ /*==========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,returnValue); CallPeriodicTasks(theEnv); } if (GetEvaluationError(theEnv)) return(FALSE); return(TRUE); } #else /*************************************************/ /* EvalFunction: This is the non-functional stub */ /* provided for use with a run-time version. */ /*************************************************/ globle void EvalFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function eval does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); } /*****************************************************/ /* EnvEval: This is the non-functional stub provided */ /* for use with a run-time version. */ /*****************************************************/ globle int EnvEval( void *theEnv, const char *theString, DATA_OBJECT_PTR returnValue) { PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function eval does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return(FALSE); } #endif #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************/ /* BuildFunction: H/L access routine */ /* for the build function. */ /***************************************/ globle int BuildFunction( void *theEnv) { DATA_OBJECT theArg; /*==============================================*/ /* Function build expects exactly one argument. */ /*==============================================*/ if (EnvArgCountCheck(theEnv,"build",EXACTLY,1) == -1) return(FALSE); /*==================================================*/ /* The argument should be of type SYMBOL or STRING. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"build",1,SYMBOL_OR_STRING,&theArg) == FALSE) { return(FALSE); } /*======================*/ /* Build the construct. */ /*======================*/ return(EnvBuild(theEnv,DOToString(theArg))); } /*****************************/ /* Build: C access routine */ /* for the build function. */ /*****************************/ #if ALLOW_ENVIRONMENT_GLOBALS globle int Build( const char *theString) { return EnvBuild(GetCurrentEnvironment(),theString); } #endif /******************************/ /* EnvBuild: C access routine */ /* for the build function. */ /******************************/ globle int EnvBuild( void *theEnv, const char *theString) { const char *constructType; struct token theToken; int errorFlag; /*====================================================*/ /* No additions during defrule join network activity. */ /*====================================================*/ #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE); #endif /*===========================================*/ /* Create a string source router so that the */ /* string can be used as an input source. */ /*===========================================*/ if (OpenStringSource(theEnv,"build",theString,0) == 0) { return(FALSE); } /*================================*/ /* The first token of a construct */ /* must be a left parenthesis. */ /*================================*/ GetToken(theEnv,"build",&theToken); if (theToken.type != LPAREN) { CloseStringSource(theEnv,"build"); return(FALSE); } /*==============================================*/ /* The next token should be the construct type. */ /*==============================================*/ GetToken(theEnv,"build",&theToken); if (theToken.type != SYMBOL) { CloseStringSource(theEnv,"build"); return(FALSE); } constructType = ValueToString(theToken.value); /*======================*/ /* Parse the construct. */ /*======================*/ errorFlag = ParseConstruct(theEnv,constructType,"build"); /*=================================*/ /* Close the string source router. */ /*=================================*/ CloseStringSource(theEnv,"build"); /*=========================================*/ /* If an error occured while parsing the */ /* construct, then print an error message. */ /*=========================================*/ if (errorFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); /*===========================================*/ /* Perform periodic cleanup if the build was */ /* issued from an embedded controller. */ /*===========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*===============================================*/ /* Return TRUE if the construct was successfully */ /* parsed, otherwise return FALSE. */ /*===============================================*/ if (errorFlag == 0) return(TRUE); return(FALSE); } #else /**************************************************/ /* BuildFunction: This is the non-functional stub */ /* provided for use with a run-time version. */ /**************************************************/ globle int BuildFunction( void *theEnv) { PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function build does not work in run time modules.\n"); return(FALSE); } /******************************************************/ /* EnvBuild: This is the non-functional stub provided */ /* for use with a run-time version. */ /******************************************************/ globle int EnvBuild( void *theEnv, const char *theString) { PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function build does not work in run time modules.\n"); return(FALSE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* STRING_FUNCTIONS */ clips_core_source_630/._core0000755000175000017500000000033012512773651014376 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/._readme.txt0000644000175000017500000000041312504551126015510 0ustar jfsjfsMac OS X  2Ù ATTR ¼O¼com.apple.TextEncodingË@com.apple.quarantineUTF-8;134217984q/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235clips_core_source_630/._makefiles0000755000175000017500000000033012512772777015416 0ustar jfsjfsMac OS X  2¦ØATTRؘ@˜@com.apple.quarantineq/0002;552bf321;Safari.app;95B5D286-6B4A-4D6E-A2F9-ED59E6672235