Program StickyEditor;
(*$S-*)
(*$C+*)
Label  999;                    (* Jump to 999 to end program *)
Const  blocksize = 2000;       (* Size of array blocks which contain the text *)
       buffersize = 500;       (* NOT to exceed one page size on the VAX/VMS 2.0 *)
       ESC = %X1B;
       CR = %X0D;
       LF = %X0A;
       FF = %X0C;
       BS = %X08;              (* Ordinal values for non-printable characters *)
       DEL = %X7F;
       BEL = %X07;
       NUL = %X00;
       TB = %X09;
       SO = %X0E;
       EOL = %X0D;             (* Character to mark eoln in text arrays *)
       nulls = 20;             (* Number of nulls written to screen for BANTOM terms *)
       maxnamesize = 10;       (* Maximum length of an identifier *)
       maxinteger = 2147483647;(* Maximum integer for 32 bit system *)
       tablesize = 52;         (* Hash table size *)
       rms$_fnf = %X18292;     (* VAX dependent constants used in opening files *)
       rms$_normal = %X10001;



Type  (* ------------- Used in balanced tree structure --------------------- *)
       ptr = ^node;
       sticky = ^stickypointer;
       objectptr = ^object;
       node = record           (* Basic element of balanced tree structure *)
                length,disp : integer;       (* getfile depends on placement *)
                text : ^newtext;             (* of length and text in this *)
                color : (black,red);         (* record*)
                parent,left,right : ptr;
              end;
       stickypointer = record  (* Pointer into tree structure and text *)
                         disp : integer;
                         seg : ptr;
                       end;
       object = record         (* Pointers which delimit strings of text *)
                  first,last : stickypointer;
                end;
(* ---------------- Used in available space lists -------------------------- *)
       textlistptr = ^textlist;
       textptr = ^newtext;
       textlist = record
                    next : textlistptr;
                    location : textptr;
                  end;
       newtext = packed array[1..blocksize] of char; (*Array blocks which contain the text*)
(* ------------------ Used in parse tree structure ------------------------- *)
       alfaptr = ^alfa;
       alfa = packed array[1..maxnamesize] of char;
             (* Symbols returned by lexical analyser (GETSYM) *)
       Symbols = (IntegerSym,CharacterSym,BooleanSym,StackSym,PtrSym,StringSym,
                 CaseSym,IfSym,EndSym,LoopSym,WhenSym,DoSym,ExitSym,Colon,
                 Semicolon,Bar,Comma,PlusSym,MinusSym,EmptySym,OrdSym,CharSym,
                 Getchsym,NotSym,RightParen,LeftParen,Quote,IsSym,LessThan,
                 LessOrEqual,Equal,NotEqual,GtrOrEqual,GtrThan,IntSym,ChSym,
                 IdentSym,TrueSym,FalseSym,AndSym,OrSym,FirstSym,LastSym,
                 NamePtr,NameString,NameInt,NameCh,NameBool,MoveC,Move,DelName,
                 CreateStack,Push,Pop,Top,AddMacros,Delete,UnDelete,Copy,
                 Search,Change,Replace,ListNames,ListFiles,Run,Edit,Return,
                 Visit,InputFile,Save,ExitSave,Quit,EndOfString);    
       Actions = NamePtr..Quit;                (* Symbols which represent actions *)
       IntOps = PlusSym..MinusSym;             (* Symbols which contain the operators on integers *)
       BoolOps = LessThan..GtrThan;            (* Symbols which represent boolean operators *)
       VariableTypes = IntegerSym..StringSym;  (* Symbols which define possible variable types *)
       LogicOps = AndSym..OrSym;               (* Symbols which represent operators on booleans *)
              (* Non-terminals used in parse tree *)
       NonTerminals = (StmtNT,TestNT,CaseNT,LoopNT,ExitNT,OrdNT,IsNT,CharNT,
                      GetNT,EmptyNT,IntExpNT,CharExpNT,PtrNT,StringNT,ActionNT,
                      IdentNT,CharStringNT,IntOpNT,BoolOpNT,TypeNT,BoolNT,
                      LogicOpNT,IntNT,ChNT,NotNT,FirstNT,LastNT);
       NextItem = ^Item;
              (* Basic element in the parse tree *)
       Item = Record
               Son,Brother : NextItem;
               Case Nonterm : Nonterminals of
                 StmtNT,TestNT,CaseNT,LoopNT,ExitNT,OrdNT,IsNT,NotNT,EmptyNT,
                 CharNT,GetNT,IntExpNT,CharExpNT,PtrNT,StringNT : ();
                 ActionNT : (Action : Actions);
                 IdentNT, FirstNT, LastNT : (Filename,Name : Alfa);
                 CharStringNT : (Location : Object);
                 IntOpNT : (IntOp : IntOps);
                 BoolOpNT : (BoolOp : BoolOps);
                 TypeNT : (Tipe : VariableTypes);
                 BoolNT : (BoolValue : Boolean);
                 LogicOpNT : (LogicOp : LogicOps);
                 IntNT : (IntValue : Integer);
                 ChNT : (ChValue : Char);
             End;
      SymbolSet = set of Symbols;
                     (* Possible variable types *)
      Types = (IntType,CharType,BoolType,PtrType,StringType,StackType,Reserved);
(* ----------- Used in alphabetical list of variable names ----------------- *)
       nextname = ^namelist;
             (* Element in alphabetical list of variable names *)
       namelist = record
                    next : nextname;
                    name : alfa;
                    tipe : types;
                  end;
(* -------------------- Element of the hash table -------------------------- *)
      Entry = ^TableEntry;
      TableEntry = Record
                     Name : Alfa;
                     Next : Entry;
                     Case Tipe : Types of
                       IntType : (IntValue : Integer);
                       CharType : (CharValue : Char);
                       BoolType : (BoolValue : Boolean);
                       PtrType : (Location : Sticky);
                       StringType : (First,Last : Sticky);
                       StackType : (Top : Entry);
                       Reserved : (SymbolValue : Symbols);
                   end;
(* ----------------- Used to deal with text files -------------------------- *)
       filename = packed array[1..64] of char;
       nextfile = ^fileheader;
       fileheader = record
                      name : alfa;             (* File name used to access this file by user *)
                      spec : filename;         (* Full name of file according to computer *)
                      speclength : integer;    (* Length of file specification in characters *)
                      maintext : boolean;      (* Whether a maintext exists or just a pointer file *)
                      ptrspec : filename;      (* Full name of pointer file *)
                      ptrspeclength : integer; (* Length of pointer file specification *)
                      belong : boolean;        (* Does pointer file belong to the text file? *)
                      table : array [0..tablesize] of entry;    (* Hash table for this file *)
                      namelist : nextname;     (* Alphabetical list of user variable names *)
                      next : nextfile;         (* Pointer to next file in link list of files *)
                   end;
(* ------------------------------------------------------------------------- *)
       bufferarray = packed array[1..buffersize] of char;  (* Output buffers *)
       states = (garbagecollect,savefile,finished);  (* Possible actions when COMPACT is called *)



Var (* ---------------- Variable used for inputing files ------------------- *)
       currentfile : nextfile; (* File currently being edited *)
       firstblock : boolean;   (* Used to flag first call to NEWBLOCK when reading new textfile *)
(* -------------------- Available space pointers --------------------------- *)
       nodeavail : ptr;            (* For nodes *)
       entryavail : entry;         (* For hash table entries *)
       itemavail : nextitem;       (* For elements of the parse tree *)
       textavail : textlistptr;    (* For array blocks *)
       nameavail : nextname;       (* For names in the alphabetic list of names *)
       maintext : textlistptr;     (* Pointer to the array blocks currently in use *)
(* ------------------ Variables for manipulating the screen ---------------- *)
          (* Characters used in control sequences to manage terminal screens *)
       up,down,left,right,home,ftnchar,clearline,clearpage : char;
       screensize : integer;      (* Size of the terminal screen vertically *)
       screenwidth : integer;     (* Size of the terminal screen horizontally *)
       falsescreensize : integer; (* Amount of the screen to be used for command mode *)
       terminal : (fox,hp,bantom,vt,zenith,ddt,tec);   (* Types of terminals *)
       edge : integer;            (* Contains the number of characters the screen is shifted *)
            (* Variables to mark the cursor position relative to the window pointer *)
       cursor,tempcursor : record
                             lines : integer;    (* Number of lines from line window is on *)
                             chars : integer;    (* Number of chars from left edge of screen *)
                             actual : integer;   (* Number of chars from left edge of text *)
                           end;
            (* Contains info to return from command mode to cursor mode *)
       oldtext : record
                   lines,chars,edge : integer;
                   window,cursor : stickypointer;
                   btext,etext : sticky;
                 end;
       buffer : bufferarray;     (* Main output buffer for screen *)
       bufferindex : integer;    (* Index for output buffer *)
       restofline : bufferarray; (* Output buffer in insert mode to hold rest of current line *)
       linelength : integer;     (* Current length of text in RESTOFLINE buffer *)
(* ----------------------- Variables used in command mode ------------------ *)
       lastcom : entry;          (* Last command to be entered in command mode *)
       lastcommand : object;     (* Contains string that was last entered in command mode *)
       oldsearch : objectptr;    (* Delimits last string searched for *)
       lastdel : object;         (* Delimits last string to be deleted *)
       quitediting : boolean;    (* When set to TRUE, specifies that editing session is done *)
       adjustcursor : boolean;   (* Set TRUE whenever cursor may have been moved in command mode *)
       insertdelete : boolean;   (* Set TRUE whenever an insert or delete is done in command mode *)
       refill : boolean;         (* Set FALSE to flag that "false screen" must not be rewritten *)
       editing : boolean;        (* Set TRUE when not editing main text *)
       changefile : boolean;     (* Set TRUE when main file is changed *)
(* ----------------------- Special variable that user sets ----------------- *)
          (* Pointers set up when the keys 0 - 9 are pressed in cursor mode *)
       m0,m1,m2,m3,m4,m5,m6,m7,m8,m9 : entry;
       slash : stickypointer;      (* Pointer set up when '/' is pressed *)
       tab : entry;                (* Contains seperation of tab stops in number of characters *)
       indent : entry;             (* Boolean value specifying whether to indent in insert mode *)
       o : object;                 (* Delimits the string defined when '/' and 'm' are used *)
(* ----------------------- Special predefined pointers --------------------- *)
       curse : entry;       (* Pointer to cursor location in text *)
       btext : entry;       (* Pointer to beginning of text currently being edited *)
       etext : entry;       (* Pointer to end of text currently being edited *)
       window : entry;      (* Pointer to upper left corner of screen in text *)
(* ----------------------- Various other important variables --------------- *)
       command : char;      (* Contains character which represents the current command *)
       avail : record       (* Pointer to next available location for text in an array block *)
                  arry : ^newtext;
                  loc : integer;
               end;
       newobject,endobject : ptr;  (* Pointers used when creating new text with STARTTEXT *)
       emptyname : alfa;    (* The name which consists of all blank characters *)
(* ----------------------- Temporary Variables ----------------------------- *)
       endwindow,temp,tempbtext,tempetext,t1,t2 : stickypointer;
       l,c,lines,chars,endlocation : integer;
       ch : char;
       tempbool : boolean;
       obj,textstring,markedstring : object;
       wantall : packed array[1..48] of char;





           (* External macros to handle screen I/O *)
Procedure Init;  extern;
Procedure Writebuf(Var b : bufferarray; i : integer);  extern;
Procedure Readch(Var b : char);  extern;


Procedure Error(i : integer);
(* Dummy procedure for marking potential user errors *)
Begin
  (* writeln('ERROR ',i:3); *)
End;


Procedure NewNode(Var p : ptr);
(* Returns a pointer to a free node, either from the available space list or
   from the heap if the list is empty *)
Begin
  if nodeavail = nil      (* List is empty *)
    then begin
      new(p);
      p^.text:=nil;
      p^.disp:=0;
      p^.length:=0;
      p^.right:=nil;
      p^.left:=nil;
      p^.parent:=nil;
    end
    else begin            (* Take node from list *)
      p:=nodeavail;
      nodeavail:=nodeavail^.right;
      p^.text:=nil;
      p^.length:=0;
      p^.disp:=0;
      p^.right:=nil;
      p^.left:=nil;  
      p^.parent:=nil;
    end;
End;


Procedure NodeDispose(Var p : ptr);
(* Puts a node on the available space list of nodes *)
Begin
  p^.right:=nodeavail;
  nodeavail:=p;
End;


Procedure NewEntry(Var e : entry);
(* Returns a pointer to a free hash table element, either from the available
   space list or from the heap if the list is empty *)
Begin
  if entryavail = nil      (* List is empty *)
    then begin
      new(e);
      e^.next:=nil;
      e^.intvalue:=0;
      e^.last:=nil;
    end
    else begin            (* Take node from list *)
      e:=entryavail;
      entryavail:=entryavail^.next;
      e^.next:=nil;
      e^.intvalue:=0;
      e^.last:=nil;
    end;
End;


Procedure EntryDispose(Var e : entry);
(* Puts a hash table element on the available space list of hash table elements *)
Begin
  e^.next:=entryavail;
  entryavail:=e;
End;


Procedure NewItem(Var i : nextitem);
(* Returns a pointer to a free element of the parse tree, either from the
   available space list or from the heap if the list is empty *)
Begin
  if itemavail = nil      (* List is empty *)
    then begin
      new(i);
      i^.brother:=nil;
      i^.son:=nil;
      i^.intvalue:=0;
    end
    else begin            (* Take node from list *)
      i:=itemavail;
      itemavail:=itemavail^.brother;
      i^.brother:=nil;
      i^.son:=nil;
      i^.intvalue:=0;
    end;
End;


Procedure ItemDispose(Var i : nextitem);
(* Puts a parse tree element on the available space list of parse tree elements *)
Begin
  i^.brother:=itemavail;
  itemavail:=i;
End;


Procedure MoreText(Var t : textptr);
Var   tlist : textlistptr;
(* Returns a pointer to a free text array block, either from the available
   space list or from the heap if the list is empty *)
Begin
  if textavail = nil      (* List is empty *)
    then begin
      new(tlist);
      new(tlist^.location);
      t:=tlist^.location;
      tlist^.next:=maintext;
      maintext:=tlist;
    end
    else begin            (* Take node from list *)
      t:=textavail^.location;
      tlist:=textavail^.next;
      textavail^.next:=maintext;
      maintext:=textavail;
      textavail:=tlist;
    end;
End;


Procedure TextDispose(Var t : textptr);
(* Puts a text array block on the available space list of text array blocks *)
Var  tlist,tt : textlistptr;
Begin
  tlist:=maintext;
  while tlist^.location <> t do
    tlist:=tlist^.next;
  if tlist = maintext
    then maintext:=maintext^.next
    else begin
      tt:=maintext;
      while tt^.next <> tlist do
        tt:=tt^.next;
      tt^.next:=tlist^.next;
    end;
  tlist^.next:=textavail;
  textavail:=tlist;
End;


Procedure NewName(Var n : nextname);
(* Returns a pointer to a free element of the alphabetical list of names,
   either from the available space list or from the heap if the list is empty *)
Begin
  if nameavail = nil      (* List is empty *)
    then begin
      new(n);
      n^.next:=nil;
    end
    else begin            (* Take node from list *)
      n:=nameavail;
      nameavail:=n^.next;
      n^.next:=nil;
    end;
End;


Procedure NameDispose(Var n : nextname);
(* Puts a name element on the available space list of name elements *)
Begin
  n^.next:=nameavail;
  nameavail:=n;
End;


Function Hash(name : alfa) : integer;
(* This function takes a user defined variable name and hashes it to a 
   subscript in the hash table *)
Var  i,j : integer;
Begin
  i:=ord(name[1])*256 + ord(name[2]);
  j:=10;
  while (name[j] = ' ') and (j > 2) do
    j:=j - 1;
  i:=i*65536 + ord(name[j])*256 + ord(name[j-1]);
  hash:=i mod (tablesize + 1);
End;



Function FindFile(nameoffile : alfa) : nextfile;
Var   temp : nextfile;
Begin
  if (currentfile^.name = nameoffile) or (nameoffile = emptyname)
    then findfile:=currentfile
    else begin
      temp:=currentfile^.next;
      while (temp^.name <> nameoffile) and (temp <> currentfile) do
        temp:=temp^.next;
      if temp^.name = nameoffile
        then findfile:=temp
        else findfile:=nil;
    end;
End;



Function Lookup(name,nameoffile : alfa) : entry;
(* Lookup searches for a variable name in the hash table and returns a pointer
   to it.  If the name is not in the hash table, NIL is returned. *)
Var  s : entry;
     tempfile : nextfile;
Begin
  tempfile:=findfile(nameoffile);
  if tempfile <> nil
    then begin
      s:=tempfile^.table[hash(name)];
      if s <> nil
        then begin
          while (s^.name <> name) and (s^.next <> nil) do
            s:=s^.next;
          if s^.name = name
            then lookup:=s
            else lookup:=nil
        end
        else lookup:=nil;
    end
    else lookup:=nil;
End;


Procedure EnterName(Var n : entry; header : nextfile);
(* EnterName puts a user defined variable into the hash table *)
Var  s : entry;
     i : integer;
     elem,elem1 : entry;


Procedure AddToList;
(* This procedure puts a name in an alphabetical list of names.  This list of
   names is used to print out the user defined variable names when a user 
   executes the LISTNAMES command in command mode. *)
Var  temp,trail,ptr : nextname;
Begin
  newname(ptr);
  ptr^.name:=n^.name;
  ptr^.tipe:=n^.tipe;
  if header^.namelist = nil
    then header^.namelist:=ptr
    else begin
      temp:=header^.namelist;
      trail:=nil;
      while (temp^.name < ptr^.name) and (temp^.next <> nil) do
        begin
          trail:=temp;
          temp:=temp^.next;
        end;
      if temp^.name < ptr^.name
        then temp^.next:=ptr
        else if trail = nil
          then begin
            ptr^.next:=header^.namelist;
            header^.namelist:=ptr;
          end
          else begin
            ptr^.next:=temp;
            trail^.next:=ptr;
          end;
     end;
End;

      
Begin      (* EnterName *)
  i:=hash(n^.name);
  s:=header^.table[i];
  if s <> nil
    then begin
      while (s^.name <> n^.name) and (s^.next <> nil) do
        s:=s^.next;
      if s^.name = n^.name
        then begin
          if (s^.tipe <> stringtype) and (n^.tipe = stringtype)
            then new(s^.last)
            else if s^.tipe = stacktype
              then begin
                elem:=s^.top;
                while elem <> nil do
                  begin
                    elem1:=elem;
                    elem:=elem^.next;
                    entrydispose(elem1);
                  end;
              end;
          s^.tipe:=n^.tipe;
          if n^.tipe = stringtype
            then begin
              s^.first^:=n^.first^;
              s^.last^:=n^.last^;
            end
            else s^.intvalue:=n^.intvalue;
          entrydispose(n);
        end
        else begin
          s^.next:=n;
          if n^.tipe <> reserved
            then addtolist;
        end;
    end
    else begin
      header^.table[i]:=n;
      if n^.tipe <> reserved
        then addtolist;
    end;
End;


Procedure RemoveName(name : alfa; nameoffile : alfa);
(* This procedure removes a user defined variable from the hash table *)
Var  s,t : entry;
     i : integer;
     tempfile : nextfile;
     elem,elem1 : entry;

Procedure TakeFromList;
(* TakeFromList removes a name from the alphabetical list of names *)
Var  temp,trail : nextname;
Begin
  trail:=nil;
  temp:=tempfile^.namelist;
  while temp^.name <> name do
    begin
      trail:=temp;
      temp:=temp^.next;
    end;
  if trail = nil
    then tempfile^.namelist:=temp^.next
    else trail^.next:=temp^.next;
  namedispose(temp);
End;


Begin      (* RemoveName *)
  tempfile:=findfile(nameoffile);
  i:=hash(name);
  s:=tempfile^.table[i];
  t:=nil;
  if s <> nil 
    then begin
      while (s^.name <> name) and (s^.next <> nil) do
        begin
          t:=s;
          s:=s^.next;
        end;
      if s^.name = name
        then begin
          takefromlist;
          if s^.tipe = stacktype
            then begin
              elem:=s^.top;
              while elem <> nil do
                begin
                  elem1:=elem;
                  elem:=elem^.next;
                  entrydispose(elem1);
                end;
            end;
          if t <> nil
            then begin
              t^.next:=s^.next;
              entrydispose(s);
            end
            else begin
              tempfile^.table[i]:=s^.next;
              entrydispose(s);
            end;
        end;
    end;
End;


Procedure Balance(x : ptr);
(* Balance is the procedure which keeps the data structure tree balanced.
   The variable X must have at least one son whose color is red and X itself
   must be red before this procedure is called, because it is only in this 
   case that the tree needs to be balanced at X. *)
Var  s,p,pp : ptr;
     temp : integer;
