Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/lpread.sai
There is 1 other file named lpread.sai in the archive. Click here to see a list.
COMMENT    VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY LPREAD
C00007 00003	   COMMENT READIN "WORLD" CODE
C00010 00004	   BEGIN INTEGER ARRAY CONVERT[ITMMIN:ITMMAX]
C00013 00005		STRING PROCEDURE STRIN
C00016 00006		SIMPLE PROCEDURE GETARRAY(ITEMVAR X)
C00020 00007	GLOB
C00023 00008		COMMENT READIN LOCAL ITEM NUMBERS AND PNAMES
C00026 00009	GLOB
C00028 00010		COMMENT INPUT LOCAL BRACKETED TRIPLES
C00030 00011	GLOB
C00035 00012		COMMENT INPUT LOCAL DATUMS
C00039 ENDMK
C;

ENTRY LPREAD;
BEGIN "READLP"

COMMENT 
	THIS FILE CONTAINS THE SOURCE FOR THE LPREAD PROCEDURE (RECIPROCAL
	OF LPDUMP). PARAMETERS ARE FNAME (THE NAME OF THE FILE CREATED BY
	LPDUMP), DEVICE (E.G. "DSK") AND MODE.
	
	MODE = 1 MEANS NO MERGE (EACH ITEM READ IN IS CONSIDERED TO BE NEW
		IF NO ITEM ALREADY HAS ITS PNAME THEN IT KEEPS ITS PNAME
		OTHERWISE THE ITEM READ IN WILL NOT HAVE A PNAME.
	MODE = 2 MEANS MERGE ASSOCIATIONS AND DATUMS. ITEMS READ IN WILL
		BE CONSIDERED TO BE THE SAME AS EXTANT ITEMS IF THEY HAVE
		THE SAME PNAMES. THE DATUMS OF EXTANT ITEMS WILL BE REPLACED
		BY THE DATUMS READ IN.
	MODE = 3 . SAME AS MODE 2 EXCEPT EXTANT ITEMS RETAIN THEIR DATUMS.

	THIS FILE SHOULD BE COMPILED AND THEN REQUIRED AS A LOADMODULE.

		REQUIRE "LPREAD" LOADMODULE
		EXTERNAL PROCEDURE LPREAD(STRING FNAME,DEVICE INTEGER MODE)
	(REMEMBER TO INSERT THE MISSING SEMICOLONS ABOVE).
	ALSO REQUIRED IN MUNGE.REL WHICH IS FORMED BY COMPILING MUNGE.SAI.
	
;

REQUIRE "TYPEIT.HDR" SOURCE!FILE;

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

INTERNAL PROCEDURE LPREAD(STRING FNAME,DEVICE;INTEGER MODE);
BEGIN "LPREAD"
   INTEGER ITMMAX,ITMMIN,I,J,TYPE,CHAN,FLAG,IOFLAG,EOF,BRCHAR,COUNT,
	   VALUE,ITEMP,ITNO,WORD,ATT,OBJ,VAL,WORLDS;
   BOOLEAN WNTLOC,WNTGLB;
   STRING PNAME;
   ITEMVAR DUM,ITMVR;
   LIST BRKBRK,BRKBRK2;
   LABEL ENDIT;

   EXTERNAL INTEGER ARYLS,INFTB,DATM,FP1,GOGTAB;
GLOB
   EXTERNAL INTEGER GINFTB,GDATM,USCOR2;
ENDGLOB
   EXTERNAL PROCEDURE SDESCR;
   EXTERNAL PROCEDURE ARMAK;
   EXTERNAL PROCEDURE FP1DON;

   DEFINE P = ['17], CRLF = [('15&'12)],
	   USER=['15],FP=['6],! = [COMMENT];

   REQUIRE "MUNGE.REL[LEP,JRL]" LOADMODULE;
   EXTERNAL INTEGER PROCEDURE AMUNGE(ITEMVAR X);
   EXTERNAL PROCEDURE UNMUNGE(ITEMVAR X);
GLOB
   EXTERNAL INTEGER PROCEDURE GMUNGE(ITEMVAR X);
   EXTERNAL PROCEDURE GUNMUN(ITEMVAR X);
ENDGLOB

   DEFINE INITTP(ITNO,TYPE) = [
	   STARTCODE
		   MOVE 3,ITNO;
		   MOVE 2,TYPE;
		   HRRM 2,@INFTB;
	   END;];
GLOB
   DEFINE GINITTP(ITNO,TYPE) = [
	   STARTCODE
		   MOVE 3,ITNO;
		   MOVE 2,TYPE;
		   HRRM 2,@GINFTB;
	   END;];
ENDGLOB
   COMMENT FIRST OPEN THE INPUT FILE;

   OPEN(CHAN_GETCHAN,DEVICE,'10,2,0,COUNT,BRCHAR,EOF);
   IOFLAG _ TRUE;
   WHILE IOFLAG DO
   BEGIN LOOKUP(CHAN,FNAME,IOFLAG);
	 IF IOFLAG THEN
	    BEGIN OUTSTR(CRLF & "UNABLE TO OPEN LPREAD INPUT FILE:"& FNAME &
		         CRLF & "FILE =");
		  FNAME _ INCHWL;
		  IOFLAG_ TRUE;
	    END ELSE DONE;
   END;


   COMMENT READIN "WORLD" CODE;
   WORLDS_ WORDIN(CHAN);

   COMMENT WORLDS =1, ONLY LOCAL LEAP WAS DUMPED.
		   2, ONLY GLOBAL LEAP WAS DUMPED.
		   3, BOTH LOCAL AND GLOBAL WERE DUMPED;

   COMMENT READIN MINIMUM AND MAXIMUM ITEM NUMBERS DUMPED;

   ITMMIN_ WORDIN(CHAN); "minimum"
   ITMMAX_ WORDIN(CHAN); "maximum"

   COMMENT CHECK IF LEAP PROPERLY INITIALIZED;

   CASE WORLDS OF
   BEGIN
     [1] "local" 
       BEGIN WNTLOC _ TRUE; WNTGLB _ FALSE;
	     IF INFTB THEN
	       BEGIN USERERR(0,1,"LPREAD: NEEDS LOCAL LEAP MODEL");
		     OUTSTR(CRLF&"WILL IGNORE CALL TO LPREAD");
		     GO TO ENDIT;
	       END;
       END;
     [2] "global"
GLOB
       BEGIN WNTLOC _ FALSE; WNTGLB _ TRUE;
	     IF GINFTB THEN
	       BEGIN USERERR(0,1,"LPREAD: NEEDS GLOBAL LEAP MODEL");
		     OUTSTR(CRLF&"WILL IGNORE CALL TO LPREAD");
		     GO TO ENDIT;
	       END;
       END;
ENDGLOB
NOGLOB
	USERERR(0,1,"LPREAD:VERSION CAN'T READ GLOBAL LEAP MODEL");
ENDNOGLOB
     [3] "both"
GLOB
       BEGIN WNTLOC _WNTGLB _ TRUE;
	     IF GINFTB  INFTB THEN
	       BEGIN USERERR(0,1,"LPREAD: NEEDS LOC. OR GLOB. MODEL");
		     OUTSTR(CRLF&"WILL IGNORE CALL TO LPREAD");
		     GO TO ENDIT;
	       END;
       END
ENDGLOB
NOGLOB
	USERERR(0,1,"LPREAD:VERSION CAN'T READ GLOBAL LEAP MODEL")
ENDNOGLOB
   END;


   BEGIN INTEGER ARRAY CONVERT[ITMMIN:ITMMAX];
	INTEGER TPROPS;
	LABEL DATLP;
	ITEMVAR PROCEDURE CONVERTS(INTEGER I);
	BEGIN "CONVERTS"
	      DEFINE BOUND(X) = "CVN(X)";
	      ITEMVAR TITMVR;
	      IF I < ITMMIN  I > ITMMAX THEN
		 BEGIN USERERR(0,1,"LPREAD: READ INVALID ITEM NUMBER");
		       I _ ITMMIN;
		 END;
	      TITMVR _ CVI(CONVERT[I]);
	      IF BOUND(TITMVR) THEN
		   USERERR(0,1,"LPREAD: READ UNALLOCATED ITEM NUMBER");
	      RETURN(TITMVR);
	END "CONVERTS";

	LIST PROCEDURE LISTIN;
	BEGIN "LISTIN"
	      INTEGER VALUE, I, LEN;
	      LIST X;
	      LEN_WORDIN(CHAN);
	      I_3; X_ NIL;
	      WHILE LEN DO
	      BEGIN LEN_LEN-1;
		    IF(I_I+1)> 3 THEN
		      BEGIN I_1;
			    VALUE_ WORDIN(CHAN);
		      END;
		    X[+1]_CONVERTS((VALUE_VALUE ROT 12) LAND '7777);
	      END;
	      IF I = 3 THEN VALUE_ WORDIN (CHAN);
	      RETURN (X);
	END "LISTIN";

	SET PROCEDURE  SETIN;
	BEGIN "SETIN"
	      INTEGER VAL, I, LEN;
	      SET X;

	      LEN_ WORDIN(CHAN);
	      I_ 3; X _ PHI;
	      WHILE LEN DO
	      BEGIN LEN _ LEN -1;
		      IF (I_ I+1)> 3 THEN
		      BEGIN	I_1;
			      VAL_ WORDIN(CHAN);
		      END;
		      PUT CONVERTS((VAL_(VAL ROT 12)) LAND '7777) IN X;
	      END;
	      IF I = 3 THEN VAL_WORDIN(CHAN);
	      RETURN(X);
	END "SETIN";


	STRING PROCEDURE STRIN;
	BEGIN "STRIN"
	     INTEGER VAL,I,LEN;
	     STRING X;

	     LEN_WORDIN(CHAN);
	     I_5;
	     X_ NULL;
	     WHILE LEN DO
	     BEGIN LEN_ LEN-1;
		     IF (I_I+1)>5 THEN
		     BEGIN I_ 1;
			     VAL_WORDIN(CHAN);
		     END;
		     X _ X & ((VAL _ VAL ROT 7) LAND '177);
	     END;
	     IF I= 5 THEN VAL_WORDIN(CHAN);
	     RETURN(X);
	END "STRIN";

	PROCEDURE BRACKMAKE(INTEGER ATT,OBJ,VAL;STRING PNAME;INTEGER TPROPS;
					BOOLEAN GLOBLE);
	BEGIN "BRACK"
	     ITEMVAR ITMVR1,ITMVR2,ITMVR3;
	     IF CVN(ITMVR1_CONVERTS(ATT))  CVN(ITMVR2_CONVERTS(OBJ)) 
		     CVN(ITMVR3_CONVERTS(VAL)) THEN
		  BEGIN	BRKBRK[+1]_CVI(ITNO);
			IF WNTLOC THEN BRKBRK[+1]_NEW(PNAME);
			BRKBRK[+1]_CVI(ATT);
			BRKBRK[+1]_CVI(OBJ);
			BRKBRK[+1]_CVI(VAL);
			BRKBRK[+1]_CVI(TPROPS);
			RETURN;
		  END;
GLOB
	     IF GLOBLE THEN
		  BEGIN GLOBAL MAKE DUMDUM[GLOBAL ITMVR1ITMVR2ITMVR3];
			CONVERT[ITNO] _ CVN(ITMVR1_COP(GLOBAL DUMDUM));
			GLOBAL PROPS(ITMVR1)_ TPROPS;
			FLAG_TRUE;
			IF LENGTH(PNAME) THEN NEWPNAME(ITMVR1,PNAME);
			GLOBAL ERASE DUMDUMANY;
		  END ELSE
ENDGLOB
	          BEGIN MAKE DUMDUM[ITMVR1ITMVR2ITMVR3];
			CONVERT[ITNO] _ CVN(ITMVR1_COP(DUMDUM));
			PROPS(ITMVR1) _ TPROPS;
			FLAG_TRUE;
			IF LENGTH(PNAME) THEN NEWPNAME(ITMVR1,PNAME);
			ERASE DUMDUMANY;
		  END;
	END;


	SIMPLE PROCEDURE GETARRAY(ITEMVAR X);
	BEGIN "GETARRAY"
	   LABEL L1,L2,L4,USERR;
GLOB
	   LABEL L3;
	   BOOLEAN GLBFLAG;
	   EXTERNAL SIMPLE PROCEDURE IFGLOBAL;
ENDGLOB
	     STARTCODE
GLOB
		     PUSH    P,-1(P);  ! THE ITEMVAR PARAM?;
		     PUSHJ   P,IFGLOBAL;! IS IT GLOBAL?;
		     MOVEM   1,GLBFLAG;! SAVE GLOBAL STATUS;
ENDGLOB
		     PUSH    P,CHAN;
		     PUSHJ   P,WORDIN; ! NUMBER OF PARAMS TO ARMAK;
		     JUMPLE  1,USERR;  ! BETTER BE SOME;
	     L1:     PUSH    P,1;      ! SAVE COUNT ;
		     PUSH    P,CHAN;
		     PUSHJ   P,WORDIN; ! INPUT A PARAM TO ARMAK;
		     EXCH    1,(P);    ! PUT PARAM ON STACK, GET COUNT;
		     SOJG    1,L1;     ! LOOP UNTIL DONE;
		     MOVE    USER,GOGTAB;
GLOB
		     SKIPE   GLBFLAG;  ! GLOBAL ARRAY?;
		     SETOM   USCOR2(USER); ! USE HIGH CORE.;
ENDGLOB
		     PUSHJ   P,ARMAK;  ! GET THE ARRAY;
		     MOVE    USER,GOGTAB; ! USER TABLE;
GLOB
		     SETZM   USCOR2(USER); ! USE LOW CORE AGAIN.;
ENDGLOB
		     SKIPL   -2(1);    ! A STRING ARRAY?;
		     JRST    L2;       ! NO.
		     SKIPN   FP,FP1(USER); ! HEAD OF ONE-WORD FREE LIST;
		     PUSHJ   P,FP1DON; ! NO FREES YET, GO GET SOME;
		     MOVEI   2,(FP);   ! ADDRESS OF A FREE;
		     SKIPN   FP,(FP);  ! FOR NEXT TIME;
		     PUSHJ   P,FP1DON;
		     HRRM    FP,FP1(USER); ! SAVE NEW HEAD OF FREE LIST;
		     HRLM    1,(2);    ! ADDRESS OF STRING ARRAY;
		     HRR     3,ARYLS(USER); ! LIST OF STRING ARRAYS;
		     HRRM    3,(2);    ! LINK IN THIS ARRAY;
		     HRRZM   2,ARYLS(USER); ! NEW LIST OF STRING ARRAYS;
	     L2:     MOVE    3,-1(P);  ! ITEMVAR PARAMETER;
GLOB
		     SKIPE   GLBFLAG;  ! GLOBAL ITEM;
		     JRST    L3;       ! YES;
ENDGLOB
		     HRRZM   1,@DATM;  ! PUT ADDR ARRAY IN DATUM TABLE;
GLOB
		     JRST    L4;
	     L3:     HRRZM   1,@GDATM  ! PUT ADDR ARRAY IN GLOB DATUM TABLE;
ENDGLOB
	     END;
	L4:  RETURN;
	USERR: USERERR(0,1,"DRYROT- READING ARRAY ITEM:LPREAD");
	END;


GLOB
	COMMENT READIN GLOBAL ITEM NUMBERS AND PNAMES IF ANY;
	IF WNTGLB THEN
	WHILE ITNO_WORDIN(CHAN)  DO
	BEGIN TYPE _ WORDIN(CHAN);
	      TPROPS _ WORDIN(CHAN);
	      PNAME_ STRIN;
	      CASE MODE OF
	      BEGIN
		 [1]"NO MERGE"
		    BEGIN CONVERT[ITNO]_ CVN(ITMVR _ GLOBAL NEW);
		       CVSI(PNAME,FLAG);
		       IF FLAG  PNAME  NULL THEN
			       NEWPNAME(ITMVR,PNAME);
		       GINITTP(ITMVR,TYPE);
		       GLOBAL PROPS(ITMVR)_ TPROPS;
		    END;

		 [2]"MERGE ASSOCIATIONS AND DATUMS"
		    BEGIN ITMVR _ CVSI(PNAME,FLAG);
		       IF FLAG THEN
			 BEGIN CONVERT[ITNO]_CVN(ITMVR_ GLOBAL NEW);
			    IF LENGTH(PNAME) THEN
				      NEWPNAME(ITMVR,PNAME);
			 END ELSE
			 BEGIN CONVERT[ITNO]_CVN(ITMVR);
			    IF TYPE  TYPEIT(ITMVR) THEN
			       OUTSTR("DATUM TYPE MISMATCH. "&
				  "ITEM "& PNAME & ('15&'12));
			    IF IFGLOBAL(ITMVR) THEN
			       USERERR(0,1,"LPREAD:GLOBAL-LOCAL MISMATCH");
			    GLOBAL DELETE(ITMVR);
			    NEWPNAME(ITMVR_GLOBAL NEW,PNAME);
			 END;
		       GINITTP(ITMVR,TYPE);
		       GLOBAL PROPS(ITMVR)_TPROPS;
		    END;
		 [3]"MERGE JUST ASSOCIATIONS"
		    BEGIN ITMVR _ CVSI(PNAME,FLAG);
		       IF FLAG THEN
			 BEGIN CONVERT[ITNO]_ CVN(ITMVR _ GLOBAL NEW);
			    IF LENGTH(PNAME) THEN
				    NEWPNAME(ITMVR,PNAME);
			    GINITTP(ITMVR,[1]);
			 END ELSE
			 BEGIN CONVERT[ITNO] _ CVN(ITMVR);
			    IF IFGLOBAL(ITMVR) THEN
			      USERERR(0,1,"LPREAD:GLOBAL-LOCAL MISMATCH");
			 END;
		    END 
	      END;
	END;
ENDGLOB

	COMMENT READIN LOCAL ITEM NUMBERS AND PNAMES;

	IF WNTLOC THEN
	WHILE ITNO_WORDIN(CHAN)  DO
	BEGIN TYPE _ WORDIN(CHAN);
	   TPROPS _ WORDIN(CHAN);
	   PNAME_ STRIN;
	   CASE MODE OF
	   BEGIN
	      [1]"NO MERGE"
		  BEGIN CONVERT[ITNO]_ CVN(ITMVR _ NEW);
		     CVSI(PNAME,FLAG);
		     IF FLAG  PNAME  NULL THEN
			     NEWPNAME(ITMVR,PNAME);
		     INITTP(ITMVR,TYPE);
		     PROPS(ITMVR)_TPROPS;
		  END;
	      [2]"MERGE ASSOCIATIONS AND DATUMS"
		 BEGIN ITMVR _ CVSI(PNAME,FLAG);
		    IF FLAG THEN
		      BEGIN CONVERT[ITNO]_CVN(ITMVR_ NEW);
			    IF LENGTH(PNAME) THEN
				      NEWPNAME(ITMVR,PNAME);
		      END ELSE
		      BEGIN CONVERT[ITNO]_CVN(ITMVR);
			    IF TYPE  TYPEIT(ITMVR) THEN
			       OUTSTR("DATUM TYPE MISMATCH."&
				    " ITEM "& PNAME & ('15&'12));
			    IF IFGLOBAL(ITMVR) THEN
			       USERERR(0,1,"LPREAD:GLOBAL-LOCAL MISMATCH");
			    DELETE(ITMVR);
			    NEWPNAME(ITMVR_NEW,PNAME);
		      END;
		    INITTP(ITMVR,TYPE);
		    PROPS(ITMVR)_ TPROPS;
		 END;
	      [3]  "MERGE JUST ASSOCIATIONS"
		   BEGIN ITMVR _ CVSI(PNAME,FLAG);
		      IF FLAG THEN
			BEGIN CONVERT[ITNO]_ CVN(ITMVR _ NEW);
				IF LENGTH(PNAME) THEN
					NEWPNAME(ITMVR,PNAME);
			       INITTP(ITMVR,[1]);
			END ELSE CONVERT[ITNO] _ CVN(ITMVR);
		   END 
	   END;
	END;


GLOB
	COMMENT INPUT GLOBAL BRACKETED TRIPLES;

	IF WNTGLB THEN
	  BEGIN
	     DUM_ GLOBAL NEW; "WILL BE USED TO FORCE CALL OF BMAKE"

	     WHILE ITNO_WORDIN(CHAN) DO
	     BEGIN
		TPROPS _ WORDIN(CHAN);
		PNAME_STRIN; "PNAME"
		WORD_WORDIN(CHAN); "TRIPLE"
		ATT_(WORD ROT 12)LAND '7777;
		OBJ_(WORD ROT 24)LAND '7777;
		VAL_(WORD LAND '7777);
		BRACKMAKE(ATT,OBJ,VAL,PNAME,TPROPS,TRUE);
	     END;

	     COMMENT NOW GET ONE'S WE MISSED THE FIRST PASS;
	     FLAG _ TRUE;
	     WHILE FLAG DO
	     BEGIN FLAG _ FALSE;
		BRKBRK2_BRKBRK;
		BRKBRK_ NIL;
		WHILE LENGTH(BRKBRK2) DO
		BEGIN ITNO _ CVN(LOP(BRKBRK2));
		   IF WNTLOC THEN
		     BEGIN ITMVR _ LOP(BRKBRK2);
			   PNAME _ DATUM(ITMVR,STRING);
			   DELETE(ITMVR);
		     END ELSE PNAME _ NULL;
		   ATT _ CVN(LOP(BRKBRK2));
		   OBJ _ CVN(LOP(BRKBRK2));
		   VAL _ CVN(LOP(BRKBRK2));
		   TPROPS _ CVN(LOP(BRKBRK2));
		   BRACKMAKE(ATT,OBJ,VAL,PNAME,TPROPS,TRUE);
		END;
	     END;
	     IF LENGTH(BRKBRK) THEN
		     USERERR(0,1,"NESTED BRACKETED TRIPLES");

	     GLOBAL DELETE(DUM);
	  END;
ENDGLOB

	COMMENT INPUT LOCAL BRACKETED TRIPLES;

	IF WNTLOC THEN 
	   BEGIN 
	      DUM_ NEW; "WILL BE USED TO FORCE CALL OF BMAKE"

	      WHILE ITNO_WORDIN(CHAN) DO
	      BEGIN
		 TPROPS _ WORDIN(CHAN);
		 PNAME_STRIN; "PNAME"
		 WORD_WORDIN(CHAN); "TRIPLE"
		 IF (ATT_((WORD ROT 12)LAND '7777)) = 0 THEN
			 USERERR(0,1,"LPREAD:INVALID BRK TRIPLE -ATT");
		 IF (OBJ_((WORD ROT 24)LAND '7777)) = 0 THEN
			 USERERR(0,1,"LPREAD:INVALID BRK TRIPLE -OBJ");
		 IF (VAL_(WORD LAND '7777))= 0 THEN
			 USERERR(0,1,"LPREAD:INVALID BRK TRIPLE -VAL");
		 BRACKMAKE(ATT,OBJ,VAL,PNAME,TPROPS,FALSE);
	      END;

	      COMMENT NOW GET ONE'S WE MISSED THE FIRST PASS;
	      FLAG _ TRUE;
	      WHILE FLAG DO
	      BEGIN FLAG _ FALSE;
		 BRKBRK2_BRKBRK;
		 BRKBRK_ NIL;
		 WHILE LENGTH(BRKBRK2) DO
		 BEGIN ITNO _ CVN(LOP(BRKBRK2));
		    ITMVR _ LOP(BRKBRK2);
		    PNAME _ DATUM(ITMVR,STRING);
		    DELETE(ITMVR);
		    ATT _ CVN(LOP(BRKBRK2));
		    OBJ _ CVN(LOP(BRKBRK2));
		    VAL _ CVN(LOP(BRKBRK2));
		    TPROPS _ CVN(LOP(BRKBRK2));
		    BRACKMAKE(ATT,OBJ,VAL,PNAME,TPROPS,FALSE);
		 END;
	      END;
	      IF LENGTH(BRKBRK) THEN
		      USERERR(0,1,"NESTED BRACKETED TRIPLES");

	      DELETE(DUM);
	   END;


GLOB
	COMMENT INPUT GLOBAL ASSOCIATIONS;

	IF WNTGLB THEN
	WHILE WORD _ WORDIN(CHAN) DO
	BEGIN INTEGER ATT,OBJ,VAL;
	      ATT _ (WORD ROT 12) LAND '7777;
	      OBJ _ (WORD ROT 24) LAND '7777;
	      VAL _  WORD LAND '7777;
	      GLOBAL MAKE CONVERTS(ATT)CONVERTS(OBJ)  CONVERTS(VAL);
	END;

ENDGLOB

	COMMENT INPUT LOCAL ASSOCIATIONS;

	IF WNTLOC THEN
	WHILE WORD _ WORDIN(CHAN) DO
	BEGIN INTEGER ATT,OBJ,VAL;
	      ATT _ (WORD ROT 12) LAND '7777;
	      OBJ _ (WORD ROT 24) LAND '7777;
	      VAL _  WORD LAND '7777;
	      MAKE CONVERTS(ATT)CONVERTS(OBJ)  CONVERTS(VAL);
	END;


	IF MODE = 3 THEN GO TO ENDIT;

	COMMENT NOW INPUT GLOBAL DATUMS;
DATLP: 
GLOB
 IF WNTGLB THEN
	WHILE (ITNO_WORDIN(CHAN))DO
	BEGIN	TYPE _ TYPEIT(ITMVR_CONVERTS(ITNO));
		CASE TYPE OF
		BEGIN [!UNTYPED] "UNTYPED";
		      [!BRACKETED] "BRKITM" USERERR(0,1,"LPREAD: DRYROT-BRK TRIPLE");
		      [!STRING] USERERR(0,1,"GLOBAL STRING ITEM");
		      [!REAL] "REAL"
			  COMMENT SINCE WORDIN RETURNS INTEGER ACT AS IF
				THIS WERE INTEGER ITEM;
			  GLOBAL DATUM(ITMVR,INTEGER) _ WORDIN(CHAN);
		      [!INTEGER] "INTEGER"
			  GLOBAL DATUM(ITMVR,INTEGER) _ WORDIN(CHAN);
		      [!SET] "SET"
			  GLOBAL DATUM(ITMVR,SET) _ SETIN;
		      [!LIST] "LIST"
			  GLOBAL DATUM(ITMVR,LIST) _ LISTIN;
		      [!PROCEDURE] USERERR(0,1,"LPREAD: INVALID GLOBAL TYPE");
		      [!PROCESS] USERERR(0,1,"LPREAD: INVALID GLOBAL TYPE");
		     [!EVENT] USERERR(0,1,"LPREAD: INVALID GLOBAL TYPE");
		     [!CONTEXT] USERERR(0,1,"LPREAD: INVALID GLOBAL TYPE");
		     [!STRING!ARRAY] USERERR(0,1,"GLOBAL STRING ARRAY ITEM");
		     [!REAL!ARRAY] "REAL ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_GMUNGE(ITMVR);
				ARRYIN(CHAN, GLOBAL
				   DATUM(ITMVR,REAL ARRAY)[1],ITEMP);
				GUNMUN(ITMVR);
			  END;
	      	     [!REAL!ARRAY] "INTEGER ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_GMUNGE(ITMVR);
				ARRYIN(CHAN,GLOBAL
				   DATUM(ITMVR,INTEGER ARRAY)[1],ITEMP);
				GUNMUN(ITMVR);
			  END;
		     [!SET!ARRAY] "SET ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_GMUNGE(ITMVR);
				FOR J _ 1 STEP 1 UNTIL ITEMP DO
				   GLOBAL DATUM(ITMVR,SET ARRAY)[J]_SETIN;
				GUNMUN(ITMVR);
			  END;


		     [!LIST!ARRAY] "LIST ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_ GMUNGE(ITMVR);
				FOR J _ 1 STEP 1 UNTIL ITEMP DO
				  GLOBAL DATUM(ITMVR,LIST ARRAY)[J]_LISTIN;
				GUNMUN(ITMVR);
			  END
		  FORLC I = !INVALID!TYPEITS DOC
		    [;[I] USERERR(0,1,"LPREAD: INVALID GLOBAL TYPE")] ENDC
		END;
	END;

ENDGLOB

	COMMENT INPUT LOCAL DATUMS;
	IF WNTLOC THEN 
	WHILE (ITNO_WORDIN(CHAN))  0 DO
	BEGIN	TYPE _ TYPEIT(ITMVR_CONVERTS(ITNO));
		CASE TYPE OF
		BEGIN [!DELETED] USERERR(0,1,"LPREAD:INVALID TYPE");
		      [!UNTYPED] "UNTYPED";
		      [!BRACKETED] "BRKITM" USERERR(0,1,"LPREAD: DRYROT-BRK TRIPLE");
		      [!STRING] "STRING ITEM"
			  BEGIN STARTCODE
					MOVE	3,ITMVR;
					PUSHJ	P,SDESCR;
					POP	P,@DATM;
				END;
				DATUM(ITMVR,STRING)_ STRIN;
			  END;
		      [!REAL] "REAL"
			  DATUM(ITMVR,INTEGER) _ WORDIN(CHAN);
		      [!INTEGER] "INTEGER"
			  DATUM(ITMVR,INTEGER) _ WORDIN(CHAN);
		      [!SET] "SET"
			  DATUM(ITMVR,SET) _ SETIN;
		      [!LIST] "LIST"
			  DATUM(ITMVR,LIST) _ LISTIN;
		      [!PROCEDURE] USERERR(0,1,"LPREAD:INVALID TYPE");
		      [!PROCESS] USERERR(0,1,"LPREAD:INVALID TYPE");
		     [!EVENT] USERERR(0,1,"LPREAD:INVALID TYPE");
		     [!CONTEXT] USERERR(0,1,"LPREAD:INVALID TYPE");
		     [!STRING!ARRAY] "STRING ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_AMUNGE(ITMVR);
				FOR J _ 1 STEP 1 UNTIL ITEMP DO
					DATUM(ITMVR,STRING ARRAY)[J]_STRIN;
				UNMUNGE(ITMVR);
			  END;
		     [!REAL!ARRAY] "REAL ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_AMUNGE(ITMVR);
				ARRYIN(CHAN,
					DATUM(ITMVR,REAL ARRAY)[1],ITEMP);
				UNMUNGE(ITMVR);
			  END;
		     [!INTEGER!ARRAY] "INTEGER ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_AMUNGE(ITMVR);
				ARRYIN(CHAN,
				    DATUM(ITMVR,INTEGER ARRAY)[1],ITEMP);
				UNMUNGE(ITMVR);
			  END;
		     [!SET!ARRAY] "SET ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_AMUNGE(ITMVR);
				FOR J _ 1 STEP 1 UNTIL ITEMP DO
					DATUM(ITMVR,SET ARRAY)[J]_SETIN;
				UNMUNGE(ITMVR);
			  END;
		     [!LIST!ARRAY] "LIST ARRAY"
			  BEGIN GETARRAY(ITMVR);
				ITEMP_ AMUNGE(ITMVR);
				FOR J _ 1 STEP 1 UNTIL ITEMP DO
					DATUM(ITMVR,LIST ARRAY)[J]_LISTIN;
				UNMUNGE(ITMVR);
			  END
		   FORLC I = !INVALID!TYPEITS DOC
		     [;[I] USERERR(0,1,"LPREAD:INVALID TYPE")] ENDC
		END;
	END;
    END;
ENDIT: CLOSE(CHAN);RELEASE(CHAN);
END "LPREAD";
END "READLP"