; DLSCode24.Mu -- microcode for Alto DLS
; Derived from AltoCode24.Mu
; This microcode defines the Emulator, Memory Refresh, and Cursor tasks.

;	Last modified May 2, 1982  2:18 PM by Taft

;***Derived from ALTOCODE23.MU, as last modified by
;	Ingalls, August 11, 1976  10:39 PM
;***E. McCreight, editor
;***modified by McCreight, September 19, 1977  4:34 PM
;	removed STM3: dependence on saving R40 across tasks

; DLS microcode originally written by C. Thacker.
; Cleaned up by E. Taft, mostly to ensure adequate frequency of TASKs.

#AltoConsts23.Mu;

;LABEL PREDEFINITIONS

;The reset locations of the tasks:

!17,20,NOVEM,,,,,,,EREST,MRT,,CURT,,,,,;

;Locations which may need to be accessible from the Ram, or Ram
;  locations which are accessed from the Rom (TRAP1):
!37,20,START,RAMRET,RAMCYCX,,,,,,,,,,,,,TRAP1;

;Macro-op dispatch table:
!37,20,DOINS,DOIND,EMCYCLE,NOPAR,JSRII,U5,U6,U7,,,,,,,RAMTRAP,TRAP;

;Parameterless macro-op sub-table:
!37,40,DIR,EIR,BRI,RCLK,SIO,BLT,BLKS,ANDM,JMPR,RDRM,WTRM,DIRS,VERS,DLSOFF,DLSON,GCRB,MUL,DIV,QCH,ORM,BITBLT,SETBLV,RRB,WRB,,,,,,,,;

;Cycle dispatch table:
!37,20,L0,L1,L2,L3,L4,L5,L6,L7,L8,R7,R6,R5,R4,R3X,R2X,R1X;


;some global R-Registers
$NWW		$R4;		State of interrupt system
$R37		$R37;		Used by MRT, interval timer and EIA
$MTEMP		$R25;		Public temporary R-Register

;Alto Ethernet Microcode, Version III, Boggs and Metcalfe
; Modified March 25, 1982  4:15 PM by Taft - fix the unsynchronized status bug in EPOST

;4-way branches using NEXT6 and NEXT7
!17,20,EIFB00,EODOK,EOEOK,ENOCMD,EIFB01,EODPST,EOEPST,EOREST,EIFB10,EODCOL,EOECOL,EIREST,EIFB11,EODUGH,EOEUGH,ERBRES;

;2-way branches using NEXT7
;EOCDW1, EOCDWX, and EIGO are all related.  Be careful!
!7,10,EIDOK,EIFOK,,EOCDW1,EIDPST,EIFBAD,EOCDWX,EIGO;

;Miscellaenous address constraints
!7,10,,EOCDW0,EODATA,,,EOCDRS,EIDATA,EPOST;
!1,1,EIFB1;
!1,1,EIFRST;

;2-way branches using NEXT9
!1,2,EOINPR,EOINPN;
!1,2,EODMOR,EODEND;
!1,2,EOLDOK,EOLDBD;
!1,2,EIDMOR,EIDFUL;
!1,2,EIFCHK,EIFPRM;
!1,2,EOCDWT,EOCDGO;
!1,2,ECNTOK,ECNTZR;
!1,2,EIFIGN,EISET;
!1,2,EIFNBC,EIFBC;

;R Memory Locations

$ECNTR	$R12;	Remaining words in buffer
$EPNTR	$R13;	points BEFORE next word in buffer

;Ethernet microcode Status codes

$ESIDON	$377;	Input Done
$ESODON	$777;	Output Done
$ESIFUL	$1377;	Input Buffer full - words lost from tail of packet
$ESLOAD	$1777;	Load location overflowed
$ESCZER	$2377;	Zero word count for input or output command
$ESABRT	$2777;	Abort - usually caused by reset command
$ESNEVR	$3377;	Never Happen - Very bad if it does

;Main memory locations in page 1 reserved for Ethernet

$EPLOC	$600;	Post location
$EBLOC	$601;	Interrupt bit mask

$EELOC	$602;	Ending count location
$ELLOC	$603;	Load location

$EICLOC	$604;	Input buffer Count
$EIPLOC	$605;	Input buffer Pointer

$EOCLOC	$606;	Output buffer Count
$EOPLOC	$607;	Output buffer Pointer

$EHLOC	$610;	Host Address

;Function Definitions

$EIDFCT	$L000000,014004,000100;	BS = 4,  Input data
$EILFCT	$L016013,070013,000100;	F1 = 13, Input Look
$EPFCT	$L016014,070014,000100;	F1 = 14, Post
$EWFCT	$L016015,000000,000000;	F1 = 15, Wake-Up

$EODFCT	$L026010,000000,124000;	F2 = 10, Output data
$EOSFCT	$L024011,000000,000000;	F2 = 11, Start output
$ERBFCT	$L024012,000000,000000;	F2 = 12, Rest branch
$EEFCT	$L024013,000000,000000;	F2 = 13, End of output
$EBFCT	$L024014,000000,000000;	F2 = 14, Branch
$ECBFCT	$L024015,000000,000000;	F2 = 15, Countdown branch
$EISFCT	$L024016,000000,000000;	F2 = 16, Start input

; - Whenever a label has a pending branch, the list of possible
;   destination addresses is shown in brackets in the comment field.
; - Special functions are explained in a comment near their first ;use.
; - To avoid naming conflicts, all labels and special functions
;   have "E" as the first letter.

;Top of Ethernet Task loop

;Ether Rest Branch Function - ERBFCT
;merge ICMD and OCMD Flip Flops into NEXT6 and NEXT7
;ICMD and OCMD are set from AC0 [14:15] by the SIO instruction
;	00  neither 
;	01  OCMD - Start output
;	10  ICMD - Start input
;	11  Both - Reset interface

;in preparation for a hack at EIREST, zero EPNTR

EREST:	L_ 0,ERBFCT;		What's happening ?
	EPNTR_ L,:ENOCMD;	[ENOCMD,EOREST,EIREST,ERBRES]

ENOCMD:	L_ ESNEVR,:EPOST;	Shouldn't happen
ERBRES:	L_ ESABRT,:EPOST;	Reset Command

;Post status and halt.  Microcode status in L.
;Put microstatus,,hardstatus in EPLOC, merge c(EBLOC) into NWW.
;Note that we write EPLOC and read EBLOC in one operation

;Ether Post Function - EPFCT.  Gate the hardware status
;(LOW TRUE) to Bus [10:15], reset interface.

EPOST:	MAR_ EELOC;
	EPNTR_ L,TASK;		Save microcode status in EPNTR
	MD_ ECNTR;		Save ending count

	MAR_ EPLOC;		double word reference
	T_ NWW;
	L_ EPNTR, EPFCT;	BUS AND EPNTR with Status
	MTEMP_ L;		*** Run through L first because status is unsynchronized
	MD_ MTEMP;
	L_ MD OR T,TASK;	NWW OR c(EBLOC)
	NWW_ L,:EREST;		Done.  Wait for next command

;This is a subroutine called from both input and output (EOCDGO
;and EISET).  The return address is determined by testing ECBFCT,
;which will branch if the buffer has any words in it, which can
;only happen during input.

ESETUP:	NOP;
	L_ MD,BUS=0;		check for zero length
	T_ MD-1,:ECNTOK;	[ECNTOK,ECNTZR] start-1

ECNTZR:	L_ ESCZER,:EPOST;	Zero word count.  Abort

;Ether Countdown Branch Function - ECBFCT.
;NEXT7 = Interface buffer not empty.

ECNTOK:	ECNTR_ L,L_ T,ECBFCT,TASK;
	EPNTR_ L,:EODATA;	[EODATA,EIDATA]

;Ethernet Input

;It turns out that starting the receiver for the first time and
;restarting it after ignoring a packet do the same things.

EIREST:	:EIFIGN;		Hack

;Address filtering code.

;When the first word of a packet is available in the interface
;buffer, a wakeup request is generated.  The microcode then
;decides whether to accept the packet.  Decision must be reached
;before the buffer overflows, within about 14*5.44 usec.
;if EHLOC is zero, machine is 'promiscuous' - accept all packets
;if destination byte is zero, it is a 'broadcast' packet, accept.
;if destination byte equals EHLOC, packet is for us, accept.

;EIFRST is really a subroutine that can be called from EIREST
;or from EIGO, output countdown wait.  If a packet is ignored
;and EPNTR is zero, EIFRST loops back and waits for more
;packets, else it returns to the countdown code.

;Ether Branch Function - EBFCT
;NEXT7 = IDL % OCMD % ICMD % OUTGONE % INGONE (also known as POST)
;NEXT6 = COLLision - Can't happen during input

EIFRST:	MAR_ EHLOC;		Get Ethernet address
	T_ 377,EBFCT;		What's happening?
	L_ MD AND T,BUS=0,:EIFOK;[EIFOK,EIFBAD] promiscuous?

EIFOK:	MTEMP_ LLCY8,:EIFCHK;	[EIFCHK,EIFPRM] Data wakeup

EIFBAD:	ERBFCT,TASK,:EIFB1;	[EIFB1] POST wakeup; xCMD FF set?
EIFB1:	:EIFB00;		[EIFB00,EIFB01,EIFB10,EIFB11]

EIFB00:	:EIFIGN;		IDL or INGONE, restart rcvr
EIFB01:	L_ ESABRT,:EPOST;	OCMD, abort
EIFB10:	L_ ESABRT,:EPOST;	ICMD, abort
EIFB11:	L_ ESABRT,:EPOST;	ICMD and OCMD, abort

EIFPRM:	TASK,:EIFBC;		Promiscuous. Accept

;Ether Look Function - EILFCT.  Gate the first word of the 
;data buffer to the bus, but do not increment the read pointer.

EIFCHK:	L_ T_ 177400,EILFCT;	Mask off src addr byte (BUS AND)
	L_ MTEMP-T,SH=0;	Broadcast?
	SH=0,TASK,:EIFNBC;	[EIFNBC,EIFBC] Our Address?

EIFNBC:	:EIFIGN;		[EIFIGN,EISET]

EIFBC:	:EISET;			[EISET] Enter input main loop

;Ether Input Start Function - EISFCT.  Start receiver.  Interface
;will generate a data wakeup when the first word of the next
;packet arrives, ignoring any packet currently passing.

EIFIGN:	SINK_ EPNTR,BUS=0,EPFCT;Reset; Called from output?
	EISFCT,TASK,:EOCDWX;	[EOCDWX,EIGO] Restart rcvr

EOCDWX:	EWFCT,:EOCDWT;		Return to countdown wait loop

EISET:	MAR_ EICLOC,:ESETUP;	Double word reference

;Input Main Loop

;Ether Input Data Function - EIDFCT.  Gate a word of data to
;the bus from the interface data buffer, increment the read ptr.
;		* * * * * W A R N I N G * * * * *
;The delay from decoding EIDFCT to gating data to the bus is
;marginal, so this loop causes SysClk to stop for one cycle by
;referencing MD in cycle 4.

EIDATA:	L_ MAR_ EPNTR+1,EBFCT;	What's happening?
	T_ ECNTR-1,BUS=0,:EIDOK;[EIDOK,EIDPST] word count zero?
EIDOK:	EPNTR_ L,L_ T,:EIDMOR;	[EIDMOR,EIDFUL]
EIDMOR:	MD_ EIDFCT,TASK;	Read a word from interface
	ECNTR_ L,:EIDATA;

EIDPST:	L_ ESIDON,:EPOST;	[EPOST] Presumed to be INGONE

EIDFUL:	L_ ESIFUL,:EPOST;	Input buffer overrun

;Ethernet output

;It is possible to get here due to a collision.  If a collision
;happened, the interface was reset (EPFCT) to shut off the
;transmitter.  EOSFCT is issued to guarantee more wakeups while
;generating the countdown.  When this is done, the interface is
;again reset, without really doing an output.

EOREST:	MAR_ ELLOC;		Get load
	L_ R37;			Use clock as random # gen
	EPNTR_ LLSH1;		Use bits [2:9]
	L_ MD,EOSFCT;		L_ current load
	SH<0,ECNTR_ L;		Overflowed?
	MTEMP_ LLSH1,:EOLDOK;	[EOLDOK,EOLDBD]

