insert[d0lang];
insert[GlobalDefs];

TITLE [Halftone -- April 3, 1980 7:52 AM];

* Floyd-Steinberg error distribution halftoning,
*"REPLACE" mode, doesn’t work for all modes (save space)

SET TASK[0];
ONPAGE[InitPage];

* Registers for test program
* Available Temps: 40-53 56-57, 64, 66-67, 72-73
* Available Unused: 14, 70-71
RV [nInputPixels,40];
RV [blackVal,41];
RV [range,42];
RV [nOutputDots,43];

RV [errorVec,44];
RV [errorVecHi,45];
RV [screenWord,46];
RV [screenWordHi,47];

RV [bitCount,50];
RV [bitmapWidth,51];
RV [pixelArray,52];
RV [pixelArrayHi,53];

RV [AddrTemp,10]; *same as Stack7
RV [AddrTempHi,11];
RV [CascadeRight,56];
RV [CascadeDiag,57];
RV [errorTemp,72];
RV [bitval,66];
RV [jctr,67];
RV [x,70];
RV [val,71];

RV [returnLoc,73],

* New names for standard registers

* At locations

SET [PrintLine,ADD[LSHIFT[InitPage,10],000]];* Starting location
SET [bLoc,ADD[LSHIFT[InitPage,10],020]];*
SET [modeLoc,ADD[LSHIFT[InitPage,10],040]];*
SET [modeLoc1,ADD[LSHIFT[InitPage,10],060]];*


* halftone stuff
AT[PrintLine], AddrTempHi ← (0c);
T ← Stack;
AddrTemp ← T;
PFetch4[AddrTemp,errorVec,4];
useCTask;
T ← APC&APCTask;
returnLoc ← T;
PFetch4[AddrTemp,bitCount,10];
T ← LSH[errorVecHi,10],TASK;
errorVecHi ← (errorVecHi)+T+1;
T ← LSH[screenWordHi,10];
screenWordHi ← (screenWordHi)+T;*no +1, for negative adds;
PFetch4[AddrTemp,nInputPixels,0],TASK;
T ← LSH[pixelArrayHi,10];
DISPATCH[bitCount,14,4];
pixelArrayHi ← (pixelArrayHi)+T+1,DISP[b0];
*bit selection dispatch table
b0:bitval ← (100000c),GOTO[b20],AT[bLoc,0];
b1:bitval ← (40000c),GOTO[b20],AT[bLoc,1];
b2:bitval ← (20000c),GOTO[b20],AT[bLoc,2];
b3:bitval ← (10000c),GOTO[b20],AT[bLoc,3];
b4:bitval ← (4000c),GOTO[b20],AT[bLoc,4];
b5:bitval ← (2000c),GOTO[b20],AT[bLoc,5];
b6:bitval ← (1000c),GOTO[b20],AT[bLoc,6];
b7:bitval ← (400c),GOTO[b20],AT[bLoc,7];
b10:bitval ← (200c),GOTO[b20],AT[bLoc,10];
b11:bitval ← (100c),GOTO[b20],AT[bLoc,11];
b12:bitval ← (40c),GOTO[b20],AT[bLoc,12];
b13:bitval ← (20c),GOTO[b20],AT[bLoc,13];
b14:bitval ← (10c),GOTO[b20],AT[bLoc,14];
b15:bitval ← (4c),GOTO[b20],AT[bLoc,15];
b16:bitval ← (2c),GOTO[b20],AT[bLoc,16];
b17:bitval ← (1c),GOTO[b20],AT[bLoc,17];
b20: T ← bitCount;
PFetch1[errorVec,CascadeRight];
T ← nOutputDots;
jctr ← (zero) - T;
CascadeDiag ← (zero);
CascadeRight ← (LSH[CascadeRight,2])-1;
T ← nInputPixels;
Stack4 ← T;
T ← LDF[bitmapWidth,4,1];
nInputPixels ← (nInputPixels) + T;
x ← T,GOTO[forX0];

*subroutines: pieces used by all four modes
GetPixel:
T ← RSH[x,1],GOTO[xDone,ALU<0];
PFetch1[pixelArray,val];
T ← blackVal;
LU ← x,GOTO[xOdd,R ODD];
xEven:val ← T ← (RSH[val,10]) - T,GOTO[blackCheck];
xOdd: val ← T ← (RHMask[val]) - T,GOTO[blackCheck];
blackCheck: LU ← (range) - T,GOTO[blackOK,ALU>=0];
val ← (zero),RETURN;
blackOK: T ← range,GOTO[whiteOK,ALU>=0];
val ← T,RETURN;
whiteOK: RETURN;
OrBlack:
PFetch1[screenWord,Stack6];
T←bitVal;
Stack6 ← (Stack6) OR T,RETURN;
NotWhite:
PFetch1[screenWord,Stack6];
T←bitVal;
Stack6 ← (Stack6) AND NOT T,RETURN;
StoreVal:PStore1[screenWord,Stack6],RETURN;
GetError:
CascadeRight ← (RSH[CascadeRight,1]) OR T,GOTO[a1,R ODD];
a0:T ← (RSH[CascadeRight,1]) OR T,GOTO[a00,R EVEN];
a01:CascadeRight ← (CascadeRight) + 1;
a00:errorTemp ← T,GOTO[haveError];
a1:T ← (RSH[CascadeRight,1]) OR T,GOTO[a10,R EVEN];
a11:errorTemp ← T ← (zero) + T + 1,GOTO[haveError];
a10:CascadeRight ← (CascadeRight) + 1,GOTO[a00];
haveError:CascadeDiag ← (CascadeDiag) + T;
T ← bitCount;
PStore1[errorVec,CascadeDiag],RETURN;
GetNext:
PFetch1[errorVec,Stack6];
T ← errorTemp;
CascadeDiag ← T;
T ← Stack6;
CascadeRight ← (CascadeRight)+T;
T ← Stack4,RETURN;
xDone:
APC&APCTask ← returnLoc;
RETURN;

