;-----------------------------------------------------------------
; MesadROM.Mu - Xfer, State switching, process support, Nova interface
; Last modified by Levin - February 27, 1979  4:50 PM
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; F r a m e   A l l o c a t i o n
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; Alloc subroutine:
;	allocates a frame
;	Entry conditions:
;	  frame size index (fsi) in T
;	Exit conditions:
;	  frame pointer in L, T, and frame
;	  if allocation fails, alternate return address is taken and
;	    temp2 is shifted left by 1 (for ALLOC)
;-----------------------------------------------------------------
!1,2,ALLOCr,XferGr;						subroutine returns
!1,2,ALLOCrf,XferGrf;						failure returns
!3,4,Alloc0,Alloc1,Alloc2,Alloc3;				dispatch on pointer flag
;	if more than 2 callers, un-comment the following pre-definition:
; !17,1,Allocx;							shake IR_ dispatch

AllocSub:	L_avm1+T+1, TASK, :Allocx;			fetch av entry

Allocx:		entry_L;					save av entry address
		L_MAR_entry;
		T_3;						mask for pointer flags
		L_MD AND T, T_MD;				(L_MD AND 3, T_MD)
		temp_L, L_MAR_T;				start reading pointer
		SINK_temp, BUS;					branch on bits 14:15
		frame_L, :Alloc0;

;
; Bits 14:15 = 00, a frame of the right index is queued for allocation
;

Alloc0:		L_MD, TASK;					new entry for frame vector
		temp_L;						new value of vector entry
		MAR_entry;					update frame vector
		L_T_frame, IDISP;				establish exit conditions
		MD_temp, :ALLOCr;				update and return

;
; Bits 14:15 = 01, allocation list empty:  restore argument, take failure return
;

Alloc1:		L_temp2, IDISP, TASK;				restore parameter
		temp2_L LSH 1, :ALLOCrf;			allocation failed

;
; Bits 14:15 = 10, a pointer to an alternate list to use
;

Alloc2:		temp_L RSH 1, :Allocp;				indirection: index_index/4

Allocp:		L_temp, TASK;
		temp_L RSH 1;
		T_temp, :AllocSub;

Alloc3:		temp_L RSH 1, :Allocp;				(treat type 3 as type 2)

;-----------------------------------------------------------------
; Free subroutine:
;	frees a frame
;	Entry conditions: address of frame is in 'frame'
;	Exit conditions: 'frame' left pointing at released frame (for LSTF)
;-----------------------------------------------------------------

!3,4,RETr,FREEr,LSTFr,;						FreeSub returns
!17,1,Freex;							shake IR_ dispatch

FreeSub:	MAR_frame-1;					start read of fsi word
Freex:		NOP;						wait for memory
		T_MD;						T_index
		L_MAR_avm1+T+1;					fetch av entry
		entry_L;					save av entry address
		L_MD;						read current pointer
		MAR_frame;					write it into current frame
		temp_L, TASK;
		MD_temp;					write!
		MAR_entry;					entry points at frame
		IDISP, TASK;
		MD_frame, :RETr;				free

;-----------------------------------------------------------------
; ALLOC - allocate a frame whose fsi is specified by <TOS> (popped)
;-----------------------------------------------------------------
!1,1,Savpcinframe;						(here so ALLOCrf can call it)
; The following logically belongs here; however, because the entry point to general Xfer is
; known to the outside world, the real declaration appears in MesaROM.mu.
; !7,10,XferGT,Xfer,Mstopr,PORTOpc,LSTr,ALLOCrfr,,;		return points for Savpcinframe
!1,2,doAllocTrap,XferGfz;					used by XferGrf

ALLOC:		L_ret7, TASK, :Xpopsub;				returns to ALLOCrx
ALLOCrx:	temp2_L LSH 1, IR_msr0, :AllocSub;		L,T: fsi
ALLOCr:		L_stkp+1, BUS, :pushT1B;			duplicates pushTB

;
;  Allocation failed - save mpc, undiddle lp, push fsi*4 on stack, then trap
;

ALLOCrf:	IR_sr5, :Savpcinframe;				failure because lists empty
ALLOCrfr:	L_temp2, TASK, :doAllocTrap;			pick up trap parameter

;
;  Inform software that allocation failed
;

doAllocTrap:	ATPreg_L;					store param. to trap proc.
		T_sAllocTrap, :Mtrap;				go trap to software


;-----------------------------------------------------------------
; FREE - release the frame whose address is <TOS> (popped)
;-----------------------------------------------------------------

FREE:		L_ret10, TASK, :Xpopsub;			returns to FREErx
FREErx:		frame_L, TASK;
		IR_sr1, :FreeSub;
FREEr:		:next;

;-----------------------------------------------------------------
; D e s c r i p t o r   I n s t r u c t i o n s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; DESCB - push <<gp>+gfi offset>+2*alpha+1 (masking gfi word appropriately)
;	DESCB is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------

DESCB:		T_gp;
		T_ngpoffset+T+1, :DESCBcom;			T:address of frame

DESCBcom:	MAR_gfioffset+T;				start fetch of gfi word
		T_gfimask;					mask to isolate gfi bits
		T_MD.T;						T:gfi
		L_ib+T, T_ib;					L:gfi+alpha, T:alpha
		T_M+T+1, :pushTA;				pushTA because A-aligned


;-----------------------------------------------------------------
; DESCBS - push <<TOS>+gfi offset>+2*alpha+1 (masking gfi word appropriately)
;	DESCBS is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------

DESCBS:		L_ret15, TASK, :Xpopsub;			returns to DESCBcom