EOLDBD:	L_ ESLOAD,:EPOST;	Load overlow

EOLDOK:	MAR_ ELLOC;		Write updated load
	L_ MTEMP+1;
	MTEMP_ L,TASK;
	MD_ MTEMP,:EORST1;	New load = (old lshift 1) + 1

EORST1:	L_ EPNTR;		Continue making random #
	EPNTR_ LLSH1;
	T_ 177400;
	L_ EPNTR AND T,TASK;
	EPNTR_ LLCY8,:EORST2;

;At this point, EPNTR has 0,,random number, ENCTR has old load.

EORST2:	MAR_ EICLOC;		Has an input buffer been set up?
	T_ ECNTR;
	L_ EPNTR AND T;		L_ Random & Load
	SINK_ MD,BUS=0;
	ECNTR_ L,SH=0,EPFCT,:EOINPR;[EOINPR,EOINPN] 

EOINPR:	EISFCT,:EOCDWT;		[EOCDWT,EOCDGO] Enable in under out

EOINPN:	:EOCDWT;		[EOCDWT,EOCDGO] No input.

;Countdown wait loop.  MRT will wake generate a wakeup every
;37 usec which will decrement ECNTR.  When it is zero, start
;the transmitter.

;Ether Wake Function - EWFCT.  Sets a flip flop which will cause
;a wakeup to this task the next time MRT wakes up (every 37 usec).
;Wakeup is cleared when Ether task next runs.  EWFCT must be
;issued in the instruction AFTER a task.

EOCDWT:	L_ 177400,EBFCT;	What's happening?
	EPNTR_ L,ECBFCT,:EOCDW0;[EOCDW0,EOCDRS] Packet coming in?
EOCDW0:	L_ ECNTR-1,BUS=0,TASK,:EOCDW1; [EOCDW1,EIGO]
EOCDW1:	ECNTR_ L,EWFCT,:EOCDWT;	[EOCDWT,EOCDGO]

EOCDRS:	L_ ESABRT,:EPOST;	[EPOST] POST event

EIGO:	:EIFRST;		[EIFRST] Input under output

;Output main loop setup

EOCDGO:	MAR_ EOCLOC;		Double word reference
	EPFCT;			Reset interface
	EOSFCT,:ESETUP;		Start Transmitter

;Ether Output Start Function - EOSFCT.  The interface will generate
;a burst of data requests until the interface buffer is full or the
;memory buffer is empty, wait for silence on the Ether, and begin
;transmitting.  Thereafter it will request a word every 5.44 us.

;Ether Output Data Function - EODFCT.  Copy the bus into the
;interface data buffer, increment the write pointer, clears wakeup
;request if the buffer is now nearly full (one slot available).

;Output main loop

EODATA:	L_ MAR_ EPNTR+1,EBFCT;	What's happening?
	T_ ECNTR-1,BUS=0,:EODOK; [EODOK,EODPST,EODCOL,EODUGH]
EODOK:	EPNTR_ L,L_ T,:EODMOR;	[EODMOR,EODEND]
EODMOR:	ECNTR_ L,TASK;
	EODFCT_ MD,:EODATA;	Output word to transmitter

EODPST:	L_ ESABRT,:EPOST;	[EPOST] POST event

EODCOL:	EPFCT,:EOREST;		[EOREST] Collision

EODUGH:	L_ ESABRT,:EPOST;	[EPOST] POST + Collision

;Ether EOT Function - EEFCT.  Stop generating output data wakeups,
;the interface has all of the packet.  When the data buffer runs
;dry, the interface will append the CRC and then generate an
;OUTGONE post wakeup.

EODEND:	EEFCT;			Disable data wakeups
	TASK;			Wait for EEFCT to take
	:EOEOT;			Wait for Outgone

;Output completion.  We are waiting for the interface buffer to
;empty, and the interface to generate an OUTGONE Post wakeup.

EOEOT:	EBFCT;			What's happening?
	:EOEOK;			[EOEOK,EOEPST,EOECOL,EOEUGH]

EOEOK:	L_ ESNEVR,:EPOST;	Runaway Transmitter. Never Never.

EOEPST:	L_ ESODON,:EPOST;	POST event.  Output done

EOECOL:	EPFCT,:EOREST;		Collision

EOEUGH:	L_ ESABRT,:EPOST;	POST + Collision


;MEMORY REFRESH TASK AND MOUSE HANDLER
; DLS modifications: remove mouse, cursor, and interval timer, and
; add code to maintain timer queue pointer for DLS and to set
; R37[15] _ 1 if R37[14] = 1.

$TIME	$R15;
$MTEMP	$R25;
$R37	$R37;

!1,2, NOCLK, CLOCK;
!1,2, POKEDLS, NOPOKE;

MRT:	T_REFMSK;
	MAR_R37 AND T, T_R37;
	L_T_77+T+1;
	R37_L, ALUCY;
CLKRET: L_2 AND T, :NOCLK;	[NOCLK, CLOCK]
NOCLK:	L_ONE OR T, SH=0;
	T_TIME+1, :POKEDLS;	[POKEDLS, NOPOKE]

POKEDLS: R37_L;
NOPOKE:	L_377 AND T, TASK;
	TIME_L, :MRT;


CLOCK:	MAR_ CLOCKLOC;		R37 OVERFLOWED. UPDATE CLOCK
	NOP;
	L_ MD+1;
	MAR_ CLOCKLOC;
	MTEMP_ L;
	MD_ MTEMP, :CLKRET;




;CURSOR TASK
; DLS modification: blocks itself whenever it is started

$CSR	$L26011, 0, 124000;

CURT:	BLOCK;
	MTEMP_L, CSR_0, TASK;	Loading MTEMP zeroes the bus
	:CURT;

;NOVA EMULATOR
; DLS modifications:  Booting simply sends control to START in the Rom
; (for silent boot feature);  main loop checks R37[15] on every iteration
; and goes to DLS processing if it is set; SIT instruction abolished;
; BLT, BLKS, and BITBLT poll for DLS service as well as normal interrupts;
; DLSOFF, DLSON, GCRB, QCH, ORM, ANDM, SETBLV, RRB, WRB instructions added.

$SAD	$R5;
$PC	$R6;		USED BY MEMORY INIT


!1,2,FINSTO,INCPC;

NOVEM:	SWMODE, :TOSTART;


;REGISTERS USED BY NOVA EMULATOR 
$AC0	$R3;	AC'S ARE BACKWARDS BECAUSE THE HARDWARE SUPPLIES THE
;		COMPLEMENT ADDRESS WHEN ADDRESSING FROM IR
$AC1	$R2;
$AC2	$R1;
$AC3	$R0;
$XREG	$R7;


;PREDEFINITIONS FOR NOVA

!17,20,GETAD,G1,G2,G3,G4,G5,G6,G7,G10,G11,G12,G13,G14,G15,G16,G17;
!17,20,XCTAB,XJSR,XISZ,XDSZ,XLDA,XSTA,CONVERT,,,,,,,,,;
!3,4,SHIFT,SH1,SH2,SH3;
!1,2,MAYBE,NOINT;
!1,2,DOINT,DIS0;
!1,2,SOMEACTIVE,NOACTIVE;
!1,2,IEXIT,NIEXIT;
!17,1,ODDCX;
!1,2,EIR0,EIR1;
!7,1,INTCODE;
!1,2,INTSOFF,INTSON;***X21 addition for DIRS
!7,10,EMCYCRET,RAMCYCRET,CYX2,CYX3,CYX4,CONVCYCRET,,;
!7,2,MOREBLT,FINBLT;
!1,2,DOIT,DISABLED;
!1,2, NODLS, DLS;
!1,2, START1, BBRET;

; ALL INSTRUCTIONS RETURN TO START WHEN DONE

START:	SINK_R37, BUSODD;	Test for DLS activity
START1:	T_L_MAR_PC+SKIP, :NODLS; [NODLS, DLS]
NODLS:	L_ NWW, BUS=0;	BUS# 0 MEANS DISABLED OR SOMETHING TO DO
	:MAYBE, SH<0, L_ 0+T+1;  	SH<0 MEANS DISABLED
MAYBE:	PC_ L, L_ T, :DOINT;
NOINT:	PC_ L, :DIS0;

DOINT:	MAR_ WWLOC, :INTCODE;	TRY TO CAUSE AN INTERRUPT



;DISPATCH ON FUNCTION FIELD IF ARITHMETIC INSTRUCTION,
;OTHERWISE ON INDIRECT BIT AND INDEX FIELD

DIS0:	L_ T_ IR_ MD;	SKIP CLEARED HERE

;DISPATCH ON SHIFT FIELD IF ARITHMETIC INSTRUCTION,
; THIS INSTRUCTION IS USEFUL ONLY ON ARITHMETIC INSTRUCTIONS

DIS1:	T_ ACSOURCE, :GETAD;


;GETAD MUST BE 0 MOD 20
GETAD: T_ 0, :DOINS;			PAGE 0
G1:	T_ PC -1, :DOINS;		RELATIVE
G2:	T_ AC2, :DOINS;		AC2 RELATIVE
G3:	T_ AC3, :DOINS;		AC3 RELATIVE
G4:	T_ 0, :DOINS;			PAGE 0 INDIRECT
G5:	T_ PC -1, :DOINS;		RELATIVE INDIRECT
G6:	T_ AC2, :DOINS;		AC2 RELATIVE INDIRECT
G7:	T_ AC3, :DOINS;		AC3 RELATIVE INDIRECT
G10:	L_ 0-T-1, TASK, :SHIFT;	COMPLEMENT
G11:	L_ 0-T, TASK, :SHIFT;		NEGATE
G12:	L_ 0+T, TASK, :SHIFT;		MOVE
G13:	L_ 0+T+1, TASK, :SHIFT;		INCREMENT
G14:	L_ ACDEST-T-1, TASK, :SHIFT;	ADD COMPLEMENT
G15:	L_ ACDEST-T, TASK, :SHIFT;	SUBTRACT
G16:	L_ ACDEST+T, TASK, :SHIFT;	ADD
G17:	L_ ACDEST AND T, TASK, :SHIFT;


SHIFT:	DNS_ L LCY 8, :START; 	SWAP BYTES
SH1:	DNS_ L RSH 1, :START;	RIGHT 1
SH2:	DNS_ L LSH 1, :START;	LEFT 1
SH3:	DNS_ L, :START;		NO SHIFT


DOINS:	L_ DISP + T, TASK, :SAVAD, IDISP;		 DIRECT INSTRUCTIONS
DOIND:	L_ MAR_ DISP+T;		INDIRECT INSTRUCTIONS
	XREG_ L;
	L_ MD, TASK, IDISP, :SAVAD;

BRI:	L_ MAR_ PCLOC	;INTERRUPT RETURN BRANCH
BRI0:	T_ 77777;
	L_ NWW AND T, SH < 0;
	NWW_ L, :EIR0;	BOTH EIR AND BRI MUST CHECK FOR INTERRUPT
;			REQUESTS WHICH MAY HAVE COME IN WHILE
;			INTERRUPTS WERE OFF


EIR0:	L_ MD, :DOINT;
EIR1:	L_ PC, :DOINT;


;***X21 addition: Disable Interrupts and Skip if On
DIRS:	T_100000;	Disable interrupts and skip if they were
	L_NWW AND T;	previously enabled
	L_PC+1, SH=0;

DIR:	T_ 100000, :INTSOFF;	DISABLE INTERRUPTS
INTSOFF: L_ NWW OR T, TASK, :INTZ;

INTSON: PC_L, :INTSOFF;


EIR:	L_ 100000, :BRI0;	ENABLE INTERRUPTS


FINJSR:	L_ PC;
	AC3_ L, L_ T, TASK;
FINJMP:	PC_ L, :START;
SAVAD:	SAD_ L, :XCTAB;

;JSR DOUBLE INDIRECT, PC RELATIVE.  MUST HAVE X=1 IN OPCODE
JSRII:	MAR_ DISP+T;	FIRST LEVEL
	IR_ JSRCX;	<JSR 0>
	T_ MD, :DOIND;	THE IR_ INSTRUCTION WILL NOT BRANCH	