Begin
  p:=x^.parent;
  if p = nil
    then x^.color:=black
    else begin
      pp:=p^.parent;
      if (p^.left^.color = red) and (p^.right^.color = red)
        then begin
          p^.left^.color:=black;
          p^.right^.color:=black;
          p^.color:=red;
          if pp <> nil
            then if pp^.color = red then balance(pp);
        end
        else if (x^.left^.color = red) and (x^.right^.color = red)
          then begin
            temp:=p^.length;
            if p^.left = x
              then begin
                p^.disp:=p^.disp - x^.length + x^.right^.length;
                p^.length:=p^.length + x^.right^.length - x^.length;
                x^.left^.color:=black;
                x^.right^.parent:=p;
                p^.left:=x^.right;
                x^.right:=p;
              end
              else begin
                x^.disp:=x^.disp + p^.length - p^.right^.length;
                p^.length:=p^.length + x^.left^.length - x^.length;
                x^.right^.color:=black;
                x^.left^.parent:=p;
                p^.right:=x^.left;
                x^.left:=p;
              end;
            x^.length:=temp;
            p^.parent:=x;
            x^.parent:=pp;
            if pp <> nil
              then begin
                if pp^.right = p
                  then pp^.right:=x
                  else pp^.left:=x;
                if pp^.color = red
                  then balance(pp);
              end;
          end
          else if ((p^.left^.color = red) and (x^.left^.color = red) or
                  (p^.right^.color = red) and (x^.right^.color = red))
            then begin
              temp:=p^.length;
              if p^.right = x
                then begin
                  x^.disp:=x^.disp + p^.length - p^.right^.length;
                  p^.length:=p^.length + x^.left^.length - x^.length;
                  x^.left^.parent:=p;
                  p^.right:=x^.left;
                  x^.left:=p;
                end
                else begin
                  p^.disp:=p^.disp - x^.length + x^.right^.length;
                  p^.length:=p^.length + x^.right^.length - x^.length;
                  x^.right^.parent:=p;
                  p^.left:=x^.right;
                  x^.right:=p;
                end;
              x^.length:=temp;
              x^.color:=black;
              x^.parent:=pp;
              p^.parent:=x;
              p^.color:=red;
              if pp <> nil
                then if pp^.left = p
                  then pp^.left:=x
                  else pp^.right:=x;
            end
            else begin
              temp:=p^.length;
              if x^.left^.color = red
                then begin
                  s:=x^.left;
                  x^.disp:=x^.disp - s^.length + s^.right^.length;
                  s^.disp:=s^.disp + p^.length - x^.length;
                  p^.length:=s^.left^.length + p^.length - x^.length;
                  x^.length:=x^.length + s^.right^.length - s^.length;
                  s^.left^.parent:=p;
                  s^.right^.parent:=x;
                  p^.right:=s^.left;
                  x^.left:=s^.right;
                  s^.left:=p;
                  s^.right:=x;
                end
                else begin
                  s:=x^.right;
                  p^.disp:=p^.disp - x^.length + s^.right^.length;
                  s^.disp:=s^.disp + x^.length - s^.length;
                  p^.length:=p^.length + s^.right^.length - x^.length;
                  x^.length:=x^.length + s^.left^.length - s^.length;
                  s^.left^.parent:=x;
                  s^.right^.parent:=p;
                  p^.left:=s^.right;
                  x^.right:=s^.left;
                  s^.right:=p;
                  s^.left:=x;
                end;
              s^.length:=temp;
              s^.parent:=pp;
              if pp <> nil
                then if pp^.right = p
                  then pp^.right:=s
                  else pp^.left:=s;
              s^.color:=black;
              x^.parent:=s;
              p^.parent:=s;
              p^.color:=red;
              x^.color:=red;
            end;
    end;
End;


Procedure Find(Var s : stickypointer);  forward;



Procedure MoveForward(Var s : stickypointer; Var failure : boolean);
(* Moves the pointer S one character forward in the text it is in.  If there
   are no characters forward of S then S is not changed and failure is set to 
   true, otherwise S is moved forward and failure is set to false *)
Var   temp : ptr;
Begin
  if s.seg^.text = nil
    then find(s);
  failure:=false;
  s.disp:=s.disp + 1;
  if s.seg^.length <= s.disp
    then begin
      temp:=s.seg;
      while (s.seg^.right <> nil) and (s.disp >= s.seg^.length) do
        begin
          s.seg:=s.seg^.right;
          s.disp:=0;
        end;
      if s.disp >= s.seg^.length
        then begin
          s.seg:=temp;
          failure:=true;
          s.disp:=s.seg^.length - 1;
        end;
    end;
End;



Procedure MoveBackward(Var s : stickypointer; Var failure : boolean);
(* Moves the pointer S one character backward in the text it is in.  If there
   are no characters backward of S then S is not changed and failure is set to 
   true, otherwise S is moved backward and failure is set to false *)
Var   temp : ptr;
Begin
  if s.seg^.text = nil
    then find(s);
  failure:=false;
  if s.disp > 0
    then s.disp:=s.disp - 1
    else begin
      s.disp:=s.seg^.length;
      temp:=s.seg;
      while (s.seg^.left <> nil) and (s.seg^.length <= s.disp) do
        begin
          s.disp:=0;
          s.seg:=s.seg^.left;
        end;
      if s.seg^.length <= s.disp
        then begin
          s.seg:=temp;
          s.disp:=0;
          failure:=true;
        end
        else s.disp:=s.seg^.length - 1;
    end;
End;



Procedure Find(*Var s : stickypointer*);
(* Pushes the pointer S which is up in the balanced tree structure to the base
   of the tree.  A pointer must be ot the base of the tree if it is to have
   direct access to text arrays. *)
Var   p,q : ptr;
      d : integer;
      edge : boolean;
Begin
  if s.seg^.text = nil
    then begin
      p:=s.seg;
      d:=s.disp + p^.disp;
      while (d < 0) or (d > p^.length) do   (* Move up the tree *)
        begin
          q:=p^.parent;
          if p = q^.right
            then d:=d + q^.length - p^.length;
          p:=q;
        end;
      while p^.text = nil do   (* Move down the tree *)
        if d < p^.left^.length
          then p:=p^.left
          else begin
            p:=p^.right;
            d:=d - p^.parent^.length + p^.length;
          end;
      if d < 0       (* Make sure that pointer is not pointing at deleted text *)
        then begin
          ERROR(5);
          s.disp:=0;
        end
        else s.disp:=d;
      s.seg:=p;
      if p^.length = 0
        then moveforward(s,edge);
    end;
End;



Function Greater(Var first,second : stickypointer) : boolean;
(* Returns the value of true if the ponter FIRST is to the left of pointer
   SECOND, otherwise it returns false.  If the two pointers are not in the
   same text false will be returned. *)
Var   correct,wrong : ptr;
Begin
  find(first);
  find(second);
  if first.seg = second.seg      (* The two pointers point to same node *)
    then if first.disp <= second.disp
      then greater:=true
      else greater:=false
    else begin
         (* Move along base nodes until the value of GREATER can be determined *)
      correct:=first.seg^.right;
      wrong:=first.seg^.left;
      while (correct <> second.seg) and (wrong <> second.seg) and
                                        (correct <> nil) do
        begin
          if wrong <> nil
            then wrong:=wrong^.left;
          correct:=correct^.right;
        end;
      if correct = second.seg
        then greater:=true
        else greater:=false;
    end;
End;




Function Getch(var s : stickypointer) : char;
(* Returns character pointed to by S *)
Begin
  if s.seg^.text = nil
    then find(s);
  getch:=s.seg^.text^[s.disp + s.seg^.disp];
End;


(* The next four procedures should always be used together when new text is to 
   be created *)

Procedure Starttext;
(* Initializes all the variables to be used in creating text *)
Begin
  newnode(newobject);
  newobject^.parent:=nil;
  newobject^.right:=nil;
  newobject^.left:=nil;
  if avail.loc > blocksize
    then begin
      moretext(avail.arry);
      avail.loc:=1;
    end;
  newobject^.disp:=avail.loc;
  newobject^.text:=avail.arry;
  newobject^.length:=0;
  newobject^.color:=red;
  endobject:=newobject;
End;




Procedure Addchar(ch : char);
(* Adds the character CH to the text being created *)
Var   p : ptr;
Begin
  if avail.loc > blocksize
    then begin        (* Allocate a new array block if the current one is full *)
      Moretext(avail.arry);
      avail.loc:=1;
      newnode(p);
      if endobject^.right <> nil
        then begin
          endobject^.right^.left:=p;
          p^.right:=endobject^.right;
        end;
      endobject^.right:=p;
      p^.left:=endobject;
      endobject:=p;
      endobject^.parent:=nil;
      endobject^.disp:=1;
      endobject^.length:=0;
      endobject^.color:=red;
      endobject^.text:=avail.arry;
    end;
  avail.arry^[avail.loc]:=ch;
  avail.loc:=avail.loc + 1;
  endobject^.length:=endobject^.length + 1;
End;



Procedure Delchar(Var ch : char);
(* Remove the current character from the text and return it in the variable CH.
   If there is no character to remove nothing is done. *)
Var   p : ptr;
Begin
  if (newobject^.text = avail.arry) and (newobject^.disp = avail.loc)
    then ERROR(57)
    else begin
      avail.loc:=avail.loc - 1;
      ch:=avail.arry^[avail.loc];
      endobject^.length:=endobject^.length - 1;
      if avail.loc = 1   (* Return empty array block to available space list *)
        then begin
          endobject^.text:=nil;
          p:=endobject;
          endobject:=endobject^.left;
          if p^.right <> nil
            then begin
              p^.right^.left:=endobject;
              endobject^.right:=p^.right;
            end
            else endobject^.right:=nil;
          nodedispose(p);
          textdispose(avail.arry);
          avail.arry:=endobject^.text;
          avail.loc:=blocksize + 1;
        end;
    end;
End;




Procedure Finishtext(Var obj : object);
(* Return pointers to the beginning and end of the new text in the variable OBJ *)
Var  edge : boolean;
Begin
  addchar(chr(EOL));
  obj.first.disp:=0;
  obj.first.seg:=newobject;
  obj.last.disp:=endobject^.length - 1;
  obj.last.seg:=endobject;
End;



Procedure Copytext(var first,last : stickypointer; var copiedtext : object);
(* This procedure copies the text between the pointers FIRST and LAST, and
   returns pointers to the beginning and end of the copied text in the variable
   COPIEDTEXT.  The copy is done by duplicating the nodes that point to the
   text instead of duplicating the text itself. This conserves a lot of space
   and time in the general case. *)
Var   obj : object;
      p,q,s : ptr;
      i : integer;
Begin
  find(first);
  find(last);
  if not greater(first,last)
    then ERROR(2)
    else begin
      newnode(p);
      copiedtext.first.seg:=p;
      copiedtext.first.disp:=0;
      p^.length:=first.seg^.length - first.disp;
      p^.disp:=first.seg^.disp + first.disp;
      p^.text:=first.seg^.text;
      p^.color:=black;
      p^.parent:=nil;   p^.left:=nil;   p^.right:=nil;
      q:=first.seg;
      while q <> last.seg do
        begin
          q:=q^.right;
          newnode(s);
          s^.length:=q^.length;
          s^.disp:=q^.disp;
          s^.text:=q^.text;
          s^.color:=black;
          s^.parent:=nil;   s^.left:=p;  s^.right:=nil;
          p^.right:=s;
          p:=s;
        end;
      p^.length:=p^.length + last.disp - last.seg^.length + 1;
      copiedtext.last.seg:=p;
      copiedtext.last.disp:=p^.length - 1;
    end;
End;





Procedure Insert(Var s : stickypointer; Var string : object);
(* This procedure inserts the string pointed to by STRING at the position S.
   The variable STRING should always be produced by COPYTEXT or by the
   set of four procedures STARTTEXT, ADDCHAR, DELCHAR, and FINISHTEXT because
   INSERT always assumes there is a extra character at the end of STRING.  *)
Var   p : ptr;
      rightedge : boolean;
Begin
  lastdel.first.seg:=nil;
  Find(s);
  if s.seg^.length = 0
    then moveforward(s,rightedge);
  Find(btext^.location^);
  if (btext^.location^.seg = s.seg) and (btext^.location^.disp = s.disp)
    then btext^.location^:=string.first;
(* Link in the left end of STRING to the location of S *)
  newnode(p);
  p^.color:=red;                       p^.left:=s.seg^.left;
  p^.right:=string.first.seg;          p^.disp:=s.seg^.disp;
  p^.length:=s.disp;                   p^.text:=s.seg^.text;
  p^.parent:=s.seg;
  if s.seg^.left <> nil
    then s.seg^.left^.right:=p;
  string.first.seg^.left:=p;           s.seg^.left:=p;
(* Link in the right end of STRING to the location of S *)
  newnode(p);
  while string.last.seg^.length = 0 do
    string.last.seg:=string.last.seg^.left;
  string.last.seg^.right:=p;
  string.last.seg^.color:=black;
  string.last.seg^.length:=string.last.seg^.length - 1;
  p^.color:=red;             p^.left:=string.last.seg;
  p^.right:=s.seg^.right;    p^.disp:=s.seg^.disp + s.disp;
  p^.text:=s.seg^.text;      p^.length:=s.seg^.length - s.disp;
  p^.parent:=s.seg;
  if s.seg^.right <> nil
    then s.seg^.right^.left:=p;
  s.seg^.text:=nil;          s.seg^.disp:=0;
  s.seg^.right:=p;
  if s.seg^.color = red 
    then balance(s.seg);
End;



Procedure DeleteText(Var start,finish : stickypointer);
(* DeleteText deletes the text between the two pointers START and FINISH *)
Var  p,q : ptr;
     s : stickypointer;
     temp : ptr;
     moved : boolean;
Begin
  Find(start);
  Find(finish);
  if not greater(start,finish)
    then ERROR(1)
    else begin
      lastdel.first:=start;
      lastdel.last:=finish;
      temp:=start.seg;
      s.seg:=nil;
      s.disp:=start.disp;
      while s.seg <> finish.seg do
        begin
          s.seg:=temp;
          temp:=s.seg^.right;
          newnode(p);               newnode(q);
          p^.color:=red;            q^.color:=red;
          p^.left:=s.seg^.left;     q^.left:=p;
          p^.right:=q;              q^.right:=s.seg^.right;
          p^.disp:=s.seg^.disp;     q^.disp:=s.seg^.disp + finish.disp;
          p^.text:=s.seg^.text;     q^.text:=s.seg^.text;
          p^.parent:=s.seg;         q^.parent:=s.seg;
          p^.length:=s.disp;
          if s.seg = finish.seg
            then q^.length:=s.seg^.length - finish.disp
            else q^.length:=0;
          if s.seg^.left <> nil
            then s.seg^.left^.right:=p;
          if s.seg^.right <> nil
            then s.seg^.right^.left:=q;
          s.seg^.left:=p;          s.seg^.right:=q;
          s.seg^.disp:=0;          s.seg^.text:=nil;
          if s.seg^.color = red
            then balance(s.seg);
          s.disp:=0;
        end;
    end;
End;



Procedure UnDeleteText;
(* This procedure will restore text that has been deleted in the same location
   that it was in before it was deleted.  All pointers to this deleted text
   will automatically be restored to their correct location as long as they
   have not been referenced between the deletion and undeletion of the text.
   The variable LASTDEL defines the last string to be deleted.  If LASTDEL.
   FIRST.SEG is NIL then either nothing has been deleted or an insertion has
   been made since the deletion, in which case the deleted text can no longer
   be undeleted.  The undeletion is done by copying information to the base
   nodes of the balanced tree structure from its parent which remembers the
   length of the deleted text. *)
Var  temp : ptr;
Begin
  if lastdel.first.seg <> nil then
    begin
      lastdel.first.seg:=lastdel.first.seg^.left;
      lastdel.last.seg:=lastdel.last.seg^.left;
      while lastdel.first.seg <> lastdel.last.seg do
        begin
          lastdel.first.seg^.length:=lastdel.first.seg^.parent^.length;
          lastdel.first.seg:=lastdel.first.seg^.right^.right;
        end;
      lastdel.first.seg^.length:=lastdel.first.seg^.parent^.length -
                                              lastdel.last.seg^.right^.length;
      lastdel.first.seg:=nil;
    end;
End;


Function SearchFor(stringstart,stringstop,start,stop : stickypointer; 
                    Var  s1,s2 : stickypointer) : boolean;
(* This function searches for the string defined by STRINGSTART and STRINGSTOP
   within the string defined by START and STOP.  Pointers to both sides of the
   matched string are returned in the variables S1 and S2, and the success of 
   the search is returned by the function.  If the search is unsuccessful the
   values of S1 and S2 are not changed.  The algorithm used to do the searching
   is the Knuth-Morris-Pratt algorithm. *)
Const Stringsize = 2000;
Var   flink : array [1..Stringsize] of integer;
      i,j,k,m : integer;
      string : array[0..Stringsize] of char;
      temp1,temp2 : stickypointer;
      edge : boolean;
      ch : char;


Procedure Failurelink;
(* Failurelink sets up the failure links needed for the Knuth-Morris-Pratt
   algorithm *)
Begin
  flink[1]:=0;
  i:=2;
  while i <= m do
    begin
      j:=flink[i-1];
      while (j <> 0) and (string[j] <> string[i-1]) do
        j:=flink[j];
      flink[i]:=j+1;
      i:=i+1;
    end;
End;


Function Match : boolean;
(* Match does the actual searching for the desired string and returns whether
   the search was successful or not *)
Var  ch1,ch2 : char;
Begin
  j:=1;
  while (j <= m) and ((Start.seg <> Stop.seg) or (Start.disp < Stop.disp)) do
    begin
      ch:=start.seg^.text^[start.disp + start.seg^.disp];
      if ch in ['a'..'z']
        then ch:=chr(ord(ch) - 32);
      while (j <> 0) and (string[j] <> ch) do
        j:=flink[j];
      if (j = m) and (m < stringsize)
        then j:=m + 1
        else if j < m
          then begin
            moveforward(start,edge);
            j:=j + 1;
          end
          else begin
            temp1:=stringstart;
            temp2:=start;
            ch1:=temp1.seg^.text^[temp1.disp + temp1.seg^.disp];
            ch2:=temp2.seg^.text^[temp2.disp + temp2.seg^.disp];
            if ch1 in ['a'..'z']
              then ch1:=chr(ord(ch) - 32);
            if ch2 in ['a'..'z']
              then ch2:=chr(ord(ch) - 32);
            while ((temp1.seg <> stringstop.seg) or 
                   (temp1.disp < stringstop.disp)) and (ch1 = ch2) do
              begin
                moveforward(temp1,edge);
                moveforward(temp2,edge);
                ch1:=temp1.seg^.text^[temp1.disp + temp1.seg^.disp];
                ch2:=temp2.seg^.text^[temp2.disp + temp2.seg^.disp];
                if ch1 in ['a'..'z']
                  then ch1:=chr(ord(ch) - 32);
                if ch2 in ['a'..'z']
                  then ch2:=chr(ord(ch) - 32);
              end;
            if ch1 = ch2
              then begin
                j:=m + 1;
                start:=temp2;
              end
              else begin
                j:=flink[stringsize];
                moveforward(start,edge);
              end;
          end;
    end;
  if j = m + 1
    then match:=true
    else match:=false;
End;



Begin   (* SEARCHFOR *)
  edge:=false;
  find(stringstart);
  find(stringstop);
  find(start);
  find(stop);
  oldsearch^.first:=stringstart;
  oldsearch^.last:=stringstop;
  m:=0;
  while ((stringstart.seg <> stringstop.seg) or (stringstart.disp <
          stringstop.disp)) and (m < stringsize) do
    begin
      m:=m + 1;
      ch:=stringstart.seg^.text^[stringstart.disp+stringstart.seg^.disp];
      if ch in ['a'..'z']
        then ch:=chr(ord(ch) - 32);
      string[m]:=ch;
      moveforward(stringstart,edge);
    end;
  k:=0;
  if m = stringsize
    then while (stringstart.seg <> stringstop.seg) or (stringstart.disp <
          stringstop.disp) do
      begin
        k:=k + 1;
        moveforward(stringstart,edge);
      end;
  failurelink;
  if match
    then begin
      moveforward(start,edge);
      s1:=start;
      s2:=start;
      for i:=1 to m + k do
        movebackward(s1,edge);
      searchfor:=true;
    end
    else searchfor:=false;
End;



Procedure Compact(condition : states; nameoffile : alfa);
(* Compact is the procedure which handles the writing out of the user's main
   file and corresponding pointer file when the user saves his file (either by
   a SAVE or an EXITANDSAVE command).  Compact also compresses the main balanced
   tree structure and returns all available space to available space lists. 
   The compressing is done whenever the SAVE command is done but is also set
   up to compress the tree as a garbage collection routine. *)
Var  i,j,k,displacement : integer;
     p,first,start,ptrstart : ptr;
     obj : object;
     tempname : filename;
     tempmaintext,tlist : textlistptr;
     header : nextfile;
     tempbtext : sticky;
     temp : entry;



Procedure Adjust(Op:integer);
Var  i : integer;
     p : entry;


Procedure PushDown(ptr : entry);
Begin
  Case ptr^.tipe of
     ptrtype: if not greater(tempbtext^,ptr^.location^)
                then removename(ptr^.name,header^.name)
                else find(ptr^.location^);
  stringtype: Begin
                find(ptr^.first^);
                find(ptr^.last^);
              End;
   stacktype: Begin
                ptr:=ptr^.top;
                while ptr <> nil do
                  begin
                    PushDown(ptr);
                    ptr:=ptr^.next;
                  end;
              End;
    inttype,
    booltype,
    reserved,
    chartype: ;
  end;
End;


