--RouteParse.mesa

DIRECTORY
  IODefs: FROM "IODefs",
  SegmentDefs: FROM "SegmentDefs",
  RouteDefs:FROM "RouteDefs",
  StringDefs:FROM "StringDefs",
  SystemDefs: FROM "SystemDefs",
  StreamDefs: FROM "StreamDefs";

RouteParse:PROGRAM IMPORTS SegmentDefs, StringDefs, IODefs, SystemDefs, StreamDefs, RouteDefs EXPORTS RouteDefs=BEGIN OPEN RouteDefs;

Error:SIGNAL=CODE;
Done:SIGNAL=CODE;
Feed:CHARACTER=14C;
Tab:CHARACTER='	;
Comma:CHARACTER=',;
SQ:CHARACTER='';
Gets:CHARACTER='←;
lParen:CHARACTER='(;
rParen:CHARACTER=');
Plus:CHARACTER='+;
Minus:CHARACTER='-;
Del:CHARACTER=377C;


cellCode:INTEGER=-1;
posCode:INTEGER=-2;
sizeCode:INTEGER=-3;
endFileCode:INTEGER=-4;
nameCode:INTEGER=-5;
sideCode:INTEGER=-6;
levelCode:INTEGER=-7;
offsetCode:INTEGER=-8;
northCode:INTEGER=-9;
southCode:INTEGER=-10;
eastCode:INTEGER=-11;
westCode:INTEGER=-12;
redCode:INTEGER=-13;
blueCode:INTEGER=-14;
bothCode:INTEGER=-15;
chipCode:INTEGER=-16;
leftBracketCode:INTEGER=-17;
rightBracketCode:INTEGER=-18;
commaCode:INTEGER=-19;
netCode:INTEGER=-20;
tieCode:INTEGER=-21;

Ret:CHARACTER='
;
Space:CHARACTER=' ;

innstream:StreamDefs.DiskHandle←NIL;

fileName:STRING← [50];

GetInput:PUBLIC PROCEDURE={GetInputFile; Parse};

GetInputFile:PROCEDURE=BEGIN
FOR i:INTEGER IN [0..1000) DO
good:BOOLEAN←TRUE;
IF chipmonk THEN GetChipmonkString[fileName,""L, "input file name= "L,""L]
ELSE BEGIN
  IF i#0 THEN IODefs.WriteString["  no such file!"L];
  AskForFileName["input file name= "];
  --IF fileName.length=0 THEN ImageDefs.StopMesa[];
  END;
FixExtension[fileName,".txt"L];
innstream←StreamDefs.NewByteStream[fileName,StreamDefs.Read
     !SegmentDefs.FileNameError=>{good←FALSE; CONTINUE}];
  IF good THEN EXIT;
  ENDLOOP;
END;

FixExtension: PROCEDURE [s, ext: STRING]=BEGIN
FOR i: CARDINAL IN [0..s.length) DO IF s[i] = '. THEN RETURN; ENDLOOP;
StringDefs.AppendString[to: s, from: ext];
END;

AskForFileName:PROCEDURE[s:STRING]= BEGIN OPEN IODefs;
WriteChar[Ret];
WriteString[s];
ReadID[fileName !Rubout=>RETRY;];
END;

Parse:PROCEDURE=BEGIN
DictInit[];
ReadTheFile[];
innstream.destroy[innstream];
END;

nextNetNo:NetNo;

