-- Parse.Mesa  Edited by Sandman on July 10, 1980  7:57 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [PageSize],
  BootmesaOps USING [
    BootAbort, BootmesaError, DisableHyperspace, FrameForGFI, ModuleGFI,
    MultipleNames, ResetConfig, SetConfig, SetDefaultGFTLength,
    SetDefaultMemoryLimits, SetDefaultNProcesses, SetResidentFramePages],
  CommanderDefs USING [AddCommand, CommandBlockHandle],
  ControlDefs USING [GFTIndex, GFTNull, GlobalFrameHandle, NullGlobalFrame],
  FSPDefs USING [
    AddToNewZone, DestroyZone, MakeNewZone, MakeNode, NodeOverhead, NoRoomInZone,
    ZoneOverhead, ZonePointer],
  IODefs USING [CR, NUL, SP, WriteChar, WriteString],
  String USING [
    AppendChar, AppendString, EqualString, InvalidNumber, StringToDecimal,
    WordsForString],
  Storage USING [Pages, FreePages, PagesForWords];

Parse: PROGRAM
  IMPORTS BootmesaOps, FSPDefs, IODefs, String, Storage, CommanderDefs
  EXPORTS BootmesaOps =PUBLIC
  
  BEGIN OPEN BootmesaOps;
  
  NUL: CHARACTER = IODefs.NUL;
  CR: CHARACTER = IODefs.CR;
  
  get: PROCEDURE RETURNS [CHARACTER];
  noMore: SIGNAL;
  
  InitParse: PUBLIC PROCEDURE [
    input: PROCEDURE RETURNS [CHARACTER], end: SIGNAL] =
    BEGIN get _ input; noMore _ end END;
    
  FinishParse: PUBLIC PROCEDURE =
    BEGIN
    Control _ Resident _ SwappedIn _ Wart _ Nub _ NoTrap _ NIL;
    lastResident _ lastSwappedIn _ lastNoTrap _ NIL;
    EraseHeap[]
    END;
    
  GetToken: PROCEDURE [token: STRING] RETURNS [term: CHARACTER] =
    BEGIN OPEN IODefs;
    token.length _ 0;
    DO
      ENABLE noMore => BEGIN term _ NUL; EXIT END;
      SELECT term _ get[] FROM
	'- => UNTIL get[] = CR DO NULL ENDLOOP;
	SP, CR => NULL;
	':, ';, '>, ', => RETURN;
	ENDCASE => String.AppendChar[token, term];
      ENDLOOP;
    END;
    
  module: STRING _ [40];
  config: STRING _ [40];
  keyword: STRING _ [40];
  
  GetModule: PROCEDURE [module, config: STRING] RETURNS [term: CHARACTER] =
    BEGIN
    module.length _ config.length _ 0;
    term _ GetToken[module];
    IF term = ': THEN
      BEGIN OPEN IODefs;
      WriteString["Syntax Error. Expected module Found "L];
      WriteString[module];
      WriteChar[term];
      SIGNAL BootAbort;
      END;
    IF term = '> THEN
      BEGIN
      String.AppendString[config, module];
      term _ GetToken[module];
      IF term = ': THEN
	BEGIN OPEN IODefs;
	WriteString["Syntax Error. Expected module Found "L];
	WriteString[module];
	WriteChar[term];
	SIGNAL BootAbort;
	END;
      IF term = '> THEN
	BootmesaModuleError[
	  "Syntax Error. Only one config name allowed "L, config, module];
      END;
    RETURN
    END;
    
  GetNumber: PROCEDURE RETURNS [term: CHARACTER, n: CARDINAL] =
    BEGIN
    token: STRING _ [10];
    null: STRING _ [1];
    term _ GetToken[token];
    n _ String.StringToDecimal[
      token !
      String.InvalidNumber =>
	BootmesaModuleError["Invalid Number"L, null, token]];
    RETURN
    END;
    
  BootmesaModuleError: PUBLIC PROCEDURE [msg, config, module: STRING] =
    BEGIN OPEN IODefs;
    WriteString[msg];
    IF config.length # 0 THEN BEGIN WriteString[config]; WriteChar['>]; END;
    WriteString[module];
    SIGNAL BootAbort;
    RETURN
    END;
    
  GetKeyWord: PROCEDURE [keyword: STRING] RETURNS [term: CHARACTER] =
    BEGIN
    keyword.length _ 0;
    term _ GetToken[keyword];
    IF term # ': AND keyword.length # 0 THEN
      BootmesaError["Syntax Error. Expected KEYWORD:"L];
    RETURN
    END;
    
  ParseInput: PUBLIC PROCEDURE =
    BEGIN OPEN String;
    term: CHARACTER;
    term _ GetKeyWord[keyword];
    UNTIL term = NUL DO
      SELECT TRUE FROM
	EqualString[keyword, "CONTROL"L] =>
	  BEGIN term _ GetModule[module, config]; AddControl[module, config]; END;
	EqualString[keyword, "NUB"L] =>
	  BEGIN term _ GetModule[module, config]; AddNub[module, config]; END;
	EqualString[keyword, "WART"L] =>
	  BEGIN term _ GetModule[module, config]; AddWart[module, config]; END;
	EqualString[keyword, "RESIDENTCODE"L] =>
	  BEGIN
	  DO
	    SELECT term _ GetModule[module, config] FROM
	      '; => EXIT;
	      ', => AddResident[module, config];
	      ENDCASE =>
		BootmesaModuleError[
		  "Syntax Error. Invalid modulelist at "L, config, module];
	    ENDLOOP;
	  AddResident[module, config];
	  END;
	EqualString[keyword, "SWAPPEDINCODE"L] =>
	  BEGIN
	  DO
	    SELECT term _ GetModule[module, config] FROM
	      '; => EXIT;
	      ', => AddSwappedIn[module, config];
	      ENDCASE =>
		BootmesaModuleError[
		  "Syntax Error. Invalid modulelist at "L, config, module];
	    ENDLOOP;
	  AddSwappedIn[module, config];
	  END;
	EqualString[keyword, "NOTRAP"L] =>
	  BEGIN
	  DO
	    SELECT term _ GetModule[module, config] FROM
	      '; => EXIT;
	      ', => AddNoTrap[module, config];
	      ENDCASE =>
		BootmesaModuleError[
		  "Syntax Error. Invalid modulelist at "L, config, module];
	    ENDLOOP;
	  AddNoTrap[module, config];
	  END;
	EqualString[keyword, "RESIDENTFRAMEPAGES"L] =>
	  BEGIN
	  pages: CARDINAL;
	  [term, pages] _ GetNumber[];
	  IF term # '; THEN BootmesaError["Error. Invalid Frame Page Size"L];
	  SetResidentFramePages[pages];
	  END;
	EqualString[keyword, "GFT"L] =>
	  BEGIN
	  length: CARDINAL;
	  [term, length] _ GetNumber[];
	  IF term # '; THEN BootmesaError["Error. Invalid GFT Length"L];
	  SetDefaultGFTLength[length];
	  END;
	EqualString[keyword, "MEMORY"L] =>
	  BEGIN
	  fp, lp: CARDINAL;
	  [term, fp] _ GetNumber[];
	  IF term # ', THEN BootmesaError["Error. Invalid Memory Bounds"L];
	  [term, lp] _ GetNumber[];
	  IF term # '; THEN BootmesaError["Error. Invalid Memory Bounds"L];
	  SetDefaultMemoryLimits[fp, lp];
	  END;
	EqualString[keyword, "PROCESSES"L] =>
	  BEGIN
	  number: CARDINAL;
	  [term, number] _ GetNumber[];
	  IF term # '; THEN BootmesaError["Error. Invalid Process Number"L];
	  SetDefaultNProcesses[number];
	  END;
	EqualString[keyword, "DISABLEHYPERSPACE"L] =>
	  BEGIN term _ GetToken[keyword]; DisableHyperspace[]; END;
	ENDCASE =>
	  BEGIN OPEN IODefs;
	  WriteString["Syntax Error. Expected Keyword: Found "L];
	  WriteString[keyword];
	  WriteChar[term];
	  SIGNAL BootAbort;
	  END;
      term _ GetKeyWord[keyword];
      ENDLOOP;
    RETURN;
    END;
    
  ModuleObject: TYPE = RECORD [
    link: ModuleHandle, gfi: ControlDefs.GFTIndex, module, config: STRING];
  
  ModuleHandle: TYPE = POINTER TO ModuleObject;
  
  Control, Resident, SwappedIn, Wart, Nub, NoTrap: ModuleHandle _ NIL;
  lastResident, lastSwappedIn, lastNoTrap: ModuleHandle _ NIL;
  
  GetModuleObject: PROCEDURE [module, config: STRING] RETURNS [ModuleHandle] =
    BEGIN OPEN Storage;
    m: ModuleHandle _ GetSpace[SIZE[ModuleObject]];
    m^ _
      [link: NIL, gfi: ControlDefs.GFTNull, module: GetString[module.length],
	config: GetString[config.length]];
    String.AppendString[m.module, module];
    String.AppendString[m.config, config];
    RETURN[m];
    END;
    
  AddControl: PROCEDURE [module, config: STRING] =
    BEGIN Control _ GetModuleObject[module, config]; END;
    
  AddWart: PROCEDURE [module, config: STRING] =
    BEGIN Wart _ GetModuleObject[module, config]; END;
    
  AddNub: PROCEDURE [module, config: STRING] =
    BEGIN Nub _ GetModuleObject[module, config]; END;
    
  AddResident: PROCEDURE [module, config: STRING] =
    BEGIN
    m: ModuleHandle _ GetModuleObject[module, config];
    IF Resident = NIL THEN Resident _ m ELSE lastResident.link _ m;
    lastResident _ m;
    END;
    
  AddSwappedIn: PROCEDURE [module, config: STRING] =
    BEGIN
    m: ModuleHandle _ GetModuleObject[module, config];
    IF SwappedIn = NIL THEN SwappedIn _ m ELSE lastSwappedIn.link _ m;
    lastSwappedIn _ m;
    END;
    
  AddNoTrap: PROCEDURE [module, config: STRING] =
    BEGIN
    m: ModuleHandle _ GetModuleObject[module, config];
    IF NoTrap = NIL THEN NoTrap _ m ELSE lastNoTrap.link _ m;
    lastNoTrap _ m;
    END;
    
  FindModule: PROCEDURE [m: ModuleHandle] =
    BEGIN OPEN m;
    IF gfi # ControlDefs.GFTNull THEN RETURN;
    IF config.length # 0 THEN SetConfig[config];
    gfi _ ModuleGFI[
      module !
      MultipleNames =>
	IF config.length = 0 THEN CONTINUE
	ELSE BEGIN SetConfig[config]; RETRY END];
    IF gfi = ControlDefs.GFTNull THEN
      BootmesaModuleError["Can't find module: "L, config, module];
    IF config.length # 0 THEN ResetConfig[];
    END;
    
  UserControl: PUBLIC PROCEDURE RETURNS [f: ControlDefs.GlobalFrameHandle] =
    BEGIN
    IF Control = NIL THEN RETURN[ControlDefs.NullGlobalFrame];
    FindModule[Control];
    f _ FrameForGFI[Control.gfi];
    END;
    
  NubFrame: PUBLIC PROCEDURE RETURNS [f: ControlDefs.GlobalFrameHandle] =
    BEGIN
    IF Nub = NIL THEN RETURN[ControlDefs.NullGlobalFrame];
    FindModule[Nub];
    f _ FrameForGFI[Nub.gfi];
    END;
    
  WartFrame: PUBLIC PROCEDURE RETURNS [f: ControlDefs.GlobalFrameHandle] =
    BEGIN
    IF Wart = NIL THEN BootmesaError["Error No Wart"L];
    FindModule[Wart];
    f _ FrameForGFI[Wart.gfi];
    IF f = ControlDefs.NullGlobalFrame THEN
      BootmesaModuleError["Error Can't find Wart: "L, config, module];
    END;
    
  LookUpModules: PUBLIC PROCEDURE =
    BEGIN
    LookUpModuleList[Resident];
    LookUpModuleList[SwappedIn];
    LookUpModuleList[NoTrap];
    RETURN
    END;
    
  LookUpModuleList: PROCEDURE [list: ModuleHandle] =
    BEGIN
    m: ModuleHandle;
    FOR m _ list, m.link UNTIL m = NIL DO FindModule[m] ENDLOOP;
    END;
    
  EnumerateResidentModules: PUBLIC PROCEDURE [
    proc: PROCEDURE [ControlDefs.GFTIndex] RETURNS [BOOLEAN]]
    RETURNS [ControlDefs.GFTIndex] =
    BEGIN RETURN[EnumerateModules[Resident, proc]] END;
    
  EnumerateSwappedInModules: PUBLIC PROCEDURE [
    proc: PROCEDURE [ControlDefs.GFTIndex] RETURNS [BOOLEAN]]
    RETURNS [ControlDefs.GFTIndex] =
    BEGIN RETURN[EnumerateModules[SwappedIn, proc]] END;
    
  EnumerateNoTrapModules: PUBLIC PROCEDURE [
    proc: PROCEDURE [ControlDefs.GFTIndex] RETURNS [BOOLEAN]]
    RETURNS [ControlDefs.GFTIndex] =
    BEGIN RETURN[EnumerateModules[NoTrap, proc]] END;
    
  EnumerateModules: PROCEDURE [
    list: ModuleHandle, proc: PROCEDURE [ControlDefs.GFTIndex] RETURNS [BOOLEAN]]
    RETURNS [ControlDefs.GFTIndex] =
    BEGIN
    m: ModuleHandle;
    FOR m _ list, m.link UNTIL m = NIL DO
      IF m.gfi # ControlDefs.GFTNull AND proc[m.gfi] THEN RETURN[m.gfi]; ENDLOOP;
    RETURN[ControlDefs.GFTNull]
    END;
    
  parseHeap: FSPDefs.ZonePointer _ NIL;
  
  GetString: PROCEDURE [nchars: CARDINAL] RETURNS [s: STRING] =
    BEGIN
    s _ GetSpace[String.WordsForString[nchars]];
    s^ _ [length: 0, maxlength: nchars, text:];
    RETURN
    END;
    
  GetSpace: PROCEDURE [nwords: CARDINAL] RETURNS [p: POINTER] =
    BEGIN OPEN Storage, FSPDefs;
    np: CARDINAL;
    IF parseHeap = NIL THEN InitHeap[];
    p _ MakeNode[
      parseHeap, nwords !
      NoRoomInZone =>
	BEGIN
	np _ PagesForWords[nwords + ZoneOverhead + NodeOverhead];
	IF np < 2 THEN np _ 2;
	AddToNewZone[parseHeap, Pages[np], np*AltoDefs.PageSize, FreePages];
	RESUME
	END];
    RETURN
    END;
    
  InitHeap: PROCEDURE =
    BEGIN OPEN Storage, FSPDefs;
    IF parseHeap # NIL THEN EraseHeap[];
    parseHeap _ MakeNewZone[Pages[4], 1024, FreePages];
    RETURN
    END;
    
  EraseHeap: PROCEDURE =
    BEGIN FSPDefs.DestroyZone[parseHeap]; parseHeap _ NIL; RETURN END;
    
  FindModuleFromString: PROCEDURE [s, module, config: STRING] =
    BEGIN
    i: CARDINAL;
    c: CHARACTER;
    FOR i IN [0..s.length) DO
      SELECT (c _ s[i]) FROM
	'> => BEGIN String.AppendString[config, module]; module.length _ 0; END;
	IN ['A..'Z], IN ['a..'z], IN ['0..'9] => String.AppendChar[module, c];
	ENDCASE => BEGIN module.length _ 0; EXIT END;
      ENDLOOP;
    RETURN
    END;
    
  ResidentCM: PROCEDURE [s: STRING] =
    BEGIN
    module: STRING _ [40];
    config: STRING _ [40];
    FindModuleFromString[s, module, config];
    IF module.length = 0 THEN IODefs.WriteString["! Bad name"]
    ELSE AddResident[module, config];
    RETURN
    END;
    
  SwappedInCM: PROCEDURE [s: STRING] =
    BEGIN
    module: STRING _ [40];
    config: STRING _ [40];
    FindModuleFromString[s, module, config];
    IF module.length = 0 THEN IODefs.WriteString["! Bad name"]
    ELSE AddSwappedIn[module, config];
    RETURN
    END;
    
  AddCommands: PROCEDURE =
    BEGIN OPEN CommanderDefs;
    c: CommandBlockHandle;
    c _ AddCommand["ResidentCodeModule", LOOPHOLE[ResidentCM], 1];
    c.params[0] _ [type: string, prompt: "Module name"];
    c _ AddCommand["SwappedInCodeModule", LOOPHOLE[SwappedInCM], 1];
    c.params[0] _ [type: string, prompt: "Module name"];
    RETURN
    END;
    
  AddCommands[];
  
  END...