Procedure ReEstablish(ptr : entry);
Var  j : integer;
Begin
  Case ptr^.tipe of
     ptrtype: Begin
                ptr^.location^.disp:=ptr^.location^.disp + ptr^.location^.seg^.disp;
                ptr^.location^.seg:=start;
                while ptr^.location^.disp >= blocksize do
                  begin
                    ptr^.location^.seg:=ptr^.location^.seg^.right;
                    ptr^.location^.disp:=ptr^.location^.disp - blocksize;
                  end;
              End;
  stringtype: if greater(tempbtext^,ptr^.first^)
                then begin
                  ptr^.first^.disp:=ptr^.first^.disp + ptr^.first^.seg^.disp;
                  ptr^.first^.seg:=start;
                  ptr^.last^.disp:=ptr^.last^.disp + ptr^.last^.seg^.disp;
                  ptr^.last^.seg:=start;
                  while ptr^.first^.disp >= blocksize do
                    begin
                      ptr^.first^.seg:=ptr^.first^.seg^.right;
                      ptr^.first^.disp:=ptr^.first^.disp - blocksize;
                    end;
                  while ptr^.last^.disp >= blocksize do
                    begin
                      ptr^.last^.seg:=ptr^.last^.seg^.right;
                      ptr^.last^.disp:=ptr^.last^.disp - blocksize;
                    end;
                end
                else begin
                  starttext;
                  while p^.first^.seg <> p^.last^.seg do
                    begin
                      for j:=p^.first^.disp to (p^.first^.seg^.length-1) do
                        addchar(p^.first^.seg^.text^[j+p^.first^.seg^.disp]);
                      p^.first^.disp:=0;
                      p^.first^.seg:=p^.first^.seg^.right;
                    end;
                  for j:=p^.first^.disp to p^.last^.disp do
                    addchar(p^.first^.seg^.text^[j+p^.first^.seg^.disp]);
                  finishtext(obj);
                  p^.first^:=obj.first;
                  p^.last^:=obj.last;
                end;
     stacktype: Begin
                  ptr:=ptr^.top;
                  while ptr <> nil do
                    begin
                      ReEstablish(ptr);
                      ptr:=ptr^.next;
                    end;
                End;
      inttype,
      booltype,
      reserved,
      chartype: ;
  end;
End;


Procedure WriteOut(ptr : entry);
Var  temp,temp2 : stickypointer;
     edge : boolean;
     
     
Procedure WriteName(name : alfa);
Var   i : integer;
Begin
  for i:=1 to maxnamesize do
    addchar(name[i]);
End;


Procedure WriteInt(amount : integer);
Var   i,e,exp,temp : integer;
Begin
  addchar(' ');
  if amount < 0
    then begin
      addchar('-');
      amount:=-amount;
    end;
  exp:=0;
  temp:=amount;
  while temp > 9 do
    begin
      temp:=temp div 10;
      exp:=exp + 1;
    end;
  for e:=exp downto 0 do
    begin
      temp:=amount div (10**e);
      addchar(chr(temp + ord('0')));
      amount:=amount - temp*(10**e);
    end;
  addchar(' ');
End;



Begin
  Case ptr^.tipe of 
    ptrtype: if (ptr^.name <> 'ETEXT     ') and (ptr^.name <> 'BTEXT     ')
                     and greater(tempbtext^,ptr^.location^) and
                     ((ptr^.name[1] <> 'M') or (ptr^.name[3] <> ' ') or
                     (not (ptr^.name[2] in ['0'..'9'])))
               then begin
                 writename(ptr^.name);
                 writeint(ord(ptrtype));
                 writeint(ptr^.location^.disp + ptr^.location^.seg^.disp);
                 addchar(chr(EOL));
               end;
 stringtype: Begin
               if greater(tempbtext^,ptr^.first^) and (ptr^.name <> 'LAST      ')
                 then begin
                   writename(ptr^.name);
                   writeint(ord(stringtype) + 1);
                   writeint(ptr^.first^.disp + ptr^.first^.seg^.disp);
                   writeint(ptr^.last^.disp + ptr^.last^.seg^.disp);
                   addchar(chr(EOL));
                 end
                 else if ptr^.name <> 'LAST      '
                   then begin
                     writename(ptr^.name);
                     writeint(ord(stringtype));
                     addchar(chr(EOL));
                     edge:=false;
                     temp:=ptr^.first^;
                     temp2:=ptr^.last^;
                     while not edge and not greater(temp2,temp) do
                       begin
                         addchar(temp.seg^.text^[temp.disp + temp.seg^.disp]);
                         moveforward(temp,edge);
                       end;
                     addchar(chr(ESC));
                     addchar(chr(EOL));
                   end;
             End;
  stacktype: Begin
               writename(ptr^.name);
               writeint(ord(stacktype)+1);
               addchar(chr(EOL));
               ptr:=ptr^.top;
               while ptr <> nil do
                 begin
                   WriteOut(ptr);
                   ptr:=ptr^.next;
                 end;
               writename(emptyname);
               writeint(-1);
               addchar(chr(EOL));
             End;
    inttype: Begin
               writename(ptr^.name);
               writeint(ord(inttype));
               writeint(ptr^.intvalue);
               addchar(chr(EOL));
             End;
   chartype: Begin
               writename(ptr^.name);
               writeint(ord(chartype));
               addchar(ptr^.charvalue);
               addchar(chr(EOL));
             End;
   booltype: Begin
               writename(ptr^.name);
               writeint(ord(booltype));
               writeint(ord(ptr^.boolvalue));
               addchar(chr(EOL));
             End;
   reserved: ;
  end;    (* Case *)
End;


Begin
  for i:=0 to tablesize do
    begin
      p:=header^.table[i];
      while p <> nil do
        begin
          Case op of
            1 : PushDown(p);
            2 : ReEstablish(p);
            3 : WriteOut(p);
            end;
          p:=p^.next;
        end;
    end;
End;


Procedure Destroytree;
Var p,q : ptr;

Procedure Removenode(Var Current : ptr);
Begin
  if current^.text = nil
    then begin
      removenode(current^.right);
      removenode(current^.left);
      current^.right:=nil;            current^.left:=nil;
      current^.parent:=nil;
      nodedispose(current);
    end
    else current^.parent:=nil;
End;

Begin   (* DESTROYTREE *)
  p:=tempbtext^.seg;
  while  p <> nil do
    begin 
      q:=p;
      while q^.parent <> nil do
        q:=q^.parent;
      removenode(q);
      p:=p^.right;
    end;
End;


PROCEDURE FSTART(%IMMED LEN:INTEGER; NAM:FILENAME); EXTERN;
PROCEDURE FFINISH(VAR I:INTEGER; VAR NAM:FILENAME); EXTERN;
PROCEDURE FPUT(%IMMED LEN:INTEGER; A:CHAR); EXTERN;

Begin   (* COMPACT *)
  if (nameoffile = emptyname) or (currentfile^.next = currentfile)
    then begin
      tempmaintext:=maintext;
      maintext:=nil;
    end;
  header:=findfile(nameoffile);
  repeat
    temp:=lookup(btext^.name,header^.name);
    tempbtext:=temp^.location;
    Adjust(1);
    displacement:=0;
    if header^.maintext
      then begin
        if (condition = finished) or (condition = savefile)
          then begin
            i:=header^.speclength;
            j:=1;
            while (j<=i) and (header^.spec[j]<>';') do j:=j+1;
            FSTART(j-1,header^.spec);
          end;
        if (condition = savefile) or (condition = garbagecollect)
          then begin
            destroytree;
            moretext(avail.arry);
            avail.loc:=1;
            starttext;
            first:=tempbtext^.seg;
          end;
        p:=tempbtext^.seg;
        while p <> nil do
          begin
            if (condition = finished) or (condition = savefile)
              then if p^.length<>0 then fput(p^.length,p^.text^[p^.disp]);
            if (condition = savefile) or (condition = garbagecollect)
              then for i:=p^.disp to (p^.disp + p^.length - 1) do
                addchar(p^.text^[i]);
            p^.disp:=displacement;
            displacement:=displacement + p^.length;
            p:=p^.right;
          end;
        if (condition = savefile) or (condition = garbagecollect)
          then begin
            finishtext(obj);
            start:=newobject;
          end;
      end;
    if ((condition = finished) or (condition = savefile)) and header^.belong
      then begin
        if header^.maintext
          then ffinish(i,tempname);
        k:=header^.ptrspeclength;
        j:=1;
        while (j <= k) and (header^.ptrspec[j] <> ';') do j:=j+1;
        FSTART(j-1,header^.ptrspec);
        starttext;
        ptrstart:=newobject;
        if header^.maintext
          then begin    (* write name of textfile in pointer file *)
            j:=1;
            while (tempname[j] <> ']') and (tempname[j] <> '>') do
              j:=j+1;
            for j:=j+1 to i do
              addchar(tempname[j]);
            addchar(chr(EOL));
          end;
        Adjust(3);
        finishtext(obj);
        obj.last.seg^.length:=obj.last.seg^.length - 1;
        while ptrstart <> nil do
          begin
            if ptrstart^.length <> 0
              then fput(ptrstart^.length,ptrstart^.text^[ptrstart^.disp]);
            ptrstart:=ptrstart^.right;
          end;
        ffinish(i,tempname);
      end;
    if (condition = savefile) or (condition = garbagecollect)
      then begin
        adjust(2);
        while first <> nil do
          begin
            p:=first^.right;
            first^.right:=nil;
            first^.left:=nil;
            nodedispose(first);
            first:=p;
          end;
      end;
    if nameoffile = emptyname
      then header:=header^.next
      else header:=currentfile;
  until header = currentfile;
  if ((condition = savefile) or (condition = garbagecollect)) and
     ((nameoffile = emptyname) or (currentfile^.next = currentfile))
    then begin
      tlist:=tempmaintext;
      while tlist^.next <> nil do
        tlist:=tlist^.next;
      tlist^.next:=textavail;
      textavail:=tempmaintext;
    end;
End;




Procedure MoveSticky(Var s : stickypointer; lines,chars :integer);
Var  LeftEdge,RightEdge,backward : boolean;
Begin
  find(s);
  RightEdge:=false;
  LeftEdge:=false;
  if lines <> 0 
    then begin
      movebackward(s,LeftEdge);
      while (getch(s) <> chr(EOL)) and not LeftEdge do
        begin
          movebackward(s,LeftEdge);
          chars:=chars + 1;
        end;
      if lines > 0
        then begin
          if not LeftEdge
            then moveforward(s,RightEdge);
          while (lines > 0) and not RightEdge do
            begin
              if getch(s) = chr(EOL)
                then lines:=lines - 1;
              if lines > 0
                then moveforward(s,RightEdge);
            end;
          if lines <= 0
            then moveforward(s,RightEdge);
        end
        else begin
          movebackward(s,LeftEdge);
          while (lines < 0) and not LeftEdge do
            begin
              if getch(s) = chr(EOL)
                then lines:=lines + 1;
              if lines < 0 
                then movebackward(s,LeftEdge);
            end;
          if lines = 0
            then moveforward(s,RightEdge);
        end;
      LeftEdge:=false;
      RightEdge:=false;
    end;
  if chars < 0
    then backward:=true
    else backward:=false;
  if (chars > 0) and (getch(s) <> chr(EOL))
    then begin
      moveforward(s,RightEdge);
      chars:=chars - 1;
    end
    else if chars < 0 then
      begin
        movebackward(s,LeftEdge);
        chars:=chars + 1;
      end;
  while (chars > 0) and not RightEdge and (getch(s) <> chr(EOL)) do
    begin
      moveforward(s,RightEdge);
      chars:=chars - 1;
    end;
  while (chars < 0) and not LeftEdge and (getch(s) <> chr(EOL)) do
    begin
      movebackward(s,LeftEdge);
      chars:=chars + 1;
    end;
  if backward and not leftedge and (getch(s) = chr(EOL))
    then moveforward(s,RightEdge);
End;




Procedure Dumpbuffer;
Begin
  writebuf(buffer,bufferindex - 1);
  bufferindex:=1;
End;



Procedure Findchars(s : stickypointer; Var chars : integer);
Var   leftedge : boolean;
Begin
  chars:=0;
  leftedge:=false;
  movebackward(s,leftedge);
  while (getch(s) <> chr(EOL)) and not leftedge do
    begin
      movebackward(s,leftedge);
      chars:=chars + 1;
    end;
End;




Procedure Findlocation(s : stickypointer; Var lines,chars : integer);
Var   leftedge,rightedge : boolean;
Begin
  chars:=0;
  lines:=0;
  leftedge:=false;
  rightedge:=false;
  movebackward(s,leftedge);
  while (getch(s) <> chr(EOL)) and not leftedge do
    begin
      movebackward(s,leftedge);
      chars:=chars + 1;
    end;
  chars:=chars - edge;
  if not leftedge
    then moveforward(s,rightedge);
  if not leftedge and greater(window^.location^,s)
    then begin
      while (s.seg <> window^.location^.seg) or
            (s.disp > window^.location^.disp) do
        begin
          movebackward(s,leftedge);
          if getch(s) = chr(EOL)
            then lines:=lines + 1;
        end;
    end
    else if greater(s,window^.location^) and not rightedge
      then begin
        while (s.seg <> window^.location^.seg) or
              (s.disp < window^.location^.disp) do
          begin
            if getch(s) = chr(EOL)
              then lines:=lines - 1;
            moveforward(s,rightedge);
          end;
      end;
End;




Procedure Dumplines(amount : integer; s : stickypointer; 
            Var lines,chars : integer; clearscreen : boolean);  forward;



Procedure Movecursor(line,chrs : integer);
Var   lines,chars : integer;
      start : stickypointer;
Begin
  if (line >= 0) and (line < screensize)
    then begin
      if (chrs >= 0) and (chrs < screenwidth) 
        then begin
          case terminal of
     bantom,fox : begin
                    buffer[bufferindex]:=ftnchar;
                    buffer[bufferindex+1]:='Y';
                    buffer[bufferindex+2]:=chr(chrs+32);
                    buffer[bufferindex+3]:=ftnchar;
                    buffer[bufferindex+4]:='X';
                    buffer[bufferindex+5]:=chr(line+32);
                    bufferindex:=bufferindex + 6;
                  end;
            hp  : begin
                    buffer[bufferindex]:=ftnchar;
                    buffer[bufferindex+1]:='&';
                    buffer[bufferindex+2]:='a';
                    buffer[bufferindex+3]:=chr((line div 10) + 48);
                    buffer[bufferindex+4]:=chr((line mod 10) + 48);
                    buffer[bufferindex+5]:='y';
                    buffer[bufferindex+6]:=chr((chrs div 10) + 48);
                    buffer[bufferindex+7]:=chr((chrs mod 10) + 48);
                    buffer[bufferindex+8]:='C';
                    bufferindex:=bufferindex + 9;
                  end;
      vt,zenith : begin
                    buffer[bufferindex]:=ftnchar;
                    buffer[bufferindex+1]:='Y';
                    buffer[bufferindex+2]:=chr(line+32);
                    buffer[bufferindex+3]:=chr(chrs+32);
                    bufferindex:=bufferindex + 4;
                  end;
            ddt : begin
                    buffer[bufferindex]:=ftnchar;
                    buffer[bufferindex+1]:='N';
                    buffer[bufferindex+2]:=chr(127-chrs);
                    buffer[bufferindex+3]:=chr(127-line);
                    bufferindex:=bufferindex + 4;
                  end;
            tec : begin
                    buffer[bufferindex]:=ftnchar;
                    buffer[bufferindex+1]:=chr(SO);
                    buffer[bufferindex+2]:=chr(127-line);
                    buffer[bufferindex+3]:=chr(127-chrs);
                    bufferindex:=bufferindex + 4;
                  end;
          end;
          dumpbuffer;
          cursor.chars:=chrs;
          cursor.lines:=line;
        end
        else if chrs < 0
          then begin
            edge:=edge + chrs - 5;
            if edge < 0
              then begin
                chrs:=5 + edge;
                edge:=0;
                if chrs < 0 
                  then chrs:=0;
              end
              else chrs:=5;
            lines:=0;
            chars:=-edge;
            dumplines(screensize,window^.location^,lines,chars,true);
            movecursor(line,chrs);
          end
          else begin
            edge:=edge + chrs - screenwidth + 5;
            lines:=0;
            chars:=-edge;
            dumplines(screensize,window^.location^,lines,chars,true);
            movecursor(line,screenwidth - 5);
          end;
    end
    else if line < 0
      then begin
        movesticky(window^.location^,line-5,-3000);
        lines:=0;
        chars:=-edge;
        dumplines(screensize,window^.location^,lines,chars,true);
        findlocation(curse^.location^,lines,chars);
        movecursor(lines,chrs);
      end
      else if line < 2*screensize
        then begin
          start:=window^.location^;
          movesticky(start,screensize,0);
          chars:= - edge;
          lines:=screensize;
          movecursor(screensize - 1,0);
          buffer[bufferindex]:=chr(LF);
          bufferindex:=bufferindex + 1;
          dumpbuffer;
          dumplines(line-screensize+5,start,lines,chars,false);
          movesticky(window^.location^,lines-screensize+1,-3000);
          findlocation(curse^.location^,lines,chars);
          movecursor(lines,chrs);
        end
        else begin
          movesticky(window^.location^,line-5,-3000);
          lines:=0;
          chars:=-edge;
          dumplines(screensize,window^.location^,lines,chars,true);
          findlocation(curse^.location^,cursor.lines,chars);
          movecursor(cursor.lines,chrs);
        end;
End;




Procedure Dumplines(*amount : integer; s : stickypointer; 
                          Var lines,chars : integer; clearscreen : boolean*);
Var   endofline : boolean;
      ch : char;
      i : integer;
Begin
  if lines >= screensize
    then if chars >= 0
      then movecursor(screensize - 1,chars)
      else movecursor(screensize - 1,0)
    else if chars >= 0
      then movecursor(lines,chars)
      else movecursor(lines,0);
  if clearscreen
    then if terminal = bantom
      then begin
        for i:=cursor.lines + 1 to screensize-1 do
          begin
            buffer[bufferindex]:=ftnchar;
            buffer[bufferindex+1]:=clearline;
            buffer[bufferindex+2]:=chr(CR);
            buffer[bufferindex+3]:=chr(LF);
            bufferindex:=bufferindex+4;
          end;
        buffer[bufferindex]:=ftnchar;
        buffer[bufferindex+1]:=clearline;
        for i:=1 to nulls do
          buffer[bufferindex+i+1]:=chr(NUL);
        bufferindex:=bufferindex + nulls + 2;
        dumpbuffer;
        movecursor(cursor.lines,cursor.chars);
      end
      else begin
        buffer[bufferindex]:=ftnchar;
        buffer[bufferindex+1]:=clearpage;
        bufferindex:=bufferindex + 2;
        dumpbuffer;
      end
    else begin
      buffer[bufferindex]:=ftnchar;
      buffer[bufferindex+1]:=clearline;
      bufferindex:=bufferindex + 2;
      dumpbuffer;
    end;
  if s.seg^.text = nil
    then find(s);
  while amount > 0 do
    begin
      endofline:=false;
      while (chars < 0) and not endofline do
        if s.disp >= s.seg^.length
          then begin
            moveforward(s,endofline);
            if endofline
              then amount:=0;
          end
          else begin
            if s.seg^.text^[s.disp + s.seg^.disp] = chr(EOL)
              then endofline:=true
              else chars:=chars + 1;
            s.disp:=s.disp + 1;
          end;
      while (chars < screenwidth) and not endofline do
        if s.disp >= s.seg^.length
          then begin
            moveforward(s,endofline);
            if endofline
              then amount:=0;
          end
          else begin
            ch:=s.seg^.text^[s.disp + s.seg^.disp];
            if ch = chr(EOL)
              then endofline:=true
              else begin
                if (ch < ' ') or (ch = chr(DEL))
                  then buffer[bufferindex]:='~'
                  else buffer[bufferindex]:=ch;
                bufferindex:=bufferindex + 1;
                chars:=chars + 1;
              end;
            s.disp:=s.disp + 1;
          end;
        while not endofline do
          if s.disp >= s.seg^.length
            then begin
              moveforward(s,endofline);
              if endofline
                then amount:=0;
            end
            else begin
              if s.seg^.text^[s.disp + s.seg^.disp] = chr(EOL)
                then endofline:=true;
              s.disp:=s.disp + 1;
            end;
        amount:=amount - 1;
        if chars = screenwidth
          then buffer[bufferindex-1]:='#';
        if amount > 0 
          then begin
            buffer[bufferindex]:=chr(CR);
            buffer[bufferindex+1]:=chr(LF);
            bufferindex:=bufferindex + 2;
            chars:= - edge;
            lines:=lines + 1;
            if bufferindex > buffersize - screenwidth - 2
              then dumpbuffer;
          end;
    end;
  dumpbuffer;
  s.disp:=s.disp - 1;
  if lines > screensize - 1
    then cursor.lines:=screensize - 1
    else cursor.lines:=lines;
  if chars < 0
    then cursor.chars:=0
    else if chars < screenwidth
      then cursor.chars:=chars
      else cursor.chars:=screenwidth - 1;
End;




Procedure Dumprestofline;
Var  ch : char;
     chars,temp : integer;
Begin
  chars:=cursor.chars;
  temp:=screenwidth - cursor.chars;
  if temp > linelength
    then begin
      writebuf(restofline,linelength);
      cursor.chars:=cursor.chars + linelength;
    end
    else if temp > 0
      then begin
        ch:=restofline[temp];
        restofline[temp]:='#';
        writebuf(restofline,temp);
        restofline[temp]:=ch;
        cursor.chars:=screenwidth;
      end;
  movecursor(cursor.lines,chars);
end;




Procedure Insertchar(ch : char; position : stickypointer; special : boolean);
Var  lines,chars,l,c : integer;
     leftedge : boolean;
