Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
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"