; BcplUtil.Mu  --  bcpl runtime utilities (except GetFrame and Return)
; Copyright Xerox Corporation 1979

;	Last modified October 16, 1977  6:38 PM


; All Bcpl runtime utilities in this module are invoked by an opcode
; of the form XXnnn, where XX is the opcode for the main dispatch in RamTrap
; and nnn is the DISP field used for sub-dispatching here.

!77,100, Lq0.0, Lq0.1, Lq0.2, Lq0.3, Lq0.4, Lq0.5, Lq0.6, Lq0.7,
	      , Lq1.1, Lq1.2, Lq1.3, Lq1.4, Lq1.5, Lq1.6, Lq1.7,
	Snq0, Sq0.1, Sq0.2, Sq0.3, Sq0.4, Sq0.5, Sq0.6, Sq0.7,
	Snq1, Sq1.1, Sq1.2, Sq1.3, Sq1.4, Sq1.5, Sq1.6, Sq1.7,
	LongJump, Branch, Lookup, Rsh, Lsh, Ior, Xor, Eqv,
	Mult, DivRem, MulPlus, Ly01, Ly10, Sy01, Sy10;


; RamTrap dispatches here for the Bcpl utility opcode

BcplUtility:
	SINK←DISP, BUS, TASK;		Branch on sub-code
	:Lq0.0;


; LongJump
; Jumps to AC3 + @AC3
; Calling sequence is:
;	jsr @355
;	 target-. (i.e., a self-relative pointer)

LongJump:
	MAR←T←AC3;
LongJ1:	NOP;
	L←MD+T, TASK;

; Some useful exit sequences
Start0:	PC←L;			Branch here having done L← new PC, TASK;
Start1:	L←PC, SWMODE;		Here after TASK; something;
Start2:	PC←L, :START;		Here after TASK; something; L← new PC, SWMODE;

; Branch
; Calling sequence is:
;	lda 0 switchon value
;	jsr @350
;	 value of last case
;	 number of cases
;	 lastTarget-.
;	 ...
;	 firstTarget-.
;	return here if out of range, AC0 unchanged

!1,2, Bran0, Bran1;
!1,2, Bran2, Bran3;

Branch:	MAR←T←AC3;		Fetch value of last case
	L←2+T;
	AC3←L;			AC3← address of first branch table entry
	T←AC0;			Value we are branching on
	L←MD-T;			L← lastCase-value, carry← lastCase ge value
	MAR←T←AC3-1, ALUCY;	Fetch number of cases
	T←LREG, L←LREG+T, :Bran0; [Bran0, Bran1] T← lastCase-value,
;				L← AC3+(lastCase-value)-1

; Value greater than last case, take out of range exit.
Bran0:	L←T←MD, :Bran1a; 	Finish fetch of numCases, turn off ALUCY

; Value le last case, test number of cases
Bran1:	SAD←L;			Save address-1 of branch table entry
	L←MD-T-1, T←MD;		L← numCases-(lastCase-value)-1, T← numCases
Bran1a:	L←AC3+T, ALUCY, TASK;	Carry if numCases gr (lastCase-value)
	AC3←L, :Bran2;		[Bran2, Bran3] Adr of inst after branch table

; Value in range, execute branch.
; SAD/ address-1 of branch table entry
Bran3:	MAR←T←SAD+1, :LongJ1;	Just like LongJump

; Value less than first case, take out of range exit.
Bran2:	L←AC3, SWMODE, :Start2;

; Lookup
; Calling sequence is:
;	lda 0 switchon value
;	jsr @351
;	 number of cases
;	 case value 1
;	 target1-.
;	 ...
;	 case value n
;	 targetn-.
;	return here if out of range

!1,2, Look0, Look1;
!1,2, Look2, Look3;

Lookup:	MAR←T←AC3;		Fetch number of cases
	NOP;
	L←MD+T, T←MD;		L← AC3+numCases, T← numCases
	L←LREG+T+1, TASK;	L← AC3+(2*numCases)+1
	AC1←L;			Save for end test

