From 7760907dff3f1169bec8aa906660d714d2bdca9e Mon Sep 17 00:00:00 2001 From: Neil Webber Date: Mon, 4 Sep 2023 12:49:58 -0500 Subject: [PATCH] First release --- boot.py | 45 +++ branches.py | 61 ++++ interrupts.py | 246 +++++++++++++ kl11.py | 192 ++++++++++ kw11.py | 66 ++++ machine.py | 969 ++++++++++++++++++++++++++++++++++++++++++++++++++ mmio.py | 289 +++++++++++++++ mmu.py | 561 +++++++++++++++++++++++++++++ op00.py | 325 +++++++++++++++++ op000.py | 133 +++++++ op07.py | 224 ++++++++++++ op10.py | 60 ++++ op4.py | 226 ++++++++++++ pdptests.py | 737 ++++++++++++++++++++++++++++++++++++++ pdptraps.py | 70 ++++ rp.py | 317 +++++++++++++++++ unibus.py | 74 ++++ 17 files changed, 4595 insertions(+) create mode 100644 boot.py create mode 100644 branches.py create mode 100644 interrupts.py create mode 100644 kl11.py create mode 100644 kw11.py create mode 100644 machine.py create mode 100644 mmio.py create mode 100644 mmu.py create mode 100644 op00.py create mode 100644 op000.py create mode 100644 op07.py create mode 100644 op10.py create mode 100644 op4.py create mode 100644 pdptests.py create mode 100644 pdptraps.py create mode 100644 rp.py create mode 100644 unibus.py diff --git a/boot.py b/boot.py new file mode 100644 index 0000000..e615aa1 --- /dev/null +++ b/boot.py @@ -0,0 +1,45 @@ +def boot_hp(p, addr=0o10000): + # this is the sort of thing that would be keyed in from + # the console switches (if the machine was not equipped + # with a boot rom option to hold it instead) + # + # It is a minimalist program, with lots of assumptions, to read 1K + # from block zero of drive 0 into location 0. The execution start + # at zero is done elsewhere. + # + # NOTE WELL: THIS ASSUMES THE MACHINE IS IN RESET CONDITION WHICH + # MEANS MANY OF THE DEVICE REGISTERS ARE KNOWN TO BE ZERO + # + # MOV #176704,R0 -- note how used + # MOV #177000,-(R0) -- word count - read 1K though boot really 512 + # MOV #071,-(R0) -- go! + program_insts = ( + 0o012700, # MOV #0176704,R0 + 0o176704, + 0o012740, # MOV #177000,-(R0) + 0o177000, + 0o012740, # MOV #071, -(R0) + 0o000071, + 0o0, # HALT + ) + + for o, w in enumerate(program_insts): + p.physRW(addr + o + o, w) + + return addr + + +if __name__ == "__main__": + import time + from machine import PDP1170 + p = PDP1170(loglevel='INFO') + pc = boot_hp(p) + print("starting PDP11; telnet/nc to localhost:1170 to connect to console") + print("There will be no prompt; type 'boot' to start boot program") + p.run(pc=pc) + # technically need to confirm the drive is RDY, i.e., the read + # completed, but using a delay is a lot simpler and works fine. + # In real life, humans would have manipulated console switches to + # start execution at location 0, which is also a source of delay. :) + time.sleep(0.05) + p.run(pc=0) diff --git a/branches.py b/branches.py new file mode 100644 index 0000000..62badd4 --- /dev/null +++ b/branches.py @@ -0,0 +1,61 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# keyed by masked "base code" (upper byte), not shifted +brconds = { + # NOTE: 000400 case is handled in op000 dispatch separately + # 0o000400: lambda n, z, v, c: True, # BR + 0o001000: lambda n, z, v, c: not z, # BNE + 0o001400: lambda n, z, v, c: z, # BEQ + 0o100000: lambda n, z, v, c: not n, # BPL + 0o100400: lambda n, z, v, c: n, # BMI + 0o102000: lambda n, z, v, c: not v, # BVC + 0o102400: lambda n, z, v, c: v, # BVS + 0o103000: lambda n, z, v, c: not c, # BCC + 0o103400: lambda n, z, v, c: c, # BCS + + # CAUTION: Python XOR ("^") is bitwise; hence bool() != for ^ + 0o002000: lambda n, z, v, c: bool(n) == bool(v), # BGE + 0o002400: lambda n, z, v, c: bool(n) != bool(v), # BLT + 0o003000: lambda n, z, v, c: (bool(n) == bool(v)) and not z, # BGT + 0o003400: lambda n, z, v, c: (bool(n) != bool(v)) or z, # BLE + + + 0o101000: lambda n, z, v, c: not (c or z), # BHI + 0o101400: lambda n, z, v, c: c or z, # BLOS + + # NOTE: These two are the same as BCC/BCS respectively + # 0o103000: lambda n, z, v, c: not c, # BHIS + # 0o103400: lambda n, z, v, c: c, # BLO +} + + +def branches(cpu, inst): + branch(cpu, inst, brconds[inst & 0o177400]) + + +def branch(cpu, inst, condition): + if condition(cpu.psw_n, cpu.psw_z, cpu.psw_v, cpu.psw_c): + offset = (inst & 0o377) * 2 + if offset >= 256: # i.e., was a negative 8-bit value + offset -= 512 + cpu.r[7] = cpu.u16add(cpu.r[7], offset) diff --git a/interrupts.py b/interrupts.py new file mode 100644 index 0000000..fd869d4 --- /dev/null +++ b/interrupts.py @@ -0,0 +1,246 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from collections import namedtuple +from functools import partial +import threading + +from pdptraps import PDPTrap + + +# an interrupt is, at the cpu implementation level, just a flavor of trap. +class InterruptTrap(PDPTrap): + def __init__(self, pri, vector): + super().__init__() + self.pri = pri + self.vector = vector + + +# contains the details for a pending interrupt (see discussion) +PendingInterrupt = namedtuple( + 'PendingInterrupt', ('pri', 'vector', 'callback')) + + +# To cause an interrupt, a device creates a PendingInterrupt containing: +# pri -- priority +# vector -- the interrupt vector +# callback -- see discussion +# +# and then calls pend_interrupt() to get things going. +# +# The interrupt does not, of course, occur right away; it pends until +# the processor is willing to accept it. The processor only accepts +# interrupts at instruction boundaries, and even then only if the current +# processor priority level is below the interrupt pri. +# +# When those conditions occur, the interrupt is accepted by the processor +# (via a get_pending() method called from the processor). At that time the +# interrupt request is "granted" and the callback function, if any is +# provided, is invoked (from the cpu thread). +# +# The callback is invoked with no arguments and the return value is ignored. +# Use partial() or other python techniques if the callback function requires +# arguments for more context information (most will not). +# +# The purpose of this callback protocol is that some devices have internal +# operations they want to perform when the interrupt is acknowledged, not +# just when it is first made pending. Callbacks allow for that to happen. +# CAUTION: The callback obviously executes in a separate thread and +# will be asynchronous to any device-internal threads. +# +# In the simplest/common cases where none of this is needed, the +# method simple_irq() bundles all this minutia up for the caller. + +class InterruptManager: + def __init__(self): + self.pri_pending = 0 + self.requests = [] + self.condition = threading.Condition() + + def simple_irq(self, pri, vector): + """Pend an interrupt at the given pri/vector.""" + self.pend_interrupt(PendingInterrupt(pri, vector, callback=None)) + + def pend_interrupt(self, irq): + """Pend a request for interrupt 'irq'.""" + with self.condition: + # special case to accelerate zero-to-one common transition + if not self.requests: + self.requests = [irq] + self.pri_pending = irq.pri + else: + # multiple identical requests are not pended + # (it works this way in the hardware too of course -- + # if a device has asserted the interrupt request line + # but that request hasn't been acknowledged/cleared by + # by the bus signal protocol yet, you can't assert the + # same interrupt line again ... it's already asserted) + if irq not in self.requests: + self.requests = sorted( + self.requests + [irq], key=lambda q: q.pri) + self.pri_pending = self.requests[-1].pri + self.condition.notify_all() + + # called by the processor, to get one pending interrupt (if any). + # An InterruptTrap with the highest priority is returned, IF it is + # above the given processor priority. Else None. + def get_pending(self, processor_pri): + """Returns an InterruptTrap, or None.""" + with self.condition: + try: + if self.pri_pending > processor_pri: + irq = self.requests.pop() + else: + return None + except IndexError: + return None + else: + if self.requests: + self.pri_pending = self.requests[-1].pri + else: + self.pri_pending = 0 + + if irq.callback: + irq.callback() + return InterruptTrap(irq.pri, irq.vector) + + def waitstate(self, processor_pri): + """Sit idle until any interrupt happens.""" + with self.condition: + if self.pri_pending > processor_pri: + return + self.condition.wait_for(lambda: self.pri_pending) + + +if __name__ == "__main__": + import unittest + + class TestMethods(unittest.TestCase): + def test__init__(self): + IM = InterruptManager() + + # initial state starts with no pending interrupts + self.assertEqual(IM.pri_pending, 0) + + # verify get_pending still "works" (returns None) + self.assertEqual(IM.get_pending(0), None) + + def test_queue1(self): + IM = InterruptManager() + test_pri = 4 # arbitrary + test_vec = 17 # arbitrary + IM.simple_irq(test_pri, test_vec) + self.assertEqual(IM.pri_pending, test_pri) + iinfo = IM.get_pending(0) + self.assertEqual(IM.pri_pending, 0) + self.assertEqual(iinfo.pri, test_pri) + self.assertEqual(iinfo.vector, test_vec) + + # support function for test cases, do a bunch of actions on an IM + def _actions(self, IM, prog): + cpupri = 0 + for action in prog: + match action[0], action[1]: + case 'RQ', t: + IM.simple_irq(*t) + case 'PRI', cpupri: + pass + case 'GET', xt: + t = IM.get_pending(cpupri) + if t is None: + self.assertEqual(t, xt) + else: + xpri, xvec = xt + # If the vector position is a tuple then that + # means to accept anything in that tuple + try: + _ = (t.vector in xvec) + except TypeError: + pass + else: + xvec = t.vector # i.e., it's ok + self.assertEqual(t.pri, xpri) + self.assertEqual(t.vector, xvec) + case 'CHK', pri: + self.assertEqual(IM.pri_pending, pri) + + case _: + raise ValueError("bad action", action) + + def test_mixedops(self): + testprogs = ( + # (ACTION, ACTION-INFO) + (('RQ', (4, 44)), # request IRQ 4 + ('RQ', (5, 55)), # request IRQ 5 + ('GET', (5, 55)), # get one, check that it is 5 + ('CHK', 4), # check that pri_pending is 4 + ('RQ', (3, 33)), # request IRQ 3 + ('CHK', 4), # check that pri_pending is 4 + ('RQ', (6, 66)), # request IRQ 6 + ('CHK', 6), # check that pri_pending is 6 + ('GET', (6, 66)), # get one, check that it is 6 + ('CHK', 4), # check that pri_pending is 6 + ('GET', (4, 44)), # get one, check that it is 4 + ('CHK', 3), # check that pri_pending is 3 + ('GET', (3, 33)), # get one, check that it is 3 + ('CHK', 0), # check that pri_pending is 0 + ('GET', None), # check that getting from empty works + ), + + # check priority filtering + (('RQ', (4, 44)), # request IRQ 4 + ('RQ', (5, 55)), # request IRQ 5 + ('PRI', 7), # spl7 + ('GET', None), # shouldn't see anything + ('PRI', 5), # spl5 + ('GET', None), # still shouldn't see anything + ('RQ', (6, 66)), # request IRQ 6 + ('RQ', (7, 77)), # request IRQ 7 + ('RQ', (6, 666)), # request IRQ 6 + ('RQ', (7, 777)), # request IRQ 7 + ('PRI', 6), # spl6 + ('GET', (7, (77, 777))), # should get one of these + ('GET', (7, (77, 777))), # should get the other + ('GET', None), # no more + ('PRI', 0), # spl0 + ('GET', (6, (66, 666))), # should get one of these + ('GET', (6, (66, 666))), # should get one of these + ('GET', (5, 55)), + ('GET', (4, 44)), + ('GET', None)), + ) + for tp in testprogs: + IM = InterruptManager() + self._actions(IM, tp) + + def test_vectorcallback(self): + def foo(d): + d['foo'] = 1234 + + foodict = {} + pfoo = partial(foo, foodict) + IM = InterruptManager() + IM.pend_interrupt(PendingInterrupt(4, 888, pfoo)) + iinfo = IM.get_pending(0) + self.assertEqual(foodict['foo'], 1234) + + unittest.main() diff --git a/kl11.py b/kl11.py new file mode 100644 index 0000000..b8ad643 --- /dev/null +++ b/kl11.py @@ -0,0 +1,192 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# simulation of a KL-11 console interface +# +# Trivial TCP server that accepts connections on port 1170 (cute) +# and simply proxies character traffic back and forth. +# +import sys +import socket +import time +import threading +import queue + +from pdptraps import PDPTraps + + +class KL11: + + KL11_DEFAULT = 0o17560 # offset within I/O page + BUSY = 0o400 # probably no reason to ever set this + RCDONE = 0o200 # means character available in buf + TXRDY = 0o200 # same bit on tx side is called "RDY" + IENABLE = 0o100 + RDRENA = 0o001 + + _SHUTDOWN_SENTINEL = object() + SERVERHOST = '' + SERVERPORT = 1170 + + def __init__(self, ub, baseaddr=KL11_DEFAULT): + self.ub = ub + self.addr = ub.mmio.register(self.klregs, baseaddr, 4) + ub.mmio.devicereset_register(self.reset) + + # output characters are just queued (via tq) to the output thread + # input characters have to undergo a more careful 1-by-1 + # dance to properly match interrupts to their arrival + self.tq = queue.Queue() + self.rxc = threading.Condition() + + # bits broken out of virtualized KL11 Reader Status Register + self.rcdone = False + self.r_ienable = False + + # reader buffer register (address: baseaddr + 2) + self.rdrbuf = 0 + + # transmit buffer status (address: baseaddr + 4) + self.t_ienable = False + + # The socket server connection/listener + self._t = threading.Thread(target=self._connectionserver, daemon=True) + self._t.start() + + def reset(self, ub): + """Called for UNIBUS resets (RESET instruction).""" + self.rcdone = False + self.r_ienable = False + self.r_tenable = False + + def klregs(self, addr, value=None, /): + match addr - self.addr: + case 0: # rcsr + if value is None: + # *** READING *** + + value = 0 + + if self.r_ienable: + value |= self.IENABLE + + if self.rcdone: + value |= self.RCDONE + + else: + # *** WRITING *** + if value & self.RDRENA: + with self.rxc: + # a request to get one character, which only + # has to clear the rcdone bit here. + self.rcdone = False + self.rdrbuf = 0 + self.r_ienable = (value & self.IENABLE) + self.rxc.notify() + + case 2 if value is None: # rbuf + # *** READING *** + with self.rxc: + value = self.rdrbuf + self.rcdone = False + self.rxc.notify() + + # transmit buffer status (sometimes called tcsr) + case 4: + if value is None: + # *** READING *** + value = self.TXRDY # always ready to send chars + if self.t_ienable: + value |= self.IENABLE + else: + # *** WRITING *** + prev = self.t_ienable + self.t_ienable = (value & self.IENABLE) + if self.t_ienable and not prev: + self.ub.intmgr.simple_irq(pri=4, vector=0o64) + + # transmit buffer + case 6 if value is not None: # tbuf + # *** WRITING *** + value &= 0o177 + if (value != 0o177): + s = chr(value) + self.tq.put(s) + if self.t_ienable: + self.ub.intmgr.simple_irq(pri=4, vector=0o64) + case _: + raise PDPTraps.AddressError + + return value + + def _connectionserver(self): + """Server loop daemon thread for console I/O.""" + serversocket = socket.socket(socket.AF_INET, socket.SOCK_STREAM) + serversocket.setsockopt(socket.SOL_SOCKET, socket.SO_REUSEADDR, 1) + serversocket.bind((self.SERVERHOST, self.SERVERPORT)) + serversocket.listen(1) + + def _outloop(q, s): + while True: + try: + c = q.get(True, timeout=2) + if c is self._SHUTDOWN_SENTINEL: + break + except queue.Empty: + pass + else: + s.sendall(c.encode()) + + def _inloop(s): + while len(b := s.recv(1)) != 0: + with self.rxc: + self.rxc.wait_for(lambda: not self.rcdone) + self.rdrbuf = ord(b) + self.rcdone = True + if self.r_ienable: + self.ub.intmgr.simple_irq(pri=4, vector=0o60) + + while True: + s, addr = serversocket.accept() + + outthread = threading.Thread(target=_outloop, args=(self.tq, s)) + inthread = threading.Thread(target=_inloop, args=(s,)) + + outthread.start() + inthread.start() + + inthread.join() + self.tq.put(self._SHUTDOWN_SENTINEL) + outthread.join() + + # debugging tool + def statestring(self): + s = "" + if self.r_ienable: + s += " RINT" + if self.t_ienable: + s += " TINT" + if self.rdrbuf: + s += f" LC={self.rdrbuf}" + if self.rcdone: + s += f" RCDONE" + return s diff --git a/kw11.py b/kw11.py new file mode 100644 index 0000000..ba7549f --- /dev/null +++ b/kw11.py @@ -0,0 +1,66 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# line frequency clock + +import time +import threading + + +class KW11: + + KW11_OFFS = 0o17546 + + def __init__(self, ub): + interrupt_manager = ub.intmgr + self._t = threading.Thread( + target=self._cloop, args=(0.05, interrupt_manager), daemon=True) + self.running = False + self.monbit = 0 + ub.mmio.register_simpleattr(self, 'LKS', self.KW11_OFFS, reset=True) + + # clock loop + def _cloop(self, interval, imgr): + while self.running: + time.sleep(interval) + # there are inherent races here (in the hardware too) but + # seek to make the hazard smaller than the full interval + # by testing self.running again here. + if self.running: + imgr.simple_irq(pri=6, vector=0o100) + + @property + def LKS(self): + return (int(self.monbit) << 7) | (int(self.running) << 6) + + @LKS.setter + def LKS(self, value): + if not self.running: + if value & 0o100: + self.running = True + self._t.start() + + self.monbit = (value & 0o200) + if self.running and not (value & 0o100): + # this never happens in unix but ... + self.running = False + self._t.join() diff --git a/machine.py b/machine.py new file mode 100644 index 0000000..f69f10d --- /dev/null +++ b/machine.py @@ -0,0 +1,969 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + + +import logging +import itertools +from types import SimpleNamespace + +from pdptraps import PDPTrap, PDPTraps +from mmu import MemoryMgmt +from unibus import UNIBUS, UNIBUS_1170 +from kl11 import KL11 +from rp import RPRM +# from rpa import RPRM_AIO as RPRM +from kw11 import KW11 + +from op4 import op4_dispatch_table + +# A note about the various opNxxx files: +# +# Conceptually all of those are part of the PDP11 class. But having one +# monolithic/large class file seemed less than ideal. Python does not +# allow multiple files for a single class. +# +# Some parts of the implementation, like mmu and mmio, and various devices, +# made sense as separate component classes. The opcodes, however, are +# basically additional methods in separate files. Since they are not real +# methods they get passed a "cpu" argument manually instead of "self". +# +# Was there a better way? Just give in and have one huge file?? +# +# The opcode parsing/dispatch starts with the top 4 bits of the opcode; +# thus the names "op4" and "op4_dispatch_table". Further decoding from +# there is as defined by the pdp11 operation code encoding tree. + + +class PDP11: + + # Architectural constants, generally common across the whole family + + SIGN8 = 0o200 # sign bit mask for 8 bits + SIGN16 = 0o100000 # sign bit mask for 16 bits + SIGN32 = 0x80000000 # for 32 bits; no one wants to see this in octal + + # index this by opsize (1 or 2) to get corresponding sign bit mask + SIGN816 = (None, SIGN8, SIGN16) + + MASK8 = 0o377 + MASK16 = 0o177777 + MASK32 = 0xFFFFFFFF + + # index this by opsize (1 or 2) to get corresponding byte/word mask + MASK816 = (None, MASK8, MASK16) + + # I/O page size is 8K (bytes), and equivalent mask + IOPAGE_SIZE = 8192 # bytes + IOPAGE_MASK = IOPAGE_SIZE - 1 + + UNIBUS_MASK = 0o777777 # 18 bits + UNIBUS_SIZE = UNIBUS_MASK + 1 + + # General register(s) block(s), relative to I/O page base + IOPAGE_REGSETS_OFFS = 0o17700 + IOPAGE_REGSET_SIZE = 0o10 # 11/70 overrides w/more registers + + # PSW modes, though not all processors implement all + KERNEL = 0 # 00 in PSW bits + SUPERVISOR = 1 # 01 in PSW bits + UNDEFINED_MODE = 2 # 10 is undefined and will cause a trap + USER = 3 # 11 in PSW bits + + # sometimes nice to use these for clarity; r6 == SP, r7 == PC + SP = 6 + PC = 7 + + # the processor status word I/O page offset + PS_OFFS = 0o17776 + + # the stack limit register I/O page offset + STACKLIM_OFFS = 0o17774 + + # the console switches (read) and LEDs (write) + SWLEDS_OFFS = 0o17570 + + # the CPU error register and some useful bit values + CPUERROR_OFFS = 0o17766 + + # not an Enum because ... need to do bitwise efficiently. + CPUERR_BITS = SimpleNamespace( + REDZONE=0o004, YELLOW=0o010, UNIBUS_TIMEOUT=0o020, + NXM=0o040, ODDADDR=0o100, ILLHALT=0o200) + + # halt types. These are not architectural, but are helpful to see. + # They go into self.halted as "truthy" values + HALTED_INST = 1 # halt instruction + HALTED_VECTORS = 2 # vectors not mapped into kernel dataspace (!!) + HALTED_STACK = 3 # fatal kernel stack condition + + # "straps" are synchronous traps. They are trap operations that occur + # AFTER an instruction has completely executed. Examples include the + # stack-limit violation traps, and the MMU's "management trap" which + # allows the OS to monitor page usage without a full-on page fault. + # [ see the distinction between "traps" and "aborts" in the MMU ] + # + # STRAPBITS are set by the emulation code when their condition obtains + # and a trap should be generated at the completion of the instruction. + # If multiple are requested in a single instruction, only the highest + # priority will fire. These STRAPBITS values are an implementation + # detail (presumably the PDP11 microarchitecture does something similar). + # They are never seen outside the processor implementation. + # + # NOTE: mid-instruction aborts essentially are the same as a strap, but + # abort an instruction midway rather than letting it continue. They + # are implemented by raising a PDPTrap exception, which is caught at + # the instruction loop top-level, and then turned into the same thing + # as a strap -- just one that gets there mid-instruction (and highest + # priority). See HIGHEST_ABORTTRAP in STRAPBITS and the try/except + # in the main instruction processing loop. + + # there is no significant to the specific values, other than + # they must be single bits and they must sort in this order + STRAPBITS = SimpleNamespace( + + HIGHEST_ABORTTRAP=0o100000, # absolutely MUST be the highest + MEMMGT=0o010000, + YELLOW=0o004000, + PIR=0o000040) + + # this is just a handy thing to have, and this is as good a place + # for it as anywhere else + @staticmethod + def u16add(a, b): + return (a + b) & 0o177777 + + def __init__(self, *, + physmem=None, # default will be 512KB + unibus=None, # subclasses may want to supply variant + console=True, # automated tests need to turn this off + logger="pdp11", loglevel='INFO', + instlog=False, pswlog=False): + + # logging is enabled by default and will go to + # a file logger + ".log" (i.e., "pdp11.log" by default). + # If logging is not a str instance it will just be used as is. + # (so logging can be configured by caller that way) + + try: + logfname = logger + ".log" + except TypeError: + self.logger = logger + else: + loglevel = logging.getLevelNamesMapping().get(loglevel, loglevel) + logger = logging.getLogger(logger) + if not logger.hasHandlers(): # XXX is this the right/best way? + logger.propagate = False + + logger.setLevel(loglevel) + logger_fh = logging.FileHandler(logfname) + formatter = logging.Formatter( + '%(name)s.%(levelname)s[%(asctime)s]: %(message)s', + datefmt='%H%M%S') + logger_fh.setFormatter(formatter) + logger.addHandler(logger_fh) + self.logger = logger + + self.logger.info(f"{self.__class__.__name__} started;" + f" Logging level={logging.getLevelName(loglevel)}.") + # instruction logging and/or PSW logging - HUGE LOGS but + # sometimes helpful. Often the best way to use this is to insert + # custom code into the run loop to trigger these as desired. + self.instlog = instlog + self.pswlog = pswlog + + self.ub = unibus(self) if unibus else UNIBUS(self) + self.mmu = MemoryMgmt(self) + + # default physical memory is 256K WORDS (512KB) + self.physmem = physmem or ([0] * (256*1024)) + + # The 16-bit view of the PSW is synthesized when read; the + # essential parts of it are split out internally like this: + self.psw_curmode = self.KERNEL + self.psw_prevmode = self.KERNEL + self.psw_regset = 0 # this is not in all processors + self.psw_pri = 7 + self.psw_trap = 0 + self.psw_n = 0 + self.psw_z = 0 + self.psw_v = 0 + self.psw_c = 0 + + # some attributes ("registers") that appear in I/O page + for attrname, offs in (('psw', self.PS_OFFS), + ('stack_limit_register', self.STACKLIM_OFFS), + ('swleds', self.SWLEDS_OFFS), + ('error_register', self.CPUERROR_OFFS)): + self.ub.mmio.register_simpleattr(self, attrname, offs) + + # console switches (read) and blinken lights (write) + self.swleds = 0 + self.error_register = 0 # CPU Error register per handbook + + # NOTE: The cold machine starts out in stack limit violation. + # However, the semantics are that no check happens until something + # stack-related occurs. Boot programs need to establish a valid + # stack early in their instruction sequence. + self.stack_limit_register = 0 + + # straps: keeps track of requests for synchronous traps + # during an instruction. Note that only one will really happen, + # whichever is the highest priority, though some might persist + # and recur + # - stack limit + # - mmu management traps (note: these are not aborts) + # ... others? + # + self.straps = 0 + + # start off in halted state until .run() happens + self.halted = True + + # The console, the disk drive, and the clock are never really + # accessed directly (everything is triggered through mmio I/O) + # but of course must be instantiated + if console: # it's helpful to disable for tests + self._KL = KL11(self.ub) + self._RP = RPRM(self.ub) + self._KW = KW11(self.ub) + + def physRW(self, physaddr, value=None): + """like MMU.wordRW but takes physical addresses.""" + + if (physaddr & 1): + raise PDPTraps.AddressError(cpuerr=self.CPUERR_BITS.ODDADDR) + + physaddr >>= 1 # physical mem is an array of WORDs + try: + if value is None: # i.e., reading + return self.physmem[physaddr] + else: + # sanity check should be taken out eventually + if (value & 0xFFFF) != value: + raise ValueError(f"{value} is out of range") + self.physmem[physaddr] = value + return value # generally ignored + except IndexError: + raise PDPTraps.AddressError( + cpuerr=self.CPUERR_BITS.NXM) from None + + def physRW_N(self, physaddr, nwords, words=None): + """Like physRW but for nwords at a time.""" + + if (physaddr & 1): + raise PDPTraps.AddressError(cpuerr=self.cpu.CPUERR_BITS.ODDADDR) + physaddr >>= 1 # physical mem is an array of WORDs + + try: + if words is None: + return self.physmem[physaddr:physaddr+nwords] + else: + self.physmem[physaddr:physaddr+nwords] = words + except IndexError: + raise PDPTraps.AddressError( + cpuerr=self.CPUERR_BITS.NXM) from None + + # this the heart of all things related to 6-bit instruction operands. + # If value is not given this will be a read + # If value is given and not None, this will be a write + # + # If justEA is True, the address that would be used to access the + # operand is returned, vs the operand itself. This is not valid for + # register direct. See JMP/JSR for examples of how/when this happens. + # + # If rmw is True, this will return a tuple: + # value, extendedB6 + # otherwise it returns just the value (read, or written) + + def operandx(self, b6, value=None, /, *, + opsize=2, altmode=None, altspace=None, + rmw=False, justEA=False): + """Parse a 6-bit operand and read it (value is None) or write it. + + By default the value (read, or written) is returned. + Some instructions need the operand address, not the value + (JSR is the best example of this). Specify justEA=True for that. + Note that justEA=True will trap for register-direct mode. + + Some opcodes use a single addressing mode twice: + val = read the operand + do something to val (i.e., INC) + write modified val to the operand + The problem is side-effects, which are executed here for + modes like (Rn)+ (pc-relative is also a problem) + + For this case, specify rmw=True ("read/modify/write") on the read + call (value=None) in which case the return value will be a tuple: + (value, EXTENDED_B6) + + and the EXTENDED_B6 should be passed back in as the "b6" for the + write call. Callers should treat it as opaque. It is encoded to + allow the same operand to be re-used but without side effects + the second time. + """ + + # EXTENDED_B6 ENCODING -- it is a 32-bit value: + # Bits 31-24 = 0xFF or 0x00 + # If 00: The entire value is just a native b6. The low 6 bits + # are a pdp11 b6 value and all other bits are zero. + # If FF: + # bits 23-8: 16-bit effective address + # bits 7-6: mmu.ISPACE or mmu.DSPACE value + # bits 5-0: 0o47 which is an illegal b6; just to avoid + # looking like an optimizable case and + # to catch bugs if somehow used + # + + # NOTE: real PDP-11 implementations vary in corner cases. + # For example: + # MOV R5,-(R5) + # what value gets stored? This turns out to vary. In fact, DEC + # documented the variations across processors. FWIW, the MACRO-11 + # assembler generates warnings for such cases. Given all that, + # the assumption here is that getting those tricky semantics + # "correct to the specific processor variations" is unnecessary. + + # optimize addr mode 0 - register. 8 or 16 bits. + # Note that in all READ cases b6 will be the newb6 (reusable) + if (b6 & 0o70) == 0: + if justEA: + raise PDPTraps.AddressError + + match b6 & 0o07, value, opsize: + case Rn, None, 2: + value = self.r[Rn] + case Rn, wv, 2: + self.r[Rn] = wv + case Rn, None, 1: + value = self.r[Rn] & 0o377 + case Rn, bv, 1: + self.r[Rn] = bv + if bv > 127: + self.r[Rn] |= 0xFF00 + return (value, b6) if rmw else value + + # harder cases + autocrement = 0 # increment/decrement + space = self.mmu.DSPACE # gets changed in various cases + extendedb6 = b6 # will be altered as necessary + + match b6 & 0xFF_0000_00, (b6 & 0o70), (b6 & 0o07): + # (Rn) -- register deferred + case 0, 0o10, Rn: + addr = self.r[Rn] + if Rn == 7: + space = self.mmu.ISPACE + + # both autoincrement addrmodes: (Rn)+ and @(Rn)+ + case 0, 0o20 | 0o30 as addrmode, Rn: + addr = self.r[Rn] + if Rn == self.PC: + space = self.mmu.ISPACE + autocrement = 2 # regardless of opsize + elif Rn == self.SP: + autocrement = 2 # regardless of opsize + else: + autocrement = opsize + + if addrmode == 0o30: + addr = self.mmu.wordRW(addr, space=space) + space = self.mmu.DSPACE + extendedb6 = None # force update below + + # both autodecrement addrmode, PC - NOPE. + case 0, 0o40 | 0o50, 7: + # ... did the pdp11 fault on this? + raise PDPTraps.ReservedInstruction + + # both autodecrement addrmodes, not PC + # note that bytes and -(SP) still decrement by 2 + case 0, 0o40 | 0o50 as addrmode, Rn: + autocrement = -2 if Rn == self.SP else -opsize + extendedb6 = None # force update below + addr = self.u16add(self.r[Rn], autocrement) + if addrmode == 0o50: + addr = self.mmu.wordRW(addr, space=self.mmu.DSPACE) + if Rn == self.SP: + self.strapcheck = True + + # X(Rn) and @X(Rn) + case 0, (0o60 | 0o70) as addrmode, Rn: + x = self.mmu.wordRW(self.r[self.PC], space=self.mmu.ISPACE) + self.r[self.PC] = self.u16add(self.r[self.PC], 2) + addr = self.u16add(self.r[Rn], x) + extendedb6 = None # force update below + if addrmode == 0o70: + addr = self.mmu.wordRW(addr, space=self.mmu.DSPACE) + + case 0xFF_0000_00, _, _: + # the address was shifted up 8 bits (to get it away + # from the mode-0 optimization tests) and the space + # was encoded shifted up 6 bits (again, get away from mode 0) + addr = (b6 >> 8) & 0xFFFF + space = (b6 >> 6) & 3 + case _: # should be unreachable + raise TypeError("internal error") + + if autocrement != 0: + # the autoincrement/decrements have to be recorded into the MMU + # for instruction recovery if there is a page error. + self.mmu.MMR1mod(((autocrement & 0o37) << 3) | Rn) + self.r[Rn] = self.u16add(self.r[Rn], autocrement) + + if rmw and (value is None) and (extendedb6 is None): + extendedb6 = 0xFF_0000_27 | (addr << 8) | (space << 6) + + # use alternate space (e.g. forced ISPACE) if requested. + if altspace is not None: + space = altspace + + if justEA: + val = addr + elif opsize == 2: + val = self.mmu.wordRW(addr, value, mode=altmode, space=space) + else: + val = self.mmu.byteRW(addr, value, mode=altmode, space=space) + + return (val, extendedb6) if rmw else val + + def run(self, *, steps=None, pc=None, stopat=None, loglevel=None): + """Run the machine for a number of steps (instructions). + + If steps is None (default), the machine runs until a HALT instruction + is encountered. It may run forever and the method might never return. + + Otherwise, it runs for that many instructions (or until a HALT). + + If pc is None (default) execution begins at the current pc; otherwise + the pc is set to the given value first. + """ + + if loglevel is not None: + loglevel = logging.getLevelNamesMapping().get(loglevel, loglevel) + self.logger.setLevel(loglevel) + + if pc is not None: + self.r[self.PC] = pc + + # Breakpoints (and step limits) are in the critical path. + # To keep overhead to a minimum, breakpointfunc creates a + # custom function to evaluate breakpoint criteria. When there + # are no breakpoints or step limits at all, stop_here will be None. + # Hence the test construction: + # + # if stop_here and stop_here() + # + # which is as fast as it can be when there are no execution limits. + # When there ARE breakpoints etc, stop_here is a callable that + # evaluates all stop criteria and returns True if the inner loop + # should break. + stop_here = self.breakpointfunc(stopat, steps) + + # some shorthands for convenience + interrupt_mgr = self.ub.intmgr + mmu = self.mmu + + abort_trap = None # a mid-instruction abort (vs strap) + self.halted = False + + # NOTE WELL: everything in this loop is per-instruction overhead + while not self.halted: # stop_here function will also break + + # SUBTLETY: Trap handlers expect the PC to be 2 beyond the + # instruction causing the trap. Hence "+2 then execute" + thisPC = self.r[self.PC] + self.r[self.PC] = (thisPC + 2) & 0o177777 # "could" wrap + + mmu.MMR1_staged = 0 # see discussion in go_trap + mmu.MMR2 = thisPC # per handbook + + try: + inst = mmu.wordRW(thisPC) + if self.instlog: + self.instlogging(inst, thisPC) + op4_dispatch_table[inst >> 12](self, inst) + except PDPTrap as trap: + abort_trap = trap + self.straps |= self.STRAPBITS.HIGHEST_ABORTTRAP + + # pri order:abort traps (encoded as a strap), straps, interrupts + if self.straps: + self.go_trap(self.get_synchronous_trap(abort_trap)) + elif interrupt_mgr.pri_pending > self.psw_pri: + self.go_trap(interrupt_mgr.get_pending(self.psw_pri)) + + if stop_here and stop_here(): + break + + # fall through to here if self.halted or a stop_here condition + # log halts (stop_here was already logged) + if self.halted: + self.logger.debug(f".run HALTED: {self.machinestate()}") + + def breakpointfunc(self, stopat, steps): + # create a custom function that returns True if execution + # meets the stop criteria. The returned function MUST be + # called EXACTLY ONCE per instruction execution. + # + # If steps is not None, then at most that many invocations can + # occur before execution will be halted (i.e., True returned). + # + # stopat can be a tuple: (pc, mode) or just a naked pc value. + # Execution will halt when the processor reaches that pc + # (in the given mode, or in any mode if not given). + # + # If both stopat and steps are None, then this returns None, + # which allows the run() loop to optimize out the check. + + if stopat is None and steps is None: + return None + + if steps is None: + stepsgen = itertools.count() + else: + stepsgen = range(steps) + + try: + stoppc, stopmode = stopat + except TypeError: + stoppc = stopat + stopmode = None + + def _evalstop(): + for icount in stepsgen: + + # this is sneaky ... it's can be handy in debugging to + # know the instruction count; stuff it into the cpu object + self.xxx_instcount = icount + + if self.r[self.PC] == stoppc: + if stopmode is None or self.psw_curmode == stopmode: + self.logger.info(f".run: breakpt at {oct(stoppc)}") + break + yield False + else: + self.logger.info(f".run: ran {icount+1} steps") + yield True + + g = _evalstop() + return lambda: next(g) + + def get_synchronous_trap(self, abort_trap): + """Return a synchronous trap, or possibly None. + + For notational convenience in the instruction loop, the + abort_trap argument, if not None, represents a mid-instruction + abort which is the highest priority trap and it is just returned. + The corresponding straps bit is cleared. + + After that, finds the highest priority strap if any, and returns it. + """ + + # as described above... this is how aborts work + if self.straps & self.STRAPBITS.HIGHEST_ABORTTRAP: + self.straps &= ~self.STRAPBITS.HIGHEST_ABORTTRAP + return abort_trap + + # Synchronous traps are events that are caused by an instruction + # but happen AFTER the instruction completes. The handbook shows + # eight of them, in this priority order (high to low) + # + # HIGHEST -- Parity error + # Memory Management violation + # Stack Limit Yellow + # Power Failure + # Floating Point + # Program Interrupt Request + # Bus Request + # LOWEST Trace Trap + # + # If there are multiple, only the highest priority will fire, + # though some types of them are persistent (in their root cause) + # and would therefore come back with the next instruction and + # (potentially) fire there instead. + + # no synchronous traps honored in certain error states + ignores = self.CPUERR_BITS.REDZONE | self.CPUERR_BITS.YELLOW + if self.error_register & ignores: + return None + + # The stack limit yellow bit is a little different ... it gets + # set when there is the *possibility* of a stack limit violation. + # (because the stack pointer changed, or because the limits changed). + # This is where the actual limit test gets checked. + if self.straps & self.STRAPBITS.YELLOW: + # Note special semantic of zero which means 0o400 + # (as defined by hardware book) + lim = self.stack_limit_register or 0o400 + if self.r[self.SP] >= lim: + self.straps &= ~self.STRAPBITS.YELLOW # never mind, all good! + else: + self.logger.info(f"YELLOW ZONE, {list(map(oct, self.r))}") + # yup definitely in at least a yellow condition + self.error_register |= self.CPUERR_BITS.YELLOW + + # how about red? + if self.r[self.SP] + 32 < lim: # uh oh - below the yellow! + # this is a red zone trap which is immediate + # the stack pointer is set to location 4 + # and this trap is executed + self.r[6] = 4 # !! just enough room for... + return PDPTraps.AddressError( + cpuerr=self.CPUERR_BITS.REDZONE) + + # note that only the first (should be highest) will fire + for bit, trapcl in ((self.STRAPBITS.MEMMGT, PDPTraps.MMU), + (self.STRAPBITS.YELLOW, PDPTraps.AddressError)): + if self.straps & bit: + self.straps &= ~bit + return trapcl() + return None + + def go_trap(self, trap): + """Control transfer for all types of traps, INCLUDING interrupts.""" + + # it's convenient to allow trap to be None meaning "never mind" + if trap is None: + return + + self.logger.debug(f"TRAP: {trap}:\n{self.machinestate()}") + self.error_register |= trap.cpuerr + + # get the vector information -- always from KERNEL/DSPACE + try: + newpc = self.mmu.wordRW_KD(trap.vector) + newps = self.mmu.wordRW_KD(trap.vector+2) + except PDPTrap: + # this is an egregious kernel programming error -- the vectors + # are not mapped into KERNEL/DSPACE. It is a fatal halt. + self.logger.info(f"Trap accessing trap vectors") + self.halted = self.HALTED_VECTORS + return + + # From the PDP11 processor book: + # The old PS and PC are then pushed onto the current stack + # as indicated by bits 15,14 of the new PS and the previous + # mode in effect is stored in bits 13,12 of the new PS. + # Thus: + + # easiest to get the "previous" (currently current) mode this way: + saved_curmode = self.psw_curmode + saved_psw = self.psw + + # note: this (likely) switches SP and of course various psw_xxx fields + self.psw = newps + self.psw_prevmode = saved_curmode # i.e., override newps<13:12> + + prepushSP = self.r[6] + try: + self.stackpush(saved_psw) + self.stackpush(self.r[self.PC]) + except PDPTrap as e: + # again this is a pretty egregious error it means the kernel + # stack is not mapped, or the stack pointer is odd, or similar + # very bad mistakes by the kernel code. It is a fatal halt + # NOTE: The stack register is restored + self.logger.info(f"Trap pushing trap onto stack") + self.r[6] = prepushSP + self.halted = self.HALTED_STACK + + # The error register records (accumulates) reasons (if given) + self.error_register |= trap.cpuerr + + # alrighty then, can finally jump to the PC from the vector + self.r[self.PC] = newpc + + # This is called when the run loop wants to log an instruction. + # Pulled out so can be overridden for specific debugging sceanrios. + def instlogging(self, inst, pc): + try: + logit = self.instlog(self, inst, thisPC) + except TypeError: + logit = True + if logit: + m = "KS!U"[self.psw_curmode] + self.logger.debug(f"{oct(thisPC)}/{m} :: {oct(inst)}") + + @property + def swleds(self): + return 0 # no switches implementation, yet + + @swleds.setter + def swleds(self, v): # writing to the lights is a no-op for now + pass + + # technically not all -11's have this, but ... meh do it here anyway + @property + def stack_limit_register(self): + return self._stklim + + @stack_limit_register.setter + def stack_limit_register(self, v): + + # at __init__ time it's important to NOT indicate the need + # for a stack check or else the first instruction executed + # will fail the stack limit. + # + # Any other time, set the bit so the main instruction loop + # will know it needs to examine the stack limit status. + # + # This could also have been fixed by initializing _stklim in + # __init__ and not "stack_limit_register = 0" , or it could + # have been fixed by slamming strapcheck back to false after that. + # But this way ensures The Right Thing happens no matter what. + # Performance is no issue in setting the stack limit obviously. + if hasattr(self, '_stklim'): + self.straps |= self.STRAPBITS.YELLOW + self._stklim = v & 0o177400 + + def stackpush(self, w): + # XXX YELLOW CHECK ??? + self.r[6] = self.u16add(self.r[6], -2) + self.mmu.wordRW(self.r[6], w, space=self.mmu.DSPACE) + + def stackpop(self): + w = self.mmu.wordRW(self.r[6], space=self.mmu.DSPACE) + self.r[6] = self.u16add(self.r[6], 2) + return w + + +class PDP1170(PDP11): + + # some 1170-specific values + IOPAGE_REGSET_SIZE = 0o20 # 11/70 has two sets of registers + + def __init__(self, *, physmem=None, **kwargs): + super().__init__(physmem=physmem, unibus=UNIBUS_1170, **kwargs) + + # there are two register files, though r6 and r7 are special + self.registerfiles = [[0] * 8, [0] * 8] + + # There are four stack pointers, but only 3 are legal. + # This can be indexed by self.KERNEL, self.SUPERVISOR, etc + self.stackpointers = [0, 0, 0, 0] + + # The 16-bit view of the PSW is synthesized when read; the + # essential parts of it are split out internally like this: + self.psw_curmode = self.KERNEL + self.psw_prevmode = self.KERNEL + self.psw_regset = 0 + self.psw_pri = 7 + self.psw_trap = 0 + self.psw_n = 0 + self.psw_z = 0 + self.psw_v = 0 + self.psw_c = 0 + + # self.r points to the current register set + self.r = self.registerfiles[self.psw_regset] + + # how the registers appear in IOPAGE space + self.ub.mmio.register(self._ioregsets, + self.IOPAGE_REGSETS_OFFS, + self.IOPAGE_REGSET_SIZE) + + @property + def r_alt(self): + """The other set of registers (the one that is not self.r).""" + return self.registerfiles[1 - self.psw_regset] + + def _ioregsets(self, addr, value=None, /): + # NOTE that the encoding of the register addresses is quite funky + # and includes ODD addresses (!!!) + # [ addresses given relative to I/O page base ] + # REGISTER SET ZERO + # 17700 : R0 + # 17701 : R1 -- this being at ODD address is not a typo! + # 17702 : R2 + # 17703 : R3 -- not a typo + # 17704 : R4 + # 17705 : R5 -- not a typo + # 17706 : KERNEL SP + # 17707 : PC + # + # REGISTER SET ONE + # 17710 : R0 + # 17711 : R1 + # 17712 : R2 + # 17713 : R3 + # 17714 : R4 + # 17715 : R5 + # 17716 : SUPERVISOR SP + # 17717 : USER SP + regset = addr & 0o10 + regnum = addr & 0o07 + + # copy the stack pointer out of its r6 "cache" and dup the pc + self._syncregs() + + # regset regnum r/w (value None or not) + match ((addr & 0o10) >> 3, addr & 0o07, value): + case (0, 6, None): + return self.stackpointers[self.KERNEL] + case (0, 6, newksp): + self.stackpointers[self.KERNEL] = newksp + case (1, 6, None): + return self.stackpointers[self.SUPERVISOR] + case (1, 6, newssp): + self.stackpointers[self.SUPERVISOR] = newssp + case (1, 7, None): + return self.stackpointers[self.USER] + case (1, 7, newusp): + self.stackpointers[self.USER] = newusp + case (regset, regnum, None): + return self.registerfiles[regset][regnum] + case (regset, regnum, _): + self.registerfiles[regset][regnum] = value + + # if the stack pointer for the current mode was updated + # then reestablish it as r[6]. Can just do this unconditionally + # because syncregs copied out the active r[6] above + self.r[6] = self.stackpointers[self.psw_curmode] + + def _syncregs(self): + # When there is a register set change, a mode change, or when + # the registers are being examined via their I/O addresses then + # the "cached" stack pointer in R6 has to be synced up to its + # real home, and the PC (R7) has to be duplicated into the other set. + + self.stackpointers[self.psw_curmode] = self.r[6] + + # sync the PC into the other register set + self.r_alt[self.PC] = self.r[self.PC] + + @property + def psw(self): + # NOTE: to simplify/accelerate condition code handling during + # instructions, the NZVC bits are broken out into individual + # attributes, and are stored as truthy/falsey not necessarily + # 1/0 or True/False. + + # so, to reconstitute NZVC bits ... + NZVC = 0 + if self.psw_n: + NZVC |= 0o10 + if self.psw_z: + NZVC |= 0o04 + if self.psw_v: + NZVC |= 0o02 + if self.psw_c: + NZVC |= 0o01 + + return (((self.psw_curmode & 3) << 14) | + ((self.psw_prevmode & 3) << 12) | + ((self.psw_regset & 1) << 11) | + ((self.psw_pri & 7) << 5) | + ((self.psw_trap & 1) << 4) | + NZVC) + + # Write the ENTIRE processor word, without any privilege enforcement. + # The lack of privilege enforcement is necessary because, e.g., that's + # how traps get from user to kernel mode. Generally speaking, the + # only way for user mode programs to modify the PSW is via its I/O + # address, which (obviously) an OS should not put into user space. + @psw.setter + def psw(self, value): + """Set entire PSW. NOTE: no privilege enforcement.""" + + # could test if necessary but it's just easier to do this every time + self._syncregs() # in case any mode/regset changes + + # prevent UNDEFINED_MODE from entering the PSW + m = (value >> 14) & 3 + if m == self.UNDEFINED_MODE: + raise PDPTraps.ReservedInstruction + + self.psw_curmode = m + + # prevent UNDEFINED_MODE from entering the PSW + m = (value >> 12) & 3 + if m == self.UNDEFINED_MODE: + raise PDPTraps.ReservedInstruction + self.psw_prevmode = m + + prevregset = self.psw_regset + self.psw_regset = (value >> 11) & 1 + + newpri = (value >> 5) & 7 + if self.pswlog and newpri != self.psw_pri: + self.logger.debug(f"PSW pri change: {self.spsw()} -> " + f"{self.spsw(value)}") + + self.psw_pri = newpri + + self.psw_trap = (value >> 4) & 1 + self.psw_n = (value >> 3) & 1 + self.psw_z = (value >> 2) & 1 + self.psw_v = (value >> 1) & 1 + self.psw_c = value & 1 + + # set up the correct register file and install correct SP + self.r = self.registerfiles[self.psw_regset] + self.r[6] = self.stackpointers[self.psw_curmode] + + # the PC was already sync'd in syncregs() + + # this is convenient to have for debugging and logging + def spsw(self, v=None): + """Return string rep of a psw value.""" + if v is None: + v = self.psw + + cm = (v >> 14) & 3 + pm = (v >> 12) & 3 + + m2s = "KS!U" + + s = f"CM={m2s[cm]} PM={(m2s[pm])}" + if v & 0o04000: + s += " Rx=1" + s += f" PRI={(v >> 5) & 0o07}" + if v & 0o020: + s += " T" + if v & 0o017: + s += " " + if v & 0o010: + s += "N" + if v & 0o004: + s += "Z" + if v & 0o002: + s += "V" + if v & 0o001: + s += "C" + return s + + # logging/debugging convenience + def machinestate(self, brief=False): + s = self.spsw() + '; ' + stacknames = ("KSP", "SSP", "!X!", "USP") + regnames = (* (f"R{i}" for i in range(6)), + stacknames[self.psw_curmode], "PC") + for i in range(8): + s += f"{regnames[i]}: {oct(self.r[i])} " + + for m in (0, 1, 3): + name = stacknames[m] + if m == self.psw_curmode: + name = name[0] + "xx" + s += f"{name}: {oct(self.stackpointers[m])} " + + return s diff --git a/mmio.py b/mmio.py new file mode 100644 index 0000000..a1d166c --- /dev/null +++ b/mmio.py @@ -0,0 +1,289 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from pdptraps import PDPTraps + + +class MMIO: + """Memory Mapped I/O handling for the 8K byte I/O page.""" + + # + # memory-mapped I/O is just a 4K array of function callbacks, one + # entry per each I/O WORD (even) I/O offset. Most entries, of course, + # remain set to an initial default "non-existent address" callback. + # + # See register() for setting a callback on a specific offset or range. + # + # Reads and writes to any offset within the I/O page invoke the + # callback function. Assuming f is the callback function: + # + # READS: v = f(ioaddr) + # The function f must return a value 0 .. 65535 + # + # WRITES: f(ioaddr, v) + # v will be an integer 0 .. 65535 + # The return value is ignored. + # + # Callbacks must be declared like this: + # def f(ioaddr, value=None, /): + # if value is None: + # ... this is the read case + # else: + # ... this is the write case + # + # The ioaddr will always be relative to the base of the I/O page: + # (ioaddr & 8191) == ioaddr will always be True + # + # Callbacks may also optionally receive a byte operation indicator, + # but only if they register for that. See BYTE OPERATIONS, below. + # Most callbacks will instead rely on the framework to synthesize + # byte operations from words; see _byte_wrapper and byteme. + # + # Callback functions that need context or other data can, of course, + # be bound methods (automatically receiving self) or also can use + # functools.partial() to get additional arguments passed in. + # + # + # ODD I/O ADDRESSES, BYTE OPERATIONS: + # + # The physical UNIBUS always *reads* full 16-bit words; there is no + # capability for a byte read at the electrical bus level. + # + # Oddly (haha) the bus *can* specify byte access for writes. + # Even odder (hahaha), devices that provide full-word access at + # odd addresses exist, the best example being the CPU itself. In some + # models the registers are available at a block of UNIBUS addresses, + # and some of the 16-bit registers have ODD addresses. + # For example, UNIBUS address 777707 is the PDP-11 cpu PC, as a + # full 16-bit word, while 777706 is the PDP-11 cpu KSP. + # + # This creates potential for havoc if programmers use byte operations + # on I/O addresses. Consider a typical sequence to read consecutive + # bytes from an address in R0: + # + # MOVB (R0)+,R1 # get the low byte of the word R0 points to + # MOVB (R0)+,R2 # get the high byte of that word + # + # If executed with R0 = 177706 (the KSP register virtual address + # with a typical 16-bit mapping of the upper page to I/O space) + # then R1 will be the low byte of KSP but the next access, which will + # be seen by the UNIBUS as a word read on an odd address, will pull + # the PC value (at 777707) as a word and extract the upper byte + # from THAT (PC upper byte in R2; KSP lower byte in R1). This is + # probably an unexpected result, which is a good argument against + # using byte operations in I/O space. Nevertheless, byte operations + # in I/O space abound in real world code. + # + # Thus: + # * DEVICES THAT DIRECTLY SUPPORT BYTE-WRITE OPERATIONS: + # Specify "byte_writes=True" in the registration call: + # + # mmio.register(somefunc, someoffset, somesize, byte_writes=True) + # + # and declare the somefunc callback like this: + # def somefunc(ioaddr, value=None, /, *, opsize=2): + # ... + # + # The opsize argument will be 2 for word operations and 1 for bytes. + # NOTE: Byte READS will never be seen; only byte WRITES. + # + # * DEVICES THAT DON'T CARE ABOUT BYTE-WRITES: + # The common/standard case. Let byte_writes default to False + # (i.e., leave it out of the registration call). The callback + # will be invoked with the simpler signature: f(ioaddr, v) + # + # * DEVICES THAT SUPPLY WORDS AT ODD ADDRESSES + # The cpu being the canonical example of this... register the + # I/O callback at the corresponding even address and use the ioaddr + # determine which address (the even or the odd) was requested. + # + # Devices that respond to a block of related addresses can register + # one callback to cover more than one word of Unibus address space. + # The callback gets the ioaddr which it can further decode. Again, + # the CPU register block is a good example of this. + # + # + # The PDP-11 RESET INSTRUCTION + # + # The PDP-11 RESET instruction causes the UNIBUS to be reset. + # Devices that want to know about this should: + # + # mmio.devicereset_reigster(resetfunc) + # + # And then resetfunc will be invoked as: + # resetfunc(mmio.ub) + # (i.e., passed a single argument, the UNIBUS object). + # + # For dead-simple cases, the optional reset=True argument can be + # supplied, which casues register() to also arrange for the iofunc + # to be called at RESET time, like this: + # + # iofunc(baseaddr, 0) + # + # which, it should be noted, is indistinguishable from a program + # merely setting that I/O address to zero. Note too that if iofunc + # was registered once for an N-word block a RESET will still only call + # it ONCE, on the baseaddr of that block. + # + # If this convenience, with its limitations, is insufficient for a + # device then it must use the devicereset registration instead. + # + + def __init__(self, cpu): + self.cpu = cpu + self.mmiomap = [self.__nodev] * (self.cpu.IOPAGE_SIZE >> 1) + self.device_resets = set() + + # the default entry for unoccupied I/O: cause an AddressError trap + def __nodev(self, addr, value=None, /): + self.cpu.logger.info(f"Access to non-existent I/O {oct(addr)}") + raise PDPTraps.AddressError( + cpuerr=self.cpu.CPUERR_BITS.UNIBUS_TIMEOUT) + + # Devices may have simple "dummy" I/O addresses that always read zero + # and ignore writes; See "if iofunc is None" in register() method. + def __ignoredev(self, addr, value=None, /): + self.cpu.logger.debug(f"dummy zero device @ {oct(addr)}, {value=}") + return 0 + + # register a call-back for an I/O address, which MUST be an offset + # within the 8K I/O page (which itself may reside at three different + # physical locations depending on configurations, thus explaining + # why this routine deals only in the offsets). + # + # Variations: + # iofunc=None -- implement a dummy: reads as zero, ignores writes + # reset=True -- also registers iofunc to be called at RESET time + # byte_writes=True -- Request byte writes be sent to the iofunc + # vs hidden/converted into word ops. + # + def register(self, iofunc, offsetaddr, nwords, *, + byte_writes=False, reset=False): + + if offsetaddr >= self.cpu.IOPAGE_SIZE: + raise ValueError(f"MMIO: I/O offset too large {oct(offsetaddr)}") + + # None is a shorthand for "this is a dummy always-zero addr" + if iofunc is None: + iofunc = self.__ignoredev + + # register this (raw/unwrapped) iofunc for reset if so requested + if reset: + self.devicereset_register(lambda ub: iofunc(offsetaddr, 0)) + + idx, odd = divmod(offsetaddr, 2) + if odd != 0: + # See discussion of odd I/O addrs in block comment elsewhere + raise ValueError("cannot register odd (byte) address in IO space") + + if not byte_writes: + # wrap the supplied I/O function with this code to implement + # byte write operations automatically in terms of words. + iofunc = self._byte_wrapper(iofunc) + + for i in range(nwords): + self.mmiomap[idx+i] = iofunc + return offsetaddr + + def _byte_wrapper(self, iofunc): + def byteme(ioaddr, value=None, /, *, opsize=2): + if (value is None) or (opsize == 2): + return iofunc(ioaddr, value) + else: + # value is not None, and opsize is not 2 + # In other words: a byte write to I/O space. Synthesize it. + self.cpu.logger.debug(f"Byte write to {oct(ioaddr)} {value=}") + wv = self.wordRW(ioaddr) + if ioaddr & 1: + wv = (wv & 0o377) | (value << 8) + else: + wv = (wv & 0o177400) | value + self.wordRW(ioaddr, wv) + return byteme + + # Convenience method -- registers simple attributes (or properties) into + # I/O space in the obvious way: Make this attr (of obj) show at this addr + # + # If a device just needs some attributes set to zero on a RESET, + # it can specify them here with reset=True and they will be automatically + # set to zero by reset() (no need to devicereset_register). + def register_simpleattr(self, obj, attrname, addr, reset=False): + """Create and register a handler to read/write the named attr. + + obj - the object (often "self" for the caller of this method) + attrname - the attribute name to read/write + addr - the I/O address to register it to + + If attrname is None, the address is registered as a dummy location + that ignores writes and will always read as zero. This is sometimes + useful for features that have to exist but are emulated as no-op. + """ + + # could do this with partial, but can also do it with this nested + # func def. One way or another need this func logic anyway. + + def _rwattr(_, value=None, /): + """Read/write the named attr via the I/O callback protocol.""" + if attrname is None: + value = 0 + else: + if value is None: + value = getattr(obj, attrname) + else: + setattr(obj, attrname, value) + return value + + # NOTE: Registers a different ("closure of") rwattr each time. + self.register(_rwattr, addr, 1, reset=reset) + + # In the real hardware, the PDP-11 RESET instruction pulls a reset line + # that all devices can see. In the emulation, devices that need to know + # about the RESET instruction must register themselves here: + def devicereset_register(self, func): + """Register func to be called whenever a RESET happens.""" + self.device_resets.add(func) + + # The PDP-11 RESET instruction eventually ends up here, causing + # a bus reset to be sent to all known registered devices. + def resetdevices(self): + for f in self.device_resets: + self.cpu.logger.debug(f"RESET callback: {f}") + f(self.cpu.ub) + + def wordRW(self, ioaddr, value=None, /): + """Read (value is None) or write the given I/O address.""" + if value is None: + value = self.mmiomap[ioaddr >> 1](ioaddr) + else: + self.mmiomap[ioaddr >> 1](ioaddr, value) + return value + + def byteRW(self, ioaddr, value=None, /): + """UNIBUS byte R/W - only write is legal.""" + if value is None: + raise ValueError("Unibus cannot read bytes") + else: + self.cpu.logger.debug( + f"UB: byte write {oct(ioaddr)}={oct(value)}" + f" {self.cpu.machinestate()}") + self.mmiomap[ioaddr >> 1](ioaddr, value, opsize=1) + return None diff --git a/mmu.py b/mmu.py new file mode 100644 index 0000000..a1099c6 --- /dev/null +++ b/mmu.py @@ -0,0 +1,561 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from functools import partial +from pdptraps import PDPTraps +from types import SimpleNamespace +from collections import namedtuple + + +class MemoryMgmt: + ISPACE = 0 + DSPACE = 1 + + # I/O addreses for various registers relative to I/O page base + # From the pdp11/70 (and others) 1981 processor handbook, Appendix A + # + # Each block is: + # I PDR (8 16-bit registers) + # D PDR (8 16-bit registers) + # I PAR (8 16-bit registers) + # D PAR (8 16-bit registers) + # + # so each block is 64 bytes total, octal 100 in size + # + APR_SUPER_OFFS = 0o12200 # offset within I/O page + APR_KERNEL_OFFS = 0o12300 + APR_USER_OFFS = 0o17600 # 0o17 vs 0o12 is not a typo + + # expressed as offsets within the I/O page + MMR0_OFFS = 0o17572 + MMR1_OFFS = 0o17574 + MMR2_OFFS = 0o17576 + MMR3_OFFS = 0o12516 + + # not an Enum because ... need to do bitwise efficiently. + MMR0_BITS = SimpleNamespace( + ABORT_NR=0o100000, ABORT_PLENGTH=0o040000, ABORT_RDONLY=0o020000, + TRAP_MGMT=0o010000, TRAP_ENABLE=0o001000, INST_COMPLETED=0o000200, + RELO_ENABLE=0o000001, FREEZER_TRAPS=0o160000, + ) + + # memory control (parity, etc) is not implemented but needs to respond + MCR_OFFS = 0o17746 + + # encodes read vs write cycles + CYCLE = SimpleNamespace(READ='r', WRITE='w') + + TransKey = namedtuple('TransKey', ('segno', 'mode', 'space', 'cycle')) + + def __init__(self, cpu, /, *, nocache=False): + + self.cpu = cpu + self.ub = cpu.ub + + mmio = self.ub.mmio + + # The "segment cache" dramatically speeds up address translation + # for the most common MMU usage scenarios. + # + # To preserve correct semantics, modifications to the mapping + # parameters must (of course) dump some, or all, of this cache. + self.segcache = {} + + self.MMR0 = 0 + self.MMR1 = 0 + self.MMR2 = 0 + self.MMR3 = 0 + + self.MMR1_staged = 0 + self.nocache = nocache + + # per the architecture manual, there are six (!) sets of + # eight 32-bit Active Page Registers (APR0 ... APR7) where + # each APR can be thought of as a 16-bit page address register (PAR) + # and a 16 bit page descriptor register (PDR). + # + # A set (of 8) APRs is selected by a combination of two PSW bits + # for kernel/supervisor/illegal/user modes and, if I/D separation + # is enabled, I vs D space. + # + # To simplify the mapping, 8 sets (instead of 6) are provided here + # but one of them is never used because one of the four combinations + # of the psw mode bits is illegal (enforced elsewhere). + + self.APR = [[[0, 0] for _ in range(8)] for setno in range(8)] + + # register I/O space PDR/PARs: SUPER/KERNEL/USER blocks of 32 regs. + # + # It turns out all of this context is encoded (cleverly and + # not entirely obviously) in the ioaddr bits, but it just seems + # better to make it explicit here via extra args and partial(): + for mode, base in ( + (cpu.SUPERVISOR, self.APR_SUPER_OFFS), + (cpu.KERNEL, self.APR_KERNEL_OFFS), + (cpu.USER, self.APR_USER_OFFS)): + # Each block is: + # I PDR (8 16-bit registers) + # D PDR (8 16-bit registers) + # I PAR (8 16-bit registers) + # D PAR (8 16-bit registers) + for parpdr, space, offset in ( + (1, self.ISPACE, 0), + (1, self.DSPACE, 16), + (0, self.ISPACE, 32), + (0, self.DSPACE, 48)): + ioaddr = base+offset + iofunc = partial(self.io_parpdr, parpdr, mode, space, ioaddr) + mmio.register(iofunc, ioaddr, 8) # 8 words / 16 bytes + + # register the simple attrs MMR0 etc into I/O space: + mmio.register_simpleattr(self, 'MMR0', self.MMR0_OFFS, reset=True) + mmio.register_simpleattr(self, 'MMR1', self.MMR1_OFFS) + mmio.register_simpleattr(self, 'MMR2', self.MMR2_OFFS) + mmio.register_simpleattr(self, 'MMR3', self.MMR3_OFFS, reset=True) + mmio.register_simpleattr(self, None, self.MCR_OFFS) + + def io_parpdr(self, parpdr, mode, space, base, addr, value=None, /): + """mmio I/O function for MMU PARs and PDRs. + + NOTE: parpdr/mode/space/base args provided via partial() as + supplied at registration time; see __init__. + The mmio module calls this simply as f(addr, value) + """ + aprnum = (addr - base) >> 1 + aprfile = self.APR[(mode * 2) + space] + if value is None: + return aprfile[aprnum][parpdr] + else: + # dump any matching cache entries in both reading/writing form. + for w in (self.CYCLE.READ, self.CYCLE.WRITE): + if (aprnum, mode, space, w) in self.segcache: + del self.segcache[(aprnum, mode, space, w)] + + # --- XXX THIS IS JUST INFORMATIONAL / REASSURING FOR DEBUGGING + # --- take this entire block out when satisfied + if parpdr == 1: + pdr = aprfile[aprnum][1] + # various PDR mods are of interest for logging for debug + if ((value & 4) == 0) and (pdr & 4): + self.cpu.logger.debug( + f"MMU: Write perm being removed " + f"{aprnum=} {mode=} {space=}") + if ((pdr >> 8) & 0xFF) > ((value >> 8) & 0xFF): + self.cpu.logger.debug( + f"MMU: segment being shortened " + f"pdr={oct(pdr)} value={oct(value)}" + f" {aprnum=} {mode=} {space=}") + # --- XXX END XXX + + aprfile[aprnum][parpdr] = value + + # Per the handbook - the A and W bits in a PDR are reset to + # zero when either the PAR or PDR is written. + aprfile[aprnum][1] &= ~0o0300 + + @property + def MMR0(self): + return self._mmr0 + + @MMR0.setter + def MMR0(self, value): + self.cpu.logger.debug(f"MMR0 being set to {oct(value)}") + self._mmr0 = value + self._mmu_relo_enabled = (value & self.MMR0_BITS.RELO_ENABLE) + self._mmu_trap_enabled = (value & self.MMR0_BITS.TRAP_ENABLE) + self._mmr12_frozen = (value & self.MMR0_BITS.FREEZER_TRAPS) + # XXX + if self._mmr12_frozen: + self.cpu.logger.debug(f"MMR12 FROZEN {self.MMR1=} {self.MMR2=}") + + self.segcache = {} + self.__rebaseIO() + + # MMR1 records any autoincrement/decrement of the general purpose + # registers, including explicit references through the PC. MMR1 is + # cleared at the beginning of each instruction fetch. It is really + # two subregisters each 8 bits, that record: + # Bits <7:3> two's complement amount changed + # Bits <2:0> register number (0 .. 7) + # + # Register set must be determined from appropriate PSW field(s) + # + # This is in the critical path for instruction performance, so + # there is an optimization. At the beginning of every instruction + # self.MMR1_staged is set to zero. Then "MMR1mod()" is used to + # record any modifications (they still go into MMR1_staged) and + # only when an MMU trap is generated are the staged values potentially + # transferred into MMR1. + # + # This keeps the overhead down to a single self.MMR1_staged = 0 + # assignment for instructions that do not auto inc/dec and do not + # cause MMU faults. + + def MMR1mod(self, value): + # record the given 8-bit register modification + if value == 0 or value > 255: # this should never happen + raise ValueError(f"bogus MMR1mod {value=}") + + if self.MMR1_staged == 0: + self.MMR1_staged = value + else: + self.MMR1_staged |= (value << 8) + + def _MMR1commit(self): + if not self._mmr12_frozen: + self.MMR1 = self.MMR1_staged + + @property + def MMR2(self): + return self._mmr2 + + @MMR2.setter + def MMR2(self, value): + if not self._mmr12_frozen: + self._mmr2 = value + + @property + def MMR3(self): + cpu = self.cpu + return ( + ((self._unibusmap & 1) << 5) | + ((self._22bit & 1) << 4) | + (int(self._Dspaces[cpu.KERNEL] == self.DSPACE) << 2) | + (int(self._Dspaces[cpu.SUPERVISOR] == self.DSPACE) << 1) | + (int(self._Dspaces[cpu.USER] == self.DSPACE))) + + @MMR3.setter + def MMR3(self, value): + self._unibusmap = (value >> 5) & 1 + self._22bit = (value >> 4) & 1 + self.segcache = {} + self.__rebaseIO() # because 22bit affects where it ends up + + # rather than store the kernel/super/user D-space enables, + # store which space to use for D-space lookups + self._Dspaces = {mode: [self.ISPACE, self.DSPACE][bool(value & mask)] + for mode, mask in ((self.cpu.KERNEL, 4), + (self.cpu.SUPERVISOR, 2), + (self.cpu.USER, 1))} + + def __rebaseIO(self): + """Where oh where has my little I/O page gone?""" + + # whenver relo_enabled or _22bit change, which inconveniently + # are in separate MMR registers, the I/O potentially moves. + # Figure out where to put it. + self.iopage_base = 0o160000 # end of the 16 bit space + if self._mmu_relo_enabled: + self.iopage_base |= (3 << 16) # 2 more bits (18 total) + if self._22bit: + self.iopage_base |= (15 << 18) # ... and 4 more + + def v2p(self, vaddr, mode, space, cycle): + """Convert a 16-bit virtual address to physical. + NOTE: Raises traps, updates A/W bits, & sets straps as needed. + """ + + if not self._mmu_relo_enabled: + return vaddr + + if mode is None: # the normal (not mtpi etc) case + mode = self.cpu.psw_curmode + + # fold I/D together (into I) if separation not on + space = self._foldspaces(mode, space) + + # the virtual address is broken down into three fields: + # <15:13> APF active page field. Selects the APR = par,pdr pair + # This is sometimes called the "segment number" + # <12:6> The "block number" + # <5:0> The displacement in block + # + # The block number will be added to the page address field in the par. + # That whole thing is shifted left 6 bits and or'd with the + # displacement within block. All this is per the PDP11 manuals. + + segno = vaddr >> 13 + + # the segment number and these other parameters form + # a "translation key" used in several places + xkey = self.TransKey(segno, mode, space, cycle) + + # All this translation code takes quite some time; caching + # dramatically improves performance. + # + # I/O space mappings are not cached (not performance-critical). + # + + if self.nocache and self.segcache: + self.segcache = {} + try: + xoff, validation_func = self.segcache[xkey] + if validation_func(vaddr): + return vaddr + xoff + except KeyError: + pass + + # not cached; do the translation... + + par, pdr = self._getapr(xkey) + + # In 22bit mode, the full 16 bits of the PAR are used. + # In 18bit mode, the top four have to be masked off here. + if not self._22bit: + par &= 0o7777 + + # access checks: + # "Aborts" (per the processor handbook) raise PDPTraps.MMU and + # do not return from accesschecks() + # + # If there are "memory management traps" (which are to occur + # at the *end* of instruction execution) they are returned as + # bits suitable for OR'ing into cpu.straps; note that this + # condition also prevents caching the APR. If the mgmt trap + # handler modifies the APR to disable the management trap then + # of course future lookups will be eligible for the cache then. + + straps = self._v2p_accesschecks(pdr, vaddr, xkey) + + # the actual translation... + bn = (vaddr >> 6) & 0o177 + plf = (pdr >> 8) & 0o177 + if (pdr & 0o10) and bn < plf: + self._raisetrap(self.MMR0_BITS.ABORT_PLENGTH, vaddr, xkey) + elif (pdr & 0o10) == 0 and bn > plf: + self._raisetrap(self.MMR0_BITS.ABORT_PLENGTH, vaddr, xkey) + + # "Access" and "Written" bits updates. Subtle note: if this entry + # gets cached, then by definition the corresponding AW updates + # already happened (here). So the "found it in cache" logic up top + # of this function needn't worry about AW bit updates. + + AW_update = 0o300 if cycle == self.CYCLE.WRITE else 0o200 + # XXX ^^^^^ not sure if a write should be 0o300 or naked 0o100 + + if (pdr & AW_update) != AW_update: + self._putapr(xkey, (par, pdr | AW_update)) + + dib = vaddr & 0o77 + pa = ((par + bn) << 6) | dib + + self.cpu.straps |= straps + + # only non-trapping non-io results can be cached: + if straps == 0 and pa < self.iopage_base: + self._encache(xkey, pdr, pa - vaddr) + return pa + + def _encache(self, k, pdr, offs): + # the validation function (lambdas) is constructed for cases + # where the segment is not full-length and therefore one more + # check has to happen even on cache hits. + plf = (pdr >> 8) & 0o177 + if pdr & 0o10 and plf > 0: + self.segcache[k] = (offs, lambda a: ((a >> 6) & 0o177) >= plf) + elif (pdr & 0o10) == 0 and plf < 0o177: + self.segcache[k] = (offs, lambda a: ((a >> 6) & 0o177) <= plf) + else: + self.segcache[k] = (offs, lambda a: True) # full segment + + def _foldspaces(self, mode, space): + """Folds DSPACE back into ISPACE if DSPACE not enabled for mode""" + return space if space == self.ISPACE else self._Dspaces[mode] + + def _getapr(self, xkey): + """CAUTION: xkey must already be space-folded.""" + nth = (xkey.mode * 2) + xkey.space + return self.APR[nth][xkey.segno] + + def _putapr(self, xkey, apr): + """CAUTION: xkey must already be space-folded.""" + nth = (xkey.mode * 2) + xkey.space + self.APR[nth][xkey.segno] = list(apr) + + def _v2p_accesschecks(self, pdr, vaddr, xkey): + """Raise traps or set post-instruction traps as appropriate. + + Returns straps flags (if any required). + """ + + straps = 0 + + # There are aborts and "memory management traps". + # As the handbook says: + # """Aborts are used to catch "missing page faults," prevent + # illegal access, etc.; traps are used as an aid in + # gathering memory management information + # """ + # + # Thus, an "abort" raises a vector 4 (AddressError) exception and + # a "management trap" sets a cpu bit to cause a vector 250 (MMU) + # trap at the *completion* of the instruction. + # + # The 7 possible access control modes (pdr & 7) are: + # + # 000 -- abort all accesses + # 001 -- read-only + mgmt trap (read) + # 010 -- read-only no mgmt traps + # 011 -- RESERVED/ILLEGAL, abort all accesses + # 100 -- writable + mgmt trap (any) + # 101 -- writable + mgmt trap if write + # 110 -- writable no mgmt traps + # 111 -- RESERVED/ILLEGAL abort all accesses + + # Things that are not decoded in the match are accesses that + # cause no traps or aborts. So, for example, control mode 6 + # is not in the cases; nor is control mode 5 if reading. + + cycle = xkey.cycle + match pdr & 7: + # control modes 0, 3, and 7 are always aborts + case 0 | 3 | 7: + self.cpu.logger.debug(f"ABORT_NR trap, regs: " + f"{list(map(oct, self.cpu.r))}" + f", {oct(self.cpu.psw)}" + f", PDR={oct(pdr)} {cycle=}") + self._raisetrap(self.MMR0_BITS.ABORT_NR, vaddr, xkey) + + # control mode 1 is an abort if writing, mgmt trap if read + case 1 if cycle == self.CYCLE.READ: + straps = self.cpu.STRAPBITS.MEMMGT + + case 1 | 2 if cycle == self.CYCLE.WRITE: + self._raisetrap(self.MMR0_BITS.ABORT_RDONLY, vaddr, xkey) + + # control mode 4 is mgmt trap on any access (read or write) + case 4: + straps = self.cpu.STRAPBITS.MEMMGT + + # control mode 5 is mgmt trap if WRITING + case 5 if cycle == self.CYCLE.WRITE: + straps = self.cpu.STRAPBITS.MEMMGT + + return straps + + def wordRW(self, vaddr, value=None, /, *, mode=None, space=ISPACE): + """Read/write a word at virtual address vaddr. + + If value is None, perform a read and return a 16-bit value + If value is not None, perform a write; return None. + """ + + cycle = self.CYCLE.READ if value is None else self.CYCLE.WRITE + pa = self.v2p(vaddr, mode, space, cycle) + if pa >= self.iopage_base: + return self.ub.mmio.wordRW(pa & self.cpu.IOPAGE_MASK, value) + else: + return self.cpu.physRW(pa, value) + + def byteRW(self, vaddr, value=None, /, mode=None, space=ISPACE): + """Read/write a byte at virtual address vaddr. + + If value is None, perform a read and return an 8-bit value + If value is not None, perform a write; return None. + """ + + cycle = self.CYCLE.READ if value is None else self.CYCLE.WRITE + pa = self.v2p(vaddr, mode, space, cycle) + + # Physical memory is represented as an array of 16-bit word + # values, and byte operations are synthesized from that in + # the obvious manner. + # + # However, the UNIBUS is different. At the physical electrical + # signal level, the UNIBUS cannot perform byte reads, but CAN + # perform byte writes. + # + # Given that - any byte read is synthesized from corresponding + # word read operations, I/O or physical as appropriate. + # + # But byte write operations are dispatched as byte operations + # to the unibus, while still being synthesized here for memory. + + odd = (pa & 1) + + if value is None: + # *** READ *** + # + # Synthesized from containing word in the obvious way. + # Note little-endianness. + + pa &= ~1 + if pa >= self.iopage_base: + wv = self.ub.mmio.wordRW(pa & self.cpu.IOPAGE_MASK) + else: + wv = self.cpu.physRW(pa) + return ((wv >> 8) if odd else wv) & 0o377 + else: + # *** WRITE *** + + # This sanity check should be taken out eventually + if (value & 0xFF) != value: + raise ValueError(f"{value} is out of range") + + # I/O byte writes are handled by Unibus; + # Memory byte writes are synthesized. + + if pa >= self.iopage_base: + return self.ub.mmio.byteRW(pa & self.cpu.IOPAGE_MASK, value) + else: + wv = self.cpu.physRW(pa & ~1) + if odd: + wv = (wv & 0o377) | (value << 8) + else: + wv = (wv & 0o177400) | value + self.cpu.physRW(pa & ~1, wv) + return None + + def wordRW_KD(self, a, v=None, /): + """Convenienence; version of wordRW for kernel/dspace.""" + return self.wordRW(a, v, mode=self.cpu.KERNEL, space=self.DSPACE) + + def _raisetrap(self, trapflag, vaddr, xkey): + """Raise an MMU trap. Commits regmods and updates reason in MMR0.""" + if trapflag == self.MMR0_BITS.ABORT_PLENGTH: + self.cpu.logger.debug(f"PLF trap @ {oct(vaddr)}, {xkey=}") + self._MMR1commit() + self.MMR0 |= (trapflag | + xkey.segno << 1 | # bits <3:1> + xkey.space << 4 | # bit 4 + xkey.mode << 5) # bits <6:5> + + # XXX gotta figure out how to set this for Odd Addresses and + # T bit conditions, but otherwise Bit 7 is not set. From handbook: + # Bit 7 indicates that the current instruction has·been completed. + # It will be set to a during T bit, Parity, Odd Address, and + # Time Out traps and interrupts. Bit 7 is Read-Only (it cannot + # be written). It is initialized to a 1. Note that EMT, TRAP, + # BPT, and lOT do not set bit 7. + raise PDPTraps.MMU() + + # handy for logging / debugging + def scstr(self): + """Return a string representation of the segment cache.""" + + s = "" + for xkey, v in self.segcache.items(): + ms = "KS!U"[xkey.mode] + ds = "ID"[xkey.space] + s += f"{oct(xkey.segno << 13)}:{ms}{ds}{xkey.cycle} :" + s += f" {oct(v[0])}\n" + return s diff --git a/op00.py b/op00.py new file mode 100644 index 0000000..e47455e --- /dev/null +++ b/op00.py @@ -0,0 +1,325 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from pdptraps import PDPTraps + +from op000 import op000_dispatcher +from branches import branches + + +def op00_4_jsr(cpu, inst): + Rn = (inst & 0o700) >> 6 + if Rn == cpu.SP: + raise PDPTraps.ReservedInstruction + + # according to the PDP11 handbook... + # R7 is the only register that can be used for + # both the link and destination, the other GPRs cannot. + # Thus, if the link is R5, any register except R5 can be used + # for one destination field. + # + # Does the PDP11 Trap if this is violated, or is it just "undefined"?? + if Rn != cpu.PC and Rn == (inst & 0o07): + raise PDPTraps.ReservedInstruction + + # Note that the computed b6 operand address IS the new PC value. + # In other words, JSR PC,(R0) means that the contents of R0 are + # the subroutine address. This is one level of indirection less + # than ordinary instructions. Hence the justEA for operandx(). + # Corollary: JSR PC, R0 is illegal (instructions cannot reside + # in the registers themselves) + + tmp = cpu.operandx(inst & 0o77, justEA=True) + + # NOTE: no condition code modifications + + # cpu.logger.debug(f"JSR to {oct(tmp)} from {oct(cpu.r[cpu.PC])}") + cpu.stackpush(cpu.r[Rn]) + cpu.r[Rn] = cpu.r[cpu.PC] # this could be a no-op if Rn == 7 + cpu.r[cpu.PC] = tmp + + +def op00_50_clr(cpu, inst, opsize=2): + """CLR(B) (determined by opsize). Clear destination.""" + + cpu.psw_n = cpu.psw_v = cpu.psw_c = 0 + cpu.psw_z = 1 + + cpu.operandx(inst & 0o77, 0, opsize=opsize) + + +def op00_51_com(cpu, inst, opsize=2): + """COM(B) (determined by opsize). 1's complement destination.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + # Have to be careful about python infinite length integers + # For example, ~0xFFFF == -65536 whereas the desired result is zero. + # Hence the explicit masking + val = (~val) & cpu.MASK816[opsize] + + cpu.psw_n = val & cpu.SIGN816[opsize] + cpu.psw_z = (val == 0) + cpu.psw_v = 0 + cpu.psw_c = 1 + + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_52_inc(cpu, inst, opsize=2): + """INC(B) (determined by opsize). Increment destination.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + newval = (val + 1) & cpu.MASK816[opsize] + + cpu.psw_n = newval & cpu.SIGN816[opsize] + cpu.psw_z = (newval == 0) + cpu.psw_v = (newval == cpu.SIGN816) + # C bit not affected + cpu.operandx(xb6, newval, opsize=opsize) + + +def op00_53_dec(cpu, inst, opsize=2): + """DEC(B) (determined by opsize). Decrement destination.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + newval = (val - 1) & cpu.MASK816[opsize] + + cpu.psw_n = newval & cpu.SIGN816[opsize] + cpu.psw_z = (newval == 0) + cpu.psw_v = (val == cpu.SIGN816[opsize]) + # C bit not affected + + cpu.operandx(xb6, newval, opsize=opsize) + + +def op00_54_neg(cpu, inst, opsize=2): + """NEG(B) (determined by opsize). Negate the destination.""" + + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + newval = (-val) & cpu.MASK816[opsize] + + cpu.psw_n = newval & cpu.SIGN816[opsize] + cpu.psw_z = (newval == 0) + cpu.psw_v = (val == newval) # happens at the maximum negative value + cpu.psw_c = (newval != 0) + + cpu.operandx(xb6, newval, opsize=opsize) + + +def op00_55_adc(cpu, inst, opsize=2): + """ADC(B) (determined by opsize). Add carry.""" + # NOTE: "add carry" (not "add with carry") + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + if cpu.psw_c: + oldsign = val & cpu.SIGN816[opsize] + val = (val + 1) & cpu.MASK816[opsize] + cpu.psw_v = (val & cpu.SIGN816[opsize]) and not oldsign + cpu.psw_c = (val == 0) # because this is the NEW (+1'd) val + else: + cpu.psw_v = 0 + cpu.psw_c = 0 + + cpu.psw_n = (val & cpu.SIGN816[opsize]) + cpu.psw_z = (val == 0) + + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_56_sbc(cpu, inst, opsize=2): + """SBC(B) (determined by opsize). Subtract carry.""" + # NOTE: "subtract carry" (not "subtract with carry/borrow") + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + if cpu.psw_c: + oldsign = val & cpu.SIGN816[opsize] + val = (val - 1) & cpu.MASK816[opsize] + cpu.psw_v = oldsign and not (val & cpu.SIGN816[opsize]) + cpu.psw_c = (val == cpu.MASK816[opsize]) # bcs this is the (-1'd) val + else: + cpu.psw_v = 0 + cpu.psw_c = 0 + + cpu.psw_n = (val & cpu.SIGN816[opsize]) + cpu.psw_z = (val == 0) + + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_57_tst(cpu, inst, opsize=2): + """TST(B) (determined by opsize). Test destination.""" + dst = inst & 0o77 + val = cpu.operandx(dst, opsize=opsize) + cpu.psw_n = (val & cpu.SIGN816[opsize]) + cpu.psw_z = (val == 0) + cpu.psw_v = 0 + cpu.psw_c = 0 + + +def op00_60_ror(cpu, inst, opsize=2): + """ROR(B) - rotate one bit right.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + signmask = cpu.SIGN816[opsize] + vc = signmask if cpu.psw_c else 0 + cpu.psw_c, val = (val & 1), ((val >> 1) | vc) & cpu.MASK816[opsize] + + cpu.psw_n = val & signmask + cpu.psw_z = (val == 0) + cpu.psw_v = cpu.psw_n ^ cpu.psw_c + + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_61_rol(cpu, inst, opsize=2): + """ROL(B) - rotate one bit left.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + signmask = cpu.SIGN816[opsize] + vc = 1 if cpu.psw_c else 0 + cpu.psw_c, val = (val & signmask), ((val << 1) | vc) & cpu.MASK816[opsize] + + cpu.psw_n = val & signmask + cpu.psw_z = (val == 0) + cpu.psw_v = cpu.psw_n ^ cpu.psw_c + + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_62_asr(cpu, inst, opsize=2): + """ASR(B) - arithmetic shift right one bit.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + signbit = (val & cpu.SIGN816[opsize]) + cpu.psw_c = (val & 1) + val >>= 1 + val |= signbit + cpu.psw_n = (val & cpu.SIGN816[opsize]) + cpu.psw_z = (val == 0) + cpu.psw_v = cpu.psw_n ^ cpu.psw_c + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_63_asl(cpu, inst, opsize=2): + """ASL(B) - arithmetic shift left one bit.""" + val, xb6 = cpu.operandx(inst & 0o77, opsize=opsize, rmw=True) + cpu.psw_c = (val & cpu.SIGN816[opsize]) + val = (val << 1) & cpu.MASK816[opsize] + cpu.psw_n = (val & cpu.SIGN816[opsize]) + cpu.psw_z = (val == 0) + cpu.psw_v = cpu.psw_n ^ cpu.psw_c + cpu.operandx(xb6, val, opsize=opsize) + + +def op00_64_mark(cpu, inst): + raise ValueError + + +def op00_65_mfpi(cpu, inst, opsize=2): + """MFPI - move from previous instruction space. + + The "opsize" -- which really is just the top bit of the instruction, + encodes whether this is mfpi or mfpd: + opsize = 2 mfpi (top bit was 0) + opsize = 1 mfpd (top bit was 1) + """ + + # There are some wonky special semantics. In user mode if prevmode + # is USER (which it always is in Unix) then this refers to DSPACE + # (despite the MFPI name) protect the notion of "execute only" I space + + prvm = cpu.psw_prevmode + curm = cpu.psw_curmode + if prvm == cpu.USER and (curm == prvm): + space = cpu.mmu.DSPACE + else: + space = (cpu.mmu.DSPACE, cpu.mmu.ISPACE)[opsize - 1] + + # MFPx SP is a special case, it means get the other SP register. + if (inst & 0o77) == 6 and (prvm != curm): + pival = cpu.stackpointers[prvm] + else: + pival = cpu.operandx(inst & 0o77, altmode=prvm, altspace=space) + cpu.psw_n = pival & cpu.MASK16 + cpu.psw_z = (pival == 0) + cpu.psw_v = 0 + cpu.stackpush(pival) + + +def op00_66_mtpi(cpu, inst, opsize=2): + """MTPI - move to previous instruction space. + + The "opsize" encodes whether this is mtpi or mtpd: + opsize = 2 mtpi + opsize = 1 mtpd + """ + + # there are some wonky semantics ... this instruction is NOT restricted + # to privileged modes and is potentially a path to writing into + # a privileged space (!!). Unix (and probably all others) deals with + # this by ensuring psw_prevmode is also USER when in USER mode. + + targetspace = (cpu.mmu.DSPACE, cpu.mmu.ISPACE)[opsize - 1] + w = cpu.stackpop() + + cpu.psw_n = w & cpu.MASK16 + cpu.psw_z = (w == 0) + cpu.psw_v = 0 + + prvm = cpu.psw_prevmode + curm = cpu.psw_curmode + # note the special case that MTPx SP writes the other mode's SP register + if (inst & 0o77) == 6 and (prvm != curm): + cpu.stackpointers[prvm] = w + else: + cpu.operandx(inst & 0o077, w, altmode=prvm, altspace=targetspace) + + +def op00_67_sxt(cpu, inst): + if cpu.psw_n: + val = cpu.MASK16 + else: + val = 0 + cpu.psw_z = not cpu.psw_n + cpu.operandx(inst & 0o0077, val) + + +ops56tab = ( + op00_50_clr, + op00_51_com, + op00_52_inc, + op00_53_dec, + op00_54_neg, + op00_55_adc, + op00_56_sbc, + op00_57_tst, + op00_60_ror, + op00_61_rol, + op00_62_asr, + op00_63_asl, + op00_64_mark, + op00_65_mfpi, # note: "byte" variant is really MFPD + op00_66_mtpi, # note: "byte" variant is really MTPD + op00_67_sxt) + + +op00_dispatch_table = ( + op000_dispatcher, + branches, + branches, + branches, + op00_4_jsr, + lambda cpu, inst: ops56tab[((inst & 0o7700) >> 6) - 0o50](cpu, inst), + lambda cpu, inst: ops56tab[((inst & 0o7700) >> 6) - 0o50](cpu, inst), + None) diff --git a/op000.py b/op000.py new file mode 100644 index 0000000..80b3cdc --- /dev/null +++ b/op000.py @@ -0,0 +1,133 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from pdptraps import PDPTraps + +# ... and even further down the op decode rabbit hole we go! +# These are the decodes for opcodes starting 0o000 +from branches import branch + + +def op_halt(cpu, inst): + if cpu.psw_curmode != cpu.KERNEL: + # strange trap, but that's what it says + raise PDPTraps.AddressError(cpu.CPUERR_BITS.ILLHALT) + cpu.halted = True + + +def op_reset(cpu, inst): + cpu.logger.debug("RESET INSTRUCTION") + cpu.ub.resetbus() + + +def op_wait(cpu, inst): + cpu.logger.debug("WAIT") + cpu.ub.intmgr.waitstate(cpu.psw_pri) # will pend until an interrupt + + +def op_rtt(cpu, inst): + cpu.r[cpu.PC] = cpu.stackpop() + cpu.psw = cpu.stackpop() + + +def op_02xx(cpu, inst): + x5 = (inst & 0o70) + if x5 == 0o00: + op_rts(cpu, inst) + elif x5 == 0o30: + op_spl(cpu, inst) + elif x5 >= 0o40: + op_xcc(cpu, inst) + else: + raise PDPTraps.ReservedInstruction + + +def op_spl(cpu, inst): + """SPL; note that this is a no-op (!) not a trap in non-kernel mode.""" + if cpu.psw_curmode == cpu.KERNEL: + cpu.psw = (cpu.psw & ~ (0o07 << 5)) | ((inst & 0o07) << 5) + + +def op_rts(cpu, inst): + Rn = (inst & 0o07) + cpu.r[cpu.PC] = cpu.r[Rn] # will be a no-op for RTS PC + cpu.r[Rn] = cpu.stackpop() + + +def op_jmp(cpu, inst): + # same justEA/operand non-indirection discussion as in JSR (see) + cpu.r[cpu.PC] = cpu.operandx(inst & 0o77, justEA=True) + + +def op_swab(cpu, inst): + """SWAB swap bytes.""" + val, xb6 = cpu.operandx(inst & 0o77, rmw=True) + + val = ((val >> 8) & cpu.MASK8) | ((val & cpu.MASK8) << 8) + cpu.psw_n = val & cpu.SIGN16 + + # note this screwy definition, per the handbook + cpu.psw_z = ((val & cpu.MASK8) == 0) + cpu.psw_v = 0 + cpu.psw_c = 0 + + cpu.operandx(xb6, val) + + +def op_xcc(cpu, inst): + """XCC - all variations of set/clear condition codes.""" + + setclr = inst & 0o020 # set it or clear it + if inst & 0o10: + cpu.psw_n = setclr + if inst & 0o04: + cpu.psw_z = setclr + if inst & 0o02: + cpu.psw_v = setclr + if inst & 0o01: + cpu.psw_c = setclr + + +def op000_dispatcher(cpu, inst): + match (inst & 0o0700): + case 0o0000: + if inst == 0: + op_halt(cpu, inst) + elif inst == 6 or inst == 2: # RTI and RTT are identical!! + op_rtt(cpu, inst) + elif inst == 1: + op_wait(cpu, inst) + elif inst == 5: + op_reset(cpu, inst) + + case 0o0100: + op_jmp(cpu, inst) + + case 0o0200: + op_02xx(cpu, inst) + + case 0o0300: + op_swab(cpu, inst) + + # note that 2 bits of the branch offset sneak into this match + case 0o0400 | 0o0500 | 0o0600 | 0o0700: + branch(cpu, inst, lambda n, z, v, c: True) diff --git a/op07.py b/op07.py new file mode 100644 index 0000000..6ab141b --- /dev/null +++ b/op07.py @@ -0,0 +1,224 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# op07 instructions + + +# 6 simple instructions appear in the op07 space: 070 .. 074 and 077. +# In these the first operand is restricted to being only a register +# (because the three bits usually used for 'mode' are part of +# these opcodes). The destination is still a full 6-bit specification. +# +# op075 is used for floating point instruction encoding (FP instructions +# are also found in other nooks and crannies) +# +# op076 is the commercial instruction set +# + + +def op070_mul(cpu, inst): + dstreg = (inst & 0o000700) >> 6 + r = cpu.r[dstreg] + src = cpu.operandx(inst & 0o077) + + # unlike add/subtract, need to explicitly treat as signed. + # The right results require sign extending both 16 bit operands to + # 32 bits, multiplying them, then taking the bottom 32 bits of the result. + # It may not be obvious why this works; see google. + if r >= 32768: + r |= 0xFFFF0000 + if src >= 32768: + src |= 0xFFFF0000 + m = (src * r) & 0xFFFFFFFF + + # the result is stored: + # high 16 bits in dstreg + # low 16 bits in dstreg|1 + # and if dstreg is odd ONLY the low 16 bits are stored + # This just stores both but in careful order + cpu.r[dstreg] = (m >> 16) & 0xFFFF + cpu.r[dstreg | 1] = m & 0xFFFF + + cpu.psw_n = m & 0x80000000 + if cpu.psw_n: + cpu.psw_c = (m < 0xFFFF8000) + else: + cpu.psw_c = (m >= 32768) + cpu.psw_z = (m == 0) + cpu.psw_v = 0 + + +def op071_div(cpu, inst): + dstreg = (inst & 0o000700) >> 6 + if (dstreg & 1): + raise PDPTraps.ReservedInstruction # dstreg must be even + dividend = (cpu.r[dstreg] << 16) | cpu.r[dstreg | 1] + divisor = cpu.operandx(inst & 0o077) + if divisor == 0: + cpu.psw_n = 0 + cpu.psw_z = 1 + cpu.psw_v = 1 + cpu.psw_c = 1 + elif divisor == 0o177777 and dividend == 0x80000000: + # maxneg / -1 == too big + cpu.psw_n = 0 + cpu.psw_z = 0 + cpu.psw_v = 1 + cpu.psw_c = 0 + else: + # convert both numbers to positive equivalents + # and track sign info manually + if dividend & cpu.SIGN32: + dividend = 4*1024*1024*1024 - dividend + ddendposneg = -1 + else: + ddendposneg = 1 + posneg = ddendposneg + if divisor & cpu.SIGN16: + divisor = 65536 - divisor + posneg = -posneg + q, rem = divmod(dividend, divisor) + q *= posneg + if q > 32767 or q < -32768: + cpu.psw_n = 0 + cpu.psw_z = 0 + cpu.psw_v = 1 + cpu.psw_c = 0 + else: + if ddendposneg < 0: + rem = -rem + cpu.psw_n = (q < 0) + cpu.psw_z = (q == 0) + cpu.psw_v = 0 + cpu.psw_c = 0 + + cpu.r[dstreg] = q & cpu.MASK16 + cpu.r[dstreg | 1] = rem & cpu.MASK16 + + +def op072_ash(cpu, inst): + dstreg = (inst & 0o000700) >> 6 + r = cpu.r[dstreg] + shift = cpu.operandx(inst & 0o077) & 0o077 + + r = _shifter(cpu, r, shift, opsize=2) + + cpu.r[dstreg] = r + + +def op073_ashc(cpu, inst): + dstreg = (inst & 0o000700) >> 6 + r = (cpu.r[dstreg] << 16) | cpu.r[dstreg | 1] + shift = cpu.operandx(inst & 0o077) & 0o077 + + r = _shifter(cpu, r, shift, opsize=4) + + cpu.r[dstreg] = (r >> 16) & cpu.MASK16 + cpu.r[dstreg | 1] = r & cpu.MASK16 + + +# this is the heart of ash and ashc +def _shifter(cpu, value, shift, *, opsize): + """Returns shifted value and sets condition codes.""" + + signmask = cpu.SIGN16 + signextend = 0xFFFFFFFF0000 + if opsize == 4: + signmask <<= 16 + signextend <<= 16 + + vsign = value & signmask + + if shift == 0: + cpu.psw_n = vsign + cpu.psw_z = (value == 0) + cpu.psw_v = 0 + # C is not altered + return value + elif shift > 31: # right shift + # sign extend if appropriate, so the sign propagates + if vsign: + value |= signextend + + # right shift by 1 less, to capture bottom bit for C + value >>= (63 - shift) # yes 63, see ^^^^^^^^^^^^^^^ + cbit = (value & 1) + value >>= 1 + else: + # shift by 1 less, again to capture cbit + value <<= (shift - 1) + cbit = value & signmask + value <<= 1 + + value &= (signmask | (signmask - 1)) + cpu.psw_n = (value & signmask) + cpu.psw_z = (value == 0) + cpu.psw_v = (cpu.psw_n != vsign) + cpu.psw_c = cbit + + return value + + +def op074_xor(cpu, inst): + srcreg = (inst & 0o000700) >> 6 + r = cpu.r[srcreg] + + s, xb6 = cpu.operandx(inst & 0o077, rmw=True) + + r ^= s + + cpu.psw_n = (r & cpu.SIGN16) + cpu.psw_z = (r == 0) + cpu.psw_v = 0 + + cpu.operandx(xb6, r) + + +def op077_sob(cpu, inst): + srcreg = (inst & 0o000700) >> 6 + r = cpu.r[srcreg] + + if r == 1: + r = 0 + else: + if r > 0: + r -= 1 + else: + r = 0o177777 # 0 means max, that's how SOB is defined + + # technically if this instruction occurs low enough in memory + # this PC subtraction could wrap, so be technically correct & mask + cpu.r[cpu.PC] = (cpu.r[cpu.PC] - 2 * (inst & 0o077)) & cpu.MASK16 + + cpu.r[srcreg] = r + + +# dispatch on the next digit after the 07 part... +op07_dispatch_table = ( + op070_mul, + op071_div, + op072_ash, + op073_ashc, + op074_xor, + None, # various float instructions, not implemented + None, # CIS instructions, not implmented + op077_sob) diff --git a/op10.py b/op10.py new file mode 100644 index 0000000..1d0e70b --- /dev/null +++ b/op10.py @@ -0,0 +1,60 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + + +from branches import branches +from op00 import ops56tab # these have byte variants in op10 +from pdptraps import PDPTraps + + +# dispatch MOST (but not all) of the 105x and 106x instructions +# to the op00 routines but with byte variation (opsize=1). But +# there are exceptions: 1064 unused, 1065 MFPD, 1066 MTPD, 1067 unused +def op156(cpu, inst): + i56x = (inst & 0o7700) >> 6 + # 64 (mark) and 67 (sxt) do NOT have byte variants + if i56x in (0o64, 0o67): + raise PDPTraps.ReservedInstruction + try: + opf = ops56tab[i56x - 0o50] + except IndexError: + raise PDPTraps.ReservedInstruction + opf(cpu, inst, opsize=1) + + +def op10_4_emttrap(cpu, inst): + # bit 8 determines EMT (0) or TRAP(1) + if (inst & 0o000400): + raise PDPTraps.TRAP + else: + raise PDPTraps.EMT + + +op10_dispatch_table = ( + branches, + branches, + branches, + branches, + op10_4_emttrap, + op156, + op156, + None) diff --git a/op4.py b/op4.py new file mode 100644 index 0000000..dd5f606 --- /dev/null +++ b/op4.py @@ -0,0 +1,226 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# +# TOP LEVEL OP CODE DISPATCH AND INSTRUCTION IMPLEMENTATION +# +# NOTES: +# +# DISPATCH +# 2-operand instructions are implemented here and are dispatched +# off the top-4 bits of the instruction (hence "op4" name). +# +# The other instructions are encoded into the 0o00, 0o07, and 0o10 +# portions of this top-4 bit address space. They are dispatched +# via d3dispatch and respective tables from other modules. +# +# BYTE vs WORD operations: +# Most of them come in two flavors - word and byte, with the +# top-bit distinguishing. This is communicated to the implementation +# functions via "opsize=1" or "opsize=2" when a single function can +# implement both variations. Note that MOV/MOVB are specifically +# optimized, separately, for performance. +# +# PSW updates: +# All instructions must be careful to do their final result writes +# AFTER setting the PSW, because the PSW is addressible via memory +# (a write to unibus 777776) and such a write is supposed to override +# the otherwise-native instruction CC results. +# + +# dispatchers to next level for 00, 07, and 10 instructions: +from op00 import op00_dispatch_table +from op07 import op07_dispatch_table +from op10 import op10_dispatch_table +from pdptraps import PDPTraps + + +def d3dispatcher(d3table, cpu, inst): + opf = d3table[(inst & 0o7000) >> 9] + if opf is None: + raise PDPTraps.ReservedInstruction + opf(cpu, inst) + + +# This is ALWAYS a 16-bit MOV +def op01_mov(cpu, inst): + """MOV src,dst -- always 16 bits""" + + # avoid call to the more-general operandx for mode 0, direct register. + # This optimization is a substantial speed up for register MOVs. + if (inst & 0o7000) == 0: + val = cpu.r[(inst & 0o700) >> 6] + else: + val = cpu.operandx((inst & 0o7700) >> 6) + + cpu.psw_v = 0 # per manual; V is cleared + cpu.psw_z = (val == 0) + cpu.psw_n = (val > 32767) + + # same optimization on the write side. + if (inst & 0o70) == 0: + cpu.r[(inst & 0o07)] = val + else: + cpu.operandx(inst & 0o0077, val) + + +# This is ALWAYS an 8-bit MOVB +def op11_movb(cpu, inst): + """MOVB src,dst -- always 8 bits""" + + # avoid call to the more-general operandx for mode 0, direct register. + # This optimization is a substantial speed up for register MOVs. + if (inst & 0o7000) == 0: + val = cpu.r[(inst & 0o700) >> 6] & 0o377 + else: + val = cpu.operandx((inst & 0o7700) >> 6, opsize=1) + + cpu.psw_v = 0 + cpu.psw_z = (val == 0) + cpu.psw_n = (val & 0o200) + + # No optimization on the write side, because doing so would require + # duplicating the sign-extend logic here. Yuck. + cpu.operandx(inst & 0o0077, val, opsize=1) + + +def op02_cmp(cpu, inst, opsize=2): + """CMP(B) src,dst""" + src = cpu.operandx((inst & 0o7700) >> 6, opsize=opsize) + dst = cpu.operandx(inst & 0o0077, opsize=opsize) + + # note: this is other order than SUB + t = (src - dst) & cpu.MASK816[opsize] + cpu.psw_c = (src < dst) + signbit = cpu.SIGN816[opsize] + cpu.psw_n = (t & signbit) + cpu.psw_z = (t == 0) + + # definition of V is: operands were of opposite signs and the sign + # of the destination was the same as the sign of the result + src_sign = src & signbit + dst_sign = dst & signbit + t_sign = t & signbit + cpu.psw_v = (dst_sign == t_sign) and (src_sign != dst_sign) + + +def op03_bit(cpu, inst, opsize=2): + """BIT(B) src,dst""" + src = cpu.operandx((inst & 0o7700) >> 6, opsize=opsize) + dst = cpu.operandx(inst & 0o0077, opsize=opsize) + t = dst & src + + cpu.psw_n = t & cpu.SIGN816[opsize] + cpu.psw_z = (t == 0) + cpu.psw_v = 0 + # cpu.logger.debug(f"BIT: {src=}, {dst=}, PSW={oct(cpu.psw)}") + + +def op04_bic(cpu, inst, opsize=2): + """BIC(B) src,dst""" + src = cpu.operandx((inst & 0o7700) >> 6, opsize=opsize) + dst, xb6 = cpu.operandx(inst & 0o0077, opsize=opsize, rmw=True) + dst &= ~src + + cpu.psw_n = dst & cpu.SIGN816[opsize] + cpu.psw_z = (dst == 0) + + cpu.operandx(xb6, dst, opsize=opsize) + + +def op05_bis(cpu, inst, opsize=2): + """BIS(B) src,dst""" + src = cpu.operandx((inst & 0o7700) >> 6, opsize=opsize) + dst, xb6 = cpu.operandx(inst & 0o0077, opsize=opsize, rmw=True) + dst |= src + + cpu.psw_n = dst & cpu.SIGN816[opsize] + cpu.psw_z = (dst == 0) + cpu.psw_v = 0 + + cpu.operandx(xb6, dst, opsize=opsize) + + +def op06_add(cpu, inst): + """ADD src,dst""" + src = cpu.operandx((inst & 0o7700) >> 6) + dst, xb6 = cpu.operandx(inst & 0o0077, rmw=True) + t = src + dst + + cpu.psw_c = (t > cpu.MASK16) + if cpu.psw_c: + t &= cpu.MASK16 + + cpu.psw_n = (t & cpu.SIGN16) + cpu.psw_z = (t == 0) + + # definition of V is: operands were of the same signs and the + # sign of the result is different. + src_sign = src & cpu.SIGN16 + dst_sign = dst & cpu.SIGN16 + t_sign = t & cpu.SIGN16 + cpu.psw_v = (dst_sign != t_sign) and (src_sign == dst_sign) + + cpu.operandx(xb6, t) + + +def op16_sub(cpu, inst): + """SUB src,dst""" + src = cpu.operandx((inst & 0o7700) >> 6) + dst, xb6 = cpu.operandx(inst & 0o0077, rmw=True) + + t = (dst - src) & cpu.MASK16 # note: this is opposite of CMP + cpu.psw_n = (t & cpu.SIGN16) + cpu.psw_z = (t == 0) + + # definition of V is: operands were of opposite signs and the sign + # of the source was the same as the sign of the result + src_sign = src & cpu.SIGN16 + dst_sign = dst & cpu.SIGN16 + t_sign = t & cpu.SIGN16 + cpu.psw_v = (src_sign == t_sign) and (src_sign != dst_sign) + cpu.psw_c = (src > dst) + + cpu.operandx(xb6, t) + + +def op17_reserved(cpu, inst): + raise PDPTraps.ReservedInstruction + + +op4_dispatch_table = ( + lambda c, i: d3dispatcher(op00_dispatch_table, c, i), + op01_mov, + op02_cmp, + op03_bit, + op04_bic, + op05_bis, + op06_add, + lambda c, i: d3dispatcher(op07_dispatch_table, c, i), + lambda c, i: d3dispatcher(op10_dispatch_table, c, i), + op11_movb, # NOTE: optimized; not mov+lambda + lambda c, i: op02_cmp(c, i, opsize=1), # 12 + lambda c, i: op03_bit(c, i, opsize=1), # 13 + lambda c, i: op04_bic(c, i, opsize=1), # 14 + lambda c, i: op05_bis(c, i, opsize=1), # 15 + op16_sub, + op17_reserved) # 17 reserved diff --git a/pdptests.py b/pdptests.py new file mode 100644 index 0000000..60a5b81 --- /dev/null +++ b/pdptests.py @@ -0,0 +1,737 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from itertools import chain +from types import SimpleNamespace + +from machine import PDP1170 +from pdptraps import PDPTraps +import unittest +import random + + +class TestMethods(unittest.TestCase): + + PDPLOGLEVEL = 'INFO' + + # DISCLAIMER ABOUT TEST CODING PHILOSOPHY: + # For the most part, actual PDP-11 machine code is created and + # used to establish the test conditions, as this provides additional + # (albeit haphazard) testing of the functionality. Occasionally it's + # just too much hassle to do that and the pdp object is manipulated + # directly via methods/attributes to establish conditions. + # There's no rhyme or reason in picking the approach for a given test. + + # used to create various instances, collects all the options + # detail into this one place... + @classmethod + def make_pdp(cls): + return PDP1170(console=False, loglevel=cls.PDPLOGLEVEL) + + @staticmethod + def ioaddr(p, offs): + """Given a within-IO-page IO offset, return an IO addr.""" + return (offs + p.mmu.iopage_base) & 0o177777 + + # convenience routine to load word values into physical memory + @staticmethod + def loadphysmem(p, words, addr): + for a, w in enumerate(words, start=(addr >> 1)): + p.physmem[a] = w + + # some of these can't be computed at class definition time, so... + @classmethod + def usefulconstants(cls): + + p = cls.make_pdp() # meh, need this for some constants + + ns = SimpleNamespace() + + # Kernel instruction space PDR registers + ns.KISD0 = cls.ioaddr(p, p.mmu.APR_KERNEL_OFFS) + + # Kernel data space PDR registers + ns.KDSD0 = ns.KISD0 + 0o20 + + # Kernel instruction space PAR registers + ns.KISA0 = ns.KDSD0 + 0o20 + + # Kernel data space PAR registers + ns.KDSA0 = ns.KISA0 + 0o20 + + # User mode similar + ns.UISD0 = cls.ioaddr(p, p.mmu.APR_USER_OFFS) + ns.UDSD0 = ns.UISD0 + 0o20 + ns.UISA0 = ns.UDSD0 + 0o20 + ns.UDSA0 = ns.UISA0 + 0o20 + + return ns + + # + # Create and return a test machine with a simple memory mapping: + # Kernel Instruction space seg 0 points to physical 0 + # Kernel Data space segment 0 also points to physical 0 + # User instruction space seg 0 points to physical 0o20000 + # User Data space seg 0 points to physical 0o40000 + # and turns on the MMU + # + + def simplemapped_pdp(self, p=None, addons=[]): + if p is None: + p = self.make_pdp() + + cn = self.usefulconstants() + + # this is a table of instructions that ... + # Puts the system stack at 0o20000 (8K) + # Puts 0o22222 into physical location 0o20000 + # Puts 0o33333 into physical location 0o20002 + # Puts 0o44444 into physical location 0o40000 + # Sets Kernel Instruction space A0 to point to physical 0 + # Sets Kernel Data space A0 to point to the first 8K physical memory + # Sets Kernel Data space A7 to point to the IO page + # Sets User Instruction space A0 to point to physical 0o20000 + # sets User Data space D0 to point to physical 0o40000 + # and turns on the MMU with I/D sep + # + # These instructions will be placed at 2K in memory + # + setup_instructions = ( + 0o012706, 0o20000, # put system stack at 8k and works down + + 0o012737, 0o22222, 0o20000, + 0o012737, 0o33333, 0o20002, + 0o012737, 0o44444, 0o40000, + + # point both kernel seg 0 PARs to physical zero + 0o005037, cn.KISA0, # CLR $KISA0 + 0o005037, cn.KDSA0, # CLR $KDSA0 + + # kernel seg 7 D space PAR to I/O page (at 22-bit location) + 0o012737, 0o017760000 >> 6, cn.KDSA0 + (7 * 2), + + # user I seg 0 to 0o20000, user D seg 0 to 0o40000 + 0o012737, 0o20000 >> 6, cn.UISA0, + 0o012737, 0o40000 >> 6, cn.UDSA0, + + # set the PDRs for segment zero + + 0o012703, 0o077406, # MOV #77406,R3 + # 77406 = PDR<2:0> = ACF = 0o110 = read/write + # PLF<14:8> =0o0774 = full length (128*64 bytes = 8K) + 0o010337, cn.KISD0, # MOV R3,KISD0 ... + 0o010337, cn.KDSD0, + 0o010337, cn.UISD0, + 0o010337, cn.UDSD0, + # PDR for segment 7 + 0o010337, cn.KDSD0 + (7 * 2), + + + # set previous mode to USER, keeping current mode KERNEL, pri 7 + 0o012737, (p.KERNEL << 14) | (p.USER << 12) | (7 << 5), + self.ioaddr(p, p.PS_OFFS), + + # turn on 22-bit mode, unibus mapping, and I/D sep for k & u + 0o012737, 0o000065, self.ioaddr(p, p.mmu.MMR3_OFFS), + + # turn on relocation mode ... yeehah! (MMR0 known zero here) + 0o005237, self.ioaddr(p, p.mmu.MMR0_OFFS), # INC MMR0 + ) + + instloc = 0o4000 # 2K + self.loadphysmem(p, chain(setup_instructions, addons, (0o0,)), instloc) + return p, instloc + + # these tests end up testing a other stuff too of course, including MMU + def test_mfpi(self): + # ((r0, ..., rN) results, (instructions)), ... + tvecs = ( + + # r1=2, mfpi (r1) -> r0; expect r0 = 33333 + ((0o33333,), (0o012701, 0o02, 0o006511, 0o012600)), + + # r1=0, mfpi (r1) -> r0; expect r0 = 22222 + ((0o22222,), (0o012701, 0o00, 0o006511, 0o012600)), + ) + + for rslts, insts in tvecs: + with self.subTest(rslts=rslts, insts=insts): + p, pc = self.simplemapped_pdp(addons=insts) + p.run(pc=pc) + for rN, v in enumerate(rslts): + self.assertEqual(p.r[rN], v) + + def test_mtpi(self): + # need an instance just for the constants, meh + px = self.make_pdp() + tvecs = ( + ((0o1717,), (0o012746, 0o1717, 0o006637, 0o02, + # turn MMU back off (!) + 0o005037, self.ioaddr(px, px.mmu.MMR0_OFFS), + 0o013700, 0o20002)), + ) + for rslts, insts in tvecs: + with self.subTest(rslts=rslts, insts=insts): + p, pc = self.simplemapped_pdp(addons=insts) + p.run(pc=pc) + for rN, v in enumerate(rslts): + self.assertEqual(p.r[rN], v) + + def test_add_sub(self): + p = self.make_pdp() + + testvecs = ( + # (op0, op1, expected op0 + op1, nzvc, expected op0 - op1, nzvc) + # None for nzvc means dont test that (yet/for-now/need to verify) + (1, 1, 2, 0, 0, 4), # 1 + 1 = 2(_); 1 - 1 = 0(Z) + (1, 32767, 32768, 0o12, 32766, 0), + (0, 0, 0, 0o04, 0, 0o04), + (32768, 1, 32769, 0o10, 32769, 0o13), + (65535, 1, 0, 0o05, 2, 1), + ) + + testloc = 0o10000 + add_loc = testloc + sub_loc = testloc + 4 + + p.physmem[add_loc >> 1] = 0o060001 # ADD R0,R1 + p.physmem[(add_loc >> 1) + 1] = 0 + p.physmem[sub_loc >> 1] = 0o160001 # SUB R0,R1 + p.physmem[(sub_loc >> 1) + 1] = 0 + + for r0, r1, added, a_nzvc, subbed, s_nzvc in testvecs: + with self.subTest(r0=r0, r1=r1, op="add"): + p.r[0] = r0 + p.r[1] = r1 + p.run(pc=add_loc) + self.assertEqual(p.r[1], added) + if a_nzvc is not None: + self.assertEqual(p.psw & 0o17, a_nzvc) + + with self.subTest(r0=r0, r1=r1, op="sub"): + p.r[0] = r0 + p.r[1] = r1 + p.run(pc=sub_loc) + self.assertEqual(p.r[1], subbed) + if s_nzvc is not None: + self.assertEqual(p.psw & 0o17, s_nzvc) + + def test_bne(self): + p = self.make_pdp() + loopcount = 0o1000 + insts = ( + # Program is: + # MOV loopcount,R1 + # CLR R0 + # LOOP: INC R0 + # DEC R1 + # BNE LOOP + # HALT + 0o012701, loopcount, 0o005000, 0o005200, 0o005301, 0o001375, 0) + + instloc = 0o4000 + self.loadphysmem(p, insts, instloc) + + p.run(pc=instloc) + self.assertEqual(p.r[0], loopcount) + self.assertEqual(p.r[1], 0) + + def test_cc(self): + # various condition code tests + p = self.make_pdp() + insts = ( + # program is: + # CLR R0 + # BEQ 1f + # HALT + # 1: CCC + # BNE 1f + # HALT + # 1: DEC R0 + + # MOV @#05000,R1 ; see discussion below + # MOV @#05002,R2 ; see discussion below + # CMP R1,R2 + # BLE 1f + # HALT + # 1: DEC R0 + # CMP R2,R1 + # BGT 1f + # HALT + # 1: DEC R0 + # HALT + # + # and the program will poke various test cases into locations + # 5000 and 5002, with the proviso that 5000 is always the lesser. + # + # Given that, after running the program R0 should be 65553 + + 0o005000, 0o101401, 0o0, 0o000257, 0o001001, 0, 0o005300, + + # MOV @#5000 etc + 0o013701, 0o5000, 0o013702, 0o5002, + + # CMP R1,R2 BLE + 0o020102, 0o003401, 0, 0o005300, + + # CMP R2,R1 BGT + 0o020201, 0o003001, 0, 0o005300, + + 0) + + instloc = 0o4000 + self.loadphysmem(p, insts, instloc) + + # just a convenience so the test data can use neg numbers + def s2c(x): + return x & 0o177777 + + for lower, higher in ((0, 1), (s2c(-1), 0), (s2c(-1), 1), + (s2c(-32768), 32767), + (s2c(-32768), 0), (s2c(-32768), 32767), + (17, 42), (s2c(-42), s2c(-17))): + p.physmem[0o5000 >> 1] = lower + p.physmem[0o5002 >> 1] = higher + with self.subTest(lower=lower, higher=higher): + p.run(pc=instloc) + self.assertEqual(p.r[0], 65533) + + # probably never a good idea, but ... do some random values + for randoms in range(1000): + a = random.randint(-32768, 32767) + b = random.randint(-32768, 32767) + while a == b: + b = random.randint(-32768, 32767) + if a > b: + a, b = b, a + p.physmem[0o5000 >> 1] = s2c(a) + p.physmem[0o5002 >> 1] = s2c(b) + with self.subTest(lower=a, higher=b): + p.run(pc=instloc) + self.assertEqual(p.r[0], 65533) + + def test_unscc(self): + # more stuff like test_cc but specifically testing unsigned Bxx codes + p = self.make_pdp() + insts = ( + # program is: + # CLR R0 + # MOV @#05000,R1 ; see discussion below + # MOV @#05002,R2 ; see discussion below + # CMP R1,R2 + # BCS 1f ; BCS same as BLO + # HALT + # 1: DEC R0 + # CMP R2,R1 + # BHI 1f + # HALT + # 1: DEC R0 + # HALT + # + # test values in 5000,5002 .. unsigned and 5002 always higher + # + # Given that, after running the program R0 should be 65534 + + 0o005000, + + # MOV @#5000 etc + 0o013701, 0o5000, 0o013702, 0o5002, + + # CMP R1,R2 BCS + 0o020102, 0o103401, 0, 0o005300, + + # CMP R2,R1 BHI + 0o020201, 0o101001, 0, 0o005300, + + 0) + + instloc = 0o4000 + self.loadphysmem(p, insts, instloc) + + for lower, higher in ((0, 1), (0, 65535), (32768, 65535), + (65534, 65535), + (32767, 32768), + (17, 42)): + p.physmem[0o5000 >> 1] = lower + p.physmem[0o5002 >> 1] = higher + with self.subTest(lower=lower, higher=higher): + p.run(pc=instloc) + self.assertEqual(p.r[0], 65534) + + # probably never a good idea, but ... do some random values + for randoms in range(1000): + a = random.randint(0, 65535) + b = random.randint(0, 65535) + while a == b: + b = random.randint(0, 65535) + if a > b: + a, b = b, a + p.physmem[0o5000 >> 1] = a + p.physmem[0o5002 >> 1] = b + with self.subTest(lower=a, higher=b): + p.run(pc=instloc) + self.assertEqual(p.r[0], 65534) + + def test_ash1(self): + # this code sequence taken from Unix startup, it's not really + # much of a test. + insts = (0o012702, 0o0122451, # mov #122451,R2 + 0o072227, 0o0177772, # ash -6,R2 + 0o042702, 0o0176000, # bic #0176000,R2 + 0) # R2 should be 1224 + p = self.make_pdp() + instloc = 0o4000 + self.loadphysmem(p, insts, instloc) + p.run(pc=instloc) + self.assertEqual(p.r[2], 0o1224) + + def test_br(self): + # though the bug has been fixed, this is a test of whether + # all branch offset values work correctly. Barn door shut... + p = self.make_pdp() + + # the idea is a block of INC R0 instructions + # followed by a halt, then a spot for a branch + # then a block of INC R1 instructions followed by a halt + # + # By tweaking the BR instruction (different forward/back offsets) + # and starting execution at the BR, the result on R0 and R1 + # will show if the correct branch offset was effected. + # + # NOTE: 0o477 (branch offset -1) is a tight-loop branch to self + # and that case is tested separately. + # + insts = [0o5200] * 300 # 300 INC R0 instructions + insts += [0] # 1 HALT instruction + insts += [0o477] # BR instruction .. see below + + # want to know where in memory this br will is + brspot = len(insts) - 1 + + insts += [0o5201] * 300 # 300 INC R1 instructions + insts += [0] # 1 HALT instruction + + # put that mess into memory at an arbitrary spot + baseloc = 0o10000 + for a, w in enumerate(insts, start=(baseloc >> 1)): + p.physmem[a] = w + + # test the negative offsets: + # Set R0 to 65535 (-1) + # Set R1 to 17 + # -1 is a special case, that's the tight loop and not tested here + # -2 reaches the HALT instruction only, R0 will remain 65535 + # -3 reaches back to one INC R0, R0 will be 0 + # -4 reaches back two INC R0's, R0 will be 1 + # and so on + + # 0o400 | offset starting at 0o376 will be the BR -2 case + expected_R0 = 65535 + for offset in range(0o376, 0o200, -1): + p.physmem[(baseloc >> 1) + brspot] = (0o400 | offset) + p.r[0] = 65535 + p.r[1] = 17 + + # note the 2* because PC is an addr vs physmem word index + p.run(pc=baseloc + (2*brspot)) + + with self.subTest(offset=offset): + self.assertEqual(p.r[0], expected_R0) + self.assertEqual(p.r[1], 17) + expected_R0 = (expected_R0 + 1) & 0o177777 + + # and the same sort of test but with forward branching + + expected_R1 = 42 + 300 + for offset in range(0, 0o200): + p.physmem[(baseloc >> 1) + brspot] = (0o400 | offset) + p.r[0] = 17 + p.r[1] = 42 + + # note the 2* because PC is an addr vs physmem word index + p.run(pc=baseloc + (2*brspot)) + + with self.subTest(offset=offset): + self.assertEqual(p.r[0], 17) + self.assertEqual(p.r[1], expected_R1) + expected_R1 = (expected_R1 - 1) & 0o177777 + + def test_trap(self): + # test some traps + + p = self.make_pdp() + + # put a handlers for different traps into memory + # starting at location 0o10000 (4K). This just knows + # that each handler is 3 words long, the code being: + # MOV something,R4 + # RTT + # + # where the "something" changes with each handler. + handlers_addr = 0o10000 + handlers = ( + 0o012704, 0o4444, 0o000006, # for vector 0o004 + 0o012704, 0o1010, 0o000006, # for vector 0o010 + 0o012704, 0o3030, 0o000006, # for vector 0o030 + 0o012704, 0o3434, 0o000006 # for vector 0o034 + ) + self.loadphysmem(p, handlers, handlers_addr) + + # and just jam the vectors in place + p.physmem[2] = handlers_addr # vector 0o004 + p.physmem[3] = 0 # new PSW, stay in kernel mode + p.physmem[4] = handlers_addr + 6 # each handler above was 6 bytes + p.physmem[5] = 0 + p.physmem[12] = handlers_addr + 12 # vector 0o30 (EMT) + p.physmem[13] = 0 + p.physmem[14] = handlers_addr + 18 # vector 0o34 (TRAP) + p.physmem[15] = 0 + + # (tnum, insts) + testvectors = ( + # this will reference an odd address, trap 4 + (0o4444, ( + # establish reasonable stack pointer (at 8K) + 0o012706, 0o20000, + # CLR R3 and R4 so will know if they get set to something + 0o005003, 0o005004, + # put 0o1001 into R0 + 0o012700, 0o1001, + # and reference it ... boom! + 0o011001, + # show that the RTT got to here by putting magic into R3 + 0o012703, 0o123456)), + + # this will execute a reserved instruction trap 10 + (0o1010, ( + # establish reasonable stack pointer (at 8K) + 0o012706, 0o20000, + # CLR R3 and R4 so will know if they get set to something + 0o005003, 0o005004, + # 0o007777 is a reserved instruction ... boom! + 0o007777, + # show that the RTT got to here by putting magic into R3 + 0o012703, 0o123456)), + + # this will execute an EMT instruction + (0o3030, ( + # establish reasonable stack pointer (at 8K) + 0o012706, 0o20000, + # CLR R3 and R4 so will know if they get set to something + 0o005003, 0o005004, + # EMT #42 + 0o104042, + # show that the RTT got to here by putting magic into R3 + 0o012703, 0o123456)), + + # this will execute an actual TRAP instruction + (0o3434, ( + # establish reasonable stack pointer (at 8K) + 0o012706, 0o20000, + # CLR R3 and R4 so will know if they get set to something + 0o005003, 0o005004, + # TRAP #17 + 0o104417, + # show that the RTT got to here by putting magic into R3 + 0o012703, 0o123456)), + ) + + for R4, insts in testvectors: + self.loadphysmem(p, insts, 0o3000) + p.run(pc=0o3000) + self.assertEqual(p.r[3], 0o123456) + self.assertEqual(p.r[4], R4) + + def test_trapcodes(self): + # a more ambitious testing of TRAP which verifies all + # available TRAP instruction codes work + + p = self.make_pdp() + # poke the TRAP vector info directly in + p.physmem[14] = 0o10000 # vector 0o34 (TRAP) --> 0o10000 + p.physmem[15] = 0 + + # this trap handler puts the trap # into R3 + handler = ( + # the saved PC is at the top of the stack ... get it + 0o011600, # MOV (SP),R0 + # get the low byte of the instruction which is the trap code + # note that the PC points after the TRAP instruction so + # MOVB -2(R0),R3 + 0o116003, 0o177776, + # RTT + 6) + self.loadphysmem(p, handler, 0o10000) + + # just bash a stack pointer directly in + p.r[6] = 0o20000 # 8K and working down + + for i in range(256): + insts = ( + 0o104400 | i, # TRAP #i + 0o010301, # MOV R3,R1 just to show RTT worked + 0) + self.loadphysmem(p, insts, 0o30000) + p.run(pc=0o30000) + self.assertEqual(p.r[3], p.r[1]) + + # because the machine code did MOVB, values over 127 get + # sign extended, so take that into consideration + if i > 127: + trapexpected = 0xFF00 | i + else: + trapexpected = i + self.assertEqual(p.r[1], trapexpected) + + # test_mmu_1 .. test_mmu_N .. a variety of MMU tests. + # + # Any of the other tests that use simplemapped_pdp() implicitly + # test some aspects of the MMU but these are more targeted tests. + # NOTE: it's a lot easier to test via the methods than via writing + # elaborate PDP-11 machine code so that's what these do. + + def test_mmu_1(self): + # test the page length field support + p = self.make_pdp() + + # using ED=0 (segments grow upwards), create a (bizarre!) + # user DSPACE mapping where the the first segment has length 0, + # the second has 16, the third has 32 ... etc and then check + # that that valid addresses map correctly and invalid ones fault + # correctly. NOTE that there are subtle semantics to the so-called + # "page length field" ... in a page that grows upwards, a plf of + # zero means that to be INVALID the block number has to be greater + # than zero (therefore "zero" length really means 64 bytes of + # validity) and there is a similar off-by-one semantic to ED=1 + # downward pages. The test understands this. + + cn = self.usefulconstants() + for segno in range(8): + p.mmu.wordRW(cn.UDSA0 + (segno*2), (8192 * segno) >> 6) + pln = segno * 16 + p.mmu.wordRW(cn.UDSD0 + (segno*2), (pln << 8) | 0o06) + + # enable user I/D separation + p.mmu.MMR3 |= 0o01 + + # turn on the MMU! + p.mmu.MMR0 = 1 + + for segno in range(8): + basea = segno * 8192 + maxvalidoffset = 63 + ((segno * 64) * 16) + for o in range(8192): + if o <= maxvalidoffset: + _ = p.mmu.v2p(basea + o, p.USER, p.mmu.DSPACE, + p.mmu.CYCLE.READ) + else: + with self.assertRaises(PDPTraps.MMU): + _ = p.mmu.v2p(basea + o, p.USER, p.mmu.DSPACE, + p.mmu.CYCLE.READ) + + def test_mmu_2(self): + # same test as _1 but with ED=1 so segments grow downwards + # test the page length field support + p = self.make_pdp() + + cn = self.usefulconstants() + for segno in range(8): + p.mmu.wordRW(cn.UDSA0 + (segno*2), (8192 * segno) >> 6) + pln = 0o177 - (segno * 16) + p.mmu.wordRW(cn.UDSD0 + (segno*2), (pln << 8) | 0o16) + + # enable user I/D separation + p.mmu.MMR3 |= 0o01 + + # turn on the MMU! + p.mmu.MMR0 = 1 + + for segno in range(8): + basea = segno * 8192 + minvalidoffset = 8192 - (64 + ((segno * 64) * 16)) + for o in range(8192): + if o >= minvalidoffset: + _ = p.mmu.v2p(basea + o, p.USER, p.mmu.DSPACE, + p.mmu.CYCLE.READ) + else: + with self.assertRaises(PDPTraps.MMU): + _ = p.mmu.v2p(basea + o, p.USER, p.mmu.DSPACE, + p.mmu.CYCLE.READ) + + def test_ubmap(self): + p = self.make_pdp() + + ubmaps = self.ioaddr(p, p.ub.UBMAP_OFFS) + + # code paraphrased from UNIX startup, creates a mapping pattern + # that the rest of the code expects (and fiddles upper bits) + # So ... test that. + for i in range(0, 62, 2): + p.mmu.wordRW(ubmaps + (2 * i), i << 12 & 0o1777777) + p.mmu.wordRW(ubmaps + (2 * (i + 1)), 0) + + # XXX there is no real test yet because the UBMAPs + # are all just dummied up right now + + # this is not a unit test, invoke it using timeit etc + def speed_test_setup(self, *, loopcount=10000, mmu=True, inst=None): + + p, pc = self.simplemapped_pdp() + + # the returned pdp is loaded with instructions for setting up + # the mmu; only do them if that's what is wanted + if mmu: + p.run(pc=pc) + + # by default the instruction being timed will be MOV R1,R0 + # but other instructions could be used. MUST ONLY BE ONE WORD + if inst is None: + inst = 0o010100 + + # now load the test timing loop... 9 MOV R1,R0 instructions + # and an SOB for looping (so 10 instructions per loop) + + insts = (0o012704, loopcount, # loopcount into R4 + inst, + inst, + inst, + inst, + inst, + inst, + inst, + inst, + inst, + + 0o077412, # SOB R4 back to first inst + 0) # HALT + + instloc = 0o4000 + for a2, w in enumerate(insts): + p.mmu.wordRW(instloc + (2 * a2), w) + return p, instloc + + def speed_test_run(self, p, instloc): + p.run(pc=instloc) + + +if __name__ == "__main__": + unittest.main() diff --git a/pdptraps.py b/pdptraps.py new file mode 100644 index 0000000..885c0f6 --- /dev/null +++ b/pdptraps.py @@ -0,0 +1,70 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# exceptions representing processor traps + +from types import SimpleNamespace + + +class PDPTrap(Exception): + vector = -1 + + def __init__(self, cpuerr=0, **kwargs): + + # if specified, the cpuerr bit(s) will be OR'd into + # the CPU Error Register when the trap is processed by go_trap + self.cpuerr = cpuerr + + # any additional arguments that are specific per-trap info + # simply get stored as-is + self.trapinfo = kwargs + + def __str__(self): + s = self.__class__.__name__ + "(" + s += f"vector={oct(self.vector)}" + if self.cpuerr: + s += f", cpuerr={oct(self.cpuerr)}" + if self.trapinfo: + s += f", {self.trapinfo=}" + s += ")" + return s + + +# rather than copy/pasta the above class, they are made this way +# It's not clear this is much better +# XXX the for/setattr loop instead of a dict() in SimpleNamespace +# only because it seems to be more readable this way + +PDPTraps = SimpleNamespace() +for __nm, __v in ( + ('AddressError', 0o004), + ('ReservedInstruction', 0o010), + ('BPT', 0o014), + ('IOT', 0o20), + ('PowerFail', 0o24), + ('EMT', 0o30), + ('TRAP', 0o34), + ('Parity', 0o114), + ('PIRQ', 0o240), + ('FloatingPoint', 0o244), + ('MMU', 0o250)): + setattr(PDPTraps, __nm, type(__nm, (PDPTrap,), dict(vector=__v))) diff --git a/rp.py b/rp.py new file mode 100644 index 0000000..6856930 --- /dev/null +++ b/rp.py @@ -0,0 +1,317 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +# Emulate (a bare subset of) RP04..07 RM02-80 disks + +from types import SimpleNamespace + + +class RPRM: + RPADDR_OFFS = 0o16700 + + NSECT = 22 # sectors per track + NTRAC = 19 # tracks per cylinder + SECTOR_SIZE = 512 + + # NOTE: The key names become the attribute names. See __init__ + HPREG_OFFS = { + 'CS1': 0o00, # control and status register + 'WC': 0o02, # word count + 'UBA': 0o04, # UNIBUS address + 'DA': 0o06, # desired address + 'CS2': 0o10, # control/status register 2 + 'DS': 0o12, # drive status + 'AS': 0o16, # unified attention status + 'RMLA': 0o20, # lookahead (sector under head!!) + 'OFR': 0o32, # heads offset -- seriously, boot program?? + 'DC': 0o34, # desired cylinder + 'CC': 0o36, # "current cylinder" and/or holding register + 'BAE': 0o50, # address extension (pdp11/70 extra phys bits) + } + + HPDS_BITS = SimpleNamespace( + OFM=0o000001, # offset mode + VV=0o000100, # volume valid + DRY=0o000200, # drive ready + DPR=0o000400, # drive present + MOL=0o010000, # medium online + ) + + HPCS1_BITS = SimpleNamespace( + GO=0o000001, # GO bit + FN=0o000076, # 5 bit function code - this is the mask + IE=0o000100, # Interrupt enable + RDY=0o000200, # Drive ready + A16=0o000400, + A17=0o001000, + TRE=0o040000, + ) + + def __init__(self, ub, baseoffs=RPADDR_OFFS): + self.addr = baseoffs + self.ub = ub + self.logger = ub.cpu.logger + + self.command_history = [(0, tuple())] * 100 + # XXX needs to be configurable somehow + self._diskimage = open('rp.disk', 'r+b') + + for attr, offs in self.HPREG_OFFS.items(): + setattr(self, attr, 0) + + # CS1 is a special case in several ways + if attr == 'CS1': + ub.mmio.register(self.rw_cs1, baseoffs+offs, 1, + byte_writes=True, reset=True) + else: + # the rest are simple attributes; some as properties + ub.mmio.register_simpleattr(self, attr, baseoffs+offs) + + # XXX obviously this is just fake for now + self.DS = (self.HPDS_BITS.DPR | self.HPDS_BITS.MOL | + self.HPDS_BITS.VV | self.HPDS_BITS.DRY) + + def __del__(self): + try: + self._diskimage.close() + except (AttributeError, TypeError): + pass + self._diskimage = None + + # Pass __del__ up the inheritance tree, carefully. + # Note that __del__ is not always defined, Because Reasons. + getattr(super(), '__del__', lambda self: None)(self) + + @property + def UBA(self): + return self._uba + + @UBA.setter + def UBA(self, value): + self.logger.debug(f"UBA address being set to {oct(value)}") + self._uba = value + + @property + def CS2(self): + return self._cs2 + + @CS2.setter + def CS2(self, value): + self.logger.debug(f"CS2: value={oct(value)}") + self._cs2 = value + + @property + def DS(self): + return (self._ds | self.HPDS_BITS.DPR | self.HPDS_BITS.MOL | + self.HPDS_BITS.VV | self.HPDS_BITS.DRY) + + @DS.setter + def DS(self, value): + self._ds = value + + @property + def CS1(self): + # XXX what if CS1 is just always RDY?? + self._cs1 |= self.HPCS1_BITS.RDY + + # --- XXX DEBUGGING XXX --- + if (self._cs1 & 0x4000): + self.logger.debug(f"RP: XXX! CS1={oct(self._cs1)}") + self.logger.debug(f"RP: reading CS1: {oct(self._cs1)}") + return self._cs1 + + @CS1.setter + def CS1(self, value): + self.command_history.pop(-1) + self.command_history.insert(0, (value, self.statestring())) + + self.logger.debug(f"RP: writing CS1 to {oct(value)}; " + f"state: {self.statestring()}") + self._cs1 = value + self.logger.debug(f"RP: CS1 set to {oct(self._cs1)}") + if self._cs1 & 0x4000: + self.logger.debug(f"LOOK!!!! XXX") + if self._cs1 & self.HPCS1_BITS.RDY: + self.AS = 1 # this is very bogus but maybe works for now + + # TRE/ERROR always cleared on next op + if value & self.HPCS1_BITS.GO: + self._cs1 &= ~self.HPCS1_BITS.TRE + + match value & self.HPCS1_BITS.FN, value & self.HPCS1_BITS.GO: + case 0, go: + self._cs1 &= ~go + + case 0o06 | 0o12 | 0o16 | 0o20 | 0o22 as fcode, go: + self.logger.debug(f"RP: operation {oct(fcode)} ignored.") + self.logger.debug(self.statestring()) + self._cs1 &= ~(go | fcode) + self._cs1 |= self.HPCS1_BITS.RDY + if self._cs1 & self.HPCS1_BITS.IE: + self.ub.intmgr.simple_irq(5, 0o254) + + case 0o30, 1: # SEARCH + self._cs1 &= ~0o31 + self._cs1 |= self.HPCS1_BITS.RDY + self.CC = self.DC + if self._cs1 & self.HPCS1_BITS.IE: + self.ub.intmgr.simple_irq(5, 0o254) + + case 0o60, 1: + self._cs1 &= ~0o61 + self.writecmd() + if self._cs1 & self.HPCS1_BITS.IE: + self.ub.intmgr.simple_irq(5, 0o254) + + case 0o70, 1: + self._cs1 &= ~0o71 + self.readcmd() + if self._cs1 & self.HPCS1_BITS.IE: + self.ub.intmgr.simple_irq(5, 0o254) + + case _, 0: # anything else without the go bit is a nop + pass + + case _: # but with the go bit, bail out for now + raise ValueError(value) + + # special function for handling writes to the CS1 attribute + # Because byte writes to the upper byte need to be treated carefully + def rw_cs1(self, addr, value=None, /, *, opsize=2): + + if opsize == 1: + # by definition byte reads are impossible; this will obviously + # bomb out if they happen somehow (it is physically impossible + # to have a byte write on the real UNIBUS) + value &= 0o377 # paranoia but making sure + self.logger.debug(f"RP: BYTE addr={oct(addr)}, " + f"{value=}, _cs1={oct(self._cs1)}") + self.logger.debug(self.statestring()) + if addr & 1: + self._cs1 = (value << 8) | (self._cs1 & 0o377) + else: + self.CS1 = (self._cs1 & 0o177400) | value + elif value is None: + return self.CS1 # let property getter do its thing + else: + self.CS1 = value # let property setter do its thing + return None + + def _compute_offset(self): + # cyl num, track num, sector num, which were written like this: + # HPADDR->hpdc = cn; + # HPADDR->hpda = (tn << 8) + sn; + cn = self.DC + tn = (self.DA >> 8) & 0o377 + sn = self.DA & 0o377 + + # each cylinder is NSECT*NTRAC sectors + # each track is NSECT sectors + offs = cn * (self.NSECT * self.NTRAC) + offs += (tn * self.NSECT) + offs += sn + offs *= self.SECTOR_SIZE + return offs + + def readcmd(self): + offs = self._compute_offset() + self.logger.debug(f"RP READ: offs=0x{hex(offs)}, {self.WC=}") + + addr = self._getphysaddr() + self._diskimage.seek(offs) + nw = (65536 - self.WC) + sector = self._diskimage.read(nw*2) + + # Note conversion: from little-endian on disk to native 0 .. 65535 + self.ub.cpu.physRW_N(addr, nw, self.__b2wgen(sector)) + self.WC = 0 + self.CS1 |= self.HPCS1_BITS.RDY + + def writecmd(self): + offs = self._compute_offset() + self.logger.debug(f"RP WRITE: offs=0x{hex(offs)}, {self.WC=}") + + addr = self._getphysaddr() + self._diskimage.seek(offs) + nw = (65536 - self.WC) + + # Words in physmem are just python integers; they have to be + # converted into a little-endian byte stream for disk... + sector = bytes(self.__w2bgen(self.ub.cpu.physRW_N(addr, nw))) + self._diskimage.write(sector) + self.WC = 0 + self.CS1 |= self.HPCS1_BITS.RDY + + def __b2wgen(self, b): + """Generate native python ints from sequence of little endian bytes""" + g = iter(b) + for lo in g: + hi = next(g) + yield lo + (hi << 8) + + def __w2bgen(self, words): + """Generate little-endian bytes from sequence of python ints""" + for w in words: + yield w & 0o377 + yield (w >> 8) & 0o377 + + def _getphysaddr(self): + # low 16 bits in UBA, and tack on A16/A17 + A16 = bool(self.CS1 & self.HPCS1_BITS.A16) + A17 = bool(self.CS1 & self.HPCS1_BITS.A17) + + # but also bits may be found in bae... the assumption here is + # if these bits are non-zero they override A16/A17 but they + # really need to be consistent... + if self.BAE == 0: + A1621 = 0 + else: + A16 = 0 # subsumed in A1621 + A17 = 0 # subsumed + A1621 = self.BAE & 0o77 + + phys = self.UBA | (A16 << 16) | (A17 << 17) | (A1621 << 16) + self.logger.debug(f"RP: physaddr={oct(phys)}") + return phys + # return self.UBA | (A16 << 16) | (A17 << 17) | (A1621 << 16) + + def statestring(self): + s = "RP XXX:" + for attr in self.HPREG_OFFS: + s += f"{attr}={oct(getattr(self, attr, 0))} " + return s + + # produce a pretty-print version of a single RP history + @staticmethod + def rph_pps(rph): + written = rph[0] + s = f"CS1 <-- {oct(written)} : " + cmd = written & 0o70 + s += {0o70: 'READ', 0o60: 'WRITE', 0o30: 'SEARCH'}.get(cmd, oct(cmd)) + if rph[0] & 1: + s += "|GO" + if written & 0o100: + s += "|IE" + if written & 0o040000: + s += "|TRE" + s += f"\n {rph[1]}" + return s diff --git a/unibus.py b/unibus.py new file mode 100644 index 0000000..d88803d --- /dev/null +++ b/unibus.py @@ -0,0 +1,74 @@ +# MIT License +# +# Copyright (c) 2023 Neil Webber +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +from interrupts import InterruptManager +from mmio import MMIO + +# A convenient reference for addresses: +# https://gunkies.org/wiki/UNIBUS_Device_Addresses + + +class UNIBUS: + def __init__(self, cpu): + self.cpu = cpu + self.mmio = MMIO(cpu) + self.intmgr = InterruptManager() + + def resetbus(self): + self.mmio.resetdevices() + + +class UNIBUS_1170(UNIBUS): + UBMAP_OFFS = 0o10200 + UBMAP_N = 62 + + def __init__(self, cpu): + super().__init__(cpu) + + # UBAs being 32-bit (well, really 22 bit) values, they + # are just stored natively that way and broken down + # into 16-bit components by the mmio function as needed. + self.ubas = [0] * (self.UBMAP_N // 2) + self.mmio.register(self.uba_mmio, self.UBMAP_OFFS, self.UBMAP_N) + + def uba_mmio(self, addr, value=None, /): + ubanum, hi22 = divmod(addr - self.UBMAP_OFFS, 4) + uba22 = self.ubas[ubanum] + + self.cpu.logger.debug(f"UBA addr={oct(addr)}, {value=}") + self.cpu.logger.debug(f"{ubanum=}, {hi22=}") + + if value is None: + if hi22 == 0: + return (uba22 >> 16) & 0o077 + else: + return uba22 & 0o177777 + else: + # the low bit is enforced to be zero + if hi22: + uba22 = ((value & 0o077) << 16) | (uba22 & 0o177776) + else: + uba22 = (uba22 & 0o17600000) | (value & 0o177776) + self.ubas[ubanum] = uba22 + + def busRW(self, ubaddr, value=None): + pass