--  CreateNewLookupImpl.mesa
--  ryu 27-Jun-84 19:48:39

DIRECTORY
  CESDictDataDefs USING [DictBytesPerEntry, Entry],
  JLispLookupFile USING [MaxKanaPerEntry, MaxKanjiPerEntry, LEntry, DictPtr],
  CharDefs USING [Char, Code],
  PhonicDefs USING [Phonics],
  CreateLookupDictDefs,
  
  Heap USING [Create, Delete],
  Put USING [Text, Line, Decimal],
  Stream USING [Block, CompletionCode, Handle, PutByte, PutWord, GetBlock, SetPosition],
  Space USING [PageCount],
  Window USING [Handle];
  
CreateNewLookupImpl: PROGRAM IMPORTS Stream, Heap, Put
			  EXPORTS CreateLookupDictDefs =
BEGIN

-- Types

IndexRecord: TYPE = RECORD [
  kana:    CharDefs.Code,
  flag:    {internal, external} ← internal,
  count:   CARDINAL ← 0,
  next:    LONG POINTER TO IndexRecord ← NIL,
  lower:   LONG POINTER TO IndexRecord ← NIL,
  firstI:  CARDINAL ← 0,
  lastI:   CARDINAL ← 0,
  dictPtr: JLispLookupFile.DictPtr ← [0, , 0]];

-- Constants

Onesbyte: CARDINAL = 377B;
nullPhonic: CharDefs.Code = PhonicDefs.Phonics[nullPhonic].ORD;
nullPtr: JLispLookupFile.DictPtr = [0, , 0];
MaxEntries : CARDINAL = 134;
maxCount: CARDINAL = 30;

-- Variables

pRootIndex, pI0, pI1, pI2: LONG POINTER TO IndexRecord ← NIL;
currentIndex: CARDINAL ← 0;
kana0, kana1, kana2: CharDefs.Code ← nullPhonic;
nKanaCodes : CARDINAL ← 0;
KanaCode : PACKED ARRAY [0..JLispLookupFile.MaxKanaPerEntry) OF CharDefs.Code;
kanjiArray: ARRAY [0..JLispLookupFile.MaxKanjiPerEntry) OF CharDefs.Char;
nKanjis: CARDINAL ← 0;

mEntry: CESDictDataDefs.Entry;
pMEntry: LONG POINTER TO CESDictDataDefs.Entry ← @mEntry;
inBlock: Stream.Block ← [LOOPHOLE [LONG[@mEntry]], 0, CESDictDataDefs.DictBytesPerEntry];
nBytes: CARDINAL ← 0;

currentDictPtr, oldDictPtr: JLispLookupFile.DictPtr;
recsize : CARDINAL ← 0;
nLEntries : CARDINAL ← 0;
pLEntry : ARRAY [0 .. MaxEntries] OF LONG POINTER TO JLispLookupFile.LEntry;

myZone: UNCOUNTED ZONE;
zoneSize: Space.PageCount = 200;
firstTime: BOOLEAN;

why: Stream.CompletionCode;

-- Create is the Main Line of this module
  
CreateLookupDict:  PUBLIC PROCEDURE [masterStrH: Stream.Handle,
                                     lookupStrH: Stream.Handle,
				     indexStrH:  Stream.Handle,
                                     msgSW, logSW: Window.Handle]
                   RETURNS [nEntry, ctSkipped: LONG CARDINAL] =
BEGIN

-- Initialize initializes the index table (first part) of the lookup dictionary

Initialize: PROCEDURE[] =
BEGIN
  myZone ← Heap.Create[initial: zoneSize, increment: 10, threshold: 16, checking: TRUE]; 
  KanaCode ← ALL [nullPhonic];
--  kana0, kana1, kana2 ← nullPhonic;
  nLEntries ← 0;
  pLEntry ← ALL [NIL];
  recsize ← 0;
  currentDictPtr.dictPageNo ← 0;
  currentDictPtr.relAddr ← 1;
  oldDictPtr ← currentDictPtr;
  Stream.SetPosition[indexStrH, LONG[0] ];
  Stream.PutWord[lookupStrH, 0];
  firstTime ← TRUE;
