;-----------------------------------------------------------------
; Adpcm.mu -- Microcode source for Alto running
;	16 Kilobit Adaptive Predictive PCM.
; Last modified by L. Stewart August 28, 1979  9:22 PM
;-----------------------------------------------------------------

; Microcode subroutines are defined and called from Mesa programs
; as shown in the following example:

; routineAddr: CARDINAL = 400B;  -- Ram address of microcode --
; CalluRoutine: PROCEDURE[x, y: REAL] RETURNS [z: REAL] =
;   MACHINE CODE BEGIN
;   Mopcodes.zLIW, routineAddr/256, routineAddr MOD 256;
;   Mopcodes.zJRAM;
;   END;

; [] _ CalluRoutine[a, b];  -- the call --

; All these routines assume they are called with a clean stack.
; Hence, an invocation such as "[] _ CalluRoutine[a, b]" must be
; written as a complete statement, not as an embedded expression.
; If the routine returns a value, it must be called in a statement
; of the form "simpleVariable _ Routine[args]".
; This permits the Ram subroutine to access fixed S-registers for
; arguments and return values.  It must still adjust the stack 
; pointer appropriately, however.

; Ram entry vector, for access via Mesa JRAM instruction.
; Note that only Ram locations 400-777 and 1400-1777 are reachable from Rom1.

%1,1777,560,EnCode;	8 bit to 2 bit
%1,1777,561,DeCode;	2 bit to 8 bit

$LastL	$R40;	M register

$SubRet	$R41;	mask
$APTemp	$R5;	count
$QLLev	$R7;	taskhole
$QHLev	$R50;	unused3
$Brkpt	$R36;	temp2
$Sign	$R57;	XTPreg

$IBufp	$R60;	stk0
$OBufp	$R61;	stk1
$Count	$R62;	stk2
$CBPtr	$R63;	stk3

$BTabs	$R42;	unused1
$QTabs	$R43;	unused2
$PTab	$R44;	alpha
$Pred	$R35;	temp

$Nowp	$R55;	ATPreg
$Hist	$R64;	stk4
$PVal	$R1;	mx
$Bits	$R2;	saveret
$Val	$R3;	newfield
$QMode	$R56;	OTPreg

;---------------------------------------------------------------
; ADPCM
;---------------------------------------------------------------
!1,2,InitRet0,InitRet1;	Subroutine returns
!1,2,ComRet0,ComRet1;

;---------------------------------------------------------------
; Initialization
;
;	IBufp:	POINTER,   (stk0)
;	OBufp:	POINTER,   (stk1)
;	Count:	CARDINAL,   (stk2)
;
; Expects pointer to control block in stk3
;
; CB: TYPE = RECORD
;	[
;	BTabs:	POINTER,
;	QTabs:	POINTER,
;	PTab:	POINTER,
;	Pred:	INTEGER,
;	QMode:	CARDINAL
;	Nowp:	CARDINAL,
;	Hist:	INTEGER,
;	PVal:	CARDINAL,
;	]
;---------------------------------------------------------------

InitRegs:	SubRet_L;
	MAR_L_CBPtr;
	APTemp_L;
	L_MD,TASK;
	BTabs_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	QTabs_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	PTab_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	Pred_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	QMode_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	Nowp_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	Hist_L;

	MAR_L_APTemp+1;
	APTemp_L;
	L_MD,TASK;
	PVal_L;

; Fetch mode register contents
	T_QMode;
	MAR_BTabs+T;
	L_QTabs+T;
	APTemp_L;
	L_MD,TASK;
	Brkpt_L;(0,5376)(1,11264)\f1
	MAR_APTemp;
	T_377;
	L_T_MD AND T;	(T_MD, L_MD AND 377)
	QHLev_L;
	L_177400 AND T,TASK;
	QLLev_L LCY 8;

	SINK_SubRet,BUS,TASK;
	NOP,:InitRet0;

;---------------------------------------------------------------
; Save Algorithm state and return
; 
; Stuff to save:
; Pred, QMode, Nowp, Hist, PVal
;---------------------------------------------------------------

