; IfsXEmulator.mu -- Extended Bcpl Emulator ; Copyright Xerox Corporation 1980, 1981 ; Last modified May 3, 1981 2:57 PM by Taft ; Derived from ALTOIICODE3.MU, as last modified by Boggs, November 28, 1977 ;Get the symbol and constant definitions ;#AltoConsts23.mu; ;LABEL PREDEFINITIONS ;The reset locations of the tasks: ;!17,20,NOVEM,,,,,,,,,,,,,,,; ;Locations which may need to be accessible from the Ram, or Ram ; locations which are accessed from the Rom (TRAP1): ;!37,20,START,RAMRET,RAMCYCX,,,,,,,,,,,,,TRAP1; ;Macro-op dispatch table for ACSOURCE with IR[5-7] # 1 or 5 !37,20,DOINS,DOIND,EMCYCLE,NOPAR,JSRII,,U6,U7,,,,,,,RAMTRAP,TRAP; ;Parameterless macro-op sub-table: ;!37,40,DIR,EIR,BRI,RCLK,SIO,BLT,BLKS,SIT,JMPR,RDRM,WTRM,DIRS,VERS,DREAD,DWRITE,DEXCH,MUL,DIV,DIOG1,DIOG2,BITBLT,XMLDA,XMSTA,,,,,,,,,; ;some global R-Registers $NWW $R4; State of interrupt system $R37 $R37; Used by MRT, interval timer and EIA $MTEMP $R25; Public temporary R-Register ;NOVA EMULATOR $SAD $R5; $PC $R6; USED BY MEMORY INIT ;REGISTERS USED BY NOVA EMULATOR $AC0 $R3; AC'S ARE BACKWARDS BECAUSE THE HARDWARE SUPPLIES THE $AC1 $R2; COMPLEMENT ADDRESS WHEN ADDRESSING FROM IR $AC2 $R1; $AC3 $R0; $XREG $R7; ;PREDEFINITIONS FOR NOVA !17,20,GETAD,G1,G2,G3,G4,G5,G6,G7,G10,G11,G12,G13,G14,G15,G16,G17; !17,20,XCTAB,XJSR,XISZ,XDSZ,XLDA,XSTA,CONVERT,,,,,,,,,; !3,4,SHIFTX,SH1,SH2,SH3; !1,2,MAYBE,NOINTR; !1,2,DOINT,DIS0; !1,2,SOMEACTIVE,NOACTIVE; !1,2,IEXIT,NIEXIT; !7,1,INTCODE; !3,4,StoreXRet0,StoreXRet1,StoreXRet2; ; new runtime routines, and routines for extended JSR3XX instructions. ; Note: RUxxx labels are attached to otherwise unconstrained instructions ; so as to fill up the Ram Utility area with emulator microcode. XReturn: MAR_ 177740; Zero bank bits RU774: TASK; RU775: MD_ 0, :Return; XFrame: XMAR_ AC3; Start fetch of frame size RU776: L_ -3, :GetF1; 3 extra words Finish: L_ 24, :XEmulatorTrap; 377-24 = 353 Abort: L_ 23, :XEmulatorTrap; 377-23 = 354 ; Call Bcpl Runtime routine at @(377-L). ; Precisely: store the extended PC in trapXJmp and trapXPC, then ; simulate a JSR @(377-L) executed at trapXJmp-1. XEmulatorTrap: SAD_ L; RU777: IR_ 2, :StoreTrapXPC; Store extended PC in 631, 632 StoreXRet2: L_ PC; Pretend the call was a JSR RU1000: AC3_ L; RU1001: T_ SAD; RU1002: MAR_ 377-T; Fetch runtime dispatch StartMD: T_ IR_ 0, :LongJ1; PC_ MD and go to START in ROM ; ObjCall instruction -- implements the Calls mechanism. ; Executes JMP @(AC0+DISP) ; Note that unlike the standard Calls mechanism, this operation ; enters the called procedure at instruction 0 rather than 1, and ; without having clobbered AC3. ObjCall: T_ DISP; RU1003: MAR_ AC0+T, :StartMD; ; STA3JSRI instruction -- combines the effects of: ; STA 3 1 2 ; JSR @DISP ; (page zero indirect) ; Precisely: AC2!1 _ AC3; AC3 _ PC+1; PC _ @DISP ; This is used for entering the IfsOverlays package fault routine. STA3JSRI: MAR_ AC2+1; L_ PC; Already incremented MD_ AC3; MAR_ DISP; AC3_ L, :StartMD; ;Xjmp0-3 jump to the extended emulator; the low two bits say which bank. ; Note: XJmp0 is defined only for symmetry -- running the extended emulator ; in bank 0 is totally illegal! Xjmp0: :TRAP1X; Xjmp1: MAR_ 177740, :Xjmp3a; Xjmp2: MAR_ 177740, :Xjmp3a; Xjmp3: MAR_ 177740; Xjmp3a: L_ DISP, L_ lgm3; MD_ M; MAR_ PC; NOP; L_ MD, TASK, :FINJMPX; ; GetNextChar instruction ; AC0 points to even-word aligned Character Stream Descriptor: ; structure CSD: [ oddByte bit; byteCount bit 15; wordAddress word ] ; DISP=0 just fetches next character. ; DISP=140 also converts lower-case to upper-case if alphabetic. ; Returns +1: stream exhausted ; +2: AC1 contains next character ! 1, 2, ~Exhausted, Exhausted; ! 1, 2, GLeft, GRight; ! 1, 2, GCheckAlpha, GNCExit; ! 1, 2, ~LCAlpha?, LCAlpha?; ! 1, 2, LCAlpha, ~LCAlpha; GetNextChar: MAR_ AC0; T_ 77777; L_ MD AND T, T_ MD; MD = Byte flag and count L_ MD+1, SH=0; MD = Word address MAR_ AC0, :~Exhausted; [~Exhausted, Exhausted] ~Exhausted: SAD_ L; Word address +1 L_ 77777+T; Decrement count and flip byte flag MD_ M, L_ T; MAR_ SAD-1, SH<0; Fetch word containing byte T_ 377, :GLeft; [GLeft, GRight] GLeft: L_ DISP; L_ MD AND NOT T, SH=0, TASK; Left byte, flip to right AC1_ L LCY 8, :GCheckAlpha; [GCheckAlpha, GNCExit] GRight: L_ MD . T; Right byte, mask it MAR_ AC0+1; Store incremented word address AC1_ L; SINK_ DISP, BUS=0, TASK; MD_ SAD, :GCheckAlpha; [GCheckAlpha, GNCExit] GNCExit: L_ PC+1, TASK, :Start2; Skip next instruction Exhausted: L_ PC, TASK, :Start2; Execute next instruction GCheckAlpha: T_ AC1; The data byte L_ DISP-T; 140 - byte T_ M, SH<0; Lower-case alpha in [141..172] L_ 31+T+1, :~LCAlpha?; [~LCAlpha?, LCAlpha?] LCAlpha?: T_ AC1, SH<0; L_ 177740+T, :LCAlpha; [LCAlpha, ~LCAlpha] LCAlpha: AC1_ L; Return upper-case equivalent ~LCAlpha: L_ PC+1, TASK, :Start2; ~LCAlpha?: L_ PC+1, TASK, :Start2; ;Extended Emulator Macro-op dispatch table: (ACSOURCE for IR[5-7] = 1 or 5) !37,20,DOINSX,DOINDX,,,JSRIIX,U5X,,,,,,,,,RAMTRAPX,; ;** !1,2,StartXOK,StartXBad; ; ALL INSTRUCTIONS RETURN TO StartX WHEN DONE ; ********** ; For debugging: trap if we ever find ourselves executing in bank 0 ;** StartX: ;** MAR_ 177740; ;** T_ 3; ;** L_ MD AND T; ;** L_ 37, SH=0; ; ********** StartX: T_ XMAR_PC+SKIP, :StartXOK; [StartXOK, StartXBad] StartXOK: L_ NWW, BUS=0; BUS# 0 MEANS DISABLED OR SOMETHING TO DO :MAYBE, SH<0, L_ 0+T+1; SH<0 MEANS DISABLED MAYBE: PC_ L, L_ T, :DOINT; NOINTR: PC_ L, :DIS0; DOINT: MAR_ WWLOC, :INTCODE; TRY TO CAUSE AN INTERRUPT ;DISPATCH ON FUNCTION FIELD IF ARITHMETIC INSTRUCTION, ;OTHERWISE ON INDIRECT BIT AND INDEX FIELD DIS0: L_ T_ IR_ MD; SKIP CLEARED HERE ;DISPATCH ON SHIFT FIELD IF ARITHMETIC INSTRUCTION, ;OTHERWISE ON THE INDIRECT BIT OR IR[3-7] DIS1: T_ ACSOURCE, :GETAD; ;GETAD MUST BE 0 MOD 20 GETAD: T_ 0, :DOINS; PAGE 0 G1: T_ PC -1, :DOINSX; RELATIVE G2: T_ AC2, :DOINS; AC2 RELATIVE G3: T_ AC3, :DOINS; AC3 RELATIVE G4: T_ 0, :DOINS; PAGE 0 INDIRECT G5: T_ PC -1, :DOINSX; RELATIVE INDIRECT G6: T_ AC2, :DOINS; AC2 RELATIVE INDIRECT G7: T_ AC3, :DOINS; AC3 RELATIVE INDIRECT G10: L_ 0-T-1, TASK, :SHIFTX; COMPLEMENT G11: L_ 0-T, TASK, :SHIFTX; NEGATE G12: L_ 0+T, TASK, :SHIFTX; MOVE G13: L_ 0+T+1, TASK, :SHIFTX; INCREMENT G14: L_ ACDEST-T-1, TASK, :SHIFTX; ADD COMPLEMENT G15: L_ ACDEST-T, TASK, :SHIFTX; SUBTRACT G16: L_ ACDEST+T, TASK, :SHIFTX; ADD G17: L_ ACDEST AND T, TASK, :SHIFTX; AND SHIFTX: DNS_ L LCY 8, :StartX; SWAP BYTES SH1: DNS_ L RSH 1, :StartX; RIGHT 1 SH2: DNS_ L LSH 1, :StartX; LEFT 1 SH3: DNS_ L, :StartX; NO SHIFT DOINS: L_ DISP + T, TASK, :SAVAD, IDISP; DIRECT INSTRUCTIONS DOIND: L_ MAR_ DISP+T; INDIRECT INSTRUCTIONS DOIND1: XREG_ L; L_ MD, TASK, IDISP; SAVAD: SAD_ L, :XCTAB; ;JSRII - 64400 - JSR double indirect, PC relative. Must have X=1 in opcode JSRIIX: XMAR_ DISP+T, :JSRII1; FIRST LEVEL ;JSRIS - 65000 - JSR double indirect, AC2 relative. Must have X=2 in opcode JSRII: MAR_ DISP+T; FIRST LEVEL JSRII1: IR_ JSRCX; T_ MD, :DOIND; THE IR_ INSTRUCTION WILL NOT BRANCH ;TRAP ON UNIMPLEMENTED OPCODES. SAVES PC AT ;TRAPPC, AND DOES A JMP@ TRAPVEC ! OPCODE. TRAP: XREG_ L LCY 8; THE INSTRUCTION TRAP1X: IR_ ONE; Return index StoreTrapXPC: L_ 631, :StoreExtendedPC; Store in 631-632 StoreXRet1: SWMODE; :TRAP1; ;***X21 CHANGE: ADDED TAG RAMTRAP RAMTRAP: :TRAP; EMCYCLE: :TRAP; NOPAR: :TRAP; U6: :TRAP; U7: :TRAP; CONVERT: :TRAP; ; ********** ; Here to trap if started to execute instruction in bank 0. ; L = TrapVec offset to use (37, for opcode 77400); T = PC. ;** StartXBad: ;** XREG_ L, L_ T, TASK; ;** PC_ L, :TRAP1X; ; ********** %301,1777,1476, UTILJSR,JSR0XX,,JSR1XX,,JSR2XX,,JSR3XX; ;REGJSR is #77 of the runtime dispatch table, i.e.: ;!377,1, REGJSR; binary xx11111111 FINJSR: L_ PC, SH<0, :JSR0XX; here after _DISP, BUS JSR0XX: XMAR_ PC, :REGJSR; JSR1XX: XMAR_ PC, :REGJSR; JSR2XX: XMAR_ PC, :REGJSR; here also if JSR3XX and sign-extended JSR3XX: SINK_ DISP, SINK_ disp.377, BUS, :UTILJSR; [UTILJSR, JSR0XX] UTILJSR: AC3_ L, :Lq0.6; dispatch on low six bits REGJSR: T_ AC2 -1; T gets AC2-1 L_ MD; L gets NumArgs T_ MAR_ -4 +T+1; T and MAR get AC2-4 T_ 0 +T+1; T gets AC2-3 MD_ M; store NumArgs in -4,AC2 L_ ALLONES +T; L gets AC2-4 AC3_ L, MAR_ 0 +T+1; AC3 gets AC2-4, MAR gets AC2-2 L_ PC +1, TASK; L gets XPC+1 MD_ M, :XCTAB; store XPC+1 in -2,AC2 ; Zero bank bits and jump to SAD in bank 0 ; extended relative instructions !17,20,XCTABX,XJSRX,XISZX,XDSZX,XLDAX,XSTAX,CONVERTX,,,,,,,,,; !1,2,FINST1,INCPCX; U5X: :TRAP; RAMTRAPX: :TRAP; CONVERTX: :TRAP; DOINSX: L_ DISP + T, TASK, :SAVADX, IDISP; DIRECT INSTRUCTIONS DOINDX: L_ XMAR_ DISP+T, :DOIND1; INDIRECT INSTRUCTIONS (+CONVERT) SAVADX: SAD_ L, :XCTABX; XCTABX: L_ SAD, TASK, :FINJMPX; JMP XISZX: XMAR_ SAD, :ISZ1X; ISZ XDSZX: XMAR_ SAD, :DSZ1X; DSZ XLDAX: XMAR_ SAD, :FINLOAD; LDA 0-3 XSTAX: XMAR_ SAD, :XSTA1; /*NORMAL FINJMPX: PC_ L, :StartX; DSZ1X: T_ ALLONES, :FINISZX; ISZ1X: T_ ONE, :FINISZX; FINISZX: L_ MD+T; XMAR_ SAD; SH=0, :FINSTO; INCPCX: MD_ SAD, :INCPC1; ; JSR .+n -- allocate a n-1 word long string in the (extended) frame ; DISP = n, AC3 = PC = ., SAD = .+n !1, 2, SomeStrings, NoStrings; !1, 2, MoreStrings, EndStrings; !1, 2, NextString, FoundString; !1, 2, NoStringOv, StringOv; !1, 2, MoreCopyString, EndCopyString; XJSRX: MAR_ T_ AC2-1; Fetch frame!stackBottom L_ T_ -4+T+1; T_ lv (frame!xArgs) AC3_ L; L_ MD-T, T_ MD; See if there is a frame!stringList word L_ T, SH=0, TASK; Fetch frame!stringList XH_ L, :SomeStrings; [SomeStrings, NoStrings] XH_ stackBottom ; Search existing string list for this string. AC3 = previous string SomeStrings: MAR_ T_ AC3-1, :NextString1; Fetch string!nextOffset NextString: MAR_ T_ AC3-1; NextString1: NOP; L_ T_ MD+T+1, BUS=0; T_ next string in list; MD=0 if no more MAR_ -2+T, :MoreStrings; [MoreStrings, EndStrings] Fetch string!callPC MoreStrings: AC3_ L; T_ PC; L_ MD-T; Same call PC? SH=0, TASK; :NextString; [NextString, FoundString] ; AC3 points to the correct string in the frame. ; Finish by jumping around the string in the code. FoundString: L_ SAD, TASK, :FINJMPX; ; No string list at all. AC3 = lv (frame!xArgs) = XH = stackBottom NoStrings: T_ DISP+1, :EndStrings1; Need to extend stack by string length +3 ; String not found in string list. AC3 = last string = (XH = stackBottom)+2 EndStrings: T_ DISP; Need to extend stack by string length +2 EndStrings1: MAR_ 335; Fetch stackMin L_ XH-T-1; New stackBottom T_ M; L_ MD-T; Check for stack overflow MAR_ AC2-1, ALUCY; Begin to store new stackBottom L_ T, T_ 2, :NoStringOv; [NoStringOv, StringOv] NoStringOv: MD_ M, L_ M+T; L_ stackBottom+2 = new string MAR_ T_ AC3-1; Store new offset in previous string!nextOffset L_ M-T-1, T_ M; L_ offset (negative), T_ new string MD_ M, L_ T, TASK; AC3_ L; AC3_ new string MAR_ L_ AC3-1; newString!nextOffset _ 0 to terminate list T_ DISP-1; T_ string length in words XH_ L, L_ T, MD_ 0; XH_ newString-1 MAR_ XH-1; newString!callPC _ PC XREG_ L, TASK; XREG_ string length MD_ PC; ; Copy string from code to frame, using PC as source and XH+1 as destination. ; XREG = length of string in words. CopyString: XMAR_ T_ PC; L_ XREG-1, BUS=0; XREG_ L, L_ 0+T+1, :MoreCopyString; [MoreCopyString, EndCopyString] MoreCopyString: PC_ L; T_ MD; MAR_ L_ XH+1; XH_ L, L_ T, TASK; MD_ M, :CopyString; ; AC3 points to the correct string in the frame. ; Finish by jumping around the string in the code. EndCopyString: L_ SAD, TASK, :FINJMPX; ; Allocating new string would overflow the stack. Call trap routine StringOv: L_ 0, :XEmulatorTrap; Trap to @377 ;MAIN INSTRUCTION TABLE. GET HERE: ; (1) AFTER AN INDIRECTION ; (2) ON DIRECT INSTRUCTIONS XCTAB: MAR_ 177740, :FINJMP; JMP -- zero the bank bits XJSR: L_ DISP, BUS, :FINJSR; JSR XISZ: MAR_ SAD, :ISZ1; ISZ XDSZ: MAR_ SAD, :DSZ1; DSZ XLDA: MAR_ SAD, :FINLOAD; LDA 0-3 XSTA: MAR_ SAD; /*NORMAL XSTA1: L_ ACDEST, :FINSTO; /*NORMAL DSZ1: T_ ALLONES, :FINISZ; ISZ1: T_ ONE, :FINISZ; FINSTO: SAD_ L,TASK, :FINST1; [FINST1, INCPCX] FINST1: MD_SAD, :StartX; FINLOAD: NOP; LOADX: L_ MD, TASK; LOADD: ACDEST_ L, :StartX; FINISZ: L_ MD+T; MAR_ SAD, SH=0, :FINSTO; INCPC1: L_ PC+1, TASK, :FINJMPX; FINJMP: L_ SAD, TASK; PC_ L, MD_ 0, :Start3; ;INTERRUPT SYSTEM. INTCODE: PC_ L, IR_ 0; T_ NWW; T_ MD OR T; L_ MD AND T; SAD_ L, L_ T, SH=0; SAD HAD POTENTIAL INTERRUPTS NWW_ L, L_0+1, :SOMEACTIVE; NWW HAS NEW WW NOACTIVE: MAR_ WWLOC; RESTORE WW TO CORE L_ SAD; AND REPLACE IT WITH SAD IN NWW MD_ NWW, TASK; NWW_ L, :StartX; (Originally labeled INTZ) SOMEACTIVE: L_ 630-1, :StoreExtendedPC; Store in 627-630 (DISP=0 here) StoreXRet0: MAR_ PCLOC; STORE PC AND SET UP TO FIND HIGHEST PRIORITY REQUEST L_ 0+1; XREG_ L, L_ 0; MD_ PC, TASK; ILPA: PC_ L; T_ SAD; (Originally labeled ILP) L_ XREG AND T, T_ XREG; SH=0, L_ T, T_ PC; :IEXIT, XREG_ L LSH 1; NIEXIT: L_ 0+T+1, TASK, :ILPA; IEXIT: MAR_ PCLOC+T+1; FETCH NEW PC. T HAS CHANNEL #, L HAS MASK T_ M; L_ NWW XOR T; TURN OFF BIT IN WW FOR INTERRUPT ABOUT TO HAPPEN T_ MD; NWW_ L, L_ T; PC_ L, L_ T_ 0+1, TASK; SAD_ L MRSH 1; SAD_ 1B5 TO DISABLE INTERRUPTS MAR_ WWLOC; RESTORE WW TO CORE L_ SAD; AND REPLACE IT WITH SAD IN NWW MD_ NWW, TASK; NWW_ L, :Start3; ; Subroutine to store extended PC and switch to bank 0. ; L has address of XJMP cell (XPC is XJMP+1). ; Does a return branch on DISP. StoreExtendedPC: MAR_ M+1; Start store of XPC T_ sr10-1; sr10 = 64024 MD_ PC; MAR_ 177740; Start fetch of bank register T_ 27 +T+1; 64053 T_ MD +T+1; 64034 + bank bits (high 12 bits are ones) MAR_ M; Start store of XJMP PC_ L, L_ T, TASK; PC_ address of XPC cell MD_ M; MAR_ 177740; Zero bank bits SINK_ DISP, BUS, TASK; MD_ 0, :StoreXRet0;