;TRAP ON UNIMPLEMENTED OPCODES.  SAVES  PC AT
;TRAPPC, AND DOES A JMP@ TRAPVEC ! OPCODE.
TRAP:	XREG_ L LCY 8;	THE INSTRUCTION
TRAP1:	MAR_ TRAPPC;***X13 CHANGE: TAG 'TRAP1' ADDED
	IR_ T_ 37;
	T_ XREG.T;
	T_ TRAPCON+T+1;	T NOW CONTAINS 471+OPCODE
	MD_ PC, :DOIND;		THIS WILL DO JMP@ 530+OPCODE


;***X21 CHANGE: ADDED TAG RAMTRAP
RAMTRAP: SWMODE, :TRAP;



; Parameterless operations come here for dispatch.

!1,2,NPNOTRAP,NPTRAP;

NOPAR:	XREG_L LCY 8;
	T_30;			Greatest defined op is 27 (**DLS**)
	L_DISP-T;
	ALUCY;
	SINK_DISP, SINK_X37, BUS, TASK, :NPNOTRAP;

NPNOTRAP: :DIR;

NPTRAP: :TRAP1;

;***X21 addition for debugging w/ expanded DISP Prom
U5:	:RAMTRAP;
U6:	:RAMTRAP;
U7:	:RAMTRAP;



;MAIN INSTRUCTION TABLE.  GET HERE:
;		(1) AFTER AN INDIRECTION
;		(2) ON DIRECT INSTRUCTIONS 

