-- MDModel.Mesa
-- last edit by Schmidt, January 6, 1983 2:11 pm 
-- last edit by Satterthwaite, January 31, 1983 5:03 pm 
-- definitions file for the modeller

DIRECTORY
  CompilerOps: TYPE USING [LetterSwitches],
  Dir: TYPE USING [DepSeq, FileInfo],
  File: TYPE USING [Capability],
  LowLoader: TYPE USING [InterfaceSeq],
  PilotLoadStateFormat: TYPE USING [ConfigIndex],
  Space: TYPE USING [Handle],
  Stream: TYPE USING [Handle],
  Subr: TYPE USING[TTYProcs],
  TimeStamp: TYPE USING [Stamp],
  TypeScript: TYPE USING [TS];

MDModel: DEFINITIONS = {

  SubType: TYPE = {	-- order is important
	typeBAD, typeLOC, typeLIST, typeLET, typeOPEN, typeMODEL, 
	typeTYPE, typePROC, typeSTRING, typeAPPL};
  HasAStringName: TYPE = SubType[$typeTYPE..$typeAPPL];


 -- check AllocateSymbolSeq in MDSupportImpl before changing this struct.
  SymbolSeq: TYPE = LONG POINTER TO SymbolSeqRecord;
  SymbolSeqRecord: TYPE = RECORD[
	controlv: TYPESymbol←NIL,	-- symbol for "CONTROL"
	toploc: LOCSymbol←NIL,	-- top of the sym tree after parsing
	traversalInProgress: BOOL←FALSE,	-- if T then we must save visited bits
	savedInUse: BOOL←FALSE,
	savedVisited: LONG POINTER←NIL,	-- LP to packed array of bool
	modelSeq: ModelSeq←NIL,
	size: CARDINAL←0,			-- current size
	body: SEQUENCE maxsize: CARDINAL OF SymbolRecord];

  ModelSeq: TYPE = LONG POINTER TO ModelSeqRecord;
  ModelSeqRecord: TYPE = RECORD[
	size: CARDINAL←0,		-- current size
	body: SEQUENCE maxsize: CARDINAL OF MODELSymbol];

  ListType: TYPE = {normal, plus, then};
    -- $plus if object of a PLUS, $then if object of a THEN, $normal otherwise

  Symbol: TYPE = LONG POINTER TO SymbolRecord;
  SymbolRecord: TYPE = RECORD[
	defn: BOOL←FALSE,		-- if T, symbol has been defined
	print: BOOL←FALSE,		-- if T, symbol val has been printed
	visited: BOOL←FALSE,		-- used by tree marking algorithms
	recursive: BOOL←FALSE,	-- this node is in a recursive cycle
	changed: BOOL←FALSE,		-- used in determining recompilation
	failed: BOOL←FALSE,		-- used in determining recompilation
	qualified: BOOL←FALSE,	-- if T then this var is b of a.b
	vpart: SELECT stype: SubType FROM
	    typeTYPE => [			-- id: TYPE ?typeName = val
		typesym: LONG STRING,	-- the text of the symbol
		typeName: LONG STRING,	-- the modulename, defaults to typesym
		typeval: Symbol,
		frameptr: BOOL,		-- T=> is typesym: FRAMEPTRTYPE
		letparent: LETSymbol,
		uniqueno: CARDINAL	-- 0 is no #, otherwise is add 1 to
					-- to get a unique instance of this
		],
	    typeLOC => [			-- [host]path>tail.sext!createtime[parm(s)]
		host: LONG STRING,
		path: LONG STRING,
		tail: LONG STRING,	-- does not have ".mesa" or ".bcd"
		sext: LONG STRING,
		createtime: LONG CARDINAL,	-- create time of ".mesa" or ".bcd"
		parmlist: LISTSymbol,
		nestedmodel: MODELSymbol,
		fi: Dir.FileInfo,	-- points to info about local files
		-- below is used to make the model
		parmsdefaultable: BOOL,	-- if T, then parameters to 
					-- this module may all be defaulted
		prinpart: CARDINAL	-- if ~= 0, index into sext, 1st char
					-- of prinpart, terminated by '.
		],
	    typePROC => [			-- id:PROC ?group RETURNS ?group = val
		procsym: LONG STRING,-- the text of the symbol
		procparm: LISTSymbol,
		procret: LISTSymbol,
		procval: Symbol
		],
	    typeSTRING => [			-- STRING = val
		strsym: LONG STRING,	-- the text of the symbol
		strval: LONG STRING	-- the value of the var of type STRING
		],
	    typeAPPL => [
		applsym: LONG STRING,	-- the text of the symbol
		appltype: Symbol,
		applval: Symbol,	-- may be LOC or LIST
		configname: LONG STRING, -- the name of the interface record
					-- used in the config 
		letparent: LETSymbol,	-- if not NIL, pts to LET node this is
					-- in letgrp of
		interfaceseq: LowLoader.InterfaceSeq
		],
	    typeLET => [
		letgrp: LISTSymbol,	-- list of exports, typeLIST
		letval: Symbol		-- value
		],
	    typeLIST => [		-- lists are terminated by rest = NIL
		listtype: ListType,	-- default is "$normal"
		first: Symbol,
		rest: LISTSymbol
		],
	    typeOPEN => [		-- OPEN x
		open: Symbol	-- the argument
		],
	    typeMODEL => [	-- invisible header before each model
		modelfilename: LONG STRING,	-- the name, with ".Model" at end
		modelchanged: BOOL,		-- if T then the model has been chg
		modelcap: File.Capability,	-- cap for the model file
		modelcreate: LONG CARDINAL,	-- create date of model file
		model: LISTSymbol,		-- the parsed contents of model
		fakebcdspace: Space.Handle,	-- the bcdbase for a fake config
		configindex: PilotLoadStateFormat.ConfigIndex,	-- fake config index
		started: BOOL			-- true if modules have been loaded and STARTed
		],
	    typeBAD => NULL,
	    ENDCASE];

 -- these are the discriminated pointer types
  LOCSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeLOC;
  LISTSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeLIST;
  LETSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeLET;
  OPENSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeOPEN;
  MODELSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeMODEL;
  TYPESymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeTYPE;
  PROCSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typePROC;
  STRINGSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeSTRING;
  APPLSymbol: TYPE = 	LONG POINTER TO SymbolRecord.typeAPPL;

-- procs

-- defined in MDParseImpl.Mesa

  ModelParse: PROC[SymbolSeq, TypeScript.TS, Subr.TTYProcs];
  PushInputStream: PROC[Stream.Handle];
 -- parsing of Mesa source files and .Configs, fill in depseq, sfn is the file
  ParseUnit: PROC[sh: Stream.Handle, depseq: Dir.DepSeq, sfn: LONG STRING];
 -- call to free memory of scanner
  StopScanner: PROC;

-- defined in MDRulesImpl.Mesa (call before calling P1.Parse)

  ParseInit: PROC[ss: SymbolSeq, make: BOOL, typeScript: TypeScript.TS,
	ttywindow: Subr.TTYProcs];
  ParseLoc: PROC[sploc: LOCSymbol, typeScript: TypeScript.TS, ttywindow: Subr.TTYProcs] 
	RETURNS[symmodel: MODELSymbol, nerrors: CARDINAL];
  ProcessFilename: PROC[fn: LONG STRING] RETURNS[sploc: LOCSymbol];

-- defined in MDSupportImpl.Mesa
	
  LookForTypeSource: PROC[
	formal, typeName: LONG STRING, symbolseq: SymbolSeq, spmodel: MODELSymbol] 
	RETURNS[sptype: TYPESymbol, sptypeloc: LOCSymbol, spproc: PROCSymbol];
  LookForTypeBcd: PROC[bcdFileName: LONG STRING, bcdVers: TimeStamp.Stamp,
	symbolseq: SymbolSeq, spmodel: MODELSymbol] 
	RETURNS[sptype: TYPESymbol, sptypeloc: LOCSymbol, spproc: PROCSymbol];

-- sptype may be NIL
  LookForInstSource: PUBLIC PROC[formal, type: LONG STRING, 
	symbolseq: SymbolSeq, spmodel: MODELSymbol, sptype: TYPESymbol] 
	RETURNS[spappl: APPLSymbol, spnewtype: TYPESymbol, spproc: PROCSymbol];
  LookForInstBcd: PUBLIC PROC[bcdFileName: LONG STRING, bcdVers: TimeStamp.Stamp, 
	symbolseq: SymbolSeq, spmodel: MODELSymbol, sptype: TYPESymbol] 
	RETURNS[spappl: APPLSymbol, spnewtype: TYPESymbol, spproc: PROCSymbol];

-- list operations

 -- predicates
  After: PROC[first, second: Symbol, sptoplist: LISTSymbol] RETURNS[BOOL];
  IsOnList: PROC[spnode: Symbol, splist: LISTSymbol] RETURNS[BOOL];

 -- traversal
  TraverseTree: PROC[sproot: Symbol, symbolseq: SymbolSeq,
	proc: PROC[Symbol, MODELSymbol] RETURNS[BOOL], 
	preorder: BOOL←TRUE, followscopingrules: BOOL←FALSE];
  TraverseList: PROC[sp: LISTSymbol, proc: PROC[Symbol]];
  TraverseAndRemove: PROC[oldlist: LISTSymbol,
	proc: PROC[sp: Symbol] RETURNS[remove: BOOL]]
	RETURNS[newlist: LISTSymbol];

 -- addition
  AddToEndOfList: PROC[oldlist: LISTSymbol, spadd: Symbol,
	listtype: ListType, symbolseq: SymbolSeq] 
	RETURNS[newlist: LISTSymbol];
  MergeIntoList: PROC[slist, sadd: Symbol, symbolseq: SymbolSeq, 
	listtype: ListType] RETURNS[Symbol];
  SpliceBefore: PROC[symbolseq: SymbolSeq, spmove: Symbol, spstay: LISTSymbol,
	oldlist: LISTSymbol] RETURNS[newlist: LISTSymbol];
 
 -- deletion
  RemoveFromList: PROC[spremove: Symbol, oldlist: LISTSymbol] 
	RETURNS[spparent: LISTSymbol, newlist: LISTSymbol];
 
 -- startup and cleanup
  ZeroOut: PROC[sp: Symbol];
  CheckNotNil: PROC[p: LONG POINTER];
  AllocateSymbolSeq: PROC[nsym: CARDINAL] RETURNS[SymbolSeq];
  FreeSymbolSeq: PROC[psymbolseq: LONG POINTER TO SymbolSeq];
  FreeStringsOf: PROC[sp: Symbol];


-- symbol table management
  NewSymLOC:    PROC[symbolseq: SymbolSeq] RETURNS[LOCSymbol];
  NewSymLIST:   PROC[symbolseq: SymbolSeq] RETURNS[LISTSymbol];
  NewSymLET:    PROC[symbolseq: SymbolSeq] RETURNS[LETSymbol];
  NewSymOPEN:   PROC[symbolseq: SymbolSeq] RETURNS[OPENSymbol];
  NewSymMODEL:  PROC[symbolseq: SymbolSeq] RETURNS[MODELSymbol];
  NewSymTYPE:   PROC[symbolseq: SymbolSeq] RETURNS[TYPESymbol];
  NewSymPROC:   PROC[symbolseq: SymbolSeq] RETURNS[PROCSymbol];
  NewSymSTRING: PROC[symbolseq: SymbolSeq] RETURNS[STRINGSymbol];
  NewSymAPPL:   PROC[symbolseq: SymbolSeq] RETURNS[APPLSymbol];

  GenerateUniqueName: PUBLIC PROC[spappl: APPLSymbol] 
	RETURNS[sym: LONG STRING];

-- parsing of compiler switches
  FoldInParms: PROC[parms: LONG STRING] 
	RETURNS[switches: CompilerOps.LetterSwitches, explicitSortSwitch: BOOL];
  ValidateModel: PROC[symbolseq: SymbolSeq];

-- returns the value of a TYPE, returns NIL if no value
  LocForType: PROC[sptype: TYPESymbol] RETURNS[sploc: LOCSymbol];

-- returns the value of a APPL, returns NIL if no value
  LocForAppl: PROC[spappl: APPLSymbol] RETURNS[sploc: LOCSymbol];

-- file information
  GetFileInfo: PROC[sploc: LOCSymbol] RETURNS[fi: Dir.FileInfo];
   -- takes a LOC, returns its fi if already calculated
   -- if not, will look on local disk for bcd and src files
   -- does not compute bcdvers or depseq's, which would require it to analyze the 
   -- contents of the source or bcd files
  GetBcdCreate: PROC[fi: Dir.FileInfo] RETURNS[bcdCreate: LONG CARDINAL];
  GetSrcCreate: PROC[fi: Dir.FileInfo] RETURNS[srcCreate: LONG CARDINAL];
  LookupFileInfo: PROC[bcdFileName: LONG STRING, bcdVers: TimeStamp.Stamp] 
	RETURNS[fi: Dir.FileInfo];
  EraseCacheEntry: PROC[fi: Dir.FileInfo, src: BOOL];

  ResetFileEntries: PROC[oldCapability: File.Capability, fi: Dir.FileInfo];
   -- will make sure that entries in the fileInfo data structure
   -- that mention the same file are reset to point to the version "fi" wants
   -- oldCapability is the old capability for the file

  StartMDSupport: PROC;	-- call whenever starting a new symbolseq
  StopMDSupport: PROC;	-- call to free data associated with symbolseq

-- variables (defined in MDSupportImpl)
  numberofbcdsmapped: VAR CARDINAL;	-- # of .Bcd files read in and mapped
  numberofsourcesparsed: VAR CARDINAL; -- # of .Mesa files read in and parsed
  traversetreecalled: VAR CARDINAL;	-- # times TraverseTree is called

-- PROGRAMs
  MDRulesImpl, MDSupportImpl, MDParseImpl: PROGRAM;

-- INLINES
  CkType: PROC[sp: Symbol, st: SubType] = INLINE {
    IF sp = NIL OR sp.stype ~= st THEN ERROR};

 -- warning!! this may return NIL
  LocForSp: PROC[sp: Symbol] RETURNS [LOCSymbol] = INLINE {
    spl: Symbol;
    IF sp = NIL THEN ERROR;
    WITH sp SELECT FROM
      spt: TYPESymbol => {
	spl ← spt.typeval;
	IF spl = NIL THEN spl ← spt.letparent.letval};
      spt: APPLSymbol => {
	spl ← spt.applval;
	IF spl = NIL THEN spl ← spt.letparent.letval};
      spt: LETSymbol => spl ← spt.letval;
      spt: LOCSymbol => spl ← spt;
      ENDCASE => ERROR;
    RETURN[NARROW[spl]]};

-- these are the various procedures to NARROW subtypes
  NarrowToLOC: PROC[sp: Symbol] RETURNS[LOCSymbol] = INLINE {
    RETURN[NARROW[sp, LOCSymbol]]};

  NarrowToLIST: PROC[sp: Symbol] RETURNS[LISTSymbol] = INLINE {
    RETURN[NARROW[sp, LISTSymbol]]};

  NarrowToLET: PROC[sp: Symbol] RETURNS[LETSymbol] = INLINE {
    RETURN[NARROW[sp, LETSymbol]]};

  NarrowToOPEN: PROC[sp: Symbol] RETURNS[OPENSymbol] = INLINE {
    RETURN[NARROW[sp, OPENSymbol]]};

  NarrowToMODEL: PROC[sp: Symbol] RETURNS[MODELSymbol] = INLINE {
    RETURN[NARROW[sp, MODELSymbol]]};

  NarrowToTYPE: PROC[sp: Symbol] RETURNS[TYPESymbol] = INLINE {
    RETURN[NARROW[sp, TYPESymbol]]};

  NarrowToPROC: PROC[sp: Symbol] RETURNS[PROCSymbol] = INLINE {
    RETURN[NARROW[sp, PROCSymbol]]};

  NarrowToSTRING: PROC[sp: Symbol] RETURNS[STRINGSymbol] = INLINE {
    RETURN[NARROW[sp, STRINGSymbol]]};

  NarrowToAPPL: PROC[sp: Symbol] RETURNS[APPLSymbol] = INLINE {
    RETURN[NARROW[sp, APPLSymbol]]};

  Sym: PROC[sp: Symbol] RETURNS[str: LONG STRING] = INLINE {
    RETURN[ WITH sp1~~sp SELECT FROM
	typeTYPE => sp1.typesym,
	typePROC => sp1.procsym,
	typeSTRING => sp1.strsym,
	typeAPPL => sp1.applsym,
	ENDCASE => ERROR]}	-- bad select - Sym

  }.