COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Editor:  Editor-command executor }
C00007 00003	procedure readProg external
C00011 00004	 procedure doAtCmd external
C00015 00005	procedure eDoECmd (var okp: boolean var oc: integer) external
C00020 ENDMK
C⊗;
{$NOMAIN	Editor:  Editor-command executor }

%include emain.hdr;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
function newNode: nodep;					external;
procedure relNode(n: nodep);					external;
function newStatement: statementp;				external;
procedure relStatement(n: statementp);				external;

	(* From FREE *)
procedure freeStatement(s: statementp);				external;
procedure freeNode(n: nodep);					external;

	(* From EAUX1A *)
procedure pushStmnt(s: statementp; indent: integer);		external;
procedure clearLine(i: integer);				external;

	(* From EAUX1C *)
function evalOrder(what,last: nodep; pcons: boolean): nodep;	external;

	(* From ETOKEN *)
procedure getToken;						external;

	(* From EAUX2C *)
procedure setECurInt;						external;
procedure displayLines(var pfrom: integer);			external;

	(* From EAUX2D *)
procedure readline;						external;

	(* From IINIT *)
procedure calibrate; external;

	(* From EPAR3B *)
procedure reFormatStmnt(st: statementp; indent,ocur: integer);	external;

	(* From EAUX3A *)
procedure setPPSize(arg: integer);				external;
procedure setUpStmnt(which: integer);				external;
procedure flushOldEnvironments(dLev: integer);			external;
procedure makeOuterBlock;					external;
procedure mark;							external;
procedure unmark(all: boolean);					external;
procedure saveOutermostEnv;					external;
procedure fileParse(var fname: c20str); 			external;
procedure writeProg;						external;
procedure getEcmd;						external;
function atStmnt: boolean;					external;
procedure doSetcmd;						external;

	(* From EAUX3B *)
procedure varDefine;						external;
procedure setBpt(st: statementp);				external;
procedure clrBpt(st: statementp);				external;
procedure clrAllBpts;						external;
procedure setTBpt(st: statementp);				external;
procedure stepStmnt(bpttype: integer);				external;
procedure trace(all: boolean);					external;

	(* From EAUX3C *)
function getBlkId: identp;					external;

	(* From EDEBUG *)
procedure runStmnt(which: integer);				external;
procedure executeStmnt(st: statementp; which: integer);		external;
procedure goStmnt(which: integer);				external;

	(* From EROOT *)
procedure em3AddStmnt(firstTime: boolean);			external;

	(* From PP *)
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 em3Get; external;
procedure em3Get; begin end;

