[_cd8_]<press>pressmc.dm!1>ScanMc.mu

;; Press Microcode -- "Scan Microcode" (Scan conversion pass)

; last modified by Butterfield, September 29, 1980 4:22 PM
; - change TRP10 and TRP11 end tests to be SH=0 - 9/29
; - ScanPutChar(TRP1), don’t mask down BELOChar.Bit - 8/8
; - add TRP10 and TRP11 dispatches - 3/18
; - include DispatchMc.mu inline and start to re-work it - 3/18
; - get lastMask using rightMask1 - 3/7
; - bum a word at TRP2 - 3/5/80

%0, 1777, 23, LOC23;Used by RdRAM
%0, 1777, 24, LOC24;and WriteRam in ScanConvert
%0, 1777, 37, TRAP1;RAM trap location
$LREG$R40;
#TriConMc.Mu;

; Additional emulator definitions
$AC2$R1;
$AC3$R0;
$PC$R6;
$XREG$R7;
$TEMP$R5;Shared with SAD

$400$400;

;R register availability:
; R10
; (R14 used by disk)
; R15-R17
; R35-R36
;
;S register availability:
; (R40 = last L in RAM)
; R41-R56 -- used by Slot, but can be re-used if Slot off.
; (R71-R76 used by disk)
; (R77 unusable)

; Notation:
;** means TASK break may happen after this instruction
;Note that an instruction line with ** may NOT have
;branch conditions or BUS (i.e., anything that alters NEXT)
;!a,b means the label a (which is the goto of this instruction)
;is in a branch table with b.
;
;********************************************************************
; Trap handling stuff (copied from Ingalls)
; If trap is 70000 + disp field, this is a trap for us; dispatch
; on low order 3 bits to TRP0-TRP7. Otherwise, return the trap
; to the Emulator.

!637,1,TRAPX10; X10 microcode locn of TRAP
!645,1,TRAPX13; X13 location
;TRAP1; X21 location

!1,2,RETRAP,TRPDISP;

TRAPX10: T← 37, :TRPX;
TRAPX13: T← 37, :TRPX;
TRAP1:T← 37, :TRPX;

TRPX:L← T← XREG.T;Look for trap # 70000
TEMP← L;
T← 20;
L← LREG-T;
SH=0, TASK;
:RETRAP;** !RETRAP, TRPDISP
RETRAP: MAR← TRAPPC;
T← TEMP;
MD← PC;
MAR← TRAPPC+T+1;
NOP;
L← MD, TASK, :PCL;

; Trap dispatch to the various functions

!17,20,TRP0,TRP1,TRP2,TRP3,TRP4,TRP5,TRP6,TRP7,TRP10,TRP11;

TRPDISP: SINK← DISP, BUS; No out-of-range protection
:TRP0;

;********************************************************************
; BCPLRETL -- Do a "Bcpl return" with L as value of the function.
; BCPLRET -- Simply do a "Bcpl return"

BCPLRETL: AC0← L;
BCPLRET: L← AC3+1, TASK;
PCL:PC← L;**
SWRET: SWMODE;
:START;

;********************************************************************
; Definitions for Press scan conversion microcode
;
;
; G L O B A L
;
$ScanBitWc$R70;Number of words/scan line
$mpSBuf$R67;ScanLineIndex!s = pointer to scan-line buffer
;already offset for any margin effects

$177770$177770;
$177774$177774;
$177776$177776;
$170000$170000;

; ScanPutChar
$ShiftCnt$R66;
$nS$R65;
$Fw$R64;
$Fadr$R63;
$Badr$R62;
$FCNT$R61;
$WLEFT$R60;
$SubRet$R57;
$Fb$R56;
$FracPart$R55;
$lastMask$R54;
$leftMask$R53;
$rightMask$R52;
$leftMask1$R51;
$rightMask1$R50;
$initialFadr$R47;
$thisW$R46;
$inputShiftAmt$R45;

$nextW$R15;Must be an R register
$Badr0$R16;Must be an R register
;TEMP$R5;shared with SAD

; ScanPutDots (also ScanPutHalf)
$INADR$R66;
$BIT$R65;
$BBIT$R64;
$BINCR$R63;
$BBITINIT$R62;
$BDIM$R61;
$BSTATUS$R60;
$BDELTA$R57;
$INBIT$R56;
$WORDOUT$R55;
$BCOUNT$R54;
$WORDIN$R53;

; ScanPutHalf
$screenAddr$R52;
$screenMod$R51;
$screenCount$R50;
$screen$R47;
$cascadeDiag$R46;
$black$R45;
$white$R44;
$range$R43;
$threshold$R42;
$errorBuff$R41;
$error$R36;R register for shifts
$error1$R35;R register for shifts
$sample$R17;R register for shifts
$MASK$R3;

;
;ScanLoadVars(v)
;v!0 = mpSBuf
;v!1 = ScanBitWc

TRP0:MAR← AC0;
NOP;
L←MD;
MAR← AC0+1;
mpSBuf← L;
L←MD, TASK;
ScanBitWc← L, :BCPLRET;**
;
;********************************************************************
; ScanPutChar(Soff, v) -- scan convert a character
;v=> structure BELOChar describing character to do:
;Cbit bit 1 =1
;spare bit 3
;hwbit 12;-Number of bits/sl
;
;orbitXbit 4;scan line in band to start on (=Soff)
;Bit bit 12;Address on scan line
;
;bitOffsetbit 4;offset of char start in word of font
;orbitSbit 12;nscanlines-1 left to do
;
;Fadr word;Address of next font word
; returns 0 if no left-overs
; returns 4 (size BELOChar/16) if leftovers ; also ns and Fadr
;fields of v are updated.

!17,20,CYCL0,CYCL1,CYCL2,CYCL3,CYCL4,CYCL5,CYCL6,CYCL7,CYCL8,CYCR7,CYCR6,CYCR5,CYCR4,CYCR3,CYCR2,CYCR1;

!17,20,wCycR0,wCycR1,wCycR2,wCycR3,wCycR4,wCycR5,wCycR6,wCycR7,wCycL8,wCycL7,wCycL6,wCycL5,wCycL4,wCycL3,wCycL2,wCycL1;

