%	*****************************************************************
%	*								*
%	*	This module is a part of the SAO VAX/VMS		*
%	*	RED full-screen text editor				*
%	*								*
%	*	It was created by					*
%	*	Roger Hauck						*
%	*	Smithsonian Institution					*
%	*	Astrophysical Observatory				*
%	*	Cambridge, Massachusetts  02138				*
%	*	(617)495-7151  (FTS 830-7151)				*
%	*								*
%	*	This module may be reproduced				*
%	*	provided that this header is retained.			*
%	*								*
%	*****************************************************************

%  Variables
1 'C.SIGN VARIABLE  % sign as multiplier
0 'C.MAG VARIABLE  % magnitude of argument
0 'C.ARGLEN VARIABLE  % string-length of argument
0 'C.XARG VARIABLE  % first argument for X commands
0 'C.DEFAULT? VARIABLE  % whether there's a default argument
0 'C.LOOP_COUNT VARIABLE  % count for prevention of loop stack overflow
0 'C.REC_LENGTH VARIABLE  % record length for fixed-length files
0 'C.LINE_COUNT VARIABLE  % tally for the comma command
0 'MAIN_SEP VARIABLE  % separator for main file
0 'REC_ATT VARIABLE  % record attribute
0 'MAIN_ATT VARIABLE  % main file attribute
0 'ERR_FLAG VARIABLE  % error flag for ? command
0 'ERR_SUPPRESS VARIABLE  % error suppress flag
0 'FIRST_BYTE VARIABLE  % address of first byte of block being read
0 'FSIZE VARIABLE  % holding area for control block size during file open
0 'CHAN VARIABLE  % RMS channel number for file mapping operations
0 'OK_TO_MAP VARIABLE  % flag to prevent attempts at unimp. file types
0 'STOIC_ESCAPE_FLAG VARIABLE  % whether to drop out

% Utilities


ASSEMBLER<

'E.MATCH :  % pattern identifier, E.MATCH, pattern id., success
%	(compares pattern string to top of bottom buffer)
  TOPOBOT @ MOVL (P)+ R3  MOVQ (P) R0  % load parameters into registers
  CMPC3 R0 (R1) (R3)  % do it
  MOVL R0 -(P) EQZ  % success value
  ;

>

 
'TF_LL :  % move cursor to bottom of screen then scroll to center cursor
  TF @ 2* 2+  % row # of bottom line
  SROW @  % current row #
  - GTZ_IF  % already at bottom line?
    UNDROP C.L+ THEN  % no, move cursor to bottom line
  CENTER_UP  % scroll if necessary
  SCOL @ 1 EQ_IF  %  already at column 1?
    S.CUP ELSE  % yes, restore cursor
    1 C.L- THEN  % no, move cursor to beginning of line
  ;

'TF_-LL :  % move cursor to top of screen then scroll to center cursor
  SROW @  % current row #
  1- C.L-  % move cursor to top line
  CENTER_DOWN  % scroll down if necessary
  ;

'I.WORDRIGHT :  % move one word to the right
  TOPOBOT @ BEGIN  % save TOPOBOT
    BOPOP IF  % anything left?
      BLANK LT ELSE  % yes, stop if not delimiter
      -1 THEN
    END
  BEGIN
    BOPOP IF  % anything left?
      BLANK GE_IF  % yes, delimiter?
        TOPOBOT 1-! -1 ELSE  % yes, restore byte to bottom buffer, done
        0 THEN ELSE  % no, keep going
      -1 THEN  % nothing left, all done
    END
  TOPOBOT @ OVER -  % # of bytes to move
  SWAP TOPOBOT !  % restore TOPOBOT
  C.M+  % do move
  ;

'I.WORDLEFT :  % move one word to the left
  BOTOTOP @ BEGIN  % save BOTOTOP
    TOPOP IF  % anything left?
      BLANK LT ELSE  % yes, stop if not delimiter
      -1 THEN
    END
  BEGIN
    TOPOP IF  % anything left?
      BLANK GE_IF  % yes, delimiter?
        BOTOTOP 1+! -1 ELSE  % yes, restore byte to top buffer, done
        0 THEN ELSE  % no, keep going
      -1 THEN  % nothing left, all done
    END
  DUP BOTOTOP @ -  % # of bytes to move
  SWAP BOTOTOP !  % restore BOTOTOP
  C.M-  % do move
  ;