Begin
  find(position);      find(window^.location^);
  if (position.seg = window^.location^.seg) and 
     (position.disp = window^.location^.disp)
    then movebackward(window^.location^,leftedge);
  if ch <> chr(CR)
    then begin
      if cursor.chars < screenwidth - 1
        then begin
          cursor.chars:=cursor.chars + 1;
          if (ch < ' ') or (ch = chr(DEL))
            then buffer[bufferindex]:='~'
            else buffer[bufferindex]:=ch;
          bufferindex:=bufferindex + 1;
          if cursor.chars = 70
            then begin
              buffer[bufferindex]:=chr(BEL);
              bufferindex:=bufferindex + 1;
            end;
          dumpbuffer;
          if not special
            then dumprestofline;
        end
        else begin
          edge:=edge + 5;
          c:=cursor.chars + 1 - 5;
          l:=cursor.lines;
          chars:=-edge;
          if special
            then begin
              lines:=screensize - falsescreensize;
              dumplines(falsescreensize,window^.location^,lines,chars,true);
            end
            else begin
              lines:=0;
              dumplines(screensize,window^.location^,lines,chars,true);
            end;
          movecursor(l,c);
        end;
      cursor.actual:=cursor.actual + 1;
    end
    else if not special
      then begin
        if edge = 0
          then begin
            buffer[bufferindex]:=ftnchar;
            buffer[bufferindex+1]:=clearline;
            buffer[bufferindex+2]:=chr(CR);
            buffer[bufferindex+3]:=chr(LF);
            bufferindex:=bufferindex + 4;
            dumpbuffer;
            cursor.chars:=0;
            if cursor.lines < screensize - 1
              then begin
                cursor.lines:=cursor.lines + 1;
                lines:=cursor.lines;
                chars:=0;
                l:=lines;
                dumplines(screensize-lines,position,lines,chars,true);
                movecursor(l,0);
              end
              else begin
                dumprestofline;
                movesticky(window^.location^,1,-3000);
              end;
           end
           else begin
             movesticky(window^.location^,1,-3000);
             cursor.chars:=0;
             edge:=0;
             lines:=0;
             chars:=0;
             l:=cursor.lines;
             dumplines(screensize,window^.location^,lines,cursor.chars,true);
             movecursor(l,0);
           end;
        cursor.actual:=0;
      end
      else begin
        if edge = 0
          then if cursor.lines < screensize - 1
            then movecursor(cursor.lines + 1,0)
            else begin
              movesticky(window^.location^,1,-3000);
              l:=screensize-falsescreensize;
              c:=0;
              dumplines(falsescreensize,window^.location^,l,c,true);
              movecursor(screensize-1,0);
            end
          else begin
            edge:=0;
            lines:=cursor.lines;
            if cursor.lines = screensize - 1
              then movesticky(window^.location^,1,-3000)
              else lines:=lines + 1;
            l:=screensize - falsescreensize;
            c:=0;
            dumplines(falsescreensize,window^.location^,l,c,true);
            movecursor(lines,0);
          end;
      end;
End;




Procedure Removechar(ch : char; position : stickypointer; special : boolean);
Var  lines,chars,l,c : integer;
Begin
  if ch <> chr(EOL)
    then begin
      if cursor.chars > 0
        then begin
          cursor.chars:=cursor.chars - 1;
          buffer[bufferindex]:=chr(BS);
          buffer[bufferindex+1]:=ftnchar;
          buffer[bufferindex+2]:=clearline;
          bufferindex:=bufferindex + 3;
          dumpbuffer;
          if not special
            then dumprestofline;
        end
        else begin
          edge:=edge - 5;
          if edge < 0
            then begin
              c:=edge + 5 - 1;
              edge:=0;
            end
            else c:=5 - 1;
          l:=cursor.lines;
          chars:=-edge;
          if special
            then begin
              lines:=screensize - falsescreensize;
              dumplines(falsescreensize,window^.location^,lines,chars,true);
            end
            else begin
              lines:=0;
              dumplines(screensize,window^.location^,lines,chars,true);
            end;
          movecursor(l,c);
        end;
      cursor.actual:=cursor.actual - 1;
    end
    else if not special
      then begin
        findchars(position,cursor.actual);
        if (cursor.actual < screenwidth-edge) and (cursor.actual >= edge)
          then begin
            movecursor(cursor.lines-1,cursor.actual-edge);
            lines:=cursor.lines;
            chars:=cursor.chars;
            l:=lines;
            c:=chars;
            dumplines(screensize-lines,position,lines,chars,true);
            movecursor(l,c);
          end
          else movecursor(cursor.lines-1,cursor.actual-edge);
      end
      else begin
        findchars(position,chars);
        if (cursor.lines > screensize-falsescreensize) and (chars < screenwidth)
          then movecursor(cursor.lines-1,chars)
          else begin
            if cursor.lines = screensize - falsescreensize
              then movesticky(window^.location^,-falsescreensize,-3000);
            if chars >= screenwidth
              then edge:=edge + chars - screenwidth + 5;
            findlocation(position,lines,chars);
            l:=screensize - falsescreensize;
            c:=-edge;
            dumplines(falsescreensize,window^.location^,l,c,true);
            movecursor(screensize - falsescreensize + lines,chars);
          end;
      end;
End;





Procedure Addtext(start,stop : stickypointer);
Var   l,c,lines,chars,stopchars,stoplines : integer;
Begin
  find(stop);    find(window^.location^);
  if (stop.seg = window^.location^.seg) and (stop.disp=window^.location^.disp)
    then window^.location^:=start;
  if greater(window^.location^,start) and greater(start,endwindow)
    then begin
      findlocation(start,lines,chars);
      if chars >= screenwidth
        then movesticky(start,1,-3000);
    end;
  if greater(window^.location^,stop) and greater(stop,endwindow) 
        and greater(start,stop)
    then begin
      if greater(start,window^.location^) 
        then movesticky(window^.location^,0,-3000);
      findlocation(start,lines,chars);
      findlocation(stop,stoplines,stopchars);
      findlocation(curse^.location^,l,c);
      if l < screensize
        then begin
          if lines < stoplines
            then dumplines(screensize-lines,start,lines,chars,true)
            else dumplines(1,start,lines,chars,false);
        end
        else begin
          dumplines(l-lines,start,lines,chars,true);
          movesticky(window^.location^,lines-screensize+1,-3000);
        end;
      findlocation(curse^.location^,lines,chars);
      cursor.actual:=chars + edge;
      movecursor(lines,chars);
    end;
End;



Procedure Removetext(start : stickypointer);
Var    l,c,lines,chars : integer;
Begin
  findlocation(endwindow,l,c);
  if (l < endlocation) or (greater(window^.location^,start) and 
                           greater(start,endwindow))
    then begin
      findlocation(start,lines,chars);
      if (l = endlocation) and (chars < screenwidth)
        then begin
          dumplines(1,start,lines,chars,false);
          findlocation(curse^.location^,lines,chars);
          cursor.actual:=chars + edge;
          movecursor(lines,chars);
        end
        else if greater(start,window^.location^)
          then begin
            movesticky(window^.location^,0,-3000);
            lines:=0;
            chars:=-edge;
            dumplines(screensize,window^.location^,lines,chars,true);
            findlocation(curse^.location^,cursor.lines,cursor.chars);
            cursor.actual:=cursor.chars + edge;
            movecursor(cursor.lines,cursor.chars);
          end
          else if l < endlocation
            then begin
              if chars >= screenwidth
                then begin
                  movesticky(start,1,-3000);
                  findlocation(start,lines,chars);
                end;
              dumplines(screensize-lines,start,lines,chars,true);
              findlocation(curse^.location^,lines,chars);
              cursor.actual:=chars + edge;
              movecursor(lines,chars);
            end;
    end;
End;



Procedure Createtext;
Var  ch : char;
     s,indentptr : stickypointer;
     obj : object;
     i : integer;
     rightedge : boolean;
Begin
  starttext;
  newobject^.length:=1; 
  obj.first.seg:=newobject;        obj.last.seg:=newobject;
  obj.first.disp:=0;               obj.last.disp:=1;
  insert(curse^.location^,obj);
  for i:=cursor.actual to cursor.chars - 1 + edge do
    addchar(' ');
  cursor.actual:=cursor.chars + edge;
  s:=curse^.location^;
  linelength:=0;
  rightedge:=false;
  if indent^.boolvalue
    then begin
      indentptr:=curse^.location^;
      movesticky(indentptr,0,-3000);
    end;
  while (getch(s) <> chr(EOL)) and not rightedge do
    begin
      linelength:=linelength + 1;
      ch:=getch(s);
      if (ch < ' ') or (ch = chr(DEL))
        then restofline[linelength]:='~'
        else restofline[linelength]:=ch;
      moveforward(s,rightedge);
    end;
  repeat
    readch(ch);
    if ch <> chr(ESC)
       then if (ch <> chr(DEL)) and (ch <> chr(BS)) and (ch <> chr(TB))
         then begin
           addchar(ch);
           insertchar(ch,curse^.location^,false);
           if indent^.boolvalue and (ch = chr(CR))
             then begin
               while getch(indentptr) = ' ' do
                 begin
                   addchar(' ');
                   insertchar(' ',curse^.location^,false);
                   moveforward(indentptr,rightedge);
                 end;
               indentptr:=curse^.location^;
               movesticky(indentptr,0,-3000);
             end;
         end
         else if ch = chr(TB)
           then begin
             if tab^.intvalue > 0 then
               for i:=1 to tab^.intvalue - (cursor.actual mod tab^.intvalue) do
                 begin
                   addchar(' ');
                   insertchar(' ',curse^.location^,false)
                 end
               else begin
                 addchar(chr(TB));
                 insertchar(chr(TB),curse^.location^,false);
               end;
           end
           else begin
             delchar(ch);
             if (ch <> chr(DEL)) and (ch <> chr(BS))
               then begin
                 removechar(ch,curse^.location^,false);
                 if indent^.boolvalue and (ch = chr(EOL))
                   then begin
                     indentptr:=curse^.location^;
                     movesticky(indentptr,0,-3000);
                   end;
               end;
           end;
  until ch = chr(ESC);
  finishtext(obj);
  obj.last.seg^.length:=obj.last.seg^.length - 1;
  if window <> nil
    then begin
   (* Fudge factor to keep BTEXT and WINDOW pointing to their correct locations *)
      find(window^.location^);
      find(btext^.location^);
      if window^.location^.seg^.length = 0
        then moveforward(window^.location^,rightedge);
      if btext^.location^.seg^.length = 0
        then moveforward(btext^.location^,rightedge);
    end;
End;



Function NewBlock : Ptr;
Var  p : ptr;
Begin
  if firstblock
    then firstblock:=false
    else begin
      moretext(avail.arry);
      avail.loc:=1;
      newnode(p);
      endobject^.right:=p;
      p^.left:=endobject;
      endobject:=p;
      endobject^.disp:=1;
      endobject^.length:=blocksize;
      endobject^.color:=red;
      endobject^.text:=avail.arry;
    end;
  newblock:=endobject;
End;





Procedure ReadInFile(Var infile:nextfile; name:filename; Var noerrors:boolean;
                                                              getmain:boolean);
Label  55;
Type returnstatus = record
                      fileopened : boolean;
                      dummy1,dummy2,dummy3 : boolean;
                      length : integer;
                      name : filename;
                    end;

Var   maxsize,i,j : integer;
      error : integer;
      returnblock : returnstatus;
      len,ext,nam : integer;
      textname,ptrname,storename : filename;
      textlen,ptrlen,storelength : integer;
      ptrobj : object;
      dummy,noptr : boolean;
      p : stickypointer;
      buf : packed array[1..50] of char;
      header : nextfile;
      

Function GetFile(n:filename; %immed length:integer; var k:returnstatus):integer;
                                                                        extern;


Procedure InputPtrs;
(* This procedure uses obj and ptrobj *)
Type  ordinalvalue = -1..6;
Var   ordinal : ordinalvalue;
      s : entry;
      tobject : object;
      eofile : boolean;
      index,temp : stickypointer;
      

Procedure ReadInt(Var i:integer);
Var  ch : char;
     neg : boolean;
begin
 i:=0;
 while getch(index) = ' ' do
   moveforward(index,eofile);
 if getch(index) = '-'
   then begin
     neg:=true;
     moveforward(index,eofile);
   end
   else neg:=false;
 repeat
   ch:=getch(index);
   moveforward(index,eofile);
   i:=i*10 + ord(ch) - ord('0');
 until not (getch(index) in ['0'..'9']);
 if neg
   then i:=-i;
End;


Procedure ReadLine;
Var  dummy : boolean;
Begin
 repeat
   ch:=getch(index);
   moveforward(index,eofile);
 until (ch = chr(EOL)) or eofile;
 moveforward(index,eofile);
  movebackward(index,dummy);
End;


Procedure ReadChar(Var ch:char);
Begin
  ch:=getch(index);
  moveforward(index,eofile);
End;


Procedure ReadName(Var n:alfa);
Var  i : integer;
Begin
 for i:=1 to maxnamesize do
   begin
     n[i]:=getch(index);
     moveforward(index,eofile);
   end;
End;


Procedure InputValue(ptr : entry; ordinal : ordinalvalue);
Var   dummy : alfa;
Begin
  Case ordinal of
    0: Begin   (* integers *)
         ptr^.tipe:=inttype;
         readint(ptr^.intvalue);
         readline; 
       End;
    1: Begin    (* characters *)
         ptr^.tipe:=chartype;
         readchar(ptr^.charvalue);
         readline;
       End;
    2: Begin    (* boolean *)
         ptr^.tipe:=booltype;
         readint(ordinal);
         readline;
         ptr^.boolvalue:=ordinal = 1;
       End;
    3: Begin    (* pointers *)
         new(ptr^.location);
         readint(ptr^.location^.disp);
         readline; 
         ptr^.location^.seg:=obj.first.seg;
         ptr^.tipe:=ptrtype;
         while (ptr^.location^.disp >= blocksize) and
                                    (ptr^.location^.seg^.right <> nil) do
           begin
             ptr^.location^.seg:=ptr^.location^.seg^.right;
             ptr^.location^.disp:=ptr^.location^.disp - blocksize;
           end;
         if ptr^.location^.disp >= blocksize
           then ptr^.location^.disp:=obj.last.disp;
       End;
    4: Begin  (* string *)
         new(ptr^.first);
         new(ptr^.last);
         readline; 
         ptr^.tipe:=stringtype;
         temp:=index;
         while getch(index) <> chr(ESC) do
           moveforward(index,eofile);
         copytext(temp,index,tobject);
         readline;
         ptr^.first^:=tobject.first;
         ptr^.last^:=tobject.last; 
       End;
    5: Begin
         new(ptr^.first);
         new(ptr^.last);
         readint(ptr^.first^.disp);
         readint(ptr^.last^.disp);
         readline;
         ptr^.first^.seg:=obj.first.seg;          
         ptr^.last^.seg:=obj.first.seg;
         ptr^.tipe:=stringtype;
         while (ptr^.first^.disp >= blocksize) and (ptr^.first^.seg^.right <> nil) do
           begin
             ptr^.first^.seg:=ptr^.first^.seg^.right;
             ptr^.first^.disp:=ptr^.first^.disp - blocksize;
           end;
         while (ptr^.last^.disp >= blocksize) and (ptr^.last^.seg^.right <> nil) do
           begin
             ptr^.last^.seg:=ptr^.last^.seg^.right;
             ptr^.last^.disp:=ptr^.last^.disp - blocksize;
           end;
         if ptr^.last^.disp >= blocksize
           then ptr^.last^.disp:=obj.last.disp;
       End;
    6: Begin
         readline;
         ptr^.tipe:=stacktype;
         readname(dummy);
         readint(ordinal);
         if ordinal < 0
           then ptr^.top:=nil
           else begin
             newentry(ptr^.top);
             ptr:=ptr^.top;
             InputValue(ptr,ordinal);
             readname(dummy);
             readint(ordinal);
             while ordinal >= 0 do
               begin
                 newentry(ptr^.next);
                 ptr:=ptr^.next;
                 InputValue(ptr,ordinal);
                 readname(dummy);
                 readint(ordinal);
               end;
             readline;
           end;
       End;
  end;        (* Case *)
End;



Begin  (* InputPtrs *)
  eofile:=false;
  index:=ptrobj.first;
  if not eofile
    then readline;
  while not eofile do
    begin
      newentry(s);
      readname(s^.name);
      readint(ordinal); 
      inputvalue(s,ordinal);
      entername(s,currentfile);
    end;
End;



Procedure InitPtrs;
Var  i : integer;
Begin
  for i:=0 to tablesize do
    currentfile^.table[i]:=nil;
  newentry(curse);                       curse^.name:='CURSOR    ';
  curse^.tipe:=ptrtype;                  new(curse^.location);
  curse^.location^:=obj.first;           
  entername(curse,currentfile);
  newentry(btext);                       btext^.name:='BTEXT     ';
  btext^.tipe:=ptrtype;                  new(btext^.location);
  btext^.location^:=obj.first;
  entername(btext,currentfile);
  newentry(etext);                       etext^.name:='ETEXT     ';
  etext^.tipe:=ptrtype;                  new(etext^.location);
  etext^.location^:=obj.last;
  entername(etext,currentfile);
  newentry(window);                      window^.name:='WINDOW    ';
  window^.tipe:=ptrtype;                 new(window^.location);
  window^.location^:=obj.first;
  entername(window,currentfile);
  newentry(lastcom);                     lastcom^.name:='LAST      ';
  lastcom^.tipe:=stringtype;             new(lastcom^.first);
  new(lastcom^.last);                    lastcom^.first^:=obj.first;
  lastcom^.last^:=obj.first;
  entername(lastcom,currentfile);
  newentry(m0);                          m0^.name:='M0        ';
  m0^.tipe:=ptrtype;                     new(m0^.location);
  m0^.location^:=obj.first;
  entername(m0,currentfile);
  newentry(m1);                          m1^.name:='M1        ';
  m1^.tipe:=ptrtype;                     new(m1^.location);
  m1^.location^:=obj.first;
  entername(m1,currentfile);
  newentry(m2);                          m2^.name:='M2        ';
  m2^.tipe:=ptrtype;                     new(m2^.location);
  m2^.location^:=obj.first;
  entername(m2,currentfile);
  newentry(m3);                          m3^.name:='M3        ';
  m3^.tipe:=ptrtype;                     new(m3^.location);
  m3^.location^:=obj.first;
  entername(m3,currentfile);
  newentry(m4);                          m4^.name:='M4        ';
  m4^.tipe:=ptrtype;                     new(m4^.location);
  m4^.location^:=obj.first;
  entername(m4,currentfile);
  newentry(m5);                          m5^.name:='M5        ';
  m5^.tipe:=ptrtype;                     new(m5^.location);
  m5^.location^:=obj.first;
  entername(m5,currentfile);
  newentry(m6);                          m6^.name:='M6        ';
  m6^.tipe:=ptrtype;                     new(m6^.location);
  m6^.location^:=obj.first;
  entername(m6,currentfile);
  newentry(m7);                          m7^.name:='M7        ';
  m7^.tipe:=ptrtype;                     new(m7^.location);
  m7^.location^:=obj.first;
  entername(m7,currentfile);
  newentry(m8);                          m8^.name:='M8        ';
  m8^.tipe:=ptrtype;                     new(m8^.location);
  m8^.location^:=obj.first;
  entername(m8,currentfile);
  newentry(m9);                          m9^.name:='M9        ';
  m9^.tipe:=ptrtype;                     new(m9^.location);
  m9^.location^:=obj.first;
  entername(m9,currentfile);
  new(oldsearch);
  oldsearch^.first:=btext^.location^;
  oldsearch^.last:=btext^.location^;
  newentry(tab);                         tab^.name:='TAB       ';
  tab^.tipe:=inttype;                    tab^.intvalue:=8;
  entername(tab,currentfile);
  newentry(indent);                      indent^.name:='INDENT    ';
  indent^.tipe:=booltype;                indent^.boolvalue:=false;
  entername(indent,currentfile);
End;



Procedure InitReserved;
Var   s : entry;
Begin
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=CHANGE;
  s^.name:='CH        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=COPY;
  s^.name:='CP        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=CREATESTACK;
  s^.name:='CS        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=DELETE;
  s^.name:='DL        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=DELNAME;
  s^.name:='DN        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=DOSYM;
  s^.name:='DO        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=EDIT;
  s^.name:='ED        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=EXITSAVE;
  s^.name:='EX        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=IFSYM;
  s^.name:='IF        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=INPUTFILE;
  s^.name:='IN        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=ISSYM;
  s^.name:='IS        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=LISTNAMES;
  s^.name:='LN        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=LISTFILES;
  s^.name:='LF        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=MOVEC;
  s^.name:='MC        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=MOVE;
  s^.name:='MV        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=NAMEBOOL;
  s^.name:='NB        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=NAMECH;
  s^.name:='NC        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=NAMEINT;
  s^.name:='NI        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=NAMEPTR;
  s^.name:='NP        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=NAMESTRING;
  s^.name:='NS        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=ORSYM;
  s^.name:='OR        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=QUIT;
  s^.name:='QT        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=RETURN;
  s^.name:='RT        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=RUN;
  s^.name:='RN        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=REPLACE;
  s^.name:='RP        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=SEARCH;
  s^.name:='SR        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=SAVE;
  s^.name:='SV        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=UNDELETE;
  s^.name:='UD        ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=VISIT;
  s^.name:='VS        ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=ADDMACROS;
  s^.name:='ADD       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=ANDSYM;
  s^.name:='AND       ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=BOOLEANSYM;
  s^.name:='BOOLEAN   ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=CASESYM;
  s^.name:='CASE      ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=CHARSYM;
  s^.name:='CHAR      ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=CHARACTERSYM;
  s^.name:='CHARACTER ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=EMPTYSYM;
  s^.name:='EMPTY     ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=ENDSYM;
  s^.name:='END       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=EXITSYM;
  s^.name:='EXIT      ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=FALSESYM;
  s^.name:='FALSE     ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=GETCHSYM;
  s^.name:='GET       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=INTSYM;
  s^.name:='INTEGER   ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=LOOPSYM;
  s^.name:='LOOP      ';  entername(s,currentfile); 
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=NOTSYM;
  s^.name:='NOT       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=ORDSYM;
  s^.name:='ORD       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=PTRSYM;
  s^.name:='POINTER   ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=POP;
  s^.name:='POP       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=PUSH;
  s^.name:='PUSH      ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=STACKSYM;
  s^.name:='STACK     ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=STRINGSYM;
  s^.name:='STRING    ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=TOP;
  s^.name:='TOP       ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=TRUESYM;
  s^.name:='TRUE      ';  entername(s,currentfile);
  newentry(s);   s^.tipe:=reserved;  s^.symbolvalue:=WHENSYM;
  s^.name:='WHEN      ';  entername(s,currentfile);
