Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0002/lpdump.sai
There is 1 other file named lpdump.sai in the archive. Click here to see a list.
COMMENT    VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY LPDUMP
C00007 00003	   SIMPLE PROCEDURE OUTDES(ITEMVAR X)
C00010 00004	   COMMENT FIRST OPEN THE OUTPUT FILE
C00013 00005	OUTPUT ITEMS AND DATUMS, PNAMES
C00017 00006	   COMMENT NOW OUTPUT THE LOCAL BRACKETED TRIPLES
C00020 00007	GLOB
C00023 00008		COMMENT NOW OUTPUT THE LOCAL ITEM NUMBER, & DATUM
C00027 ENDMK
C;

ENTRY LPDUMP;
BEGIN "DUMPLP"

COMMENT THE FOLLOWING PROCEDURE WRITES OUT THE LEAP WORLD
	INCLUDING THE ITEMS, THEIR DATUMS AND ASSOCIATIONS IN A FORMAT
	THAT MAY BE READ BY THE PROCEDURE "LPREAD".
	THE PARAMETERS TO THIS PROCEDURE ARE A FILENAME, A DEVICE (SUCH
	AS "DSK") AN INTEGER WHICH REFLECTS WHICH LEAP MODELS (GLOBAL, LOCAL),
	ARE TO BE DUMPED, AND A BOOLEAN PROCEDUR WHICH TAKES A REFERENCE 
	ITEMVAR ARGUMENT AND RETURNS TRUE IF 
	ITS ARGUMENT IS AN ITEM WHICH IS TO BE DUMPED.

	THIS PROCEDURE MUST BE LOADED WITH MUNGE WHICH IS FORMED BY
	COMPILING MUNGE.SAI.

	JUNE 24,1973. JIM LOW, STANFORD ARTIFICIAL INTELLIGENCE LAB.;

REQUIRE "TYPEIT.HDR" SOURCE!FILE;

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 ];

INTERNAL PROCEDURE LPDUMP(STRING FNAME,DEVICE;INTEGER WORLDS;
	BOOLEAN PROCEDURE FILTER);