END;

-- Pass1

Pass1: PROCEDURE[] =
BEGIN
  DO -- Pass 1
    [nBytes, why] ← Stream.GetBlock[masterStrH, inBlock];
    IF why = endOfStream THEN { LastEntry[pMEntry]; EXIT };
    IF pMEntry.pos >= 1 AND pMEntry.pos <= 60B 
      AND --(pMEntry.freq >= 8 OR pMEntry.kanji[1].code.ORD = Onesbyte AND pMEntry.freq >= 5) 
      (pMEntry.kanji[1].code.ORD = Onesbyte OR pMEntry.freq >= 4)
      THEN AddEntry[pMEntry];
  ENDLOOP;
  Put.Line[logSW, "End of Pass 1"L];
END;  

-- AddEntry 

AddEntry: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] = 
BEGIN
  ConvertNullPhonic[pMEntry];
  IF EqKana[KanaCode, pMEntry.kana]
    THEN SameRecord[pMEntry]
    ELSE DifferentRecord[pMEntry];
END;

-- ConvertNullPhonic

ConvertNullPhonic: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] = 
BEGIN
  FOR i: CARDINAL IN [0..JLispLookupFile.MaxKanaPerEntry) DO
    IF pMEntry.kana[i] = Onesbyte THEN pMEntry.kana[i] ← nullPhonic;
  ENDLOOP;
END;

-- EqKana

EqKana: PROCEDURE[kana1, kana2: PACKED ARRAY [0..JLispLookupFile.MaxKanaPerEntry) OF CharDefs.Code]
	  RETURNS[BOOLEAN] =
BEGIN
  FOR i: CARDINAL IN [0..JLispLookupFile.MaxKanaPerEntry) DO
    IF kana1[i] # kana2[i] THEN RETURN[FALSE];
    IF kana1[i] = nullPhonic THEN RETURN[TRUE];
  ENDLOOP;
  RETURN[TRUE]
END;

-- SameRecord

SameRecord: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] =
BEGIN
  nWords: CARDINAL;
  
  IF nLEntries >= MaxEntries
    THEN { Put.Text[logSW, "Entry table overflow: "L];
    	   FOR i: CARDINAL IN [0 .. nKanaCodes-1) DO
	     Put.Decimal[logSW, KanaCode[i]];
	     Put.Text[logSW, ", "]
	   ENDLOOP;
	   Put.Decimal[logSW, KanaCode[nKanaCodes-1]];
	   Put.Line[logSW, " "L] }
    ELSE { [nWords, pLEntry[nLEntries]] ← ConvertEntry[pMEntry];
           nLEntries ← nLEntries + 1;
           recsize ← recsize + nWords;
	   pI0.count ← pI0.count + 1;
	   pI1.count ← pI1.count + 1;
	   pI2.count ← pI2.count + 1;
	   nEntry ← nEntry + 1 };
END;

-- ConvertEntry

ConvertEntry: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] 
		RETURNS [nWords: CARDINAL, pLEntry: LONG POINTER TO JLispLookupFile.LEntry] =
BEGIN  
  nKanjis ← 0;
  FOR i: CARDINAL IN [0..JLispLookupFile.MaxKanjiPerEntry) DO
    kanjiArray[i] ← pMEntry.kanji[i];
    IF kanjiArray[i].code # Onesbyte THEN nKanjis ← i + 1;
  ENDLOOP;
  
  pLEntry ← myZone.NEW[JLispLookupFile.LEntry[nKanjis]];
  pLEntry.pos ← pMEntry.pos;
  pLEntry.pre ← 1;
  pLEntry.freq ← pMEntry.freq;
  pLEntry.nKanjis ← nKanjis;
  FOR i: CARDINAL IN [0..nKanjis) DO
    pLEntry.kanji[i] ← pMEntry.kanji[i]
  ENDLOOP;
  nWords ← nKanjis + 3;
  RETURN [nWords, pLEntry];