!17,20,PCleftMask0,PCleftMask1,PCleftMask2,PCleftMask3,PCleftMask4,PCleftMask5,PCleftMask6,PCleftMask7,PCleftMask10,PCleftMask11,PCleftMask12,PCleftMask13,PCleftMask14,PCleftMask15,PCleftMask16,PCleftMask17;

;3/7 !17,20,PClastMask0,PClastMask1,PClastMask2,PClastMask3,PClastMask4,
;3/7 PClastMask5,PClastMask6,PClastMask7,PClastMask10,PClastMask11,
;3/7 PClastMask12,PClastMask13,PClastMask14,PClastMask15,PClastMask16,
;3/7 PClastMask17;

!1,2,PCGOT1Mask,PCGOTlastMask; ;3/7
!1,2,PCGOTlastMask2,PCGOTlastMask1; ;3/7

!17,20,PC1Mask0,PC1Mask1,PC1Mask2,PC1Mask3,PC1Mask4,PC1Mask5,PC1Mask6,PC1Mask7,PC1Mask10,PC1Mask11,PC1Mask12,PC1Mask13,PC1Mask14,PC1Mask15,PC1Mask16,PC1Mask17;

!1,2,PCH2,PCH3;
!1,2,PCH0,PCH5;
!1,2,CHARL1,CHARL2;
!1,2,CHARLmore,CHARLlast;
!1,2,cycleThisW,ZthisW;
!1,2,CHARL5,CHARL6;
!1,2,CHARL,CHARL8;
!1,2,CHARL9,PCH1;
!1,2,CYRET0,CycleRet2;

;Note: Badr0 must be R reg for shifts

TRP1:MAR←L←AC1+1;v
AC1←L;
;8/8T← 7777;
;8/8L← MD AND T;//let Bit=v>>BELOChar.Bit
L← MD;//let Bit=v>>BELOChar.Bit ;8/8
Badr0← L RSH 1;1 shift
T← 17;
L←LREG AND T,TASK;Compute skew
ShiftCnt←L;**//let ShiftCnt=(Bit)

T← 170000;
MAR←L←AC1-1;hw word
L← Badr0;
Badr0← L RSH 1;2 shifts
T←MD OR T;T←-hw
L←0-T;
Fb←L;//let Fb=-(#170000+v>>BELOChar.orbitW)

T←17;
L←Fb AND T;
FracPart←L;//let FracPart=Fb

SINK← FracPart, BUS;
;3/7 T← 170000, :PClastMask0;!PClastMask0,1,2,....
;3/7 PCGOTlastMask: lastMask←L;//let lastMask=masks!(16-FracPart)
T← 0, BUS=0, :PC1Mask0;!PC1Mask0,1,2,.... ;3/7
PCGOTlastMask: ;3/7
T← ALLONES, SH<0; ;3/7
L← LREG XOR T, :PCGOTlastMask2; !PCGOTlastMask2,PCGOTlastMask1 ;3/7

PCGOTlastMask1: ;3/7
L← ALLONES; ;3/7
PCGOTlastMask2: ;3/7
lastMask←L;//let lastMask=masks!(16-FracPart) ;3/7

T←17;
L←Fb+T;
T←177760;
L←LREG AND T;
Fw←L;//let Fw=(Fb+15)/16

MAR←L←AC1+1;
AC1←L;
T←7777;
L←T←MD AND T;T←bitOffset,nS;L←nS
L←LREG+1;was nScanLines-1
nS←L,L←T;//let nS=v>>BELOChar.orbitS+1

T←170000;
L←T←LREG.T;
TEMP←L MLSH 1;
L←T←TEMP;
TEMP←L MLSH 1;
L←T←TEMP;
TEMP←L MLSH 1;
L←T←TEMP;
TEMP←L MLSH 1;
L←TEMP,TASK;
inputShiftAmt←L;//let inputShiftAmt=v>>BELOChar.bitOffset

SINK←ShiftCnt, BUS;
;3/7 T←ALLONES,:PC1Mask0;!PC1Mask0,...
T← ALLONES, BUS=0, :PC1Mask0; !PC1Mask0,... ;3/7
PCGOT1Mask: rightMask1←L;//let rightMask1=-1 rshift ShiftCnt
L←rightMask1 XOR T;
leftMask1←L;//let leftMask1=not rightMask1

MAR← AC1+1;Fadr word
L← Badr0;
Badr0← L RSH 1;3 shifts
L←MD, TASK;
initialFadr←L;** initialFadr= first font address
L←Badr0;
Badr0← L RSH 1;4 th shift
T←AC0;Scan line number (0-15 decimal)
MAR← mpSBuf+T;
L← 20-T;
AC0←L;AC0= number of scan-lines to go to run out
T←MD-1;//let Badr=mpSBuf!Soff+(Bit rshift 4)

;Prepare to call CHARL to do one scan-line of the character
PCH0:L←Badr0+T;L=first band address-1
Badr0←L, TASK;
Badr←L;**

SINK←inputShiftAmt,BUS;
T←ALLONES,:PCleftMask0;!PCleftMask0,PCleftMask1,...
PCGOTleftMask:leftMask←L;//let leftMask=masks!inputShiftAmt
L←leftMask XOR T,TASK;
rightMask←L;//let rightMask=not leftMask

LOC23:XMAR←L←initialFadr;
Fadr←L;
T←MD,:CycleInit;//let nextW=Cycle(Fadr!0,inputShiftAmt)
CycleRet1:L←0;
WLEFT←L;//let WLEFT=0

T←20;
L← Fw-T, TASK;
FCNT← L, :CHARL;** FCNT = 20*(Fw-1)
PCH1:L← nS-1;
nS←L, SH=0;
L←AC0-1, :PCH2;!PCH2,PCH3

;nS has not expired; more to do.
PCH2:AC0←L, SH=0;
T←ScanBitWc, :PCH0;!PCH0,PCH5

;nS=0 -- character is completed
PCH3:L←0, :BCPLRETL;No leftovers

