! Virtual memory management, 
! Bus error handling,
! Address translation fault handling,
! Page fault handling.

%option "-low-nons-nocheck-nodiag-nostack"
%include "mouse:nmouse.inc-nolist"
%externalintegerfnspec stoi(%string(255)s)

%constinteger -
  lbpp=10, bpp=1<<lbpp {1k bytes per page},
  lppt=8,  ppt=1<<lppt {256 pages per page table},
  ltps=6,  tps=1<<ltps {64 page tables per address space}
! NB a page table is the same size as a page,
! but a page table index is only 256 bytes long.
! At present there is no special alignment requirement
! on either page tables or page table indices.

%recordformatspec ptefm
%recordformat ppdfm(%record(queuefm)q %or -
      %byte *,mode,%half pba,%record(ptefm)%name pte)
%recordformat ptefm(%byte mode %orinteger pba %orrecord(ppdfm)%name ppd)
%recordformat ptfm(%record(ptefm)%array pte(0:ppt-1))
%recordformat ptifm(%record(ptfm)%namearray pt(0:tps-1))

%recordformat astfm (%byte asn,*)
%recordformat mmufm -
  (%record(astfm)%array ast(0:15),
   %half lba,lam,pba, %byte asn,sr,asm,dp, *,ivr, *,gsr, *,lsr, *,
   (%writeonlybyte ssr %or %readonlybyte tdo),
   %readonlybyte *,*, *,*, *,*, *,idp, *,rdp, *,dto, *,ldo)
@16_100000 %record(mmufm) mmu0,mmu1

@16_1004 %integer gla,berrvec
%owninteger maxslot=63
%owninteger nextslot=0,firstslot=0

%ownrecord(ppdfm)%namearray active desc(0:63)
%ownrecord(queuefm)hot,cold
%ownrecord(ptifm)%name gpti

%routine clash check(%integer b)
  rompstr("*MMU desc clash*") %and rompsym(nl) %unless b=0
%end