XCTAB:	L_ SAD, TASK, :FINJMP;			JMP
XJSR:	T_ SAD, :FINJSR;			JSR
XISZ:	MAR_ SAD, :ISZ1;
XDSZ:	MAR_ SAD, :DSZ1;
XLDA:	MAR_ SAD, :FINLOAD;			LDA 0-3
XSTA:	MAR_ SAD;		/*NORMAL
	L_ ACDEST, :FINSTO;	/*NORMAL

;	BOUNDS-CHECKING VERSION OF STORE
;	SUBST ";**<CR>" TO "<CR>;**" TO ENABLE THIS CODE:
;**	!1,2,XSTA1,XSTA2;
;**	!1,2,DOSTA,TRAPSTA;
;**XSTA:	MAR_ 10;	LOCS 10,11 CONTAINS HI,LO BOUNDS
;**	T_ SAD
;**	L_ MD-T;	HIGHBOUND-ADDR
;**	T_ MD, ALUCY;
;**	L_ SAD-T, :XSTA1;	ADDR-LOWBOUND
;**XSTA1:	TASK, :XSTA3;
;**XSTA2:	ALUCY, TASK;
;**XSTA3:	L_ 177, :DOSTA;
;**TRAPSTA:	XREG_ L, :TRAP1;	CAUSE A SWAT
;**DOSTA:	MAR_ SAD;	DO THE STORE NORMALLY
;**	L_ ACDEST, :FINSTO;
;**

DSZ1:	T_ ALLONES, :FINISZ;
ISZ1:	T_ ONE, :FINISZ;

FINSTO:	SAD_ L,TASK;
FINST1:	MD_SAD, :START;


FINLOAD: NOP;
LOADX:	L_ MD, TASK;
LOADD:	ACDEST_ L, :START;

FINISZ:	L_ MD+T;
	MAR_ SAD, SH=0;
	SAD_ L, :FINSTO;

INCPC:	L_ PC+1;
	PC_ L, TASK, :FINST1;




;DIVIDE.  THIS DIVIDE IS IDENTICAL TO THE NOVA DIVIDE EXCEPT THAT
;IF THE DIVIDE CANNOT BE DONE, THE INSTRUCTION FAILS TO SKIP, OTHERWISE
;IT DOES.  CARRY IS UNDISTURBED.

!1,2,DODIV,NODIV;
!1,2,DIVL,ENDDIV;
!1,2,NOOVF,OVF;
!1,2,DX0,DX1;
!1,2,NOSUB,DOSUB;

DIV:	T_ AC2;
DIVX:	L_ AC0 - T;	DO THE DIVIDE ONLY IF AC2>AC0
	ALUCY, TASK, SAD_ L, L_ 0+1;
	:DODIV, SAD_ L LSH 1;		SAD_ 2.  COUNT THE LOOP BY SHIFTING

NODIV:	:FINBLT;		***X21 change.
DODIV:	L_ AC0, :DIV1;

DIVL:	L_ AC0;
DIV1:	SH<0, T_ AC1;	WILL THE LEFT SHIFT OF THE DIVIDEND OVERFLOW?
	:NOOVF, AC0_ L MLSH 1, L_ T_ 0+T;	L_ AC1, T_ 0

OVF:	AC1_ L LSH 1, L_ 0+INCT, :NOV1;		L_ 1. SHIFT OVERFLOWED
NOOVF:	AC1_ L LSH 1 , L_ T;			L_ 0. SHIFT OK

NOV1:	T_ AC2, SH=0;
	L_ AC0-T, :DX0;

DX1:	ALUCY;		DO THE TEST ONLY IF THE SHIFT DIDN'T OVERFLOW.  IF 
;			IT DID, L IS STILL CORRECT, BUT THE TEST WOULD GO
;			THE WRONG WAY.
	:NOSUB, T_ AC1;

DX0:	:DOSUB, T_ AC1;

DOSUB:	AC0_ L, L_ 0+INCT;	DO THE SUBTRACT
	AC1_ L;			AND PUT A 1 IN THE QUOTIENT

NOSUB:	L_ SAD, BUS=0, TASK;
	SAD_ L LSH 1, :DIVL;

ENDDIV:	L_ PC+1, TASK, :DOIT; ***X21 change. Skip if divide was done.


;MULTIPLY.  THIS IS AN EXACT EMULATION OF NOVA HARDWARE MULTIPLY.
;AC2 IS THE MULTIPLIER, AC1 IS THE MULTIPLICAND.
;THE PRODUCT IS IN AC0 (HIGH PART), AND AC1 (LOW PART).
;PRECISELY: AC0,AC1 _ AC1*AC2  + AC0

!1,2,DOMUL,NOMUL;
!1,2,MPYL,MPYA;
!1,2,NOADDIER,ADDIER;
!1,2,NOSPILL,SPILL;
!1,2,NOADDX,ADDX;
!1,2,NOSPILLX,SPILLX;


MUL:	L_ AC2-1, BUS=0;
MPYX:	XREG_L,L_ 0, :DOMUL;	GET HERE WITH AC2-1 IN L. DON'T MUL IF AC2=0
DOMUL:	TASK, L_ -10+1;
	SAD_ L;		COUNT THE LOOP IN SAD

MPYL:	L_ AC1, BUSODD;
	T_ AC0, :NOADDIER;

NOADDIER:	AC1_ L MRSH 1, L_ T, T_ 0, :NOSPILL;
ADDIER:		L_ T_ XREG+INCT;
		L_ AC1, ALUCY, :NOADDIER;

SPILL:	T_ ONE;
NOSPILL:	AC0_ L MRSH 1;
	L_ AC1, BUSODD;
	T_ AC0, :NOADDX;

NOADDX:	AC1_ L MRSH 1, L_ T, T_ 0, :NOSPILLX;
ADDX:	L_ T_ XREG+ INCT;
	L_ AC1,ALUCY, :NOADDX;

SPILLX:	T_ ONE;
NOSPILLX:	AC0_ L MRSH 1;
	L_ SAD+1, BUS=0, TASK;
	SAD_ L, :MPYL;


NOMUL:	T_ AC0;
	AC0_ L, L_ T, TASK;		CLEAR AC0
	AC1_ L;			AND REPLACE AC1 WITH AC0
MPYA:	:FINBLT;		***X21 change.





;CYCLE AC0 LEFT BY DISP MOD 20B, UNLESS DISP=0, IN WHICH
;CASE CYCLE BY AC1 MOD 20B
;LEAVES AC1=CYCLE COUNT-1 MOD 20B
$CYRET		$R5;	Shares space with SAD.
$CYCOUT	$R7;	Shares space with XREG.
!1,2,EMCYCX,ACCYCLE;
!1,1,Y1;
!1,1,Y2;
!1,1,Y3;
!1,1,Z1;
!1,1,Z2;
!1,1,Z3;

EMCYCLE: L_ DISP, SINK_ X17, BUS=0;	CONSTANT WITH BS=7
CYCP:	T_ AC0, :EMCYCX;

ACCYCLE: T_ AC1;
	L_ 17 AND T, :CYCP;

EMCYCX: CYCOUT_L, L_0, :RETCYCX;

RAMCYCX: CYCOUT_L, L_0+1;

RETCYCX: CYRET_L, L_0+T;
	SINK_CYCOUT, BUS;
	TASK, :L0;

;TABLE FOR CYCLE
R4:	CYCOUT_ L MRSH 1;
Y3:	L_ T_ CYCOUT, TASK;
R3X:	CYCOUT_ L MRSH 1;
Y2:	L_ T_ CYCOUT, TASK;
R2X:	CYCOUT_ L MRSH 1;
Y1:	L_ T_ CYCOUT, TASK;
R1X:	CYCOUT_ L MRSH 1, :ENDCYCLE;

L4:	CYCOUT_ L MLSH 1;
Z3:	L_ T_ CYCOUT, TASK;
L3:	CYCOUT_ L MLSH 1;
Z2:	L_ T_ CYCOUT, TASK;
L2:	CYCOUT_ L MLSH 1;
Z1:	L_ T_ CYCOUT, TASK;
L1:	CYCOUT_ L MLSH 1, :ENDCYCLE;
L0:	CYCOUT_ L, :ENDCYCLE;

L8:	CYCOUT_ L LCY 8, :ENDCYCLE;
L7:	CYCOUT_ L LCY 8, :Y1;
L6:	CYCOUT_ L LCY 8, :Y2;
L5:	CYCOUT_ L LCY 8, :Y3;

R7:	CYCOUT_ L LCY 8, :Z1;
R6:	CYCOUT_ L LCY 8, :Z2;
R5:	CYCOUT_ L LCY 8, :Z3;

ENDCYCLE: SINK_ CYRET, BUS, TASK;
	:EMCYCRET;

EMCYCRET: L_CYCOUT, TASK, :LOADD;

RAMCYCRET: T_PC, BUS, SWMODE, :TORAM;



; Scan convert instruction for characters. Takes DWAX (Destination
; word address)-NWRDS in AC0, and a pointer to a .AL-format font
; in AC3. AC2+displacement contains a pointer to a two-word block
; containing NWRDS and DBA (Destination Bit Address).

$XH	$R10;
$DWAX	$R35;
$MASK	$R36;

!1,2,HDLOOP,HDEXIT;
!1,2,MERGE,STORE;
!1,2,NFIN,FIN;
!17,2,DOBOTH,MOVELOOP;

CONVERT: MAR_XREG+1; Got here via indirect mechanism which
			; left first arg in SAD, its address in XREG. 
	T_17;
	L_MD AND T;

	T_MAR_AC3;
	AC1_L;		AC1_DBA&#17
	L_MD+T, TASK;
	AC3_L;		AC3_Character descriptor block address(Char)

	MAR_AC3+1;
	T_177400;
	IR_L_MD AND T;		IR_XH
	XH_L LCY 8, :ODDCX;	XH register temporarily contains HD
ODDCX:	L_AC0, :HDENTER;

HDLOOP: T_SAD;			(really NWRDS)
	L_DWAX+T;

HDENTER: DWAX_L;		DWAX _ AC0+HD*NWRDS
	L_XH-1, BUS=0, TASK;
	XH_L, :HDLOOP;

HDEXIT:	T_MASKTAB;
	MAR_T_AC1+T;		Fetch the mask.
	L_DISP;
	XH_L;			XH register now contains XH
	L_MD;
	MASK_L, L_0+T+1, TASK;
	AC1_L;			***X21. AC1 _ (DBA&#17)+1

	L_5;			***X21. Calling conventions changed.
	IR_SAD, TASK;
	CYRET_L, :MOVELOOP;	CYRET_CALL5

MOVELOOP: L_T_XH-1, BUS=0;
	MAR_AC3-T-1, :NFIN;	Fetch next source word
NFIN:	XH_L;
	T_DISP;			(really NWRDS)
	L_DWAX+T;		Update destination address
	T_MD;
	SINK_AC1, BUS;
	DWAX_L, L_T, TASK, :L0;	Call Cycle subroutine

CONVCYCRET: MAR_DWAX;
	T_MASK, BUS=0;
	T_CYCOUT.T, :MERGE;	Data for first word. If MASK=0
				; then store the word rather than
				; merging, and do not disturb the
				; second word.
MERGE:	L_XREG AND NOT T;	Data for second word.
	T_MD OR T;		First word now merged,
	MAR_DWAX;			restore it.
	XREG_L, L_T;
	MTEMP_L;
	SINK_XREG, BUS=0, TASK;
	MD_MTEMP, :DOBOTH;	XREG=0 means only one word
				; is involved.

DOBOTH: MAR_DWAX+1;
	T_XREG;
	L_MD OR T;
	MAR_DWAX+1;
	XREG_L, TASK;		***X21. TASK added.
STORE:	MD_XREG, :MOVELOOP;

FIN:	L_AC1-1;		***X21. Return AC1 to DBA&#17.
	AC1_L;			*** ... bletch ...
	IR_SH3CONST;
	L_MD, TASK, :SH1;




RCLK:	MAR_ CLOCKLOC;	READ REAL TIME CLOCK INTO AC0 (HIGH) AND AC1(LOW)
	L_ R37;
	AC1_ L, :LOADX;

SIO:	L_ AC0, STARTF;
	T_77777;		***X21 sets AC0[0] to 0
	L_ RSNF AND T;
LTOAC0:	AC0_ L, TASK, :TOSTART;


$EngBuild	$0;**** This will change with machine!!!

VERS:	T_EngBuild;  ***X21 addition
	L_3+T, :LTOAC0;	*** Altocode24 is called ucode version 3!!!!


;BLOCK TRANSFER AND BLOCK STORE
;AC0= FIRST SOURCE WORD-1 FOR BLT, OR DATA TO BE STORED FOR BLKS
;AC1= LAST WORD OF DESTINATION AREA 
;AC3= NEGATIVE WORD COUNT
;LEAVES AC3= 0
;AC0 = ADDRESS OF LAST SOURCE WORD +1 (BLT), OR UNCHANGED (BLKS)
;AC1 = UNCHANGED
;PC = PC-1 if termination was due to interrupt detection.


!1,2,PERHAPS, NO;
!1,2,~DLSRq,DLSRq;

BLT:	L_ MAR_ AC0+1;
	AC0_ L;
	L_ MD, :BLKSA;

BLKS:	L_ AC0;
BLKSA:	T_ AC3+1, BUS=0;
	MAR_ AC1+T, :MOREBLT;

MOREBLT:	XREG_ L, L_ T;
	AC3_ L;
	SINK_ R37, BUSODD, TASK;	Test for DLS service request
	MD_ XREG, :~DLSRq;	[~DLSRq, DLSRq] STORE
~DLSRq:	L_ NWW, BUS=0;		CHECK FOR INTERRUPT
	SH<0, :PERHAPS, L_ PC-1;	Prepare to back up PC.

NO:	SINK_ DISP, SINK_ M7, BUS, :DISABLED;

PERHAPS:	SINK_ DISP, SINK_ M7, BUS, :DOIT;

DLSRq:	L_ PC-1;		DLS request pending
DOIT:	PC_L, :FINBLT;	***X21. Reset PC, terminate instruction.

DISABLED:	:DIR;	GOES TO BLT OR BLKS

FINBLT:	T_777;	***X21. PC in [177000-177777] means Ram return
	L_PC+T+1;
	L_PC AND T, TASK, ALUCY;
TOSTART: XREG_L, :START;

RAMRET: T_XREG, BUS, SWMODE;
TORAM:	:NOVEM;
 

;PARAMETERLESS INSTRUCTIONS FOR DIDDLING THE WCS.

JMPR:	T_AC1, BUS, SWMODE, :TORAM;	JUMP TO THE RAM ADDRESS SPECIFIED BY AC1


RDRM:	T_ AC1, RDRAM;	READ THE RAM WORD ADDRESSED BY AC1 INTO AC0
	L_ ALLONES, TASK, :LOADD;


WTRM:	T_ AC1;		WRITE AC0,AC3 INTO THE RAM LOCATION ADDRESSED BY AC1
	L_ AC0, WRTRAM;
	L_ AC3, :FINBLT;


;INTERRUPT SYSTEM.  TIMING IS 0 CYCLES IF DISABLED, 18 CYCLES
;IF THE INTERRUPTING CHANEL IS INACTIVE, AND 36+6N CYCLES TO CAUSE
;AN INTERRUPT ON CHANNEL N

INTCODE:	PC_ L, IR_ 0;	
	T_ NWW;
	T_ MD OR T;
	L_ MD AND T;
	SAD_ L, L_ T, SH=0;	SAD HAD POTENTIAL INTERRUPTS
	NWW_ L, L_0+1, :SOMEACTIVE;	NWW HAS NEW WW

NOACTIVE:	MAR_ WWLOC;	RESTORE WW TO CORE
	L_ SAD;			AND REPLACE IT WITH SAD IN NWW
	MD_ NWW, TASK;
INTZ:	NWW_ L, :START;

SOMEACTIVE:	MAR_ PCLOC;	STORE PC AND SET UP TO FIND HIGHEST PRIORITY REQUEST
	XREG_ L, L_ 0;
	MD_ PC, TASK;

ILPA:	PC_ L;
ILP:	T_ SAD;
	L_ T_ XREG AND T;
	SH=0, L_ T, T_ PC;
	:IEXIT, XREG_ L LSH 1;

NIEXIT:	L_ 0+T+1, TASK, :ILPA;
IEXIT:	MAR_ PCLOC+T+1;		FETCH NEW PC. T HAS CHANNEL #, L HAS MASK

	XREG_ L;
	T_ XREG;
	L_ NWW XOR T;	TURN OFF BIT IN WW FOR INTERRUPT ABOUT TO HAPPEN
	T_ MD;
	NWW_ L, L_ T;
	PC_ L, L_ T_ 0+1, TASK;
	SAD_ L MRSH 1, :NOACTIVE;	SAD_ 1B5 TO DISABLE INTERRUPTS

;
;	************************
;	* BIT-BLT - 61024 *
;	************************
;
;	/* NOVA REGS
;	AC2 -> BLT DESCRIPTOR TABLE, AND IS PRESERVED
;	AC1 CARRIES LINE COUNT FOR RESUMING AFTER AN
;		INTERRUPT. MUST BE 0 AT INITIAL CALL
;	AC0 AND AC3 ARE SMASHED TO SAVE S-REGS
;
;	/* ALTO REGISTER USAGE
;DISP CARRIES:	TOPLD(20), SOURCE(14), OP(3)
$MASK1	$R0;
$YMUL	$R2;	HAS TO BE AN R-REG FOR SHIFTS
$RETN	$R2;
$SKEW	$R3;
$TEMP	$R5;
$WIDTH	$R7;
$PLIER	$R7;	HAS TO BE AN R-REG FOR SHIFTS
$DESTY	$R10;
$WORD2	$R10;
$STARTBITSM1	$R35;
$SWA	$R36;
$DESTX	$R36;
$LREG	$R40;	HAS TO BE R40 (COPY OF L-REG)
$NLINES	$R41;
$RAST1	$R42;
$SRCX	$R43;
$SKMSK	$R43;
$SRCY	$R44;
$RAST2	$R44;
$CONST	$R45;
$TWICE	$R45;
$HCNT	$R46;
$VINC	$R46;
$HINC	$R47;
$NWORDS	$R50;
$MASK2	$R51;	WAS $R46;
;
$LASTMASKP1	$500;	MASKTABLE+021
$170000	$170000;
$CALL3	$3;	SUBROUTINE CALL INDICES
$CALL4	$4;
$DWAOFF	$2;	BLT TABLE OFFSETS
$DXOFF	$4;
$DWOFF	$6;
$DHOFF	$7;
$SWAOFF	$10;
$SXOFF	$12;
$GRAYOFF	$14;	GRAY IN WORDS 14-17
$LASTMASK	$477;	MASKTABLE+020	**NOT IN EARLIER PROMS!


;	BITBLT SETUP - CALCULATE RAM STATE FROM AC2'S TABLE
;	----------------------------------------------------------
;
;	/* FETCH COORDINATES FROM TABLE
	!1,2,FDDX,BLITX;
	!1,2,FDBL,BBNORAM;
	!17,20,FDBX,,,,FDX,,FDW,,,,FSX,,,,,;	FDBL RETURNS (BASED ON OFFSET)
;	        (0)     4    6      12
BITBLT:	L_ 0;
	SINK_ LREG, BUSODD;	SINK_ -1 IFF NO RAM
	L_ T_ DWOFF, :FDBL;
BBNORAM:	TASK, :NPTRAP;	TRAP IF NO RAM
;
FDW:	T_ MD;			PICK UP WIDTH, HEIGHT
	WIDTH_ L, L_ T, TASK, :NZWID;
NZWID:	NLINES_ L;
	T_ AC1;
	L_ NLINES-T;
	NLINES_ L, SH<0, TASK;
	:FDDX;
;
FDDX:	L_ T_ DXOFF, :FDBL;	PICK UP DEST X AND Y
FDX:	T_ MD;
	DESTX_ L, L_ T, TASK;
	DESTY_ L;
;
	L_ T_ SXOFF, :FDBL;	PICK UP SOURCE X AND Y
FSX:	T_ MD;
	SRCX_ L, L_ T, TASK;
	SRCY_ L, :CSHI;
;
;	/* FETCH DOUBLEWORD FROM TABLE (L_ T_ OFFSET, :FDBL)
FDBL:	MAR_ AC2+T;
	SINK_ LREG, BUS;
FDBX:	L_ MD, :FDBX;
;
;	/* CALCULATE SKEW AND HINC
	!1,2,LTOR,RTOL;
CSHI:	T_ DESTX;
	L_ SRCX-T-1;
	T_ LREG+1, SH<0;	TEST HORIZONTAL DIRECTION
	L_ 17.T, :LTOR;	SKEW _ (SRCX - DESTX) MOD 16
RTOL:	SKEW_ L, L_ 0-1, :AH, TASK;	HINC _ -1
LTOR:	SKEW_ L, L_ 0+1, :AH, TASK;	HINC _ +1
AH:	HINC_ L;
;
;	CALCULATE MASK1 AND MASK2
	!1,2,IFRTOL,LNWORDS;
	!1,2,POSWID,NEGWID;
CMASKS:	T_ DESTX;
	T_ 17.T;
	MAR_ LASTMASKP1-T-1;
	L_ 17-T;		STARTBITS _ 16 - (DESTX.17)
	STARTBITSM1_ L;
	L_ MD, TASK;
	MASK1_ L;		MASK1 _ @(MASKLOC+STARTBITS)
	L_ WIDTH-1;
	T_ LREG-1, SH<0;
	T_ DESTX+T+1, :POSWID;
POSWID:	T_ 17.T;
;	T_ 0+T+1;	**
;	MAR_ LASTMASKP1-T-1;	**REPLACE THESE 2 BY 1 BELOW IN #21
	MAR_ LASTMASK-T-1;
	T_ ALLONES;		MASK2 _ NOT
	L_ HINC-1;
	L_ MD XOR T, SH=0, TASK;	@(MASKLOC+(15-((DESTX+WIDTH-1).17)))
	MASK2_ L, :IFRTOL;
;	/* IF RIGHT TO LEFT, ADD WIDTH TO X'S AND EXCH MASK1, MASK2
IFRTOL:	T_ WIDTH-1;	WIDTH-1
	L_ SRCX+T;
	SRCX_ L;		SRCX _ SCRX + (WIDTH-1)
	L_ DESTX+T;
	DESTX_ L;	DESTX _ DESTX + (WIDTH-1)
	T_ DESTX;
	L_ 17.T, TASK;
	STARTBITSM1_ L;	STARTBITS _ (DESTX.17) + 1
	T_ MASK1;
	L_ MASK2;
	MASK1_ L, L_ T,TASK;	EXCHANGE MASK1 AND MASK2
	MASK2_L;
;
;	/* CALCULATE NWORDS
	!1,2,LNW1,THIN;
LNWORDS:T_ STARTBITSM1+1;
	L_ WIDTH-T-1;
	T_ 177760, SH<0;
	T_ LREG.T, :LNW1;
LNW1:	L_ CALL4;		NWORDS _ (WIDTH-STARTBITS)/16
	CYRET_ L, L_ T, :R4, TASK; CYRET_CALL4
;	**WIDTH REG NOW FREE**
CYX4:	L_ CYCOUT, :LNW2;
THIN:	T_ MASK1;	SPECIAL CASE OF THIN SLICE
	L_MASK2.T;
	MASK1_ L, L_ 0-1;	MASK1 _ MASK1.MASK2, NWORDS _ -1
LNW2:	NWORDS_ L;	LOAD NWORDS
;	**STARTBITSM1 REG NOW FREE**
;
;	/* DETERMINE VERTICAL DIRECTION
	!1,2,BTOT,TTOB;
	T_ SRCY;
	L_ DESTY-T;
	T_ NLINES-1, SH<0;
	L_ 0, :BTOT;	VINC _ 0 IFF TOP-TO-BOTTOM
BTOT:	L_ ALLONES;	ELSE -1
BTOT1:	VINC_ L;
	L_ SRCY+T;		GOING BOTTOM TO TOP
	SRCY_ L;			ADD NLINES TO STARTING Y'S
	L_ DESTY+T;
	DESTY_ L, L_ 0+1, TASK;
	TWICE_L, :CWA;
;
TTOB:	T_ AC1, :BTOT1;		TOP TO BOT, ADD NDONE TO STARTING Y'S
;	**AC1 REG NOW FREE**;
;
;	/* CALCULATE WORD ADDRESSES - DO ONCE FOR SWA, THEN FOR DWAX
CWA:	L_ SRCY;	Y HAS TO GO INTO AN R-REG FOR SHIFTING
	YMUL_ L;
	T_ SWAOFF;		FIRST TIME IS FOR SWA, SRCX
	L_ SRCX;
;	**SRCX, SRCY REG NOW FREE**
DOSWA:	MAR_ AC2+T;		FETCH BITMAP ADDR AND RASTER
	XREG_ L;
	L_CALL3;
	CYRET_ L;		CYRET_CALL3
	L_ MD;
	T_ MD;
	DWAX_ L, L_T, TASK;
	RAST2_ L;
	T_ 177760;
	L_ T_ XREG.T, :R4, TASK;	SWA _ SWA + SRCX/16
CYX3:	T_ CYCOUT;
	L_ DWAX+T;
	DWAX_ L;
;
	!1,2,NOADD,DOADD;
	!1,2,MULLP,CDELT;	SWA _ SWA + SRCY*RAST1
	L_ RAST2;
	SINK_ YMUL, BUS=0, TASK;	NO MULT IF STARTING Y=0
	PLIER_ L, :MULLP;
MULLP:	L_ PLIER, BUSODD;		MULTIPLY RASTER BY Y
	PLIER_ L RSH 1, :NOADD;
NOADD:	L_ YMUL, SH=0, TASK;	TEST NO MORE MULTIPLIER BITS
SHIFTB:	YMUL_ L LSH 1, :MULLP;
DOADD:	T_ YMUL;
	L_ DWAX+T;
	DWAX_ L, L_T, :SHIFTB, TASK;
;	**PLIER, YMUL REG NOW FREE**
;
	!1,2,HNEG,HPOS;
	!1,2,VPOS,VNEG;
	!1,1,CD1;		CALCULATE DELTAS = +-(NWORDS+2)[HINC] +-RASTER[VINC]
CDELT:	L_ T_ HINC-1;	(NOTE T_ -2 OR 0)
	L_ T_ NWORDS-T, SH=0;	(L_NWORDS+2 OR T_NWORDS)
CD1:	SINK_ VINC, BUSODD, :HNEG;
HNEG:	T_ RAST2, :VPOS;
HPOS:	L_ -2-T, :CD1;	(MAKES L_-(NWORDS+2))
VPOS:	L_ LREG+T, :GDELT, TASK;	BY NOW, LREG = +-(NWORDS+2)
VNEG:	L_ LREG-T, :GDELT, TASK;	AND T = RASTER
GDELT:	RAST2_ L;
;
;	/* END WORD ADDR LOOP
	!1,2,ONEMORE,CTOPL;
	L_ TWICE-1;
	TWICE_ L, SH<0;
	L_ RAST2, :ONEMORE;	USE RAST2 2ND TIME THRU
ONEMORE:	RAST1_ L;
	L_ DESTY, TASK;	USE DESTY 2ND TIME THRU
	YMUL_ L;
	L_ DWAX;		USE DWAX 2ND TIME THRU
	T_ DESTX;	CAREFUL - DESTX=SWA!!
	SWA_ L, L_ T;	USE DESTX 2ND TIME THRU
	T_ DWAOFF, :DOSWA;	AND DO IT AGAIN FOR DWAX, DESTX
;	**TWICE, VINC REGS NOW FREE**
;
;	/* CALCULATE TOPLD
	!1,2,CTOP1,CSKEW;
	!1,2,HM1,H1;
	!1,2,NOTOPL,TOPL;
CTOPL:	L_ SKEW, BUS=0, TASK;	IF SKEW=0 THEN 0, ELSE
CTX:	IR_ 0, :CTOP1;
CTOP1:	T_ SRCX;	(SKEW GR SRCX.17) XOR (HINC EQ 0)
	L_ HINC-1;
	T_ 17.T, SH=0;	TEST HINC
	L_ SKEW-T-1, :HM1;
H1:	T_ HINC, SH<0;
	L_ SWA+T, :NOTOPL;
HM1:	T_ LREG;		IF HINC=-1, THEN FLIP
	L_ 0-T-1, :H1;	THE POLARITY OF THE TEST
NOTOPL:	SINK_ HINC, BUSODD, TASK, :CTX;	HINC FORCES BUSODD
TOPL:	SWA_ L, TASK;		(DISP _ 20 FOR TOPLD)
	IR_ 20, :CSKEW;
;	**HINC REG NOW FREE**
;
;	/* CALCULATE SKEW MASK
	!1,2,THINC,BCOM1;
	!1,2,COMSK,NOCOM;
CSKEW:	T_ SKEW, BUS=0;	IF SKEW=0, THEN COMP
	MAR_ LASTMASKP1-T-1, :THINC;
THINC:	L_HINC-1;
	SH=0;			IF HINC=-1, THEN COMP
BCOM1:	T_ ALLONES, :COMSK;
COMSK:	L_ MD XOR T, :GFN;
NOCOM:	L_ MD, :GFN;
;
;	/* GET FUNCTION
GFN:	MAR_ AC2;
	SKMSK_ L;
	T_ 17;	**THIS MASK IS ONLY FOR SAFETY
	T_ MD.T;
	L_ DISP+T, TASK;
	IR_ LREG, :BENTR;		DISP _ DISP .OR. FUNCTION

;	BITBLT WORK - VERT AND HORIZ LOOPS WITH 4 SOURCES, 4 FUNCTIONS
;	----------------------------------------------------------------------

;
;	/* VERTICAL LOOP: UPDATE SWA, DWAX
	!1,2,DO0,VLOOP;
VLOOP:	T_ SWA;
	L_ RAST1+T;	INC SWA BY DELTA
	SWA_ L;
	T_ DWAX;
	L_ RAST2+T, TASK;	INC DWAX BY DELTA
	DWAX_ L;
;
;	/* TEST FOR DONE, OR NEED GRAY
	!1,2,MOREV,DONEV;
	!1,2,BMAYBE,BNOINT;
	!1,2,BDOINT,BDIS0;
	!1,2,DOGRAY,NOGRAY;
BENTR:	L_ T_ NLINES-1;		DECR NLINES AND CHECK IF DONE
	NLINES_ L, SH<0;
	L_ NWW, BUS=0, :MOREV;	CHECK FOR INTERRUPTS
MOREV:	L_ 3.T, :BMAYBE, SH<0;	CHECK DISABLED
BNOINT:	SINK_ DISP, SINK_ lgm10, BUS=0, :BDIS0, TASK;
BMAYBE:	SINK_ DISP, SINK_ lgm10, BUS=0, :BDOINT, TASK;	TEST IF NEED GRAY(FUNC=8,12)
BDIS0:	CONST_ L, :DOGRAY;
;
;	/* INTERRUPT SUSPENSION (POSSIBLY)
	!1,1,DOI1;	MAY GET AN OR-1
BDOINT:	:DOI1;	TASK HERE
DOI1:	T_ AC2;
	MAR_ DHOFF+T;		NLINES DONE = HT-NLINES-1
	T_ NLINES;
	L_ PC-1;		BACK UP THE PC, SO WE GET RESTARTED
	PC_ L;
	L_ MD-T-1, :BLITX, TASK;	...WITH NO LINES DONE IN AC1
;
;	/* LOAD GRAY FOR THIS LINE (IF FUNCTION NEEDS IT)
	!1,2,PRELD,NOPLD;
DOGRAY:	T_ CONST-1;
	T_ GRAYOFF +T+1;
	MAR_ AC2+T;
	NOP;	UGH
	L_ MD;
NOGRAY:	SINK_ DISP, SINK_ lgm20, BUS=0, TASK;	TEST TOPLD
	CONST_ L, :PRELD;
;
;	/* NORMAL COMPLETION
NEGWID:	L_ 0, :BLITX, TASK;
DONEV:	L_ 0, :BLITX, TASK;	MAY BE AN OR-1 HERE!
BLITX:	AC1_ L, :FINBLT;
;
;	/* PRELOAD OF FIRST SOURCE WORD (DEPENDING ON ALIGNMENT)
PRELD:	T_ HINC;
	MAR_ SWA-T;	PRELOAD SOURCE PRIOR TO MAIN LOOP
	NOP;
	L_ MD, TASK;
	WORD2_ L, :NOPLD;
;
;
;	/* HORIZONTAL LOOP - 3 CALLS FOR 1ST, MIDDLE AND LAST WORDS
	!1,2,FDISPA,LASTH;
	%17,17,14,DON0,,DON2,DON3;		CALLERS OF HORIZ LOOP
;	NOTE THIS IGNORES 14-BITS, SO lgm14 WORKS LIKE L_0 FOR RETN
	!14,1,LH1;	IGNORE RESULTING BUS
NOPLD:	L_ 3, :FDISP;		CALL #3 IS FIRST WORD
DON3:	L_ NWORDS;
	HCNT_ L, SH<0;		HCNT COUNTS WHOLE WORDS
DON0:	L_ HCNT-1, :DO0;	IF NEG, THEN NO MIDDLE OR LAST
DO0:	HCNT_ L, SH<0;		CALL #0 (OR-14!) IS MIDDLE WORDS
;	UGLY HACK SQUEEZES 2 INSTRS OUT OF INNER LOOP:
	L_ DISP, SINK_ lgm14, BUS, TASK, :FDISPA;	(WORKS LIKE L_0)
LASTH:	:LH1;	TASK AND BUS PENDING
LH1:	L_ 2, :FDISP;		CALL #2 IS LAST WORD
DON2:	:VLOOP;
;
;
;	/* HERE ARE THE SOURCE FUNCTIONS
	!17,20,,,,F0,,,,F1,,,,F2,,,,F3;	IGNORE OP BITS IN FUNCTION CODE
	!17,20,,,,F0A,,,,F1A,,,,F2A,,,,;	SAME FOR WINDOW RETURNS
	!3,4,OP0,OP1,OP2,OP3;
FDISP:	SINK_ DISP, SINK_lgm14, BUS, TASK;
FDISPA:	RETN_ L, :F0;
F0:	:WIND;			FUNC 0 - WINDOW
F1:	:WIND;			FUNC 1 - NOT WINDOW
F1A:	T_ CYCOUT;
	L_ ALLONES XOR T, TASK, :F3A;
F2:	:WIND;			FUNC 2 - WINDOW .AND. GRAY
F2A:	T_ CYCOUT;
	L_ ALLONES XOR T;
	TEMP_ L;			TEMP _ NOT WINDOW
	MAR_ DWAX;
	L_ CONST AND T;		WINDOW .AND. GRAY
	T_ TEMP;
	T_ MD .T;			DEST.AND.NOT WINDOW
	L_ LREG OR T, TASK, :F3A;	(TRANSPARENT)
F3:	L_ CONST, TASK;	FUNC 3 - CONSTANT (COLOR)
F3A:	CYCOUT_ L;
;
;
;	/* HERE ARE THE OPERATIONS - ENTER WITH SOURCE IN CYCOUT
	%16,17,15,STFULL,STMSK;	MASKED OR FULL STORE (LOOK AT 2-BIT)
	!1, 2, OPX, DLSIntFromBitBlt;
F0A:	SINK_ R37, BUSODD;	DLS activity?
F0AX:	SINK_ DISP, SINK_ lgm3, BUS, :OPX; [OPX, DLSIntFromBitBlt] DISPATCH ON OP
OPX:	T_ MAR_ DWAX, :OP0;	OP 0 - SOURCE
OP0:	SINK_ RETN, BUS;		TEST IF UNMASKED
OP0A:	L_ HINC+T, :STFULL;		(ELSE :STMSK)
OP1:	T_ CYCOUT;		OP 1 - SOURCE .OR. DEST
	L_ MD OR T, :OPN, TASK;
OP2:	T_ CYCOUT;		OP 2 - SOURCE .XOR. DEST
	L_ MD XOR T, :OPN, TASK;
OP3:	T_ CYCOUT;		OP 3 - (NOT SOURCE) .AND. DEST
	L_ 0-T-1;
	T_ LREG;
	L_ MD AND T, TASK;
OPN:	CYCOUT_ L, :OPX;
;
;
;	/* STORE MASKED INTO DESTINATION
	!1,2,STM2,STM1;
STMSK:	L_ MD;
	SINK_ RETN, BUSODD, TASK;	DETERMINE MASK FROM CALL INDEX
	TEMP_ L, :STM2;		STACHE DEST WORD IN TEMP
STM1:	T_MASK1, :STM3;
STM2:	T_MASK2, :STM3;
STM3:	L_ CYCOUT AND T;  ***X24. Removed TASK clause.
	CYCOUT_ L, L_ 0-T-1;		AND INTO SOURCE
	T_ LREG;		T_ MASK COMPLEMENTED
	T_ TEMP .T;		AND INTO DEST
	L_ CYCOUT OR T, TASK;
	CYCOUT_ L;		OR TOGETHER THEN GO STORE
	T_ MAR_ DWAX, :OP0A;
;
;	/* STORE UNMASKED FROM CYCOUT (L=NEXT DWAX)
STFULL:	MD_ CYCOUT;
STFUL1:	SINK_ RETN, BUS, TASK;
	DWAX_ L, :DON0;
;
;
;	/* WINDOW SOURCE FUNCTION
;	TASKS UPON RETURN, RESULT IN CYCOUT
	!1,2,DOCY,NOCY;
	!17,1,WIA;
	!1,2,NZSK,ZESK;
WIND:	MAR_ SWA;		ENTER HERE (7 INST TO TASK)
	L_ T_ SKMSK;
	L_ WORD2.T, SH=0;
	CYCOUT_ L, L_ 0-T-1, :NZSK;	CYCOUT_ OLD WORD .AND. MSK
ZESK:	L_ MD;	ZERO SKEW BYPASSES LOTS
	CYCOUT_ L, :NOCY;
NZSK:	T_ MD;
	L_ LREG.T;
	TEMP_ L, L_T, TASK;	TEMP_ NEW WORD .AND. NOTMSK
	WORD2_ L;
	T_ TEMP;
	L_ T_ CYCOUT OR T;		OR THEM TOGETHER
	CYCOUT_ L, L_ 0+1, SH=0;	 DONT CYCLE A ZERO ***X21.
	SINK_ SKEW, BUS, :DOCY;
DOCY:	CYRET_ L LSH 1, L_ T, :L0; CYCLE BY SKEW ***X21.
NOCY:	T_ SWA, :WIA;	(MAY HAVE OR-17 FROM BUS)
CYX2:	T_ SWA;
WIA:	L_ HINC+T;
	SINK_ DISP, SINK_ lgm14, BUS, TASK;	DISPATCH TO CALLER 
	SWA_ L, :F0A;

; DLS microcode -- executed by emulator task

;REGISTERS USED BY THE DLS
; These must not overlay any emulator registers, including those used by BitBlt.
$DTEMP		$R11;	COINCIDENT WITH CLOCKTEMP, WHICH HAS BEEN ABOLISHED
$NOW		$R14;	CURRENT TIME MOD 400B AS SEEN BY EMULATOR
$TIME		$R15;	CURRENT TIME MOD 400B AS SEEN BY MRT
$XTEMP		$R16;	TEMPORARY
$YTEMP		$R17;
$QBASE		$R52;	POINTERS TO DATA STRUCTURES OF INTEREST
$IBCB		$R53;
$GCBASE3	$R54;
$LCBTB		$R55;
$OBCB		$R56;
$INTERVAL	$R57;
$TLINE		$R60;
$PLCB		$R61;	POINTER TO LINE CONTROL BLOCK
$ETEMP		$R62;
$LINK		$R63;	LINK TO NEXT LCB
$ZTEMP		$R64;
$DLSRETN	$R65;	Return dispatch from DLS code
$IRSAVE		$R66;

;CONSTANTS USED BY THE DLS (some are precomputed and stored in S-registers)
$GNMASK		$360;
$CSIZMSK	$R67;
$INBASE		$177400;
$OUTBASE	$177600;
$LNMASK		$M7:377;
$INPUTINT	$10;
$UGLYINT	$20;
$OUTPUTINT	$40;
$CTRLMSK	$174000;
$STOPMASK	$R70;

$10000		$10000;
$4000		$4000;
$400		$400;

;PREDEFINITIONS
!1,2,BUFNOTEMPTY,BUFEMPTY;
!1,2,NOBWRAP,BWRAP;
!1,2,DLSY,DLSZ;
!1,2,DLS1,DLSF;
!3,1,DLSBB1;
!1,2,GETLINE,BUFCHAR;
!1,2,GOTLINE,GOTLINE1;
!1,2,SPACING,MARKING;
!17,20,GETMASK,GM1,GM2,GM3,GM4,GM5,GM6,GM7,GM10,GM11,GM12,GM13,GM14,GM15,GM16,GM17;
!1,2,PACNZ,PACZ;
!17,20,CHARIN,FINDSTART,OUTPUT,,,,,,,,,,,,,;
!1,2,NOTNOISE,NOISE;
!1,2,BUFOK,BUFWRAP;
!1,2,NOTFULL,CHBFULL;
!1,2,DEQUEUELINE,MOVELINKX;
!1,2,SOMEBUSY,MOVELINK;
!1,2,NFOUND,FOUND;
!1,2,NOTLASTBLOCK,LASTBLOCK;
!1,2,NOSPEED,SPEED;
!1,2,DOMORELINES,NOMORELINES;
!1,1,ODDSP;
!1,2,SENDBIT,CHARDONE;
!1,2,NOWRAP,SENDWRAP;

; We get here from START because R37[15]=1 (set by MRT).
; TIME is the present real time (mod 400B) as kept by MRT.
; NOW is the time for which DLS processing was last performed.
; Process all timer queue entries from NOW+1 to TIME, inclusive.
; Note that TIME may increase while processing is going on.

DLS:	PC_ L, L_ IR_ 0, :DLSINT;

; Here when interrupted from BitBlt.
; We must save IR, and remember to go back to BitBlt when we are done.
; There is a 4-way dispatch pending, which we must squash.
DLSIntFromBitBlt:
	L_ DISP, :DLSBB1;
DLSBB1:	IRSAVE_ L;
	L_ 0+1;

DLSINT:	T_ NOW+1;		NOW _ (NOW+1) mod 400B
DLSRPT:	T_ 377.T;
	MAR_ QBASE+T;		Fetch LCB pointer at QBASE[NOW]
	DLSRETN_ L, L_ T;
	NOW_ L;
	L_ MD, BUS=0, TASK;
	PLCB_ L, :DLS1;		[DLS1, DLSF] GOES TO DLSF IF NOTHING TO DO

DLS1:	MAR_ PLCB-1;		GET LINE CONTROL BLOCK FROM HEAD OF QUEUE
	T_ GNMASK;		LEAVE THE GROUP NUMBER IN T FOR OTHERS
	L_ MD;			LINK TO NEXT LCB (IF ANY)
	T_ MD.T, IR_ MD;	DISPATCH ON ACTIVITY CODE IN (0,5-7)
	MAR_ PLCB+1, :CHARIN;	[CHARIN, FINDSTART, OUTPUT] Fetch words 2 & 3


DLSF:	T_ NOW;			CLEAR THE LIST HEADER
	L_ TIME-T;
	MAR_ QBASE+T, SH=0;	Have we caught up with real time?
	L_ DLSRETN, :DLSY;	[DLSY, DLSZ] To DLSZ if so

DLSY:	MD_ 0, T_ 0+T+1, :DLSRPT; GO AROUND AGAIN

DLSZ:	L_ R37-1;		Turn off the flag
	SINK_ DLSRETN, BUS, TASK; Back to whatever we were doing before
	R37_ L, MD_ 0, :START1;	[START1, BBRET]

BBRET:	IR_ IRSAVE, :F0AX;

;CHARACTER INPUT ROUTINE.  GATHERS ONE BIT, AND BUFFERS THE
;CHARACTER IF IT IS FINISHED

CHARIN:	LINK_ L;		LINK TO NEXT LCB
	T_ CSIZMSK;		EXTRACT BIT FROM INTERVAL FIELD(CSIZMSK=1400B)
	L_ MD, BUSODD;		PARTIALLY ASSEMBLED CHARACTER
	T_ MD.T, :GETLINE;	[GETLINE, BUFCHAR] TO BUFCHAR IF DONE

GETLINE: DTEMP_ L, L_ T, TASK;	DTEMP_ PARTIAL CHARACTER,L_ CHARACTER SIZE BIT
	XTEMP_ L;

	T_ GNMASK;		GNMASK = 360B
	T_ DISP.T;
	MAR_ INBASE+T;		Fetch hardware input bits for this group
	SINK_ DISP, SINK_ X17, BUS;
	:GETMASK;		[GETMASK, GM1 .. GM17] Get mask for this line

;TABLE FOR SUPPLYING MASKS BASED ON LINE NUMBERS
; Entered from above with no branch pending, or from DEQUEUELINE
; with branch pending

GETMASK: T_ 100000, :GOTLINE;	[GOTLINE, GOTLINE1]
GM1:	T_ 40000, :GOTLINE;
GM2:	T_ 20000, :GOTLINE;
GM3:	T_ 10000, :GOTLINE;
GM4:	T_ 4000, :GOTLINE;
GM5:	T_ 2000, :GOTLINE;
GM6:	T_ 1000, :GOTLINE;
GM7:	T_ 400, :GOTLINE;
GM10:	T_ 200, :GOTLINE;
GM11:	T_ 100, :GOTLINE;
GM12:	T_ 40, :GOTLINE;
GM13:	T_ 20, :GOTLINE;
GM14:	T_ 10, :GOTLINE;
GM15:	T_ 4, :GOTLINE;
GM16:	T_ 2, :GOTLINE;
GM17:	T_ ONE, :GOTLINE;

GOTLINE: L_ MD AND T;		HARDWARE AND MASK BIT FOR THIS LINE
	SH=0, T_ XTEMP;		SH=0 MEANS THE LINE IS MARKING
	MAR_ PLCB+1, :SPACING;	[SPACING, MARKING]

; There are 4 cases, depending on whether this bit is marking or spacing
; and whether or not any bits have already been assembled.
;  Spacing and no previous bits:  we are in the middle of the start bit.
;  Spacing and previous bits:  we have a '0' data bit.
;  Marking and no previous bits:  noise triggered the line.
;  Marking and previous bits:  we have a '1' data bit.
; T has character size bit from LCB (either bit 6 or bit 7 on)
; and a memory reference to words 2 and 3 of the LCB is in progress.

SPACING: L_ DTEMP, BUS=0;	Any bits already assembled?
	MTEMP_ L RSH 1, L_ T, :PACNZ; [PACNZ, PACZ]

PACZ:	MTEMP_ L RSH 1;		No, just store start bit
PACNZ:	MD_ MTEMP, :GETINT;	Store updated character

MARKING: L_ DTEMP OR T, BUS=0;	Or in new 1 bit.  Any bits already assembled?
	MTEMP_ L RSH 1, :NOTNOISE; [NOTNOISE, NOISE]

NOTNOISE: MD_ MTEMP;		Yes, store updated character
GETINT:	T_ MD, :MOVELINK;	FETCH INTERVAL & UPDATE TIMER QUEUE

;MEMORY IS FETCHING LCB WORDS 2 AND 3, BUT WE SUSPECT THAT
;NOISE TRIGGERED THE LINE.  IF THE LINE IS IN SPEED DETERMINATION
;MODE, KEEP PROCESSING THE CHARACTER ANYWAY, OTHERWISE FLUSH IT.

NOISE:	MD_ MTEMP;		Store start bit
	L_ T_ MD;			INTERVAL AND FLAGS
	T_ NOW+T+1, SH<0;	TEST FOR SPEED MODE
	T_ 377.T, :DEQUEUELINE;	[DEQUEUELINE, MOVELINKX]

;GET HERE IF THE CHARACTER IF FINISHED.  WE ARE IN THE MIDDLE
;OF THE STOP BIT, THE CHARACTER IS IN BITS 7-14 OF L, AND THE
;LINE NUMBER IS IN BITS 9-15 OF IR.

BUFCHAR: TASK;			Right-justify character in YTEMP
	YTEMP_ L RSH 1;

	MAR_ IBCB- 1;		BUFFER CONTROL BLOCK FOR INPUT
	L_ YTEMP;		Left-justify char in YTEMP
	YTEMP_ L LCY 8;
	T_ MD+1;		BUFFER INPUT POINTER+1
	L_ MD-T;		EQUAL TO BUFFER LIMIT?
	L_ MAR_ T, T_ YTEMP, SH=0; START THE REFERENCE TO THE BUFFER
AGAINB:	YTEMP_ L, L_T, :BUFOK;	[BUFOK, BUFWRAP] YTEMP_ INPUT POINTER, L_ CHAR

BUFWRAP: YTEMP_ L;		SAVE CHARACTER
	T_ MD;			Last word of buffer is pointer to first
	L_ MAR_ T, T_ YTEMP, :AGAINB;

BUFOK:	L_ DISP OR T, SINK_ LNMASK; T has char in left byte, DISP has line no.
	XTEMP_ L, TASK;		CHARACTER IN LEFT BYTE, LINE NUMBER IN RIGHT
	MD_ XTEMP;		STORE CHARACTER, LINE NUMBER

	MAR_ IBCB+1;		CHECK INPUT POINTER #OUTPUT POINTER
	T_ YTEMP;		THE INPUT POINTER
	L_ MD-T;
	MAR_ IBCB-1, SH=0;	
	T_ NWW, :NOTFULL;	[NOTFULL, CHBFULL]

NOTFULL: L_ INPUTINT OR T;	CAUSE THE INPUT INTERRUPT
	NWW_ L, TASK;
	MD_ YTEMP, :DEQUEUELINE; STORE THE NEW INPUT POINTER

CHBFULL: L_ UGLYINT OR T, TASK;	CAUSE THE BUFFER OVERFLOW INTERRUPT
	NWW_ L, :DEQUEUELINE;

;RESTORE THE LINE STATE
;GCB!2 _ GCB!2 OR (GCB!4 AND MASK)

DEQUEUELINE: T_ GNMASK;
	T_ DISP.T;		GROUP NUMBER
	L_ MAR_ GCBASE3+T+1;	GCB WORD 4 FETCHED
	SINK_ DISP, SINK_ X17, BUS;
	BUS=0, DTEMP_ L, :GETMASK; [GETMASK, GM1 .. GM17] RETURNS TO GOTLINE1

GOTLINE1: L_ MD AND T, TASK;
	XTEMP_ L;

	T_ DTEMP;
	MAR_ L_ -2+T;		WORD 2 OF THE GCB
	DTEMP_ L;
	T_ XTEMP;
	L_ MD OR T;
	MAR_ DTEMP;
	DTEMP_ L, :FININPUT;


;GET HERE WITH INTERVAL IN T.  MOVE THE LCB TO NOW+INTERVAL+1.

MOVELINK: T_ NOW +T+ 1;
	T_ 377. T;
MOVELINKX: MAR_ QBASE+T;
	NOP;
	L_ MD;			HEADER OF THE LIST ONTO WHICH THE LCB GOES
	MAR_ QBASE+T;		STORE PLCB INTO THIS HEADER
	DTEMP_ L, TASK;
	MD_ PLCB;

	MAR_ PLCB-1;		AND STORE THE HEADER INTO THE LCB
FININPUT: L_ LINK;		CHECK FOR ANOTHER LCB ON THE CHAIN
	PLCB_ L, SH=0, TASK;
	MD_ DTEMP, :DLS1;	[DLS1, DLSF]

; GROUP SCANNING ROUTINE
; Look for start bits from any line in group, and queue normal input control
; blocks for any that are found.

; L has link to next LCB, T has line number of base of group, and
; a memory reference to words 2 and 3 of the LCB has been started.

FINDSTART: LINK_ L;		SAVE LINK
	L_ INBASE+T;		ADDRESS OF THIS GROUP'S INPUT HDWE
	DTEMP_ L;
	T_ MD;			1'S MEAN LINE IS ACTIVE BUT IDLE
	L_ MD;			SCANNING INTERVAL FOR THIS GROUP
	INTERVAL_ L, L_ T, TASK;
	ETEMP_ L;		IDLE LINE MASK

	MAR_ DTEMP;
	L_ DISP-1, SINK_ LNMASK; TLINE_ group base -1
	TLINE_ L;
	T_ ETEMP;
	L_ MD AND T;		NEW BUSY LINES INTO L.  MARK=0
	T_ INTERVAL, SH=0;	GOES TO MOVELINK IF NOTHING TO DO
	:SOMEBUSY;		[SOMEBUSY, MOVELINK]

SOMEBUSY: T_ ETEMP;		UPDATE LCB. IDLE_ IDLE XOR NEW BUSY
	MAR_ PLCB+1;
	XTEMP_ L;		NEW BUSY LINES
	L_ XTEMP XOR T;
	DTEMP_ L, TASK;
	MD_ DTEMP;		STORE INTO LCB


;LOOP THROUGH THE MASK OF NEW BUSY LINES IN XTEMP.

NFOUND:	L_ XTEMP;
NFOUND1: XTEMP_ L LSH 1;
	L_ TLINE+1, SH<0, TASK;
	TLINE_ L, :NFOUND;	[NFOUND, FOUND]

; FOUND A NEWLY-BUSY LINE.
; LINK ITS INPUT LCB INTO THE TIMER QUEUE ONE-HALF BIT TIME IN THE FUTURE.

FOUND:	T_ TLINE;
	MAR_ LCBTB+T;		POINTER TO THE NEWLY ACTIVE LCB
	NOP;
	L_ T_ MD;		POINTER TO NEW LCB
NOTLASTBLOCK:
	DTEMP_ L, MAR_ 0+T+1;	Start reference to words 2 and 3 of LCB
	T_ 377;
	MD_ 0;			ZERO THE PAC WORD
	L_ MD AND T, T_ MD;	L_ INTERVAL-1 FOR THIS LCB, T_ INTERVAL WORD
	MTEMP_ L RSH 1, L_ T;	(INTERVAL-1)/2
	T_ NOW;			WE WILL LINK THE NEW LCB INTO TIMEQ AT
	T_ MTEMP+T+1;		  (NOW + (INTERVAL-1)/2 +1) mod 400B
	T_ 377.T;		  = (NOW + (INTERVAL+1)/2) mod 400B
	MAR_ QBASE+T;		TIMEQ ENTRY ONTO WHICH THIS LCB WILL GO
	ZTEMP_ L, L_ T;		ZTEMP_ raw interval word
	ETEMP_ L;		TIME FOR THE NEW LCB
	L_ MD, TASK;		THE OLD LIST HEADER FROM TIMEQ
	YTEMP_ L;

	MAR_ DTEMP-1;		STORE IT INTO THE NEW LCB'S LINK WORD
	T_ ETEMP;
	MD_ YTEMP;
	MAR_ QBASE+T;		STORE POINTER TO THE NEW LCB INTO TIMEQ
	L_ ZTEMP;
	SH<0;			Test sign of interval word
	SINK_ XTEMP, BUS=0, TASK, :NOSPEED; [NOSPEED, SPEED] More active lines?
NOSPEED: MD_ DTEMP, :DOMORELINES; [DOMORELINES, NOMORELINES]

; Line is in speed determination mode.  If word 4 of the LCB is nonzero,
; it is a pointer to another LCB for the same line.
SPEED:	MD_ DTEMP;		[ODDSP, ODDSP]

ODDSP:	T_ DTEMP;
	MAR_ 3+T;		GET WORD 4 OF THE LCB
	NOP;
	L_ T_ MD, BUS=0;
	:NOTLASTBLOCK;		[NOTLASTBLOCK, LASTBLOCK]

LASTBLOCK: SINK_ XTEMP, BUS=0, TASK;
	:DOMORELINES;		[DOMORELINES, NOMORELINES]

; There are more newly-busy lines in this TIMEQ slot, go pick them up
DOMORELINES: L_ XTEMP, :NFOUND1;

; No more newly-busy lines, advance this GCB to its next sampling time.
NOMORELINES: T_ INTERVAL, :MOVELINK;	MOVE THE GCB

; DLS OUTPUT ROUTINE
; Sends the next bit of the current character to the hardware, and
; notifies the software when the character has been completely sent.

; L has link to next LCB, T has line number of base of group, and
; a memory reference to words 2 and 3 of the LCB has been started.

OUTPUT:	LINK_ L;
	L_ MD, BUS=0;		CHARACTER DONE IF =0, L_ PARTIAL CHARACTER
	T_ MD, :SENDBIT;	[SENDBIT, CHARDONE] T_ INTERVAL WORD

SENDBIT: MAR_ PLCB+1;		RESTORE THE CHARACTER TO CORE
	XTEMP_ L RSH 1;
	YTEMP_ L, L_ T;		L_ INTERVAL
	T_ CTRLMSK.T;		T_ CONTROL BITS FOR THIS LINE
	MD_ XTEMP;		STORE CHARACTER
	DTEMP_ L;
	L_ YTEMP OR T, TASK;	THE DATA DESTINED FOR THE HARDWARE
	YTEMP_ L;

	T_ DISP, SINK_ LNMASK;	T_ LINE NUMBER
	MAR_ OUTBASE+T;		START THE STORE INTO THE HARDWARE
	T_ DTEMP;		THE INTERVAL FOR THE LCB
	MD_ YTEMP, :MOVELINK;


;CHARACTER HAS BEEN SENT.  CAUSE AN INTERRUPT AND BUFFER THE LCB POINTER.
; Note that if there are more entries in the buffer than there are output
; lines, the buffer can never overflow.  The microcode depends on this,
; and never checks for overflow.

CHARDONE: TASK;
	NOP;

	MAR_ OBCB-1;		OUTPUT BUFFER CONTROL BLOCK
	T_ NWW;			CAUSE THE OUTPUT DONE INTERRUPT
	L_ OUTPUTINT OR T;
	NWW_ L;
	T_ MD+1;		BUFFER INPUT POINTER
	L_ MD-T;		LIMIT-INPUT
ZAGAIN:	L_ MAR_ T, SH=0;	GOES TO SENDWRAP IF BUFFER OVER LIMIT
	DTEMP_ L, :NOWRAP;	[NOWRAP, SENDWRAP] DTEMP_ NEW OUTPUT POINTER

SENDWRAP: L_ T_ MD, :ZAGAIN;	Last word of buffer contains pointer to first

NOWRAP:	MD_ PLCB;		STORE POINTER TO THE LCB IN THE BUFFER
	MAR_ OBCB-1, :FININPUT;	RESTORE THE INPUT POINTER.

; QCH (61022)
; QUEUES CHARACTER FOR OUTPUT
; Accepts pointer to word 1 of output LCB in AC0 and character in AC1.
; The LCB must start on an even word boundary;  i.e., AC0 must be odd.

QCH:	T_ 2;
	MAR_ AC0+T;		FETCH INTERVAL FIELD OF THE LCB
	T_ STOPMASK;		3400B
	L_ MD AND T, T_ MD;	L_ STOP BITS, T_ INTERVAL
	YTEMP_ L RSH 1;		STOP BITS
	L_ CTRLMSK AND T;
	INTERVAL_ L;
	T_ TIME+T+1;		LINK THE LCB INTO THE TIMER QUEUE
	T_ 377.T;
	L_ MAR_ QBASE+T;	FETCH THE LIST HEADER AT THE NEW POSITION
	ZTEMP_ L;
	T_ AC1;
	L_ MD;			HEAD OF LIST
	MAR_ ZTEMP;		STORE POINTER TO LCB INTO HEADER
	ZTEMP_ L;
	L_ YTEMP OR T;		CHARACTER OR STOP BITS
	YTEMP_ L, TASK;
	MD_ AC0;		LCB ADDRESS

	MAR_ AC0-1;		STORE OLD LIST HEAD INTO LCB
	T_ 377;
	MD_ ZTEMP;
	T_ MD.T;		PHYSICAL LINE NUMBER
	MAR_ OUTBASE+T;		STORE CONTROL BITS INTO THE HARDWARE
	TASK;
	MD_ INTERVAL;

	MAR_ AC0+1;		STORE CHAR. OR STOP BITS INTO WORD 2 OF LCB
	TASK;
	MD_ YTEMP, :START;


; GCRB (61017)
; TAKES IN AC0 A POINTER TO A BUFFER CONTROL BLOCK OF THE FORM:
;	WORD -1: INPUT POINTER  (THIS LOCATION MUST BE EVEN)
;	WORD 0: BUFFER LIMIT (AC0 POINTS TO THIS WORD)
;	WORD 1: OUTPUT POINTER
;IF THE BUFFER IS EMPTY (INPUT= OUTPUT) , THE INSTRUCTION NOSKIPS
;IF NOT, THE INSTRUCTION SKIPS WITH THE CONTENTS OF THE BUFFER IN 
;AC0.  THE OUTPUT POINTER IS INCREMENTED.

GCRB:	MAR_ L_ AC0+1;		FETCH OUTPUT POINTER
	XREG_ L;
	T_ L_ MD;
	MAR_ AC0-1;		FETCH INPUT AND LIMIT
	L_ 0+T+1;
	DTEMP_ L;		DTEMP_ INCREMENTED OUTPUT POINTER
	L_ MD-T;		INPUT=OUTPUT?
	T_ MD, SH=0;		T_ LIMIT
	L_ DTEMP-T, T_ DTEMP, :BUFNOTEMPTY; [BUFNOTEMPTY,BUFEMPTY] OUTPUT=LIMIT?

BUFEMPTY: TASK, :TOSTART;	Buffer empty, no-skip return

; Fetch word addressed by output pointer.
; If output=limit, this will be the address of the start of the buffer
; (for wraparound);  otherwise it will be the desired buffer contents.
BUFNOTEMPTY: L_ MAR_ T, SH=0;	Can branch only the first time around
	DTEMP_ L, :NOBWRAP;	[NOBWRAP, BWRAP]
BWRAP: L_ T_ MD, :BUFNOTEMPTY;	GO AROUND AGAIN, BUFFER WRAPPED AROUND

NOBWRAP: L_ MD, TASK;
	AC0_ L;			RETURN BUFFER CONTENTS

	MAR_ XREG;		RESTORE THE UPDATED OUTPUT POINTER
	L_ PC+1;		SKIP NEXT INSTRUCTION
	PC_ L, TASK;
	MD_ DTEMP, :START;

; DLSON (61016)
; INITIALIZES CONSTANTS, CLEARS NOW AND TIME, AND SETS R37(14)
; AC0 must be a pointer to a parameter block, which must be on
; an even word boundary:
;  0	LCBTB	pointer to table of pointers to input LCBs
;  1	GCBASE	pointer to table of input group scanning LCBs
;  2	IBCB	pointer to input buffer control block
;  3	OBCB	pointer to output buffer control block
;  4	QBASE	pointer to base of 256-word timer queue

DLSON:	T_ 1000;
	L_ T_ 400 OR T;		1400B
	CSIZMSK _ L;
	L_ 2000 OR T, TASK;
	STOPMASK _ L;		3400B

	MAR_ T_ AC0;
	L_ 2+T, T_ 2;
	AC0_ L;
	L_ MD;
	T_ MD+T+1;		T_ GCBASE+3
	LCBTB_ L, L_ T, TASK;
	GCBASE3_ L;

	MAR_ T_ AC0;
	L_ 2+T;
	AC0_ L;
	L_ MD;
	T_ MD;
	IBCB_ L, L_ T, TASK;
	OBCB_ L;

	MAR_ AC0;
	T_ 0;
	L_ MD;
	QBASE_ L, L_ T;
	TIME_ L, T_ 0+T+1;
	NOW_ L, T_ 0+T+1;	T_ 2
	L_ R37 OR T, TASK, :SITF; Set R37[14]


; DLSOFF (61015)
; TURNS DLS OFF

DLSOFF:	T_ BIAS;
	L_ R37 AND T, TASK;	Clear R37[14,15]
SITF:	R37_ L, :START;


; ANDM (61007) - Replaces SIT
; @AC1 _ @AC1 & AC0

ANDM:	MAR_ AC1;
	T_ AC0;
	L_ MD AND T, :FINORM;

; ORM (61023)
; @AC1 _ @AC1 % AC0

ORM:	MAR_ AC1;
	T_ AC0;
	L_ MD OR T;
FINORM:	MAR_ AC1, :FINSTO;


; SETBLV (61025)
; Sets the Boot Locus Vector to the value in AC0

SETBLV:	RMR_ AC0, :TOSTART;

; Ring buffer instructions: RRB and WRB

$RBTEMP		$R7;		= XREG

; The following overlay BITBLT temporaries
$RBBEG		$R41;		RBD.begin
$RBLEN		$R42;		RBD.length
$RBREAD		$R43;		RBD.read
$RBWRITE	$R44;		RBD.write

; structure RBD:  // RingBufferDescriptor, compatible with BCPL RingBytes package
; [
; begin word	// pointer to beginning of ring buffer
; length word	// length of ring buffer in bytes
; read word	// index of last byte read
; write word	// index of last byte written
; ]

!1, 2, RRBContinue, WRBContinue;
!1, 2, ~RRBEmpty, RRBEmpty;
!1, 2, RRBCountOK, RRBFixCount;
!1, 2, ~RRBWrap, RRBWrap;
!1, 2, RRBLeft, RRBRight;


; RRB (61026B, must be even) Read Ring Buffer
; Accepts: AC0 = pointer to RBD (even-word aligned)
; Returns +1: ring buffer empty, AC0 = 0
;	+2: AC0 = number of bytes in buffer prior to reading this byte
;	    AC1 = byte read from ring buffer

RRB:	MAR_ T_ AC0, :RBCommon;
RRBContinue:
	L_ T_ MD;			RBD.read
	L_ MD-T;			RBD.write; compute bytes in buffer
	AC0_ L, T_ 0+T+1, SH=0;		read=write means empty; advance read ptr
RRBAgain:
	L_ T, T_ RBLEN, SH<0, :~RRBEmpty; [~RRBEmpty, RRBEmpty]

; Buffer not empty, prepare to read character from it.
~RRBEmpty:
	RBREAD_ L, :RRBCountOK;		[RRBCountOK, RRBFixCount] updated read ptr
RRBFixCount:
	L_ AC0+T;			count _ count mod length
	AC0_ L;
RRBCountOK:
	L_ RBREAD-T, T_ RBREAD;		see if read=length
	L_ T, SH=0, TASK;
	RBTEMP_ L RSH 1, :~RRBWrap;	[~RRBWrap, RRBWrap] compute word offset
RRBWrap:
	L_ T_ 0, :RRBAgain;		wrap around to zero

~RRBWrap:
	T_ RBTEMP;
	MAR_ RBBEG+T;			fetch word containing desired byte
	SINK_ RBREAD, BUSODD;		which half?
	T_ 377, :RRBLeft;		[RRBLeft, RRBRight]
RRBLeft:
	L_ MD AND NOT T, TASK;		fetch left byte
	AC1_ L LCY 8, :RRBFinish;

RRBRight:
	L_ MD AND T, TASK;		fetch right byte
	AC1_ L;
RRBFinish:
	MAR_ SAD;			store updated read ptr back into RBD
	L_ PC+1;			increment PC
	PC_ L, TASK;
	MD_ RBREAD, :START;

; If buffer is empty, just return +1.  We have already zeroed AC0.
RRBEmpty:
	TASK, :TOSTART;

!1, 2, ~WRBWrap, WRBWrap;
!1, 2, ~WRBFull, WRBFull;
!1, 2, WRBCountOK, WRBFixCount;
!1, 2, WRBLeft, WRBRight;

; WRB (61027B, must be odd) Write Ring Buffer
; Accepts: AC0 = pointer to RBD (even-word aligned)
;	AC1 = byte to store in ring buffer (left half must be zero)
; Returns +1: ring buffer full, AC0 = 0
;	+2: AC0 = amount of room remaining in buffer prior to writing this byte

WRB:	MAR_ T_ AC0, :RBCommon;

; Following code is shared by RRB and WRB
RBCommon:
	L_ 2+T;
	SAD_ L;
	L_ MD;				RBD.begin
	T_ MD;				RBD.length
	MAR_ SAD;
	RBBEG_ L, L_ T;
	SINK_ DISP, BUSODD;		who called?
	RBLEN_ L, :RRBContinue;		[RRBContinue, WRBContinue]
; End of shared code
WRBContinue:
	L_ MD;				RBD.read
	T_ MD+1;			RBD.write; advance write ptr
	RBREAD_ L;
	L_ RBLEN-T;			see if write=length
	L_ T, SH=0, TASK;
WRBWrap?:
	RBWRITE_ L, :~WRBWrap;		[~WRBWrap, WRBWrap]

WRBWrap:
	L_ 0, TASK, :WRBWrap?;		wrap around to zero

~WRBWrap:
	T_ RBWRITE;
	L_ RBREAD-T;			compute bytes remaining in buffer
	AC0_ L, SH=0;			read=(updated)write means full
	L_ T, T_ RBLEN, SH<0, :~WRBFull; [~WRBFull, WRBFull]

; Buffer not full, prepare to write character into it.
~WRBFull:
	RBTEMP_ L RSH 1, :WRBCountOK;	[WRBCountOK, WRBFixCount] compute word offset
WRBFixCount:
	L_ AC0+T, TASK;			count _ count mod length
	AC0_ L;

WRBCountOK:
	T_ RBTEMP;
	MAR_ L_ RBBEG+T;		fetch word into which byte will be stored
	RBTEMP_ L;
	L_ AC1;				byte to be stored
	T_ MD;
	SINK_ RBWRITE, BUSODD;		which half?
	MAR_ RBTEMP, :WRBLeft;		[WRBLeft, WRBRight]

WRBLeft:
	MTEMP_ L LCY 8;			store left byte
	T_ 377.T;
	L_ MTEMP OR T, TASK, :WRBFinish;

WRBRight:
	T_ 177400.T;			store right byte
	L_ AC1 OR T, TASK;
WRBFinish:
	MD_ M;

	MAR_ SAD+1;			store updated write ptr back into RBD
	L_ PC+1;			increment PC
	PC_ L, TASK;
	MD_ RBWRITE, :START;

; If buffer is full, just return +1.  We have already zeroed AC0.
WRBFull:
	TASK, :TOSTART;