;S=0 -- run out of band. Update BELOChar structure
PCH5:L←T←inputShiftAmt;move to leftmost 4 bits
TEMP←L MRSH 1;
L←T←TEMP;
TEMP←L MRSH 1;
L←T←TEMP;
TEMP←L MRSH 1;
L←T←TEMP;
TEMP←L MRSH 1;
T←TEMP;

MAR←AC1;
L← nS-1;
L←LREG OR T, TASK;//v>>BELOChar.bitOffset=inputShiftAmt
MD← LREG;**//v>>BELOChar.orbitS=nS-1
MAR←AC1+1;Now restore Fadr to structure
L←4;
MD←initialFadr,:BCPLRETL;//v>>BELOChar.CoreAdr=Fadr
;//resultis size BELOChar/16

; Mask tables here to make above code somewhat more readable

;3/7 PClastMask0:L← ALLONES, :PCGOTlastMask;
;3/7 PClastMask1:L← 100000, :PCGOTlastMask;
;3/7 PClastMask2:L← 140000, :PCGOTlastMask;
;3/7 PClastMask3:L← 160000, :PCGOTlastMask;
;3/7 PClastMask4:L← 170000, :PCGOTlastMask;
;3/7 PClastMask5:L← 174000, :PCGOTlastMask;
;3/7 PClastMask6:L← 176000, :PCGOTlastMask;
;3/7 PClastMask7:L← 177000, :PCGOTlastMask;
;3/7 PClastMask10:L← 177400, :PCGOTlastMask;
;3/7 PClastMask11:L← 177600, :PCGOTlastMask;
;3/7 PClastMask12:L← 177700, :PCGOTlastMask;
;3/7 PClastMask13:L← 177740, :PCGOTlastMask;
;3/7 PClastMask14:L← 177760, :PCGOTlastMask;
;3/7 PClastMask15:L← 177770, :PCGOTlastMask;
;3/7 PClastMask16:L← 177774, :PCGOTlastMask;
;3/7 PClastMask17:L← 177776, :PCGOTlastMask;

PC1Mask0:L← ALLONES, :PCGOT1Mask;
PC1Mask1:L← 77777, :PCGOT1Mask;
PC1Mask2:L← 37777, :PCGOT1Mask;
PC1Mask3:L← 17777, :PCGOT1Mask;
PC1Mask4:L← 7777, :PCGOT1Mask;
PC1Mask5:L← 3777, :PCGOT1Mask;
PC1Mask6:L← 1777, :PCGOT1Mask;
PC1Mask7:L← 777, :PCGOT1Mask;
PC1Mask10:L← 377, :PCGOT1Mask;
PC1Mask11:L← 177, :PCGOT1Mask;
PC1Mask12:L← 77, :PCGOT1Mask;
PC1Mask13:L← 37, :PCGOT1Mask;
PC1Mask14:L← 17, :PCGOT1Mask;
PC1Mask15:L← 7, :PCGOT1Mask;
PC1Mask16:L← 3, :PCGOT1Mask;
PC1Mask17:L← ONE, :PCGOT1Mask;

PCleftMask0:L← ALLONES, :PCGOTleftMask;
PCleftMask1:L← 177776, :PCGOTleftMask;
PCleftMask2:L← 177774, :PCGOTleftMask;
PCleftMask3:L← 177770, :PCGOTleftMask;
PCleftMask4:L← 177760, :PCGOTleftMask;
PCleftMask5:L← 177740, :PCGOTleftMask;
PCleftMask6:L← 177700, :PCGOTleftMask;
PCleftMask7:L← 177600, :PCGOTleftMask;
PCleftMask10:L← 177400, :PCGOTleftMask;
PCleftMask11:L← 177000, :PCGOTleftMask;
PCleftMask12:L← 176000, :PCGOTleftMask;
PCleftMask13:L← 174000, :PCGOTleftMask;
PCleftMask14:L← 170000, :PCGOTleftMask;
PCleftMask15:L← 160000, :PCGOTleftMask;
PCleftMask16:L← 140000, :PCGOTleftMask;
PCleftMask17:L← 100000, :PCGOTleftMask;
;
;Character loop for one scan-line.
; Enter at CHARL with:
;initialFadr+1 => next word of font to fetch
;Badr+1 => next word to store in the band
;ShiftCnt = shift amount for each font word (to the right)
;FCNT+20 = 20* number of font words/scanline
;MASK = -1 rshift ShiftCnt
; Exit to PCH1 with:
;Fadr+1 => next word of font to fetch
;ShiftCnt,MASK unchanged

;let thisW=nextW&leftMask
;nextW=Cycle(Fadr!j,inputShiftAmt)
;thisW=thisW+(rightMask&nextW)
CHARL:T←leftMask;
L←nextW AND T;
thisW←L;//let thisW=nextW&leftMask

LOC24:XMAR←L←Fadr+1;
Fadr←L;
L←MD, BUS=0, TASK;
nextW←L, :CHARL1;** !CHARL1,CHARL2

;Left cycle the non-zero font word by inputShiftAmt, and pick out some low bits
; (governed by MASK) to put in this band word.
CHARL1:T←nextW, :Cycle;//nextW=Cycle(Fadr!j,inputShiftAmt)
CycleRet2:T←rightMask,:CHARL3;
CHARL2:T←rightMask;
CHARL3:L←nextW AND T;
T←thisW;
L←LREG+T;
thisW←L;//thisW=thisW+(rightMask&nextW)

;if j eq Fw then//update shiftAmt, mask w
; [ thisW=thisW&lastMask
; inputShiftAmt=inputShiftAmt+Fb
; initialFadr=initialFadr+inputShiftAmt/16
; inputShiftAmt=inputShiftAmt
; ]
SINK←FCNT,BUS=0;
L←T←thisW,:CHARLmore;!1,2,CHARLmore,CHARLlast;
CHARLlast: L←lastMask AND T,TASK;
thisW←L;//thisW=thisW&lastMask
T←Fb;
L←inputShiftAmt+T;
inputShiftAmt←L;//inputShiftAmt=inputShiftAmt+Fb
TEMP←L RSH 1;
L←TEMP;
TEMP←L RSH 1;
L←TEMP;
TEMP←L RSH 1;
L←TEMP;
TEMP←L RSH 1;
T←initialFadr;
L←TEMP+T,TASK;
initialFadr←L;//initialFadr=initialFadr+inputShiftAmt/16
T←17;
L←inputShiftAmt AND T;
inputShiftAmt←L;//inputShiftAmt=inputShiftAmt
L←T←thisW,:CHARLmore;

