perm filename LP4MAT.SAI[NEW,AIL] blob sn#408298 filedate 1979-01-08 generic text, type T, neo UTF8
COMMENT XOR   VALID 00005 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	ENTRY LP4MAT
 00006 00003	FIRST OUTPUT THE LOCAL MODEL
 00012 00004	GLOB
 00017 00005	ENDIT:
 00018 ENDMK
XOR ;
ENTRY LP4MAT;
BEGIN "LP4MAT"
COMMENT THE FOLLOWING PROCEDURE IS USED TO OBTAIN A SYMBOLIC LISTING
	OF THE GLOBAL AND LOCAL LEAP MODELS. IT FIRST ASKS FOR A FILENAME TO
	WHICH THE LISTING SHOULD BE DIRECTED. IF THE USER RESPONDS WITH
	THE CHARACTERS "T","T","Y" FOLLOWED BY A CARRIAGE RETURN THE 
	OUTPUT WILL BE DIRECTED TO HIS TERMINAL, OTHERWISE TO THE DISK
	FILE WITH THE NAME HE HAS TYPED. THE FORMAT IS:
	THE ITEM NAMES(PNAME OR "CVI(item #)") FOLLOWED BY THE PROPS, DATUM
	TYPE FOLLOWED BY THE DATUM(IF ANY).

	THE CALLING SEQUENCE IS SIMPLY:

		LP4MAT

	THIS PROCEDURE MUST BE LOADED WITH PROCEDURES OUTTTY, AND ENDOUT
	WHICH ARE CONTAINED IN FILE IOMODS.SAI.

	ALSO REQUIRED ARE AMUNGE,UNMUNGE, CONTAINED IN
	MUNGE.SAI.

	SEPTMEMBER 1972. JIM LOW, STANFORD ARTIFICIAL INTELLIGENCE LAB.;


REQUIRE "[][]" DELIMITERS;
DEFINE GLOBSW ← 0; COMMENT NORMALLY NO GLOBAL MODEL STUFF;
DEFINE GLOB = [ IFC GLOBSW THENC ];
DEFINE ENDGLOB = [ ENDC ];
DEFINE NOGLOB = [ IFC NOT GLOBSW THENC ];
DEFINE ENDNOGLOB = [ ENDC ];


COMMENT TYPEIT CODES;
REQUIRE "CS:TYPEIT.HDR" SOURCE!FILE;

INTERNAL PROCEDURE LP4MAT;
BEGIN "LP4MAT"
   REQUIRE "IOMODS.HDR" SOURCE!FILE;
   REQUIRE "CS:MUNGE.REL" LOAD!MODULE;
   EXTERNAL INTEGER PROCEDURE AMUNGE(ITEMVAR X);
   EXTERNAL PROCEDURE UNMUNG(ITEMVAR X);
   EXTERNAL INTEGER MAXITM,INFTB;
	
GLOB
   EXTERNAL INTEGER GINFTB;
ENDGLOB

   INTEGER FLAG,ITMMAX,TYPE,I,J,K;
   ITEMVAR ITMVR;
   INTEGER ITEMVAR IITMVR; REAL ITEMVAR RITMVR; STRING ITEMVAR SITMVR;
   INTEGER ARRAY ITEMVAR IAITMVR; REAL ARRAY ITEMVAR RAITMVR;
   STRING ARRAY ITEMVAR SAITMVR;
   LIST ITEMVAR LITMVR;
   LIST LISTV;
   LIST ARRAY ITEMVAR LAITMVR;
   LABEL ENDIT;
GLOB
   LABEL GLB!MODEL;
ENDGLOB

   STRING PROCEDURE ITNAME(ITEMVAR X);
   BEGIN INTEGER FLAG; STRING PNAME;
      PNAME←CVIS(X,FLAG);
      IF FLAG THEN PNAME ← "CVI("&CVS(CVN(X))&")";
      RETURN(PNAME);
   END;

   PROCEDURE OUTLST(LIST X);
   BEGIN WHILE LENGTH(X) DO
            OUTTTY("  "&ITNAME(LOP(X)));
   END;