ReadTheFile:PROCEDURE=BEGIN
cell:CellPtr←NIL;
signal:SignalPtr←NIL;
netNumber:INTEGER←0;
t:INTEGER;
problem←[];
hold←FALSE;
nextNetNo←1;
DO SELECT t←GetToken[] FROM
  >0=>Error;
  =0=>Error;
  chipCode=>problem.chipSize←ReadPoint[];
  cellCode=>BEGIN
      cellNo:INTEGER←Number[];
      cell←NIL; signal←NIL;
      FOR cl:CellListPtr←problem.cells,cl.t UNTIL cl=NIL DO
        IF cl.h.cellNo=cellNo THEN {cell←cl.h; EXIT}; ENDLOOP;
      IF cell=NIL THEN BEGIN
          cellList:CellListPtr←AllocateList[];
          cell←AllocateCell[];
          cell.cellNo←cellNo;
          cellList↑←[cell,problem.cells];
          problem.cells←cellList;
        END;
      END;
  endFileCode=>RETURN;
  posCode=>IF cell=NIL THEN Error ELSE cell.pos←ReadPoint[];
  sizeCode=>IF cell=NIL THEN Error ELSE cell.sizeL←ReadPoint[];
  nameCode=>BEGIN
    j:STRING←ReadName[];
    signalList:SignalListPtr←AllocateList[];
    IF cell=NIL THEN Error;
    FOR sl:SignalListPtr←cell.signals,sl.t UNTIL sl=NIL DO
      s:SignalPtr=sl.h;
      IF SameString[j,s.name] THEN Error;
      ENDLOOP;
    signal←AllocateSignal[];
    signal.name←j;
    signalList↑←[signal,cell.signals];
    cell.signals←signalList;
    END;
  sideCode=>IF signal=NIL THEN Error ELSE signal.side←ReadSide[];
  levelCode=>IF signal=NIL THEN Error ELSE signal.level←ReadLevel[];
  offsetCode=>IF signal=NIL THEN Error ELSE signal.offset←Number[];
  netCode=>netNumber←netNumber+1;
  tieCode=>BEGIN
    s:STRING←ReadName[];
    netList:NetListPtr←AllocateList[];
    net:NetPtr←AllocateNet[];
    net↑←[netNumber,s,nextNetNo];
    nextNetNo←nextNetNo+1;
    netList↑←[net,problem.wirelist];
    problem.wirelist←netList;
    END;
  ENDCASE=>Error;
  ENDLOOP;
END;

ReadPoint:PROCEDURE RETURNS[c:CoordL]=BEGIN
t:INTEGER←GetToken[];
IF t#leftBracketCode THEN Error;
c.x←Number[];
t←GetToken[];
IF t#commaCode THEN Error;
c.y←Number[];
t←GetToken[];
IF t#rightBracketCode THEN Error;
END;

ReadName:PROCEDURE RETURNS[STRING]={RETURN[GetRealWords[]]};

ReadSide:PROCEDURE RETURNS[Side]=BEGIN
t:INTEGER←GetToken[];
SELECT t FROM
  northCode=>RETURN[n];
  southCode=>RETURN[s];
  eastCode=>RETURN[e];
  westCode=>RETURN[w];
  ENDCASE=>{Error; RETURN[n]};
END;

ReadLevel:PROCEDURE RETURNS[What]=BEGIN
t:INTEGER←GetToken[];
SELECT t FROM
  redCode=>RETURN[red];
  blueCode=>RETURN[blue];
  bothCode=>RETURN[both];
  ENDCASE=>{Error; RETURN[both]};
END;

--////// manage tokens and dictionary

dict:ARRAY [0..100) OF Dict←ALL[[NIL,0]];
dictMax:INTEGER=LENGTH[dict];
dictEnd:INTEGER←0;
dictBase:INTEGER←4;
Dict:TYPE=RECORD[s:STRING,v:INTEGER];

DictInit:PROCEDURE=BEGIN
dict[0]←["cell",cellCode];
dict[1]←["pos",posCode];
dict[2]←["size",sizeCode];
dict[3]←["end",endFileCode];
dict[4]←["name",nameCode];
dict[5]←["side",sideCode];
dict[6]←["level",levelCode];
dict[7]←["offset",offsetCode];
dict[8]←["n",northCode];
dict[9]←["s",southCode];
dict[10]←["e",eastCode];
dict[11]←["w",westCode];
dict[12]←["red",redCode];
dict[13]←["blue",blueCode];
dict[14]←["both",bothCode];
dict[15]←["chip",chipCode];
dict[16]←["net",netCode];
dict[17]←["tie",tieCode];
dictEnd←18;
END;

