/*  E D ,   T H E   C P / M   C O N T E X T   E D I T O R  */
100H: DECLARE BDOS LITERALLY '0005H', BOOT LITERALLY '0';
	/*      COPYRIGHT  (C) 1976
	   DIGITAL RESEARCH
	   BOX 579 PACIFIC GROVE
	   CALIFORNIA 93950
	   */
	.DECLARE COPYRIGHT DATA ('COPYRIGHT (C) 1976, DIGITAL RESEARCH') ;

/* COMMAND              FUNCTION
   -------              --------
   A             APPEND LINES OF TEXT TO BUFFER
   B             MOVE TO BEGINNING OR END OF TEXT
   C             SKIP CHARACTERS
   D             DELETE CHARACTERS
   E             END OF EDIT
   F             FIND STRING IN CURRENT BUFFER
   H             MOVE TO TOP OF FILE (HEAD)
   I             INSERT CHARACTERS FROM KEYBOARD
                 UP TO NEXT (ENDFILE)
   J             JUXTAPOSITION OPERATION - SEARCH FOR FIRST STRING,
                 INSERT SECOND STRING, DELETE UNTIL THIRD STRING
   K             DELETE LINES
   L             SKIP L INES
   M             MACRO DEFINITION (SEE COMMENT BELOW)
   N             FIND NEXT OCCURRENCE OF STRING
                 WITH AUTO SCAN THROUGH FILE
   O             RE-EDIT OLD FILE
   P             PAGE AND DISPLAY (MOVES UP OR DOWN 24 LINES AND
                 DISPLAYS 24 LINES)
   Q             OUIT EDIT WITHOUT UPDATING THE FILE
   R<FILENAME>   READ FROM FILE <FILENAME>.LIB UNTIL <ENDFILE> AND
                 INSERT INTO TEXT
   S             SEARCH FOR FIRST STRING, REPLACE BY SECOND STRING
   T             TYPE LINES
   U             MOVE UP LINES (SAME AS -HP)
   W             WRITE LINES OF TEXT TO FILE
   Z             SLEEP FOR 1/2 SECOND (USED IN MACROS TO STOP DISPLAY)
   <CR>          MOVE UP OR DOWN AND PRINT ONE LINE
   
   A NUMBER OF COMMANDS CAN BE PRECEDED BY A POSITIVE OR
   NEGATIVE INTEGER BETWEEN 0 AND 65535 (1 IS DEFAULT IF NO VALUE
   IS SPECIFIED). TNIS VALUE DETERMINES THE NUMBER OF TIMES THE
   COMMAND IS APPLIED BEFORE RETURNING FOR ANOTHER COMMAND.
		THE COMMANDS
                    C D K L T P U <CR>
   CAN BE PRECEDED BY AN UNSIGNED, POSITIVE, OR NEGATIVE NUMBER.
		THE COMMANDS
                    A F J N W Z
   CAN BE PRECEDED BY AN UNSIGNED OR POSITIVE NUMBER.
		THE COMMANDS
                    E H D Q
   CANNOT BE PRECEDED BY AN UNSIGNED OR POSITIVE NUMBER.
        THE COMMANDS
                    F I J M R S
   ARE ALL FOLLOWED BY ONE OR MORE STRINGS OF CHARACTERS WHICH CAN
   BE OPTIONALLY SEPARATED OR TERMINATED BY EITHER <ENDFILE> OR <CR>.
   THE <ENDFILE> IS GENERALLY USED TO SEPARATE THE SEARCH STRINGS
   IN THE S AMD J COMMANDS, AND IS USED AT THE END OF THE COMMANDS IF
   ADDITIONAL COMMANDS FOLLOW. FOR EXAMPLE. THE FOLLOWING COMMAND
   SEQUENCE SEARCHES FOR THE STRING 'GAMMA', SUBSTITUTES THE STRING
   'DELTA', AND THEN TYPES THE FIRST PART OF THE LINE WHERE THE
   CHANGE OCCURRED, FOLLOWED BY THE REMAINDER OF THE LINE WHICH WAS
   CHANGED.
                 SGAMMA<ENDFILE>NDELTA<ENDFILE>ATT<CR>
   
   THE CONTROL-L CHARACTER IN SEARCH AND SUBSTITUTE STRINGS IS
   REPLACED ON INPUT BY <CR><LF>  CHARACTERS   THE CONTROL-I KEY
   IS TAKEN AS A TAB CHARACTER.
   
   THE COMMAND R MUST BE FOLLOWED BY A FILE NAME (WITH ASSUMED FILE
   TYPE OF 'LIB`) WITH A TRAILING <CR> OR <ENDFILE>.  THE COMMAND
   I IS FOLLOWED BY A STRING OF SYMBOLS TO INSERT.  TERMINATED BY
   A <CR> OR <ENDFILE>. IF SEVERAL LINES OF TEXT ARE TO BE INSERTED,
   THE I CAN BE DIRECTLY FOLLOWED BY AN <ENDFILE> OR <CR> IN WHICH
   CASE THE EDITOR ACCEPTS LINES OF INPUT TO THE NEXT <ENDFILE>.
   THE COMMAND 0T PRINTS THE FIRST PART OF THE CURRENT LINE,
   AND THE COMMAND 0L MOVES THE REFERENCE TO THE BEGINNING OF THE
   CURRENT LINE.  THE COMMAND 0P PRINTS THE CURRENT PAGE ONLY. WHILE
   THE COMMAND 0Z READS THE CONSOLE RATHER THAN WAITING (THIS IS USED
   AGAIN WITHIN MACROS TO STOP THE DISPLAY - THE MACRO EXPANSION
   STOPS UNTIL A CHARACTER IS READ.  IF THE CHARACTER IS NOT A BREAK
   THEN THE MACRO EXPANSION CONTINUES NORMALLY)
   
   NOTE THAT A POUND SIGN IS TAKEN AS THE NUMBER 65535, ALL
   UNSIGNED NUMBERS ARE ASSUMED POSITIVE, AND A SINGLE - IS ASSUMED -1
   
   A NUMBER OF COMMANDS CAN BE GROUPED TOGETHER AND EXECUTED
   REPETITIVELY USING THE MACRO COMMAND WHICH TAKES THE FORM
   
                    <NUMBER>MC1C2...CN<DELIMITER>
   
   WHERE <NUMBER> IS A NON-NEGATIVE INTEGER N, AND <DELIMITER> IS
   <ENDFILE> OR <CR>. THE COMMANDS Cl ... CN  FOLLOWING THE M ARE
   EXECUTED N TIMES, STARTING AT THE CURRENT POSITION IN THE BUFFER.
   IF N IS 0, 1, OR OMITTED, THE COMMANDS ARE EXECUTED UNTIL THE END
   IF THE BUFFER IS ENCOUNTERED.
   
   THE FOLLOWING MACRO, FOR EXAMPLE, CHANGES ALL OCCURRENCES OF
   THE NAME 'GAMMA' TO 'DELTA', AND PRINTS THE LINES WHICH
   WERE CHANGED,
   
                    MFGAMMA<ENDFILE>-5DIDELTA<ENDFILE>0LT<CR>
   
   (NOTE, AN <ENDFILE>  IS THE CP/M END OF FILE MARK - CONTROL-Z)
   
   IF ANY KEY IS DEPRESSED DURING TYPING OR MACRO EXPANSION. THE
   FUNCTION IS CONSIDERED TERMINATED, AND CONTROL RETURNS TO THE
   OPERATOR.
   
   ERROR CONDITIONS ARE INDICATED BY PRINTING ONE OF THE CHARACTERS,
   
   SYMBOL                        ERROR CONDITION
   ------      ----------------------------------------------------
   GREATER     FREE MEMORY IS EXHAUSTED - ANY COMMAND CAN 8E ISSUED
               WHICH DOES NOT INCREASE MEMORY REQUIREMENTS.
   QUESTION    UNRECOGNIZED COMMAND OR ILLEGAL NUMERIC FIELD
   POUND       CANNOT APPLY THE COMMAND THE NUMBER OF TINES SPECIFIED
               (OCCURS IF SEARCH STRING CANNOT BE FOUND).
   LETTER O    CANNOT OPEN <FILENAME>.LIB IN R COMMAND
   
   THE ERROR CHARACTER IS ALSO ACCOMPANIED BY THE LAST CHARACTER
   SCANNED WHEN THE ERROR OCCURRED.                     */