'E.B :  % go to beginning of file
  BEGIN  % loop till at beginning of file
    TOPOP IF  % EOF?
      BOPUSH REPEAT
  ;

'E.W :  % write current file
  FILE_NAME 3 WOPEN
  E.B  % go to top
  BEGIN  % loop through file
    BOT_COUNT UNDER NEZ IF  % all done?
    BOT_COUNT SFCR DUP E.M+ 2DROP  % move first line to top
      TOP_COUNT 1- 3 PUT  % output one line
      TOPOTOP BOTOTOP MOVE  % delete line
      REPEAT
  3 CLOSE
  ;

'C.K :  % Kill command
  BEGIN
    BOPOP IF  % any more bytes?
      CRET EQ_IF  % yes, is this a CR?
        -1 ELSE  % yes, end the loop
        0 THEN ELSE  % no, keep going
      -1 THEN  % no more bytes, end the loop
    END DISP -1  % always succeed
  ;

'FAIL_SEARCH :  % returns error message if error suppress flag is off
  ERR_SUPPRESS @ IF
    -1  % if flag is on, return success
  ELSE
    ERR.NOSTRN  % otherwise return "Search failed"
  THEN
  ;

'C.+S :  % pattern descriptor, iteration count, C.+S, success
%	(searches forward for countth occurence of the pattern)
%	(on success, moves cursor and records pattern length)
%	(on failure, moves cursor to top of file)
  BOT_COUNT -ROT (  % loop count times
    SEARCH_STRING IF  % found?
      I' EQZ_IF -1 ERR_FLAG 0<- THEN  % yes, if nth occurence, succeed
    ELSE
      EXIT FAIL_SEARCH  % not found, exit, fail
      ERR_FLAG -1<-
    THEN
  )
  IF  % was nth occurence found?
    DROP TOPOBOT @ -  % yes, how far away is it
    C.M+ -1 ELSE  % move that many bytes up, succeed
    UNDROP TOPOTOP D@ - C.M-  % restore err. code, go to top of file
    UNDER UNDER THEN  % drop rest-of-source descr.
  UNDER UNDER  % drop pattern descr.
  ;

'C.-S :  % pattern identifier, count, -S  (searches backwards for string)
  ERR_FLAG 0<-
  TOPOBOT @ NOTE  % save present position
  ( DUP 1- MOVE_DOWN  % move down count-1 bytes
  BEGIN  % loop until string found or BOF
    TOPOP IF BOPUSH -1 ELSE 0 THEN IF  % move one byte down, BOF?
      E.MATCH IF  % string found?
        -1 I' EQZ_IF -1 THEN ELSE  % exit, success if last time through
        0 THEN ELSE  % not what we're looking for, continue
      FAIL_SEARCH -1 THEN  % not there, exit, failure
    END ) UNDER UNDER  % drop pattern descriptor
  TOPOBOT @ RECALL OVER - D.M-  % describe string passed over, update window
  ;

'C..S :  % string descriptor, iteration count, C..S, success
%	(search for string)
  C.STRLEN 0<-  % initialize string length
  C.ARG @ EQZ_IF  % no iterations?
    2DROP DROP DISP -1 ELSE  % no iterations; drop desc.,  iter. count, succeed
    +ROT EQZ_IF  % null string?
      2DROP -1 ELSE  % yes, succeed
        UNDROP DUP MINUS C.SIGN @ * C.STRLEN ! -ROT  % save string length
        DUP GTZ_IF C.+S ELSE MINUS C.-S THEN  % do it
      THEN
    THEN
  DUP NOT IF  % success?
    C.STRLEN 0<- THEN  % no, zero string length
  ERR_SUPPRESS 0<-  % clear the error flag
  ;

'C..D :  % count, C..D, -1  (delete characters)
  C.STRLEN 0<-
  NEZ_IF  % nonzero iteration count?
    UNDROP DUP GTZ_IF  % which way
      C.D+ ELSE  % forward
      MINUS C.D- THEN  % backward
    THEN
  -1
  ;

'C..I :  % string desc., C..I, -1  (insert string)
  LTZ_IF  % direction of insertion?
    C.I+ ELSE
    C.I- THEN
  -1
  ;