GetToken:PROCEDURE RETURNS[INTEGER]=BEGIN DO
  t:STRING←GetRealWords[];
  IF t=NIL THEN RETURN[endFileCode];
  SELECT t[0] FROM
    '[=>RETURN[leftBracketCode];
    ']=>RETURN[rightBracketCode];
    ',=>RETURN[commaCode];
    ENDCASE=>RETURN[Lookup[t]];
  ENDLOOP; END;

Lookup:PROCEDURE[s:STRING] RETURNS[z:INTEGER]=BEGIN
  z←dictEnd;
  FOR i:INTEGER IN [0..z) DO
    IF SameString[s,dict[i].s] THEN RETURN[dict[i].v];
    ENDLOOP;
  dict[z]←[s,z-dictBase];
  dictEnd←dictEnd+1;
  RETURN[dict[z].v];
  END;

Lookup2:PUBLIC PROCEDURE[z:INTEGER] RETURNS[STRING]=BEGIN
  RETURN[dict[z+dictBase].s];
  END;

hold:BOOLEAN; holdC:CHARACTER←' ;

GetRealWords:PROCEDURE RETURNS[t:STRING]=BEGIN
  s:STRING←GetFreeString[];
  c:CHARACTER; s.length←0; t←NIL;
  IF hold THEN {hold←FALSE; s[0]←holdC; s.length←1; RETURN[s]}; 
  DO
    IF innstream.endof[innstream] THEN RETURN[NIL];
    SELECT c←GetChar[] FROM
      Space,Ret,Tab=>IF s.length >0 THEN RETURN[s] ELSE s.length←0;
      IN ['a..'z],SQ,Gets,lParen,rParen,Plus,Minus, IN ['0..'9]=>
              {s[s.length]←c; s.length←s.length+1};
      IN ['A..'Z]=> {s[s.length]←c-'A+'a; s.length←s.length+1};
      '[,'],',=> IF s.length=0 THEN {s[0]←c; s.length←1; RETURN[s];}
                    ELSE {hold←TRUE; holdC←c; RETURN[s]};
      ENDCASE=>Error;--illegal character
    ENDLOOP;
  END;

Number:PROCEDURE RETURNS[INTEGER]=BEGIN
  found,min:BOOLEAN←FALSE;  c:CHARACTER;
  i:INTEGER←0;
  DO
    SELECT c←GetChar[] FROM
      Space,Ret,Tab,Comma=>IF found THEN RETURN[IF min THEN -i ELSE i];
      IN ['0..'9]=>{i←i*10+(c-'0); found←TRUE};
      Minus=> min←TRUE;
      ENDCASE=>Error;--illegal character
    ENDLOOP;
  END;

Suck:PROCEDURE=
  {UNTIL SELECT Get[] FROM Ret=>TRUE, ENDCASE=>FALSE DO ENDLOOP};

held:CHARACTER←Del;

GetChar:PROCEDURE RETURNS[c:CHARACTER]=BEGIN
  IF held#Del THEN {c←held; held←Del} ELSE c←Get[];
  IF c=Minus AND (held←Get[])=Minus THEN {Suck[];  held←Del;  c←Ret};
  END;

Get:PROCEDURE RETURNS[c:CHARACTER]=--INLINE--BEGIN
  c←innstream.get[innstream];
  END;

empties:ARRAY [0..200) OF STRING←ALL[NIL];
emptyEnd:INTEGER←0;

GetFreeString:PROCEDURE RETURNS[s:STRING]=BEGIN
  IF emptyEnd=0 THEN RETURN[SystemDefs.AllocateHeapString[10]];
  emptyEnd←emptyEnd-1;
  RETURN[empties[emptyEnd]];
  END;

FreeString:PROCEDURE[s:STRING]=BEGIN
  IF emptyEnd<200 THEN { empties[emptyEnd]←s; emptyEnd←emptyEnd+1}
                  ELSE SystemDefs.FreeHeapString[s];
  END;

END..