END;

-- DifferentRecord

DifferentRecord: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] =
BEGIN
  nWords: CARDINAL;
  
  IF ~firstTime THEN OutputPrevRecord[];
  SetupKanaCodes[pMEntry];
  ClearAllLEntries[];
  
  [nWords, pLEntry[0]] ← ConvertEntry[pMEntry];
  nLEntries ← 1;
  recsize ← nWords + CeilQuotient[nKanaCodes, 2] + 3;
  			-- for recsize(1), nKanaCodes(1), and nLEntries(1)
  pI0.count ← pI0.count + 1;
  pI1.count ← pI1.count + 1;
  pI2.count ← pI2.count + 1;
  nEntry ← nEntry + 1;
END;

-- OutputPrevRecord

OutputPrevRecord: PROCEDURE =
BEGIN
  Stream.PutWord[lookupStrH, recsize];
  Stream.PutWord[lookupStrH, nKanaCodes];
  FOR i: CARDINAL IN [0..nKanaCodes) DO
    Stream.PutByte[lookupStrH, KanaCode[i]]
  ENDLOOP;
  IF nKanaCodes MOD 2 # 0 THEN Stream.PutByte[lookupStrH, nullPhonic];
  Stream.PutWord[lookupStrH, nLEntries];
  FOR i: CARDINAL IN [0..nLEntries) DO
    OutputEntry[ pLEntry[i] ];
  ENDLOOP;
  AdvancePtr[recsize];
END;

-- OutputEntry

OutputEntry: PROCEDURE[pLEntry: LONG POINTER TO JLispLookupFile.LEntry] =
BEGIN
  Stream.PutWord[lookupStrH, pLEntry.nKanjis];
  FOR i: CARDINAL IN [0..pLEntry.nKanjis) DO
    Stream.PutByte[lookupStrH, pLEntry.kanji[i].chset];
    Stream.PutByte[lookupStrH, pLEntry.kanji[i].code]
  ENDLOOP;
  Stream.PutByte[lookupStrH, pLEntry.pos];
  Stream.PutByte[lookupStrH, pLEntry.pre];
  Stream.PutByte[lookupStrH, pLEntry.freq];
  Stream.PutByte[lookupStrH, pLEntry.reserved];
END;

-- OutputDictPtr

OutputDictPtr: PROCEDURE [strH: Stream.Handle, aDictPtr: JLispLookupFile.DictPtr] =
BEGIN
  Stream.PutWord[strH, aDictPtr.dictPageNo];
  Stream.PutByte[strH, aDictPtr.padding];
  Stream.PutByte[strH, aDictPtr.relAddr];
END;

-- AdvancePtr

AdvancePtr: PROCEDURE[adv: CARDINAL] =
BEGIN
  temp: CARDINAL;
  
  temp ← CARDINAL[currentDictPtr.relAddr] + adv;
  currentDictPtr.dictPageNo ← currentDictPtr.dictPageNo + temp/256;
  currentDictPtr.relAddr ← temp MOD 256;
END;

-- ClearAllLEntries

ClearAllLEntries: PROCEDURE =
BEGIN
  FOR i: CARDINAL IN [0.. nLEntries) DO
    myZone.FREE[ @pLEntry[i] ];
  ENDLOOP;
END;

-- SetupKanaCodes

SetupKanaCodes: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] =
BEGIN
  FOR i: CARDINAL IN [0..JLispLookupFile.MaxKanaPerEntry) DO
    KanaCode[i] ← pMEntry.kana[i];
    IF KanaCode[i] # nullPhonic
      THEN nKanaCodes ← i + 1
  ENDLOOP;
  IF KanaCode[0] # kana0
    THEN NewKana0[]
    ELSE IF KanaCode[1] # kana1 THEN NewKana1[]
    ELSE IF KanaCode[2] # kana2 THEN NewKana2[];
END;

-- NewKana0

