IMPLEMENTATION MODULE Names;
FROM SYSTEM IMPORT TSIZE;
FROM Lib IMPORT AddAddr, SubAddr, HashString;
FROM IO IMPORT WrStrAdj, WrLn;
FROM Str IMPORT Caps;
FROM Memory IMPORT ALLOCATE, MarkNeeded, AddMarker, DropMarker;
FROM Machine IMPORT link, closure, parent, tempDef;
FROM Machine IMPORT EmptyClosure, MarkClosure, MarkString;
FROM Machine IMPORT wType, Build, HandlePackage, HandleParent, SaveDefinition;
FROM Machine IMPORT AddEnv, RemoveEnv, MakeDef, MakePrimitive, MakeString;
CONST
FormalMaximum=10000;
MaxEntries=64;
LastEntry=MaxEntries-1;
TYPE
wordPtr=POINTER TO wordType;
wordType=RECORD
next:wordPtr;
def:closure;
name:POINTER TO ARRAY [0..FormalMaximum] OF CHAR;
entry:closure;
END;
dictionary=POINTER TO dictRec;
dictRec= RECORD
info:ARRAY [0..LastEntry] OF wordPtr;
next:dictionary
END;
VAR
i:CARDINAL;
top:dictionary;
UndefinedMeaning:closure;
PROCEDURE DefWord(l:link):wordPtr;
BEGIN
RETURN wordPtr(SubAddr(l,TSIZE(wordPtr)))
END DefWord;
PROCEDURE vList;
CONST
WordsInRow=3;
MaxLength=25;
VAR
follow:wordPtr;
i,counter:CARDINAL;
BEGIN
counter:=1;
FOR i:=0 TO LastEntry DO
follow:=top^.info[i];
WHILE follow#NIL DO
DEC(counter);
IF counter=0 THEN
counter:=WordsInRow;
WrLn
END;
WrStrAdj(follow^.name^,-MaxLength);
follow:=follow^.next
END
END;
WrLn
END vList;
PROCEDURE NewDictionary;
VAR
d:dictionary;
i:CARDINAL;
BEGIN
NEW(d);
FOR i:=0 TO LastEntry DO
d^.info[i]:=top^.info[i]
END;
d^.next:=top;
top:=d
END NewDictionary;
PROCEDURE OldDictionary;
BEGIN
top:=top^.next
END OldDictionary;
PROCEDURE DefineWord(VAR worDef:link; wordName:ARRAY OF CHAR;
wordMeaning:closure);
VAR
newWord:wordPtr;
hash:CARDINAL;
BEGIN
hash:=HashString(wordName,MaxEntries);
NEW(newWord);
WITH newWord^ DO
next:=top^.info[hash];
top^.info[hash]:=newWord;
name:=ADR(wordName);
def:=EmptyClosure;
entry:=EmptyClosure;
worDef:=ADR(def);
MakeDef(entry,wEntry);
MakeDef(def,worDef);
AddEnv(entry,wMeaning,def);
MakeString(def,wString,name);
AddEnv(entry,wName,def);
def:=wordMeaning
END
END DefineWord;
(*
PROCEDURE UndefineWord(l:link);
VAR
hash:CARDINAL;
BEGIN
hash:=HashString(DefWord(l)^.name^,MaxEntries);
top^.info[hash]:=top^.info[hash]^.next
END UndefineWord;
PROCEDURE MoveWord(l:link; fromVoc, toVoc:dictionary);
VAR
hash:CARDINAL;
follow:POINTER TO wordPtr;
wd:wordPtr;
BEGIN
wd:=DefWord(l);
hash:=HashString(wd^.name^,MaxEntries);
IF fromVoc#EmptyDict THEN
follow:=ADR(fromVoc^.info[hash]);
WHILE (follow^#wd) AND (follow^#NIL) DO
follow:=ADR(follow^^.next)
END;
IF follow^=wd THEN
follow^:=follow^^.next
END
END;
wd^.next:=toVoc^.info[hash];
toVoc^.info[hash]:=wd
END MoveWord;
PROCEDURE Forget(dp:link):BOOLEAN;
VAR
follow,target:wordPtr;
BEGIN
target:=wordPtr(dp);
follow:=lastWord;
WHILE (follow#NIL) AND (follow#target) DO
follow:=follow^.next
END;
IF follow=NIL THEN
RETURN FALSE
ELSE
lastWord:=follow^.next;
RETURN TRUE
END
END Forget;
*)
PROCEDURE AddPrimWord(VAR worDef:link; wordName:ARRAY OF CHAR;
handler:handlerType);
BEGIN
MakePrimitive(tempDef,handler);
DefineWord(worDef,wordName,tempDef);
tempDef:=EmptyClosure
END AddPrimWord;
PROCEDURE AddArgument(VAR worDef:link; wordName:ARRAY OF CHAR);
BEGIN
DefineWord(worDef,wordName,UndefinedMeaning)
END AddArgument;
PROCEDURE AddAtom(VAR worDef:link; wordName:ARRAY OF CHAR);
BEGIN
AddPrimWord(worDef,wordName,Build);
MakeDef(tempDef,worDef);
AddEnv(worDef^,wType,tempDef);
tempDef:=EmptyClosure
END AddAtom;
PROCEDURE MarkWords;
VAR
i:[0..LastEntry];
wdCurrent:wordPtr;
dictFollow:dictionary;
fresh:BOOLEAN;
BEGIN
MarkClosure(UndefinedMeaning);
dictFollow:=top;
WHILE dictFollow#NIL DO
MarkNeeded(dictFollow,TSIZE(dictRec),fresh);
dictFollow:=dictFollow^.next
END;
FOR i:=0 TO LastEntry DO
wdCurrent:=top^.info[i];
WHILE wdCurrent#NIL DO
MarkNeeded(wdCurrent,TSIZE(wordType),fresh);
WITH wdCurrent^ DO
MarkString(name);
MarkClosure(def);
MarkClosure(entry);
wdCurrent:=next
END
END
END
END MarkWords;
PROCEDURE FindWord(wd:ARRAY OF CHAR):link;
VAR
follow:wordPtr;
letter:CARDINAL;
BEGIN
follow:=top^.info[HashString(wd,MaxEntries)];
WHILE follow#NIL DO
IF follow^.name^[0]=wd[0] THEN
letter:=1;
WITH follow^ DO
WHILE (wd[letter]=name^[letter]) AND (name^[letter]#0C) DO
INC(letter)
END;
IF wd[letter]=name^[letter] THEN
RETURN ADR(def)
END;
END
END;
follow:=follow^.next
END;
RETURN NIL
END FindWord;
(*# call( o_a_copy => on ) *)
PROCEDURE FindWordNoCase(wd:ARRAY OF CHAR):link;
VAR
follow:wordPtr;
letter:CARDINAL;
BEGIN
Caps(wd);
follow:=top^.info[HashString(wd,MaxEntries)];
WHILE follow#NIL DO
IF CAP(follow^.name^[0])=wd[0] THEN
letter:=1;
WITH follow^ DO
WHILE (wd[letter]=CAP(name^[letter])) AND (name^[letter]#0C) DO
INC(letter)
END;
IF wd[letter]=name^[letter] THEN
RETURN ADR(def)
END;
END
END;
follow:=follow^.next
END;
RETURN NIL
END FindWordNoCase;
PROCEDURE DefName(dp:link):ADDRESS;
TYPE
AddrPtr=POINTER TO ADDRESS;
BEGIN
RETURN AddrPtr(AddAddr(dp,TSIZE(closure)))^
END DefName;
PROCEDURE DefEntry(dp:link):closure;
BEGIN
RETURN link(AddAddr(dp, TSIZE(closure) + TSIZE(ADDRESS)))^
END DefEntry;
PROCEDURE SetDefEntry(dp:link;newEntry:closure);
VAR
entry:link;
BEGIN
entry:=link(AddAddr(dp, TSIZE(closure) + TSIZE(ADDRESS)));
SaveDefinition(entry);
entry^:=newEntry
END SetDefEntry;
VAR
name:closure; (* unmarked temporary, used only during initialisation *)
BEGIN
AddMarker( MarkWords );
NEW(top);
top^.next:=NIL;
FOR i:=0 TO LastEntry DO
top^.info[i]:=NIL
END;
AddArgument(wEntry, 'Entry');
tempDef:=DefEntry(wEntry);
RemoveEnv(tempDef,wMeaning);
RemoveEnv(tempDef,wName);
DefineWord(wParent, 'Parent', HandleParent);
tempDef:=DefEntry(wParent);
RemoveEnv(tempDef,wMeaning);
RemoveEnv(tempDef,wName);
AddAtom(wUndefined, 'Undefined');
tempDef:=DefEntry(wUndefined);
RemoveEnv(tempDef,wMeaning);
RemoveEnv(tempDef,wName);
MakeDef(UndefinedMeaning,wUndefined);
parent:= UndefinedMeaning;
AddArgument(wMeaning,'Meaning');
tempDef:=DefEntry(wMeaning);
RemoveEnv(tempDef,wName);
AddArgument(wName,'Name');
DefineWord(wString,'STRING',HandlePackage);
MakeString(name,wString,DefName(wName));
tempDef:=DefEntry(wName);
AddEnv(tempDef,wName,name);
MakeString(name,wString,DefName(wMeaning));
tempDef:=DefEntry(wMeaning);
AddEnv(tempDef,wName,name);
MakeString(name,wString,DefName(wUndefined));
tempDef:=DefEntry(wUndefined);
AddEnv(tempDef,wName,name);
MakeDef(name,wUndefined);
AddEnv(tempDef,wMeaning,name);
MakeString(name,wString,DefName(wParent));
tempDef:=DefEntry(wParent);
AddEnv(tempDef,wName,name);
MakeDef(name,wParent);
AddEnv(tempDef,wMeaning,name);
MakeString(name,wString,DefName(wEntry));
tempDef:=DefEntry(wEntry);
AddEnv(tempDef,wName,name);
MakeDef(name,wEntry);
AddEnv(tempDef,wMeaning,name);
wEntry^:=UndefinedMeaning;
tempDef:=EmptyClosure
END Names.