; 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;