COMMENT FIRST OUTPUT THE LOCAL MODEL;

   IF INFTB = 0 THEN
      BEGIN OUTTTY("NO LOCAL LEAP MODEL");
GLOB
	GO TO GLB!MODEL;
ENDGLOB
NOGLOB
	GO TO ENDIT;
ENDNOGLOB
      END;

   USERCON(MAXITM,ITMMAX,2);
   FOR I ← 1 STEP 1 UNTIL ITMMAX DO
      IF (TYPE←TYPEIT(CVI(I))) THEN
         BEGIN "if stmt"
	    OUTTTY(CRLF&CRLF&"#ITEM##");
	    IITMVR←IAITMVR←RAITMVR←RITMVR←ITMVR←SITMVR←CVI(I);
	    SAITMVR←LITMVR←LAITMVR←ITMVR;
	    OUTTTY(CRLF&"#PNAME#"&ITNAME(CVI(I)));
	    OUTTTY(CRLF&"#PROPS#"&CVS(PROPS(LITMVR)));
	    OUTTTY(CRLF&"#DATUM#");
	    CASE TYPE OF
	    BEGIN "case stmt"
	       [!UNTYPED] OUTTTY("UNTYPED ITEM");
	       [!BRACKETED]
		   BEGIN OUTTTY("BRACKETED TRIPLE");
			 OUTTTY(CRLF&ITNAME(FIRST(ITMVR))&
			 " XOR "&ITNAME(SECOND(ITMVR))&
			 " EQV "&ITNAME(THIRD(ITMVR)));
		   END;
	       [!STRING] OUTTTY("STRING"&CRLF&DATUM(ITMVR,STRING));
	       [!REAL] OUTTTY("REAL"&CRLF&CVF(DATUM(ITMVR,REAL)));
	       [!INTEGER] OUTTTY("INTEGER"&CRLF&CVS(DATUM(ITMVR,INTEGER)));
	       [!SET] BEGIN OUTTTY("SET"&CRLF&"{");
			 OUTLST(DATUM(ITMVR,SET));
			 OUTTTY("  ⎇");
		   END;
	       [!LIST] BEGIN OUTTTY("LIST"&CRLF&"{{");
			 OUTLST(DATUM(LITMVR,LIST));
			 OUTTTY("  ⎇⎇");
		   END;
               [!PROCEDURE] BEGIN STRING PNAME;
			 INTEGER PDA;
			 PDA ← DATUM(LITMVR,INTEGER);
			 START!CODE
				HRRZ	1,PDA;
				HRROI	2,2(1);
				MOVEI	3,PNAME;
				POP	2,(3);
				POP	2,-1(3);
			 END;
			 OUTTTY("PROCEDURE"&CRLF&PNAME);
		   END;
	       [!PROCESS] OUTTTY("PROCESS"&CRLF & "PROCESSES NOT PRINTED");
	      [!EVENT] OUTTTY("EVENT" & CRLF& "EVENTS NOT PRINTED");
	      [!CONTEXT] OUTTTY("CONTEXT"&CRLF&"CONTEXTS NOT PRINTED.");
	      [!STRING!ARRAY] 
		   BEGIN OUTTTY("STRING ARRAY");
			 J←AMUNGE(ITMVR);
			 FOR K← 1 STEP 1 UNTIL J DO
			     OUTTTY(CRLF&DATUM(ITMVR,STRING ARRAY)[K]);
			 UNMUNG(ITMVR);
		   END;
	      [!REAL!ARRAY] 
		   BEGIN OUTTTY("REAL ARRAY");
			 J←AMUNGE(ITMVR);
			 FOR K ← 1 STEP 1 UNTIL J DO
			     OUTTTY(CRLF&CVF(DATUM(ITMVR,REAL ARRAY)[K]));
			 UNMUNG(ITMVR);
		   END;
	      [!INTEGER!ARRAY] 
		   BEGIN OUTTTY("INTEGER ARRAY");
			 J←AMUNGE(ITMVR);
			 FOR K ← 1 STEP 1 UNTIL J DO
			     OUTTTY(CRLF&CVS(DATUM(ITMVR,INTEGER ARRAY)[K]));
			 UNMUNG(ITMVR);
		   END;
	      [!SET!ARRAY] 
		   BEGIN OUTTTY("SET ARRAY");
			 J←AMUNGE(ITMVR);
			 FOR K ← 1 STEP 1 UNTIL J DO
			 BEGIN OUTTTY(CRLF&"{");
			       OUTLST(DATUM(ITMVR,SET ARRAY)[K]);
			       OUTTTY("  ⎇");
			 END;
			 UNMUNG(ITMVR);
		   END;
	      [!LIST!ARRAY] 
		   BEGIN OUTTTY("LIST ARRAY");
			 J←AMUNGE(ITMVR);
			 FOR K← 1 STEP 1 UNTIL J DO
			 BEGIN OUTTTY(CRLF&"{{");
			       OUTLST(DATUM(ITMVR,LIST ARRAY)[K]);
			       OUTTTY( "  ⎇⎇");
			 END;
			 UNMUNG(ITMVR);
		   END;
	      [!CONTEXT!ARRAY] OUTTTY("CONTEXT ARRAY"&CRLF&"CONTEXTS NOT PRINTED")
	      
	     FORLC X = !INVALID!TYPEITS DOC
		[ ; [X] OUTTTY("INVALID TYPEIT CODE X") ] ENDC
	    END "case stmt";
	END "if stmt";

   COMMENT OUTPUT LOCAL ASSOCIATIONS;

   OUTTTY(CRLF&CRLF&CRLF&CRLF&"#ASSOCIATIONS#");

   FOR I ← 1 STEP 1 UNTIL ITMMAX DO
      IF TYPEIT(CVI(I)) THEN
	 FOREACH SAITMVR,RAITMVR| SAITMVR XOR RAITMVR EQV CVI(I) DO
	    OUTTTY(CRLF&ITNAME(SAITMVR)&" XOR "&ITNAME(RAITMVR)&" EQV "
							&ITNAME(CVI(I)));
   OUTTTY(CRLF);

