;D0 parameter list
;Microcode for Floyd/Steinberg halftone algorithm

$10000	$10000;
$4000	$4000;
$s1				$R01;	R register for ALU action after TASK: address of next word in s1
$val				$R02;	R reg for shift: value of next data point stored here
$CascadeRight	$R03;	error propogation to the right (R Reg for initial shift)
$error				$R05;	R register for shift
$error1			$R07;	R register for shift: error rshift 1

$xctr				$R41;	loop counter across x for reading input points
$black			$R42;	minimum value of data 
$range			$R43;	max-min
$CurrentBits		$R44;
$BitCount		$R45;
$byteptr			$R51;
$CascadeDiag	$R55;	error propogation diagonally right
$GETS			$R56;	address of next sample point in datavec

;stuff here that needs to stay around
$jctr				$R71;	counter for repeating/deleting pts in x dir
$bitOffset		$R72;  bit number of first output bit in first output word (0=leftmost)
$outpts			$R73;	number of points to put out per line
$inpts				$R74;	number of input points per line
$Screen			$R75;

;---------------------------------------------------------------
;first stuff appropriate S registers with input params
;---------------------------------------------------------------
;Print(inpts,black,range,outpts,s1,s1bank,screen,screenbank,bitOffset,
;	[mode,xOdd,distance],pixelArray,pixelBank)
print:   MAR_L_stk0;
	L_stkp-1;	reset stack pointer (1 element in, 0 out)
	stkp _ L;
	L_MD,TASK;
	inpts_L;
	NOP;	TASK RETURNS HERE: stk0 instruction uses ALU_SReg

	MAR_L_stk0+1;
	stk0_L;
	L_MD,TASK;
	black_L;

	NOP;	TASK RETURNS HERE: stk0 instruction uses ALU_SReg
	MAR_L_stk0+1;
	stk0_L;
	L_T_MD;
	L _ LREG+T; range*2
	range_L;
	T_range;
	L_range+T,TASK;range*4
	range_L;
	
	NOP;	TASK RETURNS HERE: stk0 instruction uses ALU_SReg
	MAR_L_stk0+1;
	stk0_L;
	L_MD,TASK;
	outpts_L;

	T_outpts;
	L_0-T,TASK;
	jctr_L;

	NOP;	TASK RETURNS HERE: stk0 instruction uses ALU_SReg
	MAR_L_stk0+1;
	stk0_L;
	L_MD-1,TASK;	we increment on the first store
	s1_L;

	T _ 2; skip bank (must be 0)
	MAR_L_stk0+T;
	stk0_L;
	L_MD,TASK;
	Screen_L;

	MAR _ 177740;	--bank register for task 0 (emulator)
	NOP;
	L _ MD;
	stk1 _ L; --savedbank

	MAR_L_stk0+1;
	stk0_L;
	L_MD;	
	MAR _ 177740;
	val _ L,TASK;
	MD _ val; --bitmap bank

	NOP;	TASK RETURNS HERE: stk0 instruction uses ALU_SReg
	MAR_L_stk0+1;
	stk0_L;
	T _ 17;
	L_MD,TASK;
	val_L RSH 1;
	L _ val,TASK;
	val _ L RSH 1;
	L _ val,TASK;
	val _ L RSH 1;
	L _ val,TASK;
	val _ L RSH 1;
	T _ val-1;
	MAR_stk0;
	L _ Screen+T;
	Screen_L;	
	T _ 17;
	L _ MD AND T,TASK;
	bitOffset _ L;

;skip "distance"
	T _ 2;
	MAR_stk0+T;
	L_inpts;
	xctr_L;
	L _ MD,TASK;
	GETS _ L;

;---------------------------------------------------------------
;do the work
;---------------------------------------------------------------

!1,2,jdone,jloop;
!1,2,xloop,xdone;
!1,2,xloopL,xloopR;
!1,2,pos,neg;
!1,2,NoPut,PutWord;


	;NOTE: error in from s1!0 is 1/4 range, so we multiply by 4 to keep the first line honest
	;CascadeRight=(s1!0)*2
	MAR_L_s1+1;
	NOP;
	L_MD,TASK;
	CascadeRight_L LSH 1;
	L_CascadeRight,TASK;
	CascadeRight_L LSH 1;

	L_0;
	CurrentBits_L;
	CascadeDiag_L,TASK;
	byteptr_L;

;read the initial word, and mask out the bits from bitOffset on (unless bit Offset = 0)
!1,2,getPriorBits,noPriorBits;

	L_T_bitOffset;
	L_20-T,SH=0;
	BitCount_L,:getPriorBits;		1,2,getPriorBits,noPriorBits

getPriorBits:	L_BitCount-1;
	T_LREG;
	MAR_MASKTAB+T;
	NOP;
	L_MD;

	XMAR_Screen+1;
	T_LREG;
	L_MD AND NOT T,TASK;
	CurrentBits_L;

noPriorBits:	L_T_0;

	;for i=1 to x do
	;let val=(GETS(picfile)-black) lshift 2
