! File:   FINAL.BLI
!
!    This work was supported by the Advanced Research
!    Projects Agency of the Office of the Secretary of
!    Defense (F44620-73-C-0074) and is monitored by the
!    Air Force Office of Scientific Research.
!
Module FINAL=
Begin
!				FINAL MODULE
!				------------
!
!                                                       J. APPERSON
!                                                       S. HOBBS
!
Require 'Bliss';

Own
	CHANGE		: Boolean,
	PUSHPOPFLAG	: Boolean;

Forward Routine
	ADRLEN,
	ADRSIMP,
	BACKEQ,
	BACKOV,
	BACKSET,
	BRIMPLY,
	CELLLENGTH,
	CLEARTOLAB,
	COMBLAB,
	CONDJMPSRC,
	DELADR,
	DELETE,
	DELBACKREF	: Novalue,
	DELTST,
	DOWNDATE	: Novalue,
	DUPADR,
	EQUIVADR,
	EQUIVFWD	: Novalue,
	EQUIVIND,
	FINAL		: Novalue,
	FINAL1		: Novalue,
	FINAL2		: Novalue,
	FINAL3		: Novalue,
	FIXJMPIND,
	LABREFED,
	LABREFP,
	MAKEADR		: Novalue,
	MAKEINFLOOP	: Novalue,
	MAKELABREF,
	MAKEJMP,
	MAYPOP,
	MAY_REFER,
	MAY_USE_ADDR,
	MVLABREF,
	OPT_ADDSUB,
	OPT_BIC,
	OPT_BIS,
	OPT_BIT,
	OPT_BOOLEAN,
	OPT_CLC,
	OPT_CLR,
	OPT_CLVC,
	OPT_CMP,
	OPT_DEC,
	OPT_INC,
	OPT_JSR,
	OPT_MOV,
	OPT_TST,
	PCASPARAM,
	PCONDJMP,
	PLAB,
	PUNCONDJMP,
	REACH,
	IS_SAME_ADR,
	IS_SAME_CMP,
	IS_SAME_IND,
	SETSCC,
	TESTCC,
	TESTEQL,
	TESTPOP,
	TESTPP,
	TESTPUSH,
	UPDATE		: Novalue;

Macro
	SETCHANGE	= (CHANGE = TRUE) %,
	REVCOND(I)	= (I Xor 1) %,
	CCSHIFT(X)	= ((X)^9) %,
	REDUCEADR(X)	=
			Begin
			DELADR(ST[X,cel_src],X);
			COPYADR(ST[X,cel_src],ST[x,cel_dst])
			End %;

Require 'final_tables.req';

! DEFINITIONS FOR "BASE" ADDRESSES

Bind
	PCADR		= ADRPLIT(  GENREG, PC,UNUSED,     NAME_NORMAL, 0) : ADRVARSTR,
	IMMEDZERO	= ADRPLIT( AUTOINCR,PC,ADDR_IMMED, NAME_NORMAL, 0) : ADRVARSTR,
	IMMEDONE	= ADR1PLIT(AUTOINCR,PC,ADDR_IMMED, NAME_NORMAL, 0) : ADRVARSTR,
	MEMADR		= ADRPLIT( INDEXED, PC,ADDR_MEMORY,NAME_LABEL,  0) : ADRVARSTR,
	REGADR		= ADRPLIT(  GENREG,  0,ADDR_REG,    NAME_NORMAL,0) : ADRVARSTR,
	SPADR		= ADRPLIT(  GENREG, SP,ADDR_REG,    NAME_NORMAL,0) : ADRVARSTR;

!	THIS SECTION CONTAINS THE REAL WORK
!	OF FINAL -- CROSS-JUMPS, ETC.

!
! FUNCTION:
!	RETURN THE LENGTH IN WORDS (EITHER 1 OR 0) OF THE PDP-11
!	REPRESENTATION OF ADDRESS 'ADR'. HAS AN OPTIMIZATION SIDE EFFECT.
!
Routine ADRLEN(ADR : Ref ADRVARSTR) =
Begin

! change 0(reg) to @reg

    If .ADR[adr_mode] Eql INDEXED And .ADR[adr_reg] Neq PC And .ADR[adr_name] Leq 1 And
		.ADR[adr_disp] Eql 0 Then
	ADR[adr_mode] = GENREG + DEFERRED;

! indexed modes and auto-inc PC modes take an extra word

    If (.ADR[adr_mode] And 6) EQL INDEXED Then
	Return TRUE;
    If .ADR[adr_reg] Eql PC And (.ADR[adr_mode] And 6) Eql AUTOINCR Then
	Return TRUE
    Else
	Return FALSE
End;

!
! MEASURES THE SIMPLICITY OF AN ADDRESS.
! USED BY EQUIVADR AND EQUIVIND.
!
Routine ADRSIMP(A : Ref ADRVARSTR) =
Begin
    Local
	A1		: Integer,
	A2		: Integer,
	A4		: Integer,
	A12		: Integer;

! classification of addressing mode complexities:
!
!	0	-impossible-
!	1	#0
!	2	R
!	3	@SP
!	4	@R, (R)+, -(R)
!	5	#n
!	6	#k
!	7	n
!	8	k(SP)
!	9	n(R)
!	10	@#k
!	11	k(R)
!	12	@0(SP)
!	13	@n
!	14	@k(SP)
!	15	@n(R)
!	16	@k(R), @(R)+, @-(R)
!	17	@k

    Bind
	SIMPLICITY = Uplit Byte (
		 0,	!    zero      immed -impossible-
		 1,	! PC zero      immed #0
		 0,	!              immed -impossible-
		 6,	! PC           immed #k
		 0,	!    zero SP   immed -impossible-
		 0,	! PC zero SP   immed -impossible-
		 0,	!         SP   immed -impossible-
		 0,	! PC      SP   immed -impossible-
		 0,	!    zero name immed -impossible-
		 5,	! PC zero name immed #n
		 0,	!         name immed -impossible-
		 5,	! PC      name immed #n
		16,	!    zero      indir @(R)+ \ @-(R) \ @0(R)
		17,	! PC zero      indir @k
		16,	!              indir @k(R)
		17,	! PC           indir @k
		12,	!    zero SP   indir @0(SP)
		 0,	! PC zero SP   indir -impossible-
		14,	!         SP   indir @k(SP)
		 0,	! PC      SP   indir -impossible-
		15,	!    zero name indir @n(R)
		13,	! PC zero name indir @n
		15,	!         name indir @n(R)
		13,	! PC      name indir @n
		 4,	!    zero            @R \ (R)+ \ -(R)
		10,	! PC zero            @#0
		11,	!                    k(R)
		10,	! PC                 k(PC), @#k
		 3,	!    zero SP         0(SP)
		 0,	! PC zero SP         -impossible-
		 8,	!         SP         k(SP)
		 0,	! PC      SP         -impossible-
		 9,	!    zero name       n(R)
		 7,	! PC zero name       n
		 9,	!         name       n(R)
		 7)	! PC      name       n
		: Vector[,Byte];

    If .A[adr_type] Eql ADDR_REG Then
	Return 2;
   If Not ONEOF(.A[adr_type],ADDR_IMMED,ADDR_MEMORY,ADDR_INDIRECT) Then
	Return 0;
    A1 =  1*(.A[adr_reg] Eql PC);
    A2 =  2*(.A[adr_disp] Neq 0);
    A4 =  4*(If .A[adr_name] Eql 0
			Then 0
			Else If .A[adr_name] Eql 1
			Then 1
			Else 2);
    A12= 12*(If   .A[adr_type] Eql ADDR_IMMED
			Then 0
			Else If .A[adr_type] Eql ADDR_INDIRECT
			Then 1
			Else 2);
    Return .SIMPLICITY[.A12 + .A4 + .A2 + .A1]
End;

!
! TRUE IF ADDRESSES A AND B ARE
! EQUIVALENT ENOUGH TO BE CROSS-JUMPED OVER.
! DA AND DB ARE STACK ADJUSTS (OR ADJUSTS TO OTHER REGISTERS),
! AND THERE MAY BE SIDE-EFFECTS ON THESE.
!
Routine BACKEQ(A : Ref ADRVARSTR,B : Ref ADRVARSTR,DA,DB) =
Begin

! if 'A' is a label then 'B' had better be a label too and reference
! the same cell.

    If .A[adr_name_type] Eql NAME_LABEL Then
	If .B[adr_name_type] Eql NAME_LABEL Then
	    Return .ST[.A[adr_name],cel_ref_ef] Eql .ST[.B[adr_name],cel_ref_ef]
	Else
	    Return FALSE;

! if NAME_ERROR or NAME_FORMAL then no match

    If .A[adr_name_type] Neq NAME_NORMAL Then
	Return FALSE;

! the two addresses must use the same register
! and name and the operand must actually exist.

    If .A[adr_reg] Neq .B[adr_reg] Or .A[adr_name] Neq .B[adr_name] Or .A[adr_type] Eql UNUSED Then
	Return FALSE;

! if not complex, need only to compare displacements

    If .A[adr_reg] Neq SP Then
	Return .A[adr_disp] Eql .B[adr_disp] And .A[adr_delta] Eql .B[adr_delta];

! stack modes.  check displacements, taking into account stack adjustments

    If .A[adr_disp] + ..DA Neq .B[adr_disp] + ..DB Then
	Return FALSE;

! if the value of SP itself, the adjustments must be the same for them
! to be equal

    If .A[adr_type] Eql ADDR_REG Then
	Return ..DA Eql 0;

! if no need to change adjustments

    If ..DA Eql 0 And ..DB Eql 0 And .A[adr_delta] Eql .B[adr_delta] Then
	Return TRUE;

! MUST CHANGE STACK ADJUSTS, OFFSETS, DELTAS, OR EVEN MODES.

! compute the new displacements and modify the adjustments
! according to any auto-increments/decrements

    A[adr_disp] = .A[adr_disp] + ..DA;
    B[adr_disp] = .B[adr_disp] + ..DB;
    .DA = ..DA - .A[adr_delta];
    .DB = ..DB - .B[adr_delta];
    A[adr_delta] = 0;
    B[adr_delta] = 0;

! re-compute the addressing modes

    A[adr_mode] = (If .A[adr_type] Eql ADDR_INDIRECT
			Then INDEXED+DEFERRED
			Else If .A[adr_disp] Eql 0
			Then GENREG+DEFERRED
			Else INDEXED);
    B[adr_mode] = (If .B[adr_type] Eql ADDR_INDIRECT
			Then INDEXED+DEFERRED
			Else If .B[adr_disp] Eql 0
			Then GENREG+DEFERRED
			Else INDEXED);
    Return TRUE
End;

!
! FUNCTION:
!	THIS ROUTINE PERFORMS CROSS-JUMPING. F AND T ARE POINTERS TO
!   THE ENDS OF TWO BLOCKS OF CODE (THE "FROM" BLOCK AND THE "TO" BLOCK),
!   WHICH JOIN EACH OTHER BY BRANCHING OF SOME SORT.
!
! IDENTIFIERS:
!    DF,DT -- (DELTA F, DELTA T) CONTAIN THE AMOUNT THE STACK MUST BE
!		ADJUSTED AT THE TOP OF EACH BLOCK.
!    SDF,SDT -- BEFORE ATTEMPTING TO BACK OVER A CODE CELL,
!		BACKOV SAVES DF & DT IN THESE TWO.
!    ADJUST -- THE AMOUNT THE STACK MUST BE ADJUSTED AT THE 
!		BOTTOM OF THE "TO" BLOCK.
!    FLAG -- INITIALLY 1; SET TO 0 AS SOON AS A CELL IS SUCCESSFULLY
!	     BACKED OVER.
!    SKIPFLAG -- IS SET FOR ONE OF TWO REASONS.  THE FIRST IS WHEN
!		 A TWO-WORD STACK ADJUSTMENT IS NECESSARY IF THE
!		 CURRENT CELL IS TO BE BACKED OVER; THIS PREVENTS
!		 CROSS-JUMPING FROM LOSING BY INSERTING TWO WORDS
!		 OF STACK-ADJUSTING CODE TO SAVE ONE WORD OF CROSS-
!		 JUMPED CODE. THE SECOND REASON HAS TO DO WITH CMU'S
!		 "HYDRA" ROUTINE LINKAGE, WHICH INVOLVES WORDS OF
!		 CODE WHICH MUST NOT BE BACKED OVER UNLESS THE PREVIOUS
!		 WORD CAN BE BACKED OVER.
!
Routine BACKOV(F : Ref CELL,T : Ref CELL) =
Begin
    Local
	ADJUST		: Integer,
	DF		: Integer,
	DT		: Integer,
	SDF		: Integer,
	SDT		: Integer,
	FINIT		: Ref CELL,
	TINIT		: Ref CELL,
	FLAG		: Boolean,
	SKIPFLAG	: Boolean,
	DSTF		: ADRVARSTR,
	DSTT		: ADRVARSTR;

    FINIT = .F;
    TINIT = PRVCC(.T);
    SKIPFLAG = FALSE;
    FLAG = TRUE;

! skip over any stack adjustments and get the adjustment value

    F = PRVCC(BACKSET(.F,DF));
    T = BACKSET(.T,DT);
    T = .T[cel_prev];

! compute the difference in stack adjustments

    ADJUST = .DT-.DF;
    If .ADJUST Neq 0 Then
	If .ADJUST Lss 0 Then
	    Begin

! set skipflag if more than two words of adjustment are needed

	    If .DF Eql 0 And .ADJUST Lss -4 Then
		SKIPFLAG = TRUE;
	    DF = -.ADJUST;
	    ADJUST = 0;
	    DT = 0
	    End
	Else
	    Begin

! set skipflag if more than two words of adjustment are needed

	    If .DT Eql 0 And .ADJUST Gtr 4 Then
		SKIPFLAG = TRUE;
	    DT = .ADJUST;
	    DF = 0
	    End
    Else If .DF Neq 0 Then
	Begin
	F = NXTCC(.F);
	T = NXTCC(.T);
	ADJUST = 0;
	DF = 0;
	DT = 0
	End;
    While TRUE Do
	Begin

! save the stack depths

	SDF = .DF;
	SDT = .DT;

! if not at a code cell then move to the previous one, making sure
! we don't move over non-cells when we have a stack adjustment

	If .T[cel_type] Neq CELL_CODE Then
	    If .DT Neq 0 Then
		Exitloop
	    Else
		T = PRVCC(.T);

! ditto for 'F'

	If .F[cel_type] Neq CELL_CODE Then
	    If .DF Neq 0 Then
		Exitloop
	Else
	    F = PRVCC(.F);

! must both be the same instruction code

	If .T[cel_code] Neq .F[cel_code] Then
	    Exitloop;

! now compare operands

	Case .OPERTYPE[.T[cel_code]] From LO_OPTYPE To HI_OPTYPE Of Set
	    [ OPTYPE_NOP ]:
		Begin

! cannot cross-jump over INLINE code

		If .T[cel_code] Eql PINLINE Then
		    Exitloop;

! cannot cross-jump over unconditional jumps

		If .T[cel_code] Eql PRTI Then
		    Exitloop;