GLOB
GLB!MODEL:
   IF GINFTB = 0 THEN
	BEGIN OUTTTY(CRLF&"NO GLOBAL LEAP MODEL"&CRLF);
		GO TO ENDIT;
	END;

   USERCON(MAXITM,ITMMAX,-2); COMMENT GET LOWEST GLOBAL ITEM NUMBER;
   FOR I ← ITMMAX STEP 1 UNTIL 4095 DO
      IF (TYPE←TYPEIT(CVI(I))) THEN
	BEGIN "global if"
	    OUTTTY(CRLF & CRLF& "#GLOBAL ITEM#");
	    IITMVR←IAITMVR←RAITMVR←RITMVR←ITMVR←SITMVR←CVI(I);
	    SAITMVR←LITMVR←LAITMVR←ITMVR;
	    OUTTTY(CRLF&"#PNAME#"&ITNAME(CVI(I)));
	    OUTTTY(CRLF&"#PROPS#"&CVS(GLOBAL PROPS(IITMVR)));
	    OUTTTY(CRLF&"#DATUM#");
	    CASE TYPE OF
	    BEGIN "case stmt"
		  [!UNTYPED] OUTTTY("UNTYPED ITEM");
		  [!BRACKETED] 
		      BEGIN OUTTTY("BRACKETED TRIPLE");
			    OUTTTY(CRLF&ITNAME(GLOBAL FIRST(ITMVR))&
			    " XOR "&ITNAME(GLOBAL SECOND(ITMVR))&
			    " EQV "&ITNAME(GLOBAL THIRD(ITMVR)));
		      END;
		  [!STRING] USERERR(0,1,"DRYROT- GLOBAL STRING?");
		  [!REAL] OUTTTY("REAL"&CRLF&CVF(GLOBAL DATUM(RITMVR)));
		  [!INTEGER] OUTTTY("INTEGER"&CRLF&CVS(GLOBAL DATUM(IITMVR)));
		  [!SET] BEGIN OUTTTY("SET");
			    OUTTTY(CRLF&"{");
			    OUTLST(GLOBAL DATUM(LITMVR));
			    OUTTTY("  ⎇");
		      END;
		  [!LIST] BEGIN OUTTTY("LIST");
			    OUTTTY(CRLF&"{{");
			    OUTLST(GLOBAL DATUM(LITMVR));
			    OUTTTY("  ⎇⎇");
		      END;
		  [!PROCEDURE] USERERR(0,1,"DRYROT- GLOBAL PROCEDURE ITEM");
		  [!PROCESS] USERERR(0,1,"DRYROT- GLOBAL PROCESS ITEM");
		 [!EVENT] USERERR(0,1,"DRYROT- GLOBAL EVENT ITEM");
		 [!CONTEXT] USERERR(0,1,"DRYROT- GLOBAL CONTEXT ITEM");
		 [!STRING!ARRAY] USERERR(0,1,"DRYROT LP4MAT-GLOBAL STRING ARRAY?");
		 [!REAL!ARRAY] BEGIN OUTTTY("REAL ARRAY");
			    J←AMUNGE(RAITMVR);
			    FOR K ← 1 STEP 1 UNTIL J DO
				OUTTTY(CRLF&CVF(GLOBAL DATUM(RAITMVR)[K]));
			    UNMUNG(RAITMVR);
		      END;
		 [!INTEGER!ARRAY] BEGIN OUTTTY("INTEGER ARRAY");
			    J←AMUNGE(IAITMVR);
			    FOR K ← 1 STEP 1 UNTIL J DO
				OUTTTY(CRLF&CVS(GLOBAL DATUM(IAITMVR)[K]));
			    UNMUNG(IAITMVR);
		      END;
		 [!SET!ARRAY] BEGIN OUTTTY("SET ARRAY");
			    J←AMUNGE(LAITMVR);
			    FOR K ← 1 STEP 1 UNTIL J DO
			    BEGIN OUTTTY(CRLF&"{");
				  OUTLST(GLOBAL DATUM(LAITMVR)[K]);
				  OUTTTY("  ⎇");
			    END;
			    UNMUNG(LAITMVR);
		      END;
		 [!LIST!ARRAY] BEGIN OUTTTY("LIST ARRAY");
			    J←AMUNGE(LAITMVR);
			    FOR K← 1 STEP 1 UNTIL J DO
			    BEGIN OUTTTY(CRLF&"{{");
				  OUTLST(GLOBAL DATUM(LAITMVR)[K]);
				  OUTTTY( "  ⎇⎇");
			    END;
			    UNMUNG(LAITMVR);
		      END;
		 [!CONTEXT!ARRAY] USERERR(0,1,"DRYROT- GLOBAL CONTEXT ARRAY ITEM")

		  FORLC X = !INVALID!TYPEITS DOC
		     [ ; [X] OUTTTY("INVALID TYPEIT CODE X") ] ENDC
	    END "global case";
	END "global if";

   COMMENT OUTPUT GLOBAL ASSOCIATIONS;
   OUTTTY(CRLF&CRLF&CRLF&CRLF&"#GLOBAL ASSOCIATIONS#");

   FOR I ← ITMMAX STEP 1 UNTIL 4095 DO
      IF TYPEIT(CVI(I)) THEN
	 FOREACH SAITMVR,RAITMVR| GLOBAL SAITMVR XOR RAITMVR EQV CVI(I) DO
	    OUTTTY(CRLF&ITNAME(SAITMVR)&" XOR "&ITNAME(RAITMVR)&" EQV "
							&ITNAME(CVI(I)));
   OUTTTY(CRLF);
ENDGLOB
ENDIT:
   ENDOUT;
END "LP4MAT";
END "LP4MAT"