NewKana0: PROCEDURE [] =
BEGIN
  new: LONG POINTER TO IndexRecord;
  
  kana0 ← KanaCode[0];
  kana1 ← KanaCode[1];
  kana2 ← KanaCode[2];
    
  pI2 ← myZone.NEW[IndexRecord];
  pI2↑ ← IndexRecord[kana: KanaCode[2], next: NIL, count: 0,
   		     flag: external, lower: NIL, dictPtr: currentDictPtr];
		     
  pI1 ← myZone.NEW[IndexRecord];
  pI1↑ ← IndexRecord[kana: KanaCode[1], next: NIL, count: 0,
    		     lower: pI2, flag: internal, dictPtr: nullPtr];
	   
  new ← myZone.NEW[IndexRecord];
  IF firstTime THEN { firstTime ← FALSE;
  		      pRootIndex ← new}
	       ELSE pI0.next ← new;
  pI0 ← new;		      
  pI0↑ ← IndexRecord[kana: KanaCode[0], next: NIL, count: 0,
  		     lower: pI1, flag: internal, dictPtr: nullPtr];
END;

-- NewKana1

NewKana1: PROCEDURE [] =
BEGIN
  new: LONG POINTER TO IndexRecord;
  
  kana1 ← KanaCode[1];
  kana2 ← KanaCode[2];
  
  pI2 ← myZone.NEW[IndexRecord];
  pI2↑ ← IndexRecord[kana: kana2, next: NIL, count: 0, flag: external, dictPtr: currentDictPtr];
  
  new ← myZone.NEW[IndexRecord];
  pI1.next ← new;
  pI1 ← new;
  pI1↑ ← IndexRecord[kana: kana1, next: NIL, count: 0, flag: internal,
  		     lower: pI2, dictPtr: nullPtr];
END;

-- NewKana2

NewKana2: PROCEDURE [] =
BEGIN
  new: LONG POINTER TO IndexRecord;
  
  kana2 ← KanaCode[2];
  new ← myZone.NEW[IndexRecord];
  pI2.next ← new;
  pI2 ← new;
  pI2↑ ← IndexRecord[kana: kana2, next: NIL, count: 0, flag: external, dictPtr: currentDictPtr];
END;

-- LastEntry

LastEntry: PROCEDURE [pMEntry: LONG POINTER TO CESDictDataDefs.Entry] = 
BEGIN
  OutputPrevRecord[];
  ClearAllLEntries[];
END;

-- CeilQuotient

CeilQuotient: PROCEDURE [x, y: CARDINAL] RETURNS[CARDINAL] =
BEGIN
  IF x MOD y = 0 THEN RETURN[x/y]
  		 ELSE RETURN[x/y+1]
		
END;

-- Pass2

Pass2: PROCEDURE [] =
BEGIN
  FOR pi: LONG POINTER TO IndexRecord ← pRootIndex, pi.next UNTIL pi = NIL DO
    MergeIndex[pi];
  ENDLOOP;
  Put.Line[logSW, "End of Pass 2"L];
END;


-- MergeIndex

MergeIndex: PROCEDURE [pI: LONG POINTER TO IndexRecord] =
BEGIN
  IF pI = NIL OR pI.flag = external THEN RETURN;
  FOR pi: LONG POINTER TO IndexRecord ← pI, pi.next UNTIL pi = NIL DO
    IF pi.flag = internal THEN {
        MergeIndex[pi.lower];
	IF pi.count <= maxCount OR pi.lower.next = NIL THEN {
            pi.flag ← external;
            pi.dictPtr ← pi.lower.dictPtr;
	    pi.lower ← NIL; -- ?
	     -- FreeIndex[pi.lower] -- } }
  ENDLOOP;
END;

-- FreeIndex

FreeIndex: PROCEDURE [pI: LONG POINTER TO IndexRecord] =
BEGIN
  this, next: LONG POINTER TO IndexRecord;
  
  IF pI = NIL THEN RETURN;
  this ← pI;
  next ← this.next;
  WHILE next ~= NIL DO
    myZone.FREE[ @this ];
    this ← next;
    next ← this.next;
  ENDLOOP;
  myZone.FREE[ @this ];