%routine bus error handler
@0(a7) %integerarray r(0:14),
%half sr,%integer pc,%half fw,ssw,%integer fa,*,*,*,*,*,*,*,*,*,
%half newsr,%integer newpc,%half newfw
%register(d7)%integer flags

  %routine fatal(%registerstring(*)%name s)
  %constinteger N=16; !In case of looping, report every Nth error directly
  %label here
    *addq.l #4,sp     {discard return address
    $if N#0
      %owninteger aargh=0
      aargh = aargh+1
      %if aargh&(N-1)=0 %start
        *temp
        *move.l a0,a2
        rompstr(s;" in ";currentprocess_name); rompsym(' ')
        romphex(fa);rompsym(nl)
        *move.l a2,a0
      %finish
    $finish
    *temp d0/a1
    d0 = 1            {1 is FC for UD}
    *=16_4E7B;*=1     {movec d0,dfc}
    d0 = r(0); *=16_EAD;*=16_800; *=296 {moves.l d0,event_regs(0)
    d0 = r(1); *=16_EAD;*=16_800; *=300 {moves.l d0,event_regs(1)
    d0 = r(2); *=16_EAD;*=16_800; *=304 {moves.l d0,event_regs(2)
    d0 = r(8); *=16_EAD;*=16_800; *=328 {moves.l d0,event_regs(8)
    newfw = 0
    newsr = sr
    newpc = addr(here)
    *movem.l r(3),d3-d7
    *movem.l r(9),a1-a6
    d0 = pc
    d1 = 2
    d2 = fa
    *lea newsr,a7
    *rte
here: *move.l d0,-(sp)
    d0 = 16_70
    *jmp 16_3efa
  %end

%routine new desc(%integer fa,mode,phy)
! Commandeer the next MMU slot, noting whether that page has been modified.
! Then use it to describe the page defined by the parameters.
%record(ppdfm)%name ppd
%record(mmufm)%name u
%integer s
  nextslot = nextslot+1; nextslot = firstslot %if nextslot>maxslot
  u == mmu0[nextslot>>5]; u_dp = nextslot&31
  s = u_tdo; u_ssr = 0
  ppd == activedesc(nextslot)
  activedesc(nextslot) == nil
  %unless ppd==nil %start
    exqueue(ppd_q)
    %if s&4=0 %then enqueue(ppd_q,cold) %else enqueue(ppd_q,hot)
  %finish
  u_asn = currentprocess_asn
  u_asm = mode&16_40!16_BF
  u_lam <- 16_ffff<<(lbpp-8)
  u_lba = fa>>8
  u_pba = phy
  u_sr = mode&3
  clash check(u_ldo)
%end

%conststring -
 ipa = "Invalid address (bus error)",
 iva = "Invalid address (not readable)",
 wpv = "Invalid address (not writeable)"

%own-
%record(ptifm)%name pti,
%record(ptfm)%name pt,
%record(ptefm)%name pte,
%record(ppdfm)%name ppd,
%integer retries=0,rfa

  *otsr #16_700
  *movem.l d0-d7/a0-a6,-(sp)
  a4 = gla; d4 = 0
  %if 1#ssw&7#2 %or currentprocess==nil %start
    rompstr("*Fatal bus error ")
    romphex4(ssw); rompsym(' '); romphex(fa)
    rompstr(" at "); romphex4(sr); rompsym(' ')
    romphex(pc); rompsym(' '); romphex4(fw)
    rompstr(" (no process)") %if currentprocess==nil; rompsym(nl)
    %cycle; %repeat
  %finish
  flags = mmu0_gsr
! %if flags&64#0 %start
!   rompstr("*Double MMU fault "); romphex2(mmu0_gsr); rompsym(' ')
!   romphex4(ssw); rompsym(' '); romphex(fa); rompsym(nl)
! %finish
  %if flags&128=0 %start   {no MMU fault indicated
    rfa = fa
    retries = retries+1
    fatal(ipa) %if retries>=100
    mmu0_gsr = 0
  %else
!   %if retries>0 %start
!     rompstr("*Spurious bus error at "); romphex(rfa)
!     rompstr(" resolved")
!     %unless retries=1 %start
!       rompstr(" after "); romphex2(retries); rompstr(" attempts")
!     %finish
!     rompsym(nl)
!     retries = 0
!   %finish
    flags = mmu0_lsr!mmu1_lsr
    mmu0_gsr = 0
    fatal(wpv) %if flags&16_F0#16_A0  {Not USA: assume WV}
    pti == currentprocess_pti
    *clr.b pti   {get rid of ASN part}
    %cycle
      %unless pti==nil %start
        pt == pti_pt(fa>>(lbpp+lppt)&(tps-1))
        %unless pt==nil %start
          pte == pt_pte(fa>>lbpp&(ppt-1))
          %if pte_pba<0 %start
            new desc(fa,pte_mode,pte_pba)
            %exit
          %finish
          %if pte_pba>0 %start
            ppd == pte_ppd
            new desc(fa,ppd_mode,ppd_pba)
            activedesc(nextslot) == ppd
            %exit
          %finish
        %finish
      %finish
      fatal(iva) %if pti==gpti
      pti == gpti
    %repeat
  %finish
  *movem.l (sp)+,d0-d7/a0-a6
  *rte
%end

%systemroutine map page(%integer log,phy,mode,%record(ptifm)%name index)
%record(ptfm)%name pt
%record(ptefm)%name pte
%integer page,table
  page = log>>lbpp; table = page>>lppt
  pt == index_pt(table)
  %if pt==nil %start
    pt == new(pt); pt = 0; index_pt(table) == pt
  %finish
  pte == pt_pte(page&(ppt-1))
  pte_pba = phy>>8
  pte_mode = mode!128
%end

%routine map range(%integer from,to,mode,%record(ptifm)%name index)
%integer ad = from
  %while ad<to %cycle
    map page(ad,ad,mode,index)
    ad = ad+bpp
  %repeat
%end

%constinteger userbit=128,privbit=64
%constinteger readwrite=1,readonly=3

%externalroutine become process(%integer bytes)
%record(mar fm)%name om,nm
%record(ptifm)%name pti
%integer i
%integername evlink
%label return
! Copy active module list
  om == poa_filelist
  poa_filelist == nil
  %cycle
    i = 0
    i = i+1 %while i<length(om_name) %and charno(om_name,i+1)#' '
    nm == record(heapget(sizeof(nm)-255+i))
    nm_start = om_start; nm_size = om_size
    nm_gla = om_gla; nm_name = substring(om_name,1,i)
    nm_next == poa_filelist; poa_filelist == nm; om == om_next
  %repeatuntil om==nil
! Claim workspace for new process
  currentprocess_ownlimit = freebot
  i = (a7-bytes-256)&-1024
  %signal 2,1,freebot-i,"Not enough space to become process" %if i<freebot
  freetop = i
  currentprocess_stackbase = freetop
! Set up VM tables
  i = currentprocess_asn
  pti == new(pti)
  currentprocess_pti == pti
  currentprocess_asn = i
  pti = 0
  map range(currentprocess_stackbase,currentprocess_stacklimit,readwrite,pti)
  map range(currentprocess_ownbase,currentprocess_ownlimit,readwrite,pti)
  map range(addr(currentprocess),addr(currentprocess[1]),privbit+readonly,pti)
  map range(a5,a5+1024,readwrite,pti)
! Set up heap
  poa_heapbase = freetop
  integer(freetop) = 0
  poa_stacklimit = freetop+256
! Link in trap block set up by loader
  evlink == poa_evlink
  evlink == integer(evlink) %while evlink<a5
  evlink = a5-12
{{printstring(" starting ";currentprocess_name); newline
! Set up supervisor stack frame and join run queue
  movetosr(16_2700)
  a7 = a5+2048
  *move.w #0,-(sp)       {format/vector word
  *pea return            {PC
  *move.w #0,-(sp)       {SR
  *movem.l d0-d1/a0-a1/a4,-(sp)
  *mfusp a4
  *movem.l d2-d7/a2-a6,-(sp)
  *move.l 60(sp),a4
  current process_ssp = a7
  enqueue(currentprocess_header,currentprocess_runqueue_header)
! Return to loader process
  a7 = memtop
  a5 = a7-2048
  current process == record(a5+1024)
  currentprocess_asn = (currentprocess_asn+1)!userbit!privbit
  *mtsr #16_700
  a7 = freetop
  %stop
return:
{{printstring(currentprocess_name;" started"); newline
%end

%externalrecord(process fm)%map create subprocess(%integer size,pc)
! *order: SIZE[3]==caller's GLA*
%integer evl,usp,ssp,bot,top
%record(process fm)%name newprocess
%record(poa fm)%name newpoa

  %routine push(%integer x)
    ssp = ssp-4; integer(ssp) = x
  %end

  %onevent 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
    rompstr(currentprocess_name)
    %if event_event!event_sub=0 %then rompstr(" stopped") %elsestart
      rompstr(" crashed: "); romphex1(event_event)
      rompsym(' '); romphex2(event_sub); rompsym(' ')
      romphex(event_extra); rompsym(' '); rompstr(event_message)
    %finish
    rompsym(nl)
    semaphorewait(nil)
  %finish

  evl = poa_evlink; poa_evlink = integer(evl)
  bot = heapget(size+4096)
  top = bot+size+4096
  bot = (bot+1023)&-1024
  top = top&-1024
  ssp = top
  newprocess == record(top-1024)
  usp = top-2048
  newpoa == record(usp)
  newprocess = currentprocess; newprocess_asn = newprocess_asn!128
  newprocess_name = "Sub-process of ".newprocess_name
  newpoa = poa
  newpoa_heapbase = bot; integer(bot) = 0; newpoa_stacklimit = bot+256
  usp = usp-12
  integer(usp) = 0
  integer(usp+4) = integer(evl+4)
  integer(usp+8) = integer(evl+8)
  newpoa_evlink = usp
  push(pc<<16); push(pc>>16) {[SR=0;PC;FW=0]}
  push(size[3]{caller's A4};a1;a0;d1;d0)
  push(a6;addr(newpoa);usp;a3;a2;d7;d6;d5;d4;d3;d2)
  newprocess_ssp = ssp
  movetosr(16_2000)
    mmu0_ast(1)_asn = currentprocess_asn&127
  movetosr(16_700)
    enqueue(newprocess_header,newprocess_runqueue_header)
  movetosr(0)
  mmu0_ast(1)_asn = currentprocess_asn
  %result == newprocess
%end

%begin
%integer i,min=freebot>>lbpp+1,max=freetop>>lbpp-1
%record(ppdfm)%array ppd(min:max)

%routine premap(%integer n,mode,as,log)
! Set up a transparently mapped descriptor in MMU0.
! Use slot N, with MODE either READONLY or READWRITE.
! AS specifies both ASM and ASN, LOG specifies both LAM and LBA.
%register(a0)%record(mmufm)%name u == mmu0
  u_dp = n   {select}
  u_ssr = 0  {invalidate}
  u_sr = mode; u_asm = as>>8; u_asn = as
  u_lam = log>>16; u_lba = log; u_pba = log
  clash check(u_ldo)
%end

! At reset, desc 0 will have ASM/ASN 16_FF00, which we wish to
! change to 16_8000, so that any ASN less than 128 will enjoy
! unrestricted transparent address mapping.
! In order to achieve this without getting a clash, we temporarily
! set up desc 1 for transparent mapping using a different ASN.

  premap(1,readwrite,16_FFFF,0)
  mmu0_ast(1)_asn = 16_FF
  mmu0_ast(2)_asn = 16_FF
  premap(0,readwrite,16_8000,0)
  mmu0_ast(1)_asn = 0
  mmu0_ast(2)_asn = 0
  premap(1, readonly,16_8080,16_ffc00000)
  premap(2,readwrite,16_c0c0,16_ff808000)
  premap(3,readwrite,16_8080,16_fc00e000)
  premap(4,readwrite,16_c0c0,16_ffff4000)
  firstslot = 5; nextslot = 5
  maxslot = stoi(cliparam) %unless cliparam=""
  maxslot = 63 %if maxslot>63; maxslot = 3 %if maxslot<3
{{printstring("Using "); write(maxslot,0); printstring(" MMU slots"); newline

  activedesc=0
  setupqueue(cold;hot)

  gla = a4
  *lea buserrorhandler,a0
  *move.l a0,berrvec

  gpti == new(gpti); gpti = 0
  map range(0,16_4000,readonly,gpti)
  map range(16_800000,16_808000,privbit+readwrite,gpti)
  map range(16_e00000,16_e40000,readwrite,gpti)
  map range(16_400000,16_400100,privbit+readwrite,gpti)
  map range(addr(messagepool),addr(messagepool[1]),privbit+readwrite,gpti)
  map range(addr(objectpool),addr(objectpool[1]),privbit+readonly,gpti)
  map range(membot,globalcodelimit,readonly,gpti)

  currentprocess_asn = currentprocess_asn&127
  becomeprocess(1000)
  min = freebot>>lbpp+1
  max = freetop>>lbpp-1
  %for i = min,1,max %cycle
    ppd(i) = 0; enqueue(ppd(i)_q,cold)
  %repeat
  semaphorewait(nil) {for now}

%end