perm filename LPBUG.SAI[CMU,AIL] blob
sn#086452 filedate 1974-02-13 generic text, type T, neo UTF8
00100 BEGIN "PROBUG"
00200 REQUIRE "BAYSAI[cmu,ail]" SOURCE!FILE;
00300 EXTERNAL INTEGER PROCEDURE GETBRK;
00325 EXTERNAL PROCEDURE RELBRK(INTEGER X);
00350 REQUIRE "[]()" DELIMITERS;
00400 DEFINE MASTERNAL =[INTERNAL], MASTER!=TRUE;
00600 DEFINE ERROR=[OUTSTR];
00700 EXTERNAL BOOLEAN PROCEDURE WANTREAD(INTEGER C,M,B,E;STRING F,P);
00750 INTEGER LIN!BS;
00800 !! *** THE LEXICON STUFF *** ;
00900
01000 DEFINE MAX!LEXICONS=20;
01100
01200 DEFINE UTT!B!DEX=1; ! INDEX OF START-OF-UTTERANCE MARKER
01300 ! IN LEXICON;
01400 DEFINE UTT!E!DEX=2; ! END-OF-UTTERANCE MARKER;
01500
01600 MASTERNAL INTEGER GLO!LEX!INDEX;
01700
01800 MASTERNAL STRING ! PROCEDURE; ITEMVAR ARRAY LEX!!PNAMES[1:MAX!LEXICONS];
01900 MASTERNAL INTEGER ! PROCEDURE; ITEMVAR ARRAY LEX!!INDECIES[1:MAX!LEXICONS];
02000
02100 MASTERNAL STRING ARRAY LEX!NAMES[-1:MAX!LEXICONS];
02200 MASTERNAL STRING ARRAY ITEMVAR ARRAY STDLEXS[0:MAX!LEXICONS];
02300
02400
02500 !! LEXICON ACCESS ROUTINES;
02600
02700 IFCR MASTER! THENC
02800 FORWARD MASTERNAL INTEGER SIMPLE PROCEDURE INIT!LEX(STRING LEX);
02900 ENDC
03000
03100 MASTERNAL PROCEDURE SLEX!PNAME(INTEGER LEX,DEX;REFERENCE STRING PNAME); !!! SLEX!PNAME;
03200 !!!! GIVEN A STANDARD LEX AND AN INDEX INTO IT, RETURN THE PRINTNAME OF THE SYMBOL;
03300 IFCR MASTER! THENC BEGIN "SLEX!PNAME"
03400 IF (DEX<0) OR (DEX > PROPS(STDLEXS[LEX])) THEN BEGIN
03500 ERROR("SLEX!PNAME:DEX OUT OF BOUNDS:"&CVS(DEX));
03600 RETURN; END;
03700 PNAME←DATUM(STDLEXS[LEX])[DEX];
03800 END "SLEX!PNAME";
03900 ENDC
04000
04100 MASTERNAL PROCEDURE SLEX!DEX(REFERENCE INTEGER DEX; INTEGER LEX; STRING PNAME); !!! SLEX!DEX;
04200 !!!! GIVEN A STANDARD LEX AND A SYMBOL, RETURN ITS INDEX. REQUIRE EXACT MATCH.;
04300 IFCR MASTER! THENC BEGIN "SLEX!DEX"
04400 FOR DEX←PROPS(STDLEXS[LEX]) DOWNTO 1 DO
04500 IF EQU(PNAME,DATUM(STDLEXS[LEX])[DEX]) THEN DONE;
04600 IF DEX<1 THEN ERROR(CVS(PNAME)&" NOT FOUND IN LEXICON"); !! ****** THIS IS
04700 PROBABLY NOT THE RIGHT THING TO DO HERE. MAYBE WANT STABLOOK-ISHNESS ←←←←←←←;
04800 END "SLEX!DEX";
04900 ENDC
05000
05100 !!! ; MASTERNAL STRING PROCEDURE LEX!PNAME(INTEGER LEX,INDEX);
05200 IFCR MASTER! THENC
05300 BEGIN "LEX!PNAME"
05400 !!!! RETURN A PRINTABLE NAME ASSOCIATED WITH LEXICON ENTRY LEX[INDEX];
05500
05600 STRING PNAME;
05700 IF (LEX≤0) OR (LEX>GLO!LEX!INDEX) THEN
05800 BEGIN
05900 ERROR(CVS(LEX)&" IS OUT OF BOUNDS IN LEX!PNAME");
06000 RETURN(PNAME);
06100 END;
06200 IF STDLEXS[LEX]=ANY THEN ! NON-STANDARD LEXICON;
06300 BEGIN
06400 ITEMVAR IT,SIT;
06500 IT←REF!ITEM(INDEX);
06600 SIT←REF!ITEM(PNAME);
06700 APPLY(DATUM(LEX!!PNAMES[LEX]),{{SIT,IT⎇⎇);
06800 DELETE(IT); DELETE(SIT);
06900 END
07000 ELSE SLEX!PNAME(LEX,INDEX,PNAME);
07100 ! STANDARD LEXICON;
07200 RETURN(PNAME);
07300 END "LEX!PNAME";
07400 ENDC
07500
07600 !!! ; MASTERNAL INTEGER PROCEDURE LEX!INDEX(INTEGER LEX; STRING PNAME);
07700 IFCR MASTER! THENC
07800 BEGIN "LEX!INDEX"
07900 !!!! RETURN THE INDEX IN LEX WHOSE PRINTNAME IS PNAM;
08000 INTEGER INDEX;
08100 IF (LEX≤0) OR (LEX<GLO!LEX!INDEX) THEN
08200 BEGIN
08300 ERROR(CVS(LEX)&" OUT OF BOUNDS IN LEX!INDEX");
08400 RETURN(PNAME);
08500 END;
08600 IF STDLEXS[LEX]=ANY THEN ! NON-STANDARD LEXICON;
08700 BEGIN
08800 ITEMVAR IT,SIT;
08900 SIT←REF!ITEM(PNAME);
09000 IT←REF!ITEM(INDEX);
09100 APPLY(DATUM(LEX!!INDECIES[LEX]),{{IT,SIT⎇⎇);
09200 DELETE(IT); DELETE(SIT);
09300 END
09400 ELSE SLEX!DEX(LEX,INDEX,PNAME); ! STANDARD LEXICON;
09500 RETURN(INDEX);
09600 END "LEX!INDEX";
09700 ENDC
09800
09900 MASTERNAL PROCEDURE SLEX!INIT(REFERENCE STRING FILENAME;REFERENCE INTEGER LEX!NUM; STRING NAME); !! SLEX!INIT;
10000 IFCR MASTER! THENC BEGIN "SLEX!INIT"
10100 INTEGER DEX, EOF, CHAN, ONE;
10200 SIMPLE PROCEDURE NXTENT(REFERENCE STRING ENTRY);
10300 BEGIN "NXTENT" ! GET A SINGLE ENTRY FROM THE LEX FILE;
10400 ENTRY←""; ! INITIALLY NULL;
10500 WHILE NOT LENGTH(ENTRY) AND NOT EOF DO
10600 BEGIN
10700 ENTRY←INPUT(CHAN,ONE); ! PICK OFF ENTRY;
10800 INPUT(CHAN,LIN!BS); ! DUMP REST OF LINE;
10900 END;
11000 END "NXTENT";
11100
11200 DEX←INIT!LEX(NAME); ! INDEX OF NAME INTO STDLEXS;
11300
11400 IF DEX<0 THEN ! NAME ALREADY INITIALIZED;
11500 BEGIN
11600 STRING FNAME;
11700 STRING ARRAY ITEMVAR IT;
11800 IF (IT←STDLEXS[-DEX])=ANY THEN
11900 BEGIN
12000 ERROR(CVS(NAME)&" INITIALIZED NON-STANDARD");
12100 RETURN;
12200 END
12300 ELSE IF LEX!NUM AND NOT EQU(FNAME←DATUM(IT)[0], FILENAME) THEN
12400 BEGIN
12500 ERROR(CVS(NAME)&" ALREADY INITIALIZED AS "&
12600 CVS(FILENAME));
12700 RETURN;
12800 END;
12900 END
13000 ELSE IF DEX>0 THEN ! INITIALIZE HAME;
13100 BEGIN "GRTR"
13200 STRING ENTRY;
13300 INTEGER LEX!SIZE, FLAG, SPARE, BKCH;
13400 LEX!NUM←DEX; ! LEXICON'S INDEX IN STDLEXS;
13500 IF WANTREAD(CHAN←-1,0,BKCH,EOF,FILENAME,NAME) THEN RETURN;
13600 SETBREAK(ONE←GETBRK," ,;"&LF,NULL,"INR");
13700 SPARE←0;
13800 LEX!SIZE←2;
13900 NXTENT(ENTRY); ! FIRST ENTRY IN FILE;
14000 IF SDUM←LOP(ENTRY) = "=" THEN
14100 ! EITHER "=N" OR "=+N";
14200 BEGIN
14300 IF SDUM←LOP(ENTRY)= "+" THEN
14400 SPARE←CVS(ENTRY)
14500 ELSE LEX!SIZE←CVS(SDUM&ENTRY)+2;
14600 ! ACTUAL SIZE +2;
14700 END
14800 ELSE LEX!SIZE←3; ! COUNT FIRST ENTRY, TOO;
14900 IF LEX!SIZE<4 THEN ! COUNT ENTRIES;
15000 WHILE NOT EOF DO
15100 BEGIN
15200 NXTENT(ENTRY);
15300 LEX!SIZE←LEX!SIZE+1;
15400 END; ! LEX!SIZE IS NOW LEXICON
15500 SIZE +2;
15600
15700 BEGIN "ARRBLK" ! INNER BLOCK;
15800 INTEGER DIN;
15900 STRING ARRAY DUMARR[0:LEX!SIZE+SPARE];
16000 LOOKUP(CHAN,FILENAME,FLAG); ! GET FILE FOR PASS TWO;
16100 IF FLAG THEN BEGIN
16200 ERROR("LOOKUP FOR "&CVS(FILENAME)&" FAILED -- IMPOSSIBLE!!");
16300 RETURN; END;
16400 DUMARR[0]←FILENAME;
16500 DUMARR[UTT!B!DEX]←"<";
16600 DUMARR[UTT!E!DEX]←">";
16700 FOR DIN←3 THRU LEX!SIZE DO
16800 BEGIN
16900 NXTENT(ENTRY);
17000 DUMARR[DIN]←ENTRY;
17100 END;
17200 STDLEXS[DEX]←NEW(DUMARR); ! STORE LEXICON;
17300 END "ARRBLK";
17400 RELBRK(ONE);
17500 ! THIS CREATES BAD CODE **** PROPS(STDLEXS[DEX])←LEX!SIZE+SPARE;
17600 BEGIN ITEMVAR IT; IT←STDLEXS[DEX]; PROPS(IT)←LEX!SIZE+SPARE; END;
17700 END "GRTR"; ! ELSE;
17800 END "SLEX!INIT";
17900 ENDC
18000
18100
18200 END;