End;



Procedure MakePtr(Var textfile,n:filename; Var l:integer);
Var   i,j,length : integer;
Begin 
  length:=64;
  while textfile[length] = ' ' do
    length:=length-1;
  i:=length;
  while (i > 1) and not (textfile[i] in [']','>']) do
    i:=i-1;
  if i > 1
    then i:=i+1;
  while (i <= length) and (textfile[i] in ['a'..'z','A'..'Z','0'..'9']) do
    i:=i+1;
  i:=i-1;
  for j:=1 to i do
    n[j]:=textfile[j];
  n[i+1]:='.';    n[i+2]:='P';   n[i+3]:='T';    n[i+4]:='R';
  l:=i+4;
  for i:=l+1 to 64 do
    n[i]:=' ';
End;



Procedure InputError;
Var   i : integer;
Begin
  movecursor(screensize-3,0);
  if terminal = bantom
    then begin
      for i:=1 to 3 do
        begin
          buffer[bufferindex+3*(i-1)]:=ftnchar;
          buffer[bufferindex+3*i]:=clearline;
          buffer[bufferindex+3*(i+1)]:=chr(LF);
        end;
      bufferindex:=bufferindex + 8;
      dumpbuffer;
      movecursor(screensize-2,0);
    end
    else begin
      buffer[bufferindex]:=ftnchar;
      buffer[bufferindex+1]:=clearpage;
      buffer[bufferindex+2]:=chr(LF);
      bufferindex:=bufferindex + 3;
      dumpbuffer;
    end;
  for i:=1 to 50 do 
    buffer[bufferindex+i-1]:=buf[i];
  buffer[bufferindex+50]:=chr(CR);
  bufferindex:=bufferindex + 51;
  dumpbuffer;
  cursor.lines:=screensize - 2;
  noerrors:=false;
  goto 55;
End;



Begin      (* ReadInFile *)
  noerrors:=true;
  header:=currentfile;
  currentfile:=infile;
  infile^.maintext:=getmain;
        (* strip trailing blanks *)
  len:=64;
  while (name[len] = ' ') and (len > 0) do
    len:=len-1;
  if len = 0
    then begin
      noerrors:=false;
      goto 55;
    end;
  {find end of directory part}
  ext:=0;
  i:=len;
  while i > 0 do
   if name[i] in ['>',']']
     then begin
       ext:=i;
       i:=0;
     end
     else i:=i-1;
  ext:=ext+1;
               (* find start of extension *)
  while (ext <= len) and (name[ext] in ['a'..'z','A'..'Z','0'..'9']) do
    ext:=ext+1;
  ext:=ext-1;
  ptrname:=name;
  ptrlen:=ext+4;
  ptrname[ext+1]:='.';            ptrname[ext+2]:='p'; 
  ptrname[ext+3]:='t';            ptrname[ext+4]:='r';
               (* read pointer file *)
  moretext(avail.arry);
  avail.loc:=1;
  firstblock:=true;
  starttext;
  endobject^.length:=blocksize;
  i:=getfile(ptrname,ptrlen,returnblock);
  if i <> rms$_normal then 
    begin
      buf:='Some error in opening pointer file                ';
      inputerror;
    end;
  avail.loc:=endobject^.length+1;
  finishtext(ptrobj);
  noptr:=not returnblock.fileopened;
  storelength:=0;
  if not noptr then
    begin
      infile^.ptrspec:=returnblock.name;
      infile^.ptrspeclength:=returnblock.length;
      for j:=returnblock.length+1 to 64 do
        infile^.ptrspec[j]:=' ';
      p:=ptrobj.first;
      if not getmain
        then infile^.belong:=true
        else begin
          while getch(p) <> chr(EOL) do 
            begin  
              storelength:=storelength+1;
              storename[storelength]:=getch(p);
              moveforward(p,dummy); 
            end;
          for j:=storelength+1 to 64 do
            storename[j]:=' ';
        end;
    end;
  if getmain
    then begin                 (* read textfile *)
      if ext = len       (* no extension *)
        then if noptr or (storelength = 0)
          then begin     (* no pointer file or no file name in pointer file *)
            buf:='Extension must be on file                         ';
            inputerror;
          end
          else begin
            textname:=storename;
            textlen:=storelength;
          end
        else begin      (* extension *)
          textname:=name;
          textlen:=len;
        end;
      moretext(avail.arry);
      avail.loc:=1;
      firstblock:=true;
      starttext;
      endobject^.length:=blocksize;
      i:=getfile(textname,textlen,returnblock);
      if i <> rms$_normal then 
        begin
          buf:='Some error in opening text file                   ';
          inputerror;
        end;
      if returnblock.fileopened
        then avail.loc:=endobject^.length+1
        else endobject^.length:=0;
      finishtext(obj);
      if (ext = len) and  not returnblock.fileopened
        then begin    (* no extenstion *)
          buf:='Extension required                                ';
          inputerror;
        end; 
      if noptr
        then begin    (* there is an extension on file name at this point *)
          infile^.belong:=true;
          infile^.spec:=textname;
          infile^.speclength:=textlen;
          for j:=textlen + 1 to 64 do
            infile^.spec[j]:=' ';
          makeptr(infile^.spec,infile^.ptrspec,infile^.ptrspeclength);
        end
        else begin
          infile^.belong:=true; 
          if returnblock.fileopened
            then begin
              infile^.spec:=returnblock.name;
              infile^.speclength:=returnblock.length;
              for i:=returnblock.length+1 to 64 do
                infile^.spec[i]:=' ';
              if storelength <> 0
                then begin  
                  i:=1;
                  while infile^.spec[i] <> ']' do
                    i:=i+1; 
                  i:=i+1;
                  j:=1;
                  while infile^.belong and (storename[j] <> ' ') do
                    begin
                      infile^.belong:= infile^.spec[i]=storename[j];
                      i:=i+1;
                      j:=j+1;
                    end;
                end;
            end
            else begin
              infile^.spec:=textname;
              infile^.speclength:=textlen;
              for j:=textlen + 1 to 64 do
                infile^.spec[j]:=' ';
            end;
        end;
      initptrs;
      initreserved;
    end;
  if not noptr and infile^.belong
    then inputptrs;
55:
  currentfile:=header;
End;


 
Procedure Initialize;
Var   obj : object;
      ch : char;
      s : entry;
      l,c,length,i : integer;
      done : boolean;



Procedure Command;
Const   cli$k_getcmd = 1;
Type    cline = packed array[1..80] of char;
        string_desc = packed record
                        length : integer;
                        buffer : ^cline;
                      end;
        argument = packed record
                     request : integer;
                     fill1 : integer;
                     line : string_desc;
                     fill2 : array[1..3] of integer;
                   end;
Var   command : argument;
      len,i,j : integer;


Procedure Sys$Cli(Var sys:argument); extern;


Begin
  command.request:=cli$k_getcmd;
  sys$cli(command);
  len:=command.line.length;
      (*get rid of trailing blanks *)
  while (len > 0) and (command.line.buffer^[len] = ' ') do
    len:=len-1;
      (* find terminal type *)
  i:=1;
  ch:='f';
  repeat
    while (i <= len) and (command.line.buffer^[i] <> '/') do
      i:=i+1;
    if i<len
      then begin
        ch:=command.line.buffer^[i+1]; 
        i:=i+1;
      end;
  until i > len;
      (* find beginning of file name *)
  i:=len;
  while (I > 2) and (command.line.buffer^[i-1] <> ' ' ) do i:=i-1;
      (*copy file name *)
  for j:=1 to 64 do
    currentfile^.spec[j]:=' ';
  for j:=i to len do
    currentfile^.spec[j-i+1]:=command.line.buffer^[j];
End; 



Procedure InitTermSpecs;
Begin
  case ch of
      'h','H' : begin
                  ftnchar:=chr(ESC);
                  up:='A';                         down:='B';
                  left:='D';                       right:='C';
                  home:='h';
                  clearline:='K';                  clearpage:='J';
                  screensize:=24;                  screenwidth:=79;
                  terminal:=hp;
                end;
      'Z','z' : begin
                  ftnchar:=chr(ESC);
                  up:='A';                         down:='B';
                  left:='D';                       right:='C';
                  home:='H';
                  clearline:='K';                  clearpage:='J';
                  screensize:=24;                  screenwidth:=80;
                  terminal:=zenith;
                end;
      'T','t' : begin
                  ftnchar:=chr(ESC);
                  up:=chr(1);                      down:=chr(2);
                  left:=chr(4);                    right:=chr(%X14);
                  home:=chr(BS);
                  clearline:=chr(%XB);             clearpage:=chr(LF);
                  screensize:=25;                  screenwidth:=80;
                  terminal:=tec;
                end;
      'D','d' : begin
                  ftnchar:=chr(SO);
                  home:='Q';
                  clearline:='U';                  clearpage:='S';
                  screensize:=27;                  screenwidth:=80;
                  terminal:=ddt;
                end;
      'B','b' : begin
                  ftnchar:=chr(ESC);
                  up:='A';                         down:='B';
                  left:='D';                       right:='C';
                  home:='H';
                  clearline:='I';
                  screensize:=24;                  screenwidth:=80;
                  terminal:=bantom;
                end;
      'V','v' : begin
                  ftnchar:=chr(ESC);
                  up:='A';                         down:='B';
                  left:='D';                       right:='C';
                  home:='H';
                  clearline:='K';                  clearpage:='J';
                  screensize:=24;                  screenwidth:=80;
                  terminal:=vt;
                end;
      otherwise begin
                  ftnchar:=chr(ESC);
                  up:='A';                         down:='B';
                  left:='D';                       right:='C';
                  home:='H';
                  clearline:='I';                  clearpage:='J';
                  screensize:=24;                  screenwidth:=80;
                  terminal:=fox;
                end;
    end;
End;


Begin   (* Initialize *)
  bufferindex:=1;
  new(currentfile);
  init;
  command;
  InitTermSpecs;
  maintext:=nil;
  nodeavail:=nil;
  entryavail:=nil;
  itemavail:=nil;
  textavail:=nil;
  nameavail:=nil;
  lastcommand.first.seg:=nil;
  lastdel.first.seg:=nil;
  lastdel.last.seg:=nil;
  for i:=1 to maxnamesize do
    emptyname[i]:=' ';
  refill:=true;
  ReadInFile(currentfile,currentfile^.spec,done,true);
  if not done then goto 999;
  currentfile^.next:=currentfile;
  i:=1;
  while not (currentfile^.spec[i] in [']','>',' ']) do
    i:=i + 1;
  if currentfile^.spec[i] <> ' '
    then i:=i + 1
    else i:=1;
  l:=1;
  while currentfile^.spec[i] <> '.' do
    begin
      currentfile^.name[l]:=currentfile^.spec[i];
      i:=i + 1;
      l:=l + 1;
    end;
  for i:=l to maxnamesize do
    currentfile^.name[i]:=' ';
  oldtext.lines:=-1;
  oldtext.btext:=btext^.location;
  {SET UP DISPLAY HERE}
  falsescreensize:=3;
  slash.seg:=nil;
  edge:=0;
  findlocation(curse^.location^,l,c);
  cursor.actual:=c;
  if c >= screenwidth
    then begin
      edge:=c - screenwidth + 5;
      c:=screenwidth - 5;
    end;
  lines:=0;
  chars:=-edge;
  buffer[bufferindex]:=ftnchar;
  buffer[bufferindex+1]:=home;
  bufferindex:=bufferindex + 2;
  if terminal = hp
    then begin
      buffer[bufferindex]:=ftnchar;
      buffer[bufferindex+1]:='R';
      bufferindex:=bufferindex + 2;
    end;
  dumpbuffer;
  dumplines(screensize,window^.location^,lines,chars,true);
  movecursor(l,c);
End;



Procedure Compile(starting,ending : stickypointer);
Label 99,100;
Const errormax = 23;
      ExeErrorMax = 15;
Type  ErrorType = 0..ErrorMax;
      ExeErrorType = 1..ExeErrorMax;
Var   id,nextid,fileid,nextfileid : alfa;
      integervalue : integer;
      charstring : object;
      ch : char;
      p,s : entry;
      macroptr,oldmacroptr : stickypointer;
      temp : nextitem;
      rightedge,firstchar,match : boolean;
      symbol,nextsymbol,tempsymbol : symbols;   (* Contain symbols returned by lexical analyzer *)


Procedure Error(err : errortype);
Var  c,i : integer;
     buf : packed array [1..50] of char;
Begin
  refill:=false;
  findchars(oldmacroptr,c);
  movesticky(oldmacroptr,0,-3000);
  lines:=screensize-falsescreensize-1;
  chars:=0;
  dumplines(1,oldmacroptr,lines,chars,true);
  movecursor(cursor.lines+1,0);
  for i:=1 to c - 1 do
    buffer[bufferindex+i-1]:=' ';
  buffer[bufferindex+c-1]:='^';
  buffer[bufferindex+c]:=chr(CR);
  buffer[bufferindex+c+1]:=chr(LF);
  bufferindex:=bufferindex + c + 2;
  case err of
    0: buf:='Semicolon Expected                                ';
    1: buf:='IF Expected                                       ';
    2: buf:='Colon Expected                                    ';
    3: buf:='EXIT Expected                                     ';
    4: buf:='END Expected                                      ';
    5: buf:='Identifier Expected                               ';
    6: buf:='Comma Expected                                    ';
    7: buf:='Left Parenthesis Expected                         ';
    8: buf:='Right Parenthesis Expected                        ';
    9: buf:='Integer or Identifier Expected                    ';
   10: buf:='Pointer Variables Can Not Be Added Together       ';
   11: buf:='Illegal Character Expression                      ';
   12: buf:='Type Expected                                     ';
   13: buf:='Boolean Operator Expected                         ';
   14: buf:='Illegal Symbol Beginning Test                     ';
   15: buf:='Illegal Pointer Expression                        ';
   16: buf:='Illegal File Specification                        ';
   17: buf:='Bar Expected                                      ';
   18: buf:='Identifier or File Specification Expected         ';
   19: buf:='Integer Is Too Large.  Max Integer = 2147483647   ';
   20: buf:='Missing Delimiting Quote                          ';
   21: buf:='Illegal Symbol                                    ';
   22: buf:='Illegal Starting Symbol For A Statement           ';
   23: buf:='Reference identifier is needed for specified file ';
  end;
  for i:=1 to 50 do
    buffer[bufferindex+i-1]:=buf[i];
  buffer[bufferindex+50]:=chr(CR);
  buffer[bufferindex+51]:=chr(LF);
  bufferindex:=bufferindex + 52;
  dumpbuffer;
  cursor.lines:=cursor.lines + 2;
  goto 100;
End;



Procedure Getsym;
Const NoMore = 0;
Var   count,i,j : integer;
      endofquote : boolean;
      temp : stickypointer;
      textstring : ptr;
      obj : object;

Procedure Getchar;
Begin
  if firstchar
    then firstchar:=false
    else moveforward(macroptr,rightedge);
  if rightedge or greater(ending,macroptr)
    then ch:=chr(NoMore)
    else ch:=getch(macroptr);
End;


Begin           (* Getsym *)
  oldmacroptr:=macroptr;
  while (ch = ' ') or (ch = chr(EOL)) do
    getchar;
  id:=nextid;
  fileid:=nextfileid;
  if ch in ['A'..'Z','a'..'z']
    then begin
      nextid:=emptyname;
      nextfileid:=emptyname;
      count:=0;
      repeat
        if count < maxnamesize
          then begin
            if ch in ['a'..'z']
              then ch:=chr(ord(ch) - 32);
            count:=count + 1;
            nextid[count]:=ch;
          end;
        getchar;
      until not (ch in ['A'..'Z','a'..'z','0'..'9','_','$']);
      if ch = '.'
        then begin
          nextfileid:=nextid;
          nextid:=emptyname;
          getchar;
          if not (ch in ['A'..'Z','a'..'z'])
            then error(5);
          count:=0;
          repeat
            if count < maxnamesize
              then begin
                if ch in ['a'..'z']
                  then ch:=chr(ord(ch) - 32);
                count:=count + 1;
                nextid[count]:=ch;
              end;
            getchar;
          until not (ch in ['A'..'Z','a'..'z','0'..'9','_','$']);
        end;
      p:=lookup(nextid,nextfileid);
      if p = nil
        then symbol:=identsym
        else if p^.tipe = reserved
          then symbol:=p^.symbolvalue
          else symbol:=identsym;
    end
    else case ch of
'0','1','2',
'3','4','5',
'6','7','8',
     '9' : begin
             symbol:=intsym;
             integervalue:=0;
             repeat
               integervalue:=10*integervalue + (ord(ch) - ord('0'));
               getchar;
             until (not (ch in ['0'..'9'])) or (integervalue >= maxinteger/10);
             if ch in ['0'..'9']
               then error(19);
           end;
    '''' : begin
             getchar;
             symbol:=quote;
             endofquote:=false;
             starttext;
             repeat
               if ch = ''''
                 then begin
                   getchar;
                   if ch = ''''
                     then begin
                       getchar;
                       addchar('''');
                     end
                     else begin
                       endofquote:=true;
                       if ch = chr(NoMore)
                         then ch:=' ';
                     end;
                 end
                 else begin
                   addchar(getch(macroptr));
                   getchar;
                 end;
             until endofquote or (ch = chr(NoMore));
             if ch = (chr(NoMore))
               then error(20)
               else finishtext(charstring);
           end;
     ',' : begin
             symbol:=comma;
             getchar;
           end;
     ';' : begin
             symbol:=semicolon;
             getchar;
           end;
     ':' : begin
             symbol:=colon;
             getchar;
           end;
     '|' : begin
             symbol:=bar;
             getchar;
           end;
     '+' : begin
             symbol:=plussym;
             getchar;
           end;
     '-' : begin
             symbol:=minussym;
             getchar;
           end;
     '=' : begin
             symbol:=equal;
             getchar;
           end;
     '!' : begin
             symbol:=firstsym;
             getchar;
           end;
     '"' : begin
             symbol:=lastsym;
             getchar;
           end;
     '<' : begin
             getchar;
             if ch = '='
               then begin
                 symbol:=lessorequal;
                 getchar;
               end
               else if ch = '>'
                 then begin
                   symbol:=notequal;
                   getchar;
                 end
                 else symbol:=lessthan;
           end;
     '>' : begin
             getchar;
             if ch = '='
               then begin
                 symbol:=gtrorequal;
                 getchar;
               end
               else symbol:=gtrthan;
           end;
     '(' : begin
             symbol:=leftparen;
             getchar;
           end;
     ')' : begin
             symbol:=rightparen;
             getchar;
           end;
 otherwise begin
             if ch = chr(NoMore)
               then symbol:=EndOfString
               else error(21);
           end;
    end;
  tempsymbol:=nextsymbol;
  nextsymbol:=symbol;
  symbol:=tempsymbol;
End;



Function Pointer : NextItem;
Var  index : NextItem;
Begin
  newitem(index);
  Pointer:=index;
  index^.nonterm:=PtrNt;
  if symbol = identsym
    then begin
      newitem(index^.son);
      index:=index^.son;
      index^.nonterm:=identNt;
      index^.name:=id;
      index^.filename:=fileid;
      getsym;
    end
    else if not (symbol in [firstsym,lastsym])
      then error(15)
      else begin
        newitem(index^.son);
        index:=index^.son;
        if symbol = firstsym
          then index^.nonterm:=FirstNT
          else index^.nonterm:=LastNT;
        getsym;
        if symbol <> identsym
          then error(5)
          else begin
            index^.name:=id;
            index^.filename:=fileid;
            getsym;
          end;
      end;
End;



Function String1 : NextItem;
Var  index : NextItem;
Begin
  newitem(index);
  String1:=index;
  index^.nonterm:=StringNT;
  if (not (symbol in [firstsym,lastsym])) and (nextsymbol <> bar)
    then begin
      newitem(index^.son);
      index:=index^.son;
      index^.nonterm:=identNT;
      index^.name:=id;
      index^.filename:=fileid;
      getsym;
    end
    else begin
      index^.son:=Pointer;
      index:=index^.son;
      if symbol <> bar
        then error(17)
        else begin
          getsym;
          index^.brother:=Pointer;
          index:=index^.brother;
        end;
    end;
End;


Function String2 : NextItem;
Var  index : NextItem;
Begin
  if symbol = quote
    then begin
      newitem(index);
      String2:=index;
      index^.nonterm:=StringNT;
      newitem(index^.son);
      index:=index^.son;
      index^.nonterm:=CharStringNT;
      index^.location:=CharString;
      getsym;
    end
    else String2:=String1;
End;


Function Term(allowptrs : boolean) : NextItem;
Var  index : NextItem;
Begin
  newitem(index);
  Term:=index;
  if symbol in [intsym,identsym]
    then begin
      if symbol = intsym
        then begin
          index^.nonterm:=IntNT;
          index^.intvalue:=integervalue;
        end
        else begin
          index^.nonterm:=IdentNT;
          index^.name:=id;
          index^.filename:=fileid;
        end;
      getsym;
    end
    else if allowptrs
      then begin
        index:=pointer;
        index:=index^.son;
        if symbol in [plussym..minussym]
          then error(10);
      end
      else error(9);
End;


Function CharExp : NextItem;  Forward;


