perm filename LPREAD.SAI[UOR,AIL] blob
sn#248612 filedate 1976-11-21 generic text, type T, neo UTF8
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 LOAD!MODULE.
REQUIRE "LPREAD" LOAD!MODULE
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 BRK!BRK,BRK!BRK2;
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" LOAD!MODULE;
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) = [
START!CODE
MOVE 3,ITNO;
MOVE 2,TYPE;
HRRM 2,@INFTB;
END;];
GLOB
DEFINE GINITTP(ITNO,TYPE) = [
START!CODE
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 NOT 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 NOT 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 NOT GINFTB OR NOT 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 OR I > ITMMAX THEN
BEGIN USERERR(0,1,"LPREAD: READ INVALID ITEM NUMBER");
I ← ITMMIN;
END;
TITMVR ← CVI(CONVERT[I]);
IF NOT BOUND(TITMVR) THEN
USERERR(0,1,"LPREAD: READ UNALLOCATED ITEM NUMBER");
RETURN(TITMVR);
END "CONVERTS";
LIST PROCEDURE LISTIN;
BEGIN "LISTIN"
INTEGER VALUE, I, LEN;
boolean left;
LIST X;
LEN←WORDIN(CHAN);
X← NIL;
left ← true;
for i ← 1 step 1 until len do
begin
if left then value ← wordin(chan);
x[inf+1] ← converts((value ← value rot 18) land '777777);
left ← not left
end;
RETURN (X);
END "LISTIN";
SET PROCEDURE SETIN;
BEGIN "SETIN"
INTEGER VAL, I, LEN;
boolean left;
set X;
LEN←WORDIN(CHAN);
X← phi;
left ← true;
for i ← 1 step 1 until len do
begin
if left then value ← wordin(chan);
put converts((value ← value rot 18) land '777777) in x;
left ← not left
end;
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;
RETURN(X);
END "STRIN";
PROCEDURE BRACK!MAKE(INTEGER ATT,OBJ,VAL;STRING PNAME;INTEGER TPROPS;
BOOLEAN GLOBLE);
BEGIN "BRACK"
ITEMVAR ITMVR1,ITMVR2,ITMVR3;
IF NOT CVN(ITMVR1←CONVERTS(ATT)) OR NOT CVN(ITMVR2←CONVERTS(OBJ)) OR
NOT CVN(ITMVR3←CONVERTS(VAL)) THEN
BEGIN BRK!BRK[ INF +1]←CVI(ITNO);
IF WNTLOC THEN BRK!BRK[ INF +1]←NEW(PNAME);
BRK!BRK[ INF +1]←CVI(ATT);
BRK!BRK[ INF +1]←CVI(OBJ);
BRK!BRK[ INF +1]←CVI(VAL);
BRK!BRK[ INF +1]←CVI(TPROPS);
RETURN;
END;
GLOB
IF GLOBLE THEN
BEGIN GLOBAL MAKE DUM XOR DUM EQV [GLOBAL ITMVR1 XOR ITMVR2 EQV ITMVR3];
CONVERT[ITNO] ← CVN(ITMVR1←COP(GLOBAL DUM XOR DUM));
GLOBAL PROPS(ITMVR1)← TPROPS;
FLAG←TRUE;
IF LENGTH(PNAME) THEN NEW!PNAME(ITMVR1,PNAME);
GLOBAL ERASE DUM XOR DUM EQV ANY;
END ELSE
ENDGLOB
BEGIN MAKE DUM XOR DUM EQV [ITMVR1 XOR ITMVR2 EQV ITMVR3];
CONVERT[ITNO] ← CVN(ITMVR1←COP(DUM XOR DUM));
PROPS(ITMVR1) ← TPROPS;
FLAG←TRUE;
IF LENGTH(PNAME) THEN NEW!PNAME(ITMVR1,PNAME);
ERASE DUM XOR DUM EQV ANY;
END;
END;
SIMPLE PROCEDURE GET!ARRAY(ITEMVAR X);
BEGIN "GETARRAY"
LABEL L1,L2,L4,USERR;
GLOB
LABEL L3;
BOOLEAN GLBFLAG;
EXTERNAL SIMPLE PROCEDURE IFGLOBAL;
ENDGLOB
START!CODE
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 AND PNAME NEQ NULL THEN
NEW!PNAME(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
NEW!PNAME(ITMVR,PNAME);
END ELSE
BEGIN CONVERT[ITNO]←CVN(ITMVR);
IF TYPE NEQ TYPEIT(ITMVR) THEN
OUTSTR("DATUM TYPE MISMATCH. "&
"ITEM "& PNAME & ('15&'12));
IF NOT IFGLOBAL(ITMVR) THEN
USERERR(0,1,"LPREAD:GLOBAL-LOCAL MISMATCH");
GLOBAL DELETE(ITMVR);
NEW!PNAME(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
NEW!PNAME(ITMVR,PNAME);
GINITTP(ITMVR,[1]);
END ELSE
BEGIN CONVERT[ITNO] ← CVN(ITMVR);
IF NOT 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 AND PNAME NEQ NULL THEN
NEW!PNAME(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
NEW!PNAME(ITMVR,PNAME);
END ELSE
BEGIN CONVERT[ITNO]←CVN(ITMVR);
IF TYPE NEQ TYPEIT(ITMVR) THEN
OUTSTR("DATUM TYPE MISMATCH."&
" ITEM "& PNAME & ('15&'12));
GLOB
IF IFGLOBAL(ITMVR) THEN
USERERR(0,1,"LPREAD:GLOBAL-LOCAL MISMATCH");
ENDGLOB
DELETE(ITMVR);
NEW!PNAME(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
NEW!PNAME(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"
if (word ←wordin(chan)) then
begin
att ← word lsh -18;
obj ← word land '777777;
val ← wordin(chan);
BRACK!MAKE(ATT,OBJ,VAL,PNAME,TPROPS,TRUE);
end
END;
COMMENT NOW GET ONE'S WE MISSED THE FIRST PASS;
FLAG ← TRUE;
WHILE FLAG DO
BEGIN FLAG ← FALSE;
BRK!BRK2←BRK!BRK;
BRK!BRK← NIL;
WHILE LENGTH(BRK!BRK2) DO
BEGIN ITNO ← CVN(LOP(BRK!BRK2));
IF WNTLOC THEN
BEGIN ITMVR ← LOP(BRK!BRK2);
PNAME ← DATUM(ITMVR,STRING);
DELETE(ITMVR);
END ELSE PNAME ← NULL;
ATT ← CVN(LOP(BRK!BRK2));
OBJ ← CVN(LOP(BRK!BRK2));
VAL ← CVN(LOP(BRK!BRK2));
TPROPS ← CVN(LOP(BRK!BRK2));
BRACK!MAKE(ATT,OBJ,VAL,PNAME,TPROPS,TRUE);
END;
END;
IF LENGTH(BRK!BRK) 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"
if (word ←wordin(chan)) then
begin
att ← word lsh -18;
obj ← word land '777777;
val ← wordin(chan);
brack!make(att,obj,val,pname,tprops,false)
end
END;
COMMENT NOW GET ONE'S WE MISSED THE FIRST PASS;
FLAG ← TRUE;
WHILE FLAG DO
BEGIN FLAG ← FALSE;
BRK!BRK2←BRK!BRK;
BRK!BRK← NIL;
WHILE LENGTH(BRK!BRK2) DO
BEGIN ITNO ← CVN(LOP(BRK!BRK2));
ITMVR ← LOP(BRK!BRK2);
PNAME ← DATUM(ITMVR,STRING);
DELETE(ITMVR);
ATT ← CVN(LOP(BRK!BRK2));
OBJ ← CVN(LOP(BRK!BRK2));
VAL ← CVN(LOP(BRK!BRK2));
TPROPS ← CVN(LOP(BRK!BRK2));
BRACK!MAKE(ATT,OBJ,VAL,PNAME,TPROPS,FALSE);
END;
END;
IF LENGTH(BRK!BRK) THEN
USERERR(0,1,"NESTED BRACKETED TRIPLES");
DELETE(DUM);
END;
GLOB
COMMENT INPUT GLOBAL ASSOCIATIONS;
IF WNTGLB THEN
begin
word ← wordin(chan);
while word do
begin
integer att, obj, val;
val ← word;
while ((word ← wordin(chan)) land '777777000000) do
begin
att ← word lsh -18;
obj ← word land '777777;
global make converts(att) xor converts(obj) eqv
converts(val)
end
end
end;
ENDGLOB
COMMENT INPUT LOCAL ASSOCIATIONS;
IF WNTLOC THEN
begin
word ← wordin(chan);
while word do
begin
integer att, obj, val;
val ← word;
while ((word ← wordin(chan)) land '777777000000) do
begin
att ← word lsh -18;
obj ← word land '777777;
make converts(att) xor converts(obj) eqv
converts(val)
end
end
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 GET!ARRAY(ITMVR);
ITEMP←GMUNGE(ITMVR);
ARRYIN(CHAN, GLOBAL
DATUM(ITMVR,REAL ARRAY)[1],ITEMP);
GUNMUN(ITMVR);
END;
[!REAL!ARRAY] "INTEGER ARRAY"
BEGIN GET!ARRAY(ITMVR);
ITEMP←GMUNGE(ITMVR);
ARRYIN(CHAN,GLOBAL
DATUM(ITMVR,INTEGER ARRAY)[1],ITEMP);
GUNMUN(ITMVR);
END;
[!SET!ARRAY] "SET ARRAY"
BEGIN GET!ARRAY(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 GET!ARRAY(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)) NEQ 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 START!CODE
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 GET!ARRAY(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 GET!ARRAY(ITMVR);
ITEMP←AMUNGE(ITMVR);
ARRYIN(CHAN,
DATUM(ITMVR,REAL ARRAY)[1],ITEMP);
UNMUNGE(ITMVR);
END;
[!INTEGER!ARRAY] "INTEGER ARRAY"
BEGIN GET!ARRAY(ITMVR);
ITEMP←AMUNGE(ITMVR);
ARRYIN(CHAN,
DATUM(ITMVR,INTEGER ARRAY)[1],ITEMP);
UNMUNGE(ITMVR);
END;
[!SET!ARRAY] "SET ARRAY"
BEGIN GET!ARRAY(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 GET!ARRAY(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"