; IfsXEmulator.mu -- Extended Bcpl Emulator
; Copyright Xerox Corporation 1980, 1981

; Last modified May 3, 1981  2:57 PM by Taft

; Derived from ALTOIICODE3.MU, as last modified by Boggs, November 28, 1977


;Get the symbol and constant definitions
;#AltoConsts23.mu;

;LABEL PREDEFINITIONS

;The reset locations of the tasks:

;!17,20,NOVEM,,,,,,,,,,,,,,,;

;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 for ACSOURCE with IR[5-7] # 1 or 5
!37,20,DOINS,DOIND,EMCYCLE,NOPAR,JSRII,,U6,U7,,,,,,,RAMTRAP,TRAP;

;Parameterless macro-op sub-table:
;!37,40,DIR,EIR,BRI,RCLK,SIO,BLT,BLKS,SIT,JMPR,RDRM,WTRM,DIRS,VERS,DREAD,DWRITE,DEXCH,MUL,DIV,DIOG1,DIOG2,BITBLT,XMLDA,XMSTA,,,,,,,,,;

;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


;NOVA EMULATOR

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



;REGISTERS USED BY NOVA EMULATOR 
$AC0	$R3;	AC'S ARE BACKWARDS BECAUSE THE HARDWARE SUPPLIES THE
$AC1	$R2;	COMPLEMENT ADDRESS WHEN ADDRESSING FROM IR
$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,SHIFTX,SH1,SH2,SH3;
!1,2,MAYBE,NOINTR;
!1,2,DOINT,DIS0;
!1,2,SOMEACTIVE,NOACTIVE;
!1,2,IEXIT,NIEXIT;
!7,1,INTCODE;
!3,4,StoreXRet0,StoreXRet1,StoreXRet2;

; new runtime routines, and routines for extended JSR3XX instructions.
; Note: RUxxx labels are attached to otherwise unconstrained instructions
; so as to fill up the Ram Utility area with emulator microcode.

XReturn: MAR← 177740;		Zero bank bits
RU774:	TASK;
RU775:	MD← 0, :Return;

XFrame:	XMAR← AC3;		Start fetch of frame size
RU776:	L← -3, :GetF1;		3 extra words


Finish:	L← 24, :XEmulatorTrap;	377-24 = 353
Abort:	L← 23, :XEmulatorTrap;	377-23 = 354

; Call Bcpl Runtime routine at @(377-L).
; Precisely: store the extended PC in trapXJmp and trapXPC, then
; simulate a JSR @(377-L) executed at trapXJmp-1.
XEmulatorTrap:
	SAD← L;
RU777:	IR← 2, :StoreTrapXPC;	Store extended PC in 631, 632
StoreXRet2:
	L← PC;			Pretend the call was a JSR
RU1000:	AC3← L;
RU1001:	T← SAD;
RU1002:	MAR← 377-T;		Fetch runtime dispatch
StartMD:
	T← IR← 0, :LongJ1;	PC← MD and go to START in ROM


; ObjCall instruction -- implements the Calls mechanism.
; Executes JMP @(AC0+DISP)
; Note that unlike the standard Calls mechanism, this operation
; enters the called procedure at instruction 0 rather than 1, and
; without having clobbered AC3.

ObjCall:
	T← DISP;
RU1003:	MAR← AC0+T, :StartMD;


; STA3JSRI instruction -- combines the effects of:
;	STA 3 1 2
;	JSR @DISP	; (page zero indirect)
; Precisely: AC2!1 ← AC3; AC3 ← PC+1; PC ← @DISP
; This is used for entering the IfsOverlays package fault routine.

STA3JSRI:
	MAR← AC2+1;
	L← PC;			Already incremented
	MD← AC3;
	MAR← DISP;
	AC3← L, :StartMD;


;Xjmp0-3 jump to the extended emulator; the low two bits say which bank.
; Note: XJmp0 is defined only for symmetry -- running the extended emulator
; in bank 0 is totally illegal!

Xjmp0:	:TRAP1X;
Xjmp1:	MAR← 177740, :Xjmp3a;
Xjmp2:	MAR← 177740, :Xjmp3a;
Xjmp3:	MAR← 177740;
Xjmp3a:	L← DISP, L← lgm3;
	MD← M;
	MAR← PC;
	NOP;
	L← MD, TASK, :FINJMPX;

; GetNextChar instruction
; AC0 points to even-word aligned Character Stream Descriptor:
; structure CSD: [ oddByte bit; byteCount bit 15; wordAddress word ]
; DISP=0 just fetches next character.
; DISP=140 also converts lower-case to upper-case if alphabetic.
; Returns +1: stream exhausted
;	+2: AC1 contains next character