DECLARE LIT LITERALLY 'LITERALLY',
	DCL LIT 'DECLARE',
	PROC LIT 'PROCEDURE',
	ADDR LIT 'ADDRESS',
	CTLL LIT '0CH',
	CTLU LIT '15H',							/* LINE DELETE IN INSERT MODE */
	LCA LIT '110$0001B',					/* LOWER CASE A */
	LCZ LIT '111$1010B',					/* LOWER CASE Z */
	ENDFILE LIT '1AH';						/* CP/M END OF FILE */

DECLARE MAXA ADDRESS INITIAL(0006H),        /* MONITOR LOCATION */
	MAX ADDRESS,							/* FILLED FROM MAXA */
	MAXM ADDRESS,							/* MINUS 1 */
	HMAX ADDRESS,							/* HALF THE VALUE OF MAXM */
	MAZB BASED MAXA ADDRESS;				/* TEMP TO COMPUTE ADDR */

DECLARE NBUF LITERALLY '7',					/* NUMBER OF BUFFERS-1 */
	BUFS LITERALLY '1024',					/* (NBUF+1) * 128 */
	BDISKA ADDRESS INITIAL(4),				/* BOOT DISK ADDRESS */
	BDISK BASED BDISKA BYTE,				/* BOOT DISK VALUE */
	FCBA ADDRESS INITIAL(5CH),
	FCB BASED FCBA (33) BYTE,				/* DEFAULT FCB AT 5CH */
	BUFA ADDRESS INITIAL (80H),				/* DISK IO BUFFER ADDRESS */
	RFCB (33) BYTE							/* READER FILE CONTROL BLOCK */
	INITIAL(0, /* FILE NAME */ '		  ',
		/* FILE TYPE */ 'LIB'),
	PBP BYTE,								/* READ BUFFER POINTER */
	BUFF BASED BUFA (33) BYTE,				/* DISKI0 BUFFER */
	SFCB BASED FCBA (33) BYTE,				/* SOURCE FILE CONTROL */
	SBUFF(BUFS) BYTE,						/* SOURCE BUFFER */
	DFCB (33) BYTE,							/* DEST FILE CONTROL BLOCK */
	DBUFF (BUFS) BYTE,						/* DESTINATION BUFFER */
	NSOURCE ADDRESS,						/* NEXT SOURCE CHARACTER */
	NDEST   ADDRESS;						/* NEXT DESTINATION CHAR */

DECLARE SDISK BYTE,							/* SOURCE FILE DISK */
	DDISK BYTE;								/* DESTINATION FILE DISK */
/* IO SECTION */
MON1: PROCEDURE(F,A) ; DECLARE F BYTE, A ADDRESS;
	GO TO BDOS;
	END MON1;

MON2: PROCEDURE(F,A) BYTE; DECLARE F BYTE, A ADDRESS#
	GO TO BDOS;
	END MON2;

READCHAR: PROCEDURE BYTE; RETURN MON2(1,0);
	END READCHAR;

DECLARE TRUE LITERALLY '1', FALSE LITERALLY '0',
	FOREVER LITERALLY 'WHILE TRUE',
	CR LITERALLY '13',
	LF LITERALLY '10',
	WHAT LITERALLY '63';

^PRINTCHAR: PROCEDURE(CHAR);
	DECLARE CHAR BYTE;
	CALL MON1(2,CHAR);
	END PRINTCHAR;

CRLF: PROCEDURE;
	CALL PRINTCHAR<CR>; CALL PRINTCHAR (LF);
	END CRLF;

^PRINT: PROCEDURE (A) ;
	DECLARE A ADDRESS;
	CALL CRLF; CALL MON1(9,A);
	END PRINT;

READ: PROCEDURE(A);
	DECLARE A ADDRESS;
	CALL MON1(10,A);
	END READ;

DECLARE DCNT BYTE;

OPEN: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	DCNT = MON2(15,FCB);
	END OPEN;

CLOSE: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	DCNT = MON2(16,FCB);
	END CLOSE;

SEARCH: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	DCNT = MON2(17,FCB);
	END SEARCH;

