COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Condition monitor parser }
C00005 00003	function cmonParse(st: statementp deferred: boolean): boolean external
C00013 ENDMK
C⊗;
{$NOMAIN	Condition monitor parser }

%include palhdr.pas;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
function newNode: nodep;					external;
procedure relNode(n: nodep);					external;
procedure relToken(n: tokenp);					external;

	(* From PROOT *)
procedure errprnt;						external;
function copyToken: tokenp;					external;
procedure getToken;						external;
procedure ppFlush;						external;
function cmStmntParse: statementp;				external;
function cmExprParse: nodep;					external;
function cmClauseParse(absSeen: boolean): nodep;		external;

	(* From PAUX1 *)
function makeNewVar(vartype: datatypes; vid: identp): varidefp;	external;
procedure appendEnd(s,so: statementp);				external;
function getDtype(n: nodep): datatypes;				external;

	(* From PAUX2 *)
procedure relExpr(n: nodep);					external;
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;
procedure checkdim(n,d: nodep);					external;

	(* Display-related Routines *)
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;
procedure ppInt(i: integer); 					external;
procedure ppReal(r: real); 					external;
procedure ppStrng(length: integer; s: strngp); 			external;

procedure pCmonGet; external;
procedure pCmonGet;	begin end;
function cmonParse(st: statementp; deferred: boolean): boolean; external;
function cmonParse;
 const fsstring = 'Force sensing       ';
 var b, oldInMove: boolean; i: integer; t: tokenp;
     oldCmon, oldErrHandler: statementp; v: varidefp;

 procedure notInMove;
  begin
  b := true;
  pp20L(' must be part of a M',20); pp20('OVE statement - will',20);
  pp20(' flush cmon.        ',12);
  errprnt;
  st↑.oncond := nil;
  end;

 begin						(* cmon statement *)
 b := false;
 oldCmon := curCmon;
 curCmon := st;
 oldErrHandler := curErrHandler;
 with st↑, curToken do
  begin
  deferCm := deferred;			(* remember if we are deferred or not *)
  exprCm := false;
  oncond := nil;
  getToken;				(* see what sort of cmon we have *)
  if (ttype = reswdtype) and (rtype = clsetype) then
    begin
    if (clause = durationtype) or (clause = forcetype) or (clause = torquetype) then
      begin
      backup := true;
      oncond := cmClauseParse(false);
      end
     else if (clause = arrivaltype) or (clause = departingtype) then
      begin
      if inMove then			(* only valid within a motion *)
	begin
	oncond := newNode;
	with oncond↑ do
	 if clause = departingtype then ntype := departingnode
	  else
	   begin
	   ntype := arrivalnode;
	   evar := makeNewVar(eventtype,nil);
	   end
	end
       else
	begin
	pp20L('Arrival/departing   ',17);
	notInMove;
	end;
      end
     else if clause = errortype then
      begin
      oncond := newNode;
      with oncond↑ do
       begin
       ntype := errornode;
       getToken;			(* skip over the "=" *)
       eexpr := cmExprParse;		(* get desired error bits *)
       checkdim(eexpr,nodim↑.dim);
       end;
      if inMove then curErrHandler := st
       else
	begin				(* no good *)
	relExpr(oncond↑.eexpr);
	relNode(oncond);
	pp20L('Error handler       ',13);
	notInMove;
	end;
      end
     else
      begin
      b := true;			(* no good *)
      backup := true;
      pp20L('Unknown ON condition',20); pp10(' test.    ',6); ppFlush;
      errprnt;
      relExpr(cmClauseParse(false));		(* try to parse it anyway *)
      end
    end
   else if (ttype = reswdtype) and (rtype = optype) and (op = absop) then
    begin				(* is it |Force...| or |Torque...|? *)
    getToken;					(* see what next token is *)
    backup := true;
    if (ttype = reswdtype) and (rtype = clsetype) and
       ((clause = forcetype) or (clause = torquetype)) then
      oncond := cmClauseParse(true)		(* yes - |Force/Torque...| cmon *)
     else
      begin					(* no - expression cmon *)
      exprCm := true;
      t := copyToken;		(* make a copy of token we just peeked at *)
      next := t;		(* fix things up so the peeked at token is next *)
      ttype := reswdtype;	(* and the "|" gets seen again by cmExprParse *)
      rtype := optype;
      op := absop;
      if macrodepth = 0 then	(* pretend we're a macro *)
	begin
	macrodepth := 1;
	curmacstack[macrodepth] := nil;
	macrostack[macrodepth] := nil;
	end;
      oncond := cmExprParse;	(* get expression for cmon *)
      relToken(t);		(* done with peeked at token now *)
      end
    end
   else
    begin
    backup := true;
    oncond := cmExprParse;		(* get the cmon condition *)
    if getdtype(oncond) <> eventtype then exprCm := true;
    end;
  if oncond <> nil then
   with oncond↑ do
    if (ntype = forcenode) and not inMove then
      begin
      relExpr(oncond);
      pp20L('Force sensing       ',13);
      notInMove;
      end
     else if exprCm or (ntype = durnode) or (ntype = forcenode) then
      exprs := evalOrder(oncond,nil,true)
     else if ntype = exprnode then	(* subscripted event *)
      exprs := evalOrder(arg2,nil,true)
     else exprs := nil;
  getToken;					(* look for the "do" *)
  if (ttype <> reswdtype) or (rtype <> filtype) or (filler <> dotype) then
    begin
    b := true;			(* no good *)
    pp20L('Expecting a "DO" her',20); pp5('e.   ',2); ppFlush;
    errprnt;
    relExpr(oncond);
    end
   else
    begin
    oldInMove := inMove;
    InMove := false;
    conclusion := cmStmntParse;		(* get the body of the cmon *)
    appendEnd(st,conclusion);
    InMove := oldInMove;
    end;
  end;

 v := makeNewVar(cmontype,nil);
 v↑.s := st;
 st↑.cdef := v;
(* *** check if cmon has a label & if so mark label as labelling a cmon *** *)
 curCmon := oldCmon;
 curErrHandler := oldErrHandler;
 cmonParse := b;
 end;