Look0:	MAR←T←AC3+1;		Increment pointer, fetch next case value
	L←AC1-T;		Test for end
	T←AC0, L←T, SH=0;	T← switchon value
	AC3←L, :Look2;		[Look2, Look3]
Look2:	L←MD-T;			Compare switchon value with case
	L←AC3+1, SH=0, TASK;	Increment pointer again
	AC3←L, :Look0;		[Look0, Look1]

; Found matching case value.  AC3/ address of dispatch for case.
Look1:	MAR←T←AC3, :LongJ1;	Just like LongJump

; Lookup failed.  AC3/ adr of inst after lookup table
Look3:	L←AC3, TASK, :Start0;

; Right shift
; Computes ac0 ← ac0 rshift ac1
; Called by jsr @347
; Note that shift count may be either positive or negative

!1,2, RshPos, RshNeg;
!1,2, RshG16, RshL16;
!1,2, RshG8, RshL8;
!1,1, RshN1;
!1,1, LtoAC0;

Rsh:	L←T←AC1;		Shift count negative?
	L←17-T, SH<0;		16 or greater?
	L←10 AND T, ALUCY, :RshPos; [RshPos, RshNeg] 8 or greater?
RshPos:	L←7 AND T, SH=0, :RshG16; [RshG16, RshL16] Compute count mod 8
RshL16:	T←177400, :RshG8;	[RshG8, RshL8]

; Shift count in range 8 to 15.  Start by right-shifting 8
RshG8:	T←AC0.T;
	SINK←LREG, L←T, BUS, TASK;  Branch on shift count mod 8
	AC0←L LCY 8, :Lq0.0;

; Shift count less than 8.  Branch on shift count
RshL8:	SINK←AC1, BUS, TASK;
	:Lq0.0;

; This shift table is also used in the Lq0.n series of instructions
Lq0.7:	L←AC0;
	AC0←L RSH 1;
Lq0.6:	L←AC0;
	AC0←L RSH 1;
Lq0.5:	L←AC0;
	AC0←L RSH 1;
Lq0.4:	L←AC0;
	AC0←L RSH 1;
Lq0.3:	L←AC0;
	AC0←L RSH 1;
Lq0.2:	L←AC0;
	AC0←L RSH 1;
Lq0.1:	L←AC0, TASK;
	AC0←L RSH 1, :Bran2;	Do PC←AC3 and go to START

; Shift count 0, do nothing
Lq0.0:	L←AC3, SWMODE, :Start2;	Do PC←L and go to START

; Shift count 16 or greater, return zero
RshG16:	L←0, TASK, :LtoAC0;	[LtoAC0, LtoAC0]
LtoAC0:	AC0←L, :Bran2;		Do PC←AC3 and go to START

; Shift count negative.  Convert to Left Shift
RshNeg:	L←0-T, TASK;		[RshN1, RshN1] Negate shift count
RshN1:	AC1←L, :Lsh;

; Right shift constant amount
; Computes ac0 ← ac0 rshift n (n in range 1 to 7)
; Calling sequence is:
;	lda 0 value
;	jsr 314 - 2*n
; (dispatches into Lq0.n table, above)


; Right shift constant amount
; Computes ac1 ← ac1 rshift n (n in range 1 to 7)
; Calling sequence is:
;	lda 1 value
;	jsr 315 - 2*n

Lq1.7:	L←AC1;
	AC1←L RSH 1;
Lq1.6:	L←AC1;
	AC1←L RSH 1;
Lq1.5:	L←AC1;
	AC1←L RSH 1;
Lq1.4:	L←AC1;
	AC1←L RSH 1;
Lq1.3:	L←AC1;
	AC1←L RSH 1;
Lq1.2:	L←AC1;
	AC1←L RSH 1;
Lq1.1:	L←AC1, TASK;
	AC1←L RSH 1, :Bran2;	Do PC←AC3 and go to START

; Left shift
; Computes ac0 ← ac0 lshift ac1
; called by jsr @346
; Note that shift count may be either positive or negative

!1,2, LshPos, LshNeg;
!1,2, LshG16, LshL16;
!1,2, LshG8, LshL8;
!7,10, Lsh0, Lsh1, Lsh2, Lsh3, Lsh4, Lsh5, Lsh6, Lsh7;
!1,1, LshN1;