DELETE: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	CALL MON1(19,FCB) ;
	END DELETE;

DISKREAD: PROCEDURE(FCB) BYTE;
	DECLARE FCB ADDRESS;
	RETURN MON2(20,FCB) ;
	END DISKREAD;

DISKWRITE, PROCEDURE(FCB) BYTE;
	DECLARE FCB ADDRESS;
	RETURN MON2(21,FCB);
	END DISKWRITE;

MAKE: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	DCNT = MON2(22,FCB);
	END MAKE;

RENAME: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	CALL MON1(23,FCB);
	END RENAME;

DECLARE (MAXLEN,COMLEN) BYTE, COMBUFF(128) BYTE,
	(TCBP,CBP) BYTE;

READCOM, PROCEDURE;
	MAXLEN = 123; CALL READ(.MAXLEN);
	END READCOM;

BREAK$KEY: PROCEDURE BYTE;
	IF MON2(11,0) THEN
		DO; /* CLEAR CHAR */
		CALL MON1(1,0); RETURN TRUE;
		END;
	RETURN FALSE;
	END BREAK$KEY;

CSELECT: PROCEDURE BYTE;
	/* RETURN CURRENT DRIVE NUMBER */
	RETURN MON2(25,0);
	END CSELECT;

SELECT: PROCEDURE(DISK);
	DECLARE DISK BYTE;
	/* SET DRIVE NUMBER */
	CALL MON1(14,DISK);
	END SELECT;

SETDMA: PROCEDURE(A);
	DECLARE A ADDRESS;
	/* SET DMA ADDRESS */
	CALL MON1(26,A);
	END SETDMA;

LIFTHEAD: PROCEDURE;
	/* LIFT HEAD ON SA 3900 DISK */
	CALL MON1(12,0);
	END LIFTHEAD;
/* INPUT / OUTPUT SUFFERING ROUTINES */

MOVE: PROCEDURE(S,D,N);
	DECLARE(S,D) ADDRESS, N BYTE;
	DECLARE A BASED S BYTE, B BASED D BYTE;
	DC WHILE (N := N - 1)<> 255;
	B = A; S = S + 1; D = D + l;
	END;
END MOVE;

FERR: PROCEDURE;
	CALL CRLF;
	CALL PRINT (.'FILE ERROR$');
	CALL CRLF;
	GO TO BOOT;
	END FERR;

SETTYPE, PROCEDURE(A);
	DECLARE A ADDRESS;
	CALL MOVE(A, .DFCB+9,3);
	END SETTYPE;

SETUP: PROCEDURE;
	NSOURCE = LENGTH(SBUFF); NDEST = 0;
	SFCB(12) = 0; SFCB(32) = 0;
	/* REEL AND RECORD ZEROED */
	/* COPY NAME TO DESTINATION FCB */
	CALL MOVE(FCBA,.DFCB,33);
	/* SOURCE AND DESTINATION DISKS SET */
	CALL SELECT(SDISK);
	CALL OPEN(FCBA);
	IF DCNT = 255 THEN
		DO; CALL MAKE(FCBA);
		IF DCNT = 255 THEN CALL FERR;
		CALL PRINT(.'NEW FILE$');
		CALL CRLF;
		END;
	CALL SETTYPE(. 'BAK');
	CALL DELETE(.DFCB);
	IF SDISK <> DDISK THEN
		DO; /* REMOVE BAK FILES FROM DESTINATION DISK */
		CALL SELECT(DDISK);
		CALL DELETED(.DFCB);
		END;
	CALL SETTYPE(. '$$$') ;
	CALL DELETE(.DFCB);
	CALL MAKE(.DFCB);
	DFCB(32) = O; /* NEXT RECORD IS ZERO */
	IF DCNT = 255 THEN CALL FERR;
	/* THE TEMP FILE IS NQU CREATED */
	END SETUP;

FILLSOURCE: PROCEDURE;
	DECLARE I BYTE;
	ZN: PROCEDURE;
		NSOURCE * 0;
		END ZN;
	
	CALL ZN;
	CALL SELECT(SDISK);
	DO I = 0 TO NBUF;
		CALL SETDMA(.SBUFF(NSOURCE));
		IF (DCNT := DISKREAD(FCBA)) <>  0 THEN
			DO; IF DCNT >   1 THEN CALL FERR;
			SBUFF(NSOURCE) = ENDFILE;
			I = NBUF;
			END;
		ELSE
			NSOURCE = NSOURCE * 80h;
		END;
	CALL ZN;
	END FILLSOURCE;

GETSOURCE: PROCEDURE BYTE;
	DECLARE B BYTE;
	IF NSOURCE >  = LENGTH(SBUFF) THEN CALL FILLSOURCE;
	IF (B := SBUFF(NSOURCE)) <> ENDFILE THEN
		NSOURCE = NSOURCE + 1;
	RETURN B;
	END GETSOURCE;

WRITEDEST: PROCEDURE;
	/* WRITE OUTPUT BUFFER UP TO(NOT INCLUDING) NDEST.
	   LOW 7 BITS OF NDEST ARE ZERO */
	DECLARE (I,N) BYTE;
	ZN: PROCEDURE;
		NDEST = 0;
		END ZN;
	
	CALL SELECT(DDISK);
	IF LOW((N := SHR(NDEST,7) - 1)) = 255 THEN RETURN;
	CALL ZN;
	DO I = 0 TO N;
		CALL SETDMA(.DBUFF(NDEST));
		IF DISKWRITE(.DFCB) <>   0 THEN CALL FERR;
		NDEST = NDEST + 128;
		END;
	CALL ZN;
	END WRITEDEST;

^PUTDEST: PROCEDURE(B);
	DECLARE B BYTE;
		IF NDEST) >= LENGTH(DBUFF) THEN CALL WRITEDEST;
	DBUFF(NDEST) = B;
	NDEST = NDEST + 1;
	END PUTDEST;