Function IntegerExp(allowptrs : boolean) : NextItem;
Var  index : NextItem;
Begin
  newitem(index);
  IntegerExp:=index;
  index^.nonterm:=IntExpNT;
  if symbol = ordsym
    then begin
      getsym;
      if symbol <> leftparen
        then error(7)
        else begin
          getsym;
          newitem(index^.son);
          index^.nonterm:=OrdNT;
          index^.brother:=CharExp;
          index:=index^.brother;
          if symbol <> rightparen
            then error(8)
            else getsym;
        end;
    end
    else begin
      index^.son:=Term(allowptrs);
      index:=index^.son;
      while symbol in [PlusSym,MinusSym] do
        begin
          newitem(index^.brother);
          index:=index^.brother;
          index^.nonterm:=IntOpNT;
          index^.intop:=symbol;
          getsym;
          index^.brother:=Term(allowptrs);
          index:=index^.brother;
        end;
    end;
End;



Function CharExp{ : NextItem};
Var  Index : NextItem;
Begin
  newitem(index);
  charexp:=index;
  index^.nonterm:=CharExpNT;
  newitem(index^.son);
  index:=index^.son;
  if symbol = charsym
    then begin
      getsym;
      index^.nonterm:=CharNT;
      if symbol <> leftparen
        then error(7)
        else begin
          getsym;
          index^.brother:=integerexp(false);
          index:=index^.brother;
          if symbol <> rightparen
            then error(8)
            else getsym;
        end;
    end
    else if symbol = getchsym
      then begin
        getsym;
        index^.nonterm:=GetNT;
        if symbol <> leftparen
          then error(7)
          else begin
            getsym;
            index^.brother:=Pointer;
            index:=index^.brother;
            if symbol <> rightparen
              then error(8)
              else getsym;
          end;
      end
      else if symbol = quote
        then begin
          index^.nonterm:=ChNT;
          index^.chvalue:=getch(charstring.first);
          getsym;
        end
        else if symbol <> identsym
          then error(11)
          else begin
            index^.nonterm:=IdentNT;
            index^.name:=id;
            index^.filename:=fileid;
            getsym;
          end;
End;


Function StmtList(Terminators : symbolset) : NextItem;  forward;
Function Stmt : NextItem;  forward;


Function Test : NextItem;
Var  Index : NextItem;
Begin
  newitem(index);
  Test:=index;
  index^.nonterm:=TestNT;
  if symbol in [truesym,falsesym]
    then begin
      newitem(index^.son);
      index:=index^.son;
      index^.nonterm:=BoolNT;
      if symbol = truesym
        then index^.boolvalue:=true
        else index^.boolvalue:=false;
      getsym;
    end
    else if symbol = leftparen
      then begin
        getsym;
        index^.son:=test;
        index:=index^.son;
        if symbol <> rightparen
          then error(8)
          else begin
            getsym;
            if symbol in [andsym,orsym]
              then begin
                newitem(index^.brother);
                index:=index^.brother;
                index^.nonterm:=LogicOpNT;
                index^.logicop:=symbol;
                getsym;
                if symbol <> leftparen
                  then error(7)
                  else begin
                    getsym;
                    index^.brother:=Test;
                    index:=index^.brother;
                    if symbol <> rightparen 
                      then error(8)
                      else getsym;
                  end;
              end;
          end;
      end
      else if symbol = notsym
        then begin
          getsym;
          newitem(index^.son);
          index:=index^.son;
          index^.nonterm:=NotNT;
          if symbol <> leftparen
            then error(7)
            else begin
              getsym;
              index^.brother:=Test;
              index:=index^.brother;
              if symbol <> rightparen
                then error(8)
                else getsym;
            end;
        end
        else if symbol in [identsym,intsym,ordsym]
          then if (nextsymbol = issym) and (symbol = identsym)
            then begin
              newitem(index^.son);
              index:=index^.son;
              index^.nonterm:=identNT;
              index^.name:=id;
              index^.filename:=fileid;
              getsym;
              getsym;
              newitem(index^.brother);
              index:=index^.brother;
              index^.nonterm:=IsNT;
              if not (symbol in [IntegerSym..StringSym])
                then error(12)
                else begin
                  newitem(index^.brother);
                  index:=index^.brother;
                  index^.nonterm:=TypeNT;
                  index^.tipe:=symbol;
                  getsym;
                end;
            end
            else if (nextsymbol in [lessthan..gtrthan,PlusSym,MinusSym]) or
                    (symbol = ordsym)
              then begin
                index^.son:=IntegerExp(true);
                index:=index^.son;
                if not (symbol in [lessthan..gtrthan])
                  then error(13)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=BoolOpNT;
                    index^.boolop:=symbol;
                    getsym;
                    index^.brother:=IntegerExp(true);
                    index:=index^.brother;
                  end
              end
              else begin
                index^.son:=Term(false);
                index:=index^.son;
              end
          else if symbol = search
            then begin
              index^.son:=stmt;
              index:=index^.son;
            end
            else if symbol = EmptySym
              then begin
                newitem(index^.son);
                index:=index^.son;
                index^.nonterm:=EmptyNT;
                getsym;
                if symbol <> leftparen
                  then error(7)
                  else begin
                    getsym;
                    if symbol <> identsym
                      then error(5)
                      else begin
                        newitem(index^.brother);
                        index:=index^.brother;
                        index^.nonterm:=identNT;
                        index^.name:=id;
                        index^.filename:=fileid;
                        getsym;
                        if symbol <> rightparen
                          then error(8)
                          else getsym;
                      end;
                  end;
              end
              else error(14);
End;



Function Stmt{ : NextItem};
Var  index : NextItem;
Begin
  newitem(index);
  Stmt:=index;
  Case symbol of 
     Casesym: Begin
                index^.nonterm:=CaseNT;
                getsym;
                while symbol <> endsym do
                  begin
                    if symbol <> ifsym
                      then error(1)
                      else begin
                        getsym;
                        index^.brother:=Test;
                        index:=index^.brother;
                        if symbol <> colon
                          then error(2)
                          else begin
                            getsym;
                            index^.brother:=StmtList([ifsym,endsym]);
                            while index^.brother <> nil do
                              index:=index^.brother;
                          end;
                      end;
                  end;
                getsym;
              End;
     Loopsym: Begin
                getsym;
                index^.nonterm:=LoopNT;
                index^.brother:=StmtList([whensym,endsym]);
                while index^.brother <> nil do
                  index:=index^.brother;
                while symbol = whensym do
                  begin
                    getsym;
                    index^.brother:=Test;
                    index:=index^.brother;
                    if symbol = dosym
                      then begin
                        getsym;
                        index^.brother:=StmtList([exitsym]);
                        while index^.brother <> nil do
                          index:=index^.brother;
                      end;
                    if symbol <> exitsym
                      then error(3)
                      else begin
                        newitem(index^.brother);
                        index:=index^.brother;
                        index^.nonterm:=ExitNT;
                        getsym;
                        index^.brother:=StmtList([whensym,endsym]);
                        while index^.brother <> nil do
                          index:=index^.brother;
                      end;
                  end;
                if symbol <> endsym
                  then error(4)
                  else getsym;
              End;
     NamePtr: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=nameptr;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol = comma
                      then begin
                        getsym;
                        index^.brother:=Pointer;
                      end;
                  end;
              End;
  NameString: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=NameString;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        index^.brother:=String2;
                      end;
                  end;
              End;
     NameInt: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=NameInt;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        index^.brother:=IntegerExp(false);
                      end;
                  end;
              End;
      NameCh: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=NameCh;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        index^.brother:=CharExp;
                      end;
                  end;
              End;
    NameBool: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=NameBool;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        index^.brother:=Test;
                      end;
                  end;
              End;
 CreateStack: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=CreateStack;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.filename:=fileid;
                    index^.name:=id;
                    getsym;
                  end;
              End;
         Top: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Top;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        if symbol <> identsym
                          then error(5)
                          else begin
                            newitem(index^.brother);
                            index:=index^.brother;
                            index^.nonterm:=IdentNT;
                            index^.name:=id;
                            index^.filename:=fileid;
                            getsym;
                          end;
                      end;
                  end;
              End;
         Pop: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Pop;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        if symbol <> identsym
                          then error(5)
                          else begin
                            newitem(index^.brother);
                            index:=index^.brother;
                            index^.nonterm:=IdentNT;
                            index^.name:=id;
                            index^.filename:=fileid;
                            getsym;
                          end;
                      end;
                  end;
              End;
        Push: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Push;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                    if symbol <> comma
                      then error(6)
                      else begin
                        getsym;
                        if symbol <> identsym
                          then error(5)
                          else begin
                            newitem(index^.brother);
                            index:=index^.brother;
                            index^.nonterm:=IdentNT;
                            index^.name:=id;
                            index^.filename:=fileid;
                            getsym;
                          end;
                      end;
                  end;
              End;
       MoveC: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=MoveC;
                index^.brother:=Pointer;
              End;
        Move: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Move;
                index^.brother:=Pointer;
                if symbol <> comma
                  then error(6)
                  else begin
                    index:=index^.brother;
                    getsym;
                    index^.brother:=IntegerExp(false);
                  end;
              End;
     DelName: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=DelName;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.name:=id;
                    index^.filename:=fileid;
                    getsym;
                  end;
              End;
      Delete: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Delete;
                index^.brother:=String1;
              End;
    UnDelete: Begin
                index^.nonterm:=ActionNT;
                index^.action:=UnDelete;
                getsym;
              End;
        Copy: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Copy;
                index^.brother:=String2;
                if symbol = comma
                  then begin
                    index:=index^.brother;
                    getsym;
                    index^.brother:=Pointer;
                  end;
              End;
      Change: Begin
                index^.nonterm:=ActionNT;
                index^.action:=Change;
                getsym;
                index^.brother:=String2;
                if symbol <> comma
                  then error(6)
                  else begin
                    index:=index^.brother;
                    getsym;
                    index^.brother:=String2;
                    if symbol = comma
                      then begin
                        index:=index^.brother;
                        getsym;
                        index^.brother:=String2;
                      end;
                  end;
              End;
     Replace: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Replace;
                index^.brother:=String1;
                if symbol <> comma
                  then error(6)
                  else begin
                    index:=index^.brother;
                    getsym;
                    index^.brother:=String2;
                  end;
              End;
         Run: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Run;
                index^.brother:=String2;
              End;
      Search: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Search;
                if symbol in [identsym,quote,firstsym,lastsym]
                  then begin
                    index^.brother:=String2;
                    if symbol = comma
                      then begin
                        index:=index^.brother;
                        getsym;
                        index^.brother:=String1;
                        if symbol = comma
                          then begin
                            index:=index^.brother;
                            getsym;
                            index^.brother:=Pointer;
                            if symbol = bar
                              then begin
                                index:=index^.brother;
                                getsym;
                                index^.brother:=Pointer;
                              end;
                          end;
                      end;
                  end;
              End;
   ListNames: Begin
                index^.nonterm:=ActionNT;
                index^.action:=ListNames;
                getsym;
                if symbol = Identsym
                  then begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.filename:=id;
                    getsym;
                  end;
              End;
   ListFiles: Begin
                index^.nonterm:=ActionNT;
                index^.action:=ListFiles;
                getsym;
              End;
        Edit: Begin
                index^.nonterm:=ActionNT;
                index^.action:=Edit;
                getsym;
                if symbol <> identsym
                  then error(5)
                  else index^.brother:=String1;
              End;
      Return: Begin
                index^.nonterm:=ActionNT;
                index^.action:=Return;
                getsym;
              End;
        Save: Begin
                index^.nonterm:=ActionNT;
                index^.action:=Save;
                getsym;
                if symbol = Identsym
                  then begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.filename:=id;
                    getsym;
                  end;
              End;
    ExitSave: Begin
                index^.nonterm:=ActionNT;
                index^.action:=ExitSave;
                getsym;
              End;
        Quit: Begin
                index^.nonterm:=ActionNT;
                index^.action:=Quit;
                getsym;
              End;
       Visit: Begin
                getsym;
                index^.nonterm:=ActionNT;
                index^.action:=Visit;
                if symbol <> identsym
                  then error(5)
                  else begin
                    newitem(index^.brother);
                    index:=index^.brother;
                    index^.nonterm:=IdentNT;
                    index^.filename:=id;
                    getsym;
                  end;
              End;
   InputFile: Begin
                index^.nonterm:=ActionNT;
                index^.action:=InputFile;
                getsym;
                index^.brother:=String2;
                if symbol <> Comma
                  then error(23)
                  else begin
                    getsym;
                    if symbol = IdentSym
                      then begin
                        index:=index^.brother;
                        newitem(index^.brother);
                        index:=index^.brother;
                        index^.nonterm:=IdentNT;
                        index^.filename:=id;
                        getsym;
                      end
                      else error(23);
                  end;
              End;
   AddMacros: Begin
                index^.nonterm:=ActionNT;
                index^.action:=AddMacros;
                getsym;
                index^.brother:=String2;
                if symbol <> Comma
                  then error(23)
                  else begin
                    getsym;
                    if symbol = IdentSym
                      then begin
                        index:=index^.brother;
                        newitem(index^.brother);
                        index:=index^.brother;
                        index^.nonterm:=IdentNT;
                        index^.filename:=id;
                        getsym;
                      end
                      else error(23);
                  end;
              End;
   Otherwise  error(22);
  end;
End;


Function StmtList(*(Terminators : symbolset) : NextItem*);
Var  Item1,Item2 : NextItem;
Begin
  StmtList:=nil;
  item1:=nil;
  while not (symbol in terminators) do
    if not (symbol in [semicolon,loopsym,casesym,nameptr..quit])
      then error(0)
      else begin
        while symbol = semicolon do
          getsym;
        if not (symbol in terminators) 
          then begin
            newitem(item2);
            if item1 = nil
              then StmtList:=item2
              else item1^.brother:=item2;
            item2^.son:=Stmt;
            item2^.nonterm:=StmtNT;
            item1:=item2;
          end;
      end;
End;


Procedure ExeError(err : ExeErrorType; name : alfa);
Var  buf : packed array[1..52] of char;
     i,j : integer;
Begin
  refill:=false;
  movecursor(screensize-falsescreensize-1,0);
  case err of
    1: buf:='The identifier, ^, does not exist                   ';
    2: buf:='The identifier, ^, was not a pointer                ';
    3: buf:='The identifier, ^, was not a string                 ';
    4: buf:='The identifier, ^, was not an integer               ';
    5: buf:='The identifier, ^, was not a character              ';
    6: buf:='The identifier, ^, was not a boolean                ';
    7: buf:='First pointer must be positioned before second      ';
    8: buf:='Only command language macros can be edited          ';
    9: buf:='The file, ^, does not exist in core                 ';
   10: buf:='Can not visit the file you are currently visiting   ';
   11: buf:='Some error in opening the file, ^                   ';
   12: buf:='Pointers delimiting strings must be in the same text';
   13: buf:='The identifier, ^, was not a stack                  ';
   14: buf:='The stack, ^, is empty                              ';
   15: buf:='The file, ^, is a macro file, not a text file       ';
  end;
  for i:=1 to 52 do
    if buf[i] <> '^'
      then buffer[bufferindex+i-1]:=buf[i]
      else begin
        for j:=1 to maxnamesize do
          buffer[bufferindex+i+j-2]:=name[j];
        bufferindex:=bufferindex + maxnamesize - 1;
      end;
  buffer[bufferindex+52]:=chr(CR);
  bufferindex:=bufferindex + 53;
  dumpbuffer;
  goto 99;
End;


Function ExePointer(B : NextItem) : Sticky;
Var  Ptr : Entry;
Begin
  Ptr:=Lookup(b^.name,b^.filename);
  if b^.name = 'CURSOR    '
    then adjustcursor:=true;
  if ptr = nil
    then Exeerror(1,b^.name)
    else if b^.nonterm = identNT
      then if ptr^.tipe <> PtrType
        then Exeerror(2,b^.name)
        else exepointer:=ptr^.location
      else if ptr^.tipe <> StringType
        then Exeerror(3,b^.name)
        else if b^.nonterm = firstNT
          then exepointer:=ptr^.first
          else exepointer:=ptr^.last;
End;


Procedure ExeString(B : NextItem; Var F,L : Sticky);
Var  Ptr : Entry;
     temp : sticky;
Begin
  if b^.nonterm = CharStringNT
    then begin
      new(f);   new(l);
      f^:=b^.location.first;
      l^:=b^.location.last;
    end
    else if b^.nonterm = identNT
      then begin
        ptr:=lookup(b^.name,b^.filename);
        if ptr = nil
          then Exeerror(1,b^.name)
          else if ptr^.tipe <> StringType
            then Exeerror(3,b^.name)
            else begin
              f:=ptr^.first;
              l:=ptr^.last;
              if not greater(f^,l^)
                then if not greater(l^,f^)
                  then exeerror(12,emptyname)
                  else begin
                    temp:=f;
                    f:=l;
                    l:=temp;
                  end;
            end;
      end
      else begin
        f:=exepointer(b^.son);
        l:=exepointer(b^.brother^.son);
        if not greater(f^,l^)
          then if not greater(l^,f^)
            then exeerror(12,emptyname)
            else begin
              temp:=f;
              f:=l;
              l:=temp;
            end;
      end;
End;


Function ExeCharExp(B : NextItem) : char;  forward;


Function ExeIntegerExp(B : NextItem) : Integer;
Var  count,temp : integer;
     add : boolean;
     ptr : entry;
Begin
  count:=0;
  add:=true;
  repeat
    if b^.nonterm = ordNT
      then temp:=ord(ExeCharExp(b^.brother^.son))
      else if b^.nonterm = intNT
        then temp:=b^.intvalue
        else begin
          ptr:=lookup(b^.name,b^.filename);
          if ptr = nil
            then Exeerror(1,b^.name)
            else if ptr^.tipe <> IntType
              then Exeerror(4,b^.name)
              else temp:=ptr^.intvalue;
        end;
    if add
      then count:=count + temp
      else count:=count - temp;
    b:=b^.brother;
    if b <> nil
      then begin
        if b^.intop = plussym
          then add:=true
          else add:=false;
        b:=b^.brother;
      end;
  until b = nil;
  exeintegerexp:=count;
End;


Function ExeCharExp{(B : NextItem) : char};
Var  ptr : Entry;
     t : sticky;
Begin
  if b^.nonterm = CharNT
    then execharexp:=chr(exeintegerexp(b^.brother^.son))
    else if b^.nonterm = GetNT
      then begin
        t:=exepointer(b^.brother^.son);
        execharexp:=getch(t^);
      end
      else if b^.nonterm = ChNT
        then execharexp:=b^.chvalue
        else begin
          ptr:=lookup(b^.name,b^.filename);
          if ptr = nil 
            then Exeerror(1,b^.name)
            else if ptr^.tipe <> CharType
              then Exeerror(5,b^.name)
              else execharexp:=ptr^.charvalue;
        end;
End;


Procedure ExeStmt(B : NextItem);   forward;


Function ExeTest(B : NextItem) : Boolean;
Var  ptr : Entry;
     compareptr : boolean;
     p1,p2 : sticky;
Begin
  if b^.nonterm = BoolNT
    then exetest:=b^.boolvalue
    else if b^.nonterm = NotNT
      then exetest:=not (exetest(b^.brother^.son))
      else if b^.nonterm = IdentNT
        then begin
          ptr:=lookup(b^.name,b^.filename);
          if ptr = nil
            then Exeerror(1,b^.name)
            else if b^.brother = nil
              then if ptr^.tipe = IntType
                then begin
                  ptr^.intvalue:=ptr^.intvalue - 1;
                  if ptr^.intvalue <= 0
                    then exetest:=true
                    else exetest:=false;
                end
                else if ptr^.tipe <> BoolType
                  then Exeerror(6,b^.name)
                  else exetest:=ptr^.boolvalue
              else if ord(ptr^.tipe) = ord(b^.brother^.tipe)
                then exetest:=true
                else exetest:=false;
        end
        else if b^.nonterm = IntNT
          then begin
            b^.intvalue:=b^.intvalue - 1;
            if b^.intvalue <= 0
              then exetest:=true
              else exetest:=false;
          end
          else if b^.nonterm = testNT
            then if b^.brother^.logicop = andsym
              then exetest:=exetest(b^.son) and
                   exetest(b^.brother^.brother^.son)
              else exetest:=exetest(b^.son) or
                   exetest(b^.brother^.brother^.son)
            else if b^.nonterm = actionNT
              then begin
                exestmt(b);
                exetest:=match;
              end
              else if b^.nonterm = EmptyNT
                then begin
                  ptr:=lookup(b^.brother^.name,b^.brother^.filename);
                  if ptr = nil
                    then ExeError(1,b^.brother^.name)
                    else if ptr^.tipe <> stacktype
                      then ExeError(13,b^.brother^.name)
                      else exetest:= ptr^.top = nil;
                end
                else begin
                  compareptr:=false;
                  if b^.son^.nonterm in [identNT,firstNT,lastNT]
                    then begin
                      ptr:=lookup(b^.son^.name,b^.son^.filename);
                      if ptr = nil
                        then exeerror(7,b^.son^.name)
                        else if ptr^.tipe <> inttype
                          then compareptr:=true;
                    end;
                  if not compareptr
                    then case b^.brother^.boolop of
                      lessthan: exetest:=exeintegerexp(b^.son) <
                                       exeintegerexp(b^.brother^.brother^.son);
                   lessorequal: exetest:=exeintegerexp(b^.son) <=
                                       exeintegerexp(b^.brother^.brother^.son);
                         equal: exetest:=exeintegerexp(b^.son) =
                                       exeintegerexp(b^.brother^.brother^.son);
                      notequal: exetest:=exeintegerexp(b^.son) <>
                                       exeintegerexp(b^.brother^.brother^.son);
                    gtrorequal: exetest:=exeintegerexp(b^.son) >=
                                       exeintegerexp(b^.brother^.brother^.son);
                       gtrthan: exetest:=exeintegerexp(b^.son) >
                                       exeintegerexp(b^.brother^.brother^.son);
                         end
                    else begin
                      if b^.brother^.nonterm <> BoolOpNT
                        then exeerror(4,b^.name)
                        else begin
                          p1:=exepointer(b^.son);
                          p2:=exepointer(b^.brother^.brother^.son);
                          case b^.brother^.boolop of
                            lessthan: exetest:=not (greater(p2^,p1^));
                         lessorequal: exetest:=greater(p1^,p2^);
                               equal: exetest:=greater(p1^,p2^) and
                                               greater(p2^,p1^);
                            notequal: exetest:=not (greater(p1^,p2^) and
                                                    greater(p2^,p1^));
                          gtrorequal: exetest:=greater(p2^,p1^);
                             gtrthan: exetest:=not (greater(p1^,p2^));
                          end;
                        end;
                    end;
                end;
