mirror of
https://github.com/livingcomputermuseum/ContrAlto.git
synced 2026-01-24 19:31:26 +00:00
1 line
130 KiB
Plaintext
1 line
130 KiB
Plaintext
;-----------------------------------------------------------------;
|
||
; 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;
|
||
XM0031> 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: <<mpc>+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]
|
||
XM0237> Split1: L<-T<-ONE, :Splitout0;
|
||
XM0257> Split2: L<-T<-2, :Splitout0;
|
||
XM0277> Split3: L<-T<-3, :Splitout0;
|
||
XM0317> Split4: L<-T<-4, :Splitout0;
|
||
XM0337> Split5: L<-T<-5, :Splitout0;
|
||
XM0357> Split6: L<-T<-6, :Splitout0;
|
||
XM0377> 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.
|
||
;-----------------------------------------------------------------
|
||
|
||
XM0121> Tpop0: L<-T<-stk0, IDISP, :Tpopexit;
|
||
XM0122> Tpop1: L<-T<-stk1, IDISP, :Tpopexit;
|
||
XM0123> Tpop2: L<-T<-stk2, IDISP, :Tpopexit;
|
||
XM0124> Tpop3: L<-T<-stk3, IDISP, :Tpopexit;
|
||
XM0125> Tpop4: L<-T<-stk4, IDISP, :Tpopexit;
|
||
XM0126> Tpop5: L<-T<-stk5, IDISP, :Tpopexit;
|
||
XM0127> Tpop6: L<-T<-stk6, IDISP, :Tpopexit;
|
||
XM0130> 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 <result> and
|
||
; <result+1>
|
||
; 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
|
||
XM0161> 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
|
||
XM0235> 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
|
||
|
||
XM0246> JEQnB: temp<-L RSH 1, L<-T, :JEQNEcom; temp:0, L:1 (for JEQNEcom)
|
||
XM0247> 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;
|
||
|
||
XM0251> JNEcom: L<-stkp-T-1, :JNEne; L: old stkp - 2
|
||
|
||
XM0262> JNEne: stkp<-L, IDISP, :JEQNExxx; jump, set stkp, then dispatch
|
||
XM0263> 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;
|
||
XM0274> 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
|
||
XM0265> 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)
|
||
XM0243> Jco: stkp<-L, :Jbo; carry is one (stkp<-stkp-2)
|
||
|
||
XM0270> Jnobz: L<-mpc+1, TASK, :nextAput; no jump, alignment=>nextAa
|
||
XM0271> Jbz: T<-ib, :JBx; jump
|
||
XM0272> Jbo: T<-ib, :JBx; jump
|
||
XM0273> 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 <<cp>+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 <<lp>+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 <<lp>+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 <<lp>+alpha>, push <<lp>+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 <<gp>+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 <<gp>+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 <<gp>+alpha>, push <<gp>+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;
|
||
XM0327> 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 - <<lp>+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 - <<lp>+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 - <<lp>+alpha+1><-TOS (popped), <<lp>+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 - <<gp>+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 - <<gp>+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 - <<gp>+alpha+1><-TOS (popped), <<gp>+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 - <<lp>+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 <TOS> 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 <stk0>+<stk1>
|
||
;-----------------------------------------------------------------
|
||
!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 <TOS> 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 <TOS> 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 <TOS> 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 <TOS> 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 <TOS> 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
|
||
|
||
XM0675> MULDIVret: :MULDIVret1; No divide - someday a trap
|
||
; perhaps, but garbage now.
|
||
XM0676> MULDIVret1: T<-AC1; Normal return
|
||
XM0355> L<-stkp+1;
|
||
XM0356> L<-T, SINK<-M, BUS;
|
||
XM0360> 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 <TOS-1>,,<TOS-2>/<TOS> (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 <TOS> with <TOS-1> shifted by <TOS>
|
||
; <TOS> > 0 => left shift, <TOS> < 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
|
||
XM1022> BNDCKr: SINK<-M-T, :BNDCKx; L: value, T: limit
|
||
XM0437> BNDCKx: T<-0, ALUCY, :NILCKpush;
|
||
|
||
;-----------------------------------------------------------------
|
||
; R e a d s
|
||
;-----------------------------------------------------------------
|
||
|
||
; Note: RBr must be odd!
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; Rn - TOS<-<<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<-<<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
|
||
XM0413> ReadA: stkp<-L, BUS=0, :MAStkT; to pushMDA
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; RDB - temp<-<TOS>+alpha, push <<temp>>, push <<temp>+1>, assuming:
|
||
; RDB is A-aligned (also ensures no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1514> RDB: IR<-sr30, :Popsub; returns to Dpush
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; RD0 - temp<-<TOS>, push <<temp>>, push <<temp>+1>
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1515> RD0: IR<-sr32, :Popsub; returns to RD0r
|
||
XM0072> RD0r: L<-0, :Dpusha;
|
||
|
||
;-----------------------------------------------------------------
|
||
; RILP - push <<<lp>+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 <<<gp>+alpha[0-3]>+alpha[4-7]>
|
||
;-----------------------------------------------------------------
|
||
!3,1,IPcom; shake IR<- at WILPr
|
||
|
||
XM1525> RIGP: L<-ret1, :Splitalpha; get two 4-bit values
|
||
XM0171>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 <<<lp>>>
|
||
;-----------------------------------------------------------------
|
||
!1,2,RILxB,RILxA;
|
||
|
||
XM1527> RIL0: MAR<-lp-T-1, :RILxB; fetch local 0
|
||
|
||
XM0452> RILxB: IR<-msr0, L<-0, :IPcomx; to pushMD
|
||
XM0453> RILxA: IR<-sr1, L<-sr1 AND T, :IPcomx; to pushMDA, L<-0(!)
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; RXLP - TOS<-<<TOS>+<<lp>+alpha[0-3]>+alpha[4-7]>
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1522> RXLP: L<-ret3, :Splitalpha; will return to RXLPra
|
||
XM0173> 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 - <<TOS> (popped)+n><-<TOS> (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
|
||
|
||
XM0455> 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 - <<TOS> (popped)+alpha><-<TOS-1> (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
|
||
XM1014> WSBr: T<-M, L<-T, :WSBx;
|
||
|
||
XM0477> WSBx: MAR<-ib+T, :WScom;
|
||
XM0436> WScom: temp<-L;
|
||
XM0451> WScoma: L<-stkp-1;
|
||
XM0456> MD<-temp;
|
||
XM0461> 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;
|
||
XM1015> WS0r: T<-M, L<-T, :WS0x;
|
||
|
||
XM0517> WS0x: MAR<-T, :WScom;
|
||
|
||
;-----------------------------------------------------------------
|
||
; WILP - <<lp>+alpha[0-3]>+alpha[4-7] <- <TOS> (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 - <TOS>+<<lp>+alpha[0-3]>+alpha[4-7] <- <TOS-1> (both popped)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1523> WXLP: L<-ret4, :Splitalpha; get halves of alpha
|
||
XM0174> 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+<TOS> (popped), pop into <temp>+1 and <temp>, assuming:
|
||
; WDB is A-aligned (also ensures no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1516> WDB: IR<-sr31, :Popsub; returns to Dpop
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; WD0 - temp<-<TOS> (popped), pop into <temp>+1 and <temp>
|
||
;-----------------------------------------------------------------
|
||
|
||
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
|
||
XM1020> WSDBrb: T<-M, L<-T, :WSDBx; L:high data, T:address
|
||
XM0557> WSDBx: MAR<-T<-ib+T+1; start store of low data word
|
||
XM0476> temp<-L, L<-T; temp:high data
|
||
XM0511> temp2<-L, TASK; temp2:updated address
|
||
XM0512> MD<-saveret; stash low data word
|
||
XM0513> 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
|
||
XM1032> RWBLrb: MAR<-BankReg, :RWBLxb; fetch bank register
|
||
XM0577> RWBLxb: L<-T, T<-M; T: low half, L: high half
|
||
XM0514> temp<-L; temp: high pointer
|
||
XM0516> L<-alpha+T; L: low pointer+alpha
|
||
XM0522> T<-MD; T: bank register to save
|
||
XM0524> MAR<-BankReg; reaccess bank register
|
||
XM0525> frame<-L, L<-T; frame: pointer
|
||
XM0526> taskhole<-L, TASK; taskhole: old bank register
|
||
XM0533> MD<-temp, :WBLx; set new alternate bank value
|
||
|
||
XM0607> WBLx: XMAR<-frame; start memory access
|
||
XM0534> L<-entry+1, BUS; dispatch RBL/WBL
|
||
XM0535> entry<-L, L<-T, :RBLra; (L<-T for WBLrc only)
|
||
|
||
XM0530> RBLra: T<-MD, :RWBLtail; T: data from memory
|
||
XM0531> WBLra: IR<-ret24, :BincomB; returns to WBLrb
|
||
XM1024> WBLrb: T<-M, :WBLx; T: data to write
|
||
|
||
XM0532> WBLrc: MD<-M, :RWBLtail; stash data in memory
|
||
|
||
XM0536> RWBLtail: MAR<-BankReg;
|
||
XM0551> SINK<-entry, BUS; dispatch return
|
||
XM0600> RWBLdone: MD<-taskhole, :RWBLdone; restore bank register
|
||
|
||
XM0601> RBLdone: L<-temp2+1, BUS, :pushT1B; temp2: original stkp-2
|
||
XM0603> 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 <- <TOS>+1
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1657> INC: IR<-sr14, :Popsub;
|
||
XM0054> INCr: T<-0+T+1, :pushTB;
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; NEG - TOS <- -<TOS>
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1656> NEG: L<-ret11, TASK, :Xpopsub;
|
||
XM0111> NEGr: L<-0-T, :Untail;
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; DBL - TOS <- 2*<TOS>
|
||
;-----------------------------------------------------------------
|
||
|
||
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<-<TOS> (popped), push <temp>, push <temp>
|
||
;-----------------------------------------------------------------
|
||
!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
|
||
XM1011> 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
|
||
|
||
XM1473> 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;
|
||
|
||
XM0617> STRsub: L<-stkp-1; update stack pointer
|
||
XM0554> stkp<-L;
|
||
XM0556> L<-ib+T; compute index and offset
|
||
XM0572> SINK<-M, BUSODD, TASK;
|
||
XM0574> count<-L RSH 1, :STRsubA;
|
||
|
||
XM0610> STRsubA: L<-177400, :STRsubcom; left byte
|
||
XM0611> STRsubB: L<-377, :STRsubcom; right byte
|
||
|
||
XM0576> STRsubcom: T<-temp; get string address
|
||
XM0602> MAR<-count+T; start fetch of word
|
||
XM0606> T<-M; move mask to more useful place
|
||
XM0613> SINK<-DISP, BUSODD; dispatch to caller
|
||
XM0616> mask<-L, SH<0, :RSTRrx; dispatch B/A, mask for WSTR
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; RSTR - push byte of string using base (<TOS-1>) and index (<TOS>)
|
||
; assumes RSTR is A-aligned (no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
!1,2,RSTRB,RSTRA;
|
||
|
||
XM1520> RSTR: IR<-T<-ret12, :BincomB;
|
||
XM1012> RSTRr: temp<-L, :STRsub; stash string base address
|
||
XM0614> RSTRrx: L<-MD AND T, TASK, :RSTRB; isolate good bits
|
||
|
||
XM0630> RSTRB: temp<-L, :RSTRcom;
|
||
XM0631> RSTRA: temp<-L LCY 8, :RSTRcom; right-justify byte
|
||
|
||
XM0632> RSTRcom: T<-temp, :pushTA; go push result byte
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; WSTR - pop <TOS-2> into string byte using base (<TOS-1>) and index (<TOS>)
|
||
; assumes WSTR is A-aligned (no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
!1,2,WSTRB,WSTRA;
|
||
|
||
XM1521> WSTR: IR<-T<-ret13, :BincomB;
|
||
XM1013> WSTRr: temp<-L, :STRsub; stash string base
|
||
XM0615> WSTRrx: L<-MD AND NOT T, :WSTRB; isolate good bits
|
||
|
||
XM0634> WSTRB: temp2<-L, L<-ret0, TASK, :Xpopsub; stash them, return to WSTRrB
|
||
XM0635> 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 <TOS> (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;
|
||
XM0646> RFrr: T<-mask.T, :pushTA; alignment requires pushTA
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; WF - pop data in <TOS-1> into field specified by beta in word at <TOS> (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
|
||
XM1017> WFr: newfield<-L, L<-ret0+1, :Fieldsub; (actually, L<-ret1)
|
||
|
||
XM0647> WFrr: T<-mask;
|
||
XM0643> L<-M AND NOT T; set old field bits to zero
|
||
XM0644> temp<-L; stash result
|
||
XM0645> T<-newfield.T; save new field bits
|
||
XM0650> L<-temp OR T, TASK; merge old and new
|
||
XM0651> CYCOUT<-L; stash briefly
|
||
XM0652> T<-index, BUS=0; get position, test for zero
|
||
XM0653> L<-WFretloc, :WFnzct; get return address from ROM
|
||
|
||
XM0604> WFnzct: PC<-L; stash return
|
||
XM0654> L<-20-T, SWMODE; L:remaining count to cycle
|
||
XM0655> T<-CYCOUT, :RAMCYCX; go cycle remaining amount
|
||
XM0605> WFret: MAR<-frame; start memory
|
||
XM0656> L<-stkp-1; pop remaining word
|
||
XM0660> 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
|
||
XM1016> 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
|
||
XM1021> WFSrb: newfield<-L, L<-ret0+1, BUS=0, :Fieldsub; returns quickly to WFSa
|
||
XM0663> WFSa: frame<-L; stash address
|
||
XM0665> T<-177400; to separate alpha and beta
|
||
XM0666> L<-temp AND T, T<-temp, :Getalphab; L:alpha, T:both
|
||
; returns to Fieldra
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; RFC - like RF, but uses <cp>+<alpha>+<TOS> 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 <frame> cycled left <index> 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
|
||
XM0175> Fieldrb: T<-righthalf; index for MASKTAB
|
||
XM0674> MAR<-MASKTAB+T; start fetch of mask
|
||
XM0677> T<-lefthalf+T+1; L:left-cycle count
|
||
XM0700> L<-17 AND T; mask to 4 bits
|
||
XM0701> index<-L; stash position
|
||
XM0702> L<-MD, TASK; L:mask for caller's use
|
||
XM0703> mask<-L; stash mask
|
||
XM0704> SINK<-temp2, BUS; temp2=2 <=> RFC
|
||
XM0705> T<-frame, :NotCodeSeg; get base address
|
||
XM0671> NotCodeSeg: L<-MAR<-ib+T, :StashFieldLoc; add alpha
|
||
XM0673> IsCodeSeg: XMAR<-ib+T, :DoCycle; add alpha
|
||
|
||
XM0706> StashFieldLoc: frame<-L, :DoCycle; stash updated address for WF
|
||
XM0707> DoCycle: L<-Fieldretloc; return location from RAMCYCX
|
||
XM0710> PC<-L;
|
||
XM0711> T<-MD, SWMODE; data word into T for cycle
|
||
XM0712> L<-index, :RAMCYCX; count to cycle, go do it
|
||
XM0612> Fieldrc: SINK<-temp2, BUSODD; return dispatch
|
||
XM0715> 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 <TOS> (popped)
|
||
;-----------------------------------------------------------------
|
||
!1,1,Savpcinframe; (here so ALLOCrf can call it)
|
||
; The following logically belongs here; however, because the entry point to general Xfer is
|
||
; known to the outside world, the real declaration appears in MesaROM.mu.
|
||
; !7,10,XferGT,Xfer,Mstopr,PORTOpc,LSTr,ALLOCrfr,,; return points for Savpcinframe
|
||
!1,2,doAllocTrap,XferGfz; used by XferGrf
|
||
|
||
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
|
||
XM0435> ALLOCrfr: L<-temp2, TASK, :doAllocTrap; pick up trap parameter
|
||
|
||
;
|
||
; Inform software that allocation failed
|
||
;
|
||
|
||
XM0766> doAllocTrap: ATPreg<-L; store param. to trap proc.
|
||
XM0770> T<-sAllocTrap, :Mtrap; go trap to software
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; FREE - release the frame whose address is <TOS> (popped)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1757> FREE: L<-ret10, TASK, :Xpopsub; returns to FREErx
|
||
XM0110> FREErx: frame<-L, TASK;
|
||
XM0771> IR<-sr1, :FreeSub;
|
||
XM0751> FREEr: :next;
|
||
|
||
;-----------------------------------------------------------------
|
||
; D e s c r i p t o r I n s t r u c t i o n s
|
||
;-----------------------------------------------------------------
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; DESCB - push <<gp>+gfi offset>+2*alpha+1 (masking gfi word appropriately)
|
||
; DESCB is assumed to be A-aligned (no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
|
||
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 <<TOS>+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;
|
||
XM1051> LoadgcNull: T<-sUnbound, :Stashmx; BUSODD may be pending
|
||
|
||
;
|
||
; swapped code segment, trap to software
|
||
;
|
||
XM1053> LoadgcSwap: T<-sSwapTrap, :Stashmx;
|
||
|
||
;
|
||
; destination link = 0
|
||
;
|
||
XM1047> 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;
|
||
|
||
XM1106> CheckXferTrap: L<-XTSreg, BUSODD; XTSreg[15]=1 => trap
|
||
XM1116> SINK<-DISP, BUS, :NoXferTrap; dispatch (possible) return
|
||
|
||
XM1114> NoXferTrap: XTSreg<-L RSH 1, :Xfers; reset XTSreg[15] to 0 or 1
|
||
|
||
XM1115> DoXferTrap: L<-DISP, :DoXferTrapx; tell trap handler which case
|
||
XM1113> DoXferTrapx: XTSreg<-L LCY 8, L<-T; L:trap parameter
|
||
XM1117> XTPreg<-L;
|
||
XM1120> 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
|
||
|
||
XM0431> Xfer: T<-mx; mx[14:15] is dest link type
|
||
XM1121> IR<-0, :CheckXferTrap;
|
||
XM1110> Xfers: L<-3 AND T; extract type bits
|
||
XM1122> SINK<-M, L<-T, BUS; L:dest link, branch on type
|
||
XM1123> 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
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1124> 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)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1125> Xfer1: temp<-L RSH 1; temp:ep*2+garbage
|
||
XM1145> count<-L MLSH 1; since L=T, count<-L LCY 1;
|
||
XM1146> L<-count, TASK; gfi now in 0-7 and 15
|
||
XM1147> count<-L LCY 8; count:gfi w/high bits garbage
|
||
XM1150> L<-count, TASK;
|
||
XM1151> count<-L LSH 1; count:gfi*2 w/high garbage
|
||
XM1152> T<-count;
|
||
XM1153> T<-1777.T; T:gfi*2
|
||
XM1154> MAR<-gftm1+T+1; fetch GFT[T]
|
||
XM1155> IR<-sr1, :Loadgc; pick up two word entry into
|
||
; gp and mpc
|
||
XM0145> Xfer1r: L<-temp, TASK; L:en*2+high bits of garbage
|
||
XM1156> count<-L RSH 1; count:en+high garbage
|
||
XM1157> T<-count;
|
||
XM1160> T<-enmask.T; T:en
|
||
XM1161> L<-mpc+T+1, TASK; (mpc has EV base in code seg)
|
||
XM1162> 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
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1126> Xfer2: NOP; wait for memory
|
||
XM1163> T<-MD, :Xfers;
|
||
|
||
;-----------------------------------------------------------------
|
||
; mx[14-15] = 11
|
||
; Destination link is unbound:
|
||
; mx[0-15]: passed to trap handler
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1127> 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;
|
||
XM1111> XferG: T<-count; index into entry vector
|
||
XM1165> XMAR<-cp+T; fetch of new pc and fsi
|
||
XM1166> T<-cp-1; point just before bytes
|
||
; (main loop increments mpc)
|
||
XM1167> IR<-sr1; note: does not cause branch
|
||
XM1170> L<-MD+T; relocate pc from cseg base
|
||
XM1171> T<-MD; second word contains fsi
|
||
XM1172> mpc<-L; new pc setup, ib already 0
|
||
XM1173> T<-377.T, :AllocSub; mask for size index
|
||
;
|
||
; Stash source link in new frame, establishing dynamic link
|
||
;
|
||
XM0717> XferGr: MAR<-retlinkoffset+T; T has new frame base
|
||
XM1174> L<-lpoffset+T; diddle new lp
|
||
XM1175> lp<-L; install diddled lp
|
||
XM1176> MD<-my; source link to new frame
|
||
|
||
;
|
||
; Stash new global pointer in new frame (same for local call)
|
||
;
|
||
XM1177> MAR<-T; write gp to word 0 of frame
|
||
XM1200> T<-gpoffset; offset to point at gf base
|
||
XM1201> L<-gp-T, TASK; subtract off offset
|
||
XM1202> MD<-M, :nextAdeaf; global pointer stashed, GO!
|
||
|
||
;
|
||
; Frame allocation failed - push destination link, then trap
|
||
;
|
||
; !1,2,doAllocTrap,XferGfz; (appears with ALLOC)
|
||
|
||
XM0721> XferGrf: L<-mx, BUS=0; pick up destination, test = 0
|
||
XM1203> 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
|
||
|
||
XM0767> XferGfz: L<-T, T<-ngfioffset; offset from gp to gfi word
|
||
XM1204> MAR<-gp-T; start fetch of gfi word
|
||
XM1205> count<-L LSH 1; count:4*ep+2
|
||
XM1206> L<-count-1; L:4*ep+1
|
||
XM1207> T<-gfimask; mask to save gfi only
|
||
XM1210> T<-MD.T; T:gfi
|
||
XM1211> 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 <<SD>+alpha>
|
||
;-----------------------------------------------------------------
|
||
; !1,1,KFCr; implicit in KFCr's return number (21B)
|
||
!1,1,KFCx; shake B/A dispatch (Getalpha)
|
||
; !7,1,Fetchlink; appears with Getlink
|
||
|
||
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)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1776> 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
|
||
|
||
XM1107> Stashmx: L<-mx; can't TASK, T has trap index
|
||
XM1230> OTPreg<-L, :Mtrap;
|
||
|
||
XM1232> Mtrap: T<-avm1+T+1;
|
||
XM1233> MAR<-sdoffset+T; fetch dest link for trap
|
||
XM1234> 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;
|
||
XM1112> RETxr: MAR<-nretlinkoffset+T; get previous local frame
|
||
XM1240> L<-nlpoffset+T+1;
|
||
XM1242> frame<-L; stash for 'Free'
|
||
XM1243> L<-MD; pick up prev frame pointer
|
||
XM1244> mx<-L, L<-0, IR<-msr0, TASK; mx points to caller
|
||
XM1245> 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
|
||
XM1213> 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
|
||
XM0433> 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;
|
||
XM1311> Sav11r: L<-stkp, :Savsub;
|
||
XM1310> Sav10r: T<-stkp+1;
|
||
XM1271> L<--7+T; check if stkp > 5 or negative
|
||
XM1272> L<-0+T+1, ALUCY; L:stkp+2
|
||
XM1273> temp2<-L, L<-0-T, :Savok; L:-stkp-1
|
||
|
||
XM1265> Savmax: T<--7; stkp > 5 => save all
|
||
XM1274> L<-stk7, :Savsuba;
|
||
|
||
XM1264> Savok: SINK<-temp2, BUS; stkp < 6 => save to stkp+2
|
||
XM1275> 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
|
||
|
||
XM1277> 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;
|
||
|
||
XM1333> Loadstate: temp<-L, IR<-msr0, :NovaIntrOn; stash pointer
|
||
XM1336> Lsr: T<-12, :Ldsuba;
|
||
XM1332> Lsr12: my<-L, :Ldsub;
|
||
XM1331> Lsr11: mx<-L, :Ldsub;
|
||
XM1330> Lsr10: stkp<-L;
|
||
XM1340> T<-stkp; check for BRK resumption
|
||
XM1341> L<-177400 AND T; (i.e. bytecode in stkp)
|
||
XM1342> brkbyte<-L LCY 8; stash for Xfer
|
||
XM1343> L<-T<-17.T; mask to 4 bits
|
||
XM1344> L<--7+T; check stkp > 6
|
||
XM1345> L<-T, SH<0;
|
||
XM1346> stkp<-L, T<-0+T+1, :Lsmax; T:stkp+1
|
||
XM1334> Lsmax: T<-7, :Ldsuba;
|
||
XM1327> Lsr7: stk7<-L, :Ldsub;
|
||
XM1326> Lsr6: stk6<-L, :Ldsub;
|
||
XM1325> Lsr5: stk5<-L, :Ldsub;
|
||
XM1324> Lsr4: stk4<-L, :Ldsub;
|
||
XM1323> Lsr3: stk3<-L, :Ldsub;
|
||
XM1322> Lsr2: stk2<-L, :Ldsub;
|
||
XM1321> Lsr1: stk1<-L, :Ldsub;
|
||
XM1320> Lsr0: stk0<-L, :Xfer;
|
||
|
||
XM1347> Ldsub: T<-count;
|
||
XM1335> Ldsuba: MAR<-temp+T;
|
||
XM1350> L<-ALLONES+T; decr count for next time
|
||
XM1351> count<-L, L<-T; use old value for dispatch
|
||
XM1352> SINK<-M, BUS;
|
||
XM1353> L<-MD, TASK, :Lsr0;
|
||
|
||
;-----------------------------------------------------------------
|
||
; DST - dump state at block starting at <LP>+alpha, reset stack pointer
|
||
; assumes DST is A-aligned (also ensures no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
|
||
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!
|
||
XM1312> DSTr: temp<-L, L<-0, TASK, BUS=0, :Setstkp; zap stkp, return to 'nextA'
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; LST - load state from block starting at <LP>+alpha
|
||
; assumes LST is A-aligned (also ensures no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1771> LST: L<-ib;
|
||
XM1357> temp<-L, L<-0, TASK;
|
||
XM1360> ib<-L; make Savpcinframe happy
|
||
XM1361> IR<-sr4, :Savpcinframe; returns to LSTr
|
||
XM0434> LSTr: T<-temp; get alpha back
|
||
XM1362> L<-lp+T, TASK, :Loadstate; lp already undiddled
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; LSTF - load state from block starting at <LP>+alpha, then free frame
|
||
; assumes LSTF is A-aligned (also ensures no pending branch at entry)
|
||
;-----------------------------------------------------------------
|
||
|
||
XM1772> LSTF: T<-lpoffset;
|
||
XM1363> L<-lp-T, TASK; compute frame base
|
||
XM1364> frame<-L;
|
||
XM1365> IR<-sr2, :FreeSub;
|
||
|
||
XM0752> LSTFr: T<-frame; set up by FreeSub
|
||
XM1366> L<-ib+T, TASK, :Loadstate; get state from dead frame
|
||
|
||
;-----------------------------------------------------------------
|
||
; E m u l a t o r A c c e s s
|
||
;-----------------------------------------------------------------
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; RR - push <emulator register alpha>, where:
|
||
; RR is A-aligned (also ensures no pending branch at entry)
|
||
; alpha: 1 => wdc, 2 => XTSreg, 3 => XTPreg, 4 => ATPreg,
|
||
; 5 => OTPreg
|
||
;-----------------------------------------------------------------
|
||
!1,1,DoRamRWB; shake B/A dispatch (BLTL)
|
||
|
||
XM1775> RR: L<-0, SWMODE, :DoRamRWB;
|
||
XM1367> DoRamRWB: SINK<-M, BUS, L<-T, :ramOverflow; L<-T for WR
|
||
|
||
|
||
;-----------------------------------------------------------------
|
||
; WR - emulator register alpha <- <TOS> (popped), where:
|
||
; WR is A-aligned (also ensures no pending branch at entry)
|
||
; alpha: 1 => wdc, 2 => XTSreg
|
||
;-----------------------------------------------------------------
|
||
|
||
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; <HardMRE> ~= 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)
|
||
XM1543> 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)
|
||
XM1555> MErr: T<-0+1, :FastEEtrap1; L:0, T:1 (stkp value)
|
||
XM1556> MRErr: L<-0+1, TASK, :FastEEtrap2; L:1 (stkp value)
|
||
|
||
XM1545> MEXDdone: MD<-M, L<-T, TASK, :Setstkp;
|
||
|
||
XM1551> 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"
|
||
|
||
XM0714> BITBLTdone: IR<-sr1, :NovaIntrOn; ensure Nova interrupts are on
|
||
XM1337> BITBLTdoner: brkbyte<-L, BUS=0, TASK, :Setstkp; don't bother to validate stkp
|
||
|
||
XM0713> BITBLTintr: L<-AC1, SWMODE; pick up intermediate state
|
||
XM1572> 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 *** |