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 ITMVR1ITMVR2 ITMVR3];
CONVERT[ITNO] _ CVN(ITMVR1_COP(GLOBAL DUMDUM));
GLOBAL PROPS(ITMVR1)_ TPROPS;
FLAG_TRUE;
IF LENGTH(PNAME) THEN NEWPNAME(ITMVR1,PNAME);
GLOBAL ERASE DUMDUM ANY;
END ELSE
ENDGLOB
BEGIN MAKE DUMDUM [ITMVR1ITMVR2 ITMVR3];
CONVERT[ITNO] _ CVN(ITMVR1_COP(DUMDUM));
PROPS(ITMVR1) _ TPROPS;
FLAG_TRUE;
IF LENGTH(PNAME) THEN NEWPNAME(ITMVR1,PNAME);
ERASE DUMDUM ANY;
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"