Lsh:	L←T←AC1;		Shift count negative?
	L←17-T, SH<0;		16 or greater?
	L←10 AND T, ALUCY, :LshPos; [LshPos, LshNeg] 8 or greater?
LshPos:	L←7 AND T, SH=0, :LshG16; [LshG16, LshL16] Compute count mod 8
LshL16:	T←377, :LshG8;		[LshG8, LshL8]

; Shift count in range 8 to 15.  Start by left-shifting 8
LshG8:	T←AC0.T;
	SINK←LREG, L←T, BUS, TASK;  Branch on shift count mod 8
	AC0←L LCY 8, :Lsh0;

; Shift count less than 8.  Branch on shift count
LshL8:	SINK←AC1, BUS, TASK;
	:Lsh0;

Lsh7:	L←AC0;
	AC0←L LSH 1;
Lsh6:	L←AC0;
	AC0←L LSH 1;
Lsh5:	L←AC0;
	AC0←L LSH 1;
Lsh4:	L←AC0;
	AC0←L LSH 1;
Lsh3:	L←AC0;
	AC0←L LSH 1;
Lsh2:	L←AC0;
	AC0←L LSH 1;
Lsh1:	L←AC0, TASK;
	AC0←L LSH 1, :Bran2;	Do PC←AC3 and go to START

; Shift count 0, do nothing
Lsh0:	L←AC0, TASK, :LtoAC0;

; Shift count 16 or greater, return zero
LshG16:	L←0, TASK, :LtoAC0;	[LtoAC0, LtoAC0]

; Shift count negative.  Convert to Right Shift
LshNeg:	L←0-T, TASK;		[LshN1, LshN1] Negate shift count
LshN1:	AC1←L, :Rsh;

; Ior
; Computes ac0 ← ac0 % ac1
; Called by jsr @340

Ior:	T←AC1;
	L←AC0 OR T, TASK, :LtoAC0;


; Xor
; Computes ac0 ← ac0 xor ac1
; Called by jsr @341

Xor:	T←AC1;
Xor1:	L←AC0 XOR T, TASK, :LtoAC0;


; Eqv
; Computes ac0 ← ac0 eqv ac1
; Called by jsr @342

Eqv:	T←AC1;
	L←ALLONES XOR T;	ac0 eqv ac1 = ac0 xor (not ac1)
	T←LREG, :Xor1;


; MulPlus
; Computes ac0 ← ac3 ← (ac1*@ac3)+ac0
; Calling sequence is:
;	lda 0 addend
;	lda 1 multiplicand
;	jsr @357
;	 multiplier
;	return here with result in ac0 and ac3

!1,2, MPNoAd, MPAdd;
!1,2, MPLoop, MPDone;

MulPlus:
	MAR←AC3;		Start fetch of multiplier
	L←AC3+1;		Compute return pc
	PC←L;
	L←MD, BUSODD, :MPLp1;	Test low bit of multiplier

; MulPlus loop.  During each iteration, the multiplier is right-shifted 1
; and the multiplicand is left-shifted 1.  The loop terminates when the
; multiplier becomes zero.  This is good because in the standard use of
; MulPlus the multiplier is typically a small integer.
MPLoop:	L←AC3, BUSODD;		Test low bit of multiplier
MPLp1:	AC3←L RSH 1, :MPNoAd;	[MPNoAd, MPAdd] Shift it out

; Multiplier bit was 0, don't add but just shift multiplicand
MPNoAd:	L←AC1, SH=0, TASK, :MPShft; Test for no more bits in multiplier

; Multiplier bit was 1, add multiplicand to product
MPAdd:	T←AC1;			Multiplicand
	L←AC0+T;		Add to partial product
	AC0←L, L←T, TASK;	L← multiplicand
MPShft:	AC1←L LSH 1, :MPLoop;	[MPLoop, MPDone] Shift multiplicand left

; Here when done
MPDone:	L←AC0, SWMODE;		Copy result to ac3
	AC3←L, :START;