xloop:  L_ONE XOR T;
	byteptr_L,SH=0;
	MAR_GETS,:xloopL;

xloopL: T_177400;
	L_MD AND T;
	temp_L LCY 8;
	L_temp,:GETdone;

xloopR: L_GETS+1;
	GETS_L;
	T_377;
	L_MD AND T;

GETdone:T_black;
	L_LREG-T,TASK;

	val_L LSH 1;
	L_val,TASK;
	val_L LSH 1;

!1,2,SetBit,NoSetBit;	
	;while jctr ls 0 do
	L_jctr;
whilej:	T_val,SH<0;
	L_CascadeRight-T,:jdone;

	;test (CascadeRight-val) ls 0 then [ error=error+range] or SetBit()
jloop: 	error_L,SH<0;
	T_range,:SetBit;
NoSetBit:	L_error+T;

SetBitReturn:	T_0,SH<0;
	error_L MRSH 1,:pos;	do shift assuming positive (right half the time)
neg:	T_ONE;

	;error=error rshift 1	//arithmetic shift
	error_L MRSH 1;

	;error1=error rshift 1	//arithmetic shift
pos:	L_error,TASK;	************************************************************
	error1_L MRSH 1;

	;s1!index=CascadeDiag+error1
	L_s1+1;
	s1_L;
	MAR_s1;
	T_error1;
	L_CascadeDiag+T,TASK;	
	MD_LREG;

	;CascadeRight=s1!index+error
	;CascadeDiag=error1
	MAR_s1+1;
	L_error1;
	CascadeDiag_L;
	T_error;		TASK here  bombs
	L_MD+T;
	CascadeRight_L;

	L_BitCount-1;
	BitCount_L,SH=0;
	T_inpts,:NoPut;

PutWord:
	L_Screen+1;
	Screen _ L;
	XMAR_Screen;
	L_20;
	BitCount_L,TASK;	
	MD_CurrentBits;
	L_0;
	CurrentBits_L;
	T_inpts;

NoPut:	L_jctr+T;	no task here: SH not preserved
	jctr_L,:whilej;

jdone:  T_outpts;
	L_jctr-T,TASK;
	jctr_L;
	NOP;	TASK RETURNS HERE: next instruction uses ALU_SReg

	L_xctr-1;
	xctr_L,SH=0;
	T_byteptr,:xloop;

;put out last word,reset Screen
;if BitCount=20 then done
;otherwise, read previous value of Screen!1
; mask out the first (20-BitCount) bits
; OR in CurrentBits
; write out 

!1,2,workHard,easyTimeTime;
xdone: T_BitCount;
	L_17-T;
	L_BitCount-1,SH<0;
	T_LREG,:workHard;		!1,2,workHard,easyTimeTime;

workHard: MAR_MASKTAB+T;	first pick up the mask
	NOP;
	T_MD;

	XMAR_Screen+1;	now, the previous value
	TASK;
	L_MD AND T;
	
	XMAR_Screen+1;	and store it  back
	T_CurrentBits;
	L_LREG OR T;	LREG has (prev contents)&mask
	MD_LREG;

easyTimeTime: MAR _ 177740;
	L_0;
	stkp_L,SWMODE;
	MD _ stk1,:romnextA; --saved bank reg

;---------------------------------------------------------------
;setbit turns the bit (index&#17) on.
;---------------------------------------------------------------
!37,40,GetBit,GetB1,GetB2,GetB3,GetB4,GetB5,GetB6,GetB7,GetB10,GetB11,GetB12,GetB13,GetB14,GetB15,GetB16,GetB17,GetB20;
	;CurrentBits=CurrentBits % (#100000 rshift (index&#17))

SetBit: SINK_BitCount,BUS;	BitCount is between 20 and 1
	T_CurrentBits,:GetBit;
GetBit:	NOP;
GetB20:  L_100000 OR T,TASK,:HaveBit;
GetB17:  L_40000 OR T,TASK,:HaveBit;
GetB16:  L_20000 OR T,TASK,:HaveBit;
GetB15:  L_10000 OR T,TASK,:HaveBit;
GetB14:  L_4000 OR T,TASK,:HaveBit;
GetB13:  L_2000 OR T,TASK,:HaveBit;
GetB12:  L_1000 OR T,TASK,:HaveBit;
GetB11:  L_400 OR T,TASK,:HaveBit;
GetB10:  L_200 OR T,TASK,:HaveBit;
GetB7:  L_100 OR T,TASK,:HaveBit;
GetB6:  L_40 OR T,TASK,:HaveBit;
GetB5:  L_20 OR T,TASK,:HaveBit;
GetB4:  L_10 OR T,TASK,:HaveBit;
GetB3:  L_4 OR T,TASK,:HaveBit;
GetB2:  L_2 OR T,TASK,:HaveBit;
GetB1:  L_ONE OR T,TASK,:HaveBit;
HaveBit: CurrentBits_L;

	L_error,:SetBitReturn;
(635)\f1 1217b6B8b10B11b44B1010b1B