! 1, 2, ~Exhausted, Exhausted;
! 1, 2, GLeft, GRight;
! 1, 2, GCheckAlpha, GNCExit;
! 1, 2, ~LCAlpha?, LCAlpha?;
! 1, 2, LCAlpha, ~LCAlpha;

GetNextChar:
	MAR← AC0;
	T← 77777;
	L← MD AND T, T← MD;		MD = Byte flag and count
	L← MD+1, SH=0;			MD = Word address
	MAR← AC0, :~Exhausted;		[~Exhausted, Exhausted]
~Exhausted:
	SAD← L;				Word address +1
	L← 77777+T;			Decrement count and flip byte flag
	MD← M, L← T;
	MAR← SAD-1, SH<0;		Fetch word containing byte
	T← 377, :GLeft;			[GLeft, GRight]

GLeft:
	L← DISP;
	L← MD AND NOT T, SH=0, TASK;	Left byte, flip to right
	AC1← L LCY 8, :GCheckAlpha;	[GCheckAlpha, GNCExit]

GRight:
	L← MD . T;			Right byte, mask it
	MAR← AC0+1;			Store incremented word address
	AC1← L;
	SINK← DISP, BUS=0, TASK;
	MD← SAD, :GCheckAlpha;		[GCheckAlpha, GNCExit]

GNCExit:
	L← PC+1, TASK, :Start2;		Skip next instruction
Exhausted:
	L← PC, TASK, :Start2;		Execute next instruction

GCheckAlpha:
	T← AC1;				The data byte
	L← DISP-T;			140 - byte
	T← M, SH<0;			Lower-case alpha in [141..172]
	L← 31+T+1, :~LCAlpha?;		[~LCAlpha?, LCAlpha?]
LCAlpha?:
	T← AC1, SH<0;
	L← 177740+T, :LCAlpha;		[LCAlpha, ~LCAlpha]
LCAlpha:
	AC1← L;				Return upper-case equivalent
~LCAlpha:
	L← PC+1, TASK, :Start2;
~LCAlpha?:
	L← PC+1, TASK, :Start2;

;Extended Emulator Macro-op dispatch table: (ACSOURCE for IR[5-7] = 1 or 5)
!37,20,DOINSX,DOINDX,,,JSRIIX,U5X,,,,,,,,,RAMTRAPX,;
;** !1,2,StartXOK,StartXBad;


; ALL INSTRUCTIONS RETURN TO StartX WHEN DONE

; **********
; For debugging: trap if we ever find ourselves executing in bank 0
;** StartX:
;** 	MAR← 177740;
;** 	T← 3;
;** 	L← MD AND T;
;** 	L← 37, SH=0;
; **********

StartX:	T← XMAR←PC+SKIP, :StartXOK; [StartXOK, StartXBad]
StartXOK:
	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;
NOINTR:	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,
;OTHERWISE ON THE INDIRECT BIT OR IR[3-7]

DIS1:	T← ACSOURCE, :GETAD;

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

SHIFTX:	DNS← L LCY 8, :StartX; 	SWAP BYTES
SH1:	DNS← L RSH 1, :StartX;	RIGHT 1
SH2:	DNS← L LSH 1, :StartX;	LEFT 1
SH3:	DNS← L, :StartX;		NO SHIFT

DOINS:	L← DISP + T, TASK, :SAVAD, IDISP;	DIRECT INSTRUCTIONS
DOIND:	L← MAR← DISP+T;				INDIRECT INSTRUCTIONS
DOIND1:	XREG← L;
	L← MD, TASK, IDISP;
SAVAD:	SAD← L, :XCTAB;

;JSRII - 64400 - JSR double indirect, PC relative.  Must have X=1 in opcode
JSRIIX:	XMAR← DISP+T, :JSRII1;	FIRST LEVEL

;JSRIS - 65000 - JSR double indirect, AC2 relative.  Must have X=2 in opcode
JSRII:	MAR← DISP+T;	FIRST LEVEL
JSRII1:	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
TRAP1X:	IR← ONE;		Return index
StoreTrapXPC:
	L← 631, :StoreExtendedPC;  Store in 631-632
StoreXRet1:
	SWMODE;
	:TRAP1;

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

EMCYCLE: :TRAP;
NOPAR:	:TRAP;
U6:	:TRAP;
U7:	:TRAP;
CONVERT: :TRAP;

; **********
; Here to trap if started to execute instruction in bank 0.
; L = TrapVec offset to use (37, for opcode 77400); T = PC.
;** StartXBad:
;** 	XREG← L, L← T, TASK;
;** 	PC← L, :TRAP1X;
; **********