SaveRet:	T_CBPtr;
	MAR_L_3+T;
	APTemp_L,TASK;
	MD_Pred;

	MAR_L_APTemp+1;
	APTemp_L,TASK;
	MD_QMode;

	MAR_L_APTemp+1;
	APTemp_L,TASK;
	MD_Nowp;

	MAR_L_APTemp+1;
	APTemp_L,TASK;
	MD_Hist;

	MAR_L_APTemp+1;
	APTemp_L,TASK;
	MD_PVal;

; returns control to emulator in Rom1

	L_3,TASK;	most general return (Return&TASK)
	stkp_L;
	SWMODE;	Switch to Rom1
	L_T_0,:romnextA;	Mesa emulator entry point

;---------------------------------------------------------------
; Encode
;---------------------------------------------------------------
!1,2,EnMore,EnDone;
!1,2,EnLeft,EnRight;

EnCode:	L_0,TASK,:InitRegs;
InitRet0:	NOP;
EnLoop:	MAR_IBufp;
	L_Count-1,BUS=0;
	Count_L,:EnMore;	!1,2,EnMore,EnDone;
EnMore:	SINK_Nowp,BUSODD;	even or odd byte?
	L_MD,:EnLeft;	!1,2,EnLeft,EnRight;

EnLeft:	T_377;
	L_LastL AND NOT T,TASK;	even is left byte
	Val_L LCY 8,:EnSExt;
EnRight:	T_377;
	L_LastL AND T,TASK;
	Val _ L;
	L_IBufp+1,TASK;
	IBufp_L,:EnSExt;

; Convert 8 bit two's complement to sign magnitude

!1,2,EnPos,EnNeg;

EnSExt:	T_Val;
	L_177-T;	SH<0 if Val>=200B
	L_177400 OR T,SH<0;	Val extended with 1's
	T_Pred,:EnPos;	!1,2,EnPos,EnNeg;

EnNeg:	Val_L;	Use the extended value, if Val was IN[200..377]
EnPos:	L_Val-T;	Compute error

; at this point, error is two's complement, we need SM

!1,2,EnPos2,EnNeg2;
	Val_L,SH<0;	save error
	T_Val,:EnPos2;	!1,2,EnPos2,EnNeg2;

EnPos2:	L_0,TASK,:EnSgn;
EnNeg2:	L_0-T;	Store 0-Val in Val (now positive)
	Val_L,L_0-1,TASK,:EnSgn;	Sign _ -1
EnSgn:	Sign_L,:Quant;	Quantize Error

;---------------------------------------------------------------
; Quant Algorithm
;
; Expects current mode set up in registers,
;    input value in Val,,Sign as sign magnitude.
; Returns output in Bits.
; code:  3 -QHLev, 2 -QLLev, 0 QLLev, 1 QHLev
;---------------------------------------------------------------
!1,2,Qlo,Qhi;
!1,2,QNeg,QPos;

Quant:	T_Val;
	L_Brkpt-T;
	NOP,SH<0;
	SINK_Sign,BUS=0,:Qlo;	!1,2,Qlo,Qhi;

Qlo:	L_T_0,:QNeg;	!1,2,QNeg,QPos;
Qhi:	L_T_ONE,:QNeg;	!1,2,QNeg,QPos;

QNeg:	L_2 OR T;
QPos:	Bits_L;\f1

; At this point, the Quantizer codeword is in Bits...
; We call the common code

	L_0,TASK,:AdpcmCom;

;	Now we must pack Bits into running sum...
ComRet0:	L_PVal,TASK;	left shift PVal 2 bits
	PVal_L LSH 1;
	L_PVal,TASK;
	PVal_L LSH 1;
	T_Bits;	OR in Bits
	L_PVal OR T;

!1,2,EnELoop,EnStore;

	SINK_Nowp,BUS=0,TASK;
	PVal_L,:EnELoop;	!1,2,EnELoop,EnStore;

EnStore:	L_OBufp+1;
	MAR_OBufp;
	OBufp_L;
	L_0;	no good reason to clear PVal
	MD_PVal,TASK;
	PVal_L,:EnELoop;

!1,2,EnInt,EnNoInt;

EnELoop:	SINK_NWW,BUS=0;
	TASK,:EnInt;	!1,2,EnInt,EnNoInt;
