diff --git a/Contralto/CPU/UCodeMemory.cs b/Contralto/CPU/UCodeMemory.cs
index 2aaa5ef..ffdb5d4 100644
--- a/Contralto/CPU/UCodeMemory.cs
+++ b/Contralto/CPU/UCodeMemory.cs
@@ -103,6 +103,7 @@ namespace Contralto.CPU
Logging.Log.Write(Logging.LogComponent.Microcode, "SWMODE: Current Bank {0}", _microcodeBank);
// 2K ROM
+ /*
switch(_microcodeBank)
{
case MicrocodeBank.ROM0:
@@ -116,10 +117,10 @@ namespace Contralto.CPU
case MicrocodeBank.RAM0:
_microcodeBank = (nextAddress & 0x100) == 0 ? MicrocodeBank.ROM0 : MicrocodeBank.ROM1;
break;
- }
+ } */
// for 1K ROM
- //_microcodeBank = _microcodeBank == MicrocodeBank.ROM0 ? MicrocodeBank.RAM0 : MicrocodeBank.ROM0;
+ _microcodeBank = _microcodeBank == MicrocodeBank.ROM0 ? MicrocodeBank.RAM0 : MicrocodeBank.ROM0;
Logging.Log.Write(Logging.LogComponent.Microcode, "SWMODE: New Bank {0}", _microcodeBank);
}
@@ -144,7 +145,7 @@ namespace Contralto.CPU
_lowHalfsel,
Conversion.ToOctal(_ramAddr));
- UInt32 data = _uCodeRam[_ramAddr + (_ramBank * 1024)];
+ UInt32 data = MapRAMWord(_uCodeRam[_ramAddr + (_ramBank * 1024)]);
// Flip the necessary bits before returning them.
// (See table in section 8.3 of HWRef.)
@@ -181,7 +182,7 @@ namespace Contralto.CPU
ushort address = (ushort)(_ramAddr + _ramBank * 1024);
- _uCodeRam[address] = ((UInt32)(high) << 16) | low;
+ _uCodeRam[address] = MapRAMWord(((UInt32)(high) << 16) | low);
UpdateRAMCache(address);
}
@@ -283,7 +284,7 @@ namespace Contralto.CPU
private static void UpdateRAMCache(ushort address)
{
UInt32 instructionWord = _uCodeRam[address];
- _decodeCache[2048 + address] = new MicroInstruction(MapRAMWord(instructionWord));
+ _decodeCache[2048 + address] = new MicroInstruction(instructionWord);
//Console.WriteLine(_decodeCache[2048 + address]);
}
diff --git a/Contralto/Contralto.csproj b/Contralto/Contralto.csproj
index ddd4168..7de6d41 100644
--- a/Contralto/Contralto.csproj
+++ b/Contralto/Contralto.csproj
@@ -108,14 +108,42 @@
PreserveNewest
+
+
+ PreserveNewest
+
+
+ PreserveNewest
+
PreserveNewest
Always
+
+ PreserveNewest
+
+
+ PreserveNewest
+
+
+ PreserveNewest
+
+
+ PreserveNewest
+
+
+ PreserveNewest
+
+
+ PreserveNewest
+
- Always
+ PreserveNewest
+
+
+ PreserveNewest
Always
diff --git a/Contralto/Debugger.cs b/Contralto/Debugger.cs
index c5ef512..3af7cb7 100644
--- a/Contralto/Debugger.cs
+++ b/Contralto/Debugger.cs
@@ -1071,6 +1071,14 @@ namespace Contralto
_keyMap.Add(Keys.RShiftKey, AltoKey.RShift);
_keyMap.Add(Keys.ControlKey, AltoKey.CTRL);
_keyMap.Add(Keys.Return, AltoKey.Return);
+ _keyMap.Add(Keys.F1, AltoKey.BlankTop);
+ _keyMap.Add(Keys.F2, AltoKey.BlankMiddle);
+ _keyMap.Add(Keys.F3, AltoKey.BlankBottom);
+ _keyMap.Add(Keys.Back, AltoKey.BS);
+ _keyMap.Add(Keys.Tab, AltoKey.TAB);
+ _keyMap.Add(Keys.OemSemicolon, AltoKey.Semicolon);
+ _keyMap.Add(Keys.OemOpenBrackets, AltoKey.LBracket);
+ _keyMap.Add(Keys.OemCloseBrackets, AltoKey.RBracket);
}
diff --git a/Contralto/Disassembly/MesaROM-full-annotated.mu b/Contralto/Disassembly/MesaROM-full-annotated.mu
new file mode 100644
index 0000000..8ab1c80
--- /dev/null
+++ b/Contralto/Disassembly/MesaROM-full-annotated.mu
@@ -0,0 +1 @@
+;-----------------------------------------------------------------;
; X M E S A M I C R O C O D E ;
; Version 39-3 ;
;-----------------------------------------------------------------;
; MesaROM.Mu - Instruction fetch and general subroutines
; Last modified by Levin - March 6, 1979 10:40 AM
; 'uCodeVersion' is used by RunMesa to determine what version of the Mesa microcode is
; in ROM1. This version number should be incremented by 1 for every official release of
; the microcode. 'uCodeVersion' is mapped by RunMesa to the actual version number (which
; appears as a comment above). The reason for this mapping is the limited number of
; constants in the Alto constants ROM, otherwise, we would obviously have assigned
; 'uCodeVersion' the true microcode version number.
;
; The current table in RunMesa should have the following correspondences:
; uCodeVersion Microcode version Mesa release
; 0 34 4.1
; 1 39 5.0
$uCodeVersion $1;
;Completely rewritten by Roy Levin, Sept-Oct. 1977
;Modified by Johnsson; July 25, 1977 10:20 AM
;First version assembled 5 June 1975.
;Developed from Lampson's MESA.U of 21 March 1975.
;-----------------------------------------------------------------
; GLOBAL CONVENTIONS AND ASSUMPTIONS
;-----------------------------------------------------------------
; 1) Stack representation:
; stkp=0 => stack is empty
; sktp=10 => stack is full
; The validity checking that determines if the stack pointer is
; within this range is somewhat perfunctory. The approach taken is
; to include specific checks only where there absence would not lead
; to some catastrophic error. Hence, the stack is not checked for
; underflow, since allowing it to become negative will cause a disaster
; on the next stack dispatch.
; 2) Notation:
; Instruction labels correspond to opcodes in the obvious way. Suffixes
; of A and B (capitalized) refer to alignment in memory. 'A' is intended
; to suggest the right-hand byte of a memory word; 'B' is intended to
; suggest the left-hand byte. Labels terminating in a lower-case letter
; generally name local branch points within a particular group of
; opcodes. (Exception: subroutine names.) Labels terminating in 'x' generally
; exist only to satisfy alignment requirements imposed by various dispatches
; (most commonly IR<- and B/A in instruction fetch).
; 3) Tasking:
; Every effort has been made to ensure that a 'TASK' appears approximately
; every 12 instructions. Occasionally, this has not been possible,
; but (it is hoped that) violations occur only in infrequently executed
; code segments.
; 4) New symbols:
; In a few cases, the definitions of the standard Alto package
; (AltoConsts23.MU) have not been quite suitable to the needs of this
; microcode. Rather than change the standard package, we have defined
; new symbols (with names beginning with 'm') that are to be used instead
; of their standard counterparts. All such definitions appear together in
; Mesab.Mu.
; 5) Subroutine returns:
; Normally, subroutine returns using IDISP require one to deal with
; (the nuisance of) the dispatch caused by loading IR. Happily, however,
; no such dispatch occurs for 'msr0' and 'sr1' (the relevant bits
; are 0). To cut down on alignment restrictions, some subroutines
; assume they are called with only one of two returns and can
; therefore ignore the possibility of a pending IR<- dispatch.
; Such subroutines are clearly noted in the comments.
; 6) Frame pointer registers (lp and gp):
; These registers normally (i.e. except during Xfer) contain the
; addresses of local 2 and global 1, respectively. This optimizes accesses
; in such bytecodes as LL3 and SG2, which would otherwise require another cycle.
;-----------------------------------------------------------------
; Get definitions for ALTO and MESA
;-----------------------------------------------------------------
#AltoConsts23.mu;
#MesabROM.mu;
; *** 11/23/15 - START OF MESABROM.MU ***
;-----------------------------------------------------------------
; MesabROM.Mu - Registers, miscellaneous symbols and constants
; Last modified by Levin - February 27, 1979 4:49 PM
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; R memories used by code in ROM0, correct to AltoCode23.Mu
;-----------------------------------------------------------------
; Nova Emulator Registers (some used by Mesa as well)
$AC3 $R0;
$MASK1 $R0;
$AC2 $R1;
$AC1 $R2;
$YMUL $R2;
$RETN $R2;
$AC0 $R3;
$SKEW $R3;
$NWW $R4;
$SAD $R5;
$CYRET $R5;
$TEMP $R5;
$PC $R6;
$XREG $R7;
$CYCOUT $R7;
$WIDTH $R7;
$PLIER $R7;
$XH $R10;
$DESTY $R10;
$WORD2 $R10;
$DWAX $R35;
$STARTBITSM1 $R35;
$MASK $R36;
$SWA $R36;
$DESTX $R36;
$LREG $R40;
$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;
;-----------------------------------------------------------------
; Registers used by standard Nova I/O controllers
;
; All names have been prefixed with 'x' to prevent conflicts when MesabROM is
; used by XMesa clients to assemble MesaXRAM with other microcode.
;-----------------------------------------------------------------
; Model 31 Disk
$xKWDCT $R31;
$xKWDCTW $R31;
$xCKSUMR $R32;
$xCKSUMRW $R32;
$xKNMAR $R33;
$xKNMARW $R33;
$xDCBR $R34;
; Display
$CURX $R20;
$CURDATA $R21;
$xCBA $R22;
$xAECL $R23;
$xSLC $R24;
$xMTEMP $R25;
$xHTAB $R26;
$xYPOS $R27;
$xDWA $R30;
; Ethernet
$xECNTR $R12;
$xEPNTR $R13;
; Memory Refresh
$xCLOCKTEMP $R11;
$xR37 $R37;
; Audio (obsolete)
$xAudioWdCt $R71;
$xAudioData $R72;
;-----------------------------------------------------------------
; Registers used by Mesa Emulator
;-----------------------------------------------------------------
; R registers
$temp $R35; Temporary (smashed by BITBLT)
$temp2 $R36; Temporary (smashed by BITBLT)
$mpc $R15; R register holds Mesa PC (points at word last read)
$stkp $R16; stack pointer [0-10] 0 empty, 10 full
$XTSreg $R17; xfer trap state
; Registers shared by Nova and Mesa emulators
; Nova ACs are set explicitly by Mesa process opcodes and for ROM0 calls
; Other R-registers smashed by BITBLT and other ROM0 subroutines
$brkbyte $R0; (AC3) bytecode to execute after a breakpoint
; Warning! brkbyte must be reset to 0 after ROM calls!
; (see BITBLT)
$mx $R1; (AC2) x register for XFER
; Warning! smashed by BITBLT and MUL/DIV/LDIV
$saveret $R2; (AC1) R-temporary for return indices and values
$newfield $R3; (AC0) new field bits for WF and friends
; Warning! must be R-register; assumed safe across CYCLE
$count $R5; scratch R register used for counting
$taskhole $R7; pigeonhole for saving things across TASKs
; Warning! smashed by all ROM calls!
$ib $R10; instruction byte, 0 if none (0,,byte)
; Warning! smashed by BITBLT
$clockreg $R37; low-order bits of real-time clock
; S registers, can't shift into them, BUS not zero while storing.
$my $R51; y register for XFER
$lp $R52; local pointer
$gp $R53; global pointer
$cp $R54; code pointer
$ATPreg $R55; allocation trap parameter
$OTPreg $R56; other trap parameter
$XTPreg $R57; xfer trap parameter
$wdc $R70; wakeup disable counter
; Mesa evaluation stack
$stk0 $R60; stack (bottom)
$stk1 $R61; stack
$stk2 $R62; stack
$stk3 $R63; stack
$stk4 $R64; stack
$stk5 $R65; stack
$stk6 $R66; stack
$stk7 $R67; stack (top)
; Miscellaneous S registers
$mask $R41; used by string instructions, among others
$unused1 $R42; not safe across call to BITBLT
$unused2 $R43; not safe across call to BITBLT
$alpha $R44; alpha byte (among other things)
$index $R45; frame size index (among other things)
$entry $R46; allocation table entry address (among other things)
$frame $R47; allocated frame pointer (among other things)
$righthalf $R41; right 4 bits of alpha or beta
$lefthalf $R45; left 4 bits of alpha or beta
$unused3 $R50; not safe across call to BITBLT
;-----------------------------------------------------------------
; Mnemonic constants for subroutine return indices used by BUS dispatch.
;-----------------------------------------------------------------
$ret0 $L0,12000,100; zero is always special
$ret1 $1;
$ret2 $2;
$ret3 $3;
$ret4 $4;
$ret5 $5;
$ret6 $6;
$ret7 $7;
$ret10 $10;
$ret11 $11;
$ret12 $12;
$ret13 $13;
$ret14 $14;
$ret15 $15;
$ret16 $16;
$ret17 $17;
$ret20 $20;
$ret21 $21;
$ret22 $22;
$ret23 $23;
$ret24 $24;
$ret25 $25;
$ret26 $26;
$ret27 $27;
$ret30 $30;
$ret31 $31;
$ret37 $37;
;-----------------------------------------------------------------
; Mesa Trap codes - index into sd vector
;-----------------------------------------------------------------
$sBRK $L0,12000,100; Breakpoint
$sStackError $2;
$sStackUnderflow $2; (trap handler distinguishes underflow from
$sStackOverflow $2; overflow by stkp value)
$sXferTrap $4;
$sAllocTrap $6;
$sControlFault $7;
$sSwapTrap $10;
$sUnbound $13;
$sBoundsFault $20;
$sPointerFault $21; must equal sBoundsFault+1
$sBoundsFaultm1 $17; must equal sBoundsFault-1
;-----------------------------------------------------------------
; Low- and high-core address definitions
;-----------------------------------------------------------------
$HardMRE $20; location which forces MRE to drop to Nova code
$CurrentState $23; location holding address of current state
$NovaDVloc $25; dispatch vector for Nova code
$avm1 $777; base of allocation vector for frames (-1)
$sdoffset $100; offset to base of sd from av
$gftm1 $1377; base of global frame table (-1)
$BankReg $177740; address of emulator's bank register
;-----------------------------------------------------------------
; Constants in ROM, but with unpleasant names
;-----------------------------------------------------------------
$12 $12; for function calls
$-12 $177766; for Savestate
$400 $400; for JB
;-----------------------------------------------------------------
; Frame offsets and other software/microcode agreements
;-----------------------------------------------------------------
$lpoffset $6; local frame overhead + 2
$nlpoffset $177771; = -(lpoffset + 1)
$nlpoffset1 $177770; = -(lpoffset + 2)
$pcoffset $1; offset from local frame base to saved pc
$npcoffset $5; = -(lpoffset+1+pcoffset) [see Savpcinframe]
$retlinkoffset $2; offset from local frame base to return link
$nretlinkoffset $177774; = -(lpoffset-retlinkoffset)
$gpoffset $4; global frame overhead + 1
$ngpoffset $177773; = -(gpoffset + 1)
$gfioffset $L0,12000,100; offset from global frame base to gfi word (=0)
$ngfioffset $4; = gpoffset-gfioffset [see XferGfz]
$cpoffset $1; offset from global frame base to code pointer
$gpcpoffset $2; offset from high code pointer to global 1
$gfimask $177600; mask to isolate gfi in global frame word 0
$enmask $37; mask to isolate entry number/4
;-----------------------------------------------------------------
; Symbols to be used instead of ones in the standard definitions
;-----------------------------------------------------------------
$mACSOURCE $L024016,000000,000000; sets only F2. ACSOURCE also sets BS and RSEL
$msr0 $L000000,012000,000100; IDISP => 0, no IR<- dispatch, a 'special' zero
$BUSAND~T $L000000,054015,000040; sets ALUF = 15B, doesn't require defined bus
;-----------------------------------------------------------------
; Linkages between ROM1 and RAM for overflow microcode
;-----------------------------------------------------------------
; Fixed locations in ROM1
$romnext $L004400,0,0; must correspond to next
$romnextA $L004401,0,0; must correspond to nextA
$romIntstop $L004406,0,0; must correspond to Intstop
$romUntail $L004407,0,0; must correspond to Untail
$romXfer $L004431,0,0; must correspond to Xfer
; Fixed locations in RAM
$ramBLTloop $L004403,0,0; must correspond to BLTloop
$ramBLTint $L004405,0,0; must correspond to BLTint
$ramOverflow $L004410,0,0; RR, BLTL, WR
; DADD, DSUB, DCOMP, DUCOMP
; *** 11/23/15 - END OF MESABROM.MU ***
;-----------------------------------------------------------------
; Location-specific Definitions
;-----------------------------------------------------------------
; There is a fundamental difficulty in the selection of addresses that are known and
; used outside the Mesa emulator. The problem arises in trying to select a single set of
; addresses that can be used regardless of the Alto's control memory configuration. In
; effect, this cannot be done. If an Alto has only a RAM (in addition, of course, to its
; basic ROM, ROM0), then the problem does not arise. However, suppose the Alto has both a
; RAM and a second ROM, ROM1. Then, when it is necessary to move from a control memory to
; one of the other two, the choice is conditioned on (1) the memory from which the transfer
; is occurring, and (2) bit 1 of the target address. Since we expect that, in most cases, an
; Alto running Mesa will have the Mesa emulator in ROM1, the externally-known addresses have
; been chosen to work in that case. They will also work, without alteration, on an Alto that
; has no ROM1. However, if it is necessary to run Mesa on an Alto with ROM1 and it is desired
; to use a Mesa emulator residing in the RAM (say, for debugging purposes), then the address
; values in the RAM version must be altered. This implies changes in both the RAM code itself
; and the Nova code that invokes the RAM (via the Nova JMPRAM instruction). Details
; concerning the necessary changes for re-assembly appear with the definitions below.
; Note concerning Alto IVs and Alto IIs with retrofitted 3K control RAMs:
;
; The above comments apply uniformly to these machines if "RAM" is systematically replaced
; by "RAM1" and "ROM1" is systematically replaced by "RAM2".
%1,1777,0,nextBa; forced to location 0 to save a word in JRAM
;-----------------------------------------------------------------
; Emulator Entry Point Definitions
; These addresses are known by the Nova code that interfaces to the emulator and by
; RAM code executing with the Mesa emulator in ROM1. They have been chosen so that
; both such "users" can use the same value. Precisely, this means that bit 1 (the
; 400 bit) must be set in the address. In a RAM version of the Mesa emulator intended
; to execute on an Alto with a second ROM, bit 1 must be zero.
;-----------------------------------------------------------------
%1,1777,420,Mgo; Normal entry to Mesa Emulator - load state
; of process specified by AC0.
%1,1777,400,next,nextA; Return to 'next' to continue in current Mesa
; process after Nova or RAM execution.
$Minterpret $L004400,0,0; Documentation refers to 'next' this way.
%1,1777,776,DSTr1,Mstopc; Return addresses for 'Savestate'. By
; standard convention, 'Mstopc' must be at 777.
;-----------------------------------------------------------------
; Linkage from RAM to ROM1
; The following predefs must correspond to the label definitions in MesabROM.mu
;-----------------------------------------------------------------
%1,1777,406,Intstop; must correspond to romIntstop
%1,1777,407,Untail; must correspond to romUntail
%7,1777,430,XferGT,Xfer,Mstopr,PORTOpc,LSTr,ALLOCrfr; Xfer must agree with romXfer
;-----------------------------------------------------------------
; Linkage from Mesa emulator to ROM0
; The Mesa emulator uses a number of subroutines that reside in ROM0. In posting a
; return address, the emulator must be aware of the control memory in which it resides,
; RAM or ROM1. These return addresses must satisfy the following constraint:
; no ROM1 extant or emulator in ROM1 => bit 1 of address must be 1
; ROM1 extant and emulator in RAM => bit 1 of address must be 0
; In addition, since these addresses must be passed as data to ROM0, it is desirable
; that they be available in the Alto's constants ROM. Finally, it is desirable that
; they be chosen not to mess up too many pre-defs. It should be noted that these
; issues do not affect the destination location in ROM0, since its address remains
; fixed (even with respect to bit 1 mapping) whether the Mesa emulator is in RAM or
; ROM1. [Note pertaining to Alto IVs and retrofitted Alto IIs with 3K RAMs: to avoid
; confusion, the comments above and below have not been revised to discuss 3K control
; RAMs. In all cases, there is an additional constraint that bit 2 of the return
; addresses must be 1. The suggested values observe this constraint, even though the
; comments do not explicitly mention it.]
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; MUL/DIV linkage:
; An additional constraint peculiar to the MUL/DIV microcode is that the high-order
; bits of the return address be 1's. Hence, the recommended values are:
; no ROM1 extant or emulator in ROM1 => MULDIVretloc = 177675B (OK to be odd)
; ROM1 extant and emulator in RAM => MULDIVretloc = 177162B (OK to be odd)
;-----------------------------------------------------------------
$ROMMUL $L004120,0,0; MUL routine address (120B) in ROM0
$ROMDIV $L004121,0,0; DIV routine address (121B) in ROM0
$MULDIVretloc $177675; (may be even or odd)
; The third value in the following pre-def must be: (MULDIVretloc AND 777B)
%1,1777,675,MULDIVret,MULDIVret1; return addresses from MUL/DIV in ROM0
;-----------------------------------------------------------------
; BITBLT linkage:
; An additional constraint peculiar to the BITBLT microcode is that the high-order
; bits of the return address be 1's. Hence, the recommended values are:
; no ROM1 extant or emulator in ROM1 => BITBLTret = 177714B
; ROM1 extant and emulator in RAM => BITBLTret = 177175B
;-----------------------------------------------------------------
$ROMBITBLT $L004124,0,0; BITBLT routine address (124B) in ROM0
$BITBLTret $177714; (may be even or odd)
; The third value in the following pre-def must be: (BITBLTret AND 777B)-1
%1,1777,713,BITBLTintr,BITBLTdone; return addresses from BITBLT in ROM0
;-----------------------------------------------------------------
; CYCLE linkage:
; A special constraint here is that WFretloc be odd. Recommended values are:
; no ROM1 extant or emulator in ROM1 => Fieldretloc = 612B, WFretloc = 605B
; ROM1 extant and emulator in RAM => Fieldretloc = 34104B, WFretloc = 14023B
;-----------------------------------------------------------------
$RAMCYCX $L004022,0,0; CYCLE routine address (22B) in ROM0
$Fieldretloc $612; RAMCYCX return to Fieldsub (even or odd)
$WFretloc $605; RAMCYCX return to WF (must be odd)
; The third value in the following pre-def must be: (Fieldretloc AND 1777B)
%1,1777,612,Fieldrc; return address from RAMCYCX to Fieldsub
; The third value in the following pre-def must be: (WFretloc AND 1777B)-1
%1,1777,604,WFnzct,WFret; return address from RAMCYCX to WF
;-----------------------------------------------------------------
; I n s t r u c t i o n f e t c h
;
; State at entry:
; 1) ib holds either the next instruction byte to interpret
; (right-justified) or 0 if a new word must be fetched.
; 2) control enters at one of the following points:
; a) next: ib must be interpreted
; b) nextA: ib is assumed to be uninteresting and a
; new instruction word is to be fetched.
; c) nextXB: a new word is to be fetched, and interpretation
; is to begin with the odd byte.
; d) nextAdeaf: similar to 'nextA', but does not check for
; pending interrupts.
; e) nextXBdeaf: similar to 'nextXB', but does not check for
; pending interrupts.
;
; State at exit:
; 1) ib is in an acceptable state for subsequent entry.
; 2) T contains the value 1.
; 3) A branch (1) is pending if ib = 0, meaning the next
; instruction may return to 'nextA'. (This is subsequently
; referred to as "ball 1", and code that nullifies its
; effect is labelled as "dropping ball 1".)
; 4) If a branch (1) is pending, L = 0. If no branch is
; pending, L = 1.
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; Address pre-definitions for bytecode dispatch table.
;-----------------------------------------------------------------
; Table must have 2 high-order bits on for BUS branch at 'nextAni'.
;
; Warning! Many address inter-dependencies exist - think (at least) twice
; before re-ordering. Inserting new opcodes in previously unused slots,
; however, is safe.
; XMESA Note: RBL, WBL, and BLTL exist for XMESA only.
%7,1777,1400,NOOP,ME,MRE,MXW,MXD,NOTIFY,BCAST,REQUEUE; 000-007
%7,1777,1410,LL0,LL1,LL2,LL3,LL4,LL5,LL6,LL7; 010-017
%7,1777,1420,LLB,LLDB,SL0,SL1,SL2,SL3,SL4,SL5; 020-027
%7,1777,1430,SL6,SL7,SLB,PL0,PL1,PL2,PL3,LG0; 030-037
%7,1777,1440,LG1,LG2,LG3,LG4,LG5,LG6,LG7,LGB; 040-047
%7,1777,1450,LGDB,SG0,SG1,SG2,SG3,SGB,LI0,LI1; 050-057
%7,1777,1460,LI2,LI3,LI4,LI5,LI6,LIN1,LINI,LIB; 060-067
%7,1777,1470,LIW,LINB,LADRB,GADRB,,,,; 070-077
%7,1777,1500,R0,R1,R2,R3,R4,RB,W0,W1; 100-107
%7,1777,1510,W2,WB,RF,WF,RDB,RD0,WDB,WD0; 110-117
%7,1777,1520,RSTR,WSTR,RXLP,WXLP,RILP,RIGP,WILP,RIL0; 120-127
%7,1777,1530,WS0,WSB,WSF,WSDB,RFC,RFS,WFS,RBL; 130-137
%7,1777,1540,WBL,,,,,,,; 140-147
%7,1777,1550,,,,,,,,; 150-157
%7,1777,1560,,,SLDB,SGDB,PUSH,POP,EXCH,LINKB; 160-167
%7,1777,1570,DUP,NILCK,,BNDCK,,,,; 170-177
%7,1777,1600,J2,J3,J4,J5,J6,J7,J8,J9; 200-207
%7,1777,1610,JB,JW,JEQ2,JEQ3,JEQ4,JEQ5,JEQ6,JEQ7; 210-217
%7,1777,1620,JEQ8,JEQ9,JEQB,JNE2,JNE3,JNE4,JNE5,JNE6; 220-227
%7,1777,1630,JNE7,JNE8,JNE9,JNEB,JLB,JGEB,JGB,JLEB; 230-237
%7,1777,1640,JULB,JUGEB,JUGB,JULEB,JZEQB,JZNEB,,JIW; 240-247
%7,1777,1650,ADD,SUB,MUL,DBL,DIV,LDIV,NEG,INC; 250-257
%7,1777,1660,AND,OR,XOR,SHIFT,DADD,DSUB,DCOMP,DUCOMP; 260-267
%7,1777,1670,ADD01,,,,,,,; 270-277
%7,1777,1700,EFC0,EFC1,EFC2,EFC3,EFC4,EFC5,EFC6,EFC7; 300-307
%7,1777,1710,EFC8,EFC9,EFC10,EFC11,EFC12,EFC13,EFC14,EFC15; 310-317
%7,1777,1720,EFCB,LFC1,LFC2,LFC3,LFC4,LFC5,LFC6,LFC7; 320-327
%7,1777,1730,LFC8,,,,,,,; 330-337
%7,1777,1740,,LFCB,SFC,RET,LLKB,PORTO,PORTI,KFCB; 340-347
%7,1777,1750,DESCB,DESCBS,BLT,BLTL,BLTC,,ALLOC,FREE; 350-357
%7,1777,1760,IWDC,DWDC,STOP,CATCH,MISC,BITBLT,STARTIO,JRAM; 360-367
%7,1777,1770,DST,LST,LSTF,,WR,RR,BRK,StkUf; 370-377
;-----------------------------------------------------------------
; Main interpreter loop
;-----------------------------------------------------------------
;
; Enter here to interpret ib. Control passes here to process odd byte of previously
; fetched word or when preceding opcode "forgot" it should go to 'nextA'. A 'TASK'
; should appear in the instruction preceding the one that branched here.
;
XM0400> next: L<-0, :nextBa; (if from JRAM, switch banks)
XM0000> nextBa: SINK<-ib, BUS; dispatch on ib
XM0001> ib<-L, T<-0+1, BUS=0, :NOOP; establish exit state
;-----------------------------------------------------------------
; NOOP - must be opcode 0
; control also comes here from certain jump instructions
;-----------------------------------------------------------------
!1,1,nextAput;
XM1400> NOOP: L<-mpc+T, TASK, :nextAput;
;
; Enter here to fetch new word and interpret even byte. A 'TASK' should appear in the
; instruction preceding the one that branched here.
;
XM0401> nextA: L<-XMAR<-mpc+1, :nextAcom; initiate fetch
;
; Enter here when fetch address has been computed and left in L. A 'TASK' should
; appear in the instruction that branches here.
;
XM0003> nextAput: temp<-L; stash to permit TASKing
XM0002> L<-XMAR<-temp, :nextAcom;
;
; Enter here to do what 'nextA' does but without checking for interrupts
;
XM0004> nextAdeaf: L<-XMAR<-mpc+1;
XM0005> nextAdeafa: mpc<-L, BUS=0, :nextAcomx;
;
; Common fetch code for 'nextA' and 'nextAput'
;
!1,2,nextAi,nextAni;
!1,2,nextAini,nextAii;
XM0012> nextAcom: mpc<-L; updated pc
XM0013> SINK<-NWW, BUS=0; check pending interrupts
XM0014> nextAcomx: T<-177400, :nextAi;
;
; No interrupt pending. Dispatch on even byte, store odd byte in ib.
;
XM0007> nextAni: L<-MD AND T, BUS, :nextAgo; L<-"B"^8, dispatch on "A"
XM0015> nextAgo: ib<-L LCY 8, L<-T<-0+1, :NOOP; establish exit state
;
; Interrupt pending - check if enabled.
;
XM0006> nextAi: L<-MD;
XM0016> SINK<-wdc, BUS=0; check wakeup counter
XM0017> T<-M.T, :nextAini; isolate left byte
XM0010> nextAini: SINK<-M, L<-T, BUS, :nextAgo; dispatch even byte
;
; Interrupt pending and enabled.
;
!1,2,nextXBini,nextXBii;
XM0011> nextAii: L<-mpc-1; back up mpc for Savpcinframe
XM0022> mpc<-L, L<-0, :nextXBii;
;
; Enter here to fetch word and interpret odd byte only (odd-destination jumps).
;
!1,2,nextXBi,nextXBni;
XM0023> nextXB: L<-XMAR<-mpc+T;
XM0026> SINK<-NWW, BUS=0, :nextXBdeaf; check pending interrupts
;
; Enter here (with branch (1) pending) from Xfer to do what 'nextXB' does but without
; checking for interrupts. L has appropriate word PC.
;
XM0027> nextXBdeaf: mpc<-L, :nextXBi;
;
; No interrupt pending. Store odd byte in ib.
;
XM0025> nextXBni: L<-MD, TASK, :nextXBini;
XM0020> nextXBini: ib<-L LCY 8, :next; skip over even byte (TASK
; prevents L<-0, :nextBa)
;
; Interrupt pending - check if enabled.
;
XM0024> nextXBi: SINK<-wdc, BUS=0, :nextXBni; check wakeup counter
;
; Interrupt pending and enabled.
;
XM0021> nextXBii: ib<-L, :Intstop; ib = 0 for even, ~= 0 for odd
;-----------------------------------------------------------------
; S u b r o u t i n e s
;-----------------------------------------------------------------
;
; The two most heavily used subroutines (Popsub and Getalpha) often
; share common return points. In addition, some of these return points have
; additional addressing requirements. Accordingly, the following predefinitions
; have been rather carefully constructed to accommodate all of these requirements.
; Any alteration is fraught with peril.
; [A historical note: an attempt to merge in the returns from FetchAB as well
; failed because more than 31D distinct return points were then required. Without
; adding new constants to the ROM, the extra returns could not be accommodated.
; However, for Popsub alone, additional returns are possible - see Xpopsub.]
;
; Return Points (sr0-sr17)
!17,20,Fieldra,SFCr,pushTB,pushTA,LLBr,LGBr,SLBr,SGBr,
LADRBr,GADRBr,RFr,Xret,INCr,RBr,WBr,Xpopret;
; Extended Return Points (sr20-sr37)
; Note: KFCr and EFCr must be odd!
!17,20,XbrkBr,KFCr,LFCr,EFCr,WSDBra,DBLr,LINBr,LDIVf,
Dpush,Dpop,RD0r,Splitcomr,RXLPrb,WXLPrb,MISCr,RWBLra;
; Returns for Xpopsub only
!17,20,WSTRrB,WSTRrA,JRAMr,WRr,STARTIOr,PORTOr,WD0r,ALLOCrx,
FREErx,NEGr,RFSra,RFSrb,WFSra,DESCBcom,RFCr,NILCKr;
; Extended Return Machinery (via Xret)
!1,2,XretB,XretA;
XM0053> Xret: SINK<-DISP, BUS, :XretB;
XM0030> XretB: :XbrkBr;
XretA: SINK<-0, BUS=0, :XbrkBr; keep ball 1 in air
;-----------------------------------------------------------------
; Pop subroutine:
; Entry conditions:
; Normal IR linkage
; Exit conditions:
; Stack popped into T and L
;-----------------------------------------------------------------
!1,1,Popsub; shakes B/A dispatch
!7,1,Popsuba; shakes IR<- dispatch
!17,20,Tpop,Tpop0,Tpop1,Tpop2,Tpop3,Tpop4,Tpop5,Tpop6,Tpop7,,,,,,,;
XM0033> Popsub: L<-stkp-1, BUS, TASK, :Popsuba;
XM0037> Popsuba: stkp<-L, :Tpop; old stkp > 0
;-----------------------------------------------------------------
; Xpop subroutine:
; Entry conditions:
; L has return number
; Exit conditions:
; Stack popped into T and L
; Invoking instruction should specify 'TASK'
;-----------------------------------------------------------------
!1,1,Xpopsub; shakes B/A dispatch
XM0035> Xpopsub: saveret<-L;
XM0120> Tpop: IR<-sr17, :Popsub; returns to Xpopret
; Note: putting Tpop here makes
; stack underflow logic work if
; stkp=0
XM0057> Xpopret: SINK<-saveret, BUS;
XM0032> :WSTRrB;
;-----------------------------------------------------------------
; Getalpha subroutine:
; Entry conditions:
; L untouched from instruction fetch
; Exit conditions:
; alpha byte in T
; branch 1 pending if return to 'nextA' desirable
; L=0 if branch 1 pending, L=1 if no branch pending
;-----------------------------------------------------------------
!1,2,Getalpha,GetalphaA;
!7,1,Getalphax; shake IR<- dispatch
!7,1,GetalphaAx; shake IR<- dispatch
XM0132> Getalpha: T<-ib, IDISP;
XM0137> Getalphax: ib<-L RSH 1, L<-0, BUS=0, :Fieldra; ib<-0, set branch 1 pending
XM0133> GetalphaA: L<-XMAR<-mpc+1; initiate fetch
XM0147> GetalphaAx: mpc<-L;
XM0034> T<-177400; mask for new ib
XM0036> L<-MD AND T, T<-MD; L: new ib, T: whole word
XM0131> Getalphab: T<-377.T, IDISP; T now has alpha
XM0134> ib<-L LCY 8, L<-0+1, :Fieldra; return: no branch pending
;-----------------------------------------------------------------
; FetchAB subroutine:
; Entry conditions: none
; Exit conditions:
; T: <+1>
; ib: unchanged (caller must ensure return to 'nextA')
;-----------------------------------------------------------------
!1,1,FetchAB; drops ball 1
!7,1,FetchABx; shakes IR<- dispatch
!7,10,LIWr,JWr,,,,,,; return points
XM0135> etchAB: L<-XMAR<-mpc+1, :FetchABx;
XM0157> FetchABx: mpc<-L, IDISP;
XM0136> T<-MD, :LIWr;
;-----------------------------------------------------------------
; Splitalpha subroutine:
; Entry conditions:
; L: return index
; entry at Splitalpha if instruction is A-aligned, entry at
; SplitalphaB if instruction is B-aligned
; entry at Splitcomr splits byte in T (used by field instructions)
; Exit conditions:
; lefthalf: alpha[0-3]
; righthalf: alpha[4-7]
;-----------------------------------------------------------------
!1,2,Splitalpha,SplitalphaB;
!1,1,Splitx; drop ball 1
%160,377,217,Split0,Split1,Split2,Split3,Split4,Split5,Split6,Split7;
!1,2,Splitout0,Splitout1;
!7,10,RILPr,RIGPr,WILPr,RXLPra,WXLPra,Fieldrb,,; subroutine returns
XM0140> Splitalpha: saveret<-L, L<-0+1, :Splitcom; L<-1 for Getalpha
XM0141> SplitalphaB: saveret<-L, L<-0, BUS=0, :Splitcom; (keep ball 1 in air)
XM0142> Splitcom: IR<-sr33, :Getalpha; T:alpha[0-7]
XM0073> Splitcomr: L<-17 AND T, :Splitx; L:alpha[4-7]
XM0143> Splitx: righthalf<-L, L<-T, TASK; L:alpha, righthalf:alpha[4-7]
XM0146> temp<-L; temp:alpha
XM0150> L<-temp, BUS; dispatch on alpha[1-3]
XM0151> temp<-L LCY 8, SH<0, :Split0; dispatch on alpha[0]
XM0217> Split0: L<-T<-0, :Splitout0; L,T:alpha[1-3]
Split1: L<-T<-ONE, :Splitout0;
Split2: L<-T<-2, :Splitout0;
Split3: L<-T<-3, :Splitout0;
Split4: L<-T<-4, :Splitout0;
Split5: L<-T<-5, :Splitout0;
Split6: L<-T<-6, :Splitout0;
Split7: L<-T<-7, :Splitout0;
XM0145> Splitout1: L<-10+T, :Splitout0; L:alpha[0-3]
XM0144> Splitout0: SINK<-saveret, BUS, TASK; dispatch return
XM0152> lefthalf<-L, :RILPr; lefthalf:alpha[0-3]
;-----------------------------------------------------------------
; D i s p a t c h e s
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; Pop-into-T (and L) dispatch:
; dispatches on old stkp, so Tpop0 = 1 mod 20B.
;-----------------------------------------------------------------
XM121> Tpop0: L<-T<-stk0, IDISP, :Tpopexit;
XM122> Tpop1: L<-T<-stk1, IDISP, :Tpopexit;
XM123> Tpop2: L<-T<-stk2, IDISP, :Tpopexit;
XM124> Tpop3: L<-T<-stk3, IDISP, :Tpopexit;
XM125> Tpop4: L<-T<-stk4, IDISP, :Tpopexit;
XM126> Tpop5: L<-T<-stk5, IDISP, :Tpopexit;
XM127> Tpop6: L<-T<-stk6, IDISP, :Tpopexit;
XM130> Tpop7: L<-T<-stk7, IDISP, :Tpopexit;
XM0153> Tpopexit: :Fieldra; to permit TASK in Popsub
;-----------------------------------------------------------------
; pushMD dispatch:
; pushes memory value on stack
; The invoking instruction must load MAR and may optionally keep ball 1
; in the air by having a branch pending. That is, entry at 'pushMD' will
; cause control to pass to 'next', while entry at 'pushMDA' will cause
; control to pass to 'nextA'.
;-----------------------------------------------------------------
!3,4,pushMD,pushMDA,StoreB,StoreA;
!17,20,push0,push1,push2,push3,push4,push5,push6,push7,push10,,,,,,,;
XM0164> pushMD: L<-stkp+1, IR<-stkp; (IR<- causes no branch)
XM0154> stkp<-L, T<-0+1, :pushMDa;
XM0165> pushMDA: L<-stkp+1, IR<-stkp; (IR<- causes no branch)
XM0155> stkp<-L, T<-0, :pushMDa;
XM0156> pushMDa: SINK<-DISP, L<-T, BUS; dispatch on old stkp value
XM0162> L<-MD, SH=0, TASK, :push0;
;-----------------------------------------------------------------
; Push-T dispatch:
; pushes T on stack
; The invoking instruction may optionally keep ball 1 in the air by having a
; branch pending. That is, entry at 'pushTB' will cause control to pass
; to 'next', while entry at 'pushTA' will cause control to pass to 'nextA'.
;-----------------------------------------------------------------
!1,2,pushT1B,pushT1A; keep ball 1 in air
XM0042> pushTB: L<-stkp+1, BUS, :pushT1B;
XM0043> pushTA: L<-stkp+1, BUS, :pushT1A;
XM0176> pushT1B: stkp<-L, L<-T, TASK, :push0;
XM0177> pushT1A: stkp<-L, BUS=0, L<-T, TASK, :push0; BUS=0 keeps branch pending
;-----------------------------------------------------------------
; push dispatch:
; strictly vanilla-flavored
; may (but need not) have branch (1) pending if return to 'nextA' is desired
; invoking instruction should specify TASK
;-----------------------------------------------------------------
; Note: the following pre-def occurs here so that dpushof1 can be referenced in push10
!17,20,dpush,,dpush1,dpush2,dpush3,dpush4,dpush5,dpush6,dpush7,dpushof1,dpushof2,,,,,;
XM0440> push0: stk0<-L, :next;
XM0441> push1: stk1<-L, :next;
XM0442> push2: stk2<-L, :next;
XM0443> push3: stk3<-L, :next;
XM0444> push4: stk4<-L, :next;
XM0445> push5: stk5<-L, :next;
XM0446> push6: stk6<-L, :next;
XM0447> push7: stk7<-L, :next;
XM0450> push10: :dpushof1; honor TASK, stack overflow
;-----------------------------------------------------------------
; Double-word push dispatch:
; picks up alpha from ib, adds it to T, then pushes and
;
; entry at 'Dpusha' substitutes L for ib.
; entry at 'Dpushc' and 'DpB' is used by RR 6 logic.
; entry at 'dpush' is used by MUL/DIV/LDIV logic.
; returns to 'nextA' <=> ib = 0 or entry at 'Dpush'
;-----------------------------------------------------------------
!1,2,DpA,DpB;
!1,1,Dpushb; shakes B/A dispatch from RCLK
!5,2,Dpushx,RCLKr; shakes IR<-2000 dispatch and
; provides return to RCLK
XM0070> Dpush: MAR<-L<-ib+T, :DpB; L: address of low half
XM0202> Dpusha: SINK<-ib, BUS=0;
XM0203> MAR<-L<-M+T, :DpA;
XM0200> DpA: IR<-0, :Dpushb; mACSOURCE will produce 0
XM0201> DpB: IR<-2000, :Dpushb; mACSOURCE will produce 1
XM0163> Dpushb: temp<-L, :Dpushx; temp: address of low half
XM0204> Dpushx: L<-MD, TASK, :Dpushc;
XM0206> Dpushc: taskhole<-L; taskhole: low half bits
XM0207> T<-0+1;
XM0210> L<-stkp+T+1;
XM0211> MAR<-temp+1; fetch high half
XM0212> stkp<-L; stkp <- stkp+2
XM0213> L<-taskhole; L: low half bits
XM0214> SINK<-stkp, BUS, :dpush; dispatch on new stkp
XM0460> dpush: T<-MD, :dpush; T: high half bits
XM0462> dpush1: stk0<-L, L<-T, TASK, mACSOURCE, :push1; stack cells are S-registers,
XM0463> dpush2: stk1<-L, L<-T, TASK, mACSOURCE, :push2; so mACSOURCE does not affect
XM0464> dpush3: stk2<-L, L<-T, TASK, mACSOURCE, :push3; addressing.
XM0465> dpush4: stk3<-L, L<-T, TASK, mACSOURCE, :push4;
XM0466> dpush5: stk4<-L, L<-T, TASK, mACSOURCE, :push5;
XM0467> dpush6: stk5<-L, L<-T, TASK, mACSOURCE, :push6;
XM0470> dpush7: stk6<-L, L<-T, TASK, mACSOURCE, :push7;
XM0471> dpushof1: T<-sStackOverflow, :KFCr;
XM0472> dpushof2: T<-sStackOverflow, :KFCr;
;-----------------------------------------------------------------
; TOS+T dispatch:
; adds TOS to T, then initiates memory operation on result.
; used as both dispatch table and subroutine - fall-through to 'pushMD'.
; dispatches on old stkp, so MAStkT0 = 1 mod 20B.
;-----------------------------------------------------------------
!17,20,MAStkT,MAStkT0,MAStkT1,MAStkT2,MAStkT3,MAStkT4,MAStkT5,MAStkT6,MAStkT7,,,,,,,;
XM0501> MAStkT0: MAR<-stk0+T, :pushMD;
XM0502> MAStkT1: MAR<-stk1+T, :pushMD;
XM0503> MAStkT2: MAR<-stk2+T, :pushMD;
XM0504> MAStkT3: MAR<-stk3+T, :pushMD;
XM0505> MAStkT4: MAR<-stk4+T, :pushMD;
XM0506> MAStkT5: MAR<-stk5+T, :pushMD;
XM0507> MAStkT6: MAR<-stk6+T, :pushMD;
XM0510> MAStkT7: MAR<-stk7+T, :pushMD;
;-----------------------------------------------------------------
; Common exit used to reset the stack pointer
; the instruction that branches here should have a 'TASK'
; Setstkp must be odd, StkOflw used by PUSH
;-----------------------------------------------------------------
!17,11,Setstkp,,,,,,,,StkOflw;
XM0527> Setstkp: stkp<-L, :next; branch (1) may be pending
XM0537> StkOflw: :dpushof1; honor TASK, dpushof1 is odd
;-----------------------------------------------------------------
; Stack Underflow Handling
;-----------------------------------------------------------------
XM1777> StkUf: T<-sStackUnderflow, :KFCr; catches dispatch of stkp = -1
;-----------------------------------------------------------------
; Store dispatch:
; pops TOS to MD.
; called from many places.
; dispatches on old stkp, so MDpop0 = 1 mod 20B.
; The invoking instruction must load MAR and may optionally keep ball 1
; in the air by having a branch pending. That is, entry at 'StoreB' will
; cause control to pass to 'next', while entry at 'StoreA' will cause
; control to pass to 'nextA'.
;-----------------------------------------------------------------
!1,2,StoreBa,StoreAa;
!17,20,MDpopuf,MDpop0,MDpop1,MDpop2,MDpop3,MDpop4,MDpop5,MDpop6,MDpop7,,,,,,,;
XM0166> StoreB: L<-stkp-1, BUS;
XM0220> StoreBa: stkp<-L, TASK, :MDpopuf;
XM0167> StoreA: L<-stkp-1, BUS;
XM0221> StoreAa: stkp<-L, BUS=0, TASK, :MDpopuf; keep branch (1) alive
XM0541> MDpop0: MD<-stk0, :next;
XM0542> MDpop1: MD<-stk1, :next;
XM0543> MDpop2: MD<-stk2, :next;
XM0544> MDpop3: MD<-stk3, :next;
XM0545> MDpop4: MD<-stk4, :next;
XM0546> MDpop5: MD<-stk5, :next;
XM0547> MDpop6: MD<-stk6, :next;
XM0550> MDpop7: MD<-stk7, :next;
;-----------------------------------------------------------------
; Double-word pop dispatch:
; picks up alpha from ib, adds it to T, then pops stack into result and
; result+1
; entry at 'Dpopa' substitutes L for ib.
; returns to 'nextA' <=> ib = 0 or entry at 'Dpop'
;-----------------------------------------------------------------
!17,20,dpopuf2,dpopuf1,dpop1,dpop2,dpop3,dpop4,dpop5,dpop6,dpop7,,,,,,,;
!1,1,Dpopb; required by placement of
; MDpopuf only.
XM0071> Dpop: L<-T<-ib+T+1;
XM0540> MDpopuf: IR<-0, :Dpopb; Note: MDpopuf is merely a
; convenient label which leads
; to a BUS dispatch on stkp in
; the case that stkp is -1. It
; is used by the Store dispatch
; above.
XM0216> Dpopa: L<-T<-M+T+1;
XM0222> IR<-ib, :Dpopb;
XM0215> Dpopb: MAR<-T, temp<-L;
XM0560> dpopuf2: L<-stkp-1, BUS;
XM0223> stkp<-L, TASK, :dpopuf2;
XM0561> dpopuf1: :StkUf; stack underflow, honor TASK
XM0562> dpop1: MD<-stk1, :Dpopx;
XM0563> dpop2: MD<-stk2, :Dpopx;
XM0564> dpop3: MD<-stk3, :Dpopx;
XM0565> dpop4: MD<-stk4, :Dpopx;
XM0566> dpop5: MD<-stk5, :Dpopx;
XM0567> dpop6: MD<-stk6, :Dpopx;
XM0570> dpop7: MD<-stk7, :Dpopx;
XM0224> Dpopx: SINK<-DISP, BUS=0;
XM0500> MAStkT: MAR<-temp-1, :StoreB;
;-----------------------------------------------------------------
; Get operation-specific code from other files
;-----------------------------------------------------------------
#MesacROM.mu;
; *** 11/23/15 - START OF MESACROM.MU ***
;-----------------------------------------------------------------
; MesacROM.Mu - Jumps, Load/Store, Read/Write, Binary/Unary/Stack Operators
; Last modified by Levin - March 7, 1979 8:29 AM
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; J u m p s
;-----------------------------------------------------------------
; The following requirements are assumed:
; 1) J2-J9, JB are usable (in that order) as subroutine
; returns (by JEQx and JNEx).
; 2) since J2-J9 and JB are opcode entry points,
; they must meet requirements set by opcode dispatch.
;-----------------------------------------------------------------
; Jn - jump PC-relative
;-----------------------------------------------------------------
!1,2,JnA,Jbranchf;
XM1600> J2: L<-ONE, :JnA;
XM1601> J3: L<-2, :JnA;
XM1602> J4: L<-3, :JnA;
XM1603> J5: L<-4, :JnA;
XM1604> J6: L<-5, :JnA;
XM1605> J7: L<-6, :JnA;
XM1606> J8: L<-7, :JnA;
XM1607> J9: L<-10, :JnA;
XM0226> JnA: L<-M-1, :Jbranchf; A-aligned - adjust distance
;-----------------------------------------------------------------
; JB - jump PC-relative by alpha, assuming:
; JB is A-aligned
; Note: JEQB and JNEB come here with branch (1) pending
;-----------------------------------------------------------------
!1,1,JBx; shake JEQB/JNEB branch
!1,1,Jbranch; must be odd (shakes IR<- below)
XM1610> JB: T<-ib, :JBx;
XM0225> JBx: L<-400 OR T; <-DISP will do sign extension
XM0230> IR<-M; 400 above causes branch (1)
XM0232> L<-DISP-1, :Jbranch; L: ib (sign extended) - 1
;-----------------------------------------------------------------
; JW - jump PC-relative by alphabeta, assuming:
; if JW is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after JW
;-----------------------------------------------------------------
XM1611> JW: IR<-sr1, :FetchAB; returns to JWr
JWr: L<-ALLONES+T, :Jbranch; L: alphabeta-1
;-----------------------------------------------------------------
; Jump destination determination
; L has (signed) distance from even byte of word addressed by mpc+1
;-----------------------------------------------------------------
!1,2,Jforward,Jbackward;
!1,2,Jeven,Jodd;
XM0231> Jbranch: T<-0+1, SH<0; dispatch fwd/bkwd target
XM0227> Jbranchf: SINK<-M, BUSODD, TASK, :Jforward; dispatch even/odd target
XM0234> Jforward: temp<-L RSH 1, :Jeven; stash positive word offset
Jbackward: temp<-L MRSH 1, :Jeven; stash negative word offset
XM0240> Jeven: T<-temp+1, :NOOP; fetch and execute even byte
XM0240> Jodd: T<-temp+1, :nextXB; fetch and execute odd byte
;-----------------------------------------------------------------
; JZEQB - if TOS (popped) = 0, jump PC-relative by alpha, assuming:
; stack has precisely one element
; JZEQB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!1,2,Jcz,Jco;
XM1644> JZEQB: SINK<-stk0, BUS=0; test TOS = 0
XM0233> L<-stkp-1, TASK, :Jcz;
;-----------------------------------------------------------------
; JZNEB - if TOS (popped) ~= 0, jump PC-relative by alpha, assuming:
; stack has precisely one element
; JZNEB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!1,2,JZNEBne,JZNEBeq;
XM1645> JZNEB: SINK<-stk0, BUS=0; test TOS = 0
XM0236> L<-stkp-1, TASK, :JZNEBne;
XM0244> JZNEBne: stkp<-L, :JB; branch, pick up alpha
XM0245> JZNEBeq: stkp<-L, :nextA; no branch, alignment => nextA
;-----------------------------------------------------------------
; JEQn - if TOS (popped) = TOS (popped), jump PC-relative by n, assuming:
; stack has precisely two elements
;-----------------------------------------------------------------
!1,2,JEQnB,JEQnA;
!7,1,JEQNEcom; shake IR<- dispatch
XM1612> JEQ2: IR<-sr0, L<-T, :JEQnB; returns to J2
XM1613> JEQ3: IR<-sr1, L<-T, :JEQnB; returns to J3
XM1614> JEQ4: IR<-sr2, L<-T, :JEQnB; returns to J4
XM1615> JEQ5: IR<-sr3, L<-T, :JEQnB; returns to J5
XM1616> JEQ6: IR<-sr4, L<-T, :JEQnB; returns to J6
XM1617> JEQ7: IR<-sr5, L<-T, :JEQnB; returns to J7
XM1620> JEQ8: IR<-sr6, L<-T, :JEQnB; returns to J8
XM1621> JEQ9: IR<-sr7, L<-T, :JEQnB; returns to J9
;-----------------------------------------------------------------
; JEQB - if TOS (popped) = TOS (popped), jump PC-relative by alpha, assuming:
; stack has precisely two elements
; JEQB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1622> JEQB: IR<-sr10, :JEQnA; returns to JB
;-----------------------------------------------------------------
; JEQ common code
;-----------------------------------------------------------------
!1,2,JEQcom,JNEcom; return points from JEQNEcom
XM246> JEQnB: temp<-L RSH 1, L<-T, :JEQNEcom; temp:0, L:1 (for JEQNEcom)
XM247> JEQnA: temp<-L, L<-T, :JEQNEcom; temp:1, L:1 (for JEQNEcom)
!1,2,JEQne,JEQeq;
XM0250> JEQcom: L<-stkp-T-1, :JEQne; L: old stkp - 2
XM0252> JEQne: SINK<-temp, BUS, TASK, :Setstkp; no jump, reset stkp
XM0253> JEQeq: stkp<-L, IDISP, :JEQNExxx; jump, set stkp, then dispatch
;
; JEQ/JNE common code
;
; !7,1,JEQNEcom; appears above with JEQn
; !1,2,JEQcom,JNEcom; appears above with JEQB
XM0267> JEQNEcom: T<-stk1;
XM0254> L<-stk0-T, SH=0; dispatch EQ/NE
XM0255> T<-0+1, SH=0, :JEQcom; test outcome and return
XM0256> JEQNExxx: SINK<-temp, BUS, :J2; even/odd dispatch
;-----------------------------------------------------------------
; JNEn - if TOS (popped) ~= TOS (popped), jump PC-relative by n, assuming:
; stack has precisely two elements
;-----------------------------------------------------------------
!1,2,JNEnB,JNEnA;
XM1623> JNE2: IR<-sr0, L<-T, :JNEnB; returns to J2
XM1624> JNE3: IR<-sr1, L<-T, :JNEnB; returns to J3
XM1625> JNE4: IR<-sr2, L<-T, :JNEnB; returns to J4
XM1626> JNE5: IR<-sr3, L<-T, :JNEnB; returns to J5
XM1627> JNE6: IR<-sr4, L<-T, :JNEnB; returns to J6
XM1630> JNE7: IR<-sr5, L<-T, :JNEnB; returns to J7
XM1631> JNE8: IR<-sr6, L<-T, :JNEnB; returns to J8
XM1632> JNE9: IR<-sr7, L<-T, :JNEnB; returns to J9
;-----------------------------------------------------------------
; JNEB - if TOS (popped) = TOS (popped), jump PC-relative by alpha, assuming:
; stack has precisely two elements
; JNEB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1633> JNEB: IR<-sr10, :JNEnA; returns to JB
;-----------------------------------------------------------------
; JNE common code
;-----------------------------------------------------------------
XM0260> JNEnB: temp<-L RSH 1, L<-0, :JEQNEcom; temp:0, L:0
XM0261> JNEnA: temp<-L, L<-0, :JEQNEcom; temp:1, L:0
!1,2,JNEne,JNEeq;
JNEcom: L<-stkp-T-1, :JNEne; L: old stkp - 2
JNEne: stkp<-L, IDISP, :JEQNExxx; jump, set stkp, then dispatch
JNEeq: SINK<-temp, BUS, TASK, :Setstkp; no jump, reset stkp
;-----------------------------------------------------------------
; JrB - for r in {L,LE,G,GE,UL,ULE,UG,UGE}
; if TOS (popped) r TOS (popped), jump PC-relative by alpha, assuming:
; stack has precisely two elements
; JrB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
; The values loaded into IR are not returns but encoded actions:
; Bit 12: 0 => branch if carry zero
; 1 => branch if carry one (mask value: 10)
; Bit 15: 0 => perform add-complement before testing carry
; 1 => perform subtract before testing carry (mask value: 1)
; (These values were chosen because of the masks available for use with <-DISP
; in the existing constants ROM. Note that IR<- causes no dispatch.)
XM1634> JLB: IR<-10, :Jscale; adc, branch if carry one
XM1637> JLEB: IR<-11, :Jscale; sub, branch if carry one
XM1636> JGB: IR<-ONE, :Jscale; sub, branch if carry zero
XM1635> JGEB: IR<-0, :Jscale; adc, branch if carry zero
XM1640> JULB: IR<-10, :Jnoscale; adc, branch if carry one
XM1643> JULEB: IR<-11, :Jnoscale; sub, branch if carry one
XM1642> JUGB: IR<-ONE, :Jnoscale; sub, branch if carry zero
XM1641> JUGEB: IR<-0, :Jnoscale; adc, branch if carry zero
;-----------------------------------------------------------------
; Comparison "subroutine":
;-----------------------------------------------------------------
!1,2,Jadc,Jsub;
; !1,2,Jcz,Jco; appears above with JZEQB
!1,2,Jnobz,Jbz;
!1,2,Jbo,Jnobo;
XM0266> Jscale: T<-77777, :Jadjust;
Jnoscale: T<-ALLONES, :Jadjust;
XM0275> Jadjust: L<-stk1+T+1; L:stk1 + (0 or 100000)
XM0276> temp<-L;
XM0300> SINK<-DISP, BUSODD; dispatch ADC/SUB
XM0301> T<-stk0+T+1, :Jadc;
XM0264> Jadc: L<-temp-T-1, :Jcommon; perform add complement
Jsub: L<-temp-T, :Jcommon; perform subtract
XM0302> Jcommon: T<-ONE; warning: not T<-0+1
XM0303> L<-stkp-T-1, ALUCY; test ADC/SUB outcome
XM0304> SINK<-DISP, SINK<-lgm10, BUS=0, TASK, :Jcz; dispatch on encoded bit 12
XM0242> Jcz: stkp<-L, :Jnobz; carry is zero (stkp<-stkp-2)
Jco: stkp<-L, :Jbo; carry is one (stkp<-stkp-2)
XM0270> Jnobz: L<-mpc+1, TASK, :nextAput; no jump, alignment=>nextAa
Jbz: T<-ib, :JBx; jump
Jbo: T<-ib, :JBx; jump
Jnobo: L<-mpc+1, TASK, :nextAput; no jump, alignment=>nextAa
;-----------------------------------------------------------------
; JIW - see Principles of Operation for description
; assumes:
; stack contains precisely two elements
; if JIW is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after JIW
;-----------------------------------------------------------------
!1,2,JIuge,JIul;
!1,1,JIWx;
XM1647> JIW: L<-stkp-T-1, TASK, :JIWx; stkp<-stkp-2
XM0305> JIWx: stkp<-L;
XM0310> T<-stk0;
XM0311> L<-XMAR<-mpc+1; load alphabeta
XM0312> mpc<-L;
XM0313> L<-stk1-T-1; do unsigned compare
XM0314> ALUCY;
XM0315> T<-MD, :JIuge;
XM0306> JIuge: L<-mpc+1, TASK, :nextAput; out of bounds - to 'nextA'
XM0307> JIul: L<-cp+T, TASK; (removing this TASK saves a
XM0316> taskhole<-L; word, but leaves a run of
XM0320> T<-taskhole; 15 instructions)
XM0321> XMAR<-stk0+T; fetch <+alphabeta+X>
XM0322> NOP;
XM0323> L<-MD-1, :Jbranch; L: offset
;-----------------------------------------------------------------
; L o a d s
;-----------------------------------------------------------------
; Note: These instructions keep track of their parity
;-----------------------------------------------------------------
; LLn - push <+n>
; Note: LL3 must be odd!
;-----------------------------------------------------------------
; Note: lp is offset by 2, hence the adjustments below
XM1410> LL0: MAR<-lp-T-1, :pushMD;
XM1411> LL1: MAR<-lp-1, :pushMD;
XM1412> LL2: MAR<-lp, :pushMD;
XM1413> LL3: MAR<-lp+T, :pushMD;
XM1414> LL4: MAR<-lp+T+1, :pushMD;
XM1415> LL5: T<-3, SH=0, :LL3; pick up ball 1
XM1416> LL6: T<-4, SH=0, :LL3; pick up ball 1
XM1417> LL7: T<-5, SH=0, :LL3; pick up ball 1
;-----------------------------------------------------------------
; LLB - push <+alpha>
;-----------------------------------------------------------------
XM1420> LLB: IR<-sr4, :Getalpha; returns to LLBr
XM0044> LLBr: T<-nlpoffset+T+1, SH=0, :LL3; undiddle lp, pick up ball 1
;-----------------------------------------------------------------
; LLDB - push <+alpha>, push <+alpha+1>
; LLDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1421> LLDB: T<-lp, :LDcommon;
XM0324> LDcommon: T<-nlpoffset+T+1, :Dpush;
;-----------------------------------------------------------------
; LGn - push <+n>
; Note: LG2 must be odd!
;-----------------------------------------------------------------
; Note: gp is offset by 1, hence the adjustments below
XM1437> LG0: MAR<-gp-1, :pushMD;
XM1440> LG1: MAR<-gp, :pushMD;
XM1441> LG2: MAR<-gp+T, :pushMD;
XM1442> LG3: MAR<-gp+T+1, :pushMD;
XM1443> LG4: T<-3, SH=0, :LG2; pick up ball 1
XM1444> LG5: T<-4, SH=0, :LG2; pick up ball 1
XM1445> LG6: T<-5, SH=0, :LG2; pick up ball 1
XM1446> LG7: T<-6, SH=0, :LG2; pick up ball 1
;-----------------------------------------------------------------
; LGB - push <+alpha>
;-----------------------------------------------------------------
XM1447> LGB: IR<-sr5, :Getalpha; returns to LGBr
XM0045> GBr: T<-ngpoffset+T+1, SH=0, :LG2; undiddle gp, pick up ball 1
;-----------------------------------------------------------------
; LGDB - push <+alpha>, push <+alpha+1>
; LGDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1450> LGDB: T<-gp+T+1, :LDcommon; T: gp-gpoffset+lpoffset
;-----------------------------------------------------------------
; LIn - push n
;-----------------------------------------------------------------
!1,2,LI0xB,LI0xA; keep ball 1 in air
; Note: all BUS dispatches use old stkp value, not incremented one
XM1456> LI0: L<-stkp+1, BUS, :LI0xB;
XM1457> LI1: L<-stkp+1, BUS, :pushT1B;
XM1460> LI2: T<-2, :pushTB;
XM1461> LI3: T<-3, :pushTB;
XM1462> LI4: T<-4, :pushTB;
XM1463> LI5: T<-5, :pushTB;
XM1464> LI6: T<-6, :pushTB;
XM0326> LI0xB: stkp<-L, L<-0, TASK, :push0;
LI0xA: stkp<-L, BUS=0, L<-0, TASK, :push0; BUS=0 keeps branch pending
;-----------------------------------------------------------------
; LIN1 - push -1
;-----------------------------------------------------------------
XM1465> LIN1: T<-ALLONES, :pushTB;
;-----------------------------------------------------------------
; LINI - push 100000
;-----------------------------------------------------------------
XM1466> LINI: T<-100000, :pushTB;
;-----------------------------------------------------------------
; LIB - push alpha
;-----------------------------------------------------------------
XM1467> LIB: IR<-sr2, :Getalpha; returns to pushTB
; Note: pushT1B will handle
; any pending branch
;-----------------------------------------------------------------
; LINB - push (alpha OR 377B8)
;-----------------------------------------------------------------
XM1471> LINB: IR<-sr26, :Getalpha; returns to LINBr
XM0066> LINBr: T<-177400 OR T, :pushTB;
;-----------------------------------------------------------------
; LIW - push alphabeta, assuming:
; if LIW is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after LIW
;-----------------------------------------------------------------
XM1470> LIW: IR<-msr0, :FetchAB; returns to LIWr
XM0160> LIWr: L<-stkp+1, BUS, :pushT1A; duplicates pushTA, but
; because of overlapping
; return points, we
; can't use it
;-----------------------------------------------------------------
; S t o r e s
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; SLn - <+n><-TOS (popped)
; Note: SL3 is odd!
;-----------------------------------------------------------------
; Note: lp is offset by 2, hence the adjustments below
XM1422> SL0: MAR<-lp-T-1, :StoreB;
XM1423> SL1: MAR<-lp-1, :StoreB;
XM1424> SL2: MAR<-lp, :StoreB;
XM1425> SL3: MAR<-lp+T, :StoreB;
XM1426> SL4: MAR<-lp+T+1, :StoreB;
XM1427> SL5: T<-3, SH=0, :SL3;
XM1430> SL6: T<-4, SH=0, :SL3;
XM1431> SL7: T<-5, SH=0, :SL3;
;-----------------------------------------------------------------
; SLB - <+alpha><-TOS (popped)
;-----------------------------------------------------------------
XM1432> SLB: IR<-sr6, :Getalpha; returns to SLBr
XM0046> SLBr: T<-nlpoffset+T+1, SH=0, :SL3; undiddle lp, pick up ball 1
;-----------------------------------------------------------------
; SLDB - <+alpha+1><-TOS (popped), <+alpha><-TOS (popped), assuming:
; SLDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1562> SLDB: T<-lp, :SDcommon;
XM0325> SDcommon: T<-nlpoffset+T+1, :Dpop;
;-----------------------------------------------------------------
; SGn - <+n><-TOS (popped)
; Note: SG2 must be odd!
;-----------------------------------------------------------------
; Note: gp is offset by 1, hence the adjustments below
XM1451> SG0: MAR<-gp-1, :StoreB;
XM1452> SG1: MAR<-gp, :StoreB;
XM1453> SG2: MAR<-gp+T, :StoreB;
XM1454> SG3: MAR<-gp+T+1, :StoreB;
;-----------------------------------------------------------------
; SGB - <+alpha><-TOS (popped)
;-----------------------------------------------------------------
XM1455> SGB: IR<-sr7, :Getalpha; returns to SGBr
XM0047> SGBr: T<-ngpoffset+T+1, SH=0, :SG2; undiddle gp, pick up ball 1
;-----------------------------------------------------------------
; SGDB - <+alpha+1><-TOS (popped), <+alpha><-TOS (popped), assuming:
; SGDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1563> SGDB: T<-gp+T+1, :SDcommon; T: gp-gpoffset+lpoffset
;-----------------------------------------------------------------
; P u t s
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; PLn - <+n><-TOS (stack is not popped)
;-----------------------------------------------------------------
!1,1,PLcommon; drop ball 1
; Note: lp is offset by 2, hence the adjustments below
XM1433> PL0: MAR<-lp-T-1, SH=0, :PLcommon; pick up ball 1
XM1434> PL1: MAR<-lp-1, SH=0, :PLcommon;
XM1435> PL2: MAR<-lp, SH=0, :PLcommon;
XM1436> PL3: MAR<-lp+T, SH=0, :PLcommon;
XM0331> PLcommon: L<-stkp, BUS, :StoreBa; don't decrement stkp
;-----------------------------------------------------------------
; B i n a r y o p e r a t i o n s
;-----------------------------------------------------------------
; Warning! Before altering this list, be certain you understand the additional addressing
; requirements imposed on some of these return locations! However, it is safe to add new
; return points at the end of the list.
!37,40,ADDr,SUBr,ANDr,ORr,XORr,MULr,DIVr,LDIVr,SHIFTr,EXCHr,RSTRr,WSTRr,WSBr,WS0r,WSFr,WFr,
WSDBrb,WFSrb,BNDCKr,RWBLrb,WBLrb,,,,,,,,,,,;
;-----------------------------------------------------------------
; Binary operations common code
; Entry conditions:
; Both IR and T hold return number. (More precisely, entry at
; 'BincomB' requires return number in IR, entry at 'BincomA' requires
; return number in T.)
; Exit conditions:
; left operand in L (M), right operand in T
; stkp positioned for subsequent push (i.e. points at left operand)
; dispatch pending (for push0) on return
; if entry occurred at BincomA, IR has been modified so
; that mACSOURCE will produce 1
;-----------------------------------------------------------------
; dispatches on stkp-1, so Binpop1 = 1 mod 20B
!17,20,Binpop,Binpop1,Binpop2,Binpop3,Binpop4,Binpop5,Binpop6,Binpop7,,,,,,,,;
!1,2,BincomB,BincomA;
!4,1,Bincomx; shake IR<- in BincomA
XM0332> BincomB: L<-T<-stkp-1, :Bincomx; value for dispatch into Binpop
XM0334> Bincomx: stkp<-L, L<-T;
XM0330> L<-M-1, BUS, TASK; L:value for push dispatch
XM0335> Bincomd: temp2<-L, :Binpop; stash briefly
XM0333> BincomA: L<-2000 OR T; make mACSOURCE produce 1
XM0620> Binpop: IR<-M, :BincomB;
XM0621> Binpop1: T<-stk1;
XM0336> L<-stk0, :Binend;
XM0622> Binpop2: T<-stk2;
XM0340> L<-stk1, :Binend;
XM0623> Binpop3: T<-stk3;
XM0341> L<-stk2, :Binend;
XM0624> Binpop4: T<-stk4;
XM0342> L<-stk3, :Binend;
XM0625> Binpop5: T<-stk5;
XM0343> L<-stk4, :Binend;
XM0626> Binpop6: T<-stk6;
XM0344> L<-stk5, :Binend;
XM0627> Binpop7: T<-stk7;
XM0345> L<-stk6, :Binend;
XM0346> Binend: SINK<-DISP, BUS; perform return dispatch
XM0347> SINK<-temp2, BUS, :ADDr; perform push dispatch
;-----------------------------------------------------------------
; ADD - replace with sum of top two stack elements
;-----------------------------------------------------------------
XM1650> ADD: IR<-T<-ret0, :BincomB;
XM1000> ADDr: L<-M+T, mACSOURCE, TASK, :push0; M addressing unaffected
;-----------------------------------------------------------------
; ADD01 - replace stk0 with +
;-----------------------------------------------------------------
!1,1,ADD01x; drop ball 1
XM1670> ADD01: T<-stk1-1, :ADD01x;
XM0351> ADD01x: T<-stk0+T+1, SH=0; pick up ball 1
XM0350> L<-stkp-1, :pushT1B; no dispatch => to push0
;-----------------------------------------------------------------
; SUB - replace with difference of top two stack elements
;-----------------------------------------------------------------
XM1651> SUB: IR<-T<-ret1, :BincomB;
XM1001> SUBr: L<-M-T, mACSOURCE, TASK, :push0; M addressing unaffected
;-----------------------------------------------------------------
; AND - replace with AND of top two stack elements
;-----------------------------------------------------------------
XM1660> AND: IR<-T<-ret2, :BincomB;
XM1002> ANDr: L<-M AND T, mACSOURCE, TASK, :push0; M addressing unaffected
;-----------------------------------------------------------------
; OR - replace with OR of top two stack elements
;-----------------------------------------------------------------
XM1661> OR: IR<-T<-ret3, :BincomB;
XM1003> ORr: L<-M OR T, mACSOURCE, TASK, :push0; M addressing unaffected
;-----------------------------------------------------------------
; XOR - replace with XOR of top two stack elements
;-----------------------------------------------------------------
XM1662> XOR: IR<-T<-ret4, :BincomB;
XM1004> XORr: L<-M XOR T, mACSOURCE, TASK, :push0; M addressing unaffected
;-----------------------------------------------------------------
; MUL - replace with product of top two stack elements
; high-order bits of product recoverable by PUSH
;-----------------------------------------------------------------
!7,1,MULDIVcoma; shakes stack dispatch
!1,2,GoROMMUL,GoROMDIV;
!7,2,MULx,DIVx; also shakes bus dispatch
XM1652> MUL: IR<-T<-ret5, :BincomB;
XM1005> MULr: AC1<-L, L<-T, :MULDIVcoma; stash multiplicand
XM0367> MULDIVcoma: AC2<-L, L<-0, :MULx; stash multiplier or divisor
XM0416> MULx: AC0<-L, T<-0+1, :MULDIVcomb; AC0<-0 keeps ROM happy
XM0417> DIVx: AC0<-L, T<-0, BUS=0, :MULDIVcomb; BUS=0 => GoROMDIV
XM0354> MULDIVcomb: L<-MULDIVretloc+T, SWMODE, :GoROMMUL; prepare return address
XM0352> GoROMMUL: PC<-L, :ROMMUL; go to ROM multiply
XM0353> GoROMDIV: PC<-L, :ROMDIV; go to ROM divide
MULDIVret: :MULDIVret1; No divide - someday a trap
; perhaps, but garbage now.
MULDIVret1: T<-AC1; Normal return
L<-stkp+1;
L<-T, SINK<-M, BUS;
T<-AC0, :dpush; Note! not a subroutine
; call, but a direct
; dispatch.
;-----------------------------------------------------------------
; DIV - push quotient of top two stack elements (popped)
; remainder recoverable by PUSH
;-----------------------------------------------------------------
XM1654> DIV: IR<-T<-ret6, :BincomB;
XM1006> DIVr: AC1<-L, L<-T, BUS=0, :MULDIVcoma; BUS=0 => DIVx
;-----------------------------------------------------------------
; LDIV - push quotient of ,,/ (all popped)
; remainder recoverable by PUSH
;-----------------------------------------------------------------
XM1655> LDIV: IR<-sr27, :Popsub; get divisor
XM0067> LDIVf: AC2<-L; stash it
XM0361> IR<-T<-ret7, :BincomB; L:low bits, T:high bits
XM1007> LDIVr: AC1<-L, L<-T, IR<-0, :DIVx; stash low part of dividend
; and ensure mACSOURCE of 0.
;-----------------------------------------------------------------
; SHIFT - replace with shifted by
; > 0 => left shift, < 0 => right shift
;-----------------------------------------------------------------
!7,1,SHIFTx; shakes stack dispatch
!1,2,Lshift,Rshift;
!1,2,DoShift,Shiftdone;
!1,2,DoRight,DoLeft;
!1,1,Shiftdonex;
XM1663> SHIFT: IR<-T<-ret10, :BincomB;
XM1010> SHIFTr: temp<-L, L<-T, TASK, :SHIFTx; L: value, T: count
XM0427> SHIFTx: count<-L;
XM0366> L<-T<-count;
XM0372> L<-0-T, SH<0; L: -count, T: count
XM0374> IR<-sr1, :Lshift; IR<- causes no branch
XM0362> Lshift: L<-37 AND T, TASK, :Shiftcom; mask to reasonable size
XM0363> Rshift: T<-37, IR<-37; equivalent to IR<-msr0
L<-M AND T, TASK, :Shiftcom; mask to reasonable size
XM0376> Shiftcom: count<-L, :Shiftloop;
XM0402> Shiftloop: L<-count-1, BUS=0; test for completion
XM0403> count<-L, IDISP, :DoShift;
XM0364> DoShift: L<-temp, TASK, :DoRight;
XM0370> DoRight: temp<-L RSH 1, :Shiftloop;
XM0371> DoLeft: temp<-L LSH 1, :Shiftloop;
XM0365> Shiftdone: SINK<-temp2, BUS, :Shiftdonex; dispatch to push result
XM0373> Shiftdonex: L<-temp, TASK, :push0;
;-----------------------------------------------------------------
; D o u b l e - P r e c i s i o n A r i t h m e t i c
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; DADD - add two double-word quantities, assuming:
; stack contains precisely 4 elements
;-----------------------------------------------------------------
!1,1,DoRamDoubles; shake B/A dispatch
XM1664> DADD: L<-4, SWMODE, :DoRamDoubles; drop ball 1
XM0405> DoRamDoubles: SINK<-M, BUS, TASK, :ramOverflow; go to overflow code in RAM
;-----------------------------------------------------------------
; DSUB - subtract two double-word quantities, assuming:
; stack contains precisely 4 elements
;-----------------------------------------------------------------
XM1665> DSUB: L<-5, SWMODE, :DoRamDoubles; drop ball 1
;-----------------------------------------------------------------
; DCOMP - compare two long integers, assuming:
; stack contains precisely 4 elements
; result left on stack is -1, 0, or +1 (single-precision)
; (i.e. result = sign(stk1,,stk0 DSUB stk3,,stk2) )
;-----------------------------------------------------------------
XM1666> DCOMP: L<-6, SWMODE, :DoRamDoubles; drop ball 1
;-----------------------------------------------------------------
; DUCOMP - compare two long cardinals, assuming:
; stack contains precisely 4 elements
; result left on stack is -1, 0, or +1 (single-precision)
; (i.e. result = sign(stk1,,stk0 DSUB stk3,,stk2) )
;-----------------------------------------------------------------
XM1667> DUCOMP: L<-7, SWMODE, :DoRamDoubles; drop ball 1
;-----------------------------------------------------------------
; R a n g e C h e c k i n g
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; NILCK - check TOS for NIL (0), trap if so
;-----------------------------------------------------------------
!1,2,InRange,OutOfRange;
XM1571> NILCK: L<-ret17, :Xpopsub; returns to NILCKr
XM0117> NILCKr: T<-ONE, SH=0, :NILCKpush; test TOS=0
XM0404> NILCKpush: L<-stkp+T, :InRange;
XM0410> InRange: SINK<-ib, BUS=0, TASK, :Setstkp; pick up ball 1
XM0411> OutOfRange: T<-sBoundsFaultm1+T+1, :KFCr; T:SD index; go trap
;-----------------------------------------------------------------
; BNDCK - check subrange inclusion
; if TOS-1 ~IN [0..TOS) then trap (test is unsigned)
; only TOS is popped off
;-----------------------------------------------------------------
!7,1,BNDCKx; shake push dispatch
XM1573> BNDCK: IR<-T<-ret22, :BincomB; returns to BNDCKr
BNDCKr: SINK<-M-T, :BNDCKx; L: value, T: limit
BNDCKx: T<-0, ALUCY, :NILCKpush;
;-----------------------------------------------------------------
; R e a d s
;-----------------------------------------------------------------
; Note: RBr must be odd!
;-----------------------------------------------------------------
; Rn - TOS<-<+n>
;-----------------------------------------------------------------
XM1500> R0: T<-0, SH=0, :RBr;
XM1501> R1: T<-ONE, SH=0, :RBr;
XM1502> R2: T<-2, SH=0, :RBr;
XM1503> R3: T<-3, SH=0, :RBr;
XM1504> R4: T<-4, SH=0, :RBr;
;-----------------------------------------------------------------
; RB - TOS<-<+alpha>, assuming:
;-----------------------------------------------------------------
!1,2,ReadB,ReadA; keep ball 1 in air
XM1505> RB: IR<-sr15, :Getalpha; returns to RBr
XM0055> RBr: L<-stkp-1, BUS, :ReadB;
XM0412> ReadB: stkp<-L, :MAStkT; to pushMD
ReadA: stkp<-L, BUS=0, :MAStkT; to pushMDA
;-----------------------------------------------------------------
; RDB - temp<-+alpha, push <>, push <+1>, assuming:
; RDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1514> RDB: IR<-sr30, :Popsub; returns to Dpush
;-----------------------------------------------------------------
; RD0 - temp<-, push <>, push <+1>
;-----------------------------------------------------------------
XM1515> RD0: IR<-sr32, :Popsub; returns to RD0r
XM0072> RD0r: L<-0, :Dpusha;
;-----------------------------------------------------------------
; RILP - push <<+alpha[0-3]>+alpha[4-7]>
;-----------------------------------------------------------------
XM1524> RILP: L<-ret0, :Splitalpha; get two 4-bit values
XM0170> RILPr: T<-lp, :RIPcom; T:address of local 2
;-----------------------------------------------------------------
; RIGP - push <<+alpha[0-3]>+alpha[4-7]>
;-----------------------------------------------------------------
!3,1,IPcom; shake IR<- at WILPr
XM1525> RIGP: L<-ret1, :Splitalpha; get two 4-bit values
RIGPr: T<-gp+1, :RIPcom; T:address of global 2
XM0414> RIPcom: IR<-msr0, :IPcom; set up return to pushMD
XM0423> IPcom: T<--3+T+1; T:address of local or global 0
XM0415> MAR<-lefthalf+T; start memory cycle
XM0421> L<-righthalf;
XM0422> IPcomx: T<-MD, IDISP; T:local/global value
XM0424> MAR<-M+T, :pushMD; start fetch/store
;-----------------------------------------------------------------
; RIL0 - push <<>>
;-----------------------------------------------------------------
!1,2,RILxB,RILxA;
XM1527> RIL0: MAR<-lp-T-1, :RILxB; fetch local 0
XM0452> RILxB: IR<-msr0, L<-0, :IPcomx; to pushMD
RILxA: IR<-sr1, L<-sr1 AND T, :IPcomx; to pushMDA, L<-0(!)
;-----------------------------------------------------------------
; RXLP - TOS<-<+<+alpha[0-3]>+alpha[4-7]>
;-----------------------------------------------------------------
XM1522> RXLP: L<-ret3, :Splitalpha; will return to RXLPra
RXLPra: IR<-sr34, :Popsub; fetch TOS
XM0074> RXLPrb: L<-righthalf+T, TASK; L:TOS+alpha[4-7]
XM0425> righthalf<-L, :RILPr; now act like RILP
;-----------------------------------------------------------------
; W r i t e s
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; Wn - < (popped)+n><- (popped)
;-----------------------------------------------------------------
!1,2,WnB,WnA; keep ball 1 in air
XM1506> W0: T<-0, :WnB;
XM1507> W1: T<-ONE, :WnB;
XM1510> W2: T<-2, :WnB;
XM0454> WnB: IR<-sr2, :Wsub; returns to StoreB
WnA: IR<-sr3, :Wsub; returns to StoreA
;-----------------------------------------------------------------
; Write subroutine:
;-----------------------------------------------------------------
!7,1,Wsubx; shake IR<- dispatch
XM0426> Wsub: L<-stkp-1, BUS, :Wsubx;
XM0457> Wsubx: stkp<-L, IDISP, :MAStkT;
;-----------------------------------------------------------------
; WB - < (popped)+alpha><- (popped)
;-----------------------------------------------------------------
XM1511> WB: IR<-sr16, :Getalpha; returns to WBr
XM0056> WBr: :WnB; branch may be pending
;-----------------------------------------------------------------
; WSB - act like WB but with stack values reversed, assuming:
; WSB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!7,1,WSBx; shake stack dispatch
XM1531> WSB: IR<-T<-ret14, :BincomA; alignment requires BincomA
WSBr: T<-M, L<-T, :WSBx;
WSBx: MAR<-ib+T, :WScom;
WScom: temp<-L;
WScoma: L<-stkp-1;
MD<-temp;
mACSOURCE, TASK, :Setstkp;
;-----------------------------------------------------------------
; WS0 - act like WSB but with alpha value of zero
;-----------------------------------------------------------------
!7,1,WS0x; shake stack dispatch
XM1530> WS0: IR<-T<-ret15, :BincomB;
WS0r: T<-M, L<-T, :WS0x;
WS0x: MAR<-T, :WScom;
;-----------------------------------------------------------------
; WILP - <+alpha[0-3]>+alpha[4-7] <- (popped)
;-----------------------------------------------------------------
XM1526> WILP: L<-ret2, :Splitalpha; get halves of alpha
XM0172> WILPr: IR<-sr2; IPcom will exit to StoreB
XM0473> T<-lp, :IPcom; prepare to undiddle
;-----------------------------------------------------------------
; WXLP - +<+alpha[0-3]>+alpha[4-7] <- (both popped)
;-----------------------------------------------------------------
XM1523> WXLP: L<-ret4, :Splitalpha; get halves of alpha
WXLPra: IR<-sr35, :Popsub; fetch TOS
XM0075> WXLPrb: L<-righthalf+T, TASK; L:TOS+alpha[4-7]
XM0474> righthalf<-L, :WILPr; now act like WILP
;-----------------------------------------------------------------
; WDB - temp<-alpha+ (popped), pop into +1 and , assuming:
; WDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1516> WDB: IR<-sr31, :Popsub; returns to Dpop
;-----------------------------------------------------------------
; WD0 - temp<- (popped), pop into +1 and
;-----------------------------------------------------------------
XM1517> WD0: L<-ret6, TASK, :Xpopsub; returns to WD0r
XM0106> D0r: L<-0, :Dpopa;
;-----------------------------------------------------------------
; WSDB - like WDB but with address below data words, assuming:
; WSDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!7,1,WSDBx;
XM1533> WSDB: IR<-sr24, :Popsub; get low data word
XM0064> WSDBra: saveret<-L; stash it briefly
XM0475> IR<-T<-ret20, :BincomA; alignment requires BincomA
WSDBrb: T<-M, L<-T, :WSDBx; L:high data, T:address
WSDBx: MAR<-T<-ib+T+1; start store of low data word
temp<-L, L<-T; temp:high data
temp2<-L, TASK; temp2:updated address
MD<-saveret; stash low data word
MAR<-temp2-1, :WScoma; start store of high data word
;-----------------------------------------------------------------
; L o n g P o i n t e r o p e r a t i o n s
;-----------------------------------------------------------------
!1,1,RWBLcom; drop ball 1
;-----------------------------------------------------------------
; RBL - like RB, but uses a long pointer
;-----------------------------------------------------------------
XM1537> RBL: L<-M AND NOT T, T<-M, SH=0, :RWBLcom; L: ret0, T: L at entry
;-----------------------------------------------------------------
; WBL - like WB, but uses a long pointer
;-----------------------------------------------------------------
XM1540> WBL: L<-T, T<-M, SH=0, :RWBLcom; L: ret1, T: L at entry
;
; Common long pointer code
;
!1,2,RWBLcomB,RWBLcomA;
!1,1,RWBLxa; drop ball 1
!7,1,RWBLxb; shake stkp dispatch
!7,1,WBLx; shake stkp dispatch
!3,4,RBLra,WBLra,WBLrc,;
!3,4,RWBLdone,RBLdone,,WBLdone;
XM0515> RWBLcom: entry<-L, L<-T, :RWBLcomB; stash return, restore L
XM0520> RWBLcomB: IR<-sr37, :Getalpha;
XM0521> RWBLcomA: IR<-sr37, :GetalphaA;
XM0077> RWBLra: IR<-ret23, L<-T, :RWBLxa; L: alpha byte
XM0523> RWBLxa: alpha<-L, :BincomB; stash alpha, get long pointer
RWBLrb: MAR<-BankReg, :RWBLxb; fetch bank register
RWBLxb: L<-T, T<-M; T: low half, L: high half
temp<-L; temp: high pointer
L<-alpha+T; L: low pointer+alpha
T<-MD; T: bank register to save
MAR<-BankReg; reaccess bank register
frame<-L, L<-T; frame: pointer
taskhole<-L, TASK; taskhole: old bank register
MD<-temp, :WBLx; set new alternate bank value
WBLx: XMAR<-frame; start memory access
L<-entry+1, BUS; dispatch RBL/WBL
entry<-L, L<-T, :RBLra; (L<-T for WBLrc only)
RBLra: T<-MD, :RWBLtail; T: data from memory
WBLra: IR<-ret24, :BincomB; returns to WBLrb
WBLrb: T<-M, :WBLx; T: data to write
WBLrc: MD<-M, :RWBLtail; stash data in memory
RWBLtail: MAR<-BankReg;
SINK<-entry, BUS; dispatch return
RWBLdone: MD<-taskhole, :RWBLdone; restore bank register
RBLdone: L<-temp2+1, BUS, :pushT1B; temp2: original stkp-2
WBLdone: L<-temp2, TASK, :Setstkp; temp2: original stkp-3
;-----------------------------------------------------------------
; U n a r y o p e r a t i o n s
;-----------------------------------------------------------------
; XMESA Note: Untail is wired down by a pre-def in MesaROM.mu
;-----------------------------------------------------------------
; INC - TOS <- +1
;-----------------------------------------------------------------
XM1657> INC: IR<-sr14, :Popsub;
XM0054> INCr: T<-0+T+1, :pushTB;
;-----------------------------------------------------------------
; NEG - TOS <- -
;-----------------------------------------------------------------
XM1656> NEG: L<-ret11, TASK, :Xpopsub;
XM0111> NEGr: L<-0-T, :Untail;
;-----------------------------------------------------------------
; DBL - TOS <- 2*
;-----------------------------------------------------------------
XM1653> DBL: IR<-sr25, :Popsub;
XM0065> DBLr: L<-M+T, :Untail;
;-----------------------------------------------------------------
; Unary operation common code
;-----------------------------------------------------------------
XM0407> Untail: T<-M, :pushTB;
;-----------------------------------------------------------------
; S t a c k a n d M i s c e l l a n e o u s O p e r a t i o n s
;-----------------------------------------------------------------
;-----------------------------------------------------------------
; PUSH - add 1 to stack pointer
;-----------------------------------------------------------------
!1,1,PUSHx;
XM1564> PUSH: L<-stkp+1, BUS, :PUSHx; BUS checks for overflow
XM0553> PUSHx: SINK<-ib, BUS=0, TASK, :Setstkp; pick up ball 1
;-----------------------------------------------------------------
; POP - subtract 1 from stack pointer
;-----------------------------------------------------------------
XM1565> POP: L<-stkp-1, SH=0, TASK, :Setstkp; L=0 <=> branch 1 pending
; need not check stkp=0
;-----------------------------------------------------------------
; DUP - temp<- (popped), push , push
;-----------------------------------------------------------------
!1,1,DUPx;
XM1570> DUP: IR<-sr2, :DUPx; returns to pushTB
XM0555> DUPx: L<-stkp, BUS, TASK, :Popsuba; don't pop stack
;-----------------------------------------------------------------
; EXCH - exchange top two stack elements
;-----------------------------------------------------------------
!1,1,EXCHx; drop ball 1
XM1566> EXCH: IR<-ret11, :EXCHx;
XM0571> EXCHx: L<-stkp-1; dispatch on stkp-1
XM0552> L<-M+1, BUS, TASK, :Bincomd; set temp2<-stkp
EXCHr: T<-M, L<-T, :dpush; Note: dispatch using temp2
;-----------------------------------------------------------------
; LADRB - push alpha+lp (undiddled)
;-----------------------------------------------------------------
!1,1,LADRBx; shake branch from Getalpha
XM1472> LADRB: IR<-sr10, :Getalpha; returns to LADRBr
XM0050> LADRBr: T<-nlpoffset+T+1, :LADRBx;
XM0573> LADRBx: L<-lp+T, :Untail;
;-----------------------------------------------------------------
; GADRB - push alpha+gp (undiddled)
;-----------------------------------------------------------------
!1,1,GADRBx; shake branch from Getalpha
XM1472> GADRB: IR<-sr11, :Getalpha; returns to GADRBr
XM0051> GADRBr: T<-ngpoffset+T+1, :GADRBx;
XM0575> GADRBx: L<-gp+T, :Untail;
;-----------------------------------------------------------------
; S t r i n g O p e r a t i o n s
;-----------------------------------------------------------------
!7,1,STRsub; shake stack dispatch
!1,2,STRsubA,STRsubB;
!1,2,RSTRrx,WSTRrx;
STRsub: L<-stkp-1; update stack pointer
stkp<-L;
L<-ib+T; compute index and offset
SINK<-M, BUSODD, TASK;
count<-L RSH 1, :STRsubA;
STRsubA: L<-177400, :STRsubcom; left byte
STRsubB: L<-377, :STRsubcom; right byte
STRsubcom: T<-temp; get string address
MAR<-count+T; start fetch of word
T<-M; move mask to more useful place
SINK<-DISP, BUSODD; dispatch to caller
mask<-L, SH<0, :RSTRrx; dispatch B/A, mask for WSTR
;-----------------------------------------------------------------
; RSTR - push byte of string using base () and index ()
; assumes RSTR is A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
!1,2,RSTRB,RSTRA;
XM1520> RSTR: IR<-T<-ret12, :BincomB;
RSTRr: temp<-L, :STRsub; stash string base address
RSTRrx: L<-MD AND T, TASK, :RSTRB; isolate good bits
RSTRB: temp<-L, :RSTRcom;
RSTRA: temp<-L LCY 8, :RSTRcom; right-justify byte
RSTRcom: T<-temp, :pushTA; go push result byte
;-----------------------------------------------------------------
; WSTR - pop into string byte using base () and index ()
; assumes WSTR is A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
!1,2,WSTRB,WSTRA;
XM1521> WSTR: IR<-T<-ret13, :BincomB;
WSTRr: temp<-L, :STRsub; stash string base
WSTRrx: L<-MD AND NOT T, :WSTRB; isolate good bits
WSTRB: temp2<-L, L<-ret0, TASK, :Xpopsub; stash them, return to WSTRrB
WSTRA: temp2<-L, L<-ret0+1, TASK, :Xpopsub; stash them, return to WSTRrA
XM0101> WSTRrA: taskhole<-L LCY 8; move new data to odd byte
XM0633> T<-taskhole, :WSTRrB;
XM0100> WSTRrB: T<-mask.T;
XM0636> L<-temp2 OR T;
XM0637> T<-temp; retrieve string address
XM0640> MAR<-count+T;
XM0641> TASK;
XM0642> MD<-M, :nextA;
;-----------------------------------------------------------------
; F i e l d I n s t r u c t i o n s
;-----------------------------------------------------------------
; temp2 is coded as follows:
; 0 - RF, RFS
; 1 - WF, WSF, WFS
; 2 - RFC
%1,3,2,RFrr,WFrr; returns from Fieldsub
!7,1,Fieldsub; shakes stack dispatch
; !7,1,WFr; (required by WSFr) is implicit in ret17 (!)
;-----------------------------------------------------------------
; RF - push field specified by beta in word at (popped) + alpha
; if RF is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after RF
;-----------------------------------------------------------------
XM1512> RF: IR<-sr12, :Popsub;
XM0052> RFr: L<-ret0, :Fieldsub;
RFrr: T<-mask.T, :pushTA; alignment requires pushTA
;-----------------------------------------------------------------
; WF - pop data in into field specified by beta in word at (popped) + alpha
; if WF is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after WF
;-----------------------------------------------------------------
; !1,2,WFnzct,WFret; - see location-specific definitions
XM1513> WF: IR<-T<-ret17, :BincomB; L:new data, T:address
WFr: newfield<-L, L<-ret0+1, :Fieldsub; (actually, L<-ret1)
WFrr: T<-mask;
L<-M AND NOT T; set old field bits to zero
temp<-L; stash result
T<-newfield.T; save new field bits
L<-temp OR T, TASK; merge old and new
CYCOUT<-L; stash briefly
T<-index, BUS=0; get position, test for zero
L<-WFretloc, :WFnzct; get return address from ROM
WFnzct: PC<-L; stash return
L<-20-T, SWMODE; L:remaining count to cycle
T<-CYCOUT, :RAMCYCX; go cycle remaining amount
WFret: MAR<-frame; start memory
L<-stkp-1; pop remaining word
MD<-CYCOUT, TASK, :JZNEBeq; stash data, go update stkp
;-----------------------------------------------------------------
; WSF - like WF, but with top two stack elements reversed
; if WSF is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after WSF
;-----------------------------------------------------------------
XM1532> WSF: IR<-T<-ret16, :BincomB; L:address, T:new data
WSFr: L<-T, T<-M, :WFr;
;-----------------------------------------------------------------
; RFS - like RF, but with a word containing alpha and beta on top of stack
; if RFS is A-aligned, B byte is irrelevant
;-----------------------------------------------------------------
XM1535> RFS: L<-ret12, TASK, :Xpopsub; get alpha and beta
XM0112> RFSra: temp<-L; stash for WFSa
XM0661> L<-ret13, TASK, :Xpopsub; T:address
XM0113> RFSrb: L<-ret0, BUS=0, :Fieldsub; returns quickly to WFSa
;-----------------------------------------------------------------
; WFS - like WF, but with a word containing alpha and beta on top of stack
; if WFS is A-aligned, B byte is irrelevant
;-----------------------------------------------------------------
!1,2,Fieldsuba,WFSa;
XM1536> WFS: L<-ret14, TASK, :Xpopsub; get alpha and beta
XM0114> WFSra: temp<-L; stash temporarily
XM0664> IR<-T<-ret21, :BincomB; L:new data, T:address
WFSrb: newfield<-L, L<-ret0+1, BUS=0, :Fieldsub; returns quickly to WFSa
WFSa: frame<-L; stash address
T<-177400; to separate alpha and beta
L<-temp AND T, T<-temp, :Getalphab; L:alpha, T:both
; returns to Fieldra
;-----------------------------------------------------------------
; RFC - like RF, but uses ++ as address
; if RFC is A-aligned, B byte is irrelevant
; alpha in B byte, beta in A byte of word after RF
;-----------------------------------------------------------------
XM1534> FC: L<-ret16, TASK, :Xpopsub; get index into code segment
XM0116> RFCr: L<-cp+T;
XM0667> T<-M; T:address
XM0670> L<-ret2, :Fieldsub; returns to RFrr
;-----------------------------------------------------------------
; Field instructions common code
; Entry conditions:
; L holds return offset
; T holds base address
; Exit conditions:
; mask: right-justified mask
; frame: updated address, including alpha
; index: left cycles needed to right-justify field [0-15]
; L,T: data word from location cycled left bits
;-----------------------------------------------------------------
%2,3,1,NotCodeSeg,IsCodeSeg;
XM0657> Fieldsub: temp2<-L, L<-T, IR<-msr0, TASK, :Fieldsuba; stash return
XM0662> Fieldsuba: frame<-L, :GetalphaA; stash base address
; T: beta, ib: alpha
XM0040> Fieldra: L<-ret5;
XM0672> saveret<-L, :Splitcomr; get two halves of beta
Fieldrb: T<-righthalf; index for MASKTAB
MAR<-MASKTAB+T; start fetch of mask
T<-lefthalf+T+1; L:left-cycle count
L<-17 AND T; mask to 4 bits
index<-L; stash position
L<-MD, TASK; L:mask for caller's use
mask<-L; stash mask
SINK<-temp2, BUS; temp2=2 <=> RFC
T<-frame, :NotCodeSeg; get base address
NotCodeSeg: L<-MAR<-ib+T, :StashFieldLoc; add alpha
IsCodeSeg: XMAR<-ib+T, :DoCycle; add alpha
StashFieldLoc: frame<-L, :DoCycle; stash updated address for WF
DoCycle: L<-Fieldretloc; return location from RAMCYCX
PC<-L;
T<-MD, SWMODE; data word into T for cycle
L<-index, :RAMCYCX; count to cycle, go do it
Fieldrc: SINK<-temp2, BUSODD; return dispatch
L<-T<-CYCOUT, :RFrr; cycled data word in L and T
; *** 11/23/15 - END OF MESACROM.MU ***
#MesadROM.mu;
; *** 11/23/15 - START OF MESADROM.MU ***
;-----------------------------------------------------------------
; 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
XM0722> AllocSub: L<-avm1+T+1, TASK, :Allocx; fetch av entry
XM0723> Allocx: entry<-L; save av entry address
XM0730> L<-MAR<-entry;
XM0731> T<-3; mask for pointer flags
XM0732> L<-MD AND T, T<-MD; (L<-MD AND 3, T<-MD)
XM0733> temp<-L, L<-MAR<-T; start reading pointer
XM0734> SINK<-temp, BUS; branch on bits 14:15
XM0735> frame<-L, :Alloc0;
;
; Bits 14:15 = 00, a frame of the right index is queued for allocation
;
XM0724> Alloc0: L<-MD, TASK; new entry for frame vector
XM0736> temp<-L; new value of vector entry
XM0737> MAR<-entry; update frame vector
XM0740> L<-T<-frame, IDISP; establish exit conditions
XM0741> MD<-temp, :ALLOCr; update and return
;
; Bits 14:15 = 01, allocation list empty: restore argument, take failure return
;
XM0725> Alloc1: L<-temp2, IDISP, TASK; restore parameter
XM0742> temp2<-L LSH 1, :ALLOCrf; allocation failed
;
; Bits 14:15 = 10, a pointer to an alternate list to use
;
XM0726> Alloc2: temp<-L RSH 1, :Allocp; indirection: index<-index/4
XM0743> Allocp: L<-temp, TASK;
XM0744> temp<-L RSH 1;
XM0745> T<-temp, :AllocSub;
XM0727> 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
XM0746> FreeSub: MAR<-frame-1; start read of fsi word
XM0757> Freex: NOP; wait for memory
XM0747> T<-MD; T<-index
XM0753> L<-MAR<-avm1+T+1; fetch av entry
XM0754> entry<-L; save av entry address
XM0755> L<-MD; read current pointer
XM0756> MAR<-frame; write it into current frame
XM0760> temp<-L, TASK;
XM0761> MD<-temp; write!
XM0762> MAR<-entry; entry points at frame
XM0763> IDISP, TASK;
XM0764> MD<-frame, :RETr; free
;-----------------------------------------------------------------
; ALLOC - allocate a frame whose fsi is specified by (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
XM1756> ALLOC: L<-ret7, TASK, :Xpopsub; returns to ALLOCrx
XM0107> ALLOCrx: temp2<-L LSH 1, IR<-msr0, :AllocSub; L,T: fsi
XM0716> ALLOCr: L<-stkp+1, BUS, :pushT1B; duplicates pushTB
;
; Allocation failed - save mpc, undiddle lp, push fsi*4 on stack, then trap
;
XM0720> 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 (popped)
;-----------------------------------------------------------------
XM1757> FREE: L<-ret10, TASK, :Xpopsub; returns to FREErx
XM0110> FREErx: frame<-L, TASK;
XM0771> 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 <+gfi offset>+2*alpha+1 (masking gfi word appropriately)
; DESCB is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
XM1750> DESCB: T<-gp;
XM0772> T<-ngpoffset+T+1, :DESCBcom; T:address of frame
XM0115> DESCBcom: MAR<-gfioffset+T; start fetch of gfi word
XM0773> T<-gfimask; mask to isolate gfi bits
XM0774> T<-MD.T; T:gfi
XM0775> L<-ib+T, T<-ib; L:gfi+alpha, T:alpha
XM1025> T<-M+T+1, :pushTA; pushTA because A-aligned
;-----------------------------------------------------------------
; DESCBS - push <+gfi offset>+2*alpha+1 (masking gfi word appropriately)
; DESCBS is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
XM1751> 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
XM0765> Savpcinframe: T<-cp, :Savpcx; code segment base
XM1027> Savpcx: L<-mpc-T; L is code-relative pc
XM1026> SINK<-ib, BUS=0; check for odd or even pc
XM1032> T<-M, :Spcodd; pick up pc word addr
XM1030> Spcodd: L<-0-T, TASK, :Spcopc; - pc => odd, this word
XM1031> Spceven: L<-0+T+1, TASK, :Spcopc; + pc => even, next word
XM1033> Spcopc: taskhole<-L; pc value to save
XM1034> L<-0; (can't merge above - TASK)
XM1035> T<-npcoffset; offset to pc stash
XM1036> MAR<-lp-T, T<-lp; (MAR<-lp-npcoffset, T<-lp)
XM1037> ib<-L; clear ib for XferG
XM1040> L<-nlpoffset+T+1; L:undiddled lp
XM1041> MD<-taskhole; stash pc in frame+pcoffset
XM1042> my<-L, IDISP, TASK; store undiddled lp
XM1043> 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
XM1046> Loadgc: L<-lpoffset+T; diddle (presumed) lp
XM1060> lp<-L; (only correct if frame ptr)
XM1061> T<-MD; global frame address
XM1062> L<-MD; 2nd word (PC or EV offset)
XM1063> MAR<-cpoffset+T; read code pointer
XM1064> mpc<-L, L<-T; copy g to L for null test
XM1065> L<-cpoffset+T+1, SH=0; test gf=0
XM1066> taskhole<-L, :LoadgcOK; taskhole:addr of hi code base
XM1050> LoadgcOK: L<-MD, BUSODD, TASK; L: low bits of code base
XM1067> cp<-L, :LoadgcIn; stash low bits, branch if odd
XM1052> LoadgcIn: MAR<-BankReg; access bank register
XM1070> T<-14; mask to save primary bank
XM1071> L<-MD AND T; L: primary bank *4
XM1072> temp2<-L, :LoadgcShift; temp2: primary bank *4
XM1073> LoadgcShift: newfield<-L RSH 1, L<-0-T, :LoadgcDiv2; newfield: bank*2, L: negative
XM1054> LoadgcDiv2: L<-newfield, SH<0, TASK, :LoadgcShift; SH<0 forces branch, TASK safe
XM1055> LoadgcDiv4: MAR<-T<-taskhole; fetch high bits of code base
XM1074> L<-gpcpoffset+T; diddle gp
XM1075> gp<-L;
XM1076> T<-177400; mask for high bits
XM1077> L<-MD AND T, T<-MD;
XM1100> T<-3.T, SH=0; T: bank if long codebase
XM1101> MAR<-BankReg, :LoadgcNoXM; initiate store
XM1056> LoadgcNoXM: T<-newfield, :LoadgcIsXM; T: MDS bank
XM1057> LoadgcIsXM: L<-temp2 OR T, TASK; L: new bank registers
XM1102> MD<-M; stash bank
XM1103> XMAR<-cp; access first cseg word
XM1104> IDISP, TASK; dispatch return
XM1105> 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;
XM01106> CheckXferTrap: L<-XTSreg, BUSODD; XTSreg[15]=1 => trap
XM01116> SINK<-DISP, BUS, :NoXferTrap; dispatch (possible) return
XM01114> NoXferTrap: XTSreg<-L RSH 1, :Xfers; reset XTSreg[15] to 0 or 1
XM01115> 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
XM00431> Xfer: T<-mx; mx[14:15] is dest link type
XM01121> IR<-0, :CheckXferTrap;
XM01110> Xfers: L<-3 AND T; extract type bits
XM01122> SINK<-M, L<-T, BUS; L:dest link, branch on type
XM01123> 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
;-----------------------------------------------------------------
XM01124> Xfer0: IR<-msr0, :Loadgc; to LoadgcNull if dest link = 0
XM1044> 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;
XM1140> SINK<-brkbyte, BUS=0; set up by Loadstate
XM1141> SH<0, L<-0, :Xdobreak; dispatch even/odd pc
;
; Not proceeding from a breakpoint - simply pick up next instruction
;
XM1131> Xnobreak: :Xfer0B;
XM1132> Xfer0B: L<-XMAR<-cp+T, :nextAdeafa; fetch word, pc even
XM1133> Xfer0A: L<-XMAR<-cp-T; fetch word, pc odd
XM1142> mpc<-L, :nextXBni;
;
; Proceeding from a breakpoint - dispatch brkbyte and clear it
;
XM1130> Xdobreak: ib<-L, :XbrkB; clear ib for XbrkA
XM1134> XbrkB: IR<-sr20; here if BRK at even byte
XM1143> L<-XMAR<-cp+T, :GetalphaAx; set up ib (return to XbrkBr)
XM1135> XbrkA: L<-cp-T; here if BRK at odd byte
XM1144> mpc<-L, L<-0, BUS=0, :XbrkBr; ib already zero (to XbrkAgo)
XM0060> XbrkBr: SINK<-brkbyte, BUS, :XbrkBgo; dispatch brkbyte
XM1136> XbrkBgo: brkbyte<-L RSH 1, T<-0+1, :NOOP; clear brkbyte, act like nextA
XM1137> 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
;
XM0430> XferGT: T<-count; parameter to CheckXferTrap
XM1164> 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
XM1216> Getlink: T<-gp; diddled frame address
XM1220> MAR<-T<-ngpoffset+T+1; fetch word 0 of global frame
XM1221> L<-temp+T, T<-temp; L:address of link in frame
XM1222> taskhole<-L; stash it
XM1223> L<-cp+T; L:address of link in code
XM1224> SINK<-MD, BUSODD, TASK; test bit 15 of word zero
XM1225> temp2<-L, :framelink; stash code link address
XM1214> framelink: MAR<-taskhole, :Fetchlink; fetch link from frame
XM1215> codelink: XMAR<-temp2, :Fetchlink; fetch link from code
XM1217> Fetchlink: SINK<-DISP, BUS=0; dispatch to caller
XM1226> L<-T<-MD, :EFCgetr;
;-----------------------------------------------------------------
; EFCn - perform XFER to destination specified by external link n
;-----------------------------------------------------------------
; !1,1,EFCr; implicit in EFCr's return number (23B)
XM1700> EFC0: IR<-ONE, T<-ONE-1, :EFCr; 0th control link
XM1701> EFC1: IR<-T<-ONE, :EFCr; 1st control link
XM1702> EFC2: IR<-T<-2, :EFCr; . . .
XM1703> EFC3: IR<-T<-3, :EFCr;
XM1704> EFC4: IR<-T<-4, :EFCr;
XM1705> EFC5: IR<-T<-5, :EFCr;
XM1706> EFC6: IR<-T<-6, :EFCr;
XM1707> EFC7: IR<-T<-7, :EFCr;
XM1710> EFC8: IR<-T<-10, :EFCr;
XM1711> EFC9: IR<-T<-11, :EFCr;
XM1712> EFC10: IR<-T<-12, :EFCr;
XM1713> EFC11: IR<-T<-13, :EFCr;
XM1714> EFC12: IR<-T<-14, :EFCr;
XM1715> EFC13: IR<-T<-15, :EFCr;
XM1716> EFC14: IR<-T<-16, :EFCr;
XM1717> EFC15: IR<-T<-17, :EFCr;
;-----------------------------------------------------------------
; EFCB - perform XFER to destination specified by external link 'alpha'
;-----------------------------------------------------------------
!1,1,EFCdoGetlink; shake B/A dispatch (Getalpha)
XM1720> EFCB: IR<-sr23, :Getalpha; fetch link number
XM0063> EFCr: L<-0-T-1, TASK, :EFCdoGetlink; L:-(link number+1)
XM1227> EFCdoGetlink: temp<-L, :Getlink; stash index for Getlink
XM1212> EFCgetr: IR<-sr1, :SFCr; for Savpcinframe; no branch
;-----------------------------------------------------------------
; SFC - Stack Function Call (using descriptor on top of stack)
;-----------------------------------------------------------------
XM1742> SFC: IR<-sr1, :Popsub; get dest link for xfer
; now assume IR still has sr1
XM0041> SFCr: mx<-L, :Savpcinframe; set dest link, return to Xfer
;-----------------------------------------------------------------
; KFCB - Xfer using destination <+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
XM1747> KFCB: IR<-sr21, :Getalpha; fetch alpha
XM0061> KFCr: IR<-avm1, T<-avm1+T+1, :KFCx; DISP must be non zero
XM1231> KFCx: MAR<-sdoffset+T, :Fetchlink; Fetchlink shakes IR<- dispatch
;-----------------------------------------------------------------
; BRK - Breakpoint (equivalent to KFC 0)
;-----------------------------------------------------------------
KM1776> 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;
XM1235> Mtrapa: L<-MD, TASK; (enter here from PORTO)
XM1236> mx<-L, :Xfer;
;-----------------------------------------------------------------
; LFCn - call local procedure n (i.e. within same global frame)
;-----------------------------------------------------------------
!1,1,LFCx; shake B/A dispatch
XM1721> LFC1: L<-2, :LFCx;
XM1722> LFC2: L<-3, :LFCx;
XM1723> LFC3: L<-4, :LFCx;
XM1724> LFC4: L<-5, :LFCx;
XM1725> LFC5: L<-6, :LFCx;
XM1726> LFC6: L<-7, :LFCx;
XM1727> LFC7: L<-10, :LFCx;
XM1730> LFC8: L<-11, :LFCx;
XM1237> 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)
;-----------------------------------------------------------------
XM1741> LFCB: IR<-sr22, :Getalpha;
XM0062> LFCr: L<-0+T+1, :LFCx;
;-----------------------------------------------------------------
; RET - Return from function call.
;-----------------------------------------------------------------
!1,1,RETx; shake B/A branch
XM1743> RET: T<-lp, :RETx; local pointer
XM1241> 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
XM0750> 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)
;-----------------------------------------------------------------
XM1567> LINKB: MAR<-lp-T-1; address of local 0
XM1246> T<-ib;
XM1247> L<-mx-T, TASK; L: mx-alpha
XM1250> MD<-M, :nextA; local 0 <- mx-alpha
;-----------------------------------------------------------------
; LLKB - push external link 'alpha'
; LLKB is assumed to be A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
XM1744> LLKB: T<-ib; T:alpha
XM1251> 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)
;-----------------------------------------------------------------
XM1745> PORTO: IR<-sr3, :Savpcinframe; undiddle lp into my
PORTOpc: L<-ret5, TASK, :Xpopsub; returns to PORTOr
XM0105> PORTOr: MAR<-T; fetch from TOS
XM1252> L<-T;
XM1253> MD<-my; frame addr to word 0 of PORT
XM1254> MAR<-M+1; second word of PORT
XM1255> 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;
XM1746> PORTI: MAR<-mx, :PORTIx; first word of PORT
XM1257> PORTIx: SINK<-my, BUS=0;
XM1256> TASK, :PORTInz;
XM1260> PORTInz: MD<-0;
XM1262> MAR<-mx+1; store it as second word
XM1263> TASK, :PORTIz;
XM1261> 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;
XM1266> Savestate: temp<-L;
XM1267> Savestatea: T<--12+1; i.e. T<--11
XM1270> 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;
XM1307> Sav7r: L<-stk6, :Savsub;
XM1306> Sav6r: L<-stk5, :Savsub;
XM1305> Sav5r: L<-stk4, :Savsub;
XM1304> Sav4r: L<-stk3, :Savsub;
XM1303> Sav3r: L<-stk2, :Savsub;
XM1302> Sav2r: L<-stk1, :Savsub;
XM1301> Sav1r: L<-stk0, :Savsub;
XM1300> Sav0r: SINK<-DISP, BUS; return to caller
XM1276> T<--12, :DSTr1; (for DST's benefit)
; Remember, T is negative
Savsub: T<-count;
XM1313> Savsuba: temp2<-L, L<-0+T+1;
XM1314> MAR<-temp-T;
XM1315> count<-L, L<-0-T; dispatch on pos. value
XM1316> SINK<-M, BUS, TASK;
XM1317> 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;
XM01333> Loadstate: temp<-L, IR<-msr0, :NovaIntrOn; stash pointer
XM01336> 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;
XM01327> Lsr7: stk7<-L, :Ldsub;
XM01326> Lsr6: stk6<-L, :Ldsub;
XM01325> Lsr5: stk5<-L, :Ldsub;
XM01324> Lsr4: stk4<-L, :Ldsub;
XM01323> Lsr3: stk3<-L, :Ldsub;
XM01322> Lsr2: stk2<-L, :Ldsub;
XM01321> Lsr1: stk1<-L, :Ldsub;
XM01320> Lsr0: stk0<-L, :Xfer;
XM01347> Ldsub: T<-count;
XM01335> Ldsuba: MAR<-temp+T;
XM01350> L<-ALLONES+T; decr count for next time
XM01351> count<-L, L<-T; use old value for dispatch
XM01352> SINK<-M, BUS;
XM01353> L<-MD, TASK, :Lsr0;
;-----------------------------------------------------------------
; DST - dump state at block starting at +alpha, reset stack pointer
; assumes DST is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1770> DST: T<-ib; get alpha
XM1354> T<-lp+T+1;
XM1355> L<-nlpoffset1+T+1, TASK; L:lp-lpoffset+alpha
XM1356> temp<-L, IR<-ret0, :Savestatea;
XM0776> 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 +alpha
; assumes LST is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1771> LST: L<-ib;
XM1357> temp<-L, L<-0, TASK;
XM1360> ib<-L; make Savpcinframe happy
XM1361> 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 +alpha, then free frame
; assumes LSTF is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
XM1772> LSTF: T<-lpoffset;
XM1363> L<-lp-T, TASK; compute frame base
XM1364> frame<-L;
XM1365> 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 , 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)
XM1775> RR: L<-0, SWMODE, :DoRamRWB;
XM1367> DoRamRWB: SINK<-M, BUS, L<-T, :ramOverflow; L<-T for WR
;-----------------------------------------------------------------
; WR - emulator register alpha <- (popped), where:
; WR is A-aligned (also ensures no pending branch at entry)
; alpha: 1 => wdc, 2 => XTSreg
;-----------------------------------------------------------------
XM1774> WR: L<-ret3, TASK, :Xpopsub;
XM0103> WRr: L<-2, SWMODE, :DoRamRWB;
;-----------------------------------------------------------------
; JRAM - JMPRAM for Mesa programs (when emulator is in ROM1)
;-----------------------------------------------------------------
XM1767> JRAM: L<-ret2, TASK, :Xpopsub;
XM0102> 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
XM1401> ME: IR<-isME, :FastEEx; indicate ME instruction
XM1404> MXD: IR<-isMXD, :FastEEx; indicate MXD instruction
XM1402> MRE: MAR<-HardMRE, :FastMREx; ~= 0 => do Nova code
XM1377> FastMREx: IR<-isMRE, :MXDr; indicate MRE instruction
XM1475> FastEEx: MAR<-stk0, IDISP, :FastEExx; fetch monitor lock
XM1477> FastEExx: T<-100000, :MXDr; value of unlocked monitor lock
XM1542> MXDr: L<-MD, mACSOURCE, :FastEExxx; L:0 if locked (or queue empty)
MEr: L<-MD-T, mACSOURCE, :FastEExxx; L:0 if unlocked
XM1547> 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.
XM1554> 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
;-----------------------------------------------------------------
XM1403> MXW: IR<-4, :MoveParms3; 3 parameters
;-----------------------------------------------------------------
; NOTIFY,BCAST - Awaken process(es) from condition variable
;-----------------------------------------------------------------
XM1405> NOTIFY: IR<-5, :MoveParms1; 1 parameter
XM1406> BCAST: IR<-6, :MoveParms1; 1 parameter
;-----------------------------------------------------------------
; REQUEUE - Move process from queue to queue
;-----------------------------------------------------------------
XM1407> 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!
XM1375> MoveParms3: L<-stk2, TASK;
XM1550> FastEEtrap2: AC2<-L; (enter here from MRE)
XM1373> MoveParms2: L<-stk1, TASK;
XM1544> FastEEtrap1: AC1<-L; (enter here from ME/MXD)
XM1371> MoveParms1: L<-stk0, TASK;
XM1370> AC0<-L;
XM1372> L<-0, TASK; indicate stack empty
XM1374> stkp<-L;
XM1376> 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)
;-----------------------------------------------------------------
XM1763> 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
XM1762> STOP: L<-NovaDVloc+T, :GotoNova;
;-----------------------------------------------------------------
; STARTIO - perform Nova-like I/O function
;-----------------------------------------------------------------
XM1766> STARTIO: L<-ret4, TASK, :Xpopsub; get argument in L
XM0104> STARTIOr: SINK<-M, STARTF, :next;
;-----------------------------------------------------------------
; MISC - escape hatch for more than 256 opcodes
;-----------------------------------------------------------------
; !5,2,Dpushx,RCLKr; appears with Dpush
XM1764> MISC: IR<-sr36, :Getalpha; get argument in L
; throws away alpha for now
XM0076> MISCr: L<-CLOCKLOC-1, IR<-CLOCKLOC, :Dpushb; IR<- causes branch 1!
; (and mACSOURCE of 0)
; Dpushb shakes B/A dispatch
XM0205> 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
XM1752> BLT: stk7<-L, SWMODE, :BLTx; stk7=0 <=> branch pending
XM1553> 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.
;-----------------------------------------------------------------
XM1753> 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
XM1754> BLTC: stk7<-L, SWMODE, :BLTCx;
XM1557> 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
XM1765> BITBLT: stk7<-L, :BITBLTx; save even/odd across ROM call
XM1561> BITBLTx: L<-stk0, TASK;
XM1474> AC2<-L; stash descriptor table
XM1476> L<-stk1, TASK;
XM1546> AC1<-L;
XM1552> SINK<-wdc, BUS=0; check if Mesa interrupts off
XM1560> IR<-sr3, :NovaIntrOff; if so, shut off Nova's
XM1677> DoBITBLT: L<-BITBLTret, SWMODE, :DoBITBLTx; get return address
XM1577> 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
XM1676> NovaIntrOff: T<-100000; disable bit
XM1737> NovaIntrOffx: L<-NWW OR T, TASK, IDISP; turn it on, dispatch return
XM1574> NWW<-L, :Mstop;
XM01575> NovaIntrOn: T<-100000; disable bit
XM01576> L<-NWW AND NOT T, IDISP; turn it off, dispatch return
XM01646> NWW<-L, L<-0, :Lsr;
;-----------------------------------------------------------------
; IWDC - Increment Wakeup Disable Counter (disable interrupts)
;-----------------------------------------------------------------
!1,2,IDnz,IDz;
XM1760> IWDC: L<-wdc+1, TASK, :IDnz; skip check for interrupts
;-----------------------------------------------------------------
; DWDC - Decrement Wakeup Disable Counter (enable interrupts)
;-----------------------------------------------------------------
!1,1,DWDCx;
XM1761> DWDC: MAR<-WWLOC, :DWDCx; OR WW into NWW
XM1671> DWDCx: T<-NWW;
XM1675> L<-MD OR T, TASK;
XM1731> NWW<-L;
XM1732> SINK<-ib, BUS=0;
XM1733> L<-wdc-1, TASK, :IDnz;
; Ensure that one instruction will execute before an interrupt is taken
XM1672> IDnz: wdc<-L, :next;
XM1673> 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
;-----------------------------------------------------------------
XM00420> 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
;-----------------------------------------------------------------
XM1541> 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.
;-----------------------------------------------------------------
XM0406> Intstop: L<-NovaDVloc, TASK; resume at Nova loc. 30B
XM1734> PC<-L, :Mstop;
;-----------------------------------------------------------------
; Stash the Mesa pc and dump the current process state,
; then start fetching Nova instructions.
;-----------------------------------------------------------------
XM1674> Mstop: IR<-sr2, :Savpcinframe; save mpc for Nova code
XM0432> Mstopr: MAR<-CurrentState; get current state address
XM1735> IR<-ret1; will return to 'Mstopc'
XM1736> 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:
XM0777> Mstopc: L<-100000+1, SWMODE; version 1, XM
XM1740> cp<-L, :START; off to the Nova ...
; *** 11/23/15 - END OF MESADROM.MU ***
\ No newline at end of file
diff --git a/Contralto/Disassembly/boot block disassembly.txt b/Contralto/Disassembly/boot block disassembly.txt
index 3ca0b00..7a73b59 100644
--- a/Contralto/Disassembly/boot block disassembly.txt
+++ b/Contralto/Disassembly/boot block disassembly.txt
@@ -40,15 +40,15 @@
033:175550 - INCLO# 3,3 ; Data address (gets 400 (STA at 14))
034:000000 - JMP 0 ; non-error interrupt mask
035:000000 - JMP 0 ; error interrupt mask
-036:000000 - JMP 0 ; reserved
-037:000000 - JMP 0 ; disk address
+036:000000 - JMP 0 ; reserved ; header checked/written here, this is always zero
+037:000000 - JMP 0 ; disk address ; address is checked
; 1st copy of label block at 402 starts here
-040:130374 - COMSC# 1,2,SZR ; 000400 - disk address (?)
-041:000000 - JMP 0 ; 120374 - previous disk address
+040:130374 - COMSC# 1,2,SZR ; 000400 - disk address (?) ; next address ? Not checked; read
+041:000000 - JMP 0 ; 120374 - previous disk address ; previous address (checked)
042:000000 - JMP 0 ; 000000 - blank
-043:000000 - JMP 0 ; 001000 - num chars
-044:176007 - ADC 3,3,SBN ; 000001 - page number
+043:000000 - JMP 0 ; 001000 - num chars ; checked
+044:176007 - ADC 3,3,SBN ; 000001 - page number ; not checked
045:000001 - JMP 1 ; 000001 - version
046:000000 - JMP 0 ; 000000 - sn high
047:000176 - JMP 176 ; 000176 - sn low
@@ -63,7 +63,7 @@
055:176150 - ADCLO# 3,3 ; Data address
056:000000 - JMP 0 ; non-error interrupt mask
057:000000 - JMP 0 ; error interrupt mask
-060:000000 - JMP 0 ; reserved
+060:000000 - JMP 0 ; reserved ; header checked/written here
061:130374 - COMSC# 1,2,SZR ; disk address
; 2nd copy of label block at 402 starts here (and magically matches
diff --git a/Contralto/Disk/Clark-Games.dsk b/Contralto/Disk/Clark-Games.dsk
new file mode 100644
index 0000000..efe83ea
Binary files /dev/null and b/Contralto/Disk/Clark-Games.dsk differ
diff --git a/Contralto/Disk/bcpl.dsk b/Contralto/Disk/bcpl.dsk
new file mode 100644
index 0000000..ec2357e
Binary files /dev/null and b/Contralto/Disk/bcpl.dsk differ
diff --git a/Contralto/Disk/gamesb.dsk b/Contralto/Disk/gamesb.dsk
new file mode 100644
index 0000000..dbd478c
Binary files /dev/null and b/Contralto/Disk/gamesb.dsk differ
diff --git a/Contralto/Disk/gsl.dsk b/Contralto/Disk/gsl.dsk
new file mode 100644
index 0000000..370d44c
Binary files /dev/null and b/Contralto/Disk/gsl.dsk differ
diff --git a/Contralto/Disk/mazeWar.dsk b/Contralto/Disk/mazeWar.dsk
new file mode 100644
index 0000000..2b01346
Binary files /dev/null and b/Contralto/Disk/mazeWar.dsk differ
diff --git a/Contralto/Disk/mazeWarTry2.dsk b/Contralto/Disk/mazeWarTry2.dsk
new file mode 100644
index 0000000..1a17797
Binary files /dev/null and b/Contralto/Disk/mazeWarTry2.dsk differ
diff --git a/Contralto/Disk/nonprog.dsk b/Contralto/Disk/nonprog.dsk
new file mode 100644
index 0000000..9d7bc9d
Binary files /dev/null and b/Contralto/Disk/nonprog.dsk differ
diff --git a/Contralto/Disk/st76boot.dsk b/Contralto/Disk/st76boot.dsk
new file mode 100644
index 0000000..2add0c3
Binary files /dev/null and b/Contralto/Disk/st76boot.dsk differ
diff --git a/Contralto/Disk/xmsmall.dsk b/Contralto/Disk/xmsmall.dsk
new file mode 100644
index 0000000..43eacb2
Binary files /dev/null and b/Contralto/Disk/xmsmall.dsk differ
diff --git a/Contralto/Display/DisplayController.cs b/Contralto/Display/DisplayController.cs
index b9d123d..3d081ac 100644
--- a/Contralto/Display/DisplayController.cs
+++ b/Contralto/Display/DisplayController.cs
@@ -64,7 +64,7 @@ namespace Contralto.Display
_cursorRegLatch = false;
_cursorXLatch = false;
- _verticalBlankEndWakeup = new Event(_verticalBlankDuration, null, VerticalBlankEndCallback);
+ _verticalBlankScanlineWakeup = new Event(_verticalBlankDuration, null, VerticalBlankScanlineCallback);
_horizontalWakeup = new Event(_horizontalBlankDuration, null, HorizontalBlankEndCallback);
_wordWakeup = new Event(_wordDuration, null, WordCallback);
@@ -74,7 +74,7 @@ namespace Contralto.Display
private void FieldStart()
{
- // Start of Vertical Blanking (end of last field). This lasts for 16 scanline times or so.
+ // Start of Vertical Blanking (end of last field). This lasts for 34 scanline times or so.
_evenField = !_evenField;
// Wakeup DVT
@@ -86,34 +86,47 @@ namespace Contralto.Display
_fields++;
- _scanline = _evenField ? 0 : 1;
+ _scanline = _evenField ? 0 : 1;
- // Schedule wakeup for end of vblank
- _verticalBlankEndWakeup.TimestampNsec = _verticalBlankDuration;
- _system.Scheduler.Schedule(_verticalBlankEndWakeup);
+ _vblankScanlineCount = 0;
+
+ // Schedule wakeup for first scanline of vblank
+ _verticalBlankScanlineWakeup.TimestampNsec = _verticalBlankScanlineDuration;
+ _system.Scheduler.Schedule(_verticalBlankScanlineWakeup);
}
- private void VerticalBlankEndCallback(ulong timeNsec, ulong skewNsec, object context)
+ private void VerticalBlankScanlineCallback(ulong timeNsec, ulong skewNsec, object context)
{
- // End of VBlank, start new visible frame at beginning of first horizontal blanking period.
+ // End of VBlank scanline.
+ _vblankScanlineCount++;
- // Wake up DHT
- _system.CPU.WakeupTask(TaskType.DisplayHorizontal);
-
- _dataBuffer.Clear();
-
- _dwtBlocked = false;
- _dhtBlocked = false;
-
- // Schedule HBlank wakeup for end of first HBlank
- _horizontalWakeup.TimestampNsec = _horizontalBlankDuration - skewNsec;
- _system.Scheduler.Schedule(_horizontalWakeup);
-
// Run MRT
- //_system.CPU.WakeupTask(TaskType.MemoryRefresh);
+ _system.CPU.WakeupTask(TaskType.MemoryRefresh);
+
+ if (_vblankScanlineCount > (_evenField ? 33 : 34))
+ {
+ // End of vblank:
+ // Wake up DHT
+ _system.CPU.WakeupTask(TaskType.DisplayHorizontal);
- // Run CURT
- _system.CPU.WakeupTask(TaskType.Cursor);
+ _dataBuffer.Clear();
+
+ _dwtBlocked = false;
+ _dhtBlocked = false;
+
+ // Run CURT
+ _system.CPU.WakeupTask(TaskType.Cursor);
+
+ // Schedule HBlank wakeup for end of first HBlank
+ _horizontalWakeup.TimestampNsec = _horizontalBlankDuration - skewNsec;
+ _system.Scheduler.Schedule(_horizontalWakeup);
+ }
+ else
+ {
+ // Do the next vblank scanline
+ _verticalBlankScanlineWakeup.TimestampNsec = _verticalBlankScanlineDuration;
+ _system.Scheduler.Schedule(_verticalBlankScanlineWakeup);
+ }
}
private void HorizontalBlankEndCallback(ulong timeNsec, ulong skewNsec, object context)
@@ -121,14 +134,7 @@ namespace Contralto.Display
// Reset scanline word counter
_word = 0;
- // Deal with SWMODE latches for the scanline we're about to draw
- if (_swModeLatch)
- {
- _lowRes = _lowResLatch;
- _whiteOnBlack = _whiteOnBlackLatch;
- _swModeLatch = false;
- }
-
+ // Deal with cursor latches for this scanline
if (_cursorRegLatch)
{
_cursorRegLatched = _cursorReg;
@@ -141,9 +147,6 @@ namespace Contralto.Display
_cursorXLatch = false;
}
- // Run MRT on end of hsync
- _system.CPU.WakeupTask(TaskType.MemoryRefresh);
-
// Schedule immediate wakeup for first word on this scanline
_wordWakeup.TimestampNsec = 0;
_system.Scheduler.Schedule(_wordWakeup);
@@ -213,15 +216,24 @@ namespace Contralto.Display
{
// More scanlines to do.
- // Run CURT at end of scanline
- _system.CPU.WakeupTask(TaskType.Cursor);
+ // Run CURT and MRT at end of scanline
+ _system.CPU.WakeupTask(TaskType.Cursor);
+ _system.CPU.WakeupTask(TaskType.MemoryRefresh);
// Schedule HBlank wakeup for end of next HBlank
_horizontalWakeup.TimestampNsec = _horizontalBlankDuration - skewNsec;
_system.Scheduler.Schedule(_horizontalWakeup);
_dwtBlocked = false;
- _dataBuffer.Clear();
-
+ _dataBuffer.Clear();
+
+ // Deal with SWMODE latches for the scanline we're about to draw
+ if (_swModeLatch)
+ {
+ _lowRes = _lowResLatch;
+ _whiteOnBlack = _whiteOnBlackLatch;
+ _swModeLatch = false;
+ }
+
}
}
else
@@ -367,13 +379,16 @@ namespace Contralto.Display
// ~35 scanlines for vblank (1330uS)
private const double _scale = 1.0;
private const ulong _verticalBlankDuration = (ulong)(665000.0 * _scale); // 665uS
+ private const ulong _verticalBlankScanlineDuration = (ulong)(38080 * _scale); // 38uS
private const ulong _horizontalBlankDuration = (ulong)(6084 * _scale); // 6uS
private const ulong _wordDuration = (ulong)(842.0 * _scale); // 32/38uS
+
+ private int _vblankScanlineCount;
//
// Scheduler events
//
- private Event _verticalBlankEndWakeup;
+ private Event _verticalBlankScanlineWakeup;
private Event _horizontalWakeup;
private Event _wordWakeup;
}
diff --git a/Contralto/IO/DiskController.cs b/Contralto/IO/DiskController.cs
index 2bc4adc..d35edaa 100644
--- a/Contralto/IO/DiskController.cs
+++ b/Contralto/IO/DiskController.cs
@@ -264,10 +264,12 @@ namespace Contralto.IO
_seclateEvent.TimestampNsec = _seclateDuration;
_system.Scheduler.Schedule(_seclateEvent);
}
-
- // Schedule next sector pulse
- _sectorEvent.TimestampNsec = _sectorDuration - skewNsec;
- _system.Scheduler.Schedule(_sectorEvent);
+ else
+ {
+ // Schedule next sector pulse
+ _sectorEvent.TimestampNsec = _sectorDuration - skewNsec;
+ _system.Scheduler.Schedule(_sectorEvent);
+ }
}
private void WordCallback(ulong timeNsec, ulong skewNsec, object context)
@@ -280,6 +282,12 @@ namespace Contralto.IO
_wordEvent.TimestampNsec = _wordDuration - skewNsec;
_system.Scheduler.Schedule(_wordEvent);
}
+ else
+ {
+ // // Schedule next sector pulse immediately
+ _sectorEvent.TimestampNsec = skewNsec;
+ _system.Scheduler.Schedule(_sectorEvent);
+ }
}
private void SeekCallback(ulong timeNsec, ulong skewNsec, object context)
@@ -383,7 +391,7 @@ namespace Contralto.IO
_kStat |= 0x0040;
// And figure out how long this will take.
- _seekDuration = CalculateSeekTime();
+ _seekDuration = (ulong)(CalculateSeekTime() / (ulong)(Math.Abs(_destCylinder - _cylinder) + 1));
_seekEvent.TimestampNsec = _seekDuration;
_system.Scheduler.Schedule(_seekEvent);
@@ -403,7 +411,7 @@ namespace Contralto.IO
//
double seekTimeMsec = 15.0 + 8.6 * Math.Sqrt(dt);
- return (ulong)(seekTimeMsec * Conversion.MsecToNsec) / 100; // hack to speed things up
+ return (ulong)(seekTimeMsec * Conversion.MsecToNsec); // hack to speed things up
}
///
@@ -435,13 +443,7 @@ namespace Contralto.IO
// actual data (it could be the pre-header delay, inter-record gaps or sync words)
// and we may not actually end up doing anything with it, but we may
// need it to decide whether to do anything at all.
- //
-
- if (_sectorWordIndex >= _sectorWordCount)
- {
- return;
- }
-
+ //
ushort diskWord = _sectorData[_sectorWordIndex].Data;
bool bWakeup = false;
@@ -463,9 +465,11 @@ namespace Contralto.IO
{
if (!_xferOff)
{
- if (_debugRead)
+ // Debugging: on a read/check, if we are overwriting a word that was never read by the
+ // microcode via KDATA, log it.
+ if (_debugRead && (((KADR & 0x00c0) >> 6) == 0 || ((KADR & 0x00c0) >> 6) == 1))
{
- //Console.WriteLine("--- missed word {0}({1}) ---", _sectorWordIndex, _kDataRead);
+ Console.WriteLine("--- missed sector word {0}({1}) ---", _sectorWordIndex, _kDataRead);
}
Log.Write(LogType.Verbose, LogComponent.DiskWordTask, "Sector {0} Word {1} read into KDATA", _sector, Conversion.ToOctal(diskWord));
@@ -645,10 +649,10 @@ namespace Contralto.IO
// $MIR0BL $177775; DISK INTERRECORD PREAMBLE IS 3 WORDS <<-- writing
// $MRPAL $177775; DISK READ POSTAMBLE LENGTH IS 3 WORDS
// $MWPAL $177773; DISK WRITE POSTAMBLE LENGTH IS 5 WORDS <<-- writing, clearly.
- private static double _scale = 1.0;
+ private static double _scale = 1.5;
private static ulong _sectorDuration = (ulong)((40.0 / 12.0) * Conversion.MsecToNsec * _scale); // time in nsec for one sector
private static int _sectorWordCount = 269 + 22 + 34; // Based on : 269 data words (+ cksums) / sector, + X words for delay / preamble / sync
- private static ulong _wordDuration = (ulong)((_sectorDuration / (ulong)(_sectorWordCount + 1)) * _scale); // time in nsec for one word
+ private static ulong _wordDuration = (ulong)((_sectorDuration / (ulong)(_sectorWordCount)) * _scale); // time in nsec for one word
private int _sectorWordIndex; // current word being read
private Event _sectorEvent;
@@ -662,7 +666,7 @@ namespace Contralto.IO
// SECLATE data.
// 8.5uS for seclate delay (approx. 50 clocks)
- private static ulong _seclateDuration = 85 * Conversion.UsecToNsec;
+ private static ulong _seclateDuration = (ulong)(85.0 * Conversion.UsecToNsec * _scale);
private bool _seclateEnable;
private bool _seclate;
private Event _seclateEvent;
diff --git a/Contralto/Logging/Log.cs b/Contralto/Logging/Log.cs
index 643d3e0..a7f0264 100644
--- a/Contralto/Logging/Log.cs
+++ b/Contralto/Logging/Log.cs
@@ -44,7 +44,7 @@ namespace Contralto.Logging
static Log()
{
// TODO: make configurable
- _components = LogComponent.None; //LogComponent.Memory; // | LogComponent.Microcode;
+ _components = LogComponent.Memory; // LogComponent.DiskController | LogComponent.DiskSectorTask;
_type = LogType.Normal | LogType.Warning | LogType.Error;
}
diff --git a/Contralto/Memory/Memory.cs b/Contralto/Memory/Memory.cs
index c436f2b..d47d6da 100644
--- a/Contralto/Memory/Memory.cs
+++ b/Contralto/Memory/Memory.cs
@@ -29,11 +29,16 @@ namespace Contralto.Memory
{
// Check for XM registers; this occurs regardless of XM flag since it's in the I/O page.
if (address >= _xmBanksStart && address < _xmBanksStart + 16)
- {
- return _xmBanks[address - _xmBanksStart];
+ {
+ return (ushort)(0xfff0 |_xmBanks[address - _xmBanksStart]);
}
else
{
+ /*
+ if (extendedMemory)
+ {
+ Log.Write(LogComponent.Memory, "Extended memory read, bank {0} address {1}, read {2}", GetBankNumber(task, extendedMemory), Conversion.ToOctal(address), Conversion.ToOctal(_mem[address + 0x10000 * GetBankNumber(task, extendedMemory)]));
+ } */
address += 0x10000 * GetBankNumber(task, extendedMemory);
return _mem[address];
}
@@ -52,6 +57,11 @@ namespace Contralto.Memory
}
else
{
+ /*
+ if (extendedMemory)
+ {
+ Log.Write(LogComponent.Memory, "Extended memory write, bank {0} address {1}, data {2}", GetBankNumber(task, extendedMemory), Conversion.ToOctal(address), Conversion.ToOctal(data));
+ } */
address += 0x10000 * GetBankNumber(task, extendedMemory);
_mem[address] = data;
}
@@ -64,7 +74,7 @@ namespace Contralto.Memory
private int GetBankNumber(TaskType task, bool extendedMemory)
{
- return extendedMemory ? _xmBanks[(int)task] & 0x3 : (_xmBanks[(int)task] & 0xc) >> 2;
+ return extendedMemory ? (_xmBanks[(int)task]) & 0x3 : ((_xmBanks[(int)task]) & 0xc) >> 2;
}
private readonly MemoryRange[] _addresses =
diff --git a/Contralto/Program.cs b/Contralto/Program.cs
index 0ec852e..a969247 100644
--- a/Contralto/Program.cs
+++ b/Contralto/Program.cs
@@ -1,11 +1,12 @@
-namespace Contralto
+using Contralto.CPU;
+
+namespace Contralto
{
class Program
{
static void Main(string[] args)
{
-
- AltoSystem system = new AltoSystem();
+ AltoSystem system = new AltoSystem();
// for now everything is driven through the debugger
Debugger d = new Debugger(system);