%301,1777,1476, UTILJSR,JSR0XX,,JSR1XX,,JSR2XX,,JSR3XX;
;REGJSR is #77 of the runtime dispatch table, i.e.:
;!377,1, REGJSR;			binary xx11111111

FINJSR:	L← PC, SH<0, :JSR0XX;		here after ←DISP, BUS

JSR0XX:	XMAR← PC, :REGJSR;
JSR1XX:	XMAR← PC, :REGJSR;
JSR2XX:	XMAR← PC, :REGJSR;	here also if JSR3XX and sign-extended

JSR3XX:	SINK← DISP, SINK← disp.377, BUS, :UTILJSR;  [UTILJSR, JSR0XX]
UTILJSR: AC3← L, :Lq0.6;	dispatch on low six bits

REGJSR:	T← AC2 -1;		T gets AC2-1
	L← MD;			L gets NumArgs
	T← MAR← -4 +T+1;	T and MAR get AC2-4
	T← 0 +T+1;		T gets AC2-3
	MD← M;			store NumArgs in -4,AC2
	L← ALLONES +T;		L gets AC2-4
	AC3← L, MAR← 0 +T+1;	AC3 gets AC2-4, MAR gets AC2-2
	L← PC +1, TASK;		L gets XPC+1
	MD← M, :XCTAB;		store XPC+1 in -2,AC2
; Zero bank bits and jump to SAD in bank 0

; extended relative instructions

!17,20,XCTABX,XJSRX,XISZX,XDSZX,XLDAX,XSTAX,CONVERTX,,,,,,,,,;
!1,2,FINST1,INCPCX;

U5X:	:TRAP;
RAMTRAPX: :TRAP;
CONVERTX: :TRAP;

DOINSX:	L← DISP + T, TASK, :SAVADX, IDISP;  DIRECT INSTRUCTIONS
DOINDX:	L← XMAR← DISP+T, :DOIND1;	    INDIRECT INSTRUCTIONS (+CONVERT)

SAVADX:	SAD← L, :XCTABX;