;if thisW then//Play only if non-zero
;[ thisW=Cycle(thisW,16-ShiftCnt)
; WLEFT=(thisW&rightMask1)%WLEFT
;]
CHARLmore:L←T←thisW,BUS=0;
NOP,:cycleThisW;!1,2,cycleThisW,ZthisW;
cycleWRet:T←rightMask1;
L←thisW AND T;
T←WLEFT;
L←LREG OR T;
WLEFT←L;

;if WLEFT then
; Badr!0=(Badr!0 % WLEFT)

ZthisW:SINK←WLEFT,BUS=0;
NOP, :CHARL5;!CHARL5,CHARL6

;Because bits to "or" (W1) non-zero, must store
CHARL5:MAR←Badr+1;
T←WLEFT;
L← MD OR T;
MAR←T←Badr+1;
WLEFT←L,L←T;
Badr← L, TASK;Bump Badr
MD← WLEFT, :CHARL7;**

;WLEFT=thisW&leftMask1
;Badr=Badr+1
CHARL6:L←Badr+1, TASK;
Badr←L;**

;Compute WLEFT, the bits left over for next band word.
CHARL7:T← leftMask1;
L← thisW AND T,TASK;Bits left over for next time
WLEFT← L;**

;If FCNT=0, we are done with the scan-line. Else FCNT←FCNT-20
L←T← FCNT;
L←177760 +T, SH=0;Test FCNT=0
FCNT←L, :CHARL;!CHARL,CHARL8

;End of loop, need to store final band word with any remaining bits
; Badr!0=(Badr!0 % WLEFT)
CHARL8:MAR←Badr+1;
L←T← WLEFT,BUS=0;
L←MD OR T, :CHARL9;!CHARL9,PCH1
CHARL9: MAR←Badr+1;
NOP, TASK;
MD← LREG, :PCH1;**

;
;Cycle left.
; Enter at CYCLE with:
;inputShiftAmt = count of places to cycle
;T = bits
; Exit to CHARL2 with
;nextW= cycled bits
; Note: nextW must be R register for shifts

CycleInit:L←0;
SubRet←L,:Cycle;

Cycle:SINK← inputShiftAmt, BUS;
L← T, TASK, :CYCL0;

CYCL0:nextW← L, :CYRET;

CYCR4:nextW←L MRSH 1;
CYCY3:T←L←nextW, TASK;
CYCR3:nextW←L MRSH 1;
CYCY2:T←L←nextW, TASK;
CYCR2:nextW←L MRSH 1;
CYCY1:T←L←nextW; TASK;
CYCR1:nextW←L MRSH 1, :CYRET;

CYCL4:nextW←L MLSH 1;
CYCZ3:T←L←nextW, TASK;
CYCL3:nextW←L MLSH 1;
CYCZ2:T←L←nextW, TASK;
CYCL2:nextW←L MLSH 1;
CYCZ1:T←L←nextW, TASK;
CYCL1:nextW←L MLSH 1, :CYRET;

CYCL8:nextW← L LCY 8, :CYRET;
CYCL7:nextW← L LCY 8, :CYCY1;
CYCL6:nextW← L LCY 8, :CYCY2;
CYCL5:nextW← L LCY 8, :CYCY3;
CYCR7:nextW← L LCY 8, :CYCZ1;
CYCR6:nextW← L LCY 8, :CYCZ2;
CYCR5:nextW← L LCY 8, :CYCZ3;

CYRET:SINK←SubRet,BUS;
L←ONE,:CYRET0;!1,2,CYRET0,CycleRet2
CYRET0:SubRet←L,:CycleRet1;

;thisW←thisW rCycle ShiftCnt
cycleThisW:SINK← ShiftCnt, BUS;
L← T, TASK, :wCycR0;

wCycR0:thisW← L, :cycleWRet;

wCycR4:TEMP←L MRSH 1;
wCycY3:T←L←TEMP, TASK;
wCycR3:TEMP←L MRSH 1;
wCycY2:T←L←TEMP, TASK;
wCycR2:TEMP←L MRSH 1;
wCycY1:T←L←TEMP; TASK;
wCycR1:TEMP←L MRSH 1, :wCycRET;

wCycL4:TEMP←L MLSH 1;
wCycZ3:T←L←TEMP, TASK;
wCycL3:TEMP←L MLSH 1;
wCycZ2:T←L←TEMP, TASK;
wCycL2:TEMP←L MLSH 1;
wCycZ1:T←L←TEMP, TASK;
wCycL1:TEMP←L MLSH 1, :wCycRET;

wCycL8:TEMP← L LCY 8, :wCycRET;
wCycL7:TEMP← L LCY 8, :wCycY1;
wCycL6:TEMP← L LCY 8, :wCycY2;
wCycL5:TEMP← L LCY 8, :wCycY3;
wCycR7:TEMP← L LCY 8, :wCycZ1;
wCycR6:TEMP← L LCY 8, :wCycZ2;
wCycR5:TEMP← L LCY 8, :wCycZ3;

wCycRET:L←TEMP;
thisW←L,:cycleWRet;
;
;********************************************************************
;ScanPutDots(Soff, v)
; Blows up a 1-bit bit map, and spits it out.
; Soff = scan-line number within band (0-15 decimal)
; v => BEDots entry:
;H word ;;ignore
;Bstart word -- starting bit position on scan-line
;Bincr word -- =+1 if bit position increases, else -1
;Bdim word -- -# of bits to output on the scan-line
;Opaque bit
;Smagnify bit
;Bmagnify bit -- 20000 bit =1 => magnify on output
;Code bit 13
;Bdelta word -- decrement for DDA
;BitBuf word -- pointer to first word of input data
;BitPhase word -- bit position in word of first input sample
;
;DotsDeltaConst=#37777
;