procedure readProg; external;
procedure readProg;
 var i: integer; filename: c20str; b: boolean;
 begin
 fileParse(filename);
 if filename[1] = ' ' then
   begin pp20L('Need a name of file ',19); ppLine end
  else
   begin
   reset(file1,filename,'.AL',i);		(* see if file exists *)
   b := (i < 0);				(* does it? *)
   reset(file1);				(* that's all we needed it for *)
   if b then
     begin pp20L('File not found      ',15); ppLine end
    else
     begin
     freeStatement(dprog);			(* release old program *)
     flushOldEnvironments(0);
     makeOuterBlock;				(* & make new one *)
     curLine := 0;
     cursor := 0;
     pushStmnt(dprog,1);			(* set up cursor stack *)
     pushStmnt(dprog↑.pcode,0);
     curPage := 1;
     curFLine := 1;
     pushStmnt(dprog↑.pcode↑.bcode,0);		(* now push the block's END *)
     cursorLine := 2;
     i := ppSize;
     setPPSize(55);				(* use max pp size *)
     clearLine(4);
     fParse := true;
     filedepth := 1;
     errCount := 0;
     readLine;					(* get first line of program *)
     flushcomments := true;			(* don't want any comments yet *)
     getToken;					(* check for outer block *)
     with curToken do
      if (ttype = reswdtype) and (rtype = stmnttype) and 
         (stmnt = blocktype) then dprog↑.pcode↑.blkid := getBlkId
       else backup := true;
     em3AddStmnt(false);			(* read in new program *)
     fParse := false;
     filedepth := 0;
     if errcount = 0 then pp20L('No errors detected  ',18)
      else begin pp20L('Errors detected:    ',17); ppInt(errcount) end;
     ppLine;
     setUpStmnt(1);	(* Call setUpStmnt and tell it readProg called it *)
     setCursor := true;
     cursorLine := 2;
     lineNum := 1;
     topDline := 0;
     botDline := 0;
     displayLines(lineNum);			(* show first window *)
     setPPSize(i);
     end;
   reset(file1);				(* all done with file now *)
   end
 end;

 procedure doAtCmd; external;
 procedure doAtCmd;
  var np: nodep; b: boolean; s: statementp;
  begin
  b := false;
  with cursorStack[cursor] do		(* check pointing at AFFIX statement *)
   begin
   if stmntp then b := st↑.stype = affixtype;
   if b then
     begin
     np := newNode;
     with np↑ do
      begin
      ntype := exprnode;
      op := ttmulop;
      arg1 := st↑.frame1;
      arg2 := newNode;
      arg3 := nil;
      end;
     with np↑.arg2↑ do
      begin
      ntype := exprnode;
      op := tinvrtop;
      arg1 := st↑.frame2;
      arg2 := nil;
      arg3 := nil;
      end;
     s := newStatement;
     with s↑ do			(* make up a new assignment stmnt *)
      begin
      stype := evaltype;
      what := np;
      exprs := evalOrder(np,nil,true);	(* we want its current value *)
      next := s;			(* so dFreePdb doesn't flush us *)
      last := s;
(* Note we pass "3" as "which" so we return to this overlay *)
      executeStmnt(s,3);		(* aval will be set by INTERP *)
      relNode(np↑.arg2);
      relNode(np);
      np := aval;
      aval↑.t↑.refcnt := 1;		(* so it doesn't disappear *)
      end;
     relStatement(s);			(* done with it now *)
     with st↑ do
      begin
      if atexp <> nil then freeNode(atexp);	(* release any old AT expr *)
      atexp := np;
      with frame1↑ do
       if ntype = leafnode then np := nil
	else np := evalOrder(arg2,nil,true);	(* push array subscripts *)
      with frame2↑ do
       if ntype <> leafnode then np := evalOrder(arg2,np,true);
      if byvar <> nil then
      with byvar↑ do
       if ntype <> leafnode then np := evalOrder(arg2,np,true);
      exprs := evalOrder(atexp,np,true);
      end;
     reFormatStmnt(st,ind,cursorLine);		(* may have changed nlines *)
     end
    else
     begin pp20L('Must be pointing at ',20); pp20('an AFFIX statement  ',18);
	   ppLine end;
   end;
  end;

procedure eDoECmd (var okp: boolean; var oc: integer); external;
procedure eDoECmd ;
 begin
 with curToken do
	 case ed of
savecmd:    writeProg;		(* Write out program to file *)
getcmd:	    begin
	    readProg;		(* Read in new program from file *)
	    oc := 0;
	    end;
definecmd:  varDefine;		(* write Definitions for the specified vars *)
(* insertcmd,renamecmd... *)
setcmd:	    doSetcmd;		(* change appropriate system var *)
markcmd:    mark;
unmarkcmd:  begin
	    getEcmd;
	    if (ttype = reswdtype) and (rtype = filtype) and
	       (filler = alltype) then unmark(true) else unmark(false);
	    end;
		(* debugger commands follow *)
popcmd:	    begin
	    if debugLevel = 0 then
	      begin
	(* *** probably should ask if luser wants to zero or save	*** *)
	(* *** the variables in outermost environment.			*** *)
	(* *** if zeroing then 					 	*** *)
	(* ***   begin flushOldEnvironments(0); initOuterBlock end	*** *)
	(* ***  else							*** *)
	      saveOutermostEnv;
	      end
	     else flushOldEnvironments(debugLevel);	(* pop up a level *)
	    setECurInt;
	    end;
tracecmd:   begin
	    getEcmd;
	    if (ttype = reswdtype) and (rtype = filtype) and
	       (filler = alltype) then trace(true) else trace(false);
	    end;
breakcmd:   if atStmnt then setBpt(cursorStack[cursor].st);	(* ok to set it *)
unbreakcmd: begin
	    getEcmd;
	    if (ttype = reswdtype) and (rtype = filtype) and
	       (filler = alltype) then clrAllBpts
	     else
	      if atStmnt then clrBpt(cursorStack[cursor].st);  (* ok to clear it *)
	    end;
tbreakcmd:  begin
	    if atStmnt then			(* ok to set breakpoint? *)
	      begin
	      setTBpt(cursorStack[cursor].st);	(* put a temporary one there *)
	      runStmnt(3);			(* & proceed with program *)
	      end
	    end;
stepcmd:    begin stepStmnt(1); runStmnt(3); end;
sstepcmd:   begin stepStmnt(2); runStmnt(3); end;
nstepcmd:   begin stepStmnt(3); runStmnt(3); end;
gstepcmd:   begin stepStmnt(4); runStmnt(3); end;
proceedcmd: runStmnt(3);		(* Proceed with program *)
gocmd:	    if atStmnt then goStmnt(3);	(* Jump to current cursor location *)
executecmd: if atStmnt then executeStmnt(cursorStack[cursor].st,3);
	    (* Execute statement at current cursor location *)
startcmd:   begin
	    saveOutermostEnv;		(* reset Interpreter *)
	    runStmnt(3);		(* Start program from the top *)
	    end;
atcmd:	    doAtCmd;
calibratecmd:
	    calibrate;
otherwise   begin			(* ??? *)
	    pp20L(' unknown command    ',17); ppLine;
	    okp := false;
	    end;
	 end
 end;