perm filename LPDUMP.SAI[UOR,AIL] blob
sn#248611 filedate 1976-11-19 generic text, type T, neo UTF8
COMMENT XOR 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 XOR ;
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.
Modified 23-AUG-76 by Jon Shopiro, UofR, for 18-bit items;
REQUIRE "TYPEIT.HDR[170,161]" 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 TPALLC, ITMBOT, MAXITM, DATM, INFTB;
GLOB
EXTERNAL INTEGER GDATM, GINFTB;
ENDGLOB
REQUIRE "MUNGE.REL[170,161]" 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
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 BRK!LIST,GBRK!LIST;
LABEL ENDIT;
DEFINE
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;
if I then wordout(chan,value lsh ((5-I)*7+1));
END "STROUT";
SIMPLE PROCEDURE LISTOUT(LIST X);
BEGIN "LSTOUT"
boolean left;
ITEMVAR ITMVR1; INTEGER VALUE,I;
left ← true;
FOREACH ITMVR1 | ITMVR1 IN X AND ( NOT FILTER(ITMVR1)) DO
REMOVE ITMVR1 FROM X;
WORDOUT(CHAN,LENGTH(X));
I ← VALUE ← 0;
WHILE LENGTH(X) DO
begin
if left then
value ← cvn(lop(x)) lsh 18
else
wordout(chan,value lor cvn(lop(x)));
left ← not left
end;
if not left then wordout(chan, value);
END "LSTOUT";
SIMPLE PROCEDURE OUTDES(ITEMVAR X);
BEGIN "OUTDES"
LABEL L1,L2;INTERNAL LABEL OUTDE2;
START!CODE
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;
START!CODE;
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 NOT (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 GEQ 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,'777777,'777777));
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 '777777 DO
IF FILTER(CVI(I)) THEN
IF (TYPE←TYPEIT(CVI(I)))= 2 THEN GBRK!LIST[ INF +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 BRK!LIST[ INF +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(GBRK!LIST) DO
BEGIN ITMVR1← LOP(GBRK!LIST);
WORDOUT(CHAN,CVN(ITMVR1));
WORDOUT(CHAN,GLOBAL PROPS(ITMVR1));
STROUT(CVIS(ITMVR1,FLAG)); "PNAME"
BRKFLAG ← TRUE;
IF NOT FILTER(ITMVR3←GLOBAL THIRD(ITMVR1)) THEN
BEGIN BRKFLAG ←FALSE;
OUTSTR('15&'12&"LPDUMP:WARNING INVALID VALUE"&
"-BRACKETED TRIPLE");
END;
IF NOT FILTER(ITMVR2←GLOBAL SECOND(ITMVR1)) THEN
BEGIN BRKFLAG←FALSE;
OUTSTR('15&'12&"LPDUMP:WARNING INVALID OBJECT"&
"- BRACKETED TRIPLE");
END;
IF NOT FILTER(ITMVR1←GLOBAL FIRST(ITMVR1)) THEN
BEGIN BRKFLAG←FALSE;
OUTSTR('15&'12&"LPDUMP:WARNING INVALID ATTRIBUTE"&
"- BRACKETED TRIPLE");
END;
IF BRKFLAG THEN COMMENT use two words for three 18-bit items;
BEGIN
WORDOUT(CHAN,(CVN(ITMVR1) LSH 18) LOR CVN(ITMVR2));
WORDOUT(CHAN,CVN(ITMVR3))
END
ELSE WORDOUT(CHAN,0);
END;
WORDOUT(CHAN,0); "separator"
END;
ENDGLOB
COMMENT NOW OUTPUT THE LOCAL BRACKETED TRIPLES;
IF WNTLOC THEN
BEGIN WHILE LENGTH(BRK!LIST) DO
BEGIN ITMVR1← LOP(BRK!LIST);
BRKFLAG ← TRUE;
WORDOUT(CHAN,CVN(ITMVR1));
WORDOUT(CHAN,PROPS(ITMVR1));
STROUT(CVIS(ITMVR1,FLAG)); "PNAME"
IF NOT FILTER(ITMVR3←THIRD(ITMVR1)) THEN
BEGIN BRKFLAG ← FALSE;
OUTSTR('15&'12&"LPDUMP:WARNING INVALID VALUE -"&
"BRACKETED TRIPLE");
END;
IF NOT FILTER(ITMVR2←SECOND(ITMVR1)) THEN
BEGIN BRKFLAG ← FALSE;
OUTSTR('15&'12&"LPDUMP:WARNING INVALID OBJECT -"&
"BRACKETED TRIPLE");
END;
IF NOT FILTER(ITMVR1←FIRST(ITMVR1)) THEN
BEGIN BRKFLAG ← FALSE;
OUTSTR('15&'12&"LPDUMP:WARNING INVALID ATTRIBUTE-"&
"BRACKETED TRIPLE");
END;
IF BRKFLAG THEN COMMENT use two words for three 18-bit items;
BEGIN
WORDOUT(CHAN,(CVN(ITMVR1) LSH 18) LOR CVN(ITMVR2));
WORDOUT(CHAN,CVN(ITMVR3))
END
ELSE WORDOUT(CHAN,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 '777777 DO
IF FILTER(CVI(I)) THEN
BEGIN
boolean not!started;
not!started ← true;
FOREACH ITMVR2,ITMVR3| GLOBAL ITMVR2 XOR ITMVR3
EQV CVI(I) AND
(FILTER(ITMVR2) AND FILTER(ITMVR3)) DO
begin
if not!started then
begin comment put out 0,,value;
wordout(chan,i);
not!started ← false
end;
comment put out attribute,,object;
wordout(chan,(cvn(itmvr2) lsh 18) lor cvn(itmvr3))
end
END;
WORDOUT(CHAN,0); "separator"
END;
ENDGLOB
COMMENT NOW PUT OUT THE LOCAL ASSOCIATIONS;
IF WNTLOC THEN
BEGIN FOR I ← 1 STEP 1 UNTIL TPALLC, ITMBOT STEP 1 UNTIL LOCMAX DO
IF FILTER(CVI(I)) THEN
BEGIN
boolean not!started;
not!started ← true;
FOREACH ITMVR2,ITMVR3| ITMVR2 XOR ITMVR3
EQV CVI(I) AND
(FILTER(ITMVR2) AND FILTER(ITMVR3)) DO
begin
if not!started then
begin comment put out 0,,value;
wordout(chan,i);
not!started ← false
end;
comment put out attribute,,object;
wordout(chan,(cvn(itmvr2) lsh 18) lor cvn(itmvr3))
end
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 '777777 DO
IF FILTER(CVI(I)) AND ((TYPE←TYPEIT(CVI(I))) NEQ 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)) AND ((TYPE←TYPEIT(CVI(I))) NEQ 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);
END "LPDUMP";
END "DUMPLP"