$DOTSDELTACOnST $37777;

!17,20,SPDORM0,SPDORM1,SPDORM2,SPDORM3,SPDORM4,SPDORM5,SPDORM6,SPDORM7,SPDORM10,SPDORM11,SPDORM12,SPDORM13,SPDORM14,SPDORM15,SPDORM16,SPDORM17;

!17,20,SPDMASK0,SPDMASK1,SPDMASK2,SPDMASK3,SPDMASK4,SPDMASK5,SPDMASK6,SPDMASK7,SPDMASK10,SPDMASK11,SPDMASK12,SPDMASK13,SPDMASK14,SPDMASK15,SPDMASK16,SPDMASK17;

!1,2,SPD2,SPD1;
!1,2,SPD6,SPD4;
!1,2,SPD20,SPD8;
!1,2,SPD3,SPD9;
!1,2,SPD21,SPD23;
!1,2,SPD26,SPD28;
!1,2,SPD29,SPD40;
!1,2,SPD27,SPD41;
!1,2,SPD30,SPD3a;
!1,2,SPD20a,SPD31;
!1,2,SPHREE,SPDREE;

;TRP2:MAR←AC1+1;Fetch Bstart
;T←3;
;L←AC1+T;
TRP2:T← MAR← AC1 +1;Fetch Bstart
L← 2 +T;

AC1←L;
L←MD;
MAR←AC1-1;Fetch Bincr
Badr0←L RSH 1;1 shift
T←17;
L←LREG AND T;
T←MD;
BBIT←L, L←T, TASK;Bit offset in the word to begin output
BINCR←L;**
L←BINCR;
MAR←AC1, SH<0;
L←0, :SPD2;!SPD2,SPD1 -- branch if Bincr<0
SPD1:L←17;Bincr<0
SPD2:BBITINIT←L;
L←MD, TASK;
BDIM←L;**

MAR←L←AC1+1;Fetch word with Bmagnify in it;
AC1←L;
L←Badr0;
Badr0←L RSH 1;2nd shift
L←MD, TASK;
BSTATUS←L;**

MAR←L←AC1+1;Fetch Bdelta
AC1←L;
L←Badr0;
Badr0←L RSH 1;3rd shift
L←MD, TASK;
BDELTA←L;**

MAR←L←AC1+1;Fetch address of input bits
AC1←L;
L←MD-1, TASK;
INADR←L;** INADR=address of next word to get -1

MAR←L←AC1+1;Fetch bit position in word
AC1←L;
L←Badr0;
Badr0←L RSH 1;4th shift
T←MD;
L←17-T, TASK;
INBIT←L;**
T←AC0;

MAR←mpSBuf+T;Fetch scan-buffer
L←0;
WORDOUT←L;
T←Badr0;
L←MD+T, TASK;
Badr0←L;** Badr0 = band address

;Test for halftoning here
T←37;
L←BSTATUS AND T;
L←DOTSDELTACOnST,SH=0;
BCOUNT←L, :SPHREE;!SPHREE,SPDREE

;Get a Bit
SPD3:L←INBIT-1, :SPD3z;Duplicated in order to address it
SPD3a:L←INBIT-1;
SPD3z:INBIT←L, SH<0;
L←17, :SPD6;!SPD6,SPD4
SPD4:INBIT←L;Ran out of input word
SPDREE:MAR←L←INADR+1;Fetch next input word
INADR←L;
L←MD, TASK;
WORDIN←L;**
SPD6:SINK←INBIT,BUS;
T←WORDIN, :SPDMASK0;!SPDMASK0,1,2,...
SPD7:BIT←L;**

;Get DDA
T←20000;
L←BSTATUS AND T;
T←BDELTA, SH=0;Test Bmagnify
L←BCOUNT-T, :SPD20;!SPD20,SPD8
SPD8:BCOUNT←L, SH<0;Not magnifying -- do DDA
T←DOTSDELTACOnST, :SPD3;!SPD3,SPD9
SPD9:L←BCOUNT+T, TASK;
BCOUNT←L;**

;Put a bit
SPD20:L←BIT, :SPD20z;Duplicated in order to address it
SPD20a:L←BIT;
SPD20z:T←BBIT, SH=0;
L←BINCR+T, :SPD21;!SPD21,SPD23
SPD21:BBIT←L, L←T;Must or a bit in
SINK←LREG, BUS;
T←WORDOUT, :SPDORM0;!SPDORM0,1,2,...
SPD22:WORDOUT←L, :SPD24;**
SPD23:BBIT←L;

SPD24:T←177760;
L←BBIT AND T;
L←BDIM+1, SH=0;
BDIM←L, SH=0, :SPD26;!SPD26,SPD28

;Bbit has run below 0 or above 17, so must store a word.
SPD26:MAR←Badr0, :SPD27;!SPD27,SPD41 -- to SPD41 if Bdim=0
SPD27:L←BBITINIT;
BBIT←L;
T←WORDOUT;
L←MD OR T,TASK;
WORDOUT←L;**
T←BINCR;
MAR←Badr0;
L←Badr0+T;
Badr0←L, T←0;Badr0 R register => T←0
MD←WORDOUT, L←T, TASK;
WORDOUT←L;**

SPD28:T←20000, :SPD29;!SPD29,SPD40 -- to SPD40 if Bdim=0
SPD29:L←BSTATUS AND T;
T←BDELTA, SH=0;
L←BCOUNT-T, :SPD30;!SPD30,SPD3a -- if no magnify, goto getabit
SPD30:BCOUNT←L, SH<0;
T←DOTSDELTACOnST, :SPD20a; !SPD20a,SPD31 -- if overflow,
SPD31:L←BCOUNT+T, TASK;Add the constant
BCOUNT←L, :SPD3;**

; Finish out by storing the last word. Do not bother to update
; any variables in v as they dont matter

SPD40:MAR←Badr0;
SPD41:T←WORDOUT;
L←MD OR T;
MAR←Badr0;
T←0;
MD←LREG, L←T, :BCPLRETL;Return 0