End;


Procedure ExeStmtList(Var B : NextItem);  forward;


Procedure ExeStmt{B : NextItem};
Var  s1,s2,s3,s4,s5,s6 : sticky;
     dummy,t1,t2 : stickypointer;
     ptr,ptr1 : entry;
     done,rightedge : boolean;
     start : nextitem;
     count,templines,tempchars,i : integer;
     tempname : nextname;
     header : nextfile;
     dummyname : alfa;
     newfilename : filename;
     elem,e : entry;
     
     
Procedure CopyStack(start,target : entry);
Begin
  if start^.top = nil
    then target^.top:=nil
    else begin
      newentry(target^.top);
      target:=target^.top;
      start:=start^.top;
      while start <> nil do
        begin
          target^.tipe:=start^.tipe;
          case target^.tipe of
            CharType,IntType,
                   BoolType: target^.intvalue:=start^.intvalue;
                    PtrType: Begin
                               new(target^.location);
                               target^.location^:=start^.location^;
                             End;
                 StringType: Begin
                               new(target^.first);
                               new(target^.last);
                               target^.first^:=start^.first^;
                               target^.last^:=start^.last^;
                             End;
                  StackType: copystack(start,target);
          end;
          start:=start^.next;
          if start <> nil
            then begin
              newentry(target^.next);
              target:=target^.next;
            end;
        end;
    end;
End;


      
Begin
  Case B^.nonterm of
    CaseNT: Begin
              done:=false;
              while not done do
                begin
                  b:=b^.brother;
                  if b = nil
                    then done:=true
                    else if ExeTest(b^.son)
                      then begin
                        b:=b^.brother;
                        ExeStmtList(b);
                        done:=true;
                      end
                      else while (b^.brother <> nil) and
                                 (b^.brother^.nonterm <> TestNT) do
                        b:=b^.brother;
                end;
            End;
    LoopNT: Begin
              done:=false;
              start:=b;
              while not done do
                begin
                  b:=start^.brother;
                  ExeStmtList(b);
                  while (b <> nil) and not done do
                    begin
                      if ExeTest(b^.son)
                        then begin
                          b:=b^.brother;
                          ExeStmtList(b);
                          done:=true;
                        end
                        else begin
                          while b^.nonterm <> ExitNT do
                            b:=b^.brother;
                          b:=b^.brother;
                          ExeStmtList(b);
                        end;
                    end;
                end;
            End;
 ActionNT : case b^.action of
        NamePtr: Begin
                   newentry(ptr);
                   b:=b^.brother;
                   ptr^.name:=b^.name;
                   header:=findfile(b^.filename);
                   if header = nil
                     then exeerror(9,b^.filename);
                   ptr^.tipe:=PtrType;
                   new(ptr^.location);
                   if b^.brother = nil
                     then ptr^.location^:=curse^.location^
                     else begin
                       b:=b^.brother;
                       s1:=ExePointer(b^.son);
                       if (ptr^.name  <> 'CURSOR    ') or
                          ((ptr^.name = 'CURSOR    ') and
                           (greater(btext^.location^,s1^)))
                         then ptr^.location^:=s1^;
                     end;
                   EnterName(ptr,header);
                 End;
     NameString: Begin
                   newentry(ptr);
                   b:=b^.brother;
                   ptr^.name:=b^.name;
                   header:=findfile(b^.filename);
                   if header = nil
                     then exeerror(9,b^.filename);
                   ptr^.tipe:=StringType;
                   exestring(b^.brother^.son,s1,s2);
                   new(ptr^.first);
                   new(ptr^.last);
                   ptr^.first^:=s1^;
                   ptr^.last^:=s2^;
                   EnterName(ptr,header);
                 End; 
        NameInt: Begin
                   newentry(ptr);
                   b:=b^.brother;
                   ptr^.name:=b^.name;
                   header:=findfile(b^.filename);
                   if header = nil
                     then exeerror(9,b^.filename);
                   ptr^.tipe:=IntType;
                   ptr^.intvalue:=exeintegerexp(b^.brother^.son);
                   EnterName(ptr,header);
                 End;
         NameCh: Begin
                   newentry(ptr);
                   b:=b^.brother;
                   ptr^.name:=b^.name;
                   header:=findfile(b^.filename);
                   if header = nil
                     then exeerror(9,b^.filename);
                   ptr^.tipe:=CharType;
                   ptr^.charvalue:=execharexp(b^.brother^.son);
                   EnterName(ptr,header);
                 End;
       NameBool: Begin
                   newentry(ptr);
                   b:=b^.brother;
                   ptr^.name:=b^.name;
                   header:=findfile(b^.filename);
                   if header = nil
                     then exeerror(9,b^.filename);
                   ptr^.tipe:=BoolType;
                   ptr^.boolvalue:=exetest(b^.brother^.son);
                   EnterName(ptr,header);
                 End;
    CreateStack: Begin
                   newentry(ptr);
                   b:=b^.brother;
                   ptr^.name:=b^.name;
                   header:=findfile(b^.filename);
                   if header = nil
                     then exeerror(9,b^.filename);
                   ptr^.tipe:=stacktype;
                   ptr^.top:=nil;
                   EnterName(ptr,header);
                 End;
            Top: Begin
                   b:=b^.brother;
                   ptr:=lookup(b^.name,b^.filename);
                   if ptr = nil
                     then exeerror(1,b^.name);
                   if ptr^.tipe <> stacktype
                     then exeerror(13,b^.name);
                   if ptr^.top = nil
                     then exeerror(14,b^.name);
                   newentry(ptr1);
                   ptr1^.name:=b^.brother^.name;
                   header:=findfile(b^.brother^.filename);
                   if header = nil
                     then exeerror(9,b^.brother^.filename);
                   ptr1^.tipe:=ptr^.top^.tipe;
                   Case ptr1^.tipe of
                     CharType,IntType,
                             BoolType: ptr1^.intvalue:=ptr^.top^.intvalue;
                              PtrType: Begin
                                         new(ptr1^.location);
                                         ptr1^.location^:=ptr^.top^.location^;
                                       End;
                           StringType: Begin
                                         new(ptr1^.first);
                                         new(ptr1^.last);
                                         ptr1^.first^:=ptr^.top^.first^;
                                         ptr1^.last^:=ptr^.top^.last^;
                                       End;
                            StackType: copystack(ptr^.top,ptr1);
                   end;
                   entername(ptr1,header);
                 End;
            Pop: Begin
                   b:=b^.brother;
                   ptr:=lookup(b^.name,b^.filename);
                   if ptr = nil
                     then exeerror(1,b^.name);
                   if ptr^.tipe <> stacktype
                     then exeerror(13,b^.name);
                   if ptr^.top = nil
                     then exeerror(14,b^.name);
                   newentry(ptr1);
                   ptr1^.name:=b^.brother^.name;
                   header:=findfile(b^.brother^.filename);
                   if header = nil
                     then exeerror(9,b^.brother^.filename);
                   ptr1^.tipe:=ptr^.top^.tipe;
                   Case ptr1^.tipe of
                     CharType,IntType,
                             BoolType: ptr1^.intvalue:=ptr^.top^.intvalue;
                              PtrType: ptr1^.location:=ptr^.top^.location;
                           StringType: Begin
                                         ptr1^.first:=ptr^.top^.first;
                                         ptr1^.last:=ptr^.top^.last;
                                       End;
                            StackType: ptr1^.top:=ptr^.top^.top;
                   end;
                   elem:=ptr^.top;
                   ptr^.top:=ptr^.top^.next;
                   EntryDispose(elem);
                   if (ptr1^.name = curse^.name) and (ptr1^.tipe = ptrtype)
                     then if greater(btext^.location^,ptr1^.location^)
                       then adjustcursor:=true;
                   entername(ptr1,header);
                 End;
           Push: Begin
                   b:=b^.brother;
                   ptr:=lookup(b^.name,b^.filename);
                   if ptr = nil
                     then exeerror(1,b^.name);
                   if ptr^.tipe <> Stacktype
                     then exeerror(13,b^.name);
                   ptr1:=lookup(b^.brother^.name,b^.brother^.filename);
                   if ptr1 = nil
                     then exeerror(1,b^.brother^.name);
                   newentry(elem);
                   elem^.next:=ptr^.top;
                   ptr^.top:=elem;
                   elem^.tipe:=ptr1^.tipe;
                   Case elem^.tipe of 
                     CharType,IntType,
                             BoolType: ptr1^.intvalue:=ptr^.top^.intvalue;
                              PtrType: Begin
                                         new(elem^.location);
                                         elem^.location^:=ptr1^.location^;
                                       End;
                           StringType: Begin
                                         new(elem^.first);
                                         new(elem^.last);
                                         elem^.first^:=ptr1^.first^;
                                         elem^.last^:=ptr1^.last^;
                                       End;
                            StackType: copystack(ptr1,elem);
                   end;
                 End;
          MoveC: Begin
                   s1:=exepointer(b^.brother^.son);
                   if greater(btext^.location^,s1^)
                     then begin
                       curse^.location^.disp:=s1^.disp;
                       curse^.location^.seg:=s1^.seg;
                       adjustcursor:=true;
                     end;
                 End;
           Move: Begin
                   b:=b^.brother;
                   s1:=exepointer(b^.son);
                   count:=exeintegerexp(b^.brother^.son);
                   rightedge:=false;
                   if count > 0
                     then while (count > 0) and not rightedge do
                       begin
                         moveforward(s1^,rightedge);
                         count:=count - 1;
                       end
                     else while (count < 0) and not rightedge do
                       begin
                         movebackward(s1^,rightedge);
                         count:=count + 1;
                       end;
                 End;
        DelName: Begin
                   RemoveName(b^.brother^.name,b^.brother^.filename);
                 End;
         Delete: Begin
                   exestring(b^.brother^.son,s1,s2);
                   deletetext(s1^,s2^);
                   insertdelete:=true;
                 End;
       UnDelete: Begin
                   t1:=lastdel.first;
                   t2:=lastdel.last;
                   UnDeleteText;
                   if t1.seg <> nil then
                     addtext(t1,t2);
                 End;
           Copy: Begin
                   b:=b^.brother;
                   exestring(b^.son,s1,s2);
                   copytext(s1^,s2^,textstring);
                   if b^.brother = nil
                     then s1:=curse^.location
                     else s1:=exepointer(b^.brother^.son);
                   insert(s1^,textstring);
                   insertdelete:=true;
                 End;
         Change: Begin
                   b:=b^.brother;
                   exestring(b^.son,s1,s2);
                   exestring(b^.brother^.son,s3,s4);
                   if b^.brother^.brother <> nil
                     then begin
                       exestring(b^.brother^.brother^.son,s5,s6);
                       while searchfor(s1^,s2^,s5^,s6^,dummy,curse^.location^) do
                         begin
                           insertdelete:=true;
                           deletetext(dummy,curse^.location^);
                           copytext(s3^,s4^,textstring);
                           insert(dummy,textstring);
                         end;
                     end
                     else if searchfor(s1^,s2^,curse^.location^,etext^.location^,
                                                        dummy,curse^.location^)
                       then begin
                         insertdelete:=true;
                         deletetext(dummy,curse^.location^);
                         copytext(s3^,s4^,textstring);
                         insert(dummy,textstring);
                       end;
                 End;
        Replace: Begin
                   b:=b^.brother;
                   exestring(b^.son,s1,s2);
                   exestring(b^.brother^.son,s3,s4);
                   copytext(s3^,s4^,textstring);
                   deletetext(s1^,s2^);
                   insertdelete:=true;
                   insert(s1^,textstring);
                 End;
            Run: Begin
                   b:=b^.brother;
                   exestring(b^.son,s1,s2);
                   compile(s1^,s2^);
                   editing:=true;
                 End;
         Search: Begin
                   adjustcursor:=true;
                   if b^.brother = nil
                     then match:=searchfor(oldsearch^.first,oldsearch^.last,
                      curse^.location^,etext^.location^,dummy,curse^.location^)
                     else begin
                       b:=b^.brother;
                       exestring(b^.son,s1,s2);
                       if b^.brother = nil
                         then match:=searchfor(s1^,s2^,curse^.location^,
                                       etext^.location^,dummy,curse^.location^)
                         else begin
                           b:=b^.brother;
                           exestring(b^.son,s3,s4);
                           if not greater(s3^,s4^)
                             then Exeerror(7,dummyname)
                             else if b^.brother = nil
                               then match:=searchfor(s1^,s2^,s3^,s4^,dummy,
                                                           curse^.location^)
                               else begin
                                 adjustcursor:=false;
                                 b:=b^.brother;
                                 if b^.brother = nil
                                   then begin
                                     ptr:=lookup(b^.son^.name,b^.son^.filename);
                                     if ptr = nil
                                       then begin
                                         newentry(ptr);
                                         ptr^.tipe:=stringtype;
                                         new(ptr^.first);
                                         new(ptr^.last);
                                         ptr^.first^:=s3^;
                                         ptr^.last^:=s3^;
                                         ptr^.name:=b^.son^.name;
                                         header:=findfile(b^.son^.filename);
                                         if header = nil
                                           then exeerror(9,b^.son^.filename);
                                         entername(ptr,header);
                                       end;
                                     if ptr^.tipe = ptrtype
                                       then begin
                                         s5:=exepointer(b^.son);
                                         match:=searchfor(s1^,s2^,s3^,s4^,
                                                                    dummy,s5^);
                                       end
                                       else begin
                                         exestring(b^.son,s5,s6);
                                         match:=searchfor(s1^,s2^,s3^,s4^,s5^,
                                                                         s6^);
                                       end;
                                   end
                                   else begin
                                     ptr:=lookup(b^.son^.name,b^.son^.filename);
                                     if ptr = nil
                                       then begin
                                         newentry(ptr);
                                         ptr^.tipe:=ptrtype;
                                         new(ptr^.location);
                                         ptr^.location^:=s3^;
                                         ptr^.name:=b^.son^.name;
                                         header:=findfile(b^.son^.filename);
                                         if header = nil
                                           then exeerror(9,b^.son^.filename);
                                         entername(ptr,header);
                                       end;
                                     ptr:=lookup(b^.brother^.son^.name,
                                                    b^.brother^.son^.filename);
                                     if ptr = nil
                                       then begin
                                         newentry(ptr);
                                         ptr^.tipe:=ptrtype;
                                         new(ptr^.location);
                                         ptr^.location^:=s3^;
                                         ptr^.name:=b^.brother^.son^.name;
                                         header:=findfile(b^.brother^.son^.filename);
                                         if header = nil
                                           then exeerror(9,b^.brother^.son^.filename);
                                         entername(ptr,header);
                                       end;
                                     s5:=exepointer(b^.son);
                                     s6:=exepointer(b^.brother^.son);
                                     match:=searchfor(s1^,s2^,s3^,s4^,s5^,s6^);
                                   end;
                               end;
                         end;
                     end;
                 End;
      ListNames: Begin
                   if b^.brother = nil
                     then header:=currentfile
                     else begin
                       header:=findfile(b^.brother^.filename);
                       if header = nil
                         then exeerror(9,b^.brother^.filename);
                     end;
                   templines:=cursor.lines;
                   tempchars:=cursor.chars;
                   ch:=chr(ESC);
                   tempname:=header^.namelist;
                   while (ch = chr(ESC)) and (tempname <> nil) do
                     begin
                       movecursor(0,0);
                       if terminal = bantom
                         then begin
                           for i:=cursor.lines to screensize-1 do
                             begin
                               buffer[bufferindex]:=ftnchar;
                               buffer[bufferindex+1]:=clearline;
                               buffer[bufferindex+2]:=chr(LF);
                               bufferindex:=bufferindex+3;
                             end;
                           dumpbuffer;
                           movecursor(0,0);
                         end
                         else begin
                           buffer[bufferindex]:=ftnchar;
                           buffer[bufferindex+1]:=clearpage;
                           bufferindex:=bufferindex + 2;
                           dumpbuffer;
                         end;
                       count:=1;
                       while (tempname <> nil) and (count < screensize) do
                         begin
                           for i:=1 to maxnamesize do
                             buffer[bufferindex+i-1]:=tempname^.name[i];
                           for i:=1 to 3 do
                             buffer[bufferindex+i+maxnamesize-1]:=' ';
                           bufferindex:=bufferindex + maxnamesize + 3;
                           case tempname^.tipe of
                             ptrtype : dummyname:='POINTER   ';
                             stringtype : dummyname:='STRING    ';
                             inttype : dummyname:='INTEGER   ';
                             chartype : dummyname:='CHARACTER ';
                             booltype : dummyname:='BOOLEAN   ';
                             stacktype : dummyname:='STACK     ';
                           end;
                           for i:=1 to maxnamesize do
                             buffer[bufferindex+i-1]:=dummyname[i];
                           buffer[bufferindex+maxnamesize]:=chr(CR);
                           buffer[bufferindex+maxnamesize+1]:=chr(LF);
                           bufferindex:=bufferindex + maxnamesize + 2;
                           dumpbuffer;
                           tempname:=tempname^.next;
                           count:=count + 1;
                         end;
                       cursor.lines:=count - 1;
                       cursor.chars:=0;
                       readch(ch);
                     end;
                   insertdelete:=true;
                   movecursor(templines,tempchars);
                 End;
      ListFiles: Begin
                   templines:=cursor.lines;
                   tempchars:=cursor.chars;
                   movecursor(0,0);
                   if terminal = bantom
                     then begin
                       for i:=cursor.lines to screensize-1 do
                         begin
                           buffer[bufferindex]:=ftnchar;
                           buffer[bufferindex+1]:=clearline;
                           buffer[bufferindex+2]:=chr(LF);
                           bufferindex:=bufferindex+3;
                         end;
                       dumpbuffer;
                       movecursor(0,0);
                     end
                     else begin
                       buffer[bufferindex]:=ftnchar;
                       buffer[bufferindex+1]:=clearpage;
                       bufferindex:=bufferindex + 2;
                       dumpbuffer;
                     end;
                   header:=currentfile;
                   repeat
                     for i:=1 to maxnamesize do
                       buffer[bufferindex+i-1]:=header^.name[i];
                     buffer[bufferindex+maxnamesize]:=chr(CR);
                     buffer[bufferindex+maxnamesize+1]:=chr(LF);
                     bufferindex:=bufferindex + maxnamesize + 2;
                     header:=header^.next;
                   until header = currentfile;
                   dumpbuffer;
                   readch(ch);
                   movecursor(templines,tempchars);
                   insertdelete:=true;
                 End;
           Edit: Begin
                   exestring(b^.brother^.son,s1,s2);
                   if greater(btext^.location^,s1^) or ((oldtext.lines >= 0)
                                               and greater(oldtext.btext^,s1^))
                     then exeerror(8,dummyname)
                     else begin
                       if oldtext.lines < 0
                         then begin
                           oldtext.lines:=tempcursor.lines;
                           oldtext.chars:=tempcursor.chars;
                           oldtext.cursor:=curse^.location^;
                           oldtext.window:=window^.location^;
                           oldtext.edge:=edge;
                           oldtext.btext:=btext^.location;
                           oldtext.etext:=etext^.location;
                         end;
                       btext^.location:=s1;
                       etext^.location:=s2;
                       window^.location^:=s1^;
                       curse^.location^:=s1^;
                       cursor.actual:=0;
                       edge:=0;
                       insertdelete:=true;
                       editing:=true;
                     end;
                 End;
         Return: Begin
                   if oldtext.lines >= 0
                     then begin
                       curse^.location^:=oldtext.cursor;
                       window^.location^:=oldtext.window;
                       edge:=oldtext.edge;
                       insertdelete:=true;
                       btext^.location:=oldtext.btext;
                       etext^.location:=oldtext.etext;
                       oldtext.lines:=-1;
                       editing:=true;
                     end;
                 End;
           Save: Begin
                   if oldtext.lines >= 0
                     then begin
                       curse^.location^:=oldtext.cursor;
                       window^.location^:=oldtext.window;
                       edge:=oldtext.edge;
                       templines:=0;
                       tempchars:=-edge;
                       dumplines(screensize,window^.location^,templines,
                                                               tempchars,true);
                       movecursor(oldtext.lines,oldtext.chars);
                       cursor.actual:=cursor.chars + edge;
                       btext^.location:=oldtext.btext;
                       etext^.location:=oldtext.etext;
                       oldtext.lines:=-1;
                     end;
                   Compact(SaveFile,currentfile^.name);
                   lastdel.first.seg:=nil;
                 End;
       ExitSave: Begin
                   if oldtext.lines >= 0
                     then begin
                       curse^.location^:=oldtext.cursor;
                       window^.location^:=oldtext.window;
                       btext^.location:=oldtext.btext;
                       etext^.location:=oldtext.etext;
                     end;
                   Movecursor(screensize-1,0);
                   if currentfile^.next <> currentfile
                     then begin
                       buffer[bufferindex]:=ftnchar;
                       buffer[bufferindex+1]:=clearline;
                       wantall:='Do you want to save all of your files? (Y or N) ';
                       for l:=1 to 48 do
                         buffer[bufferindex+l+1]:=wantall[l];
                       bufferindex:=bufferindex + 50;
                       dumpbuffer;
                       readch(command);
                       buffer[bufferindex]:=command;
                       buffer[bufferindex+1]:=chr(CR);
                       bufferindex:=bufferindex + 2;
                       dumpbuffer;
                       if command in ['n','N']
                         then compact(finished,currentfile^.name)
                         else compact(finished,emptyname);
                     end
                     else compact(finished,currentfile^.name);
                   goto 999;
                 End;
           Quit: Begin
                   Movecursor(screensize-1,0);
                   goto 999;
                 End;
          Visit: Begin
                   header:=findfile(b^.brother^.filename);
                   if header = nil
                     then exeerror(9,b^.brother^.filename)
                     else if not header^.maintext
                       then exeerror(15,b^.brother^.filename);
                   if header <> currentfile
                     then begin
                       currentfile:=header;
                       changefile:=true;
                       if oldtext.lines > 0
                         then begin
                           curse^.location^:=oldtext.cursor;
                           window^.location^:=oldtext.window;
                           btext^.location:=oldtext.btext;
                           etext^.location:=oldtext.etext;
                           oldtext.lines:=-1;
                         end;
                       curse:=lookup(curse^.name,header^.name);
                       btext:=lookup(btext^.name,header^.name);
                       etext:=lookup(etext^.name,header^.name);
                       window:=lookup(window^.name,header^.name);
                       m0:=lookup(m0^.name,header^.name);
                       m1:=lookup(m1^.name,header^.name);
                       m2:=lookup(m2^.name,header^.name);
                       m3:=lookup(m3^.name,header^.name);
                       m4:=lookup(m4^.name,header^.name);
                       m5:=lookup(m5^.name,header^.name);
                       m6:=lookup(m6^.name,header^.name);
                       m7:=lookup(m7^.name,header^.name);
                       m8:=lookup(m8^.name,header^.name);
                       m9:=lookup(m9^.name,header^.name);
                       lastcom:=lookup(lastcom^.name,header^.name);
                       tab:=lookup(tab^.name,header^.name);
                       edge:=0;
                       findlocation(curse^.location^,l,c);
                       cursor.actual:=c;
                       if c >= screenwidth
                         then begin
                           edge:=c - screenwidth + 5;
                           c:=screenwidth - 5;
                         end;
                       lines:=0;
                       chars:=-edge;
                       buffer[bufferindex]:=ftnchar;
                       buffer[bufferindex+1]:=home;
                       bufferindex:=bufferindex + 2;
                       dumpbuffer;
                       dumplines(screensize,window^.location^,lines,chars,true);
                       movecursor(l,c);
                     end
                     else exeerror(10,dummyname);
                 End;
      InputFile: Begin
                   count:=0;
                   rightedge:=false;
                   exestring(b^.brother^.son,s1,s2);
                   new(header);
                   while not greater(s2^,s1^) and not rightedge do
                     begin
                       count:=count + 1;
                       newfilename[count]:=getch(s1^);
                       moveforward(s1^,rightedge);
                     end;
                   for i:=count+1 to 64 do
                     newfilename[i]:=' ';
                   header^.name:=b^.brother^.brother^.filename;
                   readinfile(header,newfilename,done,true);
                   if not done
                     then exeerror(11,header^.name)
                     else begin
                       changefile:=true;
                       header^.next:=currentfile^.next;
                       currentfile^.next:=header;
                       currentfile:=header;
                       if oldtext.lines > 0
                         then begin
                           curse^.location^:=oldtext.cursor;
                           window^.location^:=oldtext.window;
                           btext^.location:=oldtext.btext;
                           etext^.location:=oldtext.etext;
                           oldtext.lines:=-1;
                         end;
                       edge:=0;
                       findlocation(curse^.location^,l,c);
                       cursor.actual:=c;
                       if c >= screenwidth
                         then begin
                           edge:=c - screenwidth + 5;
                           c:=screenwidth - 5;
                         end;
                       lines:=0;
                       chars:=-edge;
                       buffer[bufferindex]:=ftnchar;
                       buffer[bufferindex+1]:=home;
                       bufferindex:=bufferindex + 2;
                       dumpbuffer;
                       dumplines(screensize,window^.location^,lines,chars,true);
                       movecursor(l,c);
                     end;
                 End;
      AddMacros: Begin
                   count:=0;
                   rightedge:=false;
                   exestring(b^.brother^.son,s1,s2);
                   new(header);
                   while not greater(s2^,s1^) and not rightedge do
                     begin
                       count:=count + 1;
                       newfilename[count]:=getch(s1^);
                       moveforward(s1^,rightedge);
                     end;
                   for i:=count+1 to 64 do
                     newfilename[i]:=' ';
                   header^.name:=b^.brother^.brother^.filename;
                   readinfile(header,newfilename,done,false);
                   if not done
                     then exeerror(11,header^.name);
                   header^.next:=currentfile^.next;
                   currentfile^.next:=header;
                 End;
            End;
  End;