; Mult
; Computes (ac0,ac1) ← ac0*ac1
; Called by jsr @343

!1,2, DoMul, NoMul;
!1,2, MNoAdd, MAdd;
!1,2, NoSpil, Spill;
!1,2, MultLp, MultDn;

Mult:	L←AC0-1, BUS=0;		Get multiplicand-1, test for zero
	SAD←L, L←0, :DoMul;	[DoMul, NoMul] Save it away
DoMul:	AC0←L, TASK;		Init partial product to 0
	IR←ONE;			Init loop count; done when it reaches 20

; Multiply loop
MultLp:	L←AC1, BUSODD;		Test low bit of multiplier
	T←AC0, :MNoAdd;		[MNoAdd, MAdd] Get partial product

; Multiplier bit was 1, add multiplicand to product
MAdd:	L←T←SAD+T+1;		Add multiplicand to partial product
	L←AC1, ALUCY;		Low part of partial product

; Multiplier bit was 0, just shift multiplicand and partial product
MNoAdd:	AC1←L MRSH 1, L←T, T←0, :NoSpil; [NoSpil, Spill]
Spill:	T←ONE;			Carry into high partial product
NoSpil:	AC0←L MRSH 1;
	L←DISP+1, L←X17+1, BUS=0, TASK; Check and update loop count
	IR←LREG, :MultLp;	[MultLp, MultDn] Branch if it was 20

; Here when done
MultDn:	L←AC3, SWMODE, :Start2;

; Here when multiplicand is zero, just return zero
NoMul:	AC1←L, :Bran2;

; DivRem
; Computes ac1 ← ac0/ac1 and ac0 ← ac0 rem ac1 (signed)
; Called by jsr@344 or jsr@345

!1,2, DvsPos, DvsNeg;
!1,2, DndPos, DndNeg;
!1,2, NoSub, DoSub;
!1,2, DivLp, DivDn;
!1,2, RemPos, RemNeg;
!1,2, QuoPos, QuoNeg;

DivRem:	L←T←AC1;		Fetch divisor
	SAD←L, SH<0;		Save it, test sign
	XREG←L, L←0-T, :DvsPos;	[DvsPos, DvsNeg] Save original divisor
DvsNeg:	SAD←L;			Negative, negate divisor
DvsPos:	L←T←AC0;		Fetch dividend
	PC←L, L←0-T, SH<0;	Save it, test sign
	:DndPos;		[DndPos, DndNeg] Init loop count
DndNeg:	T←LREG;			Negative, negate dividend
DndPos:	L←20;			Init loop count
	XH←L, L←0, :DivLp0;	Init high dividend

; Divide loop
DivLp:	L←AC0;			Current high dividend
	T←AC1;			Current low dividend and quotient
DivLp0:	AC0←L MLSH 1, L←T;	Shift another bit into high dividend
	AC1←L LSH 1;		Shift a zero into quotient
	T←SAD;			Divisor
	L←AC0-T, T←AC0;		Try to subtract divisor from high dividend
	AC0←L, ALUCY;		Store dividend assuming subtract ok
	L←XH-1, :NoSub;	[NoSub, DoSub] Decrement and test loop count

; Subtract ok, put a 1 in the quotient
DoSub:	XH←L;			Update loop count
	L←AC1+1, SH=0, TASK;	Change quotient bit to 1
	AC1←L, :DivLp;		[DivLp, DivDn] Branch if done

; Subtract not ok, restore old dividend and leave quotient bit 0
NoSub:	XH←L, L←T, SH=0, TASK;	Update loop count
	AC0←L, :DivLp;		[DivLp, DivDn] Restore AC0, branch if done

; Here when done.  Fix up signs and exit
DivDn:	L←PC;			Get original dividend
	T←AC0, SH<0;		Test sign
	L←0-T, T←0, :RemPos;	[RemPos, RemNeg]
RemNeg:	AC0←L, T←0-1;		Was negative, negate remainder
RemPos:	L←XREG XOR T;		Get divisor sign, xor with dividend
	T←AC1, SH<0;		Test sign
	L←0-T, TASK, :QuoPos;