;Mask table here to make above more readable.

SPDORM0:L←100000 OR T, TASK, :SPD22;
SPDORM1:L←40000 OR T, TASK, :SPD22;
SPDORM2:L←20000 OR T, TASK, :SPD22;
SPDORM3:L←10000 OR T, TASK, :SPD22;
SPDORM4:L←4000 OR T, TASK, :SPD22;
SPDORM5:L←2000 OR T, TASK, :SPD22;
SPDORM6:L←1000 OR T, TASK, :SPD22;
SPDORM7:L←400 OR T, TASK, :SPD22;
SPDORM10:L←200 OR T, TASK, :SPD22;
SPDORM11:L←100 OR T, TASK, :SPD22;
SPDORM12:L←40 OR T, TASK, :SPD22;
SPDORM13:L←20 OR T, TASK, :SPD22;
SPDORM14:L←10 OR T, TASK, :SPD22;
SPDORM15:L←4 OR T, TASK, :SPD22;
SPDORM16:L←2 OR T, TASK, :SPD22;
SPDORM17:L←ONE OR T, TASK, :SPD22;

SPDMASK0:L←ONE AND T, TASK, :SPD7;
SPDMASK1:L←2 AND T, TASK, :SPD7;
SPDMASK2:L←4 AND T, TASK, :SPD7;
SPDMASK3:L←10 AND T, TASK, :SPD7;
SPDMASK4:L←20 AND T, TASK, :SPD7;
SPDMASK5:L←40 AND T, TASK, :SPD7;
SPDMASK6:L←100 AND T, TASK, :SPD7;
SPDMASK7:L←200 AND T, TASK, :SPD7;
SPDMASK10:L←400 AND T, TASK, :SPD7;
SPDMASK11:L←1000 AND T, TASK, :SPD7;
SPDMASK12:L←2000 AND T, TASK, :SPD7;
SPDMASK13:L←4000 AND T, TASK, :SPD7;
SPDMASK14:L←10000 AND T, TASK, :SPD7;
SPDMASK15:L←20000 AND T, TASK, :SPD7;
SPDMASK16:L←40000 AND T, TASK, :SPD7;
SPDMASK17:L←100000 AND T, TASK, :SPD7;

;
;***************************************
;ScanPutHalf (finish initialization, and spit out the bits)

!17,20,hCYCR0,hCYCR1,hCYCR2,hCYCR3,hCYCR4,hCYCR5,hCYCR6,hCYCR7,hCYCL8,hCYCL7,hCYCL6,hCYCL5,hCYCL4,hCYCL3,hCYCL2,hCYCL1;

!17,20,SPHOrM0,SPHOrM1,SPHOrM2,SPHOrM3,SPHOrM4,SPHOrM5,SPHOrM6,SPHOrM7,SPHOrM10,SPHOrM11,SPHOrM12,SPHOrM13,SPHOrM14,SPHOrM15,SPHOrM16,SPHOrM17;

!17,20,SPHMask0,SPHMask1,SPHMask2,SPHMask3,SPHMask4,SPHMask5,SPHMask6,SPHMask7,SPHMask10,SPHMask11,SPHMask12,SPHMask13,SPHMask14,SPHMask15,SPHMask16,SPHMask17;

!1,2,SPH6,SPH4;
!1,2,SPH20,SPH8;
!1,2,SPH3,SPH9;
!1,2,SPH21,SPH23;
!1,2,SPH26,SPH28;
!1,2,SPH29,SPH40;
!1,2,SPH27,SPH41;
!1,2,SPH30,SPH3a;
!1,2,SPH20a,SPH31;
!1,2,SPHScreen,SPHNoScreen;
!1,2,NoRem,Rem;

SPHREE: T←17;fix INBIT (20-bit-sampleSize instead of 17-bit)
T←BSTATUS.T;
L←INBIT+1;
L←LREG-T;
INBIT←L;
;!!NO ERROR DISTRIBUTION!!!MAR←L←AC1+1;pick up Error Vec for error distribution
;!!NO ERROR DISTRIBUTION!!!AC1←L;
;!!NO ERROR DISTRIBUTION!!!T←BDIM;
;!!NO ERROR DISTRIBUTION!!!L←MD-T,TASK;
;!!NO ERROR DISTRIBUTION!!!errorBuff←L;**

L←AC1+1;!!NO ERROR DISTRIBUTION!!!
MAR←L←LREG+1;pick up Screen Modulus
AC1←L;
L←0;
cascadeDiag←L;
L←MD,TASK;
screenMod←L;**

MAR←L←AC1+1;pick up screen address
AC1←L;
L←MD,TASK;
screenAddr←L;**

MAR←L←AC1+1;pick up IMin
AC1←L;
L←MD,TASK;
black←L;**

MAR←AC1+1;pick up IMax
L←0;
screenCount←L;
screen←L;
L←MD,TASK;
white←L;**

T←black;
L←white-T,TASK;
nextW←L LSH 1;**
T←nextW-1;!!FIX!!
L←0-T;!!FIX!!
threshold←L;!!FIX!!
L←nextW;
nextW←L LSH 1;
L←nextW,TASK;
range←L;**range=(white-black)*4

T←37;
L←BSTATUS AND T;
L←LREG-1;
SINK←LREG,BUS;
NOP,:SPHMask0;
SPH2: MASK←L;**

; !!BUG: threshold*2 is what’s needed !! T←white;
; !!BUG !! L←black-T,TASK;
; !!BUG !! threshold←L;**
L←threshold-1;
error←L,:SPHRE;**

;Get a sample point
SPH3:T←17, :SPH3z;Duplicated in order to address it
SPH3a:T←17;
SPH3z:T←BSTATUS.T;sampleSize
L←INBIT-T;
INBIT←L, SH<0;
L←20-T, :SPH6;!SPH6,SPH4

SPH4:INBIT←L;Ran out of input word
SPHRE:MAR←L←INADR+1;Fetch next input word
INADR←L;
L←MD, TASK;
WORDIN←L;**