forX0:
LU ← (nInputPixels) - T - 1,CALL[GetPixel]; *5 instrs
T ← jctr,GOTO[jDone0,R>=0];
whileJ0:
T ← val;
CascadeRight ← (CascadeRight)+T;
T←range,GOTO[White0,ALU>=0];
Black0: T ← LDF[bitCount,0,14],CALL[OrBlack];*3 instrs
T ← LDF[bitCount,0,14],CALL[StoreVal];*1 instr
EndDot0:
T ← (CascadeRight) AND (100000c),CALL[GetError]; *6.5 instrs
bitCount ← T ← (bitCount) + 1,CALL[GetNext]; *6 instrs
jctr ← (jctr) + T;
bitVal ← RCY[bitVal,1],GOTO[whileJ0,ALU<0];
jDone0:
T ← nOutputDots;
jctr ← (jctr) - T;
x ← T ← (x) + 1,GOTO[forX0]; *could save 7 instructions if jctr still negative
White0: CascadeRight ← (CascadeRight) - T;
T ← LDF[bitCount,0,14],CALL[NotWhite];*3 instrs
T ← LDF[bitCount,0,14];*1 instr
PStore1[screenWord,Stack6],GOTO[EndDot0];
%
the rest of this stuff is deleted for space with jasmine code

forX1:
LU ← (nInputPixels) - T - 1,CALL[GetPixel]; *5 instrs
T ← jctr,GOTO[jDone1,R>=0];
whileJ1:
T ← val;
CascadeRight ← (CascadeRight)+T;
T←range,GOTO[White1,ALU>=0];
Black1: T ← LDF[bitCount,0,14],CALL[OrBlack];*3 instrs
T ← LDF[bitCount,0,14],CALL[StoreVal];*1 instr
EndDot1:
T ← (CascadeRight) AND (100000c),CALL[GetError]; *6.5 instrs
bitCount ← T ← (bitCount) - 1,CALL[GetNext]; *6 instrs
jctr ← (jctr) + T;
bitVal ← LCY[bitVal,1],GOTO[whileJ1,ALU<0];
jDone1:
T ← nOutputDots;
jctr ← (jctr) - T;
x ← T ← (x) + 1,GOTO[forX1]; *could save 7 instructions if jctr still negative
White1: CascadeRight ← (CascadeRight) - T;
T ← LDF[bitCount,0,14],CALL[NotWhite];*3 instrs
T ← LDF[bitCount,0,14];*1 instr
PStore1[screenWord,Stack6],GOTO[EndDot1];

forX2:
LU ← (nInputPixels) - T - 1,CALL[GetPixel]; *5 instrs
T ← jctr,GOTO[jDone2,R>=0];
whileJ2:
T ← val;
CascadeRight ← (CascadeRight)+T;
T←LDF[bitmapWidth,5,13],GOTO[White2,ALU>=0];
Black2: Stack5 ← T ← (Stack5) - T,CALL[OrBlack];*3 instrs
T ← Stack5,CALL[StoreVal];*1 instr
EndDot2:
T ← (CascadeRight) AND (100000c),CALL[GetError]; *6.5 instrs
bitCount ← T ← (bitCount) + 1,CALL[GetNext]; *6 instrs
jctr ← (jctr) + T;
GOTO[whileJ2,ALU<0];
jDone2:
T ← nOutputDots;
jctr ← (jctr) - T;
x ← T ← (x) + 1,GOTO[forX2]; *could save 7 instructions if jctr still negative
White2: Stack5 ← (Stack5) - T;
T ← range;
CascadeRight ← (CascadeRight) - T;
T ← LDF[bitCount,0,14],CALL[NotWhite];*3 instrs
T ← LDF[bitCount,0,14];*1 instr
PStore1[screenWord,Stack6],GOTO[EndDot2];

forX3:
GOTO[xDone];
END;

LU ← (nInputPixels) - T - 1,CALL[GetPixel]; *5 instrs
T ← jctr,GOTO[jDone3,R>=0];
whileJ3:
T ← val;
CascadeRight ← (CascadeRight)+T;
T←LDF[bitmapWidth,5,13],GOTO[White3,ALU>=0];
Black3: Stack5 ← T ← (Stack5) + T,CALL[OrBlack];*3 instrs
T ← Stack5,CALL[StoreVal];*1 instr
EndDot3:
T ← (CascadeRight) AND (100000c),CALL[GetError]; *6.5 instrs
bitCount ← T ← (bitCount) + 1,CALL[GetNext]; *6 instrs
jctr ← (jctr) + T;
GOTO[whileJ3,ALU<0];
jDone3:
T ← nOutputDots;
jctr ← (jctr) - T;
x ← T ← (x) + 1,GOTO[forX3]; *could save 7 instructions if jctr still negative
White3: Stack5 ← (Stack5) + T;
T ← range;
CascadeRight ← (CascadeRight) - T;
T ← LDF[bitCount,0,14],CALL[NotWhite];*3 instrs
T ← LDF[bitCount,0,14];*1 instr
PStore1[screenWord,Stack6],GOTO[EndDot3];

%