QuoNeg:	AC1←L, :Bran2;		Negate quotient
QuoPos:	:Bran2;			Set PC←AC3 and go to START

; Sq0
; Left shifts data a constant amount, then stores in partial-word field
; in same manner as Snq0.
; Executes @ac1 ← (@ac1 & not @ac3) + ((ac0 lshift n) & @ac3)
; Calling sequence is:
;	lda 0 value (right-justified)
;	lda 1 address of word being stored into
;	jsr 333 - 2*n (n is number of left shifts desired, in range 0-7)
;	 mask word (ones in field being stored into, zeroes elsewhere)
;	returns here

Sq0.7:	L←AC0;
	AC0←L LSH 1;
Sq0.6:	L←AC0;
	AC0←L LSH 1;
Sq0.5:	L←AC0;
	AC0←L LSH 1;
Sq0.4:	L←AC0;
	AC0←L LSH 1;
Sq0.3:	L←AC0;
	AC0←L LSH 1;
Sq0.2:	L←AC0;
	AC0←L LSH 1;
Sq0.1:	L←AC0, TASK;
	AC0←L LSH 1, :Snq0;


; Snq0
; Stores partial-word field into a structure.
; Executes @ac1 ← (@ac1 & not @ac3) + (ac0 & @ac3)
; Calling sequence is:
;	lda 0 value (must be bit-aligned with field being stored into)
;	lda 1 address of word being stored into
;	jsr @360
;	 mask word (ones in field being stored into, zeroes elsewhere)
;	returns here

Snq0:	MAR←AC3;		Fetch mask
	L←AC1;			Address of word being stored into
Snq0a:	T←MD;
	MAR←LREG;		Fetch word being stored into
	AC1←L;			Save address (in case came from Snq1)
	L←MD AND NOT T;		Zero bits to be changed
	MAR←AC1;		Start to store back updated word
	T←AC0.T;		Mask out extraneous bits in new value
	L←LREG+T, TASK;		Merge new bits into old word
	MD←LREG;		Store back in memory
	L←AC3+1, SWMODE, :Start2; PC←AC3+1 and go to START

; Sq1
; Left shifts data a constant amount, then stores in partial-word field
; in same manner as Snq1.
; Executes @ac0 ← (@ac0 & not @ac3) + ((ac1 lshift n) & @ac3)
; Calling sequence is:
;	lda 1 value (right-justified)
;	lda 0 address of word being stored into
;	jsr 334 - 2*n (n is number of left shifts desired, in range 0-7)
;	 mask word (ones in field being stored into, zeroes elsewhere)
;	returns here

Sq1.7:	L←AC1;
	AC1←L LSH 1;
Sq1.6:	L←AC1;
	AC1←L LSH 1;
Sq1.5:	L←AC1;
	AC1←L LSH 1;
Sq1.4:	L←AC1;
	AC1←L LSH 1;
Sq1.3:	L←AC1;
	AC1←L LSH 1;
Sq1.2:	L←AC1;
	AC1←L LSH 1;
Sq1.1:	L←AC1, TASK;
	AC1←L LSH 1, :Snq1;


; Snq1
; Stores partial-word field into a structure.
; Executes @ac0 ← (@ac0 & not @ac3) + ac1 & @ac3
; Calling sequence is:
;	lda 1 value (must be bit-aligned with field being stored into)
;	lda 0 address of word being stored into
;	jsr @360
;	 mask word (ones in field being stored into, zeroes elsewhere)
;	returns here

Snq1:	MAR←AC3;		Fetch mask
	L←AC1;			Get value
	T←AC0;			Get address
	AC0←L, L←T, :Snq0a;	Swap them and join common code

; Load byte from array
; Loads the ac1'th byte from the array pointed to by ac0
; and returns it right-justified in ac0.
; Called by jsr @362
; Note:  ac1 may be negative.

!1,2, Ly01P, Ly01N;
!1,2, Ly01L, Ly01R;

Ly01:	L←AC1;			Get index
	T←AC0, SH<0;		Get address, test for negative index
	MTEMP←L RSH 1, :Ly01P;	[Ly01P, Ly01N] Divide index by 2