End;


Procedure ExeStmtList{Var B : NextItem};
Var Done : boolean;
Begin
  done:=false;
  while not done do
    begin
      if b = nil
        then done:=true
        else if b^.nonterm = StmtNT
          then begin
            ExeStmt(b^.son);
            b:=b^.brother;
          end
          else done:=true;
    end;
End;


Procedure ReturnSpace(ptr : nextitem);
Begin
  if ptr <> nil
    then begin 
      returnspace(ptr^.son);
      returnspace(ptr^.brother);
      itemdispose(ptr);
    end;
End;


Begin
  firstchar:=true;
  if greater(ending,starting)
    then rightedge:=true
    else rightedge:=false;
  nextid:=emptyname;
  nextfileid:=emptyname;
  nextsymbol:=semicolon;
  symbol:=semicolon;
  ch:=' ';
  macroptr:=starting;
  temp:=stmtlist([endofstring]);
  exestmtlist(temp);
99:
  returnspace(temp);
100:
End;


Procedure CommandMode;
Var  temp,tempwindow,erased : stickypointer;
     tempedge,i : integer;
     offscreen : boolean;
     obj : object;
     processing : packed array[1..10] of char;
Begin
  if (lastcommand.first.seg <> nil) and not editing and (oldtext.lines < 0)
    then begin
      lastcom^.first^:=lastcommand.first;
      lastcom^.last^:=lastcommand.last;
    end
    else editing:=false;
  Adjustcursor:=false;
  InsertDelete:=false;
  Refill:=true;
  ChangeFile:=false;
  tempcursor.lines:=cursor.lines;
  tempcursor.chars:=cursor.chars;
  movecursor(screensize-falsescreensize-1,0);
  if terminal = bantom
    then begin
      for i:=(screensize-falsescreensize-1) to (screensize - 2) do
        begin
          buffer[bufferindex]:=ftnchar;
          buffer[bufferindex+1]:=clearline;
          buffer[bufferindex+2]:=chr(LF);
          bufferindex:=bufferindex + 3;
        end;
      buffer[bufferindex]:=ftnchar;
      buffer[bufferindex+1]:=clearline;
      bufferindex:=bufferindex + 2;
      dumpbuffer;
      movecursor(screensize-falsescreensize,0);
    end
    else begin
      buffer[bufferindex]:=ftnchar;
      buffer[bufferindex+1]:=clearpage;
      bufferindex:=bufferindex + 2;
      dumpbuffer;
      movecursor(screensize-falsescreensize,0);
    end;
  starttext;
  tempwindow:=window^.location^;
  window^.location^.disp:=0;
  window^.location^.seg:=newobject;
  temp.seg:=nil;
  tempedge:=edge;
  edge:=0;
  repeat
    readch(ch);
    if ch <> chr(ESC)
       then if (ch <> chr(DEL)) and (ch <> chr(BS))
         then begin
           addchar(ch);
           temp.seg:=endobject;
           temp.disp:=endobject^.length - 1;
           insertchar(ch,temp,true);
         end
         else begin
           delchar(ch);
           if (ch <> chr(DEL)) and (ch <> chr(BS))
             then begin
               temp.seg:=endobject;
               temp.disp:=endobject^.length;
               removechar(ch,temp,true);
             end;
         end;
  until ch = chr(ESC);
  if temp.seg <> nil
    then begin
      processing:='PROCESSING';
      insertchar(chr(CR),temp,true);
      for i:=1 to 10 do
        insertchar(processing[i],temp,true);
    end;
  addchar(' ');
  window^.location^:=tempwindow;
  edge:=tempedge;
  finishtext(lastcommand);
  compile(lastcommand.first,lastcommand.last);
  if (insertdelete or adjustcursor) and not changefile
    then begin
      offscreen:=false;
      movesticky(window^.location^,0,-3000);
      endwindow:=window^.location^;
      movesticky(endwindow,screensize,3000);
      if greater(window^.location^,curse^.location^) and
         greater(curse^.location^,endwindow)
        then findlocation(curse^.location^,lines,chars)
        else offscreen:=true;
      if offscreen
        then begin
          insertdelete:=true;
          window^.location^:=curse^.location^;
          movesticky(window^.location^,-5,-3000);
          findlocation(curse^.location^,lines,chars);
        end;
      if chars >= screenwidth
        then begin
          edge:=edge + chars - screenwidth + 5;
          chars:=screenwidth - 5;
          insertdelete:=true;
        end
        else if chars < 0
          then begin
            edge:=edge + chars - 5;
            if edge < 0
              then begin
                chars:=5 + edge;
                edge:=0;
              end
              else chars:=5;
            insertdelete:=true;
          end;
      if insertdelete
        then begin
          l:=0;  c:=-edge;
          dumplines(screensize,window^.location^,l,c,true);
          cursor.actual:=chars + edge;
        end
        else if refill
          then begin
            erased:=window^.location^;
            movesticky(erased,screensize-falsescreensize-1,0);
            l:=screensize-falsescreensize-1;
            c:=-edge;
            dumplines(falsescreensize+1,erased,l,c,true);
          end;
      movecursor(lines,chars);
      cursor.actual:=cursor.chars + edge;
    end
    else if refill and not changefile
      then begin
        erased:=window^.location^;
        movesticky(erased,screensize-falsescreensize-1,0);
        l:=screensize-falsescreensize-1;
        c:=-edge;
        dumplines(falsescreensize+1,erased,l,c,true);
        movecursor(tempcursor.lines,tempcursor.chars);
        cursor.actual:=cursor.chars + edge;
      end
      else if not changefile
        then begin
          movecursor(tempcursor.lines,tempcursor.chars);
          cursor.actual:=cursor.chars + edge;
        end;
End;
         


Begin
  initialize;
  quitediting:=false;
  repeat
    readch(command);
    if not refill and not (command in ['c','C'])
      then begin
        lines:=cursor.lines;
        chars:=cursor.chars;
        temp:=window^.location^;
        movesticky(temp,screensize-falsescreensize-1,0);
        l:=screensize-falsescreensize-1;
        c:=-edge;
        dumplines(falsescreensize+1,temp,l,c,true);
        movecursor(lines,chars);
        refill:=true;
      end;
    case ord(command) of
      CR  : Begin
              movesticky(curse^.location^,1,-3000);
              findlocation(curse^.location^,lines,chars);
              cursor.actual:=0;
              movecursor(lines,-edge);
            end;
      {d} %X44,%X64,%X20 : Begin
                             movesticky(curse^.location^,0,1);
                             findchars(curse^.location^,cursor.actual);
                             movecursor(cursor.lines,cursor.chars+1);
                           end;
      {f} %X46,%X66 : Begin
                        movesticky(curse^.location^,0,8);
                        findchars(curse^.location^,cursor.actual);
                        movecursor(cursor.lines,cursor.chars+8);
                      end;
      {s} %X53,%X73,
      {BS}       BS : Begin
                        if (cursor.actual = cursor.chars + edge) and 
                           (cursor.actual > 0)
                          then begin
                            movesticky(curse^.location^,0,-1);
                            cursor.actual:=cursor.actual - 1;
                          end;
                        if cursor.chars + edge > 0
                          then movecursor(cursor.lines,cursor.chars-1);
                      end;
      {a} %X41,%X61 : Begin
                        if cursor.actual > cursor.chars - 8 + edge
                          then begin
                            movesticky(curse^.location^,0,cursor.chars
                                                 -cursor.actual-8+edge);
                            findchars(curse^.location^,cursor.actual);
                          end;
                        if cursor.chars + edge > 8
                          then movecursor(cursor.lines,cursor.chars-8)
                          else movecursor(cursor.lines,-edge);
                      end;
      {j} %X4A,%X6A : Begin
                       movesticky(curse^.location^,1,cursor.chars -
                                                    cursor.actual+edge);
                       findlocation(curse^.location^,lines,chars);
                       cursor.actual:=chars + edge;
                       movecursor(lines,cursor.chars);
                      end;
      {k} %X4B,%X6B : Begin
                       movesticky(curse^.location^,8,cursor.chars -
                                                    cursor.actual+edge);
                       findlocation(curse^.location^,lines,chars);
                       cursor.actual:=chars + edge;
                       movecursor(lines,cursor.chars);
                      end;
      {l} %X4C,%X6C : Begin
                        movesticky(curse^.location^,screensize,
                                       cursor.chars-cursor.actual+edge);
                        findlocation(curse^.location^,lines,chars);
                        cursor.actual:=chars + edge;
                        movecursor(lines,cursor.chars);
                      end;
      {u} %X55,%X75 : Begin
                        movesticky(curse^.location^,-1,cursor.chars -
                                                    cursor.actual+edge);
                        findlocation(curse^.location^,lines,chars);
                        cursor.actual:=chars + edge;
                        movecursor(lines,cursor.chars);
                      end;
      {i} %X49,%X69 : Begin
                        movesticky(curse^.location^,-8,cursor.chars -
                                                    cursor.actual+edge);
                        findlocation(curse^.location^,lines,chars);
                        cursor.actual:=chars + edge;
                        movecursor(lines,cursor.chars);
                      end;
      {o} %X4F,%X6F : Begin
                        movesticky(curse^.location^,-screensize,
                                       cursor.chars-cursor.actual+edge);
                        findlocation(curse^.location^,lines,chars);
                        cursor.actual:=chars + edge;
                        movecursor(lines,cursor.chars);
                      end;
      {/} %X2F : slash:=curse^.location^;
      {.} %X2E : slash.seg:=nil;
      {q} %X51,%X71 : begin
                        movesticky(curse^.location^,0,-3000);
                        if edge = 0
                          then begin
                            buffer[bufferindex]:=chr(CR);
                            bufferindex:=bufferindex + 1;
                            dumpbuffer;
                            cursor.chars:=0;
                          end
                          else movecursor(cursor.lines,-edge);
                        cursor.actual:=0;
                      end;
      {g} %X47,%X67 : begin
                        movesticky(curse^.location^,0,3000);
                        findchars(curse^.location^,cursor.actual);
                        movecursor(cursor.lines,cursor.actual-edge);
                      end;
      {m} %X4D,%X6D : if slash.seg <> nil
                        then if greater(curse^.location^,slash)
                          then copytext(curse^.location^,slash,o)
                          else if greater(slash,curse^.location^)
                            then copytext(slash,curse^.location^,o)
                            else ERROR(47)
                        else ERROR(48);
      {t} %X54,%X74 : begin
                        if o.first.seg <> nil
                          then begin
                            if cursor.chars-cursor.actual+edge > 0
                              then begin
                                starttext;
                                for l:=1 to cursor.chars-cursor.actual+edge do
                                  addchar(' ');
                                finishtext(obj);
                                insert(curse^.location^,obj);
                              end;
                            copytext(o.first,o.last,textstring);
                            endwindow:=window^.location^;
                            movesticky(endwindow,screensize-1,3000);
                            insert(curse^.location^,textstring);
                            addtext(textstring.first,curse^.location^);
                          end
                          else ERROR(54);
                        end;
      {r} %X52,%X72 : begin
                        endwindow:=window^.location^;
                        movesticky(endwindow,screensize-1,3000);
                        findlocation(endwindow,endlocation,chars);
                        if slash.seg <> nil
                          then if greater(curse^.location^,slash)
                            then begin
                              deletetext(curse^.location^,slash);
                              removetext(curse^.location^);
                              slash.seg:=nil;
                            end
                            else if greater(slash,curse^.location^)
                              then begin
                                deletetext(slash,curse^.location^);
                                removetext(slash);
                                slash.seg:=nil;
                              end
                              else ERROR(47)
                          else ERROR(48);
                      end;
      {x} %X58,%X78 : begin
                        temp:=curse^.location^;
                        movesticky(temp,0,3000);
                        endwindow:=window^.location^;
                        movesticky(endwindow,screensize-1,3000);
                        findlocation(endwindow,endlocation,chars);
                        deletetext(curse^.location^,temp);
                        removetext(curse^.location^);
                      end;
      {p} %X50,%X70 : begin
                        t1:=lastdel.first;
                        t2:=lastdel.last;
                        UnDeleteText;
                        if t1.seg <> nil then
                          addtext(t1,t2);
                      end;
      {h} %X48,%X68 : createtext;
      {^} %X5E      : begin
                        readch(ch);
                        if (getch(curse^.location^)<>chr(EOL)) and (ch<>chr(CR))
                          then begin
                            temp:=curse^.location^;
                            moveforward(temp,tempbool);
                            deletetext(curse^.location^,temp);
                            starttext;
                            addchar(ch);
                            finishtext(obj);
                            insert(temp,obj);
                            lastdel.first.seg:=nil;
                            if (ch < ' ') or (ch = chr(DEL))
                              then buffer[bufferindex]:='~'
                              else buffer[bufferindex]:=ch;
                            buffer[bufferindex+1]:=chr(BS);
                            bufferindex:=bufferindex + 2;
                            dumpbuffer;
                          end;
                      end;
      {CTR e} %X05  : begin
                        quitediting:=true;
                        if oldtext.lines >= 0
                          then begin
                            curse^.location^:=oldtext.cursor;
                            window^.location^:=oldtext.window;
                            btext^.location:=oldtext.btext;
                            etext^.location:=oldtext.etext;
                          end;
                        movecursor(screensize-1,0);
                        if currentfile^.next <> currentfile
                          then begin
                            buffer[bufferindex]:=ftnchar;
                            buffer[bufferindex+1]:=clearline;
                            wantall:='Do you want to save all of your files? (Y or N) ';
                            for l:=1 to 48 do
                              buffer[bufferindex+l+1]:=wantall[l];
                            bufferindex:=bufferindex + 50;
                            dumpbuffer;
                            readch(command);
                            buffer[bufferindex]:=' ';
                            buffer[bufferindex+1]:=command;
                            bufferindex:=bufferindex + 2;
                            dumpbuffer;
                            if command in ['n','N']
                              then compact(finished,currentfile^.name)
                              else compact(finished,emptyname);
                          end
                          else compact(finished,currentfile^.name);
                      end;
      {CTR w} %X17  : Begin
                        if oldtext.lines >= 0
                          then begin
                            curse^.location^:=oldtext.cursor;
                            window^.location^:=oldtext.window;
                            edge:=oldtext.edge;
                            lines:=0;
                            chars:=-edge;
                            dumplines(screensize,window^.location^,lines,chars,
                                                                         true);
                            movecursor(oldtext.lines,oldtext.chars);
                            cursor.actual:=cursor.chars + edge;
                            btext^.location:=oldtext.btext;
                            etext^.location:=oldtext.etext;
                            oldtext.lines:=-1;
                          end;
                        tempcursor.lines:=cursor.lines;
                        tempcursor.chars:=cursor.chars;
                        movecursor(screensize-2,0);
                        buffer[bufferindex]:=ftnchar;
                        buffer[bufferindex+1]:=clearline;
                        buffer[bufferindex+2]:=chr(LF);
                        buffer[bufferindex+3]:=ftnchar;
                        buffer[bufferindex+4]:=clearline;
                        bufferindex:=bufferindex + 5;
                        dumpbuffer;
                        if terminal = bantom
                          then begin
                            for l:=1 to nulls do
                              buffer[bufferindex+l-1]:=chr(NUL);
                            bufferindex:=bufferindex + nulls;
                            dumpbuffer;
                          end;
                        buffer[bufferindex]:='S';    buffer[bufferindex+1]:='A';
                        buffer[bufferindex+2]:='V';  buffer[bufferindex+3]:='I';
                        buffer[bufferindex+4]:='N';  buffer[bufferindex+5]:='G';
                        buffer[bufferindex+6]:=chr(CR);
                        bufferindex:=bufferindex + 7;
                        dumpbuffer;
                        cursor.lines:=screensize - 1;
                        compact(savefile,currentfile^.name);
                        endwindow:=window^.location^;
                        movesticky(endwindow,screensize-2,-3000);
                        l:=screensize - 2;     c:=-edge;
                        dumplines(2,endwindow,l,c,true);
                        movecursor(tempcursor.lines,tempcursor.chars);
                      End;
      {CTR z} %X1A  : Begin
                        quitediting:=true;
                        movecursor(screensize-1,0);
                      End;
      {c} %X43,%X63 : commandmode;
      {0} %X30      : m0^.location^:=curse^.location^;
      {1} %X31      : m1^.location^:=curse^.location^;
      {2} %X32      : m2^.location^:=curse^.location^;
      {3} %X33      : m3^.location^:=curse^.location^;
      {4} %X34      : m4^.location^:=curse^.location^;
      {5} %X35      : m5^.location^:=curse^.location^;
      {6} %X36      : m6^.location^:=curse^.location^;
      {7} %X37      : m7^.location^:=curse^.location^;
      {8} %X38      : m8^.location^:=curse^.location^;
      {9} %X39      : m9^.location^:=curse^.location^;
      otherwise ;
    end;
  until quitediting;
999:
  buffer[bufferindex]:=chr(CR);
  buffer[bufferindex+1]:=chr(LF);
  bufferindex:=bufferindex + 2;
  dumpbuffer;
End.