! cannot cross-jump over any instructions which implicitly use
! the stack pointer.

		If .T[cel_code] Eql PIOT Then
		    If .DF Neq 0 Or .DT Neq 0 Then
			Exitloop
		End;

	    [ OPTYPE_ONE ]:

! one-operand - compare the single operands

		If Not BACKEQ(F[cel_src],T[cel_src],DF,DT) Then
		    Exitloop;

	    [ OPTYPE_TWO ]:
		Begin

! save the destination operands in case the BACKEQ for the source
! fails and the destination was modified.

		COPYADR(DSTF,F[cel_dst]);
		COPYADR(DSTT,T[cel_dst]);

! compare destination operands

		If Not BACKEQ(F[cel_dst],T[cel_dst],DF,DT) Then
		    Exitloop;

! compare source operands, restoring the destination in case it
! was destroyed.

		If Not BACKEQ(F[cel_src],T[cel_src],DF,DT) Then
		    Begin
		    COPYADR(F[cel_dst],DSTF);
		    COPYADR(T[cel_dst],DSTT);
		    Exitloop
		    End
		End;

	    [ OPTYPE_BR ]:
		Begin

! cannot cross-jump over unconditional jumps

		If .T[cel_code] Eql PJMP Or .T[cel_code] Eql PBR Then
		    Exitloop;

! no stack adjustments allowed at fork points

		If .DF Neq 0 Or .DT Neq 0 Then
		    Exitloop;

! compare the branch destinations

		If Not BACKEQ(F[cel_src],T[cel_src],DF,DT) Then
		    Exitloop
		End;

	    [ OPTYPE_JSR ]:
		Begin

! JSR implicitly used the stack so no adjustments allowed.

		If .DF Neq 0 Or .DT Neq 0 Then
		    Exitloop;

! quick form of BACKEQ since the source may only be a register

		If .F[cel_src_reg] Neq .T[cel_src_reg] Then
		    Exitloop;

! compare destinations

		If Not BACKEQ(F[cel_dst],T[cel_dst],DF,DT) Then
		    Exitloop
		End;

	    [ OPTYPE_RTS ]:

! cannot cross-jump over unconditional jumps

		Exitloop;

	    [ OPTYPE_TRAP ]:
		Begin

! TRAP/EMT instructions implicitly use the stack so no adjustments
! are allowed.

		If .DF Neq 0 Or .DT Neq 0 Then
		    Exitloop;

! compare TRAP/EMT codes

		If .F[cel_src_disp] Neq .T[cel_src_disp] Then
		    Exitloop
		End;

	    [ OPTYPE_WORD ]:
		Begin

! may only cross-jump over .WORD's only if this is a hydra word.

		If Not .F[cel_hydra_word] Or Not .T[cel_hydra_word] Then
		    Exitloop;

! this is part of a hydra call which implicitly uses the stack
! so no adjustments are allowed.

		If .DF Neq 0 Or .DT Neq 0 Then
		    Exitloop;

! compare destinations.

		If Not BACKEQ(F[cel_src],T[cel_src],DF,DT) Then
		    Exitloop;

! note that we say a hydra word.

		SKIPFLAG = TRUE
		End;

	    [ OPTYPE_CASE ]:

! case jumps are maybe a little too hairy to cross-jump

		Exitloop
	Tes;

! if a final stack adjustment is needed and what was gained from
! cross-jumping was a single instruction then don't bother with
! doing cross-jumping since the stack adjustment generates more
! code than gained from cross-jumping.

	If Not .SKIPFLAG Or CELLLENGTH(.F) Neq 1 Then
	    Begin

! cross-jumping succeeded.  insert a JMP from 'F' to 'T'

	    SETCHANGE;
	    FLAG = FALSE;
	    F = BEFORE(.F,NEWCODECELL());
	    MAKEJMP(.F,.T);
	    T = .T[cel_prev]
	    End;

! now setup to try the next cell.

	SKIPFLAG = FALSE;
	T = .T[cel_prev];
	F = .F[cel_prev]
	End;

! return if nothing gained from cross-jumping

    If .FLAG Then
	Return .FINIT[cel_next];

! generate any common stack adjustment

    If .ADJUST Neq 0 Then
	Begin
	TINIT = AFTER(.TINIT,NEWCODECELL());
	TINIT[cel_code]     = PADD;
	TINIT[cel_class]    = INST_ADD_IMMED;
	COPYADR(TINIT[cel_dst],SPADR);
	COPYADR(TINIT[cel_src],IMMEDZERO);
	TINIT[cel_src_disp] = .ADJUST
	End;

! generate any stack adjustment for 'F'

    F = .F[cel_next];
    If .SDF Neq 0 Then
	Begin
	F = BEFORE(.F,NEWCODECELL());
	F[cel_code]     = PSUB;
	F[cel_class]    = INST_ADD_IMMED;
	COPYADR(F[cel_dst],SPADR);
	COPYADR(F[cel_src],IMMEDZERO);
	F[cel_src_disp] = .SDF;
	End;

! ditto for 'T'

    If .SDT Neq 0 Then
	Begin
	T = AFTER(.T,NEWCODECELL());
	T[cel_code]     = PSUB;
	T[cel_class]    = INST_ADD_IMMED;
	COPYADR(T[cel_dst],SPADR);
	COPYADR(T[cel_src],IMMEDZERO);
	T[cel_src_disp] = .SDT
	End;
    Return .F
End;

!
! FUNCTION:
!	BACK OVER ANY STACK ADJUSTING INSTRUCTIONS, UPDATING BOTH
!   CODE CELL POINTER "A" AND DELTA-VALUE "DA".  THIS IS ESSENTIALLY
!   A SETTING-UP ROUTINE FOR "BACKOV".
!
Routine BACKSET(A : Ref CELL,DA) =
Begin
    Local
	B		: Ref CELL;

    B = PRVCC(.A);
    .DA = 0;

! look for 'op #n,SP' where we know 'op' can only be ADD or SUB

    If .B[cel_src_type] Neq ADDR_IMMED Or
		.B[cel_src_name] Neq 0 Or
		.B[cel_dst_type] Neq ADDR_REG Or
		.B[cel_dst_reg] Neq SP Then
	Return .A;

! fetch the stack adjust

    If .B[cel_code] Eql PADD Then
	.DA = -.B[cel_src_disp]
    Else If .B[cel_code] Eql PSUB Then
	.DA  = .B[cel_src_disp]
    Else
	Return .A;

! if 'ADD #0,SP' then delete it and try again

    If ..DA Eql 0 Then
	B = BACKSET(DELETE(.B));
    Return .B
End;

!
! F AND T ARE OPF VALUES OF TWO
! CONDITIONAL BRANCH INSTRUCTIONS.
!
! VALUE:
!	2 - WHENEVER F CAUSES A BRANCH, T WILL NOT.
!	1 - WHENEVER F CAUSES A BRANCH, T WILL ALSO.
!	0 - NEITHER OF THE ABOVE.
!
Routine BRIMPLY(F : Integer,T : Integer) =
Begin

! if 'T' is unconditional then it doesn't matter what 'F' does

    If .T Eql PBR Or .T Eql PJMP Then
	Return 1;

! if the same operation then always.

    If .T Eql .F Then
	Return 1;

! if opposites then never

    If .T Eql REVCOND(.F) Then
	Return 2;

! BEQ implies BLE, BGE, BLOS, BHIS, BPL
! BEQ denies  BGT, BLT, BLO,  BHI,  BMI

    If .F Eql PBEQ Then
	If .T Eql PBLE Or .T Eql PBLOS Then
	    Return 1
	Else If .swit_final And .T Eql PBPL Then
	    Return 1
	Else If .T Eql PBGT Or .T Eql PBHI Then
	    Return 2
	Else If .swit_final And .T Eql PBMI Then
	    Return 2
	Else
	    Return 0;

! BLO implies BLOS
! BLO denies  BHI

    If .F Eql PBLO Then
	If .T Eql PBLOS Then
	    Return 1
	Else If .T Eql PBHI Then
	    Return 2
	Else
	    Return 0;

! BHI,BGT,BMI implies BNE
! BHI,BGT,BMI denies  BEQ

    If .F Eql PBHI Or .F Eql PBGT Or (.swit_final And .F Eql PBMI) Then
	If .T Eql PBNE Then
	    Return 1
	Else If .T Eql PBEQ Then
	    Return 2
	Else
	    Return 0;

! no other implications

    Return 0
End;

! returns the length of an instruction in words

Routine CELLLENGTH(CURS : Ref CELL) =
Begin
    Case .OPERTYPE[.CURS[cel_code]] From LO_OPTYPE To HI_OPTYPE Of Set

! no-op are normally 1 single word except for inline which we give a wild guess to

    [ OPTYPE_NOP ]:
	If .CURS[cel_code] Eql PINLINE Then
	    Return %o'201' * (1 - .CURS[cel_inl_comment])
	Else
	    Return 1;

! single operand

    [ OPTYPE_ONE ]:
	Return 1+ADRLEN(CURS[cel_src]);

! double operand

    [ OPTYPE_TWO ]:
	Return 1+ADRLEN(CURS[cel_src])+ADRLEN(CURS[cel_dst]);
    [ OPTYPE_BR ]:
	If LABREFP(.CURS) And .CURS[cel_code] Neq PJMP Then
	    Return 1
	Else If .CURS[cel_code] Eql PBR Or .CURS[cel_code] Eql PJMP Then
	    Return 1+ADRLEN(CURS[cel_src])
	Else
	    Return 2+ADRLEN(CURS[cel_src]);
    [ OPTYPE_JSR ]:
	Return 1+ADRLEN(CURS[cel_dst]);
    [ OPTYPE_RTS,OPTYPE_TRAP,OPTYPE_WORD,OPTYPE_CASE ]:
	Return 1
    Tes
End;

! delete instruction up to the next label