BEGIN	"LPDUMP"
   EXTERNAL INTEGER MAXITM, DATM, INFTB, GDATM, GINFTB;
   REQUIRE "MUNGE.REL[LEP,JRL]" LOADMODULE;
   EXTERNAL INTEGER PROCEDURE AMUNGE(ITEMVAR X);
   EXTERNAL PROCEDURE UNMUNGE(ITEMVAR X);
   EXTERNAL INTEGER PROCEDURE GMUNGE(ITEMVAR X);
   EXTERNAL PROCEDURE GUNMUN(ITEMVAR X);

   BOOLEAN WNTLOC,WNTGLB,BRKFLAG;
   INTEGER LOCMAX,GLBMIN,I,J,TYPE,CHAN,FLAG,IOFLAG,EOF,BRCHAR,COUNT,VALUE,ITEMP;
   ITEMVAR ITMVR1,ITMVR2,ITMVR3;
   STRING ITEMVAR SITMVR;INTEGER ITEMVAR IITMVR;
   LIST ITEMVAR LITMVR;STRING ARRAY ITEMVAR SAITMVR;
   INTEGER ARRAY ITEMVAR IAITMVR;LIST ARRAY ITEMVAR LAITMVR;
   LIST BRKLIST,GBRKLIST;
   LABEL ENDIT;
   
   DEFINE ASSOCMAK(IT1,IT2,IT3)= [((((CVN(IT1)LSH 12)LOR CVN(IT2))
						LSH 12) LOR CVN(IT3))],
	  P = ['17],
	  CRLF = ['15&'12],
	  ! = [COMMENT];
	
   SIMPLE PROCEDURE STROUT(STRING X);
   BEGIN "STROUT"
      INTEGER VALUE,I;

      WORDOUT(CHAN,LENGTH(X));
      VALUE_ I_ 0;
      WHILE(LENGTH(X)) DO
      BEGIN VALUE_(VALUE LSH 7) LOR LOP(X);
	      IF(I_I+1)=5 THEN
	      BEGIN WORDOUT(CHAN,VALUE LSH 1);
		    I_ VALUE_ 0;
	      END;
      END;
      WORDOUT(CHAN,IF I THEN VALUE LSH ((5-I)*7+1) ELSE 0);
   END "STROUT";

   SIMPLE PROCEDURE LISTOUT(LIST X);
   BEGIN "LSTOUT" 
      ITEMVAR ITMVR1; INTEGER VALUE,I;
      FOREACH ITMVR1 | ITMVR1  X  (FILTER(ITMVR1)) DO
           REMOVE ITMVR1 FROM X;
      WORDOUT(CHAN,LENGTH(X));
      I _ VALUE _ 0;
      WHILE LENGTH(X) DO
      BEGIN VALUE _ (VALUE LSH 12) LOR CVN(LOP(X));
	    IF (I_I+1)= 3 THEN 
	       BEGIN WORDOUT(CHAN,VALUE);
		     I _ VALUE _ 0;
	       END;
      END;
      WORDOUT(CHAN,IF I THEN VALUE LSH ((3-I)*12) ELSE 0);
   END "LSTOUT";


   SIMPLE PROCEDURE OUTDES(ITEMVAR X);
   BEGIN "OUTDES"
      LABEL L1,L2;INTERNAL LABEL OUTDE2;
      STARTCODE
	      MOVE	3,-1(P);	! THE PARAM;
	      HRRZ	3,@DATM;	! THE ARRAY DESCRIPTOR;
	      SKIPG	-2(3);		! STRING ARRAY?;
	      SUBI	3,1;		! YES.;
      OUTDE2: HLRE	2,-1(3);	! NUMBER OF DIMENSIONS;
	      MOVMS	2;		! MAKE POS.;
	      PUSH	P,2;		! SAVE NUMBER OF DIM.;
	      PUSH	P,3;		! SAVE ADDR OF ARRAY;
	      PUSH	P,CHAN;		
	      LSH	2,1;
	      ADDI	2,1;
	      PUSH	P,2;
	      PUSHJ	P,WORDOUT;	! OUTPUT 2*DIM+1;
	      POP	P,3;		! ADDRESS OF ARRAY;
	      MOVE	2,(P);		! NUMBER OF DIMENSIONS AGAIN;
	      IMULI	2,3;		! THREE ENTRIES PER DIMENSION;
	      SUBI	3,1(2);		! ADDR LOWEST DIMENSION;
	      PUSH	P,3;		! SAVE ON STACK OVER FN CALLS;
      L1:	SOSGE	-1(P);		! PROCESSED ALL DIMENSIONS?;
	      JRST	L2;		! YES.;
	      PUSH	P,CHAN;
	      PUSH	P,@-1(P);	! BOUND TO BE OUTPUT;
	      PUSHJ	P,WORDOUT;	! PUT OUT LOWER BOUND;
	      PUSH	P,CHAN;
	      AOS	-1(P);		! ADDR UPPER BOUND;
	      PUSH	P,@-1(P);
	      PUSHJ	P,WORDOUT;	! PUT OUT UPPER BOUND;
	      MOVEI	3,2;
	      ADDM	3,(P);		! TO GET ADDR NEXT BOUND PAIR;
	      JRST	L1;		! LOOP;
      L2:	POP	P,2;		! ADDR DIMENSION ENTRY;
	      SUB	P,['1000001];	! REMOVE DIMENSION COUNT FROM STACK;
	      HLRE	3,(2);		! NUMBER OF DIMENSIONS;
	      MOVMS   3,3;
	      SKIPG	(2);		! STRING ARRAY?;
	      HRROS	3;		! YES.;
	      PUSH	P,CHAN;
	      PUSH	P,3;		! OUTPUT DIMENSION ENTRY;
	      PUSHJ	P,WORDOUT;
      END;
   END "OUTDES";

GLOB

   SIMPLE PROCEDURE GOUTDES(ITEMVAR X);
   BEGIN EXTERNAL INTEGER OUTDE2;
	STARTCODE;
	      MOVE	3,-1(P);	! THE GLOBAL ITEM NUMBER;
	      HRRZ	3,@GDATM;	! THE ARRAY DESCRIPTOR;
	      JRST	OUTDE2;		! HANDLE IT;
	END;
   END;
ENDGLOB


   COMMENT FIRST OPEN THE OUTPUT FILE;

   OPEN(CHAN_GETCHAN,DEVICE,'10,0,2,COUNT,BRCHAR,EOF);
   ENTER(CHAN,FNAME,IOFLAG);

   COMMENT WHAT PARTS OF LEAP DO WE WANT DUMPED;
   WNTLOC_WNTGLB_ TRUE;
   CASE WORLDS OF
   BEGIN [1] "local model only"
	     BEGIN IF INFTB = 0 THEN 
			BEGIN USERERR(0,1,"LPDUMP: NOTHING TO DUMP?");
				GO TO ENDIT;
			END;
		   WNTGLB_FALSE;
	     END;
	 [2] "global model only"
GLOB
	     BEGIN IF GINFTB = 0 THEN
			BEGIN USERERR(0,1,"LPDUMP: NOTHING TO DUMP?");
				GO TO ENDIT;
			END;
		   WNTLOC_FALSE;
	     END;
ENDGLOB
NOGLOB
		USERERR(0,1,"THERE IS NO GLOBAL MODEL TO DUMP");
ENDNOGLOB

	 [3] "both"
		BEGIN IF INFTB = 0 THEN
			BEGIN OUTSTR('15&'12&"NO LOCAL LEAP MODEL TO DUMP");
			      WNTLOC _ FALSE;
			      WORLDS _ WORLDS-1; "global model only"
			END;
GLOB
		      IF GINFTB = 0 THEN
			BEGIN OUTSTR('15&'12&"NO GLOBAL LEAP MODEL TO DUMP");
			      WNTGLB_FALSE;
				IF (WORLDS_WORLDS-2) THEN
				    BEGIN USERERR(0,1,"LPDUMP: NOTHING TO DUMP?");
					GOTO ENDIT;
				    END;
			END;
ENDGLOB
		END
   END;

   WORDOUT(CHAN,WORLDS); COMMENT 1 INDICATES A LOCAL MODEL,
				 2 INDICATES A GLOBAL MODEL,
				 3 INDICATES BOTH;


   USERCON(MAXITM,LOCMAX,2); "highest local item number"
   IF WORLDS  2 THEN USERCON(MAXITM,GLBMIN,-2); "lowest global item number"

   COMMENT OUTPUT THE LOWEST AND HIGHEST ITEM NUMBERS;
   WORDOUT(CHAN,CASE WORLDS OF (0,1,GLBMIN,1));
   WORDOUT(CHAN,CASE WORLDS OF (0,LOCMAX,'7777,'7777));


COMMENT OUTPUT ITEMS AND DATUMS, PNAMES;
GLOB
   COMMENT OUTPUT THE GLOBAL ITEMS,DATUM TYPES, & PNAMES, EXCEPT
	   FOR BRACKETED TRIPLES;

   IF WNTGLB THEN
      BEGIN FOR I _ GLBMIN STEP 1 UNTIL 4095 DO
		IF FILTER(CVI(I)) THEN
		 IF (TYPE_TYPEIT(CVI(I)))= 2 THEN GBRKLIST[+1]_CVI(I)
		    ELSE
		      BEGIN WORDOUT(CHAN,I); "GLOBAL ITEM NUMBER"
			    WORDOUT(CHAN,TYPE); "DATUM TYPE"
			    WORDOUT(CHAN,GLOBAL PROPS(CVI(I))); "PROPS"
			    STROUT(CVIS(CVI(I),FLAG)); "PNAME"
		      END;
	    WORDOUT(CHAN,0); "separator"
      END;
ENDGLOB

   COMMENT OUTPUT THE LOCAL ITEMS,DATUM TYPES, &  PNAMES, 
	   EXCEPT FOR BRACKETED TRIPLES;

   IF WNTLOC THEN
      BEGIN FOR I _ 1 STEP 1 UNTIL LOCMAX DO
		IF FILTER(CVI(I)) THEN
		 IF (TYPE_TYPEIT(CVI(I)))= 2 THEN BRKLIST[+1]_CVI(I)
		    ELSE
		      BEGIN WORDOUT(CHAN,I); "ITEM NUMBER"
			      WORDOUT(CHAN,TYPE); "DATUM TYPE"
			      WORDOUT(CHAN,PROPS(CVI(I))); "PROPS"
			      STROUT(CVIS(CVI(I),FLAG));"PNAME"
		      END;

	    WORDOUT(CHAN,0); "separator"
      END;
GLOB

   COMMENT OUTPUT THE GLOBAL BRACKETED TRIPLES;
   IF WNTGLB THEN
      BEGIN WHILE LENGTH(GBRKLIST) DO
	    BEGIN ITMVR1_ LOP(GBRKLIST);
		  WORDOUT(CHAN,CVN(ITMVR1));
		  WORDOUT(CHAN,GLOBAL PROPS(ITMVR1));
		  STROUT(CVIS(ITMVR1,FLAG)); "PNAME"
		  BRKFLAG _ TRUE;
		  IF FILTER(ITMVR3_GLOBAL THIRD(ITMVR1)) THEN
			BEGIN BRKFLAG _FALSE;
			  OUTSTR('15&'12&"LPDUMP:WARNING INVALID VALUE"&
				"-BRACKETED TRIPLE");
			END;
		  IF FILTER(ITMVR2_GLOBAL SECOND(ITMVR1)) THEN
			BEGIN BRKFLAG_FALSE;
			  OUTSTR('15&'12&"LPDUMP:WARNING INVALID OBJECT"&
				"- BRACKETED TRIPLE");
			END;
		  IF FILTER(ITMVR1_GLOBAL FIRST(ITMVR1)) THEN
			BEGIN BRKFLAG_FALSE;
			  OUTSTR('15&'12&"LPDUMP:WARNING INVALID ATTRIBUTE"&
				"- BRACKETED TRIPLE");
			END;
		  WORDOUT(CHAN,IF BRKFLAG THEN ASSOCMAK(ITMVR1,ITMVR2,ITMVR3)
					ELSE 0);
	    END;
	    WORDOUT(CHAN,0); "separator"
      END;
ENDGLOB

   COMMENT NOW OUTPUT THE LOCAL BRACKETED TRIPLES;
   IF WNTLOC THEN
      BEGIN WHILE LENGTH(BRKLIST) DO
	    BEGIN ITMVR1_ LOP(BRKLIST);
		  BRKFLAG _ TRUE;
		  WORDOUT(CHAN,CVN(ITMVR1));
		  WORDOUT(CHAN,PROPS(ITMVR1));
		  STROUT(CVIS(ITMVR1,FLAG)); "PNAME"
		  IF FILTER(ITMVR3_THIRD(ITMVR1)) THEN
			BEGIN BRKFLAG _ FALSE;
			  OUTSTR('15&'12&"LPDUMP:WARNING INVALID VALUE -"&
				"BRACKETED TRIPLE");
			END;
		  IF FILTER(ITMVR2_SECOND(ITMVR1)) THEN
			BEGIN BRKFLAG _ FALSE;
			  OUTSTR('15&'12&"LPDUMP:WARNING INVALID OBJECT -"&
				"BRACKETED TRIPLE");
			END;
		  IF FILTER(ITMVR1_FIRST(ITMVR1)) THEN
			BEGIN BRKFLAG _ FALSE;
			  OUTSTR('15&'12&"LPDUMP:WARNING INVALID ATTRIBUTE-"&
				"BRACKETED TRIPLE");
			END;
		  WORDOUT(CHAN,IF BRKFLAG THEN ASSOCMAK(ITMVR1,ITMVR2,ITMVR3)
					ELSE 0);
	    END;

	    WORDOUT(CHAN,0); "separator"
      END;
GLOB

   COMMENT NOW PUT OUT THE GLOBAL ASSOCIATIONS;

   IF WNTGLB THEN
      BEGIN FOR I _ GLBMIN STEP 1 UNTIL 4095 DO
		IF FILTER(CVI(I)) THEN
		    BEGIN
		       FOREACH ITMVR2,ITMVR3| GLOBAL ITMVR2ITMVR3 CVI(I) 
			      (FILTER(ITMVR2) FILTER(ITMVR3)) DO
			    WORDOUT(CHAN,ASSOCMAK(ITMVR2,ITMVR3,CVI(I)));
		    END;
	    WORDOUT(CHAN,0); "separator"
      END;
ENDGLOB

   COMMENT NOW PUT OUT THE LOCAL ASSOCIATIONS;

   IF WNTLOC THEN
      BEGIN FOR I _ 1 STEP 1 UNTIL LOCMAX DO
		IF FILTER(CVI(I)) THEN
		    BEGIN
		       FOREACH ITMVR2,ITMVR3| ITMVR2ITMVR3 CVI(I) 
			      (FILTER(ITMVR2) FILTER(ITMVR3)) DO
			    WORDOUT(CHAN,ASSOCMAK(ITMVR2,ITMVR3,CVI(I)));
		    END;
	    WORDOUT(CHAN,0); "separator"
      END;


GLOB
	COMMENT NOW OUTPUT THE GLOBAL ITEM NUMBER, & DATUM;
	IF WNTGLB THEN
	BEGIN FOR I_ GLBMIN STEP 1 UNTIL 4095 DO
		  IF FILTER(CVI(I)) ((TYPE_TYPEIT(CVI(I)))  2) THEN
		       BEGIN	WORDOUT(CHAN,I);"ITEM NUMBER"
			  IITMVR_IAITMVR_SITMVR_SAITMVR_LITMVR_LAITMVR_CVI(I);
			  CASE (TYPE) OF
			  BEGIN [!DELETED] "UNALLOCATED"
				     OUTSTR('15&'12&"LPDUMP:WARNING-OUTPUTTING"&
					" UNALLOCATED ITEM");
				[!UNTYPED] "UNTYPED" ;
				"BRACKETED TRIPLES ALREADY PUT OUT"
				[!STRING] USERERR(0,1,"LPDUMP:DRYROT GLOBAL STRING");
				[!REAL] "REAL" WORDOUT(CHAN,GLOBAL DATUM(IITMVR));
				[!INTEGER] "INTEGER" WORDOUT(CHAN,GLOBAL DATUM(IITMVR));
				[!SET] "SET"  LISTOUT(GLOBAL DATUM(LITMVR));
				[!LIST] "LIST" LISTOUT(GLOBAL DATUM(LITMVR));
				[!STRING!ARRAY] USERERR(0,1,"LPDUMP: GLOBAL STRING ARRAY");
				[!REAL!ARRAY] "REAL ARRAY"
				     BEGIN GOUTDES(IAITMVR);
					  ITEMP_GMUNGE(IAITMVR);
					   ARRYOUT(CHAN,GLOBAL DATUM(IAITMVR)[1],ITEMP);
					  GUNMUN(IAITMVR);
				     END;
				[!INTEGER!ARRAY] "INTEGER ARRAY"
				     BEGIN GOUTDES(IAITMVR);
					  ITEMP_GMUNGE(IAITMVR);
					  ARRYOUT(CHAN,GLOBAL DATUM(IAITMVR)[1],ITEMP);
					  GUNMUN(IAITMVR);
				     END;
				[!SET!ARRAY] "SET ARRAY"
				     BEGIN  GOUTDES(LAITMVR);
					  ITEMP_GMUNGE(LAITMVR);
					  FOR J _ 1 STEP 1 UNTIL ITEMP DO
						  LISTOUT(GLOBAL DATUM(LAITMVR)[J]);
					  GUNMUN(LAITMVR);
				     END;
				[!LIST!ARRAY] "LIST ARRAY"
				     BEGIN GOUTDES(LAITMVR);
					  ITEMP_GMUNGE(LAITMVR);
					  FOR J _ 1 STEP 1 UNTIL ITEMP DO
						  LISTOUT(GLOBAL DATUM(LAITMVR)[J]);
					  GUNMUN(LAITMVR);
				     END
			    FORLC X = !INVALID!TYPEITS DOC
			      [; [X] "INVALID"
				      BEGIN OUTSTR("ITEM NO."&CVS(I)&"INVALID TYPE");
				      END ] ENDC
			  END;
		       END;
		WORDOUT(CHAN,0); "separator"
	END;

ENDGLOB

	COMMENT NOW OUTPUT THE LOCAL ITEM NUMBER, & DATUM;
        IF WNTLOC THEN
	   BEGIN FOR I_ 1 STEP 1 UNTIL LOCMAX DO
		     IF FILTER(CVI(I)) ((TYPE_TYPEIT(CVI(I)))  2) THEN
			  BEGIN	WORDOUT(CHAN,I);"ITEM NUMBER"
			     IITMVR_IAITMVR_SITMVR_SAITMVR_LITMVR_LAITMVR_CVI(I);
			     CASE (TYPE) OF
			     BEGIN [!DELETED] "UNALLOCATED"
					OUTSTR('15&'12&"LPDUMP: WARNING "&
						"OUTPUTING UNALLOCATED ITEM");
				   [!UNTYPED] "UNTYPED" ;
				   "BRACKETED TRIPLES ALREADY PUT OUT"
				   [!STRING] "STRING ITEM" STROUT(DATUM(SITMVR));
				   [!REAL] "REAL" WORDOUT(CHAN,DATUM(IITMVR));
				   [!INTEGER] "INTEGER" WORDOUT(CHAN,DATUM(IITMVR));
				   [!SET] "SET"  LISTOUT(DATUM(LITMVR));
				   [!LIST] "LIST" LISTOUT(DATUM(LITMVR));
				   [!STRING!ARRAY] "STRING ARRAY"
					BEGIN OUTDES(SAITMVR);
					     ITEMP_AMUNGE(SAITMVR);	
					     FOR J _ 1 STEP 1 UNTIL ITEMP DO
						     STROUT(DATUM(SAITMVR)[J]);	
					     UNMUNGE(SAITMVR);	
					END;
				   [!REAL!ARRAY] "REAL ARRAY"
					BEGIN OUTDES(IAITMVR);
					     ITEMP_AMUNGE(IAITMVR);
					      ARRYOUT(CHAN,DATUM(IAITMVR)[1],ITEMP);
					     UNMUNGE(IAITMVR);
					END;
				   [!INTEGER!ARRAY] "INTEGER ARRAY"
					BEGIN OUTDES(IAITMVR);
					     ITEMP_AMUNGE(IAITMVR);
					     ARRYOUT(CHAN,DATUM(IAITMVR)[1],ITEMP);
					     UNMUNGE(IAITMVR);
					END;
				   [!SET!ARRAY] "SET ARRAY"
					BEGIN  OUTDES(LAITMVR);
					     ITEMP_AMUNGE(LAITMVR);
					     FOR J _ 1 STEP 1 UNTIL ITEMP DO
						     LISTOUT(DATUM(LAITMVR)[J]);
					     UNMUNGE(LAITMVR);
					END;
				   [!LIST!ARRAY] "LIST ARRAY"
					BEGIN OUTDES(LAITMVR);
					     ITEMP_AMUNGE(LAITMVR);
					     FOR J _ 1 STEP 1 UNTIL ITEMP DO
						     LISTOUT(DATUM(LAITMVR)[J]);
					     UNMUNGE(LAITMVR);
					END
				FORLC X = !INVALID!TYPEITS DOC
				 [ ;
				   [X] "INVALID"
					 BEGIN OUTSTR("ITEM NO."&CVS(I)&"INVALID TYPE");
					 END ] ENDC
			     END;
			END;
		 WORDOUT(CHAN,0); "separator"
	END;
ENDIT:	CLOSE(CHAN);
	RELEASE(CHAN);
	OUTSTR("DUMP COMPLETE"&CRLF);
END "LPDUMP";
END "DUMPLP"