FINIS: PROCEDURE;
	MOVEUP:  PROCEDURE;
		CALL MOVE(.DFCB,.DFCB+16,16);
		END MOVEUP;
	
	/* CLEAR OUTPUT */
	DO WHILE(LOW(NDEST) AND 7FH) <> 0;
		CALL PUTDEST<ENDFILE>;
		END ;
	CALL WRITEDEST;
	
	CALL CLOSE(. DFC0);
	IF DCNT = 255 THEN CALL FERR;
	/* RENAME OLD FILE TO BAX */
	CALL SETTYPE(.'BAK'); CALL MOVEUP;
	CALL SELECT(SDISK);
	CALL MOVE(FCBA,.DFCB,16);
	CALL RENAME(.DFCB);
	CALL MCVEUP;
	/* RENAME $$$ TO OLD NAME */
	CALL SETTYPE(.'$$$');
	CALL SELECT(DDISK);
	CALL RENAME(.DFCB);
	END FINIS;

DECLARE
	LPP LIT '23',             /*  LINES PER PAGE */
	FORWARD LIT 'l',
	BACKWARD LIT '0',
	RUBOUT LIT '07FH',
	POUND LIT '23H',
	MACSIZE LIT '128',           /* MAX MACRO SIZE */
	SCRSIZE LIT '100',           /* SCRATCH BUFFER SIZE */
	COMSIZE LIT 'ADDRESS';  /* DETERMINES MAX COMMAND NUMBER*/

DCL MACRO(MACSIZE) BYTE,
	SCRATCH(SCRSIZE) BYTE,          /* SCRATCH BUFFER FOR F,N,S */
	(UBP, WBE, WBJ) BYTE,          /* END OF F STRING, S   STRING, J STRING */
	(FLAG, MP, MI, XP, COLUMN) BYTE,
	MT COMSIZE;

DCL(START, RESTART, OVERCOUNT, OVERFLOW, RESET, BADCOM) LABEL;

DCL INSERTING BYTE,          /* TRUE IF INSERTING CHARACTERS */
	READBUFF BYTE;           /* TRUE IF END OF READ BUFFER */

DECLARE
	TAB LITERALLY '11Q',
	EOS LITERALLY '0FFH';


TTYCHAR: PROCEDURE(CHAR);
	DECLARE CHAR BYTE;
	IF CHAR >= ' ' THEN COLUMN = COLUMN + 1;
	IF CHAR = CR THEN COLUMN = 0;
	CALL PRINTCHAR(CHAR);
	END TTYCHAR;

^PRINTC: PROCEDURE(CHAR);
	DECLARE (CHAR,I,J) BYTE;
	I = CHAR = TAB AND 7 - (COLUMN AND 7);
	IF CHAR = TAB THEN CHAR = ' ';
	DO J = 0 TO I;
		CALL TTYCHAR(CHAR);
		END;
	END PRINTC;

^PRINTNMAC: PROCEDURE(CHAR);
	DECLARE CHAR BYTE;
	/* PRINT IF NOT IN MACRO EXPANSION */
	IF MP <> 0 THEN RETURN;
	CALL PRINTC(CHAR);
	END PRINTNMAC;

DECLARE TRANSLATE BYTE,  /* TRUE IF TRANSLATION TO UPPER CASE */
	UPPER BYTE;         /* TRUE   IF  GLOBALLY  TRANLATING TO UC   */

LOWERCASE: PROCEDURE(C) BYTE;
	DECLARE C BYTE;
	/* RETURN TRUE IF LOWER CASE ALPHABETIC */
	RETURN C >= LCA AND C <= LCZ;
	END LOWERCASE;

UTRAN: PROCEDURE(C) BYTE;
	DECLARE C BYTE;
	/* TRANSLATE TO UPPER CASE IF ALPHABETIC LOWER AND TRANSLATE */
	IF TRANSLATE AND LOWERCASE(C) THEN C =  C AND 10111110;
	RETURN C;
	END UTRAN;