EnNoInt:	NOP,:EnLoop;
EnInt:	NOP,:SaveRet;
EnDone:	NOP,:SaveRet;

;---------------------------------------------------------------
; DeCode
;---------------------------------------------------------------
!1,2,DeMore,DeDone;
!1,2,DeWMore,DeWFetch;

DeCode:	L_ONE,TASK,:InitRegs;	initialize R & S registers
InitRet1:	NOP,:DeLoop;

DeLoop:	L_Count-1,BUS=0,TASK;
	Count_L,:DeMore;	!1,2,DeMore,DeDone

; If the (Modulo 8) counter Nowp is 0, it is time to fetch a new word.
DeMore:	SINK_Nowp,BUS=0;
DeLoop1:	L_T_PVal,:DeWMore;	!1,2,DeWMore,DeWFetch;

DeWFetch:	MAR_OBufp;	Fetch a new word (when Nowp=0)
	L_OBufp+1;
	OBufp_L;
	L_MD,TASK;
	PVal_L,:DeLoop1;

DeWMore:	PVal_L LSH 1,L_0;	double shift to get left 2 bits of PVal
	Bits_L MLSH 1;
	L_T_PVal;
	PVal_L LSH 1;
	L_Bits,TASK;
	Bits_L MLSH 1;	assert: Bits is IN[0..3]

; at this point, we can call the common code

	L_ONE,TASK,:AdpcmCom;

; On return from the Common code, the decompressed sample is in Val
; as Excess 200B, but we need 8 bit two's complement to satisfy the audio board.
; Conversion algorithm is subtract 200B and mask.
ComRet1:	T_177577;	(-201B)
	T_Val+T+1;	T_Val-200B = Val+(-201B)+1
	L_377 AND T,TASK;
	Val_L;

; DeCode differs from EnCode in that NewQMode has already been called by
; this (access to uncompressed data) part of the loop. Thus here, an ODD
; value of Nowp means left half and an EVEN value means right side and
; increment IBufp

!1,2,DeRight,DeLeft;

	SINK_Nowp,BUSODD;
	MAR_IBufp,:DeRight;	!1,2,DeRight,DeLeft;

DeLeft:	L_Val;	Store Val to left byte, 0 to right
	Val_L LCY 8;
	MD_Val,:DeELoop;

DeRight:	T_Val;
	L_MD OR T,TASK;	Read old (left) half, and build complete word
	Val_L;
	MAR_IBufp;
	L_IBufp+1;	Increment IBufp
	IBufp_L,TASK;
	MD_Val,:DeELoop;

!1,2,DeInt,DeNoInt;

DeELoop:	SINK_NWW,BUS=0;
	TASK,:DeInt;	!1,2,DeInt,DeNoInt;
DeInt:	NOP,:SaveRet;
DeNoInt:	NOP,:DeLoop;
DeDone:	NOP,:SaveRet;

;---------------------------------------------------------------
; Common code for
; 1) Converting codeword to Quantizer output level
; 2) Updating current quantizer mode
; 3) Updating Predictor value
; Expects current Quantizer level in Bits, current time in Nowp
; Expects current modes values in QLLev, QHLev, Brkpt.
;---------------------------------------------------------------

;---------------------------------------------------------------
; DeQuant Algorithm
;
; Returns output in Val as 16 bit two's complement.
; Bits had better only have a number IN [0..3] on entry...
;---------------------------------------------------------------
!3,4,QL0,QL1,QL2,QL3;

AdpcmCom:	SubRet_L;	Save return pointer
	L_Bits,BUS;
	T_QLLev,:QL0;	!3,4,QL0,QL1,QL2,QL3;

QL0:	L_QLLev,TASK,:DQCom;
QL1:	L_QHLev,TASK,:DQCom;
QL3:	T_QHLev,:QL2;
QL2:	L_0-T,TASK,:DQCom;

DQCom:	Val_L,:NewQMode;	(Val_DeQuant(bits))

;---------------------------------------------------------------
; New QMode algorithm
; And common code for updating Predictor value
; Expects current Quantizer level in Bits, current time in Nowp
;---------------------------------------------------------------