SPH6:T←WORDIN,:hCYCLE;
SPH7:T←MASK;
L←nextW AND T;
T←black;
L←LREG-T;
sample←L LSH 1;
L←sample;
sample←L LSH 1;*4 to avoid errors on 25% calculation

;Get DDA
T←20000;
L←BSTATUS AND T;
T←BDELTA, SH=0;Test Bmagnify
L←BCOUNT-T, :SPH20;!SPH20,SPH8
SPH8:BCOUNT←L, SH<0;Not magnifying -- do DDA
T←DOTSDELTACOnST, :SPH3;!SPH3,SPH9
SPH9:L←BCOUNT+T, TASK;
BCOUNT←L;**

;Put a bit
;add screen frequency, if called for
SPH20:L←screenAddr,BUS=0,:SPH20z;Duplicated in order to address it
SPH20a:L←screenAddr,BUS=0;
SPH20z:T←screenCount,:SPHScreen;!SPHScreen,SPHNoScreen
SPHScreen:MAR←screenAddr+T;
L←screenCount+1;
screenCount←L;
L←MD,TASK;
screen←L;**

T←screenMod;
L←screenCount XOR T;
NOP,SH=0;
L←0,:NoRem;!NoRem,Rem
Rem:screenCount←L;
NoRem: T←screen-1,:SPHyyy;

;!!NO ERROR DISTRIBUTION!!!SPHNoScreen:T←BDIM;
;!!NO ERROR DISTRIBUTION!!!MAR←errorBuff+T;
;!!NO ERROR DISTRIBUTION!!!T←sample-1;
;!!NO ERROR DISTRIBUTION!!!T←screen+T+1;screen+samplescreen+sample
;!!NO ERROR DISTRIBUTION!!!L←error-T;error-(screen+sample)
;!!NO ERROR DISTRIBUTION!!!T←MD;errorBuff!BDIM
;!!NO ERROR DISTRIBUTION!!!L←LREG+T;errorBuff!BDIM+error-(screen+sample)
SPHNoScreen: T←screen-1;!!NO ERROR DISTRIBUTION!!
SPHyyy: T←sample+T+1;!!NO ERROR DISTRIBUTION!!
L←0-T;!!NO ERROR DISTRIBUTION!!
;!!NO ERROR DISTRIBUTION!!error←L;

;test error ge threshold then SetBit() or error=error+range
T←threshold;
L←LREG-T;
T←BBIT,SH<0;
L←BINCR+T,:SPH21;!SPH21,SPH23 (SetBit,SetBitReturn)
SPH21:BBIT←L, L←T;Must or a bit in
SINK←LREG, BUS;
T←WORDOUT, :SPHOrM0;!SPHOrM0,1,2,...
SPH22:WORDOUT←L;**
;!!NO ERROR DISTRIBUTION!!!L←error, :SPH24;

;!!NO ERROR DISTRIBUTION!!!SPH23:BBIT←L;
;!!NO ERROR DISTRIBUTION!!!T←range;
;!!NO ERROR DISTRIBUTION!!!L←error+T;
;!!NO ERROR DISTRIBUTION!!!error←L;

;now, compute cascading error
;distribution is : Down 25%, Diag 25%, Right 25%
;!!NO ERROR DISTRIBUTION!!!SPH24:SH<0;put sign bit in low order of T for MAGIC
;!!NO ERROR DISTRIBUTION!!!T←0,:pos;!pos,neg
;!!NO ERROR DISTRIBUTION!!!neg: T←ONE;
;!!NO ERROR DISTRIBUTION!!!pos:error←L MRSH 1;error=error/2 (error is signed number)
;!!NO ERROR DISTRIBUTION!!!L←error,TASK;
;!!NO ERROR DISTRIBUTION!!!error1←L MRSH 1;**error1=error/2 (error is signed number)

;errorBuff!BDIM=cascadeDiag+error1//prev diag error + new down error
;!!NO ERROR DISTRIBUTION!!!T←BDIM;
;!!NO ERROR DISTRIBUTION!!!MAR←errorBuff+T;
;!!NO ERROR DISTRIBUTION!!!T←error1;
;!!NO ERROR DISTRIBUTION!!!L←cascadeDiag+T,TASK;
;!!NO ERROR DISTRIBUTION!!!MD←LREG;**

;cascadeDiag=error1
;!!NO ERROR DISTRIBUTION!!!L←error1,TASK;
;!!NO ERROR DISTRIBUTION!!!cascadeDiag←L;**

SPH24: T←177760,:SPHxxx;;!!NO ERROR DISTRIBUTION111
SPH23: BBIT←L;;!!NO ERROR DISTRIBUTION111
T←177760;
SPHxxx:L←BBIT AND T;
L←BDIM+1, SH=0;
BDIM←L, SH=0, :SPH26;!SPH26,SPH28

;Bbit has run below 0 or above 17, so must store a word.
SPH26:MAR←Badr0, :SPH27;!SPH27,SPH41 -- to SPH41 if Bdim=0
SPH27:L←BBITINIT;
BBIT←L;
T←WORDOUT;
L←MD OR T,TASK;
WORDOUT←L;**

T←BINCR;
MAR←Badr0;
L←Badr0+T;
Badr0←L, T←0;Badr0 R register => T←0
MD←WORDOUT, L←T, TASK;

WORDOUT←L;**

SPH28:T←20000, :SPH29;!SPH29,SPH40 -- to SPH40 if Bdim=0
SPH29:L←BSTATUS AND T;
T←BDELTA, SH=0;
L←BCOUNT-T, :SPH30;!SPH30,SPH3a -- if no magnify, goto getabit
SPH30:BCOUNT←L, SH<0;
T←DOTSDELTACOnST, :SPH20a; !SPH20a,SPH31 -- if overflow,
SPH31:L←BCOUNT+T, TASK;Add the constant
BCOUNT←L, :SPH3;**

; Finish out by storing the last word. Do not bother to update
; any variables in v as they dont matter

SPH40:MAR←Badr0;
SPH41:T←WORDOUT;
L←MD OR T;
MAR←Badr0;
T←0;
MD←LREG, L←T, :BCPLRETL;Return 0