END;

-- Pass3

Pass3: PROCEDURE [] =
BEGIN
  level0Count, level0F, level0L: CARDINAL;
  first, last: CARDINAL;
  
  level0L ← TotalCount[pRootIndex];
  level0Count ← OneLevelCount[pRootIndex];
  level0F ← level0L - level0Count + 1;
  OutputIndexHead[level0L, level0F, level0L];
  
  [first, last] ← OutputIndices[pRootIndex];
  IF first ~= level0F
    THEN { Put.Text[logSW, "level0F calculation error ... Calculated = "L];
    	   Put.Decimal[logSW, level0F];
	   Put.Text[logSW, ", but real value = "L];
	   Put.Decimal[logSW, first];
	   Put.Line[logSW, " "L] };
  IF last ~= level0L
    THEN { Put.Text[logSW, "level0L calculation error ... Calculated = "L];
    	   Put.Decimal[logSW, level0L];
	   Put.Text[logSW, ", but real value = "L];
	   Put.Decimal[logSW, last];
	   Put.Line[logSW, " "L] };
  Put.Line[logSW, "End of Pass 3"L];
END;

-- OneLevelCount

OneLevelCount: PROCEDURE [pI: LONG POINTER TO IndexRecord] RETURNS[count: CARDINAL] =
BEGIN
  count ← 0;
  FOR pi: LONG POINTER TO IndexRecord ← pI, pi.next UNTIL pi = NIL DO
    count ← count + 1;
  ENDLOOP;
  RETURN[count];
END;

-- TotalCount

TotalCount: PROCEDURE [pI: LONG POINTER TO IndexRecord] RETURNS[count: CARDINAL] =
BEGIN
  count ← 0;
  FOR pi: LONG POINTER TO IndexRecord ← pI, pi.next UNTIL pi = NIL DO
    IF pi.flag = internal
      THEN count ← count + 1 + TotalCount[pi.lower]
      ELSE count ← count + 1;
  ENDLOOP;
  RETURN [count];
END;

-- OutputIndexHead

OutputIndexHead: PROCEDURE [size, level0F, level0L: CARDINAL] =
BEGIN
  Stream.PutWord[indexStrH, size];
  Stream.PutWord[indexStrH, level0F];
  Stream.PutWord[indexStrH, level0L];
  currentIndex ← 1;
END;

-- OutputIndices

OutputIndices: PROCEDURE [pI: LONG POINTER TO IndexRecord] RETURNS[first,last: CARDINAL] =
BEGIN
  FOR pi: LONG POINTER TO IndexRecord ← pI, pi.next UNTIL pi = NIL DO
    IF pi.flag = internal THEN [pi.firstI, pi.lastI] ← OutputIndices[pi.lower];
  ENDLOOP;
  first ← currentIndex;
  FOR pi: LONG POINTER TO IndexRecord ← pI, pi.next UNTIL pi = NIL DO
    OutputIndex[pi];
  ENDLOOP;
  last ← currentIndex - 1;
  RETURN [first, last]; 
END;

-- OutputIndex

OutputIndex: PROCEDURE[pI: LONG POINTER TO IndexRecord] =
BEGIN
  Stream.PutByte[indexStrH, pI.kana];
  IF pI.flag = internal
    THEN { Stream.PutByte[indexStrH, pI.flag.ORD];
           Stream.PutWord[indexStrH, pI.firstI];
	   Stream.PutWord[indexStrH, pI.lastI] }
    ELSE { Stream.PutByte[indexStrH, pI.flag.ORD];
           OutputDictPtr[indexStrH, pI.dictPtr] };
  currentIndex ← currentIndex + 1;
END;  

-- main line of Create

  Initialize[];
  nEntry ← 1;

  Pass1[];
  Pass2[];
  Pass3[];
    
  Heap.Delete[myZone,TRUE];
  RETURN[nEntry, 0];
  
END;  -- of Create
END.