; Determine mode switching
; Hist: 0 Bits: 2  => Decrement mode
; Hist: 2 Bits: 0  => Decrement mode
; Hist: 1 Bits: 1  => Increment mode
; Hist: 3 Bits: 3  => Increment mode

!1,2,He,Ho;
!1,2,HeBe,HeBo;
!1,2,HoBe,HoBo;

NewQMode:	T_Nowp+1;
	L_7 AND T,TASK;
	Nowp_L;
	T_Hist,BUSODD;
	L_Bits-T,BUSODD,:He;	!1,2,He,Ho;
He:	L_Bits,TASK,SH=0,:HeBe;	!1,2,HeBe,HeBo;
Ho:	L_Bits,TASK,SH=0,:HoBe;	!1,2,HoBe,HoBo;

!1,1,MSame;	squash branch
!1,2,MDown,MDNil;
!1,2,MUNil,MUp;

HeBe:	Hist_L,:MDown;	!1,2,MDown,MDNil;
HeBo:	Hist_L,:MSame;
HoBe:	Hist_L,:MSame;
HoBo:	Hist_L,:MUNil;	!1,2,MUNil,MUp;

MDNil:	T_Pred,:MDone1;
MUNil:	T_Pred,:MDone1;
MSame:	T_Pred,:MDone1;

!1,2,MDCom,MLLimit;

MDown:	L_T_QMode-1,BUS=0;
	NOP,:MDCom;	!1,2,MDCom,MLLimit;
MDCom:	QMode_L,:MFetch;	now fetch new
MLLimit:	T_Pred,:MDone1;

!1,2,MUCom,MULimit;

MUp:	T_QMode;
	L_14-T;	swing - if T>=13 (dec)
	L_T_QMode+1,SH<0;
	NOP,:MUCom;	!1,2,MUCom,MULimit;
MUCom:	QMode_L,:MFetch;	now fetch new
MULimit:	T_Pred,:MDone1;

MFetch:	MAR_BTabs+T;	T has new QMode
	L_QTabs+T;
	APTemp_L;
	L_MD,TASK;
	Brkpt_L;
	MAR_APTemp;
	T_377;
	L_T_MD AND T;	(T_MD, L_MD AND 377)
	QHLev_L;
	L_177400 AND T,TASK;
	QLLev_L LCY 8,:MDone;

; Now we have to do the prediction
MDone:	T_Pred;
MDone1:	L_Val+T,TASK;	L has Pred+DeQuant(Bits)
	Val_L;
;  Val has a 16 bit TC value, we need to limit it to the range [-128..127]
;  and convert to Excess 200B.  We do this in one operation, by adding 200B
;  and limiting to [0..377B].


!1,2,PrNoUF,PrUF;
!1,2,PrOv,PrOk;

	T_Val;
	L_T_177+T+1;
; If result of this add is still <0, Val was <-128 to start with...
; Now we check to see whether any bits outside [0..377B] range are on.
	L_177400 AND T,SH<0;
	L_T,SH=0,:PrNoUF;	(L_Val+200B) !1,2,PrNoUF,PrUF;
PrNoUF:	Val_L,:PrOv;	!1,2,PrOv,PrOk;

!1,1,PrOv1;		squash branch
PrUF:	L_0,:PrOv1;
PrOv:	L_377,:PrOv1;
PrOv1:	Val_L;

; At this point, the excess 200B value is in both L and Val.
PrOk:	APTemp_L RSH 1;
	T_APTemp;	compute PTab word address
	L_PTab+T,TASK;
	APTemp_L;

!1,2,PrEven,PrOdd;

	MAR_APTemp;	Start PTab access
	SINK_Val,BUSODD;
	T_377,:PrEven;	!1,2,PrEven,PrOdd;
PrEven:	L_MD AND NOT T,TASK;	Even is left byte
	Pred_L LCY 8,:PrSave;
PrOdd:	L_MD AND T,TASK;	Odd is right byte
	Pred_L,:PrSave;
PrSave:	T_200;
	L_Pred-T;	convert excess 200B to TC
	SINK_SubRet,BUS,TASK;
	Pred_L,:ComRet0;

; At exit, APTemp holds correct PTab word address
; and Val has correct Excess 200 version of data (output for DeCode)
\f1