--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..