-- file Find.mesa
-- last modified by Satterthwaite,  9-Mar-82 14:20:59

DIRECTORY
  Ascii: TYPE USING [CR, SP, TAB],
  DCSFileTypes: TYPE USING [tLeaderPage],
  Directory: TYPE USING [CreateFile, Error, Lookup, UpdateDates, ignore],
  Exec: TYPE USING [AddCommand, commandLine, w],
  File: TYPE USING [Capability, Permissions, delete, grow, read, shrink, write],
  FileStream: TYPE USING [Create, EndOf],
  Stream: TYPE USING [Handle, Delete, GetChar, PutChar],
  TTY: TYPE USING [Handle, GetLine, LineOverflow, PutChar, Rubout];

Find: PROGRAM
    IMPORTS Directory, Exec, FileStream, Stream, TTY = {

 -- characters and strings
 
  MAXCHAR: NAT = LAST[CHARACTER] - 0c;
  MAXSTR: NAT = 100;
  
  character: TYPE = [-1..MAXCHAR];
  string: TYPE = PACKED ARRAY [1..MAXSTR] OF character;
  
  ENDFILE:   character = -1;
  ENDSTR:    character =  0;
  BACKSPACE: character =  9;
  TAB:       character =  9;
  NEWLINE:   character = 13;
  BLANK:     character = 32;
  ESCAPE:    character = ord['@];
  
 -- file descriptors and io-related stuff
 
  MAXOPEN: NAT = 10;
  
  filedesc: TYPE = [0..MAXOPEN];
  
  IOERROR: filedesc = 0;
  STDIN:   filedesc = 1;
  STDOUT:  filedesc = 2;
  STDERR:  filedesc = 3;
  
  IOREAD:  INTEGER = 1;
  IOWRITE: INTEGER = 2;
  IOBOTH:  INTEGER = 3;  
  

-- standard (Pascal) procedures
   
  ord: PROC [c: CHARACTER] RETURNS [character] = INLINE {RETURN [c - 0c]};
  chr: PROC [c: character] RETURNS [CHARACTER] = INLINE {RETURN [c + 0c]};
  
  
-- file primitives
   
  tty: TTY.Handle;
 
  kbdline: STRING _ [MAXSTR];
  kbdx: CARDINAL;
  kbdend: BOOLEAN;
  
  
  readkbd: PROC = {
    IF (kbdend) THEN
      kbdline.length _ 0
    ELSE {
      ENABLE {
	TTY.LineOverflow => {
	  putcf[NEWLINE, STDERR];
	  message["*** line too long"L];
	  putcf[NEWLINE, STDERR];
	  RETRY};
	TTY.Rubout => {
	  IF (kbdline.length) > 0 THEN
	    RESUME
	  ELSE {
	    kbdend _ TRUE;
	    CONTINUE}}};
      IF (kbdline.length > 0)
       AND (kbdline[kbdline.length-1] = Ascii.CR) THEN
        kbdline.length _ kbdline.length - 1;	-- for ESC
      tty.GetLine[kbdline];
      IF kbdline.length >= kbdline.maxlength THEN
        [] _ ERROR TTY.LineOverflow[kbdline];
      kbdline[kbdline.length] _ Ascii.CR;
      kbdline.length _ kbdline.length + 1};
    kbdx _ 0};
	   
    
    
  filerec: TYPE = RECORD [
    type: {none, stream, tty} _ none,
    handle: Stream.Handle _ NIL];
    
  filetab: ARRAY filedesc OF filerec;
  
  accessmap: PROC [mode: INTEGER] RETURNS [File.Permissions] = {
    RETURN [SELECT mode FROM
      IOREAD => File.read,
      IOWRITE => File.write + File.grow + File.shrink + File.delete,
      IOBOTH => File.read + File.write + File.grow + File.shrink + File.delete,
      ENDCASE => File.read]};
    
  fdalloc: PROC RETURNS [fd: filedesc] = {
    -- find a free slot in filetab
    FOR fd IN (STDERR .. MAXOPEN] DO
      IF (filetab[fd].type = none) THEN EXIT
      REPEAT
        FINISHED => fd _ IOERROR; 
      ENDLOOP;
    RETURN};
  
  fileerror: ERROR = CODE;
  
  findfile: PROC [name: STRING, access: File.Permissions]
      RETURNS [File.Capability] = {
    cap: File.Capability;
    old: BOOLEAN _ (access = File.read);
    IF ~old THEN { 
      cap _ Directory.CreateFile[name, DCSFileTypes.tLeaderPage, 0
	      ! Directory.Error => {
		 IF type = fileAlreadyExists THEN GOTO fileExists 
		 ELSE GO TO fileProblem}];
      EXITS
        fileExists => old _ TRUE};
    IF old THEN
       cap _ Directory.Lookup[fileName: name, permissions: Directory.ignore
	! Directory.Error => {GO TO fileProblem}];
    RETURN [Directory.UpdateDates[cap, access]]
    EXITS
      fileProblem => ERROR fileerror};
  
  makestream: PROC [name: POINTER TO string, mode: INTEGER, fd: filedesc] = {
    i: INTEGER _ 0;
    intname: STRING _ [MAXSTR];
    WHILE (name[i+1] # ENDSTR) DO
      intname[i] _ chr[name[i+1]];
      i _ i + 1;
      ENDLOOP;
    intname.length _ i;
    filetab[fd] _ [
	type: stream,
	handle: FileStream.Create[findfile[intname, accessmap[mode]]]]};
  

  open: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [fd: filedesc] = {
    fd _ fdalloc[];
    IF fd # IOERROR THEN {
      makestream[name, mode, fd ! fileerror => {GOTO fail}];
      EXITS fail => {filetab[fd] _ [type: none]; fd _ IOERROR}};
    RETURN};

  create: PROC [name: POINTER TO string, mode: INTEGER] RETURNS [filedesc] = open;
    -- check positioning of files opened for output
    
  close: PROC [fd: filedesc] = {
    SELECT filetab[fd].type FROM
      stream => {
        h: Stream.Handle = filetab[fd].handle;
	Stream.Delete[h]};
      tty => NULL;
      ENDCASE => NULL;
    filetab[fd] _ [type: none]};

  remove: PROC [s: POINTER TO string] = {
    -- this version just prints a message
    message["If we had remove, we would be deleting "L];
    putcf[TAB, STDERR];
    putstr[s, STDERR];
    putcf[NEWLINE, STDERR]};

  getc: PROC [c: POINTER TO character] RETURNS [character] = INLINE {
    RETURN [getcf[c, STDIN]]};

  getcf: PROC [c: POINTER TO character, fd: filedesc] RETURNS [character] = {
    SELECT filetab[fd].type FROM
      stream => {
        h: Stream.Handle = filetab[fd].handle;
	c^ _ IF FileStream.EndOf[h] THEN ENDFILE ELSE ord[h.GetChar[]]};
      tty =>
        IF (kbdx < kbdline.length) THEN {
	  c^ _ ord[kbdline[kbdx]];
	  kbdx _ kbdx + 1}
	ELSE {
	  readkbd[];
	  IF (kbdline.length = 0) THEN	-- iff kbdend
	    c^ _ ENDFILE
	  ELSE {
	    c^ _ ord[kbdline[kbdx]];
	    kbdx _ kbdx + 1}};
      ENDCASE => error["bad file descriptor"L];
    RETURN [c^]};

  getline: PROC [s: POINTER TO string, fd: filedesc, maxsize: INTEGER _ MAXSTR]
      RETURNS [BOOLEAN] = {
    i: INTEGER _ 1;
    c: character;
    DO
      s[i] _ getcf[@c, fd];
      i _ i + 1;
      IF (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize) THEN EXIT
      ENDLOOP;
    IF (c = ENDFILE) THEN	-- went one too far
      i _ i - 1;
    s[i] _ ENDSTR;
    RETURN [c # ENDFILE]};


  putc: PROC [c: character] = INLINE {putcf[c, STDOUT]};

  putcf: PROC [c: character, fd: filedesc] = {
    SELECT filetab[fd].type FROM
      stream => {
        h: Stream.Handle = filetab[fd].handle;
	h.PutChar[chr[c]]};
      tty => tty.PutChar[chr[c]];
      ENDCASE => error["bad file descriptor"L]};

  putstr: PROC [s: POINTER TO string, fd: filedesc] = {
    i: INTEGER _ 1;
    WHILE (s[i] # ENDSTR) DO
      putcf[s[i], fd];
      i _ i + 1
      ENDLOOP};
      

-- errors and messages

  message: PROC [msg: STRING] = {
    FOR i: CARDINAL IN [0 .. msg.length) DO
      putcf[ord[msg[i]], STDERR] ENDLOOP};

  exit: ERROR = CODE;
  
  error: PROC [msg: STRING] = {
    message[msg];  ERROR exit};
   

-- command arg primitives

  MAXCMD: NAT = 20;

  cmdargs: [0 .. MAXCMD];
  cmd: ARRAY [1 .. MAXCMD] OF RECORD [idx, len: CARDINAL];
  
  getarg: PROC [n: INTEGER, str: POINTER TO string, maxsize: INTEGER]
      RETURNS [BOOLEAN] = {
    b: BOOLEAN _ ((n > 0) AND (n <= cmdargs));
    IF (b) THEN
      commandstr[cmd[n].idx, cmd[n].len, str, 1, maxsize];
    RETURN [b]};

  nargs: PROC RETURNS [INTEGER] = {RETURN [cmdargs]};
  
  commandstr: PROC [i, n: INTEGER,
      dest: POINTER TO string, j: INTEGER, maxsize: INTEGER] = {
    WHILE (n > 0) AND (j < maxsize) DO
      dest[j] _ ord[Exec.commandLine.s[i]];
      i _ i + 1;
      j _ j + 1;
      n _ n - 1;
      ENDLOOP;
    dest[j] _ ENDSTR}; 
  

-- utilities

 -- addstr: put c in outset[j] if it fits, increment j
  addstr: PROC [c: character, outset: POINTER TO string,
      j: POINTER TO INTEGER, maxset: INTEGER] RETURNS [added: BOOLEAN] = {
    IF (j^ > maxset) THEN
      added _ FALSE
    ELSE {
      outset[j^] _ c;
      j^ _ j^ + 1;
      added _ TRUE};
    RETURN};
	
 -- esc: map s[i^] into escaped character, increment i^
  esc: PROC [s: POINTER TO string, i: POINTER TO INTEGER] RETURNS [c: character] = {
    IF (s[i^] # ESCAPE) THEN
      c _ s[i^]
    ELSE IF (s[i^+1] = ENDSTR) THEN	-- @ not special at end
      c _ ESCAPE
    ELSE {
      i^ _ i^ + 1;
      IF (s[i^] = ord['n]) THEN
        c _ NEWLINE
      ELSE IF (s[i^] = ord['t]) THEN
        c _ TAB
      ELSE
      	c _ s[i^]};
    RETURN};

 -- isalphanum: true if c is a letter or digit
  isalphanum: PROC [c: character] RETURNS [BOOLEAN] = {
    RETURN [
      (c IN [ord['a] .. ord['z]])
       OR (c IN [ord['A] .. ord['Z]])
       OR (c IN [ord['0] .. ord['9]])]};

     
 -- main proc here
 
 -- find: find patterns in text
  find: PROC = {
    MAXPAT: NAT = MAXSTR;
    CLOSIZE: NAT = 1;		-- size of a closure entry
    CLOSURE: character = ord['*];
    BOL: character = ord['%];
    EOL: character = ord['$];
    ANYCHAR: character = ord['?];
    CCL: character = ord['[];
    CCLEND: character = ord[']];
    NEGATE: character = ord['^];
    NCCL: character = ord['!];	-- cannot be the same as NEGATE
    LITCHAR: character = ord['c];
    arg, lin, pat: string;

    getpat: PROC [arg, pat: POINTER TO string] RETURNS [BOOLEAN] = {
      -- getpat: convert argument into pattern
      
      makepat: PROC [arg: POINTER TO string, start: INTEGER,
          delim: character, pat: POINTER TO string] RETURNS [INTEGER] = {
	-- makepat: make pattern from arg[i], terminate at delim

	getccl: PROC [arg: POINTER TO string, i: POINTER TO INTEGER,
	    pat: POINTER TO string, j: POINTER TO INTEGER] RETURNS [BOOLEAN] = {
	  -- getccl: expand char class at arg[i] into pat[j]
	  jstart: INTEGER;
	  
	  dodash: PROC [delim: character, src: POINTER TO string,
	      i: POINTER TO INTEGER, dest: POINTER TO string,
	      j: POINTER TO INTEGER, maxset: INTEGER] = {
	    -- dodash: expand set at src[i^] into dest[j^], stop at delim
	    DASH: character = ord['-];
	    WHILE (src[i^] # delim) AND (src[i^] # ENDSTR) DO
	      IF (src[i^] = ESCAPE) THEN
		[] _ addstr[esc[src, i], dest, j, maxset]
	      ELSE IF (src[i^] # DASH) THEN
		[] _ addstr[src[i^], dest, j, maxset]
	      ELSE IF (j^ <= 1) OR (src[i^+1] = ENDSTR) THEN
		[] _ addstr[DASH, dest, j, maxset]	-- literal -
	      ELSE IF (isalphanum[src[i^-1]])
	       AND (isalphanum[src[i^+1]])
	       AND (src[i^-1] <= src[i^+1]) THEN {
		FOR k: character IN (src[i^-1] .. src[i^+1]] DO
		  [] _ addstr[k, dest, j, maxset] ENDLOOP;
		  i^ _ i^ + 1}
	      ELSE
		[] _ addstr[DASH, dest, j, maxset];
	      i^ _ i^ + 1
	      ENDLOOP};
	  
	  i^ _ i^ + 1;	-- skip over '[
	  IF (arg[i^] = NEGATE) THEN {
	    [] _ addstr[NCCL, pat, j, MAXPAT];
	    i^ _ i^ + 1}
	  ELSE
	    [] _ addstr[CCL, pat, j, MAXPAT];
	  jstart _ j^;
	  [] _ addstr[0, pat, j, MAXPAT];	-- room for count
	  dodash[CCLEND, arg, i, pat, j, MAXPAT];
	  pat[jstart] _ j^ - jstart - 1;
	  RETURN [arg[i^] = CCLEND]};
	  
	stclose: PROC [pat: POINTER TO string, j: POINTER TO INTEGER,
	    lastj: INTEGER] = {
	  -- stclose: insert closure entry at pat[j]
	  FOR jp: INTEGER DECREASING IN [lastj .. j^) DO
	    jt: INTEGER _ jp + CLOSIZE;
	    [] _ addstr[pat[jp], pat, @jt, MAXPAT]
	    ENDLOOP;
	  j^ _ j^ + CLOSIZE;
	  pat[lastj] _ CLOSURE};	-- where original pattern began
	  
	i: INTEGER _ start;	-- arg index
	j: INTEGER _ 1;		-- pat index
	lastj: INTEGER _ 1;
	done: BOOLEAN _ FALSE;
	WHILE (~done) AND (arg[i] # delim) AND (arg[i] # ENDSTR) DO
	  lj: INTEGER _ j;
	  IF arg[i] = ANYCHAR THEN
	    [] _ addstr[ANYCHAR, pat, @j, MAXPAT]
	  ELSE IF (arg[i] = BOL) AND (i = start) THEN
	    [] _ addstr[BOL, pat, @j, MAXPAT]
	  ELSE IF (arg[i] = EOL) AND (arg[i+1] = delim) THEN
	    [] _ addstr[EOL, pat, @j, MAXPAT]
	  ELSE IF (arg[i] = CCL) THEN
	    done _ (~getccl[arg, @i, pat, @j])
	  ELSE IF (arg[i] = CLOSURE) AND (i > start) THEN {
	    lj _ lastj;
	    IF (pat[lj] = BOL) OR (pat[lj] = EOL) OR (pat[lj] = CLOSURE) THEN
	      done _ TRUE	-- force loop termination
	    ELSE
	      stclose[pat, @j, lastj]}
	  ELSE {
	    [] _ addstr[LITCHAR, pat, @j, MAXPAT];
	    [] _ addstr[esc[arg, @i], pat, @j, MAXPAT]};
	  lastj _ lj;
	  IF (~done) THEN
	    i _ i + 1
	  ENDLOOP;
	RETURN [
	  IF (done) OR (arg[i] # delim) THEN
	    0		-- finished early
	  ELSE IF (~addstr[ENDSTR, pat, @j, MAXPAT]) THEN
	    0		-- no room
	  ELSE
	    i]};	-- all is well;
      
      RETURN [makepat[arg, 1, ENDSTR, pat] > 0]};
      
    match: PROC [lin, pat: POINTER TO string] RETURNS [BOOLEAN] = {
      -- match: find match anywhere on line

      amatch: PROC [lin: POINTER TO string, offset: INTEGER,
          pat: POINTER TO string, j: INTEGER] RETURNS [INTEGER] = {
	-- amatch: look for match of pat[j] ... at lin[offset] ...

        omatch: PROC [lin: POINTER TO string, i: POINTER TO INTEGER,
	    pat: POINTER TO string, j: INTEGER] RETURNS [matched: BOOLEAN] = {
	  -- omatch: match one patern element at pat[j]

	  locate: PROC [c: character, pat: POINTER TO string,
	      offset: INTEGER] RETURNS [found: BOOLEAN _ FALSE] = {
	    -- locate: look for c in character class at pat[offset]
	    -- size of class is at pat[offset], characters follow
	    i: INTEGER _ offset + pat[offset];	-- last position
	    WHILE (i > offset) DO
	      IF (c = pat[i]) THEN {
	        found _ TRUE;
		i _ offset}	-- force loop termination
	      ELSE
	        i _ i - 1
	      ENDLOOP;
	    RETURN};

	  advance: [-1..1] _ -1;
	  IF (lin[i^] # ENDSTR) THEN
	    SELECT pat[j] FROM
	      LITCHAR =>
	        IF (lin[i^] = pat[j+1]) THEN
		  advance _ 1;
	      BOL =>
	        IF (i^ = 1) THEN
		  advance _ 0;
	      ANYCHAR =>
	        IF (lin[i^] # NEWLINE) THEN
		  advance _ 1;
	      EOL =>
	        IF (lin[i^] = NEWLINE) THEN
		  advance _ 0;
	      CCL =>
	        IF (locate[lin[i^], pat, j+1]) THEN
		  advance _ 1;
	      NCCL =>
	        IF (lin[i^] # NEWLINE)
		 AND (~locate[lin[i^], pat, j+1]) THEN
		  advance _ 1;
	      ENDCASE =>
	        error["in omatch: can't happen"L];
	  IF (advance >= 0) THEN {
	    i^ _ i^ + advance;
	    matched _ TRUE}
	  ELSE
	    matched _ FALSE;
	  RETURN};

        patsize: PROC [pat: POINTER TO string, n: INTEGER]
	    RETURNS [size: INTEGER] = {
	  -- patsize: returns size of pattern entry at pat[n]
	  SELECT pat[n] FROM
	    LITCHAR => 
	      size _ 2;
	    BOL, EOL, ANYCHAR =>
	      size _ 1;
	    CCL, NCCL =>
	      size _ pat[n+1] + 2;
	    CLOSURE =>
	      size _ CLOSIZE;
	    ENDCASE => 
	      error["in patsize: can't happen"L];
	    RETURN [size]};
	  
	i, k: INTEGER;
	done: BOOLEAN _ FALSE;
	WHILE (~done) AND (pat[j] # ENDSTR) DO
	  IF (pat[j] = CLOSURE) THEN {
	    j _ j + patsize[pat, j];	-- step over CLOSURE
	    i _ offset;
	    -- match as many as possible
	    WHILE (~done) AND (lin[i] # ENDSTR) DO
	      IF (~omatch[lin, @i, pat, j]) THEN
	        done _ TRUE ENDLOOP;
	    -- i points to input char that made us fail
	    -- match rest of pattern against rest of input
	    -- shrink closure by 1 after each failure
	    done _ FALSE;
	    WHILE (~done) AND (i >= offset) DO
	      k _ amatch[lin, i, pat, j+patsize[pat, j]];
	      IF (k > 0) THEN 	-- matched rest of pattern
	        done _ TRUE
	      ELSE
	        i _ i - 1
	      ENDLOOP;
	    offset _ k;	-- if k = 0 THEN  failure else success
	    done _ TRUE}
	  ELSE IF (~omatch[lin, @offset, pat, j]) THEN {
	    offset _ 0;	-- non-closure
	    done _ TRUE}
	  ELSE	-- omatch succeeded on this pattern element
	    j _ j + patsize[pat, j]
	  ENDLOOP;
	RETURN [offset]};

      i: INTEGER _ 1;
      pos: INTEGER _ 0;
      WHILE (lin[i] # ENDSTR) AND (pos = 0) DO
        pos _ amatch[lin, i, pat, 1];
	i _ i + 1
	ENDLOOP;
      RETURN [pos > 0]};

    IF (~getarg[1, @arg, MAXSTR]) THEN 
      error["usage: find pattern"L];
    IF (~getpat[@arg, @pat]) THEN
      error["find: illegal pattern"L];
    WHILE (getline[@lin, STDIN, MAXSTR]) DO
      IF (match[@lin, @pat]) THEN
         putstr[@lin, STDOUT]
      ENDLOOP};
  
  
 -- here begins the shell
 
  initcmd: PROC = {
    idx: CARDINAL _ Exec.commandLine.i;
    limx: CARDINAL =
      IF Exec.commandLine.s = NIL THEN 0 ELSE Exec.commandLine.s.length-1;
    tty _ Exec.w;
    kbdx _ kbdline.length _ 0;
    kbdend _ FALSE;
    filetab[STDIN].type _ filetab[STDOUT].type _ filetab[STDERR].type _ tty;
    cmdargs _ 0;
    WHILE (idx < limx) DO
      WHILE (Exec.commandLine.s[idx] = Ascii.SP) AND (idx < limx) DO
        idx _ idx + 1 ENDLOOP;
      IF (idx < limx) THEN {
        startidx: CARDINAL = idx;
	WHILE (idx < limx)
	 AND (Exec.commandLine.s[idx] # Ascii.SP)
	 AND (Exec.commandLine.s[idx] # Ascii.TAB) DO
	  idx _ idx + 1 ENDLOOP;
	SELECT Exec.commandLine.s[startidx] FROM
	  '< => {
	    name: string;
	    commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
	    close[STDIN];
	    makestream[@name, IOREAD, STDIN]};
	  '> => {
	    name: string;
	    commandstr[startidx+1, idx - (startidx+1), @name, 1, MAXSTR];
	    close[STDOUT];
	    makestream[@name, IOWRITE, STDOUT]};
	  ENDCASE => {
	    cmdargs _ cmdargs + 1;
	    IF cmdargs > MAXCMD THEN {
	      putcf[NEWLINE, STDERR];
	      message["*** too many arguments"L];
	      putcf[NEWLINE, STDERR]}
	    ELSE
	      cmd[cmdargs] _ [idx: startidx, len: idx - startidx]}};
      ENDLOOP;
    putcf[NEWLINE, STDERR]};
      
   endcmd: PROC = {
     FOR fd: filedesc IN (IOERROR .. MAXOPEN] DO
       close[fd] ENDLOOP;
     IF Exec.commandLine.s # NIL THEN
       Exec.commandLine.i _ Exec.commandLine.s.length};
   

  main: PROC = {
    initcmd[];
    find[ ! exit => {CONTINUE}];
    endcmd[]};
  
  Exec.AddCommand["find.~"L, main];
  
  }.