;-----------------------------------------------------------------
; T r a n s f e r   O p e r a t i o n s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; Savpcinframe subroutine:
;	stashes C-relative (mpc,ib) in current local frame
;	undiddles lp into my and lp
;	Entry conditions: none
;	Exit conditions:
;	  current frame+1 holds pc relative to code segment base (+ = even, - = odd)
;	  lp is undiddled
;	  my has undiddled lp (source link for Xfer)
;-----------------------------------------------------------------
; !1,1,Savpcinframe;						required by PORTO
; !7,10,XferGT,Xfer,Mstopr,PORTOpc,LSTr,ALLOCrfr,,;		returns (appear with ALLOC)
!7,1,Savpcx;							shake IR_ dispatch
!1,2,Spcodd,Spceven;						pc odd or even

Savpcinframe: 	T_cp, :Savpcx;					code segment base
Savpcx:		L_mpc-T;					L is code-relative pc
		SINK_ib, BUS=0;					check for odd or even pc
		T_M, :Spcodd;					pick up pc word addr

Spcodd:		L_0-T, TASK, :Spcopc;				- pc => odd, this word
Spceven:	L_0+T+1, TASK, :Spcopc;				+ pc => even, next word

Spcopc:		taskhole_L;					pc value to save
		L_0;						(can't merge above - TASK)
		T_npcoffset;					offset to pc stash
		MAR_lp-T, T_lp;					(MAR_lp-npcoffset, T_lp)
		ib_L;						clear ib for XferG
		L_nlpoffset+T+1;				L:undiddled lp
		MD_taskhole;					stash pc in frame+pcoffset
		my_L, IDISP, TASK;				store undiddled lp
		lp_L, :XferGT;

;-----------------------------------------------------------------
; Loadgc subroutine:
;	load global pointer and code pointer given local pointer or GFT pointer
;	Entry conditions:
;	  T contains either local frame pointer or GFT pointer
;	  memory fetch of T has been started
;	  pending branch (1) catches zero pointer
;	Exit conditions:
;	  lp diddled (to framebase+6)
;	  mpc set from second word of entry (PC or EV offset)
;	  first word of code segment set to 1 (used by code swapper)
;	Assumes only 2 callers
;-----------------------------------------------------------------

!1,2,Xfer0r,Xfer1r;						return points
!1,2,Loadgc,LoadgcTrap;
!1,2,LoadgcOK,LoadgcNull;					good global frame or null
!1,2,LoadgcIn,LoadgcSwap;					in-core or swapped out
!1,2,LoadgcDiv2,LoadgcDiv4;					first/second shift
!1,2,LoadgcNoXM,LoadgcIsXM;					short/long codebase

Loadgc:		L_lpoffset+T;					diddle (presumed) lp
		lp_L;						(only correct if frame ptr)
		T_MD;						global frame address
		L_MD;						2nd word (PC or EV offset)
		MAR_cpoffset+T;					read code pointer
		mpc_L, L_T;					copy g to L for null test
		L_cpoffset+T+1, SH=0;				test gf=0
		taskhole_L, :LoadgcOK;				taskhole:addr of hi code base

LoadgcOK:	L_MD, BUSODD, TASK;				L: low bits of code base
		cp_L, :LoadgcIn;				stash low bits, branch if odd

LoadgcIn:	MAR_BankReg;					access bank register
		T_14;						mask to save primary bank
		L_MD AND T;					L: primary bank *4
		temp2_L, :LoadgcShift;				temp2: primary bank *4
LoadgcShift:	newfield_L RSH 1, L_0-T, :LoadgcDiv2;		newfield: bank*2, L: negative
LoadgcDiv2:	L_newfield, SH<0, TASK, :LoadgcShift;		SH<0 forces branch, TASK safe
LoadgcDiv4:	MAR_T_taskhole;					fetch high bits of code base
		L_gpcpoffset+T;					diddle gp
		gp_L;
		T_177400;					mask for high bits
		L_MD AND T, T_MD;
		T_3.T, SH=0;					T: bank if long codebase
		MAR_BankReg, :LoadgcNoXM;			initiate store

LoadgcNoXM:	T_newfield, :LoadgcIsXM;			T: MDS bank
LoadgcIsXM:	L_temp2 OR T, TASK;				L: new bank registers
		MD_M;						stash bank

		XMAR_cp;					access first cseg word
		IDISP, TASK;					dispatch return
		MD_ONE, :Xfer0r;

;
;	picked up global frame of zero somewhere, call it unbound
;
!1,1,Stashmx;
LoadgcNull:	T_sUnbound, :Stashmx;				BUSODD may be pending

;
;	swapped code segment, trap to software
;
LoadgcSwap:	T_sSwapTrap, :Stashmx;

;
;	destination link = 0
;
LoadgcTrap:	T_sControlFault, :Mtrap;

;-----------------------------------------------------------------
; CheckXferTrap subroutine:
;	Handles Xfer trapping
;	Entry conditions:
;	  IR: return number in DISP
;	  T: parameter to be passed to trap routine
;	Exit conditions:
;	  if trapping enabled, initiates trap and doesn't return.
;------------------------------------------------------------------
!3,4,Xfers,XferG,RETxr,;					returns from CheckXferTrap
!1,2,NoXferTrap,DoXferTrap;
!3,1,DoXferTrapx;

CheckXferTrap:	L_XTSreg, BUSODD;				XTSreg[15]=1 => trap
		SINK_DISP, BUS, :NoXferTrap;			dispatch (possible) return

NoXferTrap:	XTSreg_L RSH 1, :Xfers;				reset XTSreg[15] to 0 or 1

DoXferTrap:	L_DISP, :DoXferTrapx;				tell trap handler which case
DoXferTrapx:	XTSreg_L LCY 8, L_T;				L:trap parameter
		XTPreg_L;
		T_sXferTrap, :Mtrap;				off to trap sequence

;-----------------------------------------------------------------
; Xfer open subroutine:
;	decodes general destination link for Xfer
;	Entry conditions:
;	  source link in my
;	  destination link in mx
;	Exit conditions:
;	  if destination is frame pointer, does complete xfer and exits to Ifetch.
;	  if destination is procedure descriptor, locates global frame and entry
;	    number, then exits to 'XferG'.
;------------------------------------------------------------------

!3,4,Xfer0,Xfer1,Xfer2,Xfer3;					destination link type

Xfer:		T_mx;						mx[14:15] is dest link type
		IR_0, :CheckXferTrap;
Xfers:		L_3 AND T;					extract type bits
		SINK_M, L_T, BUS;				L:dest link, branch on type
		SH=0, MAR_T, :Xfer0;				check for link = 0. Memory
;								data is used only if link
;								is frame pointer or indirect

;-----------------------------------------------------------------
; mx[14-15] = 00
;	Destination link is frame pointer
;-----------------------------------------------------------------

Xfer0:		IR_msr0, :Loadgc;				to LoadgcNull if dest link = 0
Xfer0r:		L_T_mpc;					offset from cp: - odd, + even

;
; If 'brkbyte' ~= 0, we are proceeding from a breakpoint.
;     pc points to the BRK instruction:
;	even pc => fetch word, stash left byte in ib, and execute brkbyte
;	odd pc => clear ib, execute brkbyte
;
!1,2,Xdobreak,Xnobreak;
!1,2,Xfer0B,Xfer0A;
!1,2,XbrkB,XbrkA;
!1,2,XbrkBgo,XbrkAgo;

		SINK_brkbyte, BUS=0;				set up by Loadstate
		SH<0, L_0, :Xdobreak;				dispatch even/odd pc

;
; Not proceeding from a breakpoint - simply pick up next instruction
;

Xnobreak:	:Xfer0B;

Xfer0B:		L_XMAR_cp+T, :nextAdeafa;			fetch word, pc even
Xfer0A:		L_XMAR_cp-T;					fetch word, pc odd
		mpc_L, :nextXBni;

;
; Proceeding from a breakpoint - dispatch brkbyte and clear it
;

Xdobreak:	ib_L, :XbrkB;					clear ib for XbrkA

XbrkB:		IR_sr20;					here if BRK at even byte
		L_XMAR_cp+T, :GetalphaAx;			set up ib (return to XbrkBr)

XbrkA:		L_cp-T;						here if BRK at odd byte
		mpc_L, L_0, BUS=0, :XbrkBr;			ib already zero (to XbrkAgo)

XbrkBr:		SINK_brkbyte, BUS, :XbrkBgo;			dispatch brkbyte

XbrkBgo:	brkbyte_L RSH 1, T_0+1, :NOOP;			clear brkbyte, act like nextA
XbrkAgo:	brkbyte_L, T_0+1, BUS=0, :NOOP;			clear brkbyte, act like next

;-----------------------------------------------------------------
; mx[14-15] = 01
;	Destination link is procedure descriptor:
;	  mx[0-8]: GFT index (gfi)
;	  mx[9-13]: EV bias, or entry number (en)
;-----------------------------------------------------------------

Xfer1:		temp_L RSH 1;					temp:ep*2+garbage
		count_L MLSH 1;					since L=T, count_L LCY 1;
		L_count, TASK;					gfi now in 0-7 and 15
		count_L LCY 8;					count:gfi w/high bits garbage
		L_count, TASK;
		count_L LSH 1;					count:gfi*2 w/high garbage
		T_count;
		T_1777.T;					T:gfi*2
		MAR_gftm1+T+1;					fetch GFT[T]
		IR_sr1, :Loadgc;				pick up two word entry into
;								gp and mpc
Xfer1r:		L_temp, TASK;					L:en*2+high bits of garbage
		count_L RSH 1;					count:en+high garbage
		T_count;
		T_enmask.T;					T:en
		L_mpc+T+1, TASK;				(mpc has EV base in code seg)
		count_L LSH 1, :XferG;				count:ep*2


;-----------------------------------------------------------------
; mx[14-15] = 10
;	Destination link is indirect:
;	  mx[0-15]: address of location holding destination link
;-----------------------------------------------------------------

Xfer2:		NOP;						wait for memory
		T_MD, :Xfers;

;-----------------------------------------------------------------
; mx[14-15] = 11
;	Destination link is unbound:
;	  mx[0-15]: passed to trap handler
;-----------------------------------------------------------------

Xfer3:		T_sUnbound, :Stashmx;

;-----------------------------------------------------------------
; XferG open subroutine:
;	allocates new frame and patches links
;	Entry conditions:
;	  'count' holds index into code segment entry vector
;	  assumes lp is undiddled (in case of AllocTrap)
;	  assumes gp (undiddled) and cp set up
;	Exit conditions:
;	  exits to instruction fetch (or AllocTrap)
;-----------------------------------------------------------------

;
; Pick up new pc from specified entry in entry vector
;

XferGT:		T_count;					parameter to CheckXferTrap
		IR_ONE, :CheckXferTrap;
XferG:		T_count;					index into entry vector
		XMAR_cp+T;					fetch of new pc and fsi
		T_cp-1;						point just before bytes
;								(main loop increments mpc)
		IR_sr1;						note: does not cause branch
		L_MD+T;						relocate pc from cseg base
		T_MD;						second word contains fsi
		mpc_L;						new pc setup, ib already 0
		T_377.T, :AllocSub;				mask for size index
;
; Stash source link in new frame, establishing dynamic link
;
XferGr:		MAR_retlinkoffset+T;				T has new frame base
		L_lpoffset+T;					diddle new lp
		lp_L;						install diddled lp
		MD_my;						source link to new frame

;
; Stash new global pointer in new frame (same for local call)
;
		MAR_T;						write gp to word 0 of frame
		T_gpoffset;					offset to point at gf base
		L_gp-T, TASK;					subtract off offset
		MD_M, :nextAdeaf;				global pointer stashed, GO!

;
;  Frame allocation failed - push destination link, then trap
;
; !1,2,doAllocTrap,XferGfz;					(appears with ALLOC)

XferGrf:	L_mx, BUS=0;					pick up destination, test = 0
		T_count-1, :doAllocTrap;			T:2*ep+1

;	if destination link is zero (i.e. local procedure call), we must first
;	fabricate the destination link

XferGfz:	L_T, T_ngfioffset;				offset from gp to gfi word
		MAR_gp-T;					start fetch of gfi word
		count_L LSH 1;					count:4*ep+2
		L_count-1;					L:4*ep+1
		T_gfimask;					mask to save gfi only
		T_MD.T;						T:gfi
		L_M+T, :doAllocTrap;				L:gfi+4*ep+1 (descriptor)

;-----------------------------------------------------------------
; Getlink subroutine:
;	fetches control link from either global frame or code segment
;	Entry conditions:
;	  temp: - (index of desired link + 1)
;	  IR: DISP field zero/non-zero to select return point (2 callers only)
;	Exit conditions:
;	  L,T: desired control link
;-----------------------------------------------------------------
!1,2,EFCgetr,LLKBr;						return points
!1,2,framelink,codelink;
!7,1,Fetchlink;							shake IR_ in KFCB

Getlink:	T_gp;						diddled frame address
		MAR_T_ngpoffset+T+1;				fetch word 0 of global frame
		L_temp+T, T_temp;				L:address of link in frame
		taskhole_L;					stash it
		L_cp+T;						L:address of link in code
		SINK_MD, BUSODD, TASK;				test bit 15 of word zero
		temp2_L, :framelink;				stash code link address

framelink:	MAR_taskhole, :Fetchlink;			fetch link from frame
codelink:	XMAR_temp2, :Fetchlink;				fetch link from code

Fetchlink:	SINK_DISP, BUS=0;				dispatch to caller
		L_T_MD, :EFCgetr;

;-----------------------------------------------------------------
; EFCn - perform XFER to destination specified by external link n
;-----------------------------------------------------------------
; !1,1,EFCr; implicit in EFCr's return number (23B)

EFC0:		IR_ONE, T_ONE-1, :EFCr;				0th control link
EFC1:		IR_T_ONE, :EFCr;				1st control link
EFC2:		IR_T_2, :EFCr;					. . .
EFC3:		IR_T_3, :EFCr;
EFC4:		IR_T_4, :EFCr;
EFC5:		IR_T_5, :EFCr;
EFC6:		IR_T_6, :EFCr;
EFC7:		IR_T_7, :EFCr;
EFC8:		IR_T_10, :EFCr;
EFC9:		IR_T_11, :EFCr;
EFC10:		IR_T_12, :EFCr;
EFC11:		IR_T_13, :EFCr;
EFC12:		IR_T_14, :EFCr;
EFC13:		IR_T_15, :EFCr;
EFC14:		IR_T_16, :EFCr;
EFC15:		IR_T_17, :EFCr;


;-----------------------------------------------------------------
; EFCB - perform XFER to destination specified by external link 'alpha'
;-----------------------------------------------------------------
!1,1,EFCdoGetlink;						shake B/A dispatch (Getalpha)

EFCB:		IR_sr23, :Getalpha;				fetch link number
EFCr:		L_0-T-1, TASK, :EFCdoGetlink;			L:-(link number+1)

EFCdoGetlink:	temp_L, :Getlink;				stash index for Getlink
EFCgetr:	IR_sr1, :SFCr;					for Savpcinframe; no branch


;-----------------------------------------------------------------
; SFC - Stack Function Call (using descriptor on top of stack)
;-----------------------------------------------------------------

SFC:		IR_sr1, :Popsub;				get dest link for xfer
;								now assume IR still has sr1
SFCr:		mx_L, :Savpcinframe;				set dest link, return to Xfer

;-----------------------------------------------------------------
; KFCB - Xfer using destination <<SD>+alpha>
;-----------------------------------------------------------------
; !1,1,KFCr; implicit in KFCr's return number (21B)
!1,1,KFCx;							shake B/A dispatch (Getalpha)
; !7,1,Fetchlink; 	appears with Getlink

KFCB:		IR_sr21, :Getalpha;				fetch alpha
KFCr:		IR_avm1, T_avm1+T+1, :KFCx;			DISP must be non zero
KFCx:		MAR_sdoffset+T, :Fetchlink;			Fetchlink shakes IR_ dispatch


;-----------------------------------------------------------------
; BRK - Breakpoint (equivalent to KFC 0)
;-----------------------------------------------------------------

BRK:		ib_L, T_sBRK, :KFCr;				ib = 0 <=> BRK B-aligned


;-----------------------------------------------------------------
; Trap sequence:
;	used to report various faults during Xfer
;	Entry conditions:
;	  T: index in SD through which to trap
;	  Savepcinframe has already been called
;	entry at Stashmx puts destination link in OTPreg before trapping
;-----------------------------------------------------------------
; !1,1,Stashmx; above with Loadgc code

Stashmx:	L_mx;						can't TASK, T has trap index
		OTPreg_L, :Mtrap;

Mtrap:		T_avm1+T+1;
		MAR_sdoffset+T;					fetch dest link for trap
		NOP;
Mtrapa:		L_MD, TASK;					(enter here from PORTO)
		mx_L, :Xfer;

;-----------------------------------------------------------------
; LFCn - call local procedure n (i.e. within same global frame)
;-----------------------------------------------------------------
!1,1,LFCx;							shake B/A dispatch

LFC1:		L_2, :LFCx;
LFC2:		L_3, :LFCx;
LFC3:		L_4, :LFCx;
LFC4:		L_5, :LFCx;
LFC5:		L_6, :LFCx;
LFC6:		L_7, :LFCx;
LFC7:		L_10, :LFCx;
LFC8:		L_11, :LFCx;

LFCx:		count_L LSH 1, L_0, IR_msr0, :SFCr;		stash index of proc. (*2)
;								dest link = 0 for local call
;								will return to XferG


;-----------------------------------------------------------------
; LFCB - call local procedure number 'alpha' (i.e. within same global frame)
;-----------------------------------------------------------------

LFCB:		IR_sr22, :Getalpha;
LFCr:		L_0+T+1, :LFCx;

;-----------------------------------------------------------------
; RET - Return from function call.
;-----------------------------------------------------------------
!1,1,RETx;							shake B/A branch

RET:		T_lp, :RETx;					local pointer

RETx:		IR_2, :CheckXferTrap;
RETxr:		MAR_nretlinkoffset+T;				get previous local frame
		L_nlpoffset+T+1;
		frame_L;					stash for 'Free'
		L_MD;						pick up prev frame pointer
		mx_L, L_0, IR_msr0, TASK;			mx points to caller
		my_L, :FreeSub;					clear my and go free frame
RETr:		T_mx, :Xfers;					xfer back to caller


;-----------------------------------------------------------------
; LINKB - store back link to enclosing context into local 0
;	LINKB is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------

LINKB:		MAR_lp-T-1;					address of local 0
		T_ib;
		L_mx-T, TASK;					L: mx-alpha
		MD_M, :nextA;					local 0 _ mx-alpha


;-----------------------------------------------------------------
; LLKB - push external link 'alpha'
;	LLKB is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------

LLKB:		T_ib;						T:alpha
		L_0-T-1, IR_0, :EFCdoGetlink;			L:-(alpha+1), go call Getlink
LLKBr:		:pushTA;					alignment requires pushTA

;-----------------------------------------------------------------
; P o r t   O p e r a t i o n s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; PORTO - PORT Out (XFER thru PORT addressed by TOS)
;-----------------------------------------------------------------

PORTO:		IR_sr3, :Savpcinframe;				undiddle lp into my
PORTOpc:	L_ret5, TASK, :Xpopsub;				returns to PORTOr
PORTOr:		MAR_T;						fetch from TOS
		L_T;
		MD_my;						frame addr to word 0 of PORT
		MAR_M+1;					second word of PORT
		my_L, :Mtrapa;					source link to PORT address
	

;-----------------------------------------------------------------
; PORTI - PORT In (Fix up PORT return, always immediately after PORTO)
;	assumes that my and mx remain from previous xfer
;-----------------------------------------------------------------
!1,1,PORTIx;
!1,2,PORTInz,PORTIz;

PORTI:		MAR_mx, :PORTIx;				first word of PORT

PORTIx:		SINK_my, BUS=0;
		TASK, :PORTInz;

PORTInz:	MD_0;
		MAR_mx+1;					store it as second word
		TASK, :PORTIz;
PORTIz:		MD_my, :next;					store my or zero

;-----------------------------------------------------------------
; S t a t e   S w i t c h i n g
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; Savestate subroutine:
;	saves state of pre-empted emulation
;	Entry conditions:
;	  L holds address where state is to be saved
;	  assumes undiddled lp
;	Exit conditions:
;	  lp, stkp, and stack (from base to min[depth+2,8]) saved
;-----------------------------------------------------------------

; !1,2,DSTr1,Mstopc; actually appears as %1,1777,776,DSTr1,Mstopc; and is located
; in the front of the main file (Mesa.mu).

!17,20,Sav0r,Sav1r,Sav2r,Sav3r,Sav4r,Sav5r,Sav6r,Sav7r,Sav10r,Sav11r,DSTr,,,,,;
!1,2,Savok,Savmax;

Savestate:	temp_L;
Savestatea:	T_-12+1;					i.e. T_-11
		L_lp, :Savsuba;
Sav11r:		L_stkp, :Savsub;
Sav10r:		T_stkp+1;
		L_-7+T;						check if stkp > 5 or negative
		L_0+T+1, ALUCY;					L:stkp+2
		temp2_L, L_0-T, :Savok;				L:-stkp-1

Savmax:		T_-7;						stkp > 5  => save all
		L_stk7, :Savsuba;

Savok:		SINK_temp2, BUS;				stkp < 6 => save to stkp+2
		count_L, :Sav0r;

Sav7r:		L_stk6, :Savsub;
Sav6r:		L_stk5, :Savsub;
Sav5r:		L_stk4, :Savsub;
Sav4r:		L_stk3, :Savsub;
Sav3r:		L_stk2, :Savsub;
Sav2r:		L_stk1, :Savsub;
Sav1r:		L_stk0, :Savsub;
Sav0r:		SINK_DISP, BUS;					return to caller
		T_-12, :DSTr1;					(for DST's benefit)

;   Remember, T is negative

Savsub:		T_count;
Savsuba:	temp2_L, L_0+T+1;
		MAR_temp-T;
		count_L, L_0-T;					dispatch on pos. value
		SINK_M, BUS, TASK;
		MD_temp2, :Sav0r;

;-----------------------------------------------------------------
; Loadstate subroutine:
;	load state for emulation  
;	Entry conditions:
;	  L points to block from which state is to be loaded
;	Exit conditions:
;	  stkp, mx, my, and stack (from base to min[stkp+2,8]) loaded
;	    (i.e. two words past TOS are saved, if they exist)
;	Note:  if stkp underflows but an interrupt is taken before we detect
;	  it, the subsequent Loadstate (invoked by Mgo) will see 377B in the
;	  high byte of stkp.  Thinking this a breakpoint resumption, we will
;	  load the state, then dispatch the 377 (via brkbyte) in Xfer0, causing
;	  a branch to StkUf (!)  This is not a fool-proof check against a bad
;	  stkp value at entry, but it does protect against the most common
;	  kinds of stack errors.
;-----------------------------------------------------------------
!17,20,Lsr0,Lsr1,Lsr2,Lsr3,Lsr4,Lsr5,Lsr6,Lsr7,Lsr10,Lsr11,Lsr12,,,,,;
!1,2,Lsmax,Ldsuba;
!1,2,Lsr,BITBLTdoner;

Loadstate:	temp_L, IR_msr0, :NovaIntrOn;			stash pointer
Lsr:		T_12, :Ldsuba;
Lsr12:		my_L, :Ldsub;
Lsr11:		mx_L, :Ldsub;
Lsr10:		stkp_L;
		T_stkp;						check for BRK resumption
		L_177400 AND T;					(i.e. bytecode in stkp)
		brkbyte_L LCY 8;				stash for Xfer
		L_T_17.T;					mask to 4 bits
		L_-7+T;						check stkp > 6
		L_T, SH<0;
		stkp_L, T_0+T+1, :Lsmax;			T:stkp+1
Lsmax:		T_7, :Ldsuba;
Lsr7:		stk7_L, :Ldsub;
Lsr6:		stk6_L, :Ldsub;
Lsr5:		stk5_L, :Ldsub;
Lsr4:		stk4_L, :Ldsub;
Lsr3:		stk3_L, :Ldsub;
Lsr2:		stk2_L, :Ldsub;
Lsr1:		stk1_L, :Ldsub;
Lsr0:		stk0_L, :Xfer;

Ldsub:		T_count;
Ldsuba:		MAR_temp+T;
		L_ALLONES+T;					decr count for next time
		count_L, L_T;					use old value for dispatch
		SINK_M, BUS;
		L_MD, TASK, :Lsr0;

;-----------------------------------------------------------------
; DST - dump state at block starting at <LP>+alpha, reset stack pointer
;	assumes DST is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

DST:		T_ib;						get alpha
		T_lp+T+1;
		L_nlpoffset1+T+1, TASK;				L:lp-lpoffset+alpha
		temp_L, IR_ret0, :Savestatea;
DSTr1:		L_my, :Savsuba;					save my too!
DSTr:		temp_L, L_0, TASK, BUS=0, :Setstkp;		zap stkp, return to 'nextA'


;-----------------------------------------------------------------
; LST - load state from block starting at <LP>+alpha
;	assumes LST is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

LST:		L_ib;
		temp_L, L_0, TASK;
		ib_L;						make Savpcinframe happy
		IR_sr4, :Savpcinframe;				returns to LSTr
LSTr:		T_temp;						get alpha back
		L_lp+T, TASK, :Loadstate;			lp already undiddled


;-----------------------------------------------------------------
; LSTF - load state from block starting at <LP>+alpha, then free frame
;	assumes LSTF is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

LSTF:		T_lpoffset;
		L_lp-T, TASK;					compute frame base
		frame_L;
		IR_sr2, :FreeSub;

LSTFr:		T_frame;					set up by FreeSub
		L_ib+T, TASK, :Loadstate;			get state from dead frame

;-----------------------------------------------------------------
; E m u l a t o r   A c c e s s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; RR - push <emulator register alpha>, where:
;	RR is A-aligned (also ensures no pending branch at entry)
;	alpha:	1 => wdc, 2 => XTSreg, 3 => XTPreg, 4 => ATPreg,
;		5 => OTPreg
;-----------------------------------------------------------------
!1,1,DoRamRWB;							shake B/A dispatch (BLTL)

RR:		L_0, SWMODE, :DoRamRWB;
DoRamRWB:	SINK_M, BUS, L_T, :ramOverflow;			L_T for WR


;-----------------------------------------------------------------
; WR - emulator register alpha _ <TOS> (popped), where:
;	WR is A-aligned (also ensures no pending branch at entry)
;	alpha: 1 => wdc, 2 => XTSreg
;-----------------------------------------------------------------

WR:		L_ret3, TASK, :Xpopsub;
WRr:		L_2, SWMODE, :DoRamRWB;


;-----------------------------------------------------------------
; JRAM - JMPRAM for Mesa programs (when emulator is in ROM1)
;-----------------------------------------------------------------

JRAM:		L_ret2, TASK, :Xpopsub;
JRAMr:		SINK_M, BUS, SWMODE, :next;			BUS applied to 'nextBa' (=0)

;-----------------------------------------------------------------
; P r o c e s s / M o n i t o r   S u p p o r t
;-----------------------------------------------------------------
!1,1,MoveParms1;						shake B/A dispatch
!1,1,MoveParms2;						shake B/A dispatch
!1,1,MoveParms3;						shake B/A dispatch
;!1,1,MoveParms4;						shake B/A dispatch


;-----------------------------------------------------------------
; ME,MRE - Monitor Entry and Re-entry
; MXD - Monitor Exit and Depart
;-----------------------------------------------------------------
!1,1,FastMREx;							drop ball 1
!1,1,FastEEx;							drop ball 1
!7,1,FastEExx;							shake IR_isME/isMXD
!1,2,MXDr,MEr;
!7,1,FastEExxx;							shake IR_isMRE
%3,17,14,MXDrr,MErr,MRErr;
!1,2,FastEEtrap1,MEXDdone;
!1,2,FastEEtrap2,MREdone;

;  The following constants are carefully chosen to agree with the above pre-defs

$isME		$6001;						IDISP:1, DISP:1, mACSOURCE:1
$isMRE		$65403;						IDISP:13, DISP:3, mACSOURCE:16
$isMXD		$402;						IDISP:0, DISP:2, mACSOURCE:0

ME:		IR_isME, :FastEEx;				indicate ME instruction
MXD:		IR_isMXD, :FastEEx;				indicate MXD instruction

MRE:		MAR_HardMRE, :FastMREx;				<HardMRE> ~= 0 => do Nova code
FastMREx:	IR_isMRE, :MXDr;				indicate MRE instruction

FastEEx:	MAR_stk0, IDISP, :FastEExx;			fetch monitor lock
FastEExx:	T_100000, :MXDr;				value of unlocked monitor lock

MXDr:		L_MD, mACSOURCE, :FastEExxx;			L:0 if locked (or queue empty)
MEr:		L_MD-T, mACSOURCE, :FastEExxx;			L:0 if unlocked

FastEExxx:	MAR_stk0, SH=0, :MXDrr;				start store, test lock state

; Note: if control goes to FastEEtrap1 or FastEEtrap2, AC1 or AC2 will be smashed,
;	but their contents aren't guaranteed anyway.
; Note also that MErr and MXDrr cannot TASK.

MXDrr:		L_T, T_0, :FastEEtrap1;				L:100000, T:0 (stkp value)
MErr:		T_0+1, :FastEEtrap1;				L:0, T:1 (stkp value)
MRErr:		L_0+1, TASK, :FastEEtrap2;			L:1 (stkp value)

MEXDdone:	MD_M, L_T, TASK, :Setstkp;

MREdone:	stkp_L, :ME;					queue empty, treat as ME

;-----------------------------------------------------------------
; MXW - Monitor Exit and Wait
;-----------------------------------------------------------------

MXW:		IR_4, :MoveParms3;				3 parameters 


;-----------------------------------------------------------------
; NOTIFY,BCAST - Awaken process(es) from condition variable
;-----------------------------------------------------------------

NOTIFY:		IR_5, :MoveParms1;				1 parameter
BCAST:		IR_6, :MoveParms1;				1 parameter


;-----------------------------------------------------------------
; REQUEUE - Move process from queue to queue
;-----------------------------------------------------------------

REQUEUE:	IR_7, :MoveParms3;				3 parameter


;-----------------------------------------------------------------
; Parameter Transfer for Nova code linkages
;	Entry Conditions:
;	  T: 1
;	  IR: dispatch vector index of Nova code to execute
;-----------------------------------------------------------------

;MoveParms4:	L_stk3, TASK;					if you uncomment this, don't
;		AC3_L;						forget the pre-def above!
MoveParms3:	L_stk2, TASK;
FastEEtrap2:	AC2_L;						(enter here from MRE)
MoveParms2:	L_stk1, TASK;
FastEEtrap1:	AC1_L;						(enter here from ME/MXD)
MoveParms1:	L_stk0, TASK;
		AC0_L;

		L_0, TASK;					indicate stack empty
		stkp_L;
		T_DISP+1, :STOP;

;-----------------------------------------------------------------
; M i s c e l l a n e o u s   O p e r a t i o n s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; CATCH - an emulator no-op of length 2.
;	CATCH is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------

CATCH:		L_mpc+1, TASK, :nextAput;			duplicate of 'nextA'


;-----------------------------------------------------------------
; STOP - return to Nova at 'NovaDVloc+1'
;	control also comes here from process opcodes with T set appropriately
;-----------------------------------------------------------------
!1,1,GotoNova;							shake B/A dispatch

STOP:		L_NovaDVloc+T, :GotoNova;


;-----------------------------------------------------------------
; STARTIO - perform Nova-like I/O function
;-----------------------------------------------------------------

STARTIO:	L_ret4, TASK, :Xpopsub;				get argument in L
STARTIOr:	SINK_M, STARTF, :next;


;-----------------------------------------------------------------
; MISC - escape hatch for more than 256 opcodes
;-----------------------------------------------------------------
; !5,2,Dpushx,RCLKr;						appears with Dpush

MISC:		IR_sr36, :Getalpha;				get argument in L
;								throws away alpha for now
MISCr:		L_CLOCKLOC-1, IR_CLOCKLOC, :Dpushb;		IR_ causes branch 1!
;								(and mACSOURCE of 0)
;								Dpushb shakes B/A dispatch
RCLKr:		L_clockreg, :Dpushc;				don't TASK here!

;-----------------------------------------------------------------
; BLT - block transfer
;	assumes stack has precisely three elements:
;	  stk0 - address of first word to read
;	  stk1 - count of words to move
;	  stk2 - address of first word to write
;	the instruction is interruptible and leaves a state suitable
;	  for re-execution if an interrupt must be honored.
;-----------------------------------------------------------------
!1,1,BLTx;							shakes entry B/A branch

BLT:		stk7_L, SWMODE, :BLTx;				stk7=0 <=> branch pending
BLTx:		IR_msr0, :ramBLTloop;				IR_ is harmless


;-----------------------------------------------------------------
; BLTL - block transfer (long pointers)
;	assumes stack has precisely three elements:
;	  stk0, stk1 - address of first word to read
;	  stk2	     - count of words to move
;	  stk3, stk4 - address of first word to write
;	the instruction is interruptible and leaves a state suitable
;	  for re-execution if an interrupt must be honored.
;-----------------------------------------------------------------

BLTL:		stk7_L, L_T, SWMODE, :DoRamRWB;			stk7=0 <=> branch pending, L:1


;-----------------------------------------------------------------
; BLTC - block transfer from code segment
;	assumes stack has precisely three elements:
;	  stk0 - offset from code base of first word to read
;	  stk1 - count of words to move
;	  stk2 - address of first word to write
;	the instruction is interruptible and leaves a state suitable
;	  for re-execution if an interrupt must be honored.
;-----------------------------------------------------------------
!1,1,BLTCx;							shake B/A dispatch

BLTC:		stk7_L, SWMODE, :BLTCx;
BLTCx:		IR_sr1, :ramBLTloop;

;-----------------------------------------------------------------
; BITBLT - do BITBLT using ROM subroutine
;	If BITBLT A-aligned, B byte will be ignored
;-----------------------------------------------------------------
!1,1,BITBLTx;							shake B/A dispatch
!7,1,DoBITBLTx;							shake IR_ dispatch
!3,4,Mstop,,NovaIntrOff,DoBITBLT;				includes NovaIntrOff returns

BITBLT:		stk7_L, :BITBLTx;				save even/odd across ROM call
BITBLTx:	L_stk0, TASK;
		AC2_L;						stash descriptor table
		L_stk1, TASK;
		AC1_L;
		SINK_wdc, BUS=0;				check if Mesa interrupts off
		IR_sr3, :NovaIntrOff;				if so, shut off Nova's
DoBITBLT:	L_BITBLTret, SWMODE, :DoBITBLTx;		get return address
DoBITBLTx:	PC_L, L_0, :ROMBITBLT;				L_0 for Alto II ROM0 "feature"

BITBLTdone:	IR_sr1, :NovaIntrOn;				ensure Nova interrupts are on
BITBLTdoner:	brkbyte_L, BUS=0, TASK, :Setstkp;		don't bother to validate stkp

BITBLTintr:	L_AC1, SWMODE;					pick up intermediate state
		stk1_L, :ramBLTint;				stash instruction state

;-----------------------------------------------------------------
; M e s a / N o v a   C o m m u n i c a t i o n
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; Subroutines to Enable/Disable Nova Interrupts
;-----------------------------------------------------------------
; !3,4,Mstop,,NovaIntrOff,DoBITBLT;				appears with BITBLT
; !1,2,Lsr,BITBLTdoner;						appears with LoadState
!7,1,NovaIntrOffx;						shake IR_ dispatch

NovaIntrOff:	T_100000;					disable bit
NovaIntrOffx:	L_NWW OR T, TASK, IDISP;			turn it on, dispatch return
		NWW_L, :Mstop;

NovaIntrOn:	T_100000;					disable bit
		L_NWW AND NOT T, IDISP;				turn it off, dispatch return
		NWW_L, L_0, :Lsr;


;-----------------------------------------------------------------
; IWDC - Increment Wakeup Disable Counter (disable interrupts)
;-----------------------------------------------------------------
!1,2,IDnz,IDz;

IWDC:		L_wdc+1, TASK, :IDnz;				skip check for interrupts


;-----------------------------------------------------------------
; DWDC - Decrement Wakeup Disable Counter (enable interrupts)
;-----------------------------------------------------------------
!1,1,DWDCx;

DWDC:		MAR_WWLOC, :DWDCx;				OR WW into NWW

DWDCx:		T_NWW;
		L_MD OR T, TASK;
		NWW_L;
		SINK_ib, BUS=0;
		L_wdc-1, TASK, :IDnz;

;  Ensure that one instruction will execute before an interrupt is taken

IDnz:		wdc_L, :next;
IDz:		wdc_L, :nextAdeaf;


;-----------------------------------------------------------------
; Entry to Mesa Emulation
;	AC0 holds address of current process state block
;	Location 'PSBloc' is assumed to hold the same value
;-----------------------------------------------------------------

Mgo:		L_AC0, :Loadstate;

;-----------------------------------------------------------------
;  N o v a   I n t e r f a c e
;-----------------------------------------------------------------
$START		$L004020,0,0;					Nova emulator return address


;-----------------------------------------------------------------
;  Transfer to Nova code
;	Entry conditions:
;	  L contains Nova PC to use
;	Exit conditions:
;	  Control transfers to ROM0 at location 'START' to do Nova emulation
;	  Nova PC points to code to be executed
;	  Except for parameters expected by the target code, all Nova ACs
;	    contain garbage
;	  Nova interrupts are disabled
;-----------------------------------------------------------------

GotoNova:	PC_L, IR_msr0, :NovaIntrOff;			stash Nova PC, return to Mstop


;-----------------------------------------------------------------
;  Control comes here when an interrupt must be taken.  Control will
;  pass to the Nova emulator with interrupts enabled.
;-----------------------------------------------------------------

Intstop:	L_NovaDVloc, TASK;				resume at Nova loc. 30B
		PC_L, :Mstop;

;-----------------------------------------------------------------
;  Stash the Mesa pc and dump the current process state,
;  then start fetching Nova instructions.
;-----------------------------------------------------------------

Mstop:		IR_sr2, :Savpcinframe;				save mpc for Nova code
Mstopr:		MAR_CurrentState;				get current state address
		IR_ret1;					will return to 'Mstopc'
		L_MD, :Savestate;				dump the state

; The following instruction must be at location 'SWRET', by convention.

; Strictly speaking, the following two lines should read:
;Mstopc:	L_T_uCodeVersion;				stash ucode version number
;		L_100000 OR T, SWMODE;				version 1, XM
; However, under the assumption that uCodeVersion=1 (which it does, for Mesa 5.0), we can
; save an instruction as follows:

Mstopc:		L_100000+1, SWMODE;				version 1, XM
		cp_L, :START;					off to the Nova ...