C	PROGRAM BNRUN.FT
C	---------------
C
C
C
	SUBROUTINE BRUN(JX,JY,IERR,IOPR)
C
C
C	P LEMKIN
C	NIH
C	BETHESDA, MD
C	
C
C	SEPT 2, 1977
C	JUNE 27, 1977
C	JUNE 26, 1977
C	JUNE 22, 1977
C	JUNE 2, 1977
C	MAY 31, 1977
C	MAY 26, 1977
C	MAY 24, 1977
C	MAY 23, 1977
C	MAY 19, 1977
C	MAY 18, 1977
C	MAY 17, 1977
C	MAY 12, 1977, PM
C	MAY 11, 1977
C	MAY 10, 1977
C	MAY 9, 1977
C	APRIL 19, 1977
C	APRIL 18, 1977
C	APRIL 15, 1977
C	APRIL 14, 1977
C	APRIL 13, 1977
C	APRIL 11, 1977
C	APRIL 8, 1977
C	APRIL 6, 1977
C	APRIL 5, 1977
C	APRIL 4, 1977
C	APRIL 1, 1977
C	MARCH 31, 1977
C	MARCH 30, 1977
C	MARCH 29, 1977
C	MARCH 28, 1977
C	MARCH 26, 1977
C	MARCH 25, 1977
C	MARCH 24, 1977
C	MARCH 23, 1977
C	MARCH 21, 1977
C	MARCH 18, 1977
C	MARCH 17, 1977
C	MARCH 16, 1977
C	MARCH 15, 1977
C	MARCH 12, 1977
C
C	PURPOSE
C	-------
C	SET UP A RUN LENGTH MAP (RLM) IN THE NODE FREESTORE
C	FOR USE IN DETERMINING
C	THE INSIDEDNESS PROPERTY OF A BOUNDARY. NOTE ALL (X,Y)
C	VALUES ARE IN THE RANGE  OF [0:255]. BOUNDARY PIXELS ARE
C	ENTERED INTO THE RLM IN  A
C		[1] CLOCKWISE DIRECTION.
C		AND
C		[2] THE TOPMOST BOUNDRY PIXEL MUST BE THE STARTING
C		POINT TO KEEP SYNCHRONIZATION.
C
C	THE RLM CONSISTS OF 4 ARRAYS:
C
C		IENT[IY,N]  - ENTRANCE POINT FOR LINE Y RUN N.
C		IXIT[IY,N] - EXIT POINT FOR LINE Y RUN N.
C		ILASTX[IY] - LAST X SEEN (AND TO BE USED FOR RUN 
C				FORMATION) OF LINE Y.
C		IRUNNUMBER[IY] - LAST RUN EITHER BEING STARTED OR
C				FINISHED FOR LINE IY.
C
C
C
C	IOPR	FUNCTION
C	----	--------
C	1	INITIALIZE RLM AND MINIMUM WINDOW AROUND BOUNDARY.
C		THE FIRST POINT MUST BE SPECIFIED AT THIS TIME TO SET
C		UP THE LOOK AHEAD. THE FIRST CALL TO ENTER USES THE 2ND POINT.
C
C	2 	ENTER (JX,JY) INTO RLM AND COMPUTE MIN WINDOW
C		IERR IS A FLOATING POINT VARIABLE WITH AN A6 FORMAT
C		NAME OF THE NDR WHICH WAS ACTIVATED. THE INDEX OF THE
C		NAME (1:24) IS RETURNED IN THE MQ REGISTER (0 IF NULL).
C		IF THE RLM OVERFLOWS, THEN IERR<==NULL
C
C	3	RETURN MINIMUM ROWS (KY1,KY2)==>(JX,JY)
C
C	4	RETURN MINIMUM COLUMNS (KX1,KX2)==>(JXJY)
C
C	5	TEST INSIDE PREDICATE. IF (JX,JY) IS INSIDE
C		BOUNDARY THEN RETURN IERR=1 (TRUE) ELSE RETURN IERR=0 (FALSE).
C
C	6	CLEAN UP UNFINISHED RUNS AT ISOLATED END POINTS.
C		NOTE: (JX,JY) IS THE FIRST POINT OF
C		THE LIST SO THAT IT MAY BE USED AS LOOKAHEAD TO FINISH THE
C		RLM. THE A6 FORMAT NDR NAME OF THE NDR IS RETURNED IN
C		THE IERR VARIABLE (THE INDEX (1:24) IN THE MQ).
C
C	7	DUMP IRUNNUMBER, LASTX, IENT, IEXT ON LPT:
C		FROM LINES JX:JY.
C
C	8	RETURN THE NUMBER OF RUNS FOR LINE JY IN IERR.
C
C	9	RETURN RUN NUMBER 'JX' FOR LINE 'JY' IN (JX,JY) WHERE
C		THE IENT(JY,IX)==>JX, IXIT(JY,IX)==>JY
C
C	10	LOAD IENT(Y,RUN#) <== JX, WHERE Y=JY AND RUN#=IERR.
C
C	11	LOAD IXIT(Y,RUN#) <== JX, WHERE Y=JY AND RUN#=IERR.
C
C	12	RETURN RUNS FROM PREVIOUS RLM BACK TO FREESTORE.
C
C	FBW4 DEBUG SWITCHES
C	-------------------
C	IF ANY FBW4 SWITCH THEN PRINT "BNRUN[2.1.1.1] DID=',
C
C	0010	[2.1.1.1] AT EACH POINT (IX,IY) PRINT "DID" VARIABLE
C		FOR THOSE LINES IY IN THE RANGE [FBW5:FBW7].
C
C	0004	[2.1.1.1] PRINT RUNS FOR LINE Y IF Y IN [FBW5:FBW7];
C	OPDEFS
C	------
C
C
S	ABSYM	RLASTX	24
S	ABSYM	RIRUN	25
S	ABSYM	RIEXPTR	26
C
S	OPDEF	MQA	7501
S	OPDEF	MQL	7421
S	OPDEF	BSW	7002
C@S	OPDEF	DISP2	6436
C
C
	DIMENSION LIST(2),JPTR(2),KPTR(2)
C		LIST - RUN LIST PTR
C		JPTR - WORKING PTR
C		KPTR - WORKING PTR
C
	DIMENSION IRUNNUMBER(256)
C		IRUNNUMBER(IY+1) = # OF RUNS FOR IY'TH LINE.
C
	DIMENSION LASTX(256)
C		LASTX(IY+1) = LAST X SEEN ON LINE IY.
C
	DIMENSION IEXPTR(2,256)
C		IEXPTR(1:2,IY+1) = 16-BIT (EAE MODE) POINTER
C			TO LIST OF RUNS FOR LINE IY IN THE NODE
C			SPACE. A NODE CONSISTS OF 5 16-BIT WORDS:
C
C				---------------------
C				|BACKWARD PTR       |
C				---------------------
C				|RIGHT PTR        |
C				---------------------
C				|LOCAL SEMANTICS    |
C				---------------------
C				|IENT[0:11]         |
C				---------------------
C				|IXIT[0:11]         |
C
C
C	A RUN LISTS CONSISTS OF A SEQUENTIAL LIST OF RUNS
C
C		[EXy1]<==>[EXy2]<==>...<==>[EXyn];
C
C	FLAGS ON RUNS
C	--------------
C	(1) LX=-1 INDICATES THAT THERE IS NO RUN IN PROGRESS.
C	(2) LX=X+(IF (MY<IY) THEN 512 ELSE 0);
C	(3) LX=(-IX-1000) INDICATES THE LAST IX OF THE LAST RUN.
C
C	(4) IN A COMPLETED RUN i, [Ei:Xi]y, 
C		RIGHT RUNS ARE CODED:  [Ei:Xi+256],
C		LEFT RUNS ARE CODED:  [Ei+256:Xi],
C
C	(5) IN A SPLIT OR COMPLETED RUN
C		THE DIRECTION OF THE Ei AND Xi ARE
C		INDICATED BY ADDING 512 IF (MY<IY) FOR
C		THE IX WHICH PRODUCED Ei and Xi.
C		NOTE THAT: (MY<IY) <==> (DOWN), ADD 512
C		           (MY>IY) <==> (UP), ADD 0.
C	(6) SPLIT RUNS ARE CODED AS: [1024:Xi]y, or [Ei:1024]y.
C
C
C
C	[0] DISPATCH
C	SET MAX # OF RUNS
	MR=128
C@	KAPPENDXY=1
C@	KDELETEXY=2
C@	KPRINTLIST=3
C@	KINITAVAIL=4
C@	KGETLIST=5
C@	KFREELIST=6
C@	KLASTXY=7
C@	KNEXTXY=8
C@	KCARXY=9
C@	KFINDXY=10
C@	KCOPYLIST=11
C@	KCONSLIST=12
C@	KCDRLIST=13
C@	KSETXY=14
C@	KCVXYTOI=15
C@	KCVITOXY=16
C
C	COPY (X,Y)+1 BY VALUE
	IX1=JX+1
	IY1=JY+1
C
C	COPY (X,Y) BY VALUE
	IX=JX
	IY=JY
C	NOTE: 6==>[2]&[6];
	GOTO(1,2,3,4,5,2,7,8,9,10,11,12),IOPR
C
C
C
C	[1] ZERO THE RUNS
1	KX1=257
	KX2=-1
	KY1=257
	KY2=-1
C
C	SAVE (JX,JY) FOR LOOKAHEAD
	IXLA=IX
	IYLA=IY
C
	DO 100 IY1=1,256
	IY=IY1-1
C
C	COMPUTE:	IRUNNUMBER(IY1)=0
S	TAD \IY
S	TAD PIRUN
S	DCA RIRUN
S	DCA I RIRUN
C
C	COMPUTE:	LASTX(IY1)=-1
S	TAD \IY
S	TAD PLASTX
S	DCA RLASTX
S	CLA CMA /-1
S	DCA I RLASTX
C
C
C	NOTE: A -1 NODE PTR INDICATES A NULL LIST!
C	COMPUTE: IEXPTR[1:2,IY1]<==-1;
S	TAD \IY
S	CLL RAL /X2
S	TAD PIEXPTR
S	DCA RIEXPTR
S	CLA CMA /-1
S	DCA I RIEXPTR
C
S	INC RIEXPTR
S	CLA CMA /-1
S	DCA I RIEXPTR
100	CONTINUE
C
C	INIT THE STARTING VALUES
	MX=-1
	MY=-1
C
C	RETURN SEMANTIC INDEX IDID IN THE MQ (MAY NOT MAKE SENSE FOR
C	SOME IOPR CALLS)
S \2047,	CLA
S	TAD \IDID
S	MQL
	RETURN
C
C
C
C	[2] ENTER (IX,IY) INTO THE RUN.
C	COMPUTE THE MINIMUM WINDOW AND RETURN TRUE (1)==>IERR
C	IF OVF ELSE RETURN 0 (FALSE) ==>IERR
2	IERR=0
C	UPDATE LOOKAHEAD
	IX=IXLA
	IY=IYLA
	IXLA=JX
	IYLA=JY
C
C	FIND THE MINIMUM COMPUTING WINDOW
C	KX1=KX1 MIN IX
C		==> IF IX<KX1 THEN KX1=IX;
S	TAD \IX
S	CIA
S	TAD \KX1
S	SPA CLA
S	JMP OK1
	KX1=IX
C
C	KY1=KY1 MIN IY 
C		==> IF IY<KY1 THEN KY1=IY;
S OK1,	TAD \IY
S	CIA
S	TAD \KY1
S	SPA CLA
S	JMP OK2
	KY1=IY
C
C	KX2=KX2 MAX IX 
C		==> IF IX<KX2 THEN KX2=IX;
S OK2,	TAD \KX2
S	CIA
S	TAD \IX
S	SPA CLA
S	JMP OK3
	KX2=IX
C
C	KY2=KY2 MAX IY 
C		==> IF IY<KY2 THEN KY2=IY;
S OK3,	TAD \KY2
S	CIA
S	TAD \IY
S	SPA CLA
S	JMP \299
	KY2=IY
299	CONTINUE
C
C	[2.0.1] SET UP POINTERS TO LASTX(IY1), IRUNNUMBER(IY1)
S	JMS GETLX
C
S	TAD \IY
S	TAD PIRUN
S	DCA RIRUN
S	TAD I RIRUN
S	DCA \N
C
C	[2.1] TEST IF START A NEW RUN
C
C
C
C		[2.1.1] TEST IF DUPLICATE POINT (SAME AS LAST) THEN IGNORE
C		IF IY=MY
C			THEN ISAMELINE<==TRUE
C			ELSE ISAMELINE<==FALSE;
S	TAD \IY
S	CIA
S	TAD \MY
S	SNA CLA
S	IAC /TRUE
S	DCA \ISAMELINE
C
C
C		IF ISAMELINE AND (IX=MX)
C			THEN IGNORE POINT
S	TAD \ISAMELINE
S	SNA CLA
S	JMP \202 /NEQ, CONTINUE
C
S	TAD \IX
S	CIA
S	TAD \MX
S	SZA CLA
S	JMP \202 /NOT EQUAL, CONTINUE
C
C	COMPUTE: ****	DID='DUP-PT'
	IDID=8
C
C
C		[2.1.1.1] REMEMBER THE NEW POINT (MX,MY)<==(IX,IY).
201	MX=IX
	MY=IY
C
C	LOOKUP THE 'DID" VARIABLE FROM THE "IDID" INDEX
C	FOR THE SEMANTIC LABLE
C	COMPUTE OFFSET
	IX1=IDID-1
S	TAD \IX1
S	CLL RAL /*2
S	TAD \IX1 /*3
S	TAD PTABLE
S	DCA GETDID# /ARG PTR
C
S	CALL 1,FAD
S GETDID, ARG (0 /CURRENT FIELD WILL CONTAIN TABLE(IDID) PTR
S	CALL 1,STO
S	ARG \DID
C
C********DEBUG***
C	UPDATE: (N,LX)
S	TAD I RIRUN
S	DCA \N
S	JMS GETLX
C
C	FOR LINES IY IN [FBW5:FBW7]
S	6345 /FBW5
S	CIA
S	TAD \IY
S	SPA CLA
S	JMP \2046 /NO
C
S	6347 /FBW7
S	IAC
S	CIA
S	TAD \IY
S	SMA CLA
S	JMP \2046 /NO
C
C	IF FBW4[8] THEN PRINT "DID" VARIABLE;
S	6344
S	AND (0010
S	SNA CLA
S	JMP \2044 /NO
C
C
	WRITE(3,2045)IX,IY,DID,N
2045	FORMAT(' BNRUN(X,Y)=[',I3,':',I3,'] DID=',A6
     1,', N=',I3)
C
C	IF FBW4[9] THEN PRINT RUNS FOR THIS LINE;
S \2044,	6344
S	AND (0004
S	SNA CLA
S	JMP \2046 /NO
C
C	PRINT RUNS FOR THIS LINE
	IX1=IY+1
	IY1=IX1
S	JMS PRUN
2046	CONTINUE
C****************
C	IF IOPR=6
C		THEN GOTO [6] 
C		ELSE RETURN (AT 2047);
S	TAD I \IOPR
S	TAD (-6
S	SNA CLA
S	JMP \6 /GOTO [6]
C
C	ELSE DONE(DID==>IERR), RETURN;
S	CALL 1,FAD
S	ARG \DID
S	CALL 1,ISTO
S	ARG \IERR
	GOTO 2047
C
C
C		[2.1.2] FIND FINITE STATE TRANSITION FUNCTION WHICH APPLIES.
C	COMPUTE: ****	DID='NULPNT'
202	IDID=22
C
C		IF MERGE
C			THEN RETURN TO MAIN;
S	JMS MERGE
C
C
C		IF SPLIT 
C			THEN RETURN TO MAIN;
S	JMS SPLIT
C
C
C		IF IMPLICITSPLIT
C			THEN DO IMPLICIT SPLIT AND CONTINUE;
S	JMS IMPLICITSPLIT
C
C
C		IF EXTEND
C			THEN RETURN TO MAIN;
S	JMS EXTEND
C
C
C		IF COMPLETERUN
C			THEN RETURN TO MAIN;
S	JMS COMPLETERUN
C
C
C		IF NEWRUN
C			THEN RETURN TO MAIN;
S	JMS NEWRUN
C
C
C	GO REMEMBER THE LAST POINT AT [2.1.1.1]
	GOTO 201
C
C
C	[3] RETURN MIN ROWS (KY1,KY2)==>(JX,JY)
3	JX=KY1
	JY=KY2
	RETURN
C
C
C
C
C	[4] RETURN MIN COLUMNS (KX1,KX2)==>(JX,JY)
4	JX=KX1
	JY=KX2
	RETURN
C
C
C
C
C
C	[5] EVALUATE THE "INSIDE" PREDICATE ON (JX,JY)
C	AND RETURN TRUE (1) IF TRUE ELSE (0) FALSE==>IERR.
S\5,	JMS INSPRED
	IERR=JERR
	RETURN
C
C	[6] CLEAN UP UNFINISHED AND SPLIT RUNS BY MAKING UNARY RUNS.
6	MX=KY1+1
	MY=KY2+1
	DO 600 IY1=MX,MY
	IY=IY1-1
C
S	TAD \IY
S	6436 /DISP2
C
C
C	[6.1] MAKE UNARY RUNS OF UNFINISH RUNS.
C	COMPUTE:	LX=LASTX(IY1)
S	JMS GETLX /GET LX, LXDIR
C
C	IF LX GEQ 0
C		THEN FINISH RUN
C
S	TAD \LX
S	SPA CLA
S	JMP \601 /NO
C
C	YES, FINISH THE RUN
C	COMPUTE:	LASTX(IY1)=-1
S	CLA CMA
S	DCA I RLASTX
C
C	COMPUTE:	N=IRUNNUMBER(IY1)
S	TAD \IY
S	TAD PIRUN
S	DCA RIRUN
S	TAD I RIRUN
S	DCA \N
C
C	SET (LX,LX)==>RUN(N,IY)
	IENT=LX
	IXIT=LX
S	JMS SETEXRUN
C
C	YES, RESET LX
601	LX=-1
S	TAD \LX
S	DCA I RLASTX
C
C
600	CONTINUE
	RETURN
C
C
C
C
C	[7] DUMP IRUNNUMBER, LASTX, IENT, IEXT
7	CONTINUE
C	IF ONLY 1 LINE THEN DO NOT PRINT RANGE
S	TAD \IX1
S	CIA
S	TAD \IY1
S	SNA CLA
S	JMP \704 /DO NOT PRINT RANGE
C
	WRITE(3,730)KX1,KX2,KY1,KY2
730	FORMAT(' [',I3,':',I3,',',I3,':',I3,']')
C
S \704,	JMS PRUN
	RETURN
C
C
C	[8] RETURN THE NUMBER OF RUNS FOR LINE IY IN FLAG
8	CONTINUE
S	TAD \IY
S	TAD PIRUN
S	DCA RIRUN
S	TAD I RIRUN
S	DCA I \IERR
	RETURN
C
C
C
C
C
C	[9] RETURN RUN NUMBER 'JX' FOR LINE 'JY' IN (JX,JY) WHERE
C	IENT(JY,JX),IXIT(JY,JX)
9	N=IX
S	JMS GETEXRUN
S	TAD \IENT
S	DCA I \JX
C
C	RESET CURRENT DATA FIELD
	N=N
S	TAD \IXIT
S	DCA I \JY
	RETURN
C
C
C	[10]  LOAD IENT(Y,RUN#)<==JX, Y=JY, RUN#=IERR.
10	N=IERR
S	JMS GETEXRUN
	IENT=IX
S	JMS SETEXRUN
	RETURN
C
C
C	[11]  LOAD IXIT(Y,RUN#)<==JX, Y=JY, RUN#=IERR.
11	N=IERR
S	JMS GETEXRUN
	IXIT=IX
S	JMS SETEXRUN
	RETURN
C	[12] RETURN RUNS FROM PREVIOUS RLM BACK TO FREESTORE.
12	DO 1201 IY1=1,256
	IY=IY1-1
C
C	IF (LIST[1:2]<==IEXPTR[1:2,IY1]) NEQ -1
C		THEN FREE LIST;
S	TAD \IY
S	CLL RAL /X2
S	TAD PIEXPTR
S	DCA RIEXPTR
C
S	TAD I RIEXPTR
S	DCA \LIST
C
S	INC RIEXPTR
S	TAD I RIEXPTR
S	DCA \LIST#
C
S	CLA IAC
S	TAD \LIST
S	SZA CLA
S	JMP \1202 /GARBAGE COLLECT!
C
S	CLA IAC
S	TAD \LIST#
S	SZA CLA
S	JMP \1201 /NULL LIST!
C
C
C	[12.2] FREE THE LIST
C	*** KFREELIST=6
1202	CALL BNODE(IX,IY,LIST,6)
C
1201	CONTINUE
	GOTO 2047
C
C
C	*****************************************************
C	*SUBROUTINE   P R U N
C	*******************************************************
C	PRINT RUNS FOR LINES [IX1,IY1];
S	CPAGE 3
S RPRUN,	JMP I PRUN
S PRUN,	0 /ENTRY
C
	DO 701 IYY=IX1,IY1
	IY=IYY-1
C	COMPUTE:	LX=LASTX(IYY)
S	JMS GETLX /LX, LXDIR
C
S	TAD \LXDIR
S	SNA CLA
S	TAD (2102 /"UP"-"DN"
S	TAD (0416 /"DN"
S	DCA \LXDIR
C
C	COMPUTE:	MR=IRUNNUMBER(IY)
S	TAD \IY
S	TAD PIRUN
S	DCA RIRUN
S	TAD I RIRUN
S	DCA \MR
C
C
C	IF (MR > 0)
C		THEN PRINT [Y]'S ENT/EXT
S	CLA CMA
S	TAD \MR
S	SPA CLA
S	JMP \701 /NO
C
	WRITE(3,702)IY,MR,LX,LXDIR
702	FORMAT(' LINE[',I3,'] #RNS=',I2,', LX=',I5,', LXDIR=',A2)
C
	DO 707 N=1,MR
C	GET DATA FOR RUN (N,IY)
S	JMS GETEXRUN
C
C	MAKE DIR AND LAST SWITCHES TO 0:1
S	TAD \IEDIR
S	SNA CLA
S	TAD (2102 /"UP"-"DN"
S	TAD (0416 /"DN"
S	DCA \IEDIR
C
S	TAD \IELAST
S	SZA CLA
S	IAC
S	DCA \IELAST
C
S	TAD \IXDIR
S	SNA CLA
S	TAD (2102 /"UP"-"DN"
S	TAD (0416 /"DN"
S	DCA \IXDIR
C
S	TAD \IXLAST
S	SZA CLA
S	IAC
S	DCA \IXLAST
C
S	TAD \IESPLIT
S	SZA CLA
S	IAC
S	DCA \IESPLIT
C
S	TAD \IXSPLIT
S	SZA CLA
S	IAC
S	DCA \IXSPLIT
C
	WRITE(3,705)N,IENT,IXIT,IEDIR,IXDIR,IELAST,IXLAST
     1,IESPLIT,IXSPLIT
705	FORMAT(10X,' #',I4,'  [',I3,':',I3,'], E/XDIR[',A2,':',A2,
     1'], E/XLAST[',I1,':',I1,'], E/XSPLIT[',I1,':',I1,']')
707	CONTINUE
C
C	PRINT CRLF
	WRITE(3,706)
706	FORMAT(/)
701	CONTINUE
C
S	JMP RPRUN
C
C	**********************************************************
C	*SUBROUTINE     G E T L X
C	**********************************************************
C
C	GIVEN: IY, COMPUTE 
C	LX_(IF (LX_LASTX(IY+1))<0
C			THEN
C			BEGIN "<0"
C			IF LX=-1
C				THEN LXDIR_0, LX, RETURN
C				ELSE LXDIR_(-LX-1000)^'1000,
C					LX_-(-LX-LXDIR), RETURN;
C			END "<0"
C			ELSE
C			LXDIR_'1000^LX, LX^'377);
C
S	CPAGE 3
S RGETLX,	JMP I GETLX
S GETLX,	0
S	CLA
C
	LXDIR=0
C
S	TAD \IY
S	TAD PLASTX
S	DCA RLASTX
C
S	TAD I RLASTX
S	DCA \LX
C
C	IF LX=-1
C		THEN RETURN;
S	CLA IAC
S	TAD \LX
S	SNA CLA
S	JMP RGETLX
C
C
C	IF LX < -1
S	TAD \LX
S	SMA CLA
S	JMP \1809 / (LX>0)
C		THEN
C		BEGIN
C		LXDIR=(-LX-1000)^'1000;
S	TAD \LX
S	CIA
S	TAD (-D1000
S	AND (1000
S	DCA \LXDIR
C
C		LX_-(-LX-LXDIR);
	LX=-(-LX-LXDIR)
C		RETURN;
S	JMP RGETLX
C		END;
C
C
C	IF LX > 0
C		THEN
S\1809,	TAD \LX
S	AND (1000
S	DCA \LXDIR
C
S	TAD \LX
S	AND (377
S	DCA \LX
S	JMP RGETLX
C	****************************************************
C	*SUBROUTINE   S E T E X R U N
C	****************************************************
C	SET (IENT,IXIT) FOR THE N'TH RUN OF LINE IY.
C	THE ALGORITHM IS AS FOLLOWS:
C
C	IF (LIST[1:2]<==IEXPTR[1:2,IY1])= -1
C		THEN 
C		[CREATE A LIST WITH (IENT,IEXIT) DATA; ENTER NEW
C		LIST PTR INTO IEXPTR[1:2,IY1] AND RETURN;]
C	IF EXISTS (NODE N OF LIST IY)
C		THEN CHANGE THE DATA TO (IENT,IXIT)
C		ELSE APPEND A NEW NODE WITH (IENT,IXIT) TO LIST IY;
C
S	CPAGE 3
S RSETEXRUN,	JMP I SETEXRUN
S SETEXRUN,	0
S	CLA
C
C	[S.1] IF IEXPTR[1:2,IY1] IS NULL 
S	CLA
S	TAD \IY
S	CLL RAL /X2
S	TAD PIEXPTR
S	DCA RIEXPTR
C
S	TAD I RIEXPTR
S	DCA \LIST
C
S	INC RIEXPTR
S	TAD I RIEXPTR
S	DCA \LIST#
C
S	CLA IAC
S	TAD \LIST#
S	SZA CLA
S	JMP \1800 /NOT NULL
C
C
C	[S.1.1] THEN  [CREATE A LIST WITH (IENT,IEXIT) DATA; 
C	*** KGETLIST=5
	CALL BNODE(IENT,IXIT,LIST,5)
C
C	ENTER NEW LIST PTR INTO IEXPTR[1:2,IY1] AND RETURN;]
S	CLA CMA /-1 TO BACKUP THE PTR
S	TAD RIEXPTR
S	DCA RIEXPTR
C
S	TAD \LIST
S	DCA I RIEXPTR
C
S	INC RIEXPTR
S	TAD \LIST#
S	DCA I RIEXPTR
S	JMP RSETEXRUN /RETURN
C
C
C	[S.2] ELSE IF EXISTS (NODE N OF LIST IY)
1800	JPTR=LIST
S	TAD \LIST#
S	DCA \JPTR#
	NCOUNT=1
C
C
C	LOOP HERE LOOKING FOR N'TH NODE.
C	IF NCOUNT=N
C		THEN GOTO [S.2.1]
C		ELSE CONTINUE SEARCH;
S\1804,	TAD \N
S	CIA
S	TAD \NCOUNT
S	SMA CLA
S	JMP \1805 /YES
C
	NCOUNT=NCOUNT+1
C	*** KNEXTXY=8
	CALL BNODE(JUNK,JUNK,JPTR,8)
C	IF LIST=JPTR 
C		THEN FAILED!, GOTO [S.2.2];
S	TAD \LIST
S	CIA
S	TAD \JPTR
S	SZA CLA
S	JMP \1804 /NOT YET
S	TAD \LIST#
S	CIA
S	TAD \JPTR#
S	SNA CLA
S	JMP \1810 /FAILED!, GOTO [S.2.2];
	GOTO 1804
C
C
C
C	[S.2.1] THEN CHANGE THE DATA TO (IENT,IXIT)
1805	CONTINUE
C	*** KSETXY=14
	CALL BNODE(IENT,IXIT,JPTR,14)
S	JMP RSETEXRUN
C
C
C	[S.2.2] FAILED TO FIND N'TH NODE.
C	 APPEND A NEW NODE WITH (IENT,IXIT) TO LIST IY;
1810	CONTINUE
C	*** KAPPENDXY=11
	CALL BNODE(IENT,IXIT,LIST,1)
S	JMP RSETEXRUN
C
C
C	****************************************************
C	*SUBROUTINE   G E T E X R U N
C	****************************************************
C	GET (IENT,IXIT) FOR THE N'TH RUN OF LINE IY.
C	IF N=0 OR (NOT EXISTS (N'TH NODE OF LIST IEXPTR[1:2,IY+1))
C		THEN RETURN [IENT,IXIT]<==(2,1)
C		ELSE RETURN (IENT,IXIT) FROM N'TH NODE;
C	CLIP VARIABLES:
C		IELAST_IENT^'400; IEDIR_IENT^'1000; IESPLIT_IENT^'2000;
C			 IENT_IENT^'377;
C		IXLAST_IXIT^'400; IXDIR_IXIT^'1000; IXSPLIT_IXIT^'2000;
C			 IXIT_IXIT^'377;
C
S	CPAGE 3
S RGETEXRUN,	JMP I GETEXRUN
S GETEXRUN,	0
S	CLA
C
C	[G.1] IF N=0 OR (NOT EXISTS (N'TH NODE OF LIST IEXPTR[1:2,IY+1))
C	GET THE PTR
S	CLA
S	TAD \IY
S	CLL RAL /X2
S	TAD PIEXPTR
S	DCA RIEXPTR
C
S	TAD I RIEXPTR
S	DCA \LIST
C
S	INC RIEXPTR
S	TAD I RIEXPTR
S	DCA \LIST#
C
C	SET TO FAIL!
	IENT=2
	IXIT=1
C
S	TAD \N
S	SNA CLA
S	JMP \1819 /FAILED RETURN (2,1).
C
C
S	TAD \LIST#
S	SPA CLA
S	JMP \1819 /FAILED, RETURN (2,1)
C
C	FIND N'TH NODE!
	JPTR=LIST
S	TAD \LIST#
S	DCA \JPTR#
C
C
C	[G.1.1] INITIAL THE COUNTER
	NCOUNT=1
C	GET DATA FOR FIRST NODE
C	*** KCARXY=9
	CALL BNODE(IENT,IXIT,LIST,9)
C
C
C
C	[G.1.2] LOOP HERE LOOKING FOR N'TH NODE!
C	UNTIL NCOUNT=N
C		THEN "SUCCEED" GOTO [G.3]
C		ELSE BEGIN "CONTINUE SEARCH"
C			NCOUNT_NCOUNT+1;
C			IF LIST=(JPTR_NEXT(JPTR))
C				THEN "FAIL" GOTO [G.2];
C			END "CONTINUE SEARCH";
S\1814,	TAD \N
S	CIA
S	TAD \NCOUNT
S	SMA CLA
S	JMP \1819 /YES
C
C
C	ELSE
C	BEGIN "CONTINUE SEARCH"
	NCOUNT=NCOUNT+1
C	*** KNEXTXY=8
	CALL BNODE(IENT,IXIT,JPTR,8)
C	IF LIST=JPTR 
C		THEN FAILED!, GOTO [S.2.2];
S	TAD \LIST
S	CIA
S	TAD \JPTR
S	SZA CLA
S	JMP \1814 /NOT YET
S	TAD \LIST#
S	CIA
S	TAD \JPTR#
S	SZA CLA
S	JMP \1814 /NOT YET
C	FALL THROUGH IF =
C
C
C	[G.2] THEN "FAILED"  RETURN [IENT,IXIT]<==(2,1)
1815	IENT=2
	IXIT=1
C	GOTO [G.3];
C
C
C	[G.3] ELSE RETURN (IENT,IXIT) FROM N'TH NODE;
C	CLIP VARIABLES:
1819	IEDIR=0
	IXDIR=0
	IELAST=0
	IXLAST=0
	IESPLIT=0
	IXSPLIT=0
C
C	IELAST_IENT^'400; IEDIR_IENT^'1000; IESPLIT_IENT^'2000;
C	IENT_IENT^'377;
C
S	TAD \IENT
S	AND (2000 /SPLIT FLAG
S	DCA \IESPLIT
C
S	TAD \IENT
S	AND (1000
S	DCA \IEDIR
C
S	TAD \IENT
S	AND (0400
S	DCA \IELAST
C
S	TAD \IENT
S	AND (377
S	DCA \IENT
C
C	IXLAST_IXIT^'400; IXDIR_IXIT^'1000; IXSPLIT_IXIT^'2000;
C	IXIT_IXIT^'377;
C
S	TAD \IXIT
S	AND (2000 /SPLIT FLAG
S	DCA \IXSPLIT
C
S	TAD \IXIT
S	AND (1000
S	DCA \IXDIR
C
S	TAD \IXIT
S	AND (0400
S	DCA \IXLAST
C
S	TAD \IXIT
S	AND (377
S	DCA \IXIT
S	JMP RGETEXRUN /RETURN SUCCESS!
C
C	**********************************************
C	*SUBROUTINE    I N S P R E D
C	**********************************************
C	INSPRED RETURNS JERR=1 AND N IF IX IS INSIDE ANY RUN N FOR LINE Y.
C	OTHERWISE JERR=0.
C
S	CPAGE 3
S RINSPRED,	JMP I INSPRED
S INSPRED,	0 /ENTRY
S	CLA
C
	JERR=0
C
C	COMPUTE: NMAX=IRUNNUMBER(IY1)
S	TAD \IY
S	TAD PIRUN
S	DCA RIRUN
S	TAD I RIRUN
S	DCA \NMAX
C
	DO 1600 N=1,NMAX
C
C	GET (IENT,IXIT)<==RUN[N,IY]
S	JMS GETEXRUN
C
C	TEST FOR SPLIT RUNS WHICH ARE IGNORED.
C	IF IESPLIT OR IXSPLIT
C		THEN RETURN FALSE
S	TAD \IESPLIT
S	SZA CLA
S	JMP \1600 /IGNORE 
C
S	TAD \IXSPLIT
S	SZA CLA
S	JMP \1600 /IGNORE
C
C	GET THE EXIT POINT
C	IF (IENT LEQ IX LEQ IXIT)
C		THEN RETURN TRUE
S	TAD \IENT
S	CIA
S	TAD \IX
S	SPA CLA
S	JMP \1600 /NO, IX < IENT
C
S	TAD \IX
S	CIA
S	TAD \IXIT
S	SPA CLA
S	JMP \1600 /NO, IX > IXIT
C
C	RETURN TRUE
	JERR=1
S	JMP RINSPRED
C
C	RETURN FALSE
1600	CONTINUE
S	JMP RINSPRED
C
C	**************************************************
C	*SUBROUTINE   M E R G E
C	**************************************************
C	Given a previous split run indicated by a "-" in a
C	RUN [Ei:1024] or [1024:Xi] for run (y,i) then test if
C	merge the run to the current point IX.
C
C
S	CPAGE 3
S RMERGE,	JMP I MERGE
S MERGE,	0
S	CLA
C
C
C	IF (N > 0) AND (MY NEQ IY) AND NOT(IX IN [EI:XI])
S	TAD I RIRUN
S	DCA \NMAX
S	TAD \NMAX
S	SNA CLA
S	JMP RMERGE /NO, RETURN
C
S	TAD \MY
S	CIA
S	TAD \IY
S	SNA CLA
S	JMP RMERGE /NO, RETURN
C
S	JMS INSPRED
S	TAD \JERR
S	SZA CLA
S	JMP RMERGE /YES, X IN RUN (Y,I). RETURN
C
C
C	THEN
C	FOR N_(NMAX_IRUNNUMBER(IY)) STEP -1 TO 1 DO
	DO 1670 MR=1,NMAX
	N=(1+NMAX)-MR
S	JMS GETEXRUN
C
C
C			BEGIN "POSSIBLE MERGE"
C
C	[MERG.1] TEST FOR RIGHT MERGE
C		IF (MY<IY) EQV DIR(IX)="DOWN"

C			THEN
S	TAD \IY
S	CIA
S	TAD \MY
S	SMA CLA
S	JMP MERG2 /NO, MY>IY
C
C			IF [Ei:1024](y,i) and Ei(up) and (IX geq Ei)
S	TAD \IXSPLIT
S	AND (2000 /SPLIT FLAG
S	SNA CLA
S	JMP \1670 /NO
C
C	***Ei(up)
S	TAD \IEDIR
S	SZA CLA
S	JMP \1670 /NO, DOWN!
C
S	TAD \IENT
S	CIA
S	TAD \IX
S	SPA CLA
S	JMP \1670 /NO
C				THEN 
C				IF (IX-1=Ei) and (LOOKAHEAD(Y) LEQ IY)
C					THEN SETEXRUN[Ei:IX+1024](y,i)
C					ELSE SETEXRUN[Ei:IX]y,i
C	COMPUTE: ***	DID='MRGRHT'
	IDID=20
C	NOTE: IX(DOWN)
	IXIT=IX+256+512
C	IF IX-1=IENT
C		THEN MQ_0
S	CLA CMA
S	TAD \IX
S	CIA
S	TAD \IENT
S	SZA CLA
S	IAC
S	MQL
C
C	IF IYLA LEQ IY AND MQ=0
C		THEN KEEP
S	TAD \IYLA
S	CIA
S	TAD \IY
S	SPA CLA
S	IAC
S	MQA /OR TOGETHER, MUST BE ZERO TO KEEP
S	SNA CLA
S	TAD (D1024 /KEEP SPLIT SINCE ADJ POINT
S	TAD \IXIT
S	DCA \IXIT
C
	IENT=IENT+IEDIR
S	JMS SETEXRUN
C				    RETURN TO MAIN AT [2.1.1.1];
S	JMS GETLX /UPDATE LX (GET PTR)
	LX=-1
S	TAD \LX
S	DCA I RLASTX
C	GOTO [2.1.1.1]
	GOTO 201
C
C
C	[MERG.2] TEST FOR LEFT MERGE
C		IF (MY>IY) EQV DIR(IX)="UP"
C			THEN
C			IF [1024:Xi](y,i) and Xi(down) and (IX leq Xi)
S MERG2, TAD \IESPLIT
S	AND (2000 /SPLIT FLAG
S	SNA CLA
S	JMP \1670 /NO
C
C	***Xi(down)
S	TAD \IXDIR
S	SNA CLA
S	JMP \1670 /NO, UP
C
S	TAD \IX
S	CIA
S	TAD \IXIT
S	SPA CLA
S	JMP \1670 /NO
C				THEN
C				IF (IX+1=Xi) AND (LOOKAHEAD(Y) GEQ IY)
C					THEN SETEXRUN[IX+1024:Xi](y,i)
C					ELSE  SETEXRUN[IX:Xi](y,i),
C	COMPUTE: ***	DID='MRGLFT'
	IDID=19
C	NOTE: IX(UP)
	IENT=IX+256
C	IF IX+1=IXIT
C		THEN MQ_0;
S	CLA IAC /+1
S	TAD \IX
S	CIA
S	TAD \IXIT
S	SZA CLA
S	IAC
S	MQL
C
C	IF IYLA GEQ IY AND MQ=0
C		THEN KEEP
S	TAD \IY
S	CIA
S	TAD \IYLA
S	SPA CLA
S	IAC
S	MQA
S	SNA CLA
S	TAD (D1024 /KEEP SPLIT SINCE ADJ POINT
S	TAD \IENT
S	DCA \IENT
C
	IXIT=IXIT+IXDIR
S	JMS SETEXRUN
C				  RETURN TO MAIN AT [2.1.1.1];
S	JMS GETLX /UPDATE LX (GET PTR)
	LX=-1
S	TAD \LX
S	DCA I RLASTX
	GOTO 201
C
C
C			END "POSSIBLE MERGE";
1670			CONTINUE
S	JMP RMERGE
C
C	***********************************************
C	*SUBROUTINE    I M P L I C I T S P L I T
C	*************************************************
C
C	TEST FOR IMPLICIT RUNS AND CREATE A SPLIT RUN
C	IF NECESSARY AND RETURN;
C
S	CPAGE 3
S RIMPLICITSPLIT,	JMP I IMPLICITSPLIT
S IMPLICITSPLIT,	0 /ENTRY
S	CLA
C
C
C	[IS.1] GET THE LAST N AND LAST X.
C	COMPUTE:	N=IRUNNUMBER(IY+1)
S	TAD I RIRUN
S	DCA \N
C
C	COMPUTE:	LX=LASTX(IY+1)
S	JMS GETLX /LX,LXDIR
C
C	SAVE LASTX
	ISVLASTX=0
S	TAD I RLASTX
S	DCA \ISVLASTX
C
C
C	[IS.2] IF (N = 0) OR (LX=-1) THEN RETURN
S	TAD \N
S	SNA CLA
S	JMP RIMPLICITSPLIT /(N=0), RETURN
C
S	CLA IAC
S	TAD \LX
S	SNA CLA
S	JMP RIMPLICITSPLIT /(LX=-1), RETURN
C
C
C	[IS.3] TEST FOR IMPLICIT SPLIT!
C	GET THE DIRECTION OF LX AND STRIP IT TO 0:255
C	DISPATCH TO <, =, > IX RUN
C	IF (LX<-1)
C		THEN LX_-(LX+1000), MR_1 ELSE MR_0;
	MR=0
S	CLA IAC /+1
S	TAD \LX
S	SMA CLA
S	JMP \1650 /> -1
	LX=-(LX+1000)
	MR=1
C
C	IF LX=IX
C		THEN "IGNORE UNARY RUN" RETURN;
S\1650,	TAD \IX
S	CIA
S	TAD \LX
S	SNA
S	JMP RIMPLICITSPLIT /LX=IX, UNARY RUN. IGNORE!
C
C	IF (LX > IX)
C		THEN "RHT CCW" GOTO [IS.3.2]
C		ELSE "LFT CCW" GOTO [IS.3.1]
S	SMA CLA
S	JMP IS32 /LX>IX
C	FALL THROUGH TO [IS.3.1] IF IX<LX.
C
C
C	[IS.3.1] TEST IF CASE OF IMPLICIT LFT CCW RUN
C	IF IX(UP)=(MY>IY) AND (LX<IX) AND DIR(LX)="DOWN"
C		BEGIN "LFT SPLIT"
C		IX1_0; GOTO [IS.4];
C		END "LFT SPLIT";
C
S	TAD \MY
S	CIA
S	TAD \IY
S	SMA CLA
S	JMP IS32 /NO
C
S	TAD \IX
S	CIA
S	TAD \LX
S	SMA CLA
S	JMP IS32 /NO
C
S	TAD \LXDIR
S	SNA CLA
S	JMP IS32 /NO
C
C	NOTE: LX(DOWN)
C	IENT=1024+LX
C	IXIT=LX+512+256
C	SET SWITCH (IX1) TO "IMPLFT"
	IX1=0
C	GOTO [IS.4]
	GOTO 1651
C
C
C	[IS.3.2] TEST IF CASE OF IMPLICIT RHT CCW RUN
C	IF IX(DOWN)=(MY<IY) AND (LX>IX) AND DIR(LX)="UP"
C		THEN 
C		BEGIN "RHT SPLIT"
C		IX1_1; GOTO [IS.4];
C		END "RHT SPLIT"
C		ELSE RETURN (FAILURE);
S IS32,	TAD \IY
S	CIA
S	TAD \MY
S	SMA CLA
S	JMP RIMPLICITSPLIT /NO
C
S	TAD \LX
S	CIA
S	TAD \IX
S	SMA CLA
S	JMP RIMPLICITSPLIT
C
S	TAD \LXDIR
S	SZA CLA
S	JMP RIMPLICITSPLIT /NO
C
C	NOTE: LX(UP)
C	IENT=LX+256
C	IXIT=1024+LX+512
C	MARK IT A RIGHT SPLIT
	IX1=1
C
C
C	[IS.4] BEGIN "FOUND IMPLICIT SPLIT"
1651	IENT=LX
	IXIT=LX
C
C	IF N=1
S	CLA CMA
S	TAD \N
S	SZA CLA
S	JMP \1653	 /N0, (N>1)
C
C		THEN IF (LX > -1) = (MR=0)
S	TAD \MR
S	SNA CLA
S	JMP \1655 /YES, (LX>-1)
C			THEN "SAVE UNARY RUN RUN" GOTO [IS.4.1];
C			ELSE
C			BEGIN "GET AND TEST FIRST RUN"
C			GETEXRUN[IENT:IXIT]Y,1;
S	JMS GETEXRUN
C			IF (DIR(E1) = DIR(X1))
S	TAD \IEDIR
S	CIA
S	TAD \IXDIR
S	SNA CLA
S	JMP \1655 /THEN "SAVE RUN" GOTO [IS.4.1]
S	JMP \1652 /ELSE "DON'T SAVE RUN" GOTO [IS.4.2]
C			END "GET AND TEST FIRST RUN"
C
C
C	IF (N>1)
1653	CONTINUE
C		THEN
C		BEGIN "LOOK FOR OPPOSITE SPLIT TO SAVE RUN"
C		"NEW RUN" GETEXRUN[IENT:IXIT]Y,N-1
	N=N-1
S	JMS GETEXRUN
C		IF ([-:Xi] and "IMPRHT") or ([Ei:-] and "IMPLFT")
C			THEN
C
S	TAD \IESPLIT
S	TAD \IX1 /IX1(IMPRHT)=1
S	TAD (-2001
S	SNA CLA
S	JMP \1654 /"YES, SAVE RUN" GOTO [IS.4.0.1]
C
S	TAD \IXSPLIT
S	TAD \IX1 /IX1(IMPLFT)=0
S	TAD (-2000
S	SNA CLA
S	JMP \1654 /"YES, SAVE RUN" GOTO [IS.4.0.1]
C		IF (LASTX(IY) > 0) EQV (LX NEQ -1) AND (MR=-1)=(LX>-1))
C			THEN 
C			BEGIN "FINISH 'NEWRUN' AS SPLIT"
C			NOTE: A SPLIT RUN MUST BE CREATED SINCE THE
C			IMPLIED SPLIT NOW BEING CREATED WOULD PRODUCE
C			2 OR MORE 'NEWRUN'S OTHERWISE.;
C
S	CLA IAC
S	TAD \LX
S	SNA CLA
S	JMP \1652 /NO, GOTO [IS.4.2]
C
S	TAD \MR
S	SZA CLA
S	JMP \1652 /NO, GOTO [IS.4.2]
C
C	THEN "SETUP NEWRUN AS A SPLIT"
	N=N+1
	IENT=LX
	IXIT=LX
C	GOTO [IS.4.1]
	GOTO 1655
C			END "FINISH 'NEWRUN' A SPLIT";
C
C		END "LOOK FOR OPPOSITE SPLIT TO SAVE RUN";
C	NO, GOTO [IS.4.2]
	GOTO 1652
C
C
C	[IS.4.0.1] SAVE RUN
C		IF (LX<-1)=(MR=1)
C			THEN N_N+1, GETEXRUN;
C			ELSE IENT_IXIT_LX;
1654	IENT=LX
	IXIT=LX
S	TAD \MR
S	SNA CLA
S	JMP \1655 /GOTO [IS.4.1]
	N=N+1
S	JMS GETEXRUN
C
C
C	[IS.4.1] N_NRUN[IY], SETEXRUN[IENT:IXIT]Y,N];
S \1655, TAD I RIRUN
S	DCA \N
C		IF IX1=0 (EQU TO "IMPLFT")
C			THEN SETEXRUN[1024+IENT:LX+512]Y,N
C			ELSE SETEXRUN[LX:1024+IXIT]Y,N;
C	NOTE: "IMPLFT" LX(DOWN)
S	TAD \IX1
S	SZA CLA
S	JMP \1656 /IX1=1
C
	IENT=1024+IENT
	IXIT=LX+512+256
S	JMS SETEXRUN
	GOTO 1652
C
C	NOTE: "IMPRHT" LX(UP)
1656	IXIT=1024+IXIT+512
	IENT=LX+256
S	JMS SETEXRUN
C
C
C	[IS.4.2] NEWRUN(IX);
1652	LX=-1
S	TAD \LX
S	DCA I RLASTX
S	JMS NEWRUN
C
C	IF LX=-1
C		THEN "FOUND 'HAIREP' " LX_SVLASTX;
S	CLA IAC /+1
S	TAD I RLASTX /CHECK FOR -1
S	SZA CLA
S	JMP \1657 /NO
S	TAD \ISVLASTX
S	DCA I RLASTX
C
C	LABEL AS "IMPLIED HAIR"
C	COMPUTE: ***	DID='IMPLFH'
	IDID=16
S	TAD \IX1
S	SNA CLA
S	JMP \201 /RETURN
C	COMPUTE: ***	DID='IMPRHH'
	IDID=17
C	GOTO [2.1.1.1]
	GOTO 201
C
C	NOT A HAIR
C	COMPUTE: ***	DID='IMPLFT'
1657	IDID=14
S	TAD \IX1 /IF IX1=1 THEN DID='IMPRHT'
S	SNA CLA
S	JMP \201 /NO, RETURN
C	COMPUTE: ***	DID='IMPRHT'
	IDID=15
C	GOTO [2.1.1.1]
	GOTO 201
C	END "FOUND IMPLICIT SPLIT";
C	************************************************
C	*SUBROUTINE       S P L I T
C	**************************************************************
C
C	IF N > 0
C	  THEN
C	  FOR ALL i LEQ IRUNNUMBER(Y) DO
C		 IF (Ei_IENT(Y,i)) LEQ IX LEQ (Xi_IXIT(Y,i)) AND
C		    (Ei neq 1024) AND (Xi neq 1024)
C			THEN
C			BEGIN "INCLUDED POINT"
C			---- TEST FOR CONTINUING INCLUDED PT==> IGNORE ---
C			---- TEST FOR THE 4 SPLIT CASES ----
C			     RETURN TO MAIN;
C			END "INCLUDED POINT"
C			ELSE RETURN;
C
C
C
S	CPAGE 3
S RSPLIT,	JMP I SPLIT
S SPLIT,	0
S	CLA
C
C	--------------------------------------------
C	[SP.1] TEST FOR NULL INCLUDED POINTS.
S	TAD I RIRUN
S	DCA \N
S	TAD \N
S	SNA CLA
S	JMP RSPLIT /N=0, DON'T TEST!
C
C
C	FOR ALL N LEQ IRUNNUMBER(Y) DO
C		 IF (IENT(Y,i) LEQ IX LEQ IXIT(Y,i))
S	JMS INSPRED
S	TAD \JERR
S	SNA CLA
S	JMP RSPLIT /NOT THERE, RETURN
C
C
C	[SP.1.1] MAKE SURE Ei and Xi are neq 1024.
S	TAD \IESPLIT
S	AND (2000 /SPLIT FLAG
S	SZA CLA
S	JMP RSPLIT /=, SO RETURN
C
S	TAD \IXSPLIT
S	AND (2000 /SPLIT FLAG
S	SZA CLA
S	JMP RSPLIT /=, SO RETURN
C
C
C	[SP.1.2] IF CONTINUING INCLUDED POINT THEN IGNORE IT
C	IF (LAST(Y) = IY = LOOKAHEAD(Y)) OR (IENT=IXIT)
C		THEN  INCLUDED POINT;
S	TAD \IENT
S	CIA
S	TAD \IXIT
S	SNA CLA
S	JMP \1665 /YES
C
S	TAD \ISAMELINE /LASTY=Y PREDICATE
S	SNA CLA
S	JMP SP2 /NO
S	TAD \IY
S	CIA
S	TAD \IYLA
S	SZA CLA
S	JMP SP2 /NO
C
C
C	[SP.1.2.1] YES, INCLUDED POINT.
C	 TEST IF IT WAS A UNARY RUN THEN CHANGE TO A SPLIT (HAIR HANDLER);
C		IF (Ei=Xi)
C			Then 
C			Begin "change 'HAIREP' to 'HAIRSPLIT'"
C			lastx[y]_x; DIR(lastx[y])_DIR(x), 
C			If DIR(x)="up"
C				Then SETEXRUN([1024:x]y,i),DONE("CGRHSP")
C				Else SETEXRUN([x:1024]y,i),DONE("CGLHSP");
C			Goto [2.1.1.1];
C			End "change 'HAIREP' to 'HAIRSPLIT'";
S \1665,	TAD \IENT
S	CIA
S	TAD \IXIT
S	SZA CLA
S	JMP \1660 /NO
C
C	YES, CHANGE UNARY RUN TO NEW RUN.
C	GET LXDIR
S	TAD \IY
S	CIA
S	TAD \IYLA
S	SMA CLA
S	TAD (D512 /DN
S	DCA \LXDIR
	LX=IX+LXDIR
C
S	TAD \LX
S	DCA I RLASTX
C	ASSUME EI="UP"
	IENT=1024+512+IX
	IXIT=LX+256
C	COMPUTE: ***	DID='CGRHSP'
	IDID=2
S	TAD \LXDIR
S	SNA CLA
S	JMP \1661 /WAS "UP"
C	NO, EI="DOWN"
	IENT=LX+256
	IXIT=1024+IX
C	COMPUTE: ***	DID='CGLHSP'
	IDID=1
S\1661,	JMS SETEXRUN
C	GOTO [2.1.1.1]
	GOTO 201
C
C			Else DONE("INCDPT");
C	COMPUTE: ***	DID='INCDPT'
1660	IDID=18
C	GOTO [2.1.1.1]
	GOTO 201
C
C
C	[SP.2] YES, THEN TEST FOR SPLITS
C	ON THE I'TH RUN WHICH INCLUDES IX.
S SP2,	JMS GETLX /GET LX, LXDIR
C	[SP.2.1] TEST FOR "CW LFT SPLIT"
C	IF (IX in [Ei:Xi])
C		and (IYLA < IY) and (MY geq IY)
C		and Xi(down) and (Lastx(n,y)=Xi)
S	TAD \IY
S	CIA
S	TAD \IYLA
S	SMA CLA
S	JMP SP22 /NO
S	TAD \IY
S	CIA
S	TAD \MY
S	SPA CLA
S	JMP SP22 /NO
C
S	TAD \IXDIR
S	SNA CLA
S	JMP SP22 /NO
C
S	TAD \IXLAST
S	SNA CLA
S	JMP SP22 /NO
C
C		Then SETEXRUN([Ei:Xi]==>[Ei:1024]),
C	NOTE: EI(UP), XI(DOWN)
	IENT=IENT+IEDIR+256
	IX1=IXIT+IXDIR
	IXIT=1024+IXDIR+IENT
S	JMS SETEXRUN
C		     (NEWRUN(IX); SETEXRUN(N+1)[IX:Xi]);
	LX=-1
S	TAD \LX
S	DCA I RLASTX
S	JMS NEWRUN
C
C	NOTE: IX(UP)
	IENT=IX+256
	IXIT=IX1
S	JMS SETEXRUN
C
C	UPDATE LX
	LX=-(IX+1000)
S	TAD \LX
S	DCA I RLASTX
C	COMPUTE: ***	DID='SPCW-R'
	IDID=24
C	GOTO [2.1.1.1]
	GOTO 201
C
C
C	[SP.2.2] TEST FOR "CW RHT SPLIT"
C	IF (IX in [Ei:Xi]) 
C		and (IYLA > IY) and (MY leq IY)
C		and Ei(up) and (Lastx(n,y)=Ei)
S SP22,	TAD \IYLA
S	CIA
S	TAD \IY
S	SMA CLA
S	JMP SP23 /NO
S	TAD \MY
S	CIA
S	TAD \IY
S	SPA CLA
S	JMP SP23 /NO
C
S	TAD \IEDIR
S	SZA CLA
S	JMP SP23 /NO
C
S	TAD \IELAST
S	SNA CLA
S	JMP SP23 /NO
C
C		Then SETEXRUN([Ei:Xi]==>[1024:Xi]),
C	NOTE: EI(UP), XI(DOWN)
	IX1=IENT+IEDIR
	IENT=1024+IEDIR+IXIT
	IXIT=IXIT+IXDIR+IXLAST
S	JMS SETEXRUN
C		     (NEWRUN(Ei); SETEXRUN(N+1)[Ei:IX]);
	IXBACK=IX
	IX=IENT
	LX=-1
S	TAD \LX
S	DCA I RLASTX
S	JMS NEWRUN
	IX=IXBACK
C
C	NOTE: IX(DOWN)
	IXIT=IX+256+512
	IENT=IX1
S	JMS SETEXRUN
C
C	UPDATE LX
	LX=-(IX+512+1000)
S	TAD \LX
S	DCA I RLASTX
C	COMPUTE: ***	DID='SPCW-L'
	IDID=23
C	GOTO [2.1.1.1]
	GOTO 201
C
C
C	[SP.2.3] TEST FOR "CCW LFT SPLIT"
C	IF (IX in [Ei:Xi])
C		and (IYLA > IY) and (MY leq IY)
C		and Xi(up) and (Lastx(n,y)=Xi)
S SP23,	TAD \IYLA
S	CIA
S	TAD \IY
S	SMA CLA
S	JMP SP24 /NO
S	TAD \MY
S	CIA
S	TAD \IY
S	SPA CLA
S	JMP SP24 /NO
C
S	TAD \IXDIR
S	SZA CLA
S	JMP SP24 /NO
C
S	TAD \IXLAST
S	SNA CLA
S	JMP SP24 /NO
C
C		Then SETEXRUN([Ei:Xi]==>[1024:Ei]),
C	NOTE: EI(DOWN), XI(UP)
	IX1=IXIT+IXDIR
	IENT=1024+IXIT+IXDIR
	IXIT=IENT+IEDIR+256
S	JMS SETEXRUN
C		     (NEWRUN(IX); SETEXRUN(N+1)[IX:Xi]);
	LX=-1
S	TAD \LX
S	DCA I RLASTX
S	JMS NEWRUN
C
C	NOTE: IX(DOWN)
	IENT=IX+256
	IXIT=IX1
S	JMS SETEXRUN
C
C	UPDATE LX
	LX=-(IX+512+1000)
S	TAD \LX
S	DCA I RLASTX
C	COMPUTE: ***	DID='SPCCWR'
	IDID=26
C	GOTO [2.1.1.1]
	GOTO 201
C
C
C	[SP.2.4] TEST FOR "CCW RHT SPLIT"
C	IF (IX in [Ei:Xi])
C		and (IYLA < IY) and (MY geq IY)
C		and Ei(down) and (Lastx(n,y)=Ei)
S SP24,	TAD \IY
S	CIA
S	TAD \IYLA
S	SMA CLA
S	JMP \1665 /NO, IGNORE NON-ADJACENT INCLUDED PNT, GOTO [SP.1.2.1];
S	TAD \IY
S	CIA
S	TAD \MY
S	SPA CLA
S	JMP \1665 /NO, IGNORE NON-ADJACENT INCLUDED PNT, GOTO [SP.1.2.1];
S	TAD \IEDIR
S	SNA CLA
S	JMP \1665 /NO, IGNORE INCLUDED PNT, GOTO [SP.1.2.1];
C
S	TAD \IELAST
S	SNA CLA
S	JMP RSPLIT /NO
C		Then SETEXRUN([Ei:Xi]==>[Xi:1024]),
C	NOTE: EI(DOWN), XI(UP)
	IX1=IENT+IEDIR+IELAST
	IENT=IXIT+IXDIR+256
	IXIT=1024+IXIT+IEDIR
S	JMS SETEXRUN
	IX=IBACK
C		     (NEWRUN(Ei); SETEXRUN(N+1)[Ei:IX]);
	IX=IXBACK
	IX=IENT
	LX=-1
S	TAD \LX
S	DCA I RLASTX
S	JMS NEWRUN
C
	IENT=IX1
C	NOTE: IX(UP)
	IXIT=IX+256
S	JMS SETEXRUN
C
C	UPDATE LX
	LX=-(IX+1000)
S	TAD \LX
S	DCA I RLASTX
C	COMPUTE: ***	DID='SPCCWL'
	IDID=25
C	GOTO [2.1.1.1]
	GOTO 201
C
C
C	************************************************
C	************ SUBROUTINE   E X T E N D   **********
C	************************************************
C	EXTEND A RUN TO IX AS FOLLOWS:
C
C	[E.1] IF THE NUMBER OF RUNS N=0
C		OR (IENT > IXIT)
C		 THEN RETURN;
C
C	[E.2] IF (IENT-1=IX) AND ISAMELINE=1
C		THEN "LEFT ADJ RUN EXTENSION"
C			IENT<==IX, LX<==-(IX+1000), RETURN TO MAIN;
C
C	[E.3] IF (IXIT+1=IX) AND ISAMELINE
C		THEN "RIGHT ADJ RUN EXTENSION"
C			IXIT<==IX, LX<==-(IX+1000), RETURN TO MAIN;
C
C	[E.4] IF (LX<-1) AND (IENT leq IXIT)
C		THEN
C		BEGIN "DO NON-TOUCHING RUN EXTENSION"
C		IF (IX<IENT) AND IX(UP)=(MY>IY) AND (IENT NEQ 1024)
C			THEN
C			BEGIN "LEFT POINT, TEST IF EXTEND"
C				IENT_IX, LX_-IX-1000; RETURN TO MAIN;
C			END "LEFT POINT, TEST IF EXTEND"
C
C		IF (IX>IXIT) AND IX(DOWN)=(MY<IY) AND (IXIT NEQ 1024)
C			THEN
C			BEGIN "RIGHT POINT, TEST IF EXTEND"
C				IXIT_IX, LX_-IX-1000; RETURN TO MAIN;
C			END "RIGHT POINT, TEST IF EXTEND"
C		END "DO NON-TOUCHING RUN EXTENSION"
C		ELSE RETURN;
C
S	CPAGE 3
S REXTEND,	JMP I EXTEND
S EXTEND,	0 /ENTRY
S	CLA
C
C	[E.1] CHECK IF ANY PREVIOUS RUNS.
C	IF N=0 
C		THEN EXTEND 
C		ELSE RETURN IMMEDIATELY;
S	TAD I RIRUN
S	DCA \N
C
S	TAD \N
S	SNA CLA
S	JMP REXTEND /DO NOT EXTEND
C
C	COMPUTE: (IENT,IXIT)<==RUN(N,IY)
S	JMS GETEXRUN
C
C	IF (IENT > IXIT)
C		THEN RETURN
S	TAD \IENT
S	CIA
S	TAD \IXIT
S	SPA CLA
S	JMP REXTEND /RETURN
C
C	COMPUTE: LX=LASTX(IY+1)
S	JMS GETLX
C
C	------------------------------------------------
C
C	[E.2] TEST FOR LEFT ADJACENT EXTENSION
C	 IF (IENT-1=IX)
C@C		 AND ISAMELINE=1
C		THEN IENT<==IX, LX<== -IX-1000, RETURN TO MAIN;
C
S	CLA CMA
S	TAD \IENT
S	CIA
S	TAD \IX
S	SZA CLA
S	JMP EXT2
C
C@S	TAD \ISAMELINE
C@S	SNA CLA
C@S	JMP EXT2 /NOT ON SAME LINE, SO IGNORE
C
C	YES, "LEFT RUN EXTENSION"
C	RUN[N,IY]<==(IX,IXIT(RUN[N,IY]));
	IENT=IX+256+IEDIR
	IXIT=IXIT+IXDIR
C
S	JMS SETEXRUN
C
C	COMPUTE: ***	DID='EXALFT'
	IDID=9
C
C
C	SET UP CODE THAT THIS WAS AN EXTENSION
1300	LX=-(IX+IXDIR)-1000
S	TAD \LX
S	DCA I RLASTX
C	GOTO [2.1.1.1]: SAVE (IX,IY)==>(MX,MY) RETURN TO MAIN;
	GOTO 201
C
C	------------------------------------------------
C
C	[E.3] TEST FOR RIGHT ADJACENT EXTENSION
C	 IF (IXIT+1=IX)
C@C		 AND ISAMELINE=1
C		THEN IXIT<==IX, LX<== -IX-1000,  RETURN TO MAIN;
SEXT2,	CLA IAC
S	TAD \IXIT
S	CIA
S	TAD \IX
S	SZA CLA
S	JMP \1301 /NO
C
C@S	TAD \ISAMELINE
C@S	SNA CLA
C@S	JMP \1301 /NOT ON SAME LINE
C
C	YES, "RIGHT RUN EXTENSION"
C	RUN[N,IY]<==(IENT(RUN[N,IY],IX);
	IXIT=IX+256+IXDIR
	IENT=IENT+IEDIR
C
S	JMS SETEXRUN
C
C	COMPUTE: ***	DID='EXARHT'
	IDID=10
C
	GOTO 1300
C
C
C	--------------------------------------------------
C	[E.4] TEST IF NON-ADJACENT RUN EXTENSION
C	IF (LX<-1) AND (IENT leq IXIT)
C		AND (IXIT NEQ 1024) AND (IENT NEQ 1024)
S\1301,	CLA IAC
S	TAD \LX
S	SMA CLA
S	JMP REXTEND /NO
C
S	TAD \IENT /IF IENT > IXIT THEN FAIL!
S	CIA
S	TAD \IXIT
S	SPA CLA
S	JMP REXTEND /NO
C
C
S	TAD \IESPLIT
S	AND (2000 /SPLIT FLAG
S	SZA CLA
S	JMP REXTEND /=, IGNORE SPLIT RUN
C
S	TAD \IXSPLIT
S	AND (2000 /SPLIT FLAG
S	SZA CLA
S	JMP REXTEND /=, IGNORE SPLIT RUN
C
C
C		THEN
C		BEGIN "DO NON-TOUCHING RUN EXTENSION"
C
C
C	[E.4.1] IF (IX<IENT) AND IX(UP)=(MY>IY)
S	TAD \IENT
S	CIA
S	TAD \IX
S	SMA CLA
S	JMP \1303 /NO
C
S	TAD \MY
S	CIA
S	TAD \IY
S	SMA CLA
S	JMP \1303 /NO EXTENSION
C
C			THEN
C			BEGIN "LEFT POINT, TEST IF EXTEND"
C				THEN "EXTEND"
C					IENT_IX, LX_-IX-1000; RETURN TO MAIN;
C	RUN[N,IY]<==(IX,IXIT(RUN[N,IY]));
C	NOTE: IX(UP)
	IENT=IX+256
	IXIT=IXIT+IXDIR
S	JMS SETEXRUN
C
C	COMPUTE: ***	DID='EXNLFT'
	IDID=11
C
C	NOTE: IX(UP)
	LX=-IX-1000
S	TAD \LX
S	DCA I RLASTX
C	SAVE (IX,IY)==>(MX,MY) AND RETURN AT [2.1.1.1]
	GOTO 201
C			END "LEFT POINT, TEST IF EXTEND"
C
C
C
C	[E.4.2] IF (IX>IXIT) AND IX(DOWN)=(MY<IY)
S \1303,	TAD \IX
S	CIA
S	TAD \IXIT
S	SMA CLA
S	JMP REXTEND /NO
C
S	TAD \IY
S	CIA
S	TAD \MY
S	SMA CLA
S	JMP REXTEND /NO EXTEND
C			THEN
C			BEGIN "RIGHT POINT, TEST IF EXTEND"
C				THEN "EXTEND"
C					IXIT_IX, LX_-IX-1000; RETURN TO MAIN;
C	RUN[N,IY]<==(IENT(RUN[N,IY]),IX);
C	NOTE: IX(DOWN)
	IXIT=IX+256+512
	IENT=IENT+IEDIR
C
S	JMS SETEXRUN
C
C	COMPUTE: ***	DID='EXNRHT'
	IDID=12
C
	LX=-(IX+512)-1000
S	TAD \LX
S	DCA I RLASTX
C	SAVE (IX,IY)==>(MX,MY) AND RETURN AT [2.1.1.1]
	GOTO 201
C			END "RIGHT POINT, TEST IF EXTEND"
C		END "DO NON-TOUCHING RUN EXTENSION"
C		ELSE RETURN;
S		JMP REXTEND
C	********************************************************
C	*SUBROUTINE     N E W R U N
C	******************************************************
C	TEST IF START A NEW RUN. 
C	If (lastx(y) < 0)
C		Then Return
C		Else 
C		Begin "start new run"
C		lastx(y)<==IX;
C		If (n_irunnumber(y)+1) < MR
C			then irunnumer(y)<==n
C			Else lastx(y)<==-1;
C		Return;
C		End "start new run";
C
C
S	CPAGE 3
S RNEWRUN,	JMP I NEWRUN
S NEWRUN,	0 /ENTRY
S	CLA
C
C
C	[NR.1] TEST IF THE ENTRANCE POINT (LASTX) WAS NOTED.
C	IF LASTX(IY) GEQ 0
C		THEN RETURN TO FINISH OFF THE RUN;
S	TAD I RLASTX
S	DCA \LX
S	TAD \LX
S	SMA CLA
S	JMP RNEWRUN
C
C
C	[NR.2] ELSE START NEW RUN
C	COMPUTE:	LASTX(IY1)_IX+IF(MY<IY)="DOWN"
C					 THEN '1000 ELSE 0
S	TAD \IY
S	CIA
S	TAD \MY
S	SPA CLA
S	TAD (1000
C
S	TAD \IX
S	DCA I RLASTX
C
C	COMPUTE:	N=IRUNNUMBER(IY1)+1
S	TAD I RIRUN
S	DCA \N
	N=N+1
C
C	COMPUTE: ***	DID='NEWRUN'
	IDID=21
C
C
C	[NR.2.1] TEST IF OVF CORE RUN LENGTH BUFFERS
	MR=128
C	IF N > MR 
C
S	TAD \N
S	CIA
S	TAD \MR
S	SPA CLA
S	JMP \204 /ERROR
C
C		THEN START NEW RUN N, SAVE NEW # OF RUNS FOR IY1
C	COMPUTE:	IRUNNUMBER(IY1)=N
S	TAD \N
S	DCA I RIRUN
C
C		IF OLD(Y)=LOOKAHEAD(Y) NEQ (Y)
C			THEN COMPLETE RUN ELSE RETURN
S	TAD \MY
S	CIA
S	TAD \IYLA
S	SZA CLA
S	JMP RNEWRUN /NOT END POINT
C
S	TAD \IYLA
S	CIA
S	TAD \IY
S	SNA CLA
S	JMP RNEWRUN /NOT END POINT
C
C	!! YES, HAIR END POINT MAKE UNARY RUN!
S	CLA CMA /-1
S	DCA \LX
S	CLA CMA
S	DCA I RLASTX /-1
C
	IENT=IX+LXDIR
	IXIT=IX+LXDIR
S	JMS SETEXRUN /SET [IENT,IXIT] OF (N,IY)
C	COMPUTE: ***	DID='HAIREP'
	IDID=13
S	JMP RNEWRUN
C
C		ELSE ERROR, OVF IY1 RUNS
204	IERR=1
C	COMPUTE: ***	DID='NEWOVF'
	IDID=27
C	DELETE START OF NEW RUN
C	COMPUTE: LASTX(IY1)=-1
S	CLA CMA
S	DCA I RLASTX
S	JMP RNEWRUN
C
C	*****END START NEW RUN******
C
C	***********************************************
C	*SUBROUTINE   C O M P L E T E R U N
C	*************************************************
C
C	COMPLETE RUNS. TEST IF COMPLETING UNARY, RIGHT, OR LEFT
C	RUN. THE PRECONDITION FOR FINISHING A RUN IS:
C
C	IF (IRUNNUMBER(IY) > 0 ) AND (LASTX(IY) > 0)
C		THEN
C		BEGIN "TRY TO COMPLETE RUN"
C		IF (MY=IY)
C			THEN
C			BEGIN "Complete adjacent run"
C			CASE OF (LX related to IX)
C			[LX<IX] "Compl. RHT adj run"
C				SETEXRUN(LX+LXDIR,IX+LASTX+LXDIR,IY,N);
C				LASTX(IY)_(-IX-1000); DONE;
C			[LX>IX] "Compl. LFT adj run"
C				SETEXRUN(IX+LASTX+LXDIR,LX+LXDIR,IY,N);
C				LASTX(IY)_(-IX-1000); DONE;
C			END "Complete adjacent run"
C
C		ELSE
C		BEGIN "Complete non-adjacent runs"
C		CASE OF (LX related to IX)
C		[LX<IX] IF (MY>IY)
C			THEN
C			Begin "right run"
C			[SETEXRUN(LX+DOWN,IX+LASTX+UP,IY,N);
C			LASTX(IY)_(-IX-1000);
C			DONE;
C			End "right run";
C
C		[LX = IX] IF (MY=IY)
C			THEN
C			Begin "unary run"
C			[SETEXRUN(LX,IX,IY,N);
C			LASTX(IY)_(-IX-1000);
C			DONE;
C			End "unary run";
C
C		[LX>IX] IF (MY<IY)
C			THEN
C			Begin "left run"
C			[SETEXRUN(IX+LASTX+DOWN,LX+UP,IY,N);
C			LASTX(IY)_(-IX-1000);
C			DONE;
C			End "left run";
C		END "Complete non-adjacent runs"
C
C		END "TRY TO COMPLETE RUN";
C	RETURN;
C
C	--------------------------------------------------------------
S	CPAGE 3
S RCOMPLETERUN,	JMP I COMPLETERUN
S COMPLETERUN,	0 /ENTRY
S	CLA
C
C
C	[FR.1] GET THE LAST N AND LAST X.
C	COMPUTE:	N=IRUNNUMBER(IY+1)
S	TAD I RIRUN
S	DCA \N
C
C	COMPUTE:	LX=LASTX(IY+1)
S	JMS GETLX /LX,LXDIR
C	GUESS LX
	IX1=-(IX+LXDIR)-1000
C
C		[FR.1.1] IF (LX GEQ 0)
C			 THEN DISPATCH TO <, =, OR > RUN
S		TAD \LX
S		SPA CLA
S		JMP RCOMPLETERUN /DON'T FINISH RUN
C
		IF(LX-IX) 220, 211, 230
C
C
C	[FR.2] CASE OF (LASTX[IY1]=IX)
C	***** BEGIN UNARY RUN****
211	CONTINUE
C	[IEDIR:IXDIR]_IF LOOKAHEAD(Y) < IY
C		 		THEN [UP:DN]
C				ELSE [DN:UP];
S	TAD \IYLA
S	CIA
S	TAD \IY
S	SPA CLA
S	TAD (D512 /DN
S	DCA \IEDIR
C
S	TAD \IY
S	CIA
S	TAD \IYLA
S	SPA CLA
S	TAD (D512 /DN
S	DCA \IXDIR
C
	IENT=LX+IEDIR
	IXIT=LX+IXDIR
C	COMPUTE: ***	DID='CMPUNY'
	IDID=7
	GOTO 221
C	***** END UNARY RUN*****
C
C
C	[FR.3] CASE OF (LASTX(IY1)<IX)
C	THEN
C	****BEGIN RIGHT RUN****
220	CONTINUE
C	TEST IF (MY=IY)
C		THEN ADJACENT RHT-RUN
S	TAD \ISAMELINE
S	SNA CLA
S	JMP \223 /NO
C	YES
	IENT=LX+LXDIR
	IXIT=IX+256+LXDIR
C	COMPUTE: ***	DID='CPARHT'
	IDID=4
	GOTO 221
C
C	TEST IF LEGAL NON-ADJACENT RUN
C	IF (MY<IY) = "DOWN"
C		THEN CONTINUE RIGHT NON-ADJ RUN
C		ELSE FAILED, RETURN;
S\223,	TAD \IY
S	CIA
S	TAD \MY
S	SMA CLA
S	JMP RCOMPLETERUN /FAILED
C
C	SUCCEEDED
C	NOTE: LX(UP)
	IENT=LX+IEDIR
C	NOTE: IX(DOWN)
	IXIT=IX+256+512
C
C	SET LASTX SWITCH
C	NOTE: IX(DOWN)
	IX1=-(IX+512+1000)
C
C	COMPUTE: ***	DID='CPNRHT'
	IDID=6
C
C
C	[FR.3.1] SAVE THE RUN AND RESET LASTX. STORE THE RUN.
221	CONTINUE
S	JMS SETEXRUN /SET [IENT,IXIT] OF (N,IY)
C
C
C	SET THE LASTX SWITCH 
S	TAD \IX1
S	DCA I RLASTX
C
C	RETURN!
C	GOTO [2.1.1.1]
	GOTO 201
C	******END RIGHT RUN****
C
C
C
C	[FR.4] CASE OF (LASTX(IY1) > IX)
C	THEN
C	*****BEGIN LEFT RUN****
230	CONTINUE
C	TEST IF LEGAL ADJ-RUN
S	TAD \ISAMELINE
S	SNA CLA
S	JMP \231 /NO
C	YES
	IENT=IX+256+LXDIR
	IXIT=LX+LXDIR
C	COMPUTE: ***	DID='CPALFT'
	IDID=3
	GOTO 221
C
C	TEST IF LEGAL NON-ADJ RUN
C	IF (MY>IY)
C		THEN CONTINUE LEFT RUN
C		ELSE FAILED, RETURN;
S\231,	TAD \MY
S	CIA
S	TAD \IY
S	SMA CLA
S	JMP RCOMPLETERUN
C
C	IMPLEMENT THE LEFT RUN BY SWAPPING FIRST AND LAST X THEN
C	DOING A RIGHT RUN.
C	SWAP IX<==>LX
C	NOTE: IX(UP)
	IENT=IX+256
C	NOTE: LX(DOWN)
	IXIT=LX+512
C	COMPUTE: ***	DID='CPNLFT'
	IDID=5
C	NOTE: IX(UP)
	IX1=-(IX+1000)
C		GOTO [FR.3]
	GOTO 221
C	*****END LEFT RUN****
C
C
C
C	*************POINTERS*******
S PLASTX,	\LASTX
S PIRUN,	\IRUNNUMBER
S PIEXPTR,	\IEXPTR
	ISAMELINE=0
	IENT=0
	IXIT=0
C
C	***** SEMANTIC LABEL NAME TABLE ****
S PTABLE,	TABLE
C
S	CPAGE 121
S TABLE,	BLOCK 0
S	TEXT #CGLHSP# /1
S	TEXT #CGRHSP# /2
S	TEXT #CPALFT# /3
S	TEXT #CPARHT# /4
S	TEXT #CPNLFT# /5
S	TEXT #CPNRHT# /6
S	TEXT #CMPUNY# /7
S	TEXT #DUP-PT# /8
S	TEXT #EXALFT# /9
S	TEXT #EXARHT# /10
S	TEXT #EXNLFT# /11
S	TEXT #EXNRHT# /12
S	TEXT #HAIREP# /13
S	TEXT #IMPLFT# /14
S	TEXT #IMPRHT# /15
S	TEXT #IMPLFH# /16
S	TEXT #IMPRHH# /17
S	TEXT #INCDPT# /18
S	TEXT #MRGLFT# /19
S	TEXT #MRGRHT# /20
S	TEXT #NEWRUN# /21
S	TEXT #NULPNT# /22
S	TEXT #SPCW-L# /23
S	TEXT #SPCW-R# /24
S	TEXT #SPCCWL# /25
S	TEXT #SPCCWR# /26
S	TEXT #NEWOVF# /27
C
C
	END