Routine CLEARTOLAB(IND : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL;

    NEXT = NXTLCC(.IND);
    Until .NEXT[cel_type] Eql CELL_LABEL Or .NEXT Eql .BRAK2 Do
	Begin
	DELETE(.NEXT);
	NEXT = NXTLCC(.IND)
	End;
    Return .NEXT
End;

! combine multiple labels into a single label

Routine COMBLAB(LAB : Ref CELL) =
Begin
    Local
	CURS		: Ref CELL,
	LABCURS		: Ref CELL;

! find the start of a sequence of labels

    While .Block[(LABCURS = PRVLCC(.LAB)),cel_type;0,Quad] Eql CELL_LABEL Do
	LAB = .LABCURS;

! loop for each label in the sequence, moving all references to the
! first one

    While .Block[(LABCURS = NXTLCC(.LAB)),cel_type;0,Quad] Eql CELL_LABEL Do
	Begin
	SETCHANGE;

! loop, moving all references

	CURS = .LABCURS[cel_top];
	Until .CURS Eql .LABCURS Do
	    CURS = MVLABREF(.CURS,.LAB);

! if we just merged in a user label or a procedure entry label then
! make the first label tjhat user/procedure entry label

	If .LABCURS[cel_lab_type] Eql LAB_USER Or
		.LABCURS[cel_lab_type] Eql LAB_ROUTINE Then
	    Begin
	    LAB[cel_lab_type] = .LABCURS[cel_lab_type];
	    LAB[cel_lab_name] = .LABCURS[cel_lab_name]
	    End;

! delete the label just merged in

	ERASE(.LABCURS)
	End;
    Return .LAB
End;

!
! FUNCTION:
!	THIS ROUTINE RETURNS THE ULTIMATE DESTINATION OF
!   THE BRANCHING CELL "CONDJ". "LAB" IS THE LABEL THAT IT
!   REFERENCES (NOT THE SAME ON TWO DIFFERENT RECURSIONS).
!
Routine CONDJMPSRC(LAB : Ref CELL,CONDJ : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL;

! this avoids endless recursion

    If .LAB[cel_lab_seen] Then
	Return .LAB;

! next was a label cell.  we need the code cell after it.

    NEXT = NXTCC(.LAB);
    If .NEXT[cel_code] Eql INFLOOPOP Then
	Return .LAB;

! only consider branches to jumps of some sort

    If .NEXT[cel_class] Neq INST_COND_JUMP And .NEXT[cel_class] Neq INST_UNCOND_JUMP Then
	Return .LAB;
    If Not LABREFP(.NEXT) Then
	Return .LAB;
    Case BRIMPLY(.CONDJ[cel_code],.NEXT[cel_code]) From 0 To 2 Of Set

! if the target is another branch with no implications

	[0]:
	    Return .LAB;

! if the target is another branch which will always branch on the
! condition

	[1]:
	    Begin
	    LAB[cel_lab_seen] = TRUE;
	    NEXT = CONDJMPSRC(LABREFED(.NEXT),.CONDJ);
	    LAB[cel_lab_seen] = FALSE;
	    Return .NEXT
	    End;

! if the target is another branch which never branches on the
! given condition

	[2]:
	    Return .NEXT[cel_next]
    Tes
End;

! delete an addressing descriptor

Routine DELADR(ADR : Ref ADRVARSTR,IND : Ref CELL) =
Begin
    Local
	PCELL		: Ref CELL;

! if there is a register adjustment (e.g. from AUTO-INCREMENT) then
! we need to insert an ADD/SUB to adjust the register

    If .ADR[adr_delta] Neq 0 Then
	Begin
	PCELL = NEWCODECELL();
	PCELL[cel_code]     = (If .ADR[adr_delta] Lss 0 Then PSUB Else PADD);
	PCELL[cel_class]    = INST_ADD_IMMED;
	COPYADR(PCELL[cel_src],IMMEDZERO);
	COPYADR(PCELL[cel_dst],REGADR);
	PCELL[cel_src_disp] = Abs(.ADR[adr_delta]);
	PCELL[cel_dst_reg]  = .ADR[adr_reg];
	PCELL[cel_min_loc]  = .IND[cel_min_loc];
	IND = BEFORE(.IND,.PCELL)
	End

! if a label reference then delete the reference cell

    Else If .ADR[adr_name_type] Eql NAME_LABEL Then
	ERASE(.ADR[adr_name]);
    Return .IND
End;

! delete an instruction

Routine DELETE(IND : Ref CELL) =
Begin
    Local
	T		: Ref CELL;

    SETCHANGE;

! point to the previous instruction.  'IND[cel_next]' is not correct
! because DELADR may insert register adjustments and we want to
! point to those adjustments on return.

    T = .IND[cel_prev];

! delete the operands

    If HASSOURCE(.IND[cel_code]) Then
	DELADR(IND[cel_src],.IND);
    If HASDEST(.IND[cel_code]) Then
	DELADR(IND[cel_dst],.IND);

! now erase the instruction

    ERASE(.IND);
    Return .T[cel_next]
End;

!
! SCAN BACKWARDS FROM IND, DELETING CELLS WHOSE SOLE PURPOSE
! IS TO CHANGE THE CONTENTS OF ADR.
!
! called from OPT_TST and OPT_MOV

Routine DELBACKREF(IND : Ref CELL,ADR : Ref ADRVARSTR,BYTES) : Novalue =
Begin
    Local
	CURS		: Ref CELL,
	AREF		: ADRVARSTR;
    Label
	aaa;

    While TRUE Do
	Begin
	CURS = .IND;
	COPYADR(AREF,.ADR);
	AREF[adr_disp] = .AREF[adr_disp] + .ADR[adr_delta];
	While TRUE Do			! loop to exit
	    aaa: Begin
	    CURS = .CURS[cel_prev];
	    If .CURS[cel_type] Neq CELL_CODE Then
		Leave aaa;
	    If .STOPBSCAN[.CURS[cel_code]] Then
		Return;
	    Selectone .OPERTYPE[.CURS[cel_code]] Of Set
		[OPTYPE_ONE]:
		    Begin
		    If IS_SAME_ADR(AREF,CURS[cel_src]) And
				.BYTES Geq .OPBYTES[.CURS[cel_code]] Then
			Begin
			DELETE(.CURS);
			Exitloop
			End;
		    If MAY_USE_ADDR(CURS[cel_src],AREF) Then
			Return;
		    If MAY_USE_ADDR(AREF,CURS[cel_src]) Then
			Return;
		    If .BYTES Lss .OPBYTES[.CURS[cel_code]] And
					MAY_REFER(CURS[cel_src],AREF) Then
			Return;
		    DOWNDATE(CURS[cel_src],AREF)
		    End;
		[OPTYPE_TWO]:
		    Begin
		    If IS_SAME_ADR(AREF,CURS[cel_dst]) And
				.BYTES Geq .OPBYTES[.CURS[cel_code]] Then
			Begin
			DELETE(.CURS);
			Exitloop
			End;
		    If MAY_USE_ADDR(CURS[cel_dst],AREF) Then
			Return;
		    If MAY_USE_ADDR(AREF,CURS[cel_dst]) Then
			Return;
		    If .BYTES Lss .OPBYTES[.CURS[cel_code]] And
					MAY_REFER(CURS[cel_dst],AREF) Then
			Return;
		    DOWNDATE(CURS[cel_dst],AREF);
		    If MAY_REFER(CURS[cel_src],AREF) Then
			Return;
		    If MAY_USE_ADDR(CURS[cel_src],AREF) Then
			Return
		    DOWNDATE(CURS[cel_src],AREF)
		    End
	    Tes
	    End
	End
End;

!
! CALLED FROM DUPADR, OPT_ADDSUB. EITHER
! DELETE A CODE CELL, OR CHANGE IT
! TO A TST, OR DO NOTHING, DEPENDING
! ON THE ENSUING CONDITION CODE TESTING.
!
Routine DELTST(CURS : Ref CELL) =
Begin
    Local
	NZV		: Integer,
	C		: Boolean,
	A		: Boolean;

    NZV = TESTCC(.CURS,___VZN);
    C = TESTCC(.CURS,__C___);
    A = (.CURS[cel_class] Eql INST_ADD_IMMED);
    If .NZV Then
	If Not (.C And Not .A) Then
	    Begin
	    SETCHANGE;
	    CURS[cel_code] = (If .OPBYTES[.CURS[cel_code]] Eql 1
				Then PTSTB
				Else PTST);
	    REDUCEADR(.CURS);
	    Return .CURS
	    End;
    If Not .NZV Then
	If Not (.C And .A) Then
	    Return DELETE(.CURS);
    Return .CURS[cel_next]
End;

Routine DOWNDATE(A : Ref ADRVARSTR,B : Ref ADRVARSTR)  : Novalue =
Begin
    If .A[adr_reg] Eql .B[adr_reg] Then
	B[adr_disp] = .B[adr_disp] + .A[adr_delta]
End;

!
! THS ROUTINE PERFORMS WHATEVER ACTION IS NECESSARY
! WHEN IT IS DISCOVERED THAT THE SOURCE AND
! DESTINATION OPERANDS OF CURS ARE IDENTICAL.
!
Routine DUPADR(CURS : Ref CELL) =
Begin
    Local
	BYTES		: Integer;
    Bind
	DUPTYPE = Uplit Byte (0,0,1,1,0,0,2,2,0,0,3,2) : Vector[,Byte];

    If .CURS[cel_code] Eql PMOVB Then
	If .CURS[cel_dst_type] Eql ADDR_REG Then
	    Return NXTLCC(.CURS);
    BYTES = .OPBYTES[.CURS[cel_code]];
    Case .DUPTYPE[.CURS[cel_code]-PMOV] From 0 To 3 Of Set
	[0]:
	    CURS = DELTST(.CURS);		! MOV, BIT, BIS
	[1]:
	    If TESTEQL(.CURS) Then		! CMP
		Begin
		SETCHANGE;
		DELADR(CURS[cel_src],.CURS);
		DELADR(CURS[cel_dst],.CURS);
		CURS[cel_code] = SETEQLOP
		End
	    Else
		CURS = DELETE(.CURS);
	[2]:
	    Begin				! BIC, SUB
	    SETCHANGE;
	    CURS[cel_code] = (If .BYTES Eql 1 Then PCLRB Else PCLR);
	    REDUCEADR(.CURS)
	    End;
	[3]:
	    Begin				! ADD
	    SETCHANGE;
	    CURS[cel_code] = PASL;
	    REDUCEADR(.CURS)
	    End
    Tes;
    Return .CURS
End;

!
! IF ADDRESS C IN INSTRUCTION I
! IS EQUIVALENT TO THE LESS SIMPLE OF 
! A AND B, REPLAC4 IT BY THE MORE
! SIMPLE OF THE TWO.
!
Routine EQUIVADR(A : Ref ADRVARSTR,B : Ref ADRVARSTR,C : Ref ADRVARSTR,I : Ref CELL) =
Begin
    Local
	ASIMP		: Integer,
	BSIMP		: Integer;

    If .C[adr_delta] Neq 0 Then
	Return 0;
    ASIMP = ADRSIMP(.A);
    BSIMP = ADRSIMP(.B);
    If .ASIMP Eql 0 Or .BSIMP Eql 0 Or .ASIMP Eql .BSIMP Then
	Return 0;
    If .ASIMP Gtr .BSIMP Then
	SWAP(A,B);
    If Not IS_SAME_ADR(.B,.C) Then
	Return 0;
    DELADR(.C,.I);
    MAKEADR(.C,.A,.I);
    Return 1
End;

!
! SCAN FORWARD FROM IND, LOOKING FOR INSTANCES OF
! THE MORE COSTLY ONE OF IA AND IB, AND REPLACING
! THEM WITH THE CHEAPER 0NE.
!
! called by OPT_CLR and OPT_MOV

Routine EQUIVFWD(IND : Ref CELL,IA : Ref ADRVARSTR,IB : Ref ADRVARSTR,BYTES) : Novalue =
Begin
    Local
	CURS		: Ref CELL,
	A		: ADRVARSTR,
	B		: ADRVARSTR,
	T		: Integer;
    Label
	aaa;

    While TRUE Do
	Begin
	CURS = .IND;
	COPYADR(A,.IA);
	COPYADR(B,.IB);
	UPDATE(B,A);
	While TRUE Do
	    aaa: Begin
	    CURS = .CURS[cel_next];
	    If .CURS[cel_type] Neq CELL_CODE Then
		Return;
	    If .STOPFSCAN[.CURS[cel_code]] Then
		Return;
	    Selectone .OPERTYPE[.CURS[cel_code]] Of Set
		[OPTYPE_ONE]:
		    Begin
		    UPDATE(CURS[cel_src],A);
		    UPDATE(CURS[cel_src],B);
		    If .BYTES Eql 2 Then
			EQUIVIND(A,B,CURS[cel_src],.CURS);
		    If .ALTERSRCDST[.CURS[cel_code]] Then
			Begin
			If MAY_REFER(CURS[cel_src],A) Then
			    Return;
			If MAY_REFER(CURS[cel_src],B) Then
			    Return;
			If MAY_USE_ADDR(A,CURS[cel_src]) Then
			    Return;
			If MAY_USE_ADDR(B,CURS[cel_src]) Then
			    Return
			End
		    Else If .BYTES Geq .OPBYTES[.CURS[cel_code]] Then
			EQUIVADR(A,B,CURS[cel_src],.CURS);
		    If MAYPOP(CURS[cel_src],A) Or MAYPOP(CURS[cel_src],B) Then
			Return
		    End;
		[OPTYPE_TWO]:
		    Begin
		    If .flg_stack_addr And .CURS[cel_dst_type] Eql ADDR_REG And
					.CURS[cel_dst_reg] Eql SP And
					.CURS[cel_src_type] Eql ADDR_IMMED
					Then
			Begin
			If .CURS[cel_code] Eql PADD Then
			    T = .CURS[cel_src_disp]
			Else If .CURS[cel_code] Eql PSUB Then
			    T = -.CURS[cel_src_disp]
			Else
			    Leave aaa;
			If .T Gtr 0 Then
			    Begin
			    If .A[adr_type] Eql ADDR_INDIRECT Or .B[adr_type] Eql ADDR_INDIRECT Then
				Return;
			    If .A[adr_type] Eql ADDR_MEMORY And .A[adr_name] Leq 1 Then
				Begin
				If .A[adr_reg] Lss SP Then
				    Return;
				If .A[adr_reg] Eql SP And .A[adr_disp] Lss .T Then
				    Return
				End;
			    If .B[adr_type] Eql ADDR_MEMORY And .B[adr_name] Leq 1 Then
				Begin
				If .B[adr_reg] Lss SP Then
				    Return;
				If .B[adr_reg] Eql SP And .A[adr_disp] Lss .T Then
				    Return
				End
			    End
			End;
		    UPDATE(CURS[cel_src],A);
		    UPDATE(CURS[cel_src],B);
		    If .BYTES Geq .OPBYTES[.CURS[cel_code]] Then
			If Not EQUIVADR(A,B,CURS[cel_src],.CURS) Then
			    If .BYTES Eql 2 Then
				EQUIVIND(A,B,CURS[cel_src],.CURS);
		    T = (IS_SAME_ADR(A,CURS[cel_src]) Or
				IS_SAME_ADR(B,CURS[cel_src])) And
				.BYTES Geq .OPBYTES[.CURS[cel_code]];
		    UPDATE(CURS[cel_dst],A);
		    UPDATE(CURS[cel_dst],B);
		    If .T And (IS_SAME_ADR(A,CURS[cel_dst]) Or
				IS_SAME_ADR(B,CURS[cel_dst])) Then
			Begin
			DUPADR(.CURS);
			Return
			End;
		    If .BYTES Eql 2 Then
			EQUIVIND(A,B,CURS[cel_dst],.CURS);
		    If .ALTERSRCDST[.CURS[cel_code]] Then
			Begin
			If MAY_REFER(CURS[cel_dst],A) Or
					MAY_REFER(CURS[cel_dst],B) Or
					MAY_USE_ADDR(A,CURS[cel_dst]) Or
					MAY_USE_ADDR(B,CURS[cel_dst]) Then
			    Return
			End
		    Else If .BYTES Geq .OPBYTES[.CURS[cel_code]] Then
			EQUIVADR(A,B,CURS[cel_dst],.CURS);
		    If MAYPOP(CURS[cel_src],A) Or
				MAYPOP(CURS[cel_src],B) Or
				MAYPOP(CURS[cel_dst],A) Or
				MAYPOP(CURS[cel_dst],B) Then
			Return
		    End
	    Tes
	    End
	End
End;

!
! LIKE EQUIVADR, BUT C IS
! ONE LEVEL OF INDIRECTION ABOVE A AND B.
!
! called by EQUIVFWD

Routine EQUIVIND(A : Ref ADRVARSTR,B : Ref ADRVARSTR,C : Ref ADRVARSTR,I : Ref CELL) =
Begin
    Bind
	NEWFORM = Uplit Byte (
		GENREG+DEFERRED,
		INDEXED+DEFERRED,
		INDEXED+DEFERRED,
		0,
		INDEXED+DEFERRED,
		0,
		INDEXED+DEFERRED,
		0,0,0,
		AUTOINCR+DEFERRED,
		INDEXED+DEFERRED,
		0,0,
		INDEXED+DEFERRED,0) : Vector[,Byte];
    Local
	ASIMP,BSIMP;

    If .C[adr_delta] Neq 0 Or Not ONEOF(.C[adr_type],ADDR_MEMORY,ADDR_INDIRECT) Then
	Return 0;
    ASIMP = ADRSIMP(.A);
    BSIMP = ADRSIMP(.B);
    If .ASIMP Eql 0 Or .BSIMP Eql 0 Or .ASIMP Eql .BSIMP Then
	Return 0;
    If .ASIMP Gtr .BSIMP Then
	SWAP(A,B);
    If .A[adr_type] Eql ADDR_INDIRECT Then
	Return 0;
    If Not IS_SAME_IND(.B,.C) Then
	Return 0;
    If .swit_pic And .A[adr_reg] Eql PC And .A[adr_mode] Eql AUTOINCR+DEFERRED Then
	Return 0;
    MAKEADR(.C,.A,.I);
    C[adr_type] = (If .C[adr_type] Eql ADDR_MEMORY Then ADDR_INDIRECT Else ADDR_MEMORY);
    C[adr_mode] = .NEWFORM[.C[adr_mode] + (IF .C[adr_reg] Eql PC Then 8 Else 0)];
    Return 1
End;

Global Routine FINAL : Novalue =
Begin
    If Not .swit_peep Then
	Return;
    SETCHANGE;
    FINAL1();
    FINAL2();
    SETCHANGE;
    FINAL3()
End;

Routine FINAL1 : Novalue =
Begin
    Local
	CURS		: Ref CELL,
	COUNT,
	AREF		: ADRVARSTR;

    COUNT = 2;
    While (If .swit_quick Then (COUNT = .COUNT-1) Geq 0 Else .CHANGE) Do
	Begin
	CHANGE = 0;
	CURS = .BRAK1;
	Until .CURS Eql .BRAK2 Do
	    Begin
	    If .CURS[cel_type] Eql CELL_LABEL Then
		CURS = PLAB(.CURS)
	    Else If .CURS[cel_type] Neq CELL_CODE Then
		CURS = NXTLCC(.CURS)
	    Else If (If .OPERTYPE[.CURS[cel_code]] Eql OPTYPE_TWO Then
				Begin
				COPYADR(AREF,CURS[cel_src]);
				UPDATE(CURS[cel_dst],AREF);
				IS_SAME_ADR(CURS[cel_dst],AREF)
				End
	    		Else 0) Then
		CURS = DUPADR(.CURS)
	    Else
		CURS = Bliss(.OPTROUTINE[.CURS[cel_code]],.CURS)
	    End
	End
End;

Routine FINAL2 : Novalue =
Begin
    Label
	aaa,bbb;
    Local
	Q		: Ref ADRVARSTR,
	MINLOC		: Integer,
	CURS		: Ref CELL,
	VAL		: Ref CELL,
	LASTRTS		: Ref CELL;

    LASTRTS = 0;
    MINLOC = 0;
    CURS = .BRAK1;
    Until (CURS = NXTLCC(.CURS)) Eql .BRAK2 Do
	Begin
	CURS[cel_min_loc] = .MINLOC;
	If .CURS[cel_type] Eql CELL_CODE Then
	    Begin
	    If .CURS[cel_code] Eql INFLOOPOP Then
		COMBLAB(MAKEJMP(.CURS,.CURS))
	    Else If .CURS[cel_code] Eql SETEQLOP Then
		Begin
		CURS[cel_code] = PCMP;
		COPYADR(CURS[cel_src],PCADR);
		COPYADR(CURS[cel_dst],PCADR)
		End
	    Else If .CURS[cel_class] Eql INST_ADD_IMMED Then
		Begin
		CURS[cel_class] = UNUSED;
		VAL = (If .CURS[cel_code] Eql PSUB
				Then -.CURS[cel_src_disp]
				Else  .CURS[cel_src_disp]);
		If .CURS[cel_src_name] Eql 0 And Abs(.VAL) Eql 1 And
				Not TESTCC(.CURS,__C___) Then
		    Begin
		    CURS[cel_code] = (If .VAL Gtr 0 Then PINC Else PDEC);
		    REDUCEADR(.CURS)
		    End
		Else If .CURS[cel_src_name] Eql 0 And
				.CURS[cel_dst_type] Eql ADDR_REG And
				.CURS[cel_dst_reg] Eql SP And
				Not TESTCC(.CURS,__CVZN) Then
		    If Abs(.VAL) Eql 4 Then
			Begin
			CURS[cel_code] = PCMP;

! CMP (SP)+,(SP)+

			If .VAL Gtr 0 Then
			    Begin
			    CURS[cel_dst_delta] = 2;
			    CURS[cel_dst_disp] = -2;
			    CURS[cel_dst_mode] = AUTOINCR
			    End
			Else

! CMP -(SP),-(SP)

			    Begin
			    CURS[cel_dst_delta] = -2;
			    CURS[cel_dst_mode] = AUTODECR
			    End;
			CURS[cel_dst_type] = ADDR_MEMORY;
			COPYADR(CURS[cel_src],CURS[cel_dst])
			End
		    Else If Abs(.VAL) Eql 2 Then
			Begin
			CURS[cel_code] = PTST;

! TST (SP)+

			If .VAL Gtr 0 Then
			    Begin
			    CURS[cel_dst_delta] = 2;
			    CURS[cel_dst_disp] = -2;
			    CURS[cel_dst_mode] = AUTOINCR
			    End
			Else

! TST -(SP)

			    Begin
			    CURS[cel_dst_delta] = -2;
			    CURS[cel_dst_mode] = AUTODECR
			    End;
			CURS[cel_dst_type] = ADDR_MEMORY;
			COPYADR(CURS[cel_src],CURS[cel_dst])
			End
		End
	    Else If .CURS[cel_class] Eql INST_UNCOND_JUMP Then
		Begin
		If .swit_quick Then
		    CLEARTOLAB(.CURS);	! CLEAN UP AFTER CROSS-JUMPING
		If LABREFP(.CURS) Then
		    Begin
		    VAL = NXTCC(LABREFED(.CURS));
		    If .VAL[cel_code] Eql PRTS Or .VAL[cel_code] Eql PRTI Or
			(.VAL[cel_code] Eql PHALT And .VAL[cel_next] Eql .BRAK2) Then
			Begin
			CURS[cel_code] = .VAL[cel_code];
			CURS[cel_class] = INST_NORMAL;
			COPYADR(CURS[cel_src],VAL[cel_src]);
			If .VAL[cel_next] Eql .BRAK2 Then
			    LASTRTS = .CURS
			End
		    End
		End;

! look for OP @reg,@0(reg) (or the like) and change to OP (reg)+,@-(reg)

	    If .OPERTYPE[.CURS[cel_code]] Eql OPTYPE_TWO Then
		Begin
		aaa: Begin
		If .CURS[cel_src_reg] Neq .CURS[cel_dst_reg] Then
		    Leave aaa;
		If .CURS[cel_src_reg] Eql PC Then
		    Leave aaa;
		If .CURS[cel_src_reg] Neq SP And .OPBYTES[.CURS[cel_code]] Neq 2 Then
		    Leave aaa;
		If .CURS[cel_src_disp] Neq 0 Or .CURS[cel_dst_disp] Neq 0 Then
		    Leave aaa;
		If .CURS[cel_src_name] Gtr 1 Or .CURS[cel_dst_name] Gtr 1 Then
		    Leave aaa;
		Q = CURS[cel_src];
		If .Q[adr_type] Neq ADDR_INDIRECT And .Q[adr_type] Neq ADDR_MEMORY Then
		    Leave aaa;
		Q = CURS[cel_dst];
		If .Q[adr_type] Neq ADDR_INDIRECT And .Q[adr_type] Neq ADDR_MEMORY Then
		    Leave aaa;
		If .CURS[cel_src_delta] Neq 0 Or .CURS[cel_dst_delta] Neq 0 Then
		    Leave aaa;
		CURS[cel_src_delta] = 2;
		CURS[cel_src_disp] = -2;
		CURS[cel_src_mode] = (If .CURS[cel_src_type] Eql ADDR_MEMORY Then 2 Else 3);
		CURS[cel_dst_delta] = -2;
		CURS[cel_dst_mode] = (If .CURS[cel_dst_type] Eql ADDR_MEMORY Then 4 Else 5)
		End;

! look for OP #N,N(reg) and change #n to @PC

		ADRLEN(CURS[cel_dst]);
		bbb: Begin
		If .CURS[cel_src_type] Neq ADDR_IMMED Then
		    Leave bbb;
		If (.CURS[cel_dst_mode] And 6) Neq INDEXED Then
		    If .CURS[cel_dst_reg] Neq PC Or .CURS[cel_dst_mode] Neq AUTOINCR+DEFERRED Then
			Leave bbb;
		If .CURS[cel_src_disp] Neq .CURS[cel_dst_disp] Then
		    Leave bbb;
		If .CURS[cel_dst_name] Eql .CURS[cel_src_name] Or
			(.CURS[cel_src_name] Eql 0 And .CURS[cel_dst_name] Eql 1) Then
		    CURS[cel_src_mode] = 1;
		End
		End;
	    CURS[cel_min_len] = CELLLENGTH(.CURS);
	    MINLOC = .MINLOC + .CURS[cel_min_len]
	    End
	End;
    CURS = .BRAK2[cel_prev];
    If .LASTRTS Neq 0 Then
	Begin
	VAL = PRVCC(.CURS);
	If .VAL[cel_class] Eql INST_UNCOND_JUMP Then
	    Begin
	    VAL = BEFORE(.LASTRTS,DETACH(.CURS[cel_prev]));
	    VAL[cel_min_loc] = .LASTRTS[cel_min_loc];
	    ERASE(.CURS)
	    End
	End
End;

Routine FINAL3 : Novalue =
Begin
    Local
	CURS		: Ref CELL,
	VAL		: Ref CELL,
	NEXT		: Ref CELL,
	LAB		: Ref CELL,
	MINLOC		: Integer;
    Label
	aaa;

    While .CHANGE Do
	Begin
	CHANGE = 0;
	MINLOC = 0;
	CURS = .BRAK1;
	Until (CURS = NXTLCC(.CURS)) Eql .BRAK2 Do
	    aaa: Begin
	    CURS[cel_min_loc] = .MINLOC;
	    If .CURS[cel_type] Eql CELL_LABEL Then
		Leave aaa;
	    If .CURS[cel_class] Eql INST_COND_JUMP Or .CURS[cel_class] Eql INST_UNCOND_JUMP Then
		If LABREFP(.CURS) Then
		    If REACH(.CURS) Eql 0 Then     !JMP NECESSARY
			Begin
			SETCHANGE;
			NEXT = NXTCC(LABREFED(.CURS));
			If .CURS[cel_class] Eql INST_COND_JUMP Then
			    Begin
			    VAL = NEWCODECELL();
			    BEFORE(.CURS,.VAL);
			    COMBLAB(MAKEJMP(.VAL,NXTCC(.CURS)));
			    VAL[cel_code] = REVCOND(.CURS[cel_code]);
			    VAL[cel_min_len] = 1;
			    VAL[cel_min_loc] = .MINLOC;
			    MINLOC = .MINLOC + .VAL[cel_min_len];
			    VAL[cel_class] = INST_NORMAL;
			    VAL = .CURS[cel_src_name];
			    VAL[cel_class] = INST_UNCOND_JUMP
			    End;
			If .NEXT[cel_code] Eql PJMP Then
			    COPYADR(CURS[cel_src],NEXT[cel_src]);
			CURS[cel_class] = INST_NORMAL;
			CURS[cel_code] = PJMP;
			CURS[cel_min_len] = 2;
			CURS[cel_min_loc] = .MINLOC
			End;
	    MINLOC = .MINLOC + .CURS[cel_min_len]
	    End     !SCAN LOOP
	End;     !CHANGE LOOP
    FINRTNSIZE = .MINLOC;
    CODESIZE = .CODESIZE+.MINLOC;
    If .MINLOC Leq 127 Then
	Return;
    CURS = .BRAK1;
    Until (CURS = NXTCC(.CURS)) Eql .BRAK2 Do
	If .CURS[cel_class] Eql INST_COND_JUMP Or .CURS[cel_class] Eql INST_UNCOND_JUMP Then
	    If LABREFP(.CURS) Then
		Begin
		LAB = LABREFED(.CURS);
		VAL = REACH(.CURS);
		If .LAB Neq .VAL Then
		    Begin
		    LAB = COMBLAB(BEFORE(.VAL,NEWLAB()));
		    LAB[cel_min_loc] = .VAL[cel_min_loc];
		    MAKELABREF(.CURS,.LAB);
		    End
		End
End;

Routine FIXJMPIND(IND : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL,
	LAB		: Ref CELL,
	IL		: Boolean;

    If .IND[cel_code] Eql INFLOOPOP Then
	Return TRUE;
    If Not LABREFP(.IND) Then
	Return FALSE;
    LAB = LABREFED(.IND);
    If .LAB[cel_lab_seen] Then
	Begin
	MAKEINFLOOP(.IND);
	Return TRUE
	End;
    NEXT = NXTCC(.LAB);
    If .NEXT[cel_class] Neq INST_UNCOND_JUMP Then
	Return FALSE;

!EXTRA LEVELS OF INDIRECTION.  MUST RECUR

    LAB[cel_lab_seen] = TRUE;
    IL = FIXJMPIND(.NEXT);
    LAB[cel_lab_seen] = FALSE;

! branch to branch stuff

    If Not .IL Then
	Begin
	If Not LABREFP(.NEXT) Then
	    If .IND[cel_code] Eql PCASE Or ADRLEN(NEXT[cel_src]) Neq 0 Then
		Return FALSE;
	DELADR(IND[cel_src],.IND);
	MAKEADR(IND[cel_src],NEXT[cel_src],.IND);
	SETCHANGE;
	Return FALSE
	End
    Else If .IND[cel_class] Eql INST_UNCOND_JUMP Then
	Begin
	MAKEINFLOOP(.IND);
	Return TRUE
	End
    Else
	Return FALSE
End;

Routine LABREFED(IND : Ref CELL) =
Begin
    Return COMBLAB(.Block[.IND[cel_src_name],cel_ref_ef;0,Quad])
End;

Routine LABREFP(I : Ref CELL) =
Begin
    If ONEOF(.OPERTYPE[.I[cel_code]],OPTYPE_BR,OPTYPE_CASE) Then
	Return .I[cel_src_name_type] Eql NAME_LABEL
    Else
	Return FALSE
End;

!
! REPLACE ADDRESS A IN INSTRUCTION IND BY B.
!
Routine MAKEADR(A : Ref ADRVARSTR,B : Ref ADRVARSTR,IND : Ref CELL) : Novalue =
Begin
    Local
	AREF		: Ref CELL;

    COPYADR(.A,.B);
    If .IND[cel_code] Eql PADD Or .IND[cel_code] Eql PSUB Then
	If .A Eql IND[cel_src] Then
	    If .A[adr_type] Eql ADDR_IMMED Then
		IND[cel_class] = INST_ADD_IMMED;
    If .A[adr_delta] Neq 0 Then
	Begin
	A[adr_delta] = 0;
	A[adr_mode] = (If .A[adr_type] Eql ADDR_INDIRECT
			Then INDEXED+DEFERRED
			Else If .A[adr_disp] Eql 0
			Then GENREG+DEFERRED
			Else INDEXED)
	End;
    If .A[adr_name_type] Eql NAME_LABEL Then
	Begin
	AREF = A[adr_name] = GETCELL(CELL_REF,SZ_CELL_REF);
	AREF[cel_class] = .IND[cel_class];
	AREF[cel_ref_rf] = .IND;
	PUSHBOT(AREF[cel_ref_ef] = .ST[.B[adr_name],cel_ref_ef],.AREF)
	End
End;

! called by FIXJMPIND

Routine MAKEINFLOOP(I : Ref CELL) : Novalue =
Begin
    If .I[cel_code] Eql INFLOOPOP Then
	Return;
    SETCHANGE;
    DELADR(I[cel_src],.I);
    I[cel_code] = INFLOOPOP
End;

Routine MAKEJMP(F : Ref CELL,T : Ref CELL) =
Begin
    Local
	LAB		: Ref CELL;

    LAB = NEWLAB();
    BEFORE(.T,.LAB);
    LAB[cel_min_loc] = .T[cel_min_loc];
    F[cel_class] = INST_UNCOND_JUMP;
    F[cel_code]  = PBR;
    MAKELABREF(.F,.LAB);
    Return .LAB
End;

Routine MAKELABREF(IND : Ref CELL,LAB : Ref CELL) =
Begin
    Local
	AREF		: Ref CELL;

    COPYADR(IND[cel_src],MEMADR);
    AREF = IND[cel_src_name] = GETCELL(CELL_REF,SZ_CELL_REF);
    AREF[cel_class]  = .IND[cel_class];
    AREF[cel_ref_ef] = .LAB;
    AREF[cel_ref_rf] = .IND;
    PUSHBOT(.LAB,.AREF)
End;

!
! TRUE IF A MAY POP B OFF STACK.
!
Routine MAYPOP(A : Ref ADRVARSTR,B : Ref ADRVARSTR) =
Begin
    If Not .swit_final And .A[adr_delta] Neq 0 Then
	Return .B[adr_type] Neq ADDR_INDIRECT And .B[adr_type] Neq ADDR_MEMORY
    Else If Not .flg_stack_addr Or .A[adr_delta] Leq 0 Or .A[adr_reg] Neq SP Then
	Return FALSE
    Else If .B[adr_type] Eql ADDR_INDIRECT Then
	Return TRUE
    Else If .B[adr_type] Neq ADDR_MEMORY Then
	Return FALSE
    Else If .B[adr_name] Gtr 1 Or .B[adr_reg] Eql PC Then
	Return FALSE
    Else If .B[adr_reg] Eql SP Then
	Return .A[adr_disp] Lss 0
    Else
	Return TRUE
End;

!
! TRUE IF ADDRESS A MAY REFER TO ADDRESS B
!

Routine MAY_REFER(A : Ref ADRVARSTR,B : Ref ADRVARSTR) =
Begin

! minimize number of cases to check

    If .A[adr_type] Gtr .B[adr_type] Then
	SWAP(A,B);
    Case .A[adr_type] From LO_ADDR_TYPE To HI_ADDR_TYPE Of Set

! immediates never conflict

	[ADDR_IMMED]:
	    Return FALSE;

! a register may only be affected by another register

	[ADDR_REG]:
	    If .B[adr_type] Eql ADDR_REG Then
		Return .A[adr_reg] Eql .B[adr_reg]
	    Else
		Return FALSE;

! for indirection, 'A' does not refer to 'B' if 'B' is a stack location
! note that 'B' may be only ADDR_MEMORY or ADDR_INDIRECT due to the
! swap above.

	[ADDR_INDIRECT]:
	    Begin
	    If Not .swit_final Then
		Return TRUE;
	    If .flg_stack_addr Then
		Return TRUE;
	    If .B[adr_type] Neq ADDR_MEMORY Then
		Return TRUE;
	    If .B[adr_name] Neq 1 Then
		Return TRUE;
	    Return FALSE
	    End;

! note: 'B' may only be ADDR_MEMORY due to the swap above.

	[ADDR_MEMORY]:
	    Begin
	    If Not .swit_final Then
		Return TRUE;

! if the registers differ then they are different addresses if
! different named segments are used.

	    If .A[adr_reg] Neq .B[adr_reg] Then
		Begin
		If .A[adr_name] Eql 0 Then
		    Return TRUE;
		If .B[adr_name] Eql 0 Then
		    Return TRUE;
		If .A[adr_name] Eql .B[adr_name] Then
		    Return TRUE
		End
	    Else

! if the registers are the same then they are different if different
! named segments are used or the displacement is large enough.

		Begin
		If .A[adr_name] Eql .B[adr_name] And
			Abs(.A[adr_disp]-.B[adr_disp]) Lss 2 Then
		    Return TRUE
		End;
	    Return FALSE
	    End
    Tes
End;

!
! TRUE IF ADDRESS 'A' MAY USE ADDRESS 'B'.
!

Routine MAY_USE_ADDR(A : Ref ADRVARSTR,B : Ref ADRVARSTR) =
Begin
    Local
	T		: ADRVARSTR;

    Case .A[adr_type] From LO_ADDR_TYPE To HI_ADDR_TYPE Of Set
	[ADDR_IMMED]:
	    Return FALSE;
	[ADDR_REG]:
	    Return FALSE;
	[ADDR_INDIRECT]:
	    Begin
	    If Not .swit_final Then
		Return .B[adr_type] Neq ADDR_IMMED;

! if 'B' is a register, 'A' is affected if the register is the
! index register used in 'A'

	    If .B[adr_type] Eql ADDR_REG Then
		Return .A[adr_reg] Eql .B[adr_reg];

! see if 'B' may be the same location as the indirect location

	    COPYADR(T,.A);
	    T[adr_type] = ADDR_MEMORY;
	    Return MAY_REFER(T,.B)
	    End;
	[ADDR_MEMORY]:
	    If Not .swit_final Then
		Return .B[adr_type] Neq ADDR_IMMED

! if 'B' is a register, 'A' is affected if the register is the
! index register used in 'A'

	    Else If .B[adr_type] Eql ADDR_REG Then
		Return .A[adr_reg] Eql .B[adr_reg]
	    Else
		Return FALSE
    Tes
End;

Routine MOVEJMP(F : Ref CELL,T : Ref CELL) =
Begin
    Local
	Q		: Ref CELL,
	LAB		: Ref CELL;

    If .T[cel_type] Neq CELL_LABEL Then
	Begin
	Q = .T[cel_prev];
	If .Q[cel_type] Eql CELL_LABEL Then
	    T = .Q
	Else
	    Begin
	    LAB = NEWLAB();
	    BEFORE(.T,.LAB);
	    LAB[cel_min_loc] = .T[cel_min_loc];
	    T = .LAB;
	    End
	End;
    Return MVLABREF(.F[cel_src_name],.T)
End;

Routine MVLABREF(IND : Ref CELL,LAB : Ref CELL) =
Begin
    Local
	VAL		: Ref CELL;

    VAL = .IND[cel_next];
    SETCHANGE;
    IND[cel_ref_ef] = .LAB;
    PUSHBOT(.LAB,DETACH(.IND));
    Return .VAL
End;

Routine OPT_ADDSUB(I : Ref CELL) =
Begin
    Local
	PPFLAG,
	CURS		: Ref CELL,
	DST1		: ADRVARSTR;

! only optimize instructions of the form 'op #n,X'

    If .I[cel_class] Neq INST_ADD_IMMED Then
	Return .I[cel_next];

! 'ADD #0,' -> NOP

    If .I[cel_src_name] Eql 0 Then
	If .I[cel_src_disp] Eql 0 Then
	    Return DELTST(.I)

! change add(sub) #-n,X to sub(add) #n,X

	Else If .I[cel_src_disp] Lss 0 Then
	    Begin
	    I[cel_code] = (If .I[cel_code] Eql PSUB Then PADD Else PSUB);
	    I[cel_src_disp] = Abs(.I[cel_src_disp])
	    End;
    If .swit_quick Then
	Return .I[cel_next];

! with indirect, we cannot know what is in the indirect word and
! so cannot optimize it.

    If .I[cel_dst_type] Eql ADDR_INDIRECT Then
	Return .I[cel_next];
    If .I[cel_dst_type] Eql ADDR_REG Then
	Begin
	CURS = .I;
	PPFLAG = (If .I[cel_src_name] Neq 0
			Then %o'177776'
			Else If .I[cel_code] Eql PADD
			Then  .I[cel_src_disp]
			Else -.I[cel_src_disp]);
	PUSHPOPFLAG = .PPFLAG;

! perform a backward scan for other references to this register
! which can be optimized

	While TRUE Do
	    Begin
	    CURS = .CURS[cel_prev];
	    If .CURS[cel_type] Neq CELL_CODE Then
		Exitloop;
	    If .STOPFSCAN[.CURS[cel_code]] Or .STOPBSCAN[.CURS[cel_code]] Then
		Exitloop;
	    Selectone .OPERTYPE[.CURS[cel_code]] Of Set
		[OPTYPE_ONE]:
		    If TESTPOP(CURS[cel_src],.I,.CURS) Then
			Exitloop;
		[OPTYPE_TWO]:
		    If TESTPOP(CURS[cel_dst],.I,.CURS) Then
			Exitloop
		    Else If TESTPOP(CURS[cel_src],.I,.CURS) Then
			Exitloop
	    Tes
	    End;

! delete the instruction if the optimization got rid of all the
! immediate value

	If .I[cel_src_disp] Eql 0 And .I[cel_src_name] Eql 0 Then
	    Return DELTST(.I);

! now do a forward scan looking for references to this register
! which may be optimized

	CURS = .I;
	PUSHPOPFLAG = -.PPFLAG;
	While 1 Do
	    Begin
	    CURS = .CURS[cel_next];
	    If .CURS[cel_type] Neq CELL_CODE Then
		Exitloop;
	    If .STOPFSCAN[.CURS[cel_code]] Or .STOPBSCAN[.CURS[cel_code]] Then
		Exitloop;
	    Selectone .OPERTYPE[.CURS[cel_code]] Of Set
		[OPTYPE_ONE]:
		    If TESTPUSH(CURS[cel_src],.I,.CURS) Then
			Exitloop;
		[OPTYPE_TWO]:
		    If TESTPUSH(CURS[cel_src],.I,.CURS) Then
			Exitloop
		    Else If TESTPUSH(CURS[cel_dst],.I,.CURS) Then
			Exitloop
	    Tes
	    End;

! again, delete this cell if optimization got rid of the immediate
! value (saves another final pass).

	If .I[cel_src_disp] Eql 0 And .I[cel_src_name] Eql 0 Then
	    Return DELTST(.I)
	End;
    CURS = .I;
    COPYADR(DST1,I[cel_dst]);
!
! SCAN FORWARD FROM I, COMBINING ADDS(SUBS) OF LITERALS TO I'S DST
! WITH I ITSELF.
!
    While TRUE Do
	Begin
	CURS = .CURS[cel_next];
	If .CURS[cel_type] Neq CELL_CODE Then
	    Exitloop;
	If .STOPFSCAN[.CURS[cel_code]] Or .STOPBSCAN[.CURS[cel_code]] Then
	    Exitloop;
	Selectone .OPERTYPE[.CURS[cel_code]] Of Set
	    [OPTYPE_ONE]:
		Begin
		UPDATE(CURS[cel_src],DST1);
		If MAY_USE_ADDR(CURS[cel_src],DST1) Then
		    Exitloop;
		If MAY_REFER(CURS[cel_src],DST1) Then
		    Exitloop;
		If MAY_USE_ADDR(DST1,CURS[cel_src]) And
				.ALTERSRCDST[.CURS[cel_code]] Then
		    Exitloop
		End;
	    [OPTYPE_TWO]:
		Begin
		UPDATE(CURS[cel_src],DST1);
		If MAY_USE_ADDR(CURS[cel_src],DST1) Then
		    Exitloop;
		If MAY_REFER(CURS[cel_src],DST1) Then
		    Exitloop;
		UPDATE(CURS[cel_dst],DST1);
		If .CURS[cel_class] Eql INST_ADD_IMMED And
				IS_SAME_ADR(DST1,CURS[cel_dst]) Then
		    Begin
		    If .I[cel_src_name] Neq 0 Then
			Begin
			If .CURS[cel_src_name] Neq 0 Then
			    Exitloop;
			If .CURS[cel_code] Neq .I[cel_code] Then
			    Exitloop
			End;
		    CURS[cel_src_name] = .CURS[cel_src_name]+.I[cel_src_name];
		    CURS[cel_src_disp] = .CURS[cel_src_disp] +
				(If .I[cel_code] Eql .CURS[cel_code]
						Then  .I[cel_src_disp]
						Else -.I[cel_src_disp]);
		    Return DELETE(.I)
		    End
		Else
		    Begin
		    If MAY_USE_ADDR(CURS[cel_dst],DST1) Then
			Exitloop;
		    If MAY_REFER(CURS[cel_dst],DST1) Then
			Exitloop;
		    If MAY_USE_ADDR(DST1,CURS[cel_dst]) And
				.ALTERSRCDST[.CURS[cel_code]] Then
			Exitloop
		    End
		End
	Tes
	End;
    Return .I[cel_next]
End;

Routine OPT_BIC(I : Ref CELL) =
Begin
    Return OPT_BOOLEAN(.I,PBIC,PBICB,PBIS,PBISB)
End;

Routine OPT_BIS(I : Ref CELL) =
Begin
    Return OPT_BOOLEAN(.I,PBIS,PBISB,PBIC,PBICB)
End;

Routine OPT_BIT(I : Ref CELL) =
Begin
    If TESTCC(.I,___VZN) Then
	Return .I[cel_next]
    Else
	Return DELETE(.I)
End;

Routine OPT_BOOLEAN(I : Ref CELL,PBOOL,PBOOLB,XBOOL,XBOOLB) =
Begin
    Local
	FWDF		: Boolean,
	BACKF		: Boolean,
	FWDMASK		: Integer,
	BACKMASK	: Integer,
	CURS		: Ref CELL,
	ADR		: ADRVARSTR;
    Label
	aaa;

    If .swit_quick Then
	Return(.I[cel_next]);
    If .I[cel_src_type] Neq ADDR_IMMED Then
	Return .I[cel_next];
    If .I[cel_src_name] Neq 0 Then
	Return .I[cel_next];
    If .I[cel_dst_type] Eql ADDR_INDIRECT Then
	Return .I[cel_next];
!
! SCAN FORWARD FROM I, USING LOCAL CURS,
! TRYING EITHER TO DELETE I, DELETE CURS,
! OR CHANGE CURS TO A MOV(B).  DURING
! THIS FORWARD SCAN THE FOLLOWING INFORMATION
! IS KEPT AROUND:
!
!	FWDF,BACKF - FWDF IS SET IF A LABEL IS SEEN, BACKF
!		     IS SET IF A CONDITIONAL BRANCH IS SEEN
!		     OR I'S DST IS USED.  IF SOMETHING ELSE
!		     HAPPENS, SUCH AS AN UNCONDITIONAL BRANCH
!		     BEING SEEN, THEY ARE BOTH SET; ANY TIME
!		     THEY ARE BOTH SET, THE SCAN IS ENDED.
!	FWDMASK - A MASK OF THE BITS AFFECTED BY "PBOOL(B)" (AND
!		  NOT BY "XBOOL(B)") BETWEEN I AND CURS.
!		  ONLY VALID UNTIL FWDF IS SET.
!	BACKMASK - A MASK OF THE BITS AFFECTED BY "PBOOL(B)" (AND
!		   NOT BY "XBOOL(B)") BETWEEN I AND WHENEVER FWDF
!		   WAS SET, BUT NOT AFFECTED SINCE THEN.
!		   NOT VALID AFTER BACKF IS SET.
!
    FWDF = FALSE;
    BACKF = FALSE;
    If .I[cel_code] Eql .PBOOLB Then
	I[cel_src_disp] = .I[cel_src_disp] And 255;
    If .I[cel_src_disp] Eql 0 Then
	Return DELETE(.I);
    FWDMASK = BACKMASK = .I[cel_src_disp];
    COPYADR(ADR,I[cel_dst]);
    CURS = .I;
    While TRUE Do
	aaa: Begin
	CURS = .CURS[cel_next];
	If .CURS[cel_type] Neq CELL_CODE Then
	    Begin
	    If .BACKF Then
		Exitloop;
	    FWDF = TRUE;
	    Leave aaa
	    End;
	If .STOPFSCAN[.CURS[cel_code]] Then
	    FWDF = TRUE;
	If .STOPBSCAN[.CURS[cel_code]] Then
	    BACKF = TRUE;
	If .BACKF And .FWDF Then
	    Exitloop;
	If .OPERTYPE[.CURS[cel_code]] Eql OPTYPE_ONE Then
	    Begin
	    UPDATE(CURS[cel_src],ADR);
	    If .ALTERSRCDST[.CURS[cel_code]] Then
		Begin
		If MAY_REFER(CURS[cel_src],ADR) Then
		    Exitloop;
		If MAY_USE_ADDR(ADR,CURS[cel_src]) Then
		    Exitloop
		End
	    Else If MAY_REFER(CURS[cel_src],ADR) Then
		BACKF = TRUE;
	    If MAY_USE_ADDR(CURS[cel_src],ADR) Then
		BACKF = TRUE;
	    Leave aaa
	    End;
	If .OPERTYPE[.CURS[cel_code]] Neq OPTYPE_TWO Then
	    Leave aaa;
	    Begin
	UPDATE(CURS[cel_src],ADR);
	If MAY_REFER(CURS[cel_src],ADR) Then
	    BACKF = TRUE;
	If MAY_USE_ADDR(CURS[cel_src],ADR) Then
	    BACKF = TRUE;
	UPDATE(CURS[cel_dst],ADR);
	If .CURS[cel_src_type] Eql ADDR_IMMED And .CURS[cel_src_name] Eql 0 And
				IS_SAME_ADR(CURS[cel_dst],ADR) Then
	    If .CURS[cel_code] Eql .PBOOL Or .CURS[cel_code] Eql .PBOOLB Then
		Begin
		If .CURS[cel_code] Eql .PBOOLB Then
		    CURS[cel_src_disp] = .CURS[cel_src_disp] And 255;
		If .FWDF Then
		    Begin
		    BACKMASK = .BACKMASK And Not .CURS[cel_src_disp];
		    If .BACKMASK Eql 0 Then
			Return DELETE(.I);
		    Leave aaa
		    End
		Else If .BACKF Then
		    If (Not .FWDMASK And .CURS[cel_src_disp]) Eql 0 Then
			Begin
			DELETE(.CURS);
			Return .I
			End
		    Else
			Begin
			FWDMASK = .FWDMASK Or .CURS[cel_src_disp];
			Leave aaa
			End
		Else
		    Begin
		    CURS[cel_src_disp] = .CURS[cel_src_disp] Or .FWDMASK;
		    If .I[cel_code] Eql .PBOOL Then
			CURS[cel_code] = .PBOOL;
		    Return DELETE(.I)
		    End
		End
	    Else If .CURS[cel_code] Eql .XBOOL Or .CURS[cel_code] Eql .XBOOLB Then
		Begin
		If .CURS[cel_code] Eql .XBOOLB Then
		    CURS[cel_src_disp] = .CURS[cel_src_disp] And 255;
		If Not .BACKF Then
		    If (BACKMASK = .BACKMASK And Not .CURS[cel_src_disp]) Eql 0 Then
			Return DELETE(.I);
		If Not .FWDF Then
		    If ((.FWDMASK Or .CURS[cel_src_disp]) And %x'ffff') Eql %x'ffff'
				Or (.I[cel_code] Eql .PBOOLB And
				.CURS[cel_code] Eql .XBOOLB And
				((.FWDMASK Or .CURS[cel_src_disp]) And 255) Eql 255) Then
			Begin
			If .I[cel_code] Eql .PBOOLB And .CURS[cel_code] Eql .XBOOLB Then
			    CURS[cel_code] = PMOVB
			Else
			    CURS[cel_code] = PMOV;
			If .I[cel_code] Eql PBIS Or .I[cel_code] Eql PBISB Then
			    CURS[cel_src_disp] = Not .CURS[cel_src_disp];
			SETCHANGE;
			If Not .BACKF Then
			    Return DELETE(.I)
			Else
			    Return .I[cel_next]
			End;
		FWDMASK = .FWDMASK And Not .CURS[cel_src_disp];
		Leave aaa
		End;
	If .ALTERSRCDST[.CURS[cel_code]] Then
	    Begin
	    If MAY_REFER(CURS[cel_dst],ADR) Or MAY_USE_ADDR(ADR,CURS[cel_dst]) Then
		Exitloop
	    End
	Else If MAY_REFER(CURS[cel_dst],ADR) Then
	    BACKF = TRUE;
	If MAY_USE_ADDR(CURS[cel_dst],ADR) Then
	    BACKF = TRUE
	End
	End;
    Return(.I[cel_next])
End;

Routine OPT_CLC(I : Ref CELL) =
Begin
    If TESTCC(.I,__C___) Then
	Return .I[cel_next]
    Else
	Return DELETE(.I)
End;

Routine OPT_CLR(CURS : Ref CELL) =
Begin
    Local
	Q		: Ref ADRVARSTR,
	BYTES		: Integer;

    BYTES = .OPBYTES[.CURS[cel_code]];
    Q = CURS[cel_src];
    If .Q[adr_type] Eql ADDR_REG Or .Q[adr_type] Eql ADDR_MEMORY Then
	Begin
	EQUIVFWD(.CURS,CURS[cel_src],IMMEDZERO,.BYTES);
	DELBACKREF(.CURS,CURS[cel_src],.BYTES)
	End;
    Return NXTLCC(.CURS)
End;

Routine OPT_CLVC(I : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL;

    NEXT = .I[cel_next];
    If .NEXT[cel_type] Eql CELL_CODE Then
	If .NEXT[cel_code] Eql PBGE Then
	    NEXT[cel_code] = PBPL
	Else If .NEXT[cel_code] Eql PBLT Then
	    NEXT[cel_code] = PBMI;
    If TESTCC(.I,__CV__) Then
	Return .I[cel_next]
    Else
	Return DELETE(.I)
End;

Routine OPT_CMP(CURS : Ref CELL) =
Begin
    Local
	PREV		: Ref CELL,
	CURS1		: Ref CELL,
	PREV1		: Ref CELL,
	LABCURS		: Ref CELL,
	CMPSRC		: ADRVARSTR;

    If Not TESTCC(.CURS,__CVZN) Then
	Return DELETE(.CURS);

! try to change CMP(B) to TST(B)

    If .CURS[cel_dst_type] Eql ADDR_IMMED Then
	Begin
	If .CURS[cel_code] Eql PCMPB Then
	    CURS[cel_dst_disp] = .CURS[cel_dst_disp] And 255;
	If .CURS[cel_dst_name] Eql 0 And .CURS[cel_dst_disp] Eql 0 Then
	    Begin
	    CURS[cel_code] = (If .CURS[cel_code] Eql PCMPB
				Then PTSTB
				Else PTST);
	    SETCHANGE;
	    Return OPT_TST(.CURS)
	    End
	End;
    PREV = PREVNONBR(.CURS);
    If .PREV[cel_type] Eql CELL_CODE Then
	If IS_SAME_CMP(.PREV,.CURS) Then
	    Return DELETE(.CURS)
	Else
	    Return .CURS[cel_next];
    If .PREV Neq .CURS[cel_prev] Then
	Return .CURS[cel_next];
    LABCURS = .PREV[cel_top];
    Until .LABCURS Eql .PREV Do
	Begin
	CURS1 = .LABCURS[cel_ref_rf];
	LABCURS = .LABCURS[cel_next];

! cause some branches to a compare to branch to the next statement

	If .CURS1[cel_class] Eql INST_COND_JUMP Or .CURS1[cel_class] Eql INST_UNCOND_JUMP Then
	    Begin
	    PREV1 = PREVNONBR(.CURS1);
	    If .PREV1[cel_type] Eql CELL_CODE And .PREV1 Neq .CURS Then
		If IS_SAME_CMP(.PREV1,.CURS) Then
		    MOVEJMP(.CURS1,.CURS[cel_next])
	    End
	End;
    Return .CURS[cel_next]
End;

Routine OPT_DEC(CURS : Ref CELL) =
Begin

! change DEC instructions to SUB instructions.  we can't do this
! optimization if the C-bit from a previous instruction is needed
! in a later instruction.

    If TESTCC(.CURS,__C___) Then
	Return .CURS[cel_next];

! change 'DEC x' to 'SUB #1,x'

    SETCHANGE;
    COPYADR(CURS[cel_dst],CURS[cel_src]);
    COPYADR(CURS[cel_src],IMMEDONE);
    CURS[cel_code]  = PSUB;
    CURS[cel_class] = INST_ADD_IMMED;
    Return OPT_ADDSUB(.CURS)
End;

Routine OPT_INC(CURS : Ref CELL) =
Begin

! same as DEC above except we change 'INC x' to 'ADD #1,x'

    If TESTCC(.CURS,__C___) Then
	Return .CURS[cel_next];
    SETCHANGE;
    COPYADR(CURS[cel_dst],CURS[cel_src]);
    COPYADR(CURS[cel_src],IMMEDONE);
    CURS[cel_code]  = PADD;
    CURS[cel_class] = INST_ADD_IMMED;
    Return OPT_ADDSUB(.CURS)
End;

Routine OPT_JSR(CURS : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL;

! examine the next instruction.  if this is a 'JSR PC,x' and the
! next instruction is a 'RTS PC' then change the JSR to a JMP

    NEXT = NXTCC(.CURS);
    If .NEXT[cel_class] Eql INST_UNCOND_JUMP Then
	If LABREFP(.NEXT) Then
	    NEXT = NXTCC(LABREFED(.NEXT));
    If .NEXT[cel_code] Eql PRTS And
		.NEXT[cel_src_reg] Eql PC And
		.CURS[cel_src_reg] Eql PC Then
	Begin
	SETCHANGE;
	CURS[cel_code]  = PBR;
	CURS[cel_class] = INST_UNCOND_JUMP;

! if a tail-recursion call then just jump to the first cell
! otherwise just jump to the destination

	If .CURS[cel_dst_name_type] Eql NAME_NORMAL And
				.CURS[cel_dst_name] Eql .CURROUT And
				.CURS[cel_src_disp] Eql 0 Then
	    MAKEJMP(.CURS,.BRAK1[cel_next])
	Else
	    COPYADR(CURS[cel_src],CURS[cel_dst]);
	Return PUNCONDJMP(.CURS)
	End;
    Return .CURS[cel_next]
End;

Routine OPT_MOV(CURS : Ref CELL) =
Begin
    Local
	BYTES,
	Q		: Ref ADRVARSTR,
	AREF		: ADRVARSTR;

! MOV any,PC is like a JMP or BR

    If .CURS[cel_dst_mode] Eql GENREG And .CURS[cel_dst_reg] Eql PC  Then
	CLEARTOLAB(.CURS);
    BYTES = .OPBYTES[.CURS[cel_code]];

! change mov(b) #0,any to clr(b) any

    If .CURS[cel_src_type] Eql ADDR_IMMED And .CURS[cel_src_name] Eql 0 And
			.CURS[cel_src_disp] Eql 0 And Not TESTCC(.CURS,__C___) Then
	Begin
	SETCHANGE;
	REDUCEADR(.CURS);
	CURS[cel_code] = (If .BYTES Eql 2 Or .CURS[cel_dst_mode] Eql 0
				Then PCLR
				Else PCLRB);
	Return .CURS
	End;
    If .swit_quick Then
	Return .CURS[cel_next];
    COPYADR(AREF,CURS[cel_src]);
    UPDATE(CURS[cel_dst],AREF);
    Q = CURS[cel_src];
    If (.Q[adr_type] Eql ADDR_REG Or .q[adr_type] Eql ADDR_MEMORY) And
			Not MAY_USE_ADDR(AREF,CURS[cel_dst]) Then
	Begin
	EQUIVFWD(.CURS,CURS[cel_src],CURS[cel_dst],.BYTES);
	If Not MAY_REFER(AREF,CURS[cel_dst]) Then
	    Begin
	    COPYADR(AREF,CURS[cel_dst]);
	    DOWNDATE(CURS[cel_src],AREF);
	    DELBACKREF(.CURS,AREF,If .CURS[cel_dst_mode] Eql 0 Then 2 Else .BYTES);
	    End
	End;
    Return NXTLCC(.CURS)
End;

Routine OPT_TST(CURS : Ref CELL) =
Begin
    Local
	PREV		: Ref CELL,
	LABCURS		: Ref CELL,
	CURS1		: Ref CELL,
	PREV1		: Ref CELL;

    If Not TESTCC(.CURS,__CVZN) Then
	Return DELETE(.CURS);
    If .CURS[cel_src_delta] Neq 0 Then
	Return .CURS[cel_next];
    PREV = PREVNONBR(.CURS);
    If .PREV[cel_type] Eql CELL_CODE Then
	Case SETSCC(.PREV,.CURS) From 0 To 3 Of Set
	    [0]:	! may not be deleted
		Return .CURS[cel_next];
	    [1]:	! may be deleted
		Return DELETE(.CURS);
	    [2]:	! may be deleted if nobody cares for carry
		If TESTCC(.CURS,__C___) Then
		    Begin
		    DELADR(CURS[cel_src],.CURS);
		    CURS[cel_code] = PCLC;
		    Return(.CURS)
		    End
		Else
		    Return DELETE(.CURS);
	    [3]:	! may be deleted if nobody cares for carry/overflow
		If TESTCC(.CURS,__CV__) Then
		    Begin
		    DELADR(CURS[cel_src],.CURS);
		    CURS[cel_code] = PCLVC;
		    Return (.CURS)
		    End
		Else
		    Return DELETE(.CURS)
	Tes;
    If .PREV Neq .CURS[cel_prev] Then
	Return .CURS[cel_next];
    LABCURS = .PREV[cel_top];
    Until .LABCURS Eql .PREV Do
	Begin
	CURS1 = .LABCURS[cel_ref_rf];
	LABCURS = .LABCURS[cel_next];

! cause some branches to a test to branch to the next instruction

	If .CURS1[cel_class] Eql INST_COND_JUMP Or .CURS1[cel_class] Eql INST_UNCOND_JUMP Then
	    Begin
	    PREV1 = PREVNONBR(.CURS1);
	    If .PREV1[cel_type] Eql CELL_CODE Then
		If .PREV1 Neq .CURS Then
		    Case SETSCC(.PREV1,.CURS) From 0 To 3 Of Set
			[0]:	! may not be deleted
			    0;
			[1]:	! may be deleted
			    MOVEJMP(.CURS1,.CURS[cel_next]);
			[2]:	! may be deleted if nobody cares for carry
			    If Not TESTCC(.CURS,__C___) Then
				MOVEJMP(.CURS1,.CURS[cel_next]);
			[3]:	! may be deleted if nobody cares for carry/ovf
			    If Not TESTCC(.CURS,__CV__) Then
				MOVEJMP(.CURS1,.CURS[cel_next])
		    Tes
	    End
	End;
    Return .CURS[cel_next]
End;

Routine PCASPARAM(IND : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL;

    NEXT = NXTLCC(.IND);
    If .NEXT[cel_code] Neq PCASE Then
	NEXT = CLEARTOLAB(.IND);
    FIXJMPIND(.IND);
    Return .NEXT
End;

Routine PCONDJMP(IND : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL,
	NEXTC		: Ref CELL,
	LAB		: Ref CELL;

    NEXT = NXTLCC(.IND);
    If Not LABREFP(.IND) Then
	Begin
	NEXTC = NEWCODECELL();
	BEFORE(.IND,.NEXTC);
	COMBLAB(MAKEJMP(.NEXTC,.NEXT));
	NEXTC[cel_code] = REVCOND(.IND[cel_code]);
	ST[.NEXTC[cel_src_name],cel_class] = NEXTC[cel_class] = INST_COND_JUMP;
	IND[cel_code] = PJMP;
	IND[cel_class] = INST_UNCOND_JUMP;
	Return .NEXTC
	End;

!LABEL REF

    LAB  = LABREFED(.IND);

! look for:	Bcond .+1

    If .LAB Eql .NEXT Then
	Return DELETE(.IND);

! look for:	Bcond lab1
!		BR    lab2 (or Bcond' lab2)
!	    lab1:
    If .NEXT[cel_type] Eql CELL_CODE And .NEXT[cel_next] Eql .LAB Then
	If LABREFP(.NEXT) Then
	    Begin
	    If BRIMPLY(.IND[cel_code],.NEXT[cel_code]) Eql 2 Then
		Return DELETE(.IND);
	    If .NEXT[cel_code] Eql PBR Then
		Begin
		DELADR(IND[cel_src],.IND);
		MAKEADR(IND[cel_src],NEXT[cel_src],.IND);
		IND[cel_code] = REVCOND(.IND[cel_code]);
		DELETE(.NEXT);
		Return .IND
		End
	    End;

! look for:	Bcond lab1
!		BR    lab1

    NEXTC = NXTCC(.IND);
    If .NEXTC[cel_class] Eql INST_UNCOND_JUMP Then
	If LABREFP(.NEXTC) Then
	    If LABREFED(.NEXTC) Eql .LAB Then
		Return DELETE(.IND);

    NEXTC = CONDJMPSRC(.LAB,.IND);
    If .NEXTC Neq .LAB Then
	Begin
	SETCHANGE;
	MOVEJMP(.IND,.NEXTC)
	End;
    Return .NEXT
End;

Routine PLAB(LAB : Ref CELL) =
Begin
    Local
	VAL		: Ref CELL,
	CURS1		: Ref CELL,
	CURS2		: Ref CELL,
	J1		: Ref CELL,
	J2		: Ref CELL;

    LAB = COMBLAB(.LAB);
    VAL = NXTLCC(.LAB);

! if not referenced

    If .LAB[cel_bot] Eql .LAB Then
	Begin
	SETCHANGE;
	ERASE(.LAB);
	Return .VAL
	End;

!LABEL IS REFED.

    CURS1 = .LAB[cel_top];
    Until .CURS1 Eql .LAB Do     !CROSS JUMPING
	Begin
	If .CURS1[cel_class] Eql INST_UNCOND_JUMP Then
	    Begin
	    CURS2 = .CURS1;
	    Until (CURS2 = .CURS2[cel_next]) Eql .LAB Do
		If .CURS2[cel_class] Eql INST_UNCOND_JUMP Then
		    Begin
		    J1 = .CURS1[cel_ref_rf];
		    J2 = .CURS2[cel_ref_rf];
		    If .J1[cel_min_loc] Gtr .J2[cel_min_loc] Then
			SWAP(J1,J2);
		    BACKOV(.J1,.J2)
		    End
	    End;
	CURS1 = .CURS1[cel_next]
	End;
    Return .VAL
End;

Routine PUNCONDJMP(IND : Ref CELL) =
Begin
    Local
	NEXT		: Ref CELL,
	LAB		: Ref CELL,
	SVCHANGE,
	PREV		: Ref CELL,
	TMPRES		: Ref CELL,
	LAB1		: Ref CELL;

    NEXT = CLEARTOLAB(.IND);
    If Not LABREFP(.IND) Then
	Begin
	IND[cel_code] = PJMP;
	Return .NEXT
	End;

!LABEL REF

    LAB  = LABREFED(.IND);

! if BR .+1

    If .LAB Eql .NEXT Then
	Return DELETE(.IND);

! if infinite loop

    If FIXJMPIND(.IND) Then
	Return .NEXT;

!NOT INF LOOP.  BACK UP.

    LAB = LABREFED(.IND);
    SVCHANGE = .CHANGE;
    CHANGE = FALSE;
    TMPRES = BACKOV(.IND,.LAB);
    If .CHANGE Then
	Return .TMPRES;
    CHANGE = .SVCHANGE;
    PREV = PRVLCC(.IND);
    If .PREV[cel_type] Eql CELL_CODE And
			.PREV[cel_class] Eql INST_COND_JUMP Then
	If LABREFP(.PREV) Then	!SHOULD ALWAYS BE TRUE IF CONDJMPP IS TRUE

! SWITCH THE TWO BRANCHES AND TRY CROSS-JUMPING AGAIN

	    Begin
	    LAB1 = LABREFED(.PREV);
	    MOVEJMP(.PREV,.LAB);
	    MOVEJMP(.IND,.LAB1);
	    PREV[cel_code] = REVCOND(.PREV[cel_code]);
	    LAB = LABREFED(.IND);
	    CHANGE = FALSE;
	    TMPRES = BACKOV(.IND,.LAB);
	    CHANGE = .CHANGE Or .SVCHANGE
	    End;
    Return .TMPRES
End;

Routine REACH(CURS : Ref CELL) =
Begin
    Local
	LAB		: Ref CELL,
	DIST,
	NDIST,
	AREF		: Ref CELL,
	BEST		: Ref CELL,
	BDIST,
	REFCELL		: Ref CELL;

    LAB = LABREFED(.CURS);
    DIST = .LAB[cel_min_loc] - .CURS[cel_min_loc];
    If .DIST Leq 127 And .DIST Gtr -128 Then
	Return .LAB;
    AREF = .LAB[cel_top];
    BEST = 0;
    BDIST = 0;
    Until .AREF Eql .LAB Do
	Begin
	REFCELL = .AREF[cel_ref_rf];
	NDIST = .REFCELL[cel_min_loc] - .CURS[cel_min_loc];
	If .NDIST Leq 127 And .NDIST Gtr -128 And Abs(.NDIST) Gtr .BDIST And
			BRIMPLY(.CURS[cel_code],.REFCELL[cel_code]) Eql 1 And
			(BRIMPLY(.REFCELL[cel_code],.CURS[cel_code]) Neq 1 Or
			SIGN(.NDIST) Eql SIGN(.DIST)) Then
	    Begin
	    BDIST = Abs(.NDIST);
	    BEST = .REFCELL
	    End;
	AREF = .AREF[cel_next]
	End;
    Return .BEST
End;

Routine IS_SAME_ADR(A : Ref ADRVARSTR,B : Ref ADRVARSTR) =
Begin
    If .A[adr_name_type] Eql NAME_NORMAL Then
	Return .A[adr_reg] Eql .B[adr_reg] And
			.A[adr_name] Eql .B[adr_name] And
			.A[adr_disp] Eql .B[adr_disp] And
			.A[adr_type] Neq UNUSED
    Else If .A[adr_name_type] Eql NAME_LABEL Then
	If .B[adr_name_type] Eql NAME_LABEL Then
	    Return .ST[.A[adr_name],cel_ref_ef] Eql .ST[.B[adr_name],cel_ref_ef];
    Return FALSE
End;

Routine IS_SAME_CMP(PREV : Ref CELL,CURS : Ref CELL)=
Begin
    Local
	CMPSRC		: ADRVARSTR;

    If .PREV[cel_code] Eql .CURS[cel_code] And .CURS[cel_src_delta] Eql 0 And
			.CURS[cel_dst_delta] Eql 0 Then
	If IS_SAME_ADR(PREV[cel_dst],CURS[cel_dst]) Then
	    Begin
	    COPYADR(CMPSRC,CURS[cel_src]);
	    UPDATE(PREV[cel_dst],CMPSRC);
	    Return IS_SAME_ADR(PREV[cel_src],CMPSRC)
	    End;
    Return FALSE
End;

!
! TRUE IF ADDRESS B IS ADDRESS A + INDIRECT
!
Routine IS_SAME_IND(A : Ref ADRVARSTR,B : Ref ADRVARSTR) =
Begin
    If .A[adr_reg] Eql .B[adr_reg] And .A[adr_name] Eql .B[adr_name] Then
	If .A[adr_disp] Eql .B[adr_disp] Then
	    If .A[adr_type] Eql ADDR_IMMED Or .A[adr_type] Eql ADDR_REG Then
		Return .B[adr_type] Eql ADDR_MEMORY
	    Else If .A[adr_type] Eql ADDR_MEMORY Then
		Return .B[adr_type] Eql ADDR_INDIRECT;
    Return FALSE
End;

!
! T IS A TST INSTRUCTION, I IS THE PREVIOUS INSTRUCTION.
! THE RESULT RETURNED IS:
!  0 - T MUST NOT BE DELETED
!  1 - T IS SUPERFLUOUS, MAY BE DELETED
!  2 - T IS SUPERFLUOUS IF NOBODY IS WORRIED ABOUT CARRY
!  3 - T IS SUPERFLUOUS IF NOBODY IS WORRIED ABOUT CARRY OR OVERFLOW
!
Routine SETSCC(I : Ref CELL,T : Ref CELL) =
Begin
    Local
	A		: ADRVARSTR;

! previous cell must be an instruction.  if a label, previous
! instruction could have come from several spots

    If .I[cel_type] Neq CELL_CODE Then
	Return 0;
    Case .CCSETTYPE[.I[cel_code]] From 0 To 7 Of Set

! UUO, CMP(B), BIT(B), JSR, RTS, HALT, WAIT, RTI, IOT, RESET
! EMT, TRAP, BR, JMP, NOP, CLC, CLVC, .WORD, CASE

	[0]:
	    0;

! MOV(B)

	[1]:
	    If .OPBYTES[.I[cel_code]] Eql .OPBYTES[.T[cel_code]] Then
		If IS_SAME_ADR(I[cel_dst],T[cel_src]) Then
		    Return 2
		Else If Not MAY_USE_ADDR(T[cel_src],I[cel_dst]) Then
		    Begin
		    COPYADR(A,T[cel_src]);
		    DOWNDATE(I[cel_dst],A);
		    If IS_SAME_ADR(I[cel_src],A) Then
			Return 2
		    End;

! BIC(B), BIS(B)

	[2]:
	    If .OPBYTES[.I[cel_code]] Eql .OPBYTES[.T[cel_code]] Then
		If IS_SAME_ADR(I[cel_dst],T[cel_src]) Then
		    Return 2;

! ADD, SUB

	[3]:
	    If .OPBYTES[.I[cel_code]] Eql .OPBYTES[.T[cel_code]] Then
		If IS_SAME_ADR(I[cel_dst],T[cel_src]) Then
		    Return 3;

! CLR(B), COM(B), TST(B), SWAB

	[4]:
	    If .OPBYTES[.I[cel_code]] Eql .OPBYTES[.T[cel_code]] Then
		If IS_SAME_ADR(I[cel_src],T[cel_src]) Then
		    Return 1;

! INC(B), DEC(B), NEG(B), ADC(B), SBC(B), ROR(B), ROL(B), ASR(B), ASL(B)

	[5]:
	    If .OPBYTES[.I[cel_code]] Eql .OPBYTES[.T[cel_code]] Then
		If IS_SAME_ADR(I[cel_src],T[cel_src]) Then
		    Return 3;

! MFPI, MFPD, MTPI, MTPD

	[6]:
	    If .OPBYTES[.T[cel_code]] Eql 2 Then
		If IS_SAME_ADR(I[cel_src],T[cel_src]) Then
		    Return 2;

! branch instructions

	[7]:
	    Begin
	    I = .I[cel_prev];
	    If .T Neq .I Then
		Return SETSCC(.I,.T)
	    End
    Tes;
    Return 0
End;

!
! TRUE IF ANY CC BITS INDICATED BY CCS
! ARE USED BEFORE BEING RESET, ON ANY
! CONTROL PATH FOLLOWING CURS.
!
Routine TESTCC(CURS : Ref CELL,CCS : LONG) =
Begin
    Local
	CCSL,
	CCUSE,
	LAB		: Ref CELL,
	T;

    CCSL = (If .swit_final Then CCSHIFT(.CCS) Else .CCS);
    CURS = NXTCC(.CURS);
    CCUSE = .CCUSETYPE[.CURS[cel_code]];
    If (.CCUSE And .CCSL) Neq 0 Then
	Return TRUE
    Else If (.CCUSE And _J____) Neq 0 Then
	If LABREFP(.CURS) Then
	    Begin
	    LAB = LABREFED(.CURS);
	    If .LAB[cel_lab_seen] Then
		Return FALSE;
	    LAB[cel_lab_seen] = TRUE;
	    T = TESTCC(.LAB,.CCS);
	    LAB[cel_lab_seen] = FALSE;
	    If .T Then
		Return TRUE
	    Else If .CURS[cel_class] Eql INST_COND_JUMP Then
		Return TESTCC(.CURS,.CCS)
	    Else
		Return FALSE
	    End
	Else
	    Return Not .swit_final
    Else If (.CCUSE And X_____) Neq 0 And (.CCSL And __C___) Neq 0 Then
	Return TESTCC(.CURS,__C___)
    Else
	Return FALSE
End;

!
! MODIFY NEXT INSTRUCTION TO ASSUME ZERO CONDITION
! CODE.  RETURNS 1 IF MODIFICATION NOT POSSIBLE.
!
Routine TESTEQL(CURS : Ref CELL) =
Begin
    Local
	CURS1		: Ref CELL;
    Bind
	NOTBREQL = Uplit Byte (0,1,1,0,0,1,0,1,0,1,1,0,0,1,0,1)
			: Vector[,Byte];

    CURS1 = NXTCC(.CURS);
    If .CURS1[cel_type] Eql CELL_CODE And
		.CURS1[cel_class] Eql INST_COND_JUMP Then
	If .NOTBREQL[.CURS1[cel_code]-PBR] Then
	    Begin
	    DELETE(.CURS1);
	    Return 0
	    End
	Else
	    Begin
	    SETCHANGE;
	    CURS1[cel_code] = PBR;
	    CURS1[cel_class] = INST_UNCOND_JUMP;
	    Return 0
	    End;
    Return TESTCC(.CURS,__CVZN)
End;

!
! FUNCTION:
!   SEE IF ADDRESS "A" IN CODE CELL "I" CAN BE MODIFIED BECAUSE
! OF THE EXISTENCE OF LATER IMMEDIATE ADD (SUB) INSTRUCTION "IADD".
! A RETURN VALUE OF 1 TERMINATES THE SCAN.
!
! CALLED FROM A BACKWARD SCAN IN OPT_ADDSUB;

Routine TESTPOP(A : Ref ADRVARSTR,IADD : Ref CELL,I : Ref CELL) =
Begin
    Local
	BYTES		: Integer,
	OFFST		: Integer,
	NEWADD		: Ref CELL,
	NEWOFFSET	: Integer;
    Label
	aaa;

    If .A[adr_reg] Neq .IADD[cel_dst_reg] Then
	Begin

! return TRUE if an adjustment

	If Not .swit_final Then
	    Return (.A[adr_type] Neq ADDR_IMMED And .A[adr_type] Neq ADDR_REG);
	If .IADD[cel_dst_reg] Neq SP Or Not .flg_stack_addr Then
	    Return FALSE;			! TO IADD MIGHT CAUSE A TO
	If .A[adr_type] Eql ADDR_INDIRECT Then
	    Return TRUE;			! POINT ABOVE TOP OF (SP) STACK.
	If .A[adr_type] Eql ADDR_MEMORY And .A[adr_name] Eql 0 And .A[adr_reg] Neq PC Then
	    Return TRUE;
	Return FALSE
	End;
    If .A[adr_mode] Eql GENREG Then
	Return TRUE;
    If .A[adr_name] Gtr 1 Then
	Return FALSE;
    OFFST = (If .IADD[cel_code] Eql PSUB
			Then -.IADD[cel_src_disp]
			Else  .IADD[cel_src_disp]);

! change A from (R)+ to @R

    If .A[adr_delta] Gtr 0 Then
	If (.OFFST Lss 0 Or .IADD[cel_src_name] Neq 0) And .A[adr_type] Neq ADDR_INDIRECT Then
	    Begin
	    BYTES = -.A[adr_delta];
	    A[adr_mode]  = GENREG+DEFERRED;
	    A[adr_delta] = 0;
	    A[adr_disp]  = 0
	    End
	Else
	    Return TRUE

! if A is -(R) ot @-(R)

    Else If .A[adr_delta] Lss 0 Then
	Return TRUE
    Else
	Begin
	BYTES = (If .A[adr_type] Eql ADDR_INDIRECT Or .A[adr_reg] Geq SP
			Then 2
			Else .OPBYTES[.I[cel_code]]);

! change A from -2(R) to -(R) or @-2(R) to @-(R)

	If .A[adr_disp] Eql -.BYTES Then
	    Begin
	    BYTES = -.BYTES;
	    A[adr_delta] = .BYTES;
	    A[adr_mode]  = .A[adr_mode] - 2;
	    A[adr_disp]  = 0
	    End
	Else If .A[adr_disp] Eql 0 Then

! change A from @R to (R)+ or from @0(R) to @(R)+

	    If (.IADD[cel_src_name] Eql 0 And .OFFST-.BYTES Geq 0)
				Or (.A[adr_type] Eql ADDR_INDIRECT And
				(.A[adr_reg] Neq SP Or .OFFST Gtr 0)) Then
		Begin
		A[adr_delta] = .BYTES;
		A[adr_mode] = (If .A[adr_type] Eql ADDR_MEMORY Then AUTOINCR Else AUTOINCR+DEFERRED);
		A[adr_disp] = -.BYTES
		End
	    Else
		Return TRUE
	Else If

! THIS BLOCK CHECKS TO SEE IF WE CAN,
! IN EFFECT, PUT IADD BEFORE I, TO
! CHANGE A FROM N(REG) TO @REG OR (REG)+.

			aaa: Begin
			NEWOFFSET = .A[adr_disp];
			If .A[adr_reg] Neq SP Then
			    If (.NEWOFFSET Eql .OFFST  And .A[adr_type] Eql ADDR_MEMORY)
					Or .NEWOFFSET Eql .OFFST-.BYTES Then
				PUSHPOPFLAG = .OFFST;
			If (.NEWOFFSET Neq .PUSHPOPFLAG Or .A[adr_type] Neq ADDR_MEMORY)
				And .NEWOFFSET Neq .PUSHPOPFLAG-.BYTES Then
			    Leave aaa With FALSE;
			If .A[adr_type] Neq ADDR_MEMORY And .A[adr_reg] Eql SP And
						.flg_stack_addr Then
			    Leave aaa With FALSE;
			If .OPERTYPE[.I[cel_code]] Neq OPTYPE_TWO Then
			    Leave aaa With TRUE;
			If I[cel_src] Eql .A Then
			    Leave aaa With TRUE;
			If .I[cel_src_reg] Neq .A[adr_reg] Then
			    Begin
			    If .A[adr_reg] Neq SP Or Not .flg_stack_addr Then
				Leave aaa With TRUE;
!
! A IS N(SP) AND flg_stack_addr IS ON -- MUST CHECK IF
! I[SRCP] MAY POINT TO STACK.
!
			    If .I[cel_src_type] Eql ADDR_INDIRECT Then
				Leave aaa With FALSE;
			    If .I[cel_src_type] Eql ADDR_MEMORY And
					.I[cel_src_name] Eql 0 And
					.I[cel_src_reg] Neq PC Then
				Leave aaa With FALSE;
			    Leave aaa With TRUE
			    End;
			If .I[cel_src_type] Eql ADDR_REG Or .I[cel_src_delta] Neq 0 Then
			    Leave aaa With FALSE;
			If .I[cel_src_type] Eql ADDR_INDIRECT And .A[adr_reg] Eql SP
					And .flg_stack_addr Then
			    Leave aaa With FALSE;
			If .A[adr_reg] Eql SP And .I[cel_src_disp] Lss .NEWOFFSET-2 Then
			    Leave aaa With FALSE;

! MUST CHANGE I[SRCP],
! SINCE TESTPP WILL NOT.

			I[cel_src_disp] = .I[cel_src_disp]-.A[adr_disp];
			If .I[cel_src_disp] Eql -.BYTES And .I[cel_src_name] Leq 1 Then
			    Begin
			    I[cel_src_delta] = .BYTES;
			    I[cel_src_mode] = (If .I[cel_src_type] Eql ADDR_MEMORY Then AUTOINCR Else AUTOINCR+DEFERRED);
			    NEWOFFSET = .NEWOFFSET-.BYTES
			    End;
			Leave aaa With TRUE
			End
		Then				! IT WORKED!
	    Begin
	    If .A[adr_disp] Eql .PUSHPOPFLAG Then
		Begin
		A[adr_disp] = 0;
		A[adr_mode] = GENREG+DEFERRED
		End
	    Else
		Begin
		A[adr_delta] = .BYTES;
		A[adr_disp]  = -.BYTES;
		A[adr_mode]  = (If .A[adr_type] Eql ADDR_MEMORY Then AUTOINCR Else AUTOINCR+DEFERRED)
		End;
	    NEWADD = BEFORE(.I,NEWCODECELL());
	    NEWADD[cel_code]     = PADD;
	    NEWADD[cel_class]    = INST_ADD_IMMED;
	    COPYADR(NEWADD[cel_dst],IADD[cel_dst]);
	    COPYADR(NEWADD[cel_src],IMMEDZERO);
	    NEWADD[cel_src_disp] = .NEWOFFSET;
	    BYTES = .PUSHPOPFLAG;
	    End
	Else
	    Begin
	    If .A[adr_disp] Lss .PUSHPOPFLAG+.BYTES Then
		PUSHPOPFLAG = .A[adr_disp];
	    Return FALSE
	    End;
	End;
    OFFST = .OFFST-.BYTES;
    IADD[cel_src_disp] = (If .IADD[cel_code] Eql PSUB
				Then -.OFFST
				Else .OFFST);

! fix up cells between I and IADD to reflect changes in those two cells

    While TRUE Do
	Begin
	IADD = .IADD[cel_prev];
	Selectone .OPERTYPE[.IADD[cel_code]] Of Set
	    [OPTYPE_ONE]:
		If TESTPP(.A,IADD[cel_src],.BYTES) Then
		    Exitloop;
	    [OPTYPE_TWO]:
		If TESTPP(.A,IADD[cel_dst],.BYTES) Then
		    Exitloop
		Else If TESTPP(.A,IADD[cel_src],.BYTES) Then
		    Exitloop
	Tes
	End;
    SETCHANGE;
    Return TRUE
End;

!
! FUNCTION:
!   ADJUST ADDRESS "I" BY AN AMOUNT "DELTA" IF ADDRESSES
!   "A" AND "I" USE THE SAME REGISTER. RETURN TRUE IF
!   A EQUALS I, TO SIGNAL THE END OF AN ADDRESS ADJUSTMENT SCAN.
!
Routine TESTPP(A : Ref ADRVARSTR,I : Ref ADRVARSTR,DELTA) =
Begin
    If .A Eql .I Then
	Return 1;
    If .A[adr_reg] Eql .I[adr_reg] Then
	Begin
	I[adr_disp] = .I[adr_disp] - .DELTA;
	If .I[adr_disp] Eql 0 And .I[adr_mode] Eql INDEXED Then
	    I[adr_mode] = GENREG+DEFERRED
	End;
    Return 0
End;

!
! FUNCTION:
!   SEE IF ADDRESS "A" IN INSTRUCTION "I" CAN BE MODIFIED BECAUSE OF
! THE EXISTENCE OF EARLIER IMMEDIATE ADD (SUB) INSTRUCTION "IADD".
! A RETURN VALUE OF TRUE TERMINATES THE SCAN.
!
! called from OPT_ADDSUB in its forward scan

Routine TESTPUSH(A : Ref ADRVARSTR,IADD : Ref CELL,I : Ref CELL) =
Begin
    Local
	BYTES		: Integer,
	OFFST		: Integer,
	NEWADD		: Ref CELL,
	NEWOFFSET	: Integer;
    Label
	aaa;

    If .A[adr_reg] Neq .IADD[cel_dst_reg] Then
	Begin
	If .swit_final Then
	    Return FALSE;
	Return .A[adr_type] Neq ADDR_IMMED And .A[adr_type] Neq ADDR_REG
	End;
    If .A[adr_mode] Eql GENREG Then
	Return TRUE;

! if a named location

    If .A[adr_name] Gtr 1 Then
	Return FALSE;
    OFFST = (If .IADD[cel_code] Eql PSUB
			Then -.IADD[cel_src_disp]
			Else  .IADD[cel_src_disp]);

! change A from -(R) to @R

    If .A[adr_delta] Lss 0 Then
	If (.OFFST Gtr 0 Or .IADD[cel_src_name] Neq 0) And
			.A[adr_type] Neq ADDR_INDIRECT Then
	    Begin
	    BYTES = .A[adr_delta];
	    A[adr_mode]  = GENREG+DEFERRED;
	    A[adr_delta] = 0;
	    A[adr_disp]  = 0
	    End
	Else
	    Return TRUE

! A is (R)+ or @(R)+

    Else If .A[adr_delta] Gtr 0 Then
	Return TRUE
    Else
	Begin
	BYTES = (If .A[adr_type] Eql ADDR_INDIRECT Or .A[adr_reg] Geq SP
			Then 2
			Else .OPBYTES[.I[cel_code]]);

! change A from -2(R) to (R)+ or from @-2(R) to @(R)+

	If .A[adr_disp] Eql -.BYTES Then
	    Begin
	    A[adr_delta] = .BYTES;
	    A[adr_mode] = .A[adr_mode]-4;
	    BYTES = -.BYTES
	    End
	Else If .A[adr_disp] Eql 0 Then

! CHANGE A FROM @REG TO -(REG)
!       OR FROM @0(REG) TO @-(REG).

	    If (.IADD[cel_src_name] Eql 0 And .OFFST+.BYTES Leq 0)
			Or (.A[adr_type] Eql ADDR_INDIRECT And
					.A[adr_reg] Neq SP) Then
		Begin
		A[adr_delta] = -.BYTES;
		A[adr_mode]  = (If .A[adr_type] Eql ADDR_MEMORY
					Then AUTODECR
					Else AUTODECR+DEFERRED);
		A[adr_disp]  = 0
		End
	    Else
		Return TRUE
	Else If

! THIS BLOCK CHECKS TO SEE IF WE CAN, IN EFFECT, PUT IADD AFTER I, TO
! CHANGE A FROM -N(REG) TO @REG OR -(REG).

			aaa: Begin
			NEWOFFSET = .A[adr_disp];
			If .A[adr_reg] Neq SP Then
			    If (.NEWOFFSET Eql -.OFFST And .A[adr_type] Eql ADDR_MEMORY)
					Or .NEWOFFSET Eql -.OFFST-.BYTES Then
				PUSHPOPFLAG = -.OFFST;
			If TESTCC(.I,__CVZN) Then
			    Leave aaa With FALSE;
			If (.NEWOFFSET Neq .PUSHPOPFLAG Or
					.A[adr_type] Neq ADDR_MEMORY) And
					.NEWOFFSET Neq .PUSHPOPFLAG-.BYTES Then
			    Leave aaa With FALSE;
			If .OPERTYPE[.I[cel_code]] Neq OPTYPE_TWO Then
			    Leave aaa With TRUE;
			If I[cel_dst] Eql .A Then
			    Leave aaa With TRUE;
			If .I[cel_dst_reg] Neq .A[adr_reg] Then
			    Leave aaa With TRUE;
			If .I[cel_dst_type] Eql ADDR_REG Or .I[cel_dst_delta] Neq 0 Then
			    Leave aaa With FALSE;

! MUST CHANGE I[DSTP], SINCE TESTPP WILL NOT.

			If .A[adr_reg] Eql SP And .I[cel_dst_disp] Lss .NEWOFFSET-2 Then
			    Leave aaa With FALSE;
			I[cel_dst_disp] = .I[cel_dst_disp]-.A[adr_disp];
			If .I[cel_dst_disp] Eql -.BYTES And
					.I[cel_dst_name] Leq 1 Then
			    Begin
			    I[cel_dst_disp] = 0;
			    I[cel_dst_delta] = -.BYTES;
			    I[cel_dst_mode] = (If .I[cel_dst_type] Eql ADDR_MEMORY
					Then AUTODECR
					Else AUTODECR+DEFERRED);
			    NEWOFFSET = .NEWOFFSET-.BYTES
			    End;
			Leave aaa With TRUE
			End
		Then				! IT WORKED!
	    Begin
	    If .A[adr_disp] Eql .PUSHPOPFLAG Then
		A[adr_mode] = GENREG+DEFERRED
	    Else
		Begin
		A[adr_delta] = -.BYTES;
		A[adr_mode] = (If .A[adr_type] Eql ADDR_MEMORY
				Then AUTODECR
				Else AUTODECR+DEFERRED)
		End;
	    NEWADD = AFTER(.I,NEWCODECELL());
	    NEWADD[cel_code] = PADD;
	    NEWADD[cel_class] = INST_ADD_IMMED;
	    COPYADR(NEWADD[cel_dst],IADD[cel_dst]);
	    COPYADR(NEWADD[cel_src],IMMEDZERO);
	    NEWADD[cel_src_disp] = -.NEWOFFSET;
	    BYTES = .PUSHPOPFLAG;
	    A[adr_disp] = 0
	    End
	Else
	    Begin
	    If .A[adr_disp] Lss .PUSHPOPFLAG+.BYTES Then
		PUSHPOPFLAG = .A[adr_disp];
	    Return FALSE
	    End
	End;
    OFFST = .OFFST+.BYTES;
    IADD[cel_src_disp] = (If .IADD[cel_code] Eql PSUB
				Then -.OFFST
				Else .OFFST);

! fix up cells between IADD and I reflecting changes in those two cells.

    While TRUE Do
	Begin
	IADD = .IADD[cel_next];
	Selectone .OPERTYPE[.IADD[cel_code]] Of Set
	    [OPTYPE_ONE]:
		If TESTPP(.A,IADD[cel_src],.BYTES) Then
		    Exitloop;
	    [OPTYPE_TWO]:
		If TESTPP(.A,IADD[cel_src],.BYTES) Then
		    Exitloop
		Else If TESTPP(.A,IADD[cel_dst],.BYTES) Then
		    Exitloop
	Tes
	End;
    SETCHANGE;
    Return TRUE
End;

Routine UPDATE(A : Ref ADRVARSTR,B : Ref ADRVARSTR) : Novalue =
Begin
    If .A[adr_reg] Eql .B[adr_reg] Then
	B[adr_disp] = .B[adr_disp]-.A[adr_delta]
End;

End
Eludom