;Mask table here to make above more readable.

SPHOrM0:L←100000 OR T, TASK, :SPH22;
SPHOrM1:L←40000 OR T, TASK, :SPH22;
SPHOrM2:L←20000 OR T, TASK, :SPH22;
SPHOrM3:L←10000 OR T, TASK, :SPH22;
SPHOrM4:L←4000 OR T, TASK, :SPH22;
SPHOrM5:L←2000 OR T, TASK, :SPH22;
SPHOrM6:L←1000 OR T, TASK, :SPH22;
SPHOrM7:L←400 OR T, TASK, :SPH22;
SPHOrM10:L←200 OR T, TASK, :SPH22;
SPHOrM11:L←100 OR T, TASK, :SPH22;
SPHOrM12:L←40 OR T, TASK, :SPH22;
SPHOrM13:L←20 OR T, TASK, :SPH22;
SPHOrM14:L←10 OR T, TASK, :SPH22;
SPHOrM15:L←4 OR T, TASK, :SPH22;
SPHOrM16:L←2 OR T, TASK, :SPH22;
SPHOrM17:L←ONE OR T, TASK, :SPH22;

SPHMask0:L←ONE, TASK, :SPH2;
SPHMask1:L←3 , TASK, :SPH2;
SPHMask2:L←7 , TASK, :SPH2;
SPHMask3:L←17 , TASK, :SPH2;
SPHMask4:L←37 , TASK, :SPH2;
SPHMask5:L←77 , TASK, :SPH2;
SPHMask6:L←177 , TASK, :SPH2;
SPHMask7:L←377 , TASK, :SPH2;
SPHMask10:L← 777 , TASK, :SPH2;
SPHMask11:L← 1777 , TASK, :SPH2;
SPHMask12:L← 3777 , TASK, :SPH2;
SPHMask13:L← 7777 , TASK, :SPH2;
SPHMask14:L← 17777 , TASK, :SPH2;
SPHMask15:L← 37777 , TASK, :SPH2;
SPHMask16:L← 77777 , TASK, :SPH2;
SPHMask17:L←177777 , TASK, :SPH2;

;Cycle right.
; Enter at CYCLE with:
;INBIT = count of places to cycle
;T = bits
; Exit to SPH7 with
;nextW= cycled bits
; Note: nextW must be R register for shifts

hCYCLE:SINK← INBIT, BUS;
L← T, TASK, :hCYCR0;

hCYCR0:nextW← L, :SPH7;

hCYCR4:nextW←L MRSH 1;
hCYCY3:T←L←nextW, TASK;
hCYCR3:nextW←L MRSH 1;
hCYCY2:T←L←nextW, TASK;
hCYCR2:nextW←L MRSH 1;
hCYCY1:T←L←nextW; TASK;
hCYCR1:nextW←L MRSH 1, :SPH7;

hCYCL4:nextW←L MLSH 1;
hCYCZ3:T←L←nextW, TASK;
hCYCL3:nextW←L MLSH 1;
hCYCZ2:T←L←nextW, TASK;
hCYCL2:nextW←L MLSH 1;
hCYCZ1:T←L←nextW, TASK;
hCYCL1:nextW←L MLSH 1, :SPH7;

hCYCL8:nextW← L LCY 8, :SPH7;
hCYCL7:nextW← L LCY 8, :hCYCY1;
hCYCL6:nextW← L LCY 8, :hCYCY2;
hCYCL5:nextW← L LCY 8, :hCYCY3;
hCYCR7:nextW← L LCY 8, :hCYCZ1;
hCYCR6:nextW← L LCY 8, :hCYCZ2;
hCYCR5:nextW← L LCY 8, :hCYCZ3;
;----------------------------------------------------------------------
; DoubleAdd (returns integer part)
;----------------------------------------------------------------------
!1,2,DPADNoCarry,DPADCarry;
TRP3: MAR←AC0;destination AC
NOP;
L←MD;

MAR←AC0+1;
sample←L;high order of first term
L←MD;

MAR←AC1;
TEMP←L;low order of first term
L←MD;

MAR←AC1+1;
AC1←L;high order of second term
L←MD;

MAR←AC0+1;
T←TEMP;
L←LREG+T;LREG has low order of second term
MD←LREG;

T←sample,ALUCY;
MAR←AC0,:DPADNoCarry;
DPADCarry:L←AC1+T+1,:DPADStore;
DPADNoCarry:L←AC1+T,:DPADStore;
DPADStore:MD←LREG,:BCPLRETL;

;----------------------------------------------------------------------
; DoubleSub
;----------------------------------------------------------------------
!1,2,DPSBNoCarry,DPSBCarry;
TRP4: MAR←AC0;destination AC
NOP;
L←MD;

MAR←AC0+1;
sample←L;sample has high order word 1
L←MD;

MAR←AC1;
TEMP←L;TEMP has low order word 1
T←ALLONES;
L←MD XOR T;store complement of AC1

MAR←AC1+1;
AC1←L;AC1 has (NOT high order word 1)
L←MD;

MAR←AC0+1;
T←LREG;
L←TEMP-T;
MD←LREG;store low order=lowOrder1-lowOrder2

T←sample,ALUCY;
MAR←AC0,:DPSBNoCarry;
DPSBCarry:L←AC1+T+1,:DPSBStore;
DPSBNoCarry:L←AC1+T,:DPSBStore;
DPSBStore: MD←LREG,:BCPLRETL;

;----------------------------------------------------------------------
; DoubleShr
;----------------------------------------------------------------------
!1,2,DSHRpos,DSHRneg;
TRP5: MAR←AC0;
NOP;
L←MD;

MAR←AC0+1,SH<0;
AC1←L,T←0,:DSHRpos;!1,2,DSHRpos,DSHRneg;
DSHRneg: T←ALLONES;
DSHRpos: TEMP←L MRSH 1;
L←MD;

MAR←AC0;
T←AC1;unshifted high order (for carry)
AC1←L MRSH 1;
MD←TEMP;shifted high order

MAR←AC0+1;
L←TEMP;return integer part
MD←AC1,:BCPLRETL;