Ly01N:	T←77777+T+1;		Negative index, extend sign of index/2
Ly01P:	MAR←MTEMP+T;		Positive index, start fetch
	SINK←AC1, BUSODD;	Which byte?
	T←377, :Ly01L;		[Ly01L, Ly01R]

Ly01L:	L←MD AND NOT T, TASK;	Left byte, mask and swap to right
	AC0←L LCY 8, :Bran2;

Ly01R:	L←MD AND T, TASK, :LtoAC0; Right byte, mask and store


; Load byte from array
; Loads the ac0'th byte from the array pointed to by ac1
; and returns it right-justified in ac1.
; Called by jsr @363
; Note:  ac0 may be negative.

!1,2, Ly10P, Ly10N;
!1,2, Ly10L, Ly10R;

Ly10:	L←AC0;			Get index
	T←AC1, SH<0;		Get address, test for negative index
	MTEMP←L RSH 1, :Ly10P;	[Ly10P, Ly10N] Divide index by 2

Ly10N:	T←77777+T+1;		Negative index, extend sign of index/2
Ly10P:	MAR←MTEMP+T;		Positive index, start fetch
	SINK←AC0, BUSODD;	Which byte?
	T←377, :Ly10L;		[Ly10L, Ly10R]

Ly10L:	L←MD AND NOT T, TASK;	Left byte, mask and swap to right
	AC1←L LCY 8, :Bran2;

Ly10R:	L←MD AND T, TASK;	Right byte, mask and store
	AC1←L, :Bran2;

; Store byte into array
; Stores the byte now contained in frame temp 3 (ac2!3) into
; the ac1'th byte of the array pointed to by ac0.
; Called by jsr@364
; Note:  ac1 may be negative.

!1,2, Sy01P, Sy01N;
!1,2, Sy01L, Sy01R;

Sy01:	L←AC1;			Get index
	T←3, SH<0;		Frame offset, test for negative index
	MAR←AC2+T, :Sy01P;	[Sy01P, Sy01N] Start fetch of byte to store

Sy01N:	MTEMP←L MRSH 1, :Sy01A;	Negative index, divide by 2 and extend sign
Sy01P:	MTEMP←L RSH 1;		Positive index, just divide by 2

Sy01A:	T←MTEMP;		Get word index
	L←AC0+T;		Compute address of word
	T←MD;			Here comes the byte to store
	MTEMP←L;		Save word address
	MAR←MTEMP;		Fetch word being stored into
	SINK←AC1, BUSODD;	Which byte?
Sy01C:	L←377 AND T, T←377, :Sy01L; [Sy01L, Sy01R] Isolate byte being stored

Sy01L:	AC1←L LCY 8;		Storing into left byte, swap halves
	L←MD AND T, :Sy01B;	Zero left byte of word being stored into

Sy01R:	AC1←L;			Storing into right byte, already set up
	L←MD AND NOT T;		Zero right byte of word being stored into

Sy01B:	MAR←MTEMP;		Start store
	T←LREG;			Existing contents to preserve
	L←AC1 OR T, TASK;	Merge old and new bytes
	MD←LREG, :Bran2;	Finish store, then PC←AC3 and go to START


; Store byte into array
; Stores the byte now contained in frame temp 3 (ac2!3) into
; the ac0'th byte of the array pointed to by ac1.
; Called by jsr@365
; Note:  ac0 may be negative.

!1,2, Sy10P, Sy10N;

Sy10:	L←AC0;			Get index
	T←3, SH<0;		Frame offset, test for negative index
	MAR←AC2+T, :Sy10P;	[Sy10P, Sy10N] Start fetch of byte to store

Sy10N:	MTEMP←L MRSH 1, :Sy10A;	Negative index, divide by 2 and extend sign
Sy10P:	MTEMP←L RSH 1;		Positive index, just divide by 2

Sy10A:	T←MTEMP;		Get word index
	L←AC1+T;		Compute address of word
	T←MD;			Here comes the byte to store
	MTEMP←L;		Save word address
	MAR←MTEMP;		Fetch word being stored into
	SINK←AC0, BUSODD, :Sy01C; Which byte? Join common code