READC; PROCEDURE BYTE;
	/* MAY BE MACRO EXPANSION */
	IF MP > 0 THEN
		DO;
		IF BREAK$KEY THEN GO TO RESET;
		IF XP >= MP THEN
			DO; /* START AGAIN */
			IF MT <> 0 THEN
				DO; IF(MT:=MT-1) = 0 THEN
				GO TO RESET;
				END;
			XP = 0;
			END;
		RETURN UTRAN(MACRO((XP XP + 1) - 1)
		END;
	IF INSERTING THEN RETURN UTRAN(READCHAR)
		
	/* GET COMMAND LINE */
	IF READBUFF THEN
		DO; READBUFF = FALSE; CALL LIFTHEAD;
		CALL PRINTC('*');
		CALL READCOM; CBP = 0;
		CALL PRINTC(LF);
		COLUMN = 0;
		END;
	IF (READBUFF := CBP = COMLEN ) THEN COMBUFF(CBP) = CR;
	RETURN UTRAN(COMBUFF((CBP := CBP +1) -1));
	END READC;

READFILE:    PROCEDURE BYTE;
	IF RBP >= 80H THEN
		DO; CALL SELECT(SDISK);
		IF DISKREAD(.RFCB) <> 0 THEN RETURN  ENDFILE;
		RBP = 0;
		END;
	RETURN UTRAN(BUFF((RBP := RBP + i) - 1));
	END READFILE;

GETMEM: PROC(I) BYTE;
DCL I ACDR;
RETURN MEMORY(I);
END GETMEM;

^PUTMEM: PROC(I,J);
	DCL I ADDR, J BYTE;
	MEMORY(I) = J;
	END PUTMEM;

TRANSFER: PROC(I,J);
	DCL (I,J) ADDR ;
	CALL PUTMEM(I,GETMEM(J));
	END TRANSFER;

DCL(DISTANCE. TDIST) COMSIZE,
	(DIRECTION, CHAR) BYTE,
	( FRONT, BACK, FIRST, LAST) ADDR;

SETFF: PROCEDURE;
	DISTANCE = 0FFFFH;
	END SETFF;

DISTZERO: PROCEDURE BYTE;
	/* RETURN TRUE IF DISTANCE IS ZERO */
	RETURN DISTANCE = 0;
	END DISTZERO;

ZERODIST: PROCEDURE;
	DISTANCE = 0;
	END ZERODIST;

DISTNZERO: PROCEDURE BYTE;
	/* CHECK FOR ZERO DISTANCE AND DECREMENT */
	IF NOT DISTZERO THEN
		DO; DISTANCE = DISTANCE - 1;
		RETURN TRUE;
		END;
	RETURN FALSE;
	END NDISTNZERO;

SETLIMITS: PROC;
	DCL(I,K,L,M) ADDR,(MIDDLE,LOOPING) BYTE;
	IF DIRECTION = BACKWARD THEN
		DO; DISTANCE = DISTANCE+1; I = FRONT; L = 0; K * 0FFFFH;
		END; ELSE
		DO; I = BACK; L = MAXM; K = 1;
		END;

	LOOPING = TRUE;
	DO WHILE LOOPING;
		DO WHILE(MIDDLE := I <> L) AND
			GETMEM(M := I+K) <> LF;
			I = M;
			END;
		LOOPING =(DISTANCE := DISTANCE - 1) <> 0;
		IF NOT MIDDLE THEN
			DO; LOOPING = FALSE;
			I = I - K;
			END; ELSE
			IF LOOPING THEN I = M;
		END;

	IF DIRECTION = BACKWARD THEN
		DO; FIRST = I; LAST = FRONT - 1;
		END; ELSE
		DO; FIRST = BACK + I; LAST = I + 1;
		END;
	END SETLIMITS;

SETPTRS: PROCEDURE;
	IF DIRECTION = FORWARD THEN BACK-LAST; ELSE FRONT=FIRST;
	END SETPTRS;

INCFRONT: PROC; FRONT = FRONT + 1;
	END INCFRONT;
INCBACK: PROCEDURE; BACK = BACK + 1;
	END INCBACK;
DECFRONT: PROC; FRONT = FRONT - 1;
	END DECFRONT;
DECBACK: PROC; BACK = BACK - 1;
	END DECBACK;

MOVER: PROC;
IF DIRECTION = FORWARD THEN
	DO WHILE BACK < LAST; CALL INCBACK;
	CALL TRANSFER(FRONT,BACK); CALL INCFRONT;
	END; ELSE
	DO WHILE FRONT > FIRST; CALL DECFRONT;
	CALL TRANSFER(BACK,FRONT); CALL DECBACK;
	END;
END MOVER;

MOVELINES: PROC;
CALL SETLIMITS;
CALL MOVER;
END MOVELINES;

SETCLIMITS: PROC;
IF DIRECTION = BACKWARD THEN
	DO; LAST = BACK;
	IF DISTANCE > FRONT THEN
		FIRST = 1; ELSE FIRST = FRONT - DISTANCE;
	END; ELSE
	DO; FIRST = FRONT;
	IF DISTANCE >= MAX - BACK THEN
		LAST = MAXM; ELSE LAST = BACK + DISTANCE;
	END ;
END SETCLIMITS;

READLINE: PROCEDURE;
	DECLARE B BYTE;
	/* READ ANOTHER LINE OF INPUT */
	CTRAN: PROCEDURE(B) BYTE;
		DECLAPE B BYTE;
		/* CONDITIONALLY TRANSLATE TO UPPER CASE ON INPUT */
		IF UPPER THEN RETURN UTRAN(B);
		RETURN B;
		END CTRAN;
	DO FOREVER;
		IF FRONT >= BACK THEN GO TO OVERFLOW;
		IF (B := CTRAN(GETSOURCE)) = ENDFILE THEN
			DO; CALL ZERODIST; RETURN;
			END;
		CALL PUTMEM(FRONT, B) ;
		CALL INCFRONT;
		IF B = LF THEN RETURN;
		END;
	END READLINE;

WRITELINE: PROCEDURE;
	/* WRITE ONE LINE OUT */
	DECLARE B BYTE;
	DO FOREVER;
		IF BACK >= MAXM THEN /* EMPTY */
			DO; CALL ZERODIST; RETURN;
			END;
		CALL INCBACK;
		CALL PUTDEST(B:=GETMEM(BACK));
		IF B = LF THEN RETURN;
		END;
	END WRITELINE;

WRHALF: PROCEDURE;
	/* WRITE LINES UNTIL AT LEAST HALF THE BUFFER IS EMPTY */
	CALL SETFF;
	DO WHILE DISTNZERO;
		IF HMAX >= (MAXM - BACK) THEN CALL ZERODIST; ELSE
		CALL WRITELINE;
		END;
	END WRHALF;

WRITEOUT: PROCEDURE;
	/* WRITE LINES DETERMINED BY 'DISTANCE',
	   CALLED FROM W AND E COMMANDS */
	DIRECTION = BACKWARD; FIRST = I; LAST = BACK;
	CALL MOVER;
	IF DISTZERO THEN CALL WRHALF;
	/* DISTANCE = 0 IF CALL WRHALF */
	DO WHILE DISTNZERO;
		CALL WRITELINE;
		END;
	IF BACK < LAST THEN
		DO; DIRECTION = FORWARD; CALL MOVER;
		END;
	END WRITEOUT;

CLEARMEM, PROCEDURE;
	/* CLEAR MEMORY BUFFER */
	CALL SETFF;
	CALL WRITEOUT;
	END CLEARMEM;

TERMINATE: PROCEDURE;
	/* CLEAR BUFFERS */
	CALL CLEARMEM;
	DO WHILE(CHAR := GETSOURCE) <> ENDFILE;
		CALL PUTDEST(CHAR);
		END;
	CALL FINIS;
	END TERMINATE;

INSERT: PROCEDURE;
	/* INSERT CHAR INTO MEMORY BUFFER */
	IF FRONT = BACK THEN GO TO OVERFLOW;
	CALL PUTMEM(FRONT,CHAR); CALL INCFRONT;
	END INSERT;

SCANNING: PROCEDURE BYTE;
	/* READ A CHARACTER AND CHECK FOR ENDFILE OR CR */
	RETURN NOT((CHAR := READC) = ENDFILE OR
	(CHAR = CR AND NOT INSERTING));
	END SCANNING;

COLLECT: PROCEDURE;
	/* READ COMMAND BUFFER AND INSERT CHARACTERS INTO
	   SCRATCH 'TIL NEXT CONTROL-Z OR CR FOR FIND, NEXT, JUXT, OR
	   SUBSTITUTE COMMANDS - FILL AT WBE AND INCREMENT WBE SO IT
	   ADDRESSES NEXT EMPTY POSITION OF SCRATCH */
	SETSCR: PROCEDURE;
		SCRATCH(WBE) = CHAR;
		IF(WBE := WBE + 1) > LAST(SCRATCH) THEN GO TO OVERFLOW;
		END SETSCR;
	DO WHILE SCANNING;
		IF CHAR = CTLL THEN
			DO; CHAR = CR; CALL SETSCR;
			CHAR = LF;
			END;
		IF CHAR = 0 THEN GO TO RESET;
		CALL SETSCR;
		END;
	END COLLECT;

FIND: PROCEDURE(PA,PB) BYTE;
	DECLARE(PA, PB) BYTE;
	/* FIND THE STRING IN SCRATCH STARTING AT PA AND ENDING AT PB */
	DECLARE J ADDRESS;
	(K, MATCH) BYTE;
	J = BACK ; MATCH = FALSE;
	DO WHILE NOT MATCH AND (MAXM > J); /* START SCAN AT J */
		LAST,J = J + 1; K = PA ; /* ATTEMPT STRING MATCH AT K */
		DO WHILE SCRATCH(K) = MEMORY(LAST) AND NOT (MATCH := K = PB);
			K = K + 1; LAST = LAST + 1;
			END;
		END;
	IF MATCH THEN /* MOVE STORAGE */
		DO; LAST = LAST - 1; CALL MOVER;
		END;
	RETURN MATCH;
	END FIND;

SETFIND: PROCEDURE;
	/* SETUP THE SEARCH STRING FOR F,N, AND S COMMANDS */
	USE = 0; CALL COLLECT; WBP = WBE;
	END SETFIND;

CHKFOUND: PROCEDURE;
	/* CHECK FOR FOUND STRING IN F AND S COMMANDS */
	IF NOT FIND(0,WBP) THEN /* NO MATCH */ GO TO OVERCOUNT;
		END CHKFOUND;


SETRFCB; PROCEDURE;
	/* PLACE CHAR INTO READ FILE CONTROL BLOCK AND INCREMENT */
	RFCB((RBP := RBP + 1) - 1) = CHAR;
	END SETRFCB;

TYPELINES: PROCEDURE;
	DCL I ADDR;
	CALL SETLIMITS;
	IF GETMEM(FIRST - 1) = LF AND COLUMN <>  0 THEN
		DO; CALL PRINTC(CR); CALL PRINTC(LF);
		END;
	DO I = FIRST TO LAST;
		IF BREAK$KEY THEN
			GO TO RESET;
		CALL PRINTC(GETMEM(I));
		END;
	END TYPELINES;

SETLPP: PROCEDURE;
	/* SET DISTANCE TO LINES PER PAGE */
	DISTANCE = LPP;
	END SETLPP;

SAVEDIST: PROCEDURE;
	TDIST = DISTANCE;
	END SAVEDIST;

RESTDIST: PROCEDURE;
	DISTANCE = TDIST;
	END RESTDIST;

^PAGE: PROCEDURE;
	DECLARE I BYTE;
	CALL SAVEDIST;
	CALL SETLPP;
	CALL MOVELINES;
	I = DIRECTION;
	DIRECTION = FORWARD;
	CALL SETLPP;
	CALL TYPELINES;
	DIRECTION = I;
	IF LAST = MAXM OR FIRST = 1 THEN CALL ZERODIST;
	ELSE CALL RESTDIST;
	END PAGE;

WAIT: PROCEDURE;
	/* 1/2 SECOND TIME OUT */
	DECLARE I BYTE;
	DO I = 0 TO 19;
		IF BREAK$KEY THEN GO TO RESET;
		CALL TIME(250);
		END;
	END WAIT;

SETFORWARD: PROCEDURE;
	DIRECTION = FORWARD;
	DISTANCE = 1;
	END SETFORWARD;

APPHALF: PROCEDURE;
	/* APPEND 'TIL BUFFER IS AT LEAST HALF FULL */
	CALL SETFF; /* DISTANCE = 0FFFFH */
	DO WHILE DISTNZERO;
		IF FRONT >= HMAX THEN CALL ZERODIST; ELSE
		CALL READLINE;
		END;
	END APPHALF;

INSCRLF: PROCEDURE;
	/* INSERT CR LF CHARACTERS */
	CHAR = CR; CALL INSERT;
	CHAR = LF; CALL INSERT;
	END INSCRLF;

TESTCASE: PROCEDURE;
	DECLARE T BYTE;
	/* TEST FOR UPPER OR LOWER CASE COMMAND AND SET TRANSLATE
	   FLAG (USED TO DETERMINE IF CHARACTERS WHICH FOLLOW GO TO UPPER */
	TRANSLATE = TRUE;
	T = LOWERCASE(CHAR);
	CHAR = UTRAN(CHAR);
	TRANSLATE = UPPER OR NOT T;
	END TESTCASE;

READCTRAN: PROCEDURE;
	/* SET TPANSLATE TO FALSE AND READ NEXT CHARACTER */
	TRANSLATE = FALSE;
	CHAR = READC;
	CALL TESTCASE;
	END READCTRAN;

SINGLECOM: PROCEDURE(C) BYTE;
	/* RETURN TRUE IF COMMAND IS ONLY CHARACTER, NOT IN MACRO */
	DECLARE C BYTE;
	RETURN CHAR= C AND CONLEN = 1 AND MP;
	END SINGLECOM;

/* INITIALIZE THE SYSTEM */
MAX = MAXB - MEMORY - 1;
MEMORY(MAX) = 0; /* STOPS MATCH AT END OF BUFFER */
MAXM = MAX - 1;
HMAX = SHR(MAXM,1);
/* INITIALLY ASSUME NO TRANSLATE TO UPPER CASE */
UPPER = FALSE;
/*  GET SOURCE AND DESTINATION DISKS */
IF (FCB(l) = ' ') OR (FCB(17) <> ' ') THEN CALL FERR;
IF (SDISK := FCB)= 0 THEN SDISK = CSELECT; ELSE
DO; SDISK = SDISK - 1; FCB = 0; /* CLEAR DISK NAME */
	END;
IF (DDISK := FCB(16)) = 0 THEN DDISK = SDISK; ELSE
DDISK = DDISK - 1;

RESTART:
CALL SETUP;
MEMORY = LF;
FRONT = 1; BACK = MAXM;
COLUMN = 0;
GO TO START;

OVERCOUNT: FLAG = POUND; GO TO RESET;

BADCOM:   FLAG = WHAT; GO TO RESET;

OVERFLOW: /* ARRIVE HERE ON OVERFLOW CONDITION (I,P,S COMMAND) */
FLAG = '>';

RESET: /* ARRIVE HERE OH SYSTEM RESET OR OVERFLOW CONDITION */
CALL PRINTC(CR); CALL PRINTC(LF);
CALL PRINTC(CHAR);
CALL PRINTC(FLAG);
CALL CRLF;

START:
READBUFF = TRUE;
MP = 0;
DO FOREVER; /* OR UNTIL THE POWER IS TURNED OFF  */
	/* **************************************************************
	   SIMPLE COMMANDS (CANNOT BE PRECEDED BY DIRECTION/DISTANCE):
	   E      END THE EDIT NORMALLY
	   H      MOVE TO HEAD OF EDITED FILE
	   I      INSERT CHARACTERS
	   O      RETURN TO THE ORIGINAL FILE
	   R      READ FROM LIBRARY FILE
	   Q      QUIT EDIT WITHOUT CHANGES TO ORIGINAL FILE
	   ************************************************************** */
	
	INSERTING = FALSE;
	CALL READCTRAN;
	MI = CBP; /* SAVE STARTING ADDRESS FOR <CR>  COMMAND */
	IF SINGLECOM('E') THEN
		DO; CALL TERMINATE;
		IF SDISK <> DDISK THEN BDISK = DDISK;
		GO TO BOOT;
		END; ELSE
		
	
	IF SINGLECOM('H') THEN /* GO TO TOP */
		DO; CALL TERMINATE;
		CHAR = DDISK; DDISK = SDISK; SDISK = CHAR;
		/* PING - PONG DISKS */
		GO TO RESTART;
		END; ELSE
		
	
	IF CHAR = 'I' THEN /* INSERT CHARACTERS */
		DO;
		INSERTING = (CBP = COMLEN) AND(MP = 0);
		DO WHILE SCANNING;
			DO WHILE CHAR <> O;
				IF CHAR = CTLU THEN /* LINE DELETE */
					DO; CALL PRINTC(CR); CALL PRINTC(LF);
					/* ELIMINATE LINE */ DIRECTION = BACKWARD;
					DISTANCE = 0; CALL SETLIMITS; CALL SETPTRS;
					END; ELSE
					IF CHAR = RUBOUT THEN
					DO; IF FRONT = 1 THEN GO TO RESET;
					CALL DECFRONT; CALL PRINTC(GETMEM(FRONT));
					END; ELSE
					IF CHAR = CTLL THEN CALL INSCRLF; ELSE
				CALL INSERT;
				IF CHAR = CR THEN
					CALL PRINTNMAC(CHAR:=LF); ELSE CHAR=0;
				END;
			END;
		IF CHAR <> ENDFILE THEN /* MUST HAVE STOPPED ON CR */
			CALL INSCRLF;
		END; ELSE
		
	
	IF SINGLECOM('0') THEN /* FORGET THIS EDIT */
		GO TO RESTART; ELSE
		IF CHAR = 'R' THEN
		DO; /* READ FROM 'LIB' FILE */
		TRANSLATE = TRUE;
		RBP = 1;
		DO WHILE SCANNING;
			IF RBP > 0 THEN GO TO OVERCOUNT;
			CALL SETRFCB;
			END;
		CHAR = ' ';
		DO WHILE RBP <= 8;
			CALL SETRFCB;
			END;
		RFCB(12), RFCB(32) = 0; /* FILL REEL, AND NEXT RECORD */
		CALL OPEN(RFCB):= RBP = 80H;
		IF DCNT = 255 THEN
			DO; FLAG = 'O'; GO TO RESET;
			END;
		DO WHILE (CHAR := READFILE) <> ENDFILE;
			IF UPPER THEN CHAR = UTRAN(CHAR)
				CALL INSERT;
			END;
		END; ELSE
		
	
	IF SINGLECOM('Q') THEN
		DO; CALL DELETE(DFCB); GO TO BOOT;
		END; ELSE
		
	
	/* MAY BE A COMMAND WHICH HAS AN OPTIONAL DIRECTION AND DISTANCE */
	DO; /* SCAN A SIGNED INTEGER VALUE(IF ANY) */
		DCL I BYTE;
		CALL SETFORWARD;
		
		IF CHAR = '-' THEN
			DO; CALL READCTRAN; DIRECTION = BACKWARD;
			END;
		
		IF CHAR = POUND THEN
			DO; CALL SETFF; CALL READCTRAN;
			END; ELSE
			
		IF (I:=CHAR-'0')<= 9 THEN
			DO; DISTANCE = I; CALL READCTRAN;
			DO WHILE (I := CHAR - '0') <= 9;
				DISTANCE = SHL(DISTANCE,3) + SHL(DISTANCE,1) * I;
				CALL READCTRAN;
				END;
			END;
		IF DISTZERO THEN DIRECTION = BACKWARD;
		/* DIRECTION AND DISTANCE ARE NOW SET */
		
		
		/* **************************************************************
		   MAY BE A COMMAND WHICH HAS DIRECTION AND DISTANCE SPECIFIED:
		   B      BEGINNING/BOTTOM OF BUFFER
		   C      MOVE CHARACTER POSITIONS
		   D      DELETE CHARACTERS
		   K      KILL LINES
		   L      MOVE LINE POSITION
		   P      PAGE UP OR DOWN (LPP LINES AND PRINT)
		   T      TYPE LINES
		   U      OPPOSITE L
		   <CR>     MOVE UP OR DOWN LINES AND PRINT LINE
		   ************************************************************** */
		
		
		IF CHAR = '8' THEN
			DO; DIRECTION = 1 - DIRECTION;
			FIRST = 1; LAST = MAXM; CALL MOVER;
			END; ELSE
			
		
		IF CHAR = 'C' THEN
			DO; CALL SETCLIMITS; CALL MOVER;
			END; ELSE
			
		
		IF CHAR = 'D' THEN
			DO; CALL SETCLIMITS;
			CALL SETPTRS; /* SETS BACK/FRONT */
			END; ELSE
			
		
		IF CHAR = 'K' THEN
			DO; CALL SETLIMITS;
			CALL SETPTRS;
			END; ELSE
			
		
		IF CHAR = 'L' THEN CALL MOVELINES; ELSE
		
		IF CHAR = 'P' THEN /* PAGE MODE PRINT */
			DO; IF DISTZERO THEN
				DO; DIRECTION = FORWARD;
				CALL SETLPP; CALL TYPELlNES;
				END; ELSE
				DO WHILE DISTNZERO; CALL PAGE;
				CALL WAIT;
				END;
			END; ELSE
			
		
		IF CHAR = 'T' THEN
			CALL TYPELlNES; ELSE
			
		
		
		IF CHAR = 'U' THEN
			UPPER = DIRECTION = FORWARD; ELSE
			
		
		IF CHAR = CR THEN /* MAY BE MOVE/TYPE COMMAND */
			DO;
			IF MI = 1 AND MP = 0 THEN /* FIRST COMMAND */
				DO; CALL MOVELINES; CALL SETFORWARD; CALL TYPELlNES;
				END;
			END; ELSE
			
		
		IF DIRECTION = FORWARD OR DISTZERO THEN
			DO;
			
			/* **************************************************************
			   COMMANDS WHICH ALLOW DULY A PRECEDING NUMBER
			   A       APPEND LINES
			   F       FIND NTH OCCURRENCE
			   M       APPLY MACRO
			   N       SAME AS F WITH AUTOSCAN THROUGH FILE
			   S       PERFORM N SUBSTITUTIONS
			   W       WRITE LINES TO OUTPUT FILE
			   ************************************************************** */
			
			IF CHAR = 'A' THEN
				DO;
				FIRST = FRONT; LAST = MAXM; CALL MOVER;
				/* ALL STORAGE FORWARD */
				IF DISTZERO THEN CALL APPHALF;
				/* DISTANCE = 0 IF APPHALF CALLED */
				DO WHILE DISTNZERO;
					CALL READLINE;
					END;
				DIRECTION = BACKWARD; CALL MOVER;
				/* POINTERS REPOSITIONED */
				END; ELSE
				
			
			IF CHAR = 'F' THEN
				DO; CALL SETFIND; /* SEARCH STRING SCANNED
				                        AND SETUP BETWEEN 0 AND WBP-1 IN SCRATCH */
				DO WHILE DISTNZERO; CALL CHKFOUND;
					END;
				END; ELSE
				
			
			IF CHAR = 'J' THEN /* JUXTAPOSITION OPERATION */
				DO; DECLARE T ADDRESS;
				CALL SETFIND; CALL COLLECT;
				WBJ = WBE; CALL COLLECT;
				/* SEARCH FOR STRING 0 - WBP-1, INSERT STRING WBP TO WBJ-1,
				   AND THEN DELETE UP TO STRING WBJ TO WBE-1 */
				DO WHILE DISTNZERO; CALL CHKFOUND;
					/* INSERT STRING */ MI = WBP - 1;
					DO WHILE(MI := MI + 1) < WBJ;
						CHAR = SCRATCH(MI); CALL INSERT;
						END;
					T = FRONT; /* SAVE POSITION FOR DELETE */
					IF NOT FIND(WBJ,WBE) THEN GO TO OVERCOUNT;
					/* STRING FOUND, SO MOVE IT BACK */
					FIRST = FRONT -(WBE - WBJ);
					DIRECTION = BACKWARD; CALL MOVER;
					/* NOW REMOVE THE INTERMEDIATE STRING */
					FRONT = T;
					END;
				END; ELSE
				
			
			IF CHAR = 'M' AMD MP = 0 THEN /* MACRO DEFINITION */
				DO; XP = 255;
				IF DISTANCE = 1 THEN CALL ZERODIST;
				DO WHILE (MACRO(XP := XP + 1)  = READC)  <> CR;
					END;
				MP = XP; XP = 0; MT = DISTANCE;
				END; ELSE
				
			
			IF CHAR = 'N' THEN
				DO; /* SEARCH FOR STRING WITH AUTOSCAN */
				CALL SETFIND; /* SEARCH STRING SCANNED */
				DO WHILE DISTNZERO;
					/* FIND ANOTHER OCCURRENCE OF STRING */
					DO WHILE NOT FIND(0,WBP); /* NOT IN BUFFER */
						IF BREAK$KEY THEN GO TO RESET;
						CALL SAVEDIST; CALL CLEARMEM;
						/* MEMORY BUFFER WRITTEN */
						CALL APPHALF;
						DIRECTION = BACKWARD; FIRST = I; CALL MOVER;
						CALL RESTDIST; DIRECTION = FORWARD;
						/* MAY BE END OF FILE */
						IF BACK >= MAXM THEN GO TO OVERCOUNT;
						END;
					END;
				END; ELSE
				
			
			IF CHAR = 'S' THEN /* SUBSTITUTE COMMAND */
				DO; CALL SETFIND;
				CALL COLLECT;
				/* FIND STRING FROM0 TO WBP-1, SUBSTITUTE STRING
				   BETWEEN WBP AND WBE-1 IN SCRATCH */
				DO WHILE DISTNZERO;
					CALL CHKFOUND;
					/* FRONT AMD BACK NOW POSITIONED AT FOUND
					   STRING - REPLACE IT */
					FRONT = FRONT - (MI := WBP); /* BACKED UP */
					DO WHILE MI< WBE;
						CHAR = SCRATCH(MI);
						MI = MI + 1; CALL INSERT;
						END;
					END;
				END; ELSE
				
			IF CHAR = 'U' THEN
				CALL WRITEOUT; ELSE
				
			IF CHAR = 'Z' THEN /* SLEEP */
				DO;
				IF DISTZERO THEN
					DO; IF READCHAR = ENDFILE THEN GO TO RESET;
					END;
				DO WHILE DISTNZERO; CALL WAIT;
					END;
				END; ELSE
				IF CHAR <> 0 THEN /* NOT BREAK LEFT OVER FROM STOP */
				/* DIRECTION FORWARD, BUT NOT ONE OF THE ABOVE */
			GO TO BADCOM;
			END; ELSE /* DIRECTION NOT FORWARD */
			GO TO BADCOM;
		END;
	END;