XCTABX:	L← SAD, TASK, :FINJMPX;	JMP
XISZX:	XMAR← SAD, :ISZ1X;	ISZ
XDSZX:	XMAR← SAD, :DSZ1X;	DSZ
XLDAX:	XMAR← SAD, :FINLOAD;	LDA 0-3
XSTAX:	XMAR← SAD, :XSTA1;	/*NORMAL

FINJMPX: PC← L, :StartX;

DSZ1X:	T← ALLONES, :FINISZX;
ISZ1X:	T← ONE, :FINISZX;

FINISZX: L← MD+T;
	XMAR← SAD;
	SH=0, :FINSTO;

INCPCX:	MD← SAD, :INCPC1;


; JSR .+n -- allocate a n-1 word long string in the (extended) frame
; DISP = n, AC3 = PC = ., SAD = .+n
!1, 2, SomeStrings, NoStrings;
!1, 2, MoreStrings, EndStrings;
!1, 2, NextString, FoundString;
!1, 2, NoStringOv, StringOv;
!1, 2, MoreCopyString, EndCopyString;

XJSRX:	MAR← T← AC2-1;		Fetch frame!stackBottom
	L← T← -4+T+1;		T← lv (frame!xArgs)
	AC3← L;
	L← MD-T, T← MD;		See if there is a frame!stringList word
	L← T, SH=0, TASK;	Fetch frame!stringList
	XH← L, :SomeStrings;	[SomeStrings, NoStrings] XH← stackBottom

; Search existing string list for this string.  AC3 = previous string
SomeStrings:
	MAR← T← AC3-1, :NextString1;  Fetch string!nextOffset
NextString:
	MAR← T← AC3-1;
NextString1:
	NOP;
	L← T← MD+T+1, BUS=0;	T← next string in list; MD=0 if no more
	MAR← -2+T, :MoreStrings; [MoreStrings, EndStrings] Fetch string!callPC
MoreStrings:
	AC3← L;
	T← PC;
	L← MD-T;		Same call PC?
	SH=0, TASK;
	:NextString;		[NextString, FoundString]

; AC3 points to the correct string in the frame.
; Finish by jumping around the string in the code.
FoundString:
	L← SAD, TASK, :FINJMPX;

; No string list at all.  AC3 = lv (frame!xArgs) = XH = stackBottom
NoStrings:
	T← DISP+1, :EndStrings1;  Need to extend stack by string length +3

; String not found in string list.  AC3 = last string = (XH = stackBottom)+2
EndStrings:
	T← DISP;		Need to extend stack by string length +2
EndStrings1:
	MAR← 335;		Fetch stackMin
	L← XH-T-1;		New stackBottom
	T← M;
	L← MD-T;		Check for stack overflow
	MAR← AC2-1, ALUCY;	Begin to store new stackBottom
	L← T, T← 2, :NoStringOv; [NoStringOv, StringOv]
NoStringOv:
	MD← M, L← M+T;		L← stackBottom+2 = new string
	MAR← T← AC3-1;		Store new offset in previous string!nextOffset
	L← M-T-1, T← M;		L← offset (negative), T← new string
	MD← M, L← T, TASK;
	AC3← L;			AC3← new string

	MAR← L← AC3-1;		newString!nextOffset ← 0 to terminate list
	T← DISP-1;		T← string length in words
	XH← L, L← T, MD← 0;	XH← newString-1
	MAR← XH-1;		newString!callPC ← PC
	XREG← L, TASK;		XREG← string length
	MD← PC;

; Copy string from code to frame, using PC as source and XH+1 as destination.
; XREG = length of string in words.
CopyString:
	XMAR← T← PC;
	L← XREG-1, BUS=0;
	XREG← L, L← 0+T+1, :MoreCopyString; [MoreCopyString, EndCopyString]
MoreCopyString:
	PC← L;
	T← MD;
	MAR← L← XH+1;
	XH← L, L← T, TASK;
	MD← M, :CopyString;

; AC3 points to the correct string in the frame.
; Finish by jumping around the string in the code.
EndCopyString:
	L← SAD, TASK, :FINJMPX;

; Allocating new string would overflow the stack.  Call trap routine
StringOv:
	L← 0, :XEmulatorTrap;	Trap to @377

;MAIN INSTRUCTION TABLE.  GET HERE:
;		(1) AFTER AN INDIRECTION
;		(2) ON DIRECT INSTRUCTIONS 

XCTAB:	MAR← 177740, :FINJMP;		JMP -- zero the bank bits
XJSR:	L← DISP, BUS, :FINJSR;		JSR
XISZ:	MAR← SAD, :ISZ1;		ISZ
XDSZ:	MAR← SAD, :DSZ1;		DSZ
XLDA:	MAR← SAD, :FINLOAD;		LDA 0-3
XSTA:	MAR← SAD;			/*NORMAL
XSTA1:	L← ACDEST, :FINSTO;		/*NORMAL

DSZ1:	T← ALLONES, :FINISZ;
ISZ1:	T← ONE, :FINISZ;

FINSTO:	SAD← L,TASK, :FINST1;		[FINST1, INCPCX]
FINST1:	MD←SAD, :StartX;

FINLOAD: NOP;
LOADX:	L← MD, TASK;
LOADD:	ACDEST← L, :StartX;

FINISZ:	L← MD+T;
	MAR← SAD, SH=0, :FINSTO;

INCPC1:	L← PC+1, TASK, :FINJMPX;

FINJMP:	L← SAD, TASK;
	PC← L, MD← 0, :Start3;

;INTERRUPT SYSTEM.

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;
	NWW← L, :StartX;	(Originally labeled INTZ)

SOMEACTIVE:
	L← 630-1, :StoreExtendedPC;  Store in 627-630 (DISP=0 here)
StoreXRet0:
	MAR← PCLOC;	STORE PC AND SET UP TO FIND HIGHEST PRIORITY REQUEST
	L← 0+1;
	XREG← L, L← 0;
	MD← PC, TASK;

ILPA:	PC← L;
	T← SAD;			(Originally labeled ILP)
	L← XREG AND T, T← XREG;
	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
	T← M;
	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;		SAD← 1B5 TO DISABLE INTERRUPTS

	MAR← WWLOC;		RESTORE WW TO CORE
	L← SAD;			AND REPLACE IT WITH SAD IN NWW
	MD← NWW, TASK;
	NWW← L, :Start3;


; Subroutine to store extended PC and switch to bank 0.
; L has address of XJMP cell (XPC is XJMP+1).
; Does a return branch on DISP.

StoreExtendedPC:
	MAR← M+1;		Start store of XPC
	T← sr10-1;		sr10 = 64024
	MD← PC;
	MAR← 177740;		Start fetch of bank register
	T← 27 +T+1;		64053
	T← MD +T+1;		64034 + bank bits (high 12 bits are ones)
	MAR← M;			Start store of XJMP
	PC← L, L← T, TASK;	PC← address of XPC cell
	MD← M;

	MAR← 177740;		Zero bank bits
	SINK← DISP, BUS, TASK;
	MD← 0, :StoreXRet0;