!  File  NMOUSE:MAPPER

! Mapper

%option "-low-nons-nocheck-nodiag-nostack"
%include "mouse.inc"

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

%externalintegerfnspec stoi(%string(255)s)
%externalintegerfnspec wildness(%string(255)s)
%externalpredicatespec matches(%string(255)a,b)
%externalrecord(fcb fm)%mapspec file open input(%string(255)f)
%externalintegerfnspec fcb size(%record(fcb fm)%name f)
%externalroutinespec fcb read(%record(fcb fm)%name f,%integer p,a,%name b)
%externalroutinespec fcb close(%record(fcb fm)%name f)

%constinteger -
  lbpp=10, bpp=1<<lbpp  {1k bytes per page},
  lppt=8,  ppt=1<<lppt  {256 pages per page table},
  ltpi=6,  tpi=1<<ltpi  {64 page tables per index}
! 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 slot,mode,%half pba,%record(ptefm)%name pte)
%recordformat ptefm(%record(ppdfm)%name ppd %or -
      %byte type,mode,%half pba)
%recordformat ptfm(%record(ptefm)%array pte(0:ppt-1))
%recordformat ptifm(%record(ptfm)%namearray pt(0:tpi-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)mmu

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

%ownrecord(ppdfm)%namearray active desc(0:63)
%ownrecord(queuefm)hot,cold
%ownrecord(ptifm)%name gpti
%ownrecord(ptifm)%name pti
%ownrecord(ptfm)%name pt
%ownrecord(ptefm)%name pte
%ownrecord(ppdfm)%name ppd
%owninteger retries=0,rfa

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

%conststring -
 odd = "Address (alignment) error",
 ipa = "Bus error",
 iva = "Invalid virtual address",
 wpv = "Write protection violation",
 prv = "Access protection violation"

@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,%register(d1)%integer subevent)
%constinteger N=100; !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 %start
      aargh = 0
      *temp
      *move.l a0,a2
      rompstr(s;" in ";currentprocess_name); rompsym(' '); romphex4(sr)
      rompsym(' '); romphex(pc); rompsym(' '); romphex4(fw)
      rompsym(' '); romphex4(ssw); rompsym(' '); romphex(fa);rompsym(nl)
      *move.l a2,a0
    %finish
  $finish
  *temp d0/a1
  *movem.l r(3),d3-d7
  *movem.l r(9),a1-a6
  retries = 0
  %if cputype=68000 %start
    d0 = pc
    pc = addr(here)
    d2 = fa
    ssw = sr; fa = pc
    *lea ssw,a7
  %else
    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)
    d0 = pc
    d2 = fa
    *lea newsr,a7
  %finish
  *rte
here: *move.l d0,-(sp)
  d0 = 16_70
  *jmp 16_3efa
%end

%routine address error handler
  *otsr #16_700
  *movem.l d0-d7/a0-a6,-(sp)
  a4 = gla; d4 = 0
  %if cputype=68000 %start
    flags = pc; pc = fa; fa = flags
    flags = sr; sr = ssw; ssw = flags
  %finish
  %if 1#ssw&7#2 %or currentprocess==nil %start
    rompstr("*Fatal address 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
  fatal(odd,3)
%end

%routine bus error handler

  %predicate 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.
  ! Result false if there's trouble.
  %record(ppdfm)%name ppd
  %record(ptefm)%name pte
  %record(mmufm)%name u
  %integer s
    %if mode&privbit#0 %start                  {page is protected}
      %falseif currentprocess_asn&privbit=0    {no privilege}
    %finish
    nextslot = nextslot+1; nextslot = firstslot %if nextslot>maxslot
    u == mmu[nextslot>>5]; u_dp = nextslot&31
    s = u_tdo; u_ssr = 0
    ppd == activedesc(nextslot)
    activedesc(nextslot) == nil
    %unless ppd==nil %start
      pte == ppd_pte
      exqueue(ppd_q)
      %if s&4=0 %start
        enqueue(ppd_q,cold)
      %else
        enqueue(ppd_q,hot)
        ppd_mode = ppd_mode!4
      %finish
      ppd_slot = 0; ppd_pte == pte
    %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&7
    %trueif u_ldo=0; %false
  %end

%switch t(0:3)

  *otsr #16_700
  *movem.l d0-d7/a0-a6,-(sp)
  a4 = gla; d4 = 0
  %if cputype=68000 %start
    flags = pc; pc = fa; fa = flags
    flags = sr; sr = ssw; ssw = flags
  %finish
  %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
  fatal(ipa,2) %if cputype=68000
  flags = mmu_gsr
  %if flags&64#0 %start
    rompstr("*Double MMU fault "); romphex2(mmu_gsr); rompsym(' ')
    romphex4(ssw); rompsym(' '); romphex(fa); rompsym(nl)
  %finish
  %if flags&128=0 %start   {no MMU fault indicated
    retries = 0 %if rfa#fa
    rfa = fa
    retries = retries+1
    fatal(ipa,2) %if retries>=100
    mmu_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 = mmu_lsr!mmu[1]_lsr
    mmu_gsr = 0
    %if flags&16_F0#16_A0 %start {Not USA: assume WV}
      fatal(wpv,2)
    %finish
    pti == currentprocess_pti
    *clr.b pti   {get rid of ASN part}
    %cycle
      %unless pti==nil %start
        pt == pti_pt(fa>>(lbpp+lppt)&(tpi-1))
        %unless pt==nil %start
          pte == pt_pte(fa>>lbpp&(ppt-1))
          ->t(pte_type&3)
        %finish
      %finish
t(0): fatal(iva,2) %if pti==gpti
      pti == gpti
    %repeat
  %finish
t(1):
  fatal(prv,2) %unless new desc(fa,pte_mode,pte_pba)
  ->done
t(2):
  ppd == pte_ppd
  fatal(prv,2) %unless new desc(fa,ppd_mode,ppd_pba)
  ppd_slot = nextslot
  activedesc(nextslot) == ppd
done:
  *movem.l (sp)+,d0-d7/a0-a6
  *rte
t(3): {handle page fault}
%conststring pf="No page fault handler yet"
  fatal(pf,2)
%end

%record(ppdfm)%map grab page
%record(ppdfm)%name ppd
%record(ptefm)%name pte
  %signal 0,2,,"No more pages in pool" %if queueempty(cold)
  ppd == cold_forward
  pte == ppd_pte
  exqueue(ppd_q)
  pte = 0 %if pte##nil   {this should be unusual}
  %if ppd_slot#0 %start  {this should be extremely unusual}
    mmu[ppd_slot>>5]_dp = ppd_slot&31
    mmu[ppd_slot>>5]_ssr = 0
  %finish
  %result == ppd
%end

%routine 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
  pte_type = 1
%end

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

%externalroutine become process(%integer bytes)
%record(mar fm)%name om,nm
%record(process fm)%name new process
%record(poa fm)%name new poa
%record(pti fm)%name pti
%record(trap fm)%name trap,thistrap
%integer ownlimit,i
%label return

  %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
    rompstr("Process ")
    %if currentprocess_name="" -
    %then romphex(addr(currentprocess)) %else 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
  thistrap == record(stacklimit-sizeof(thistrap))
  thistrap_next == nil; thistrap_mask == poa_evtrap_mask; thistrap_gla = a4
  poa_evtrap == poa_evtrap_next
  %signal 0,1,,"Too late to BECOME PROCESS" %if freebot>=freetop
! Acquire PCB, POA, and PTI, then splice in event trap
  newprocess == record(addr(acquire message buffer))
  newpoa == record(addr(newprocess)+1024)
  pti == record(addr(newpoa)-sizeof(pti))
  newprocess = currentprocess; newpoa = poa; pti = 0
! Copy active module list
  om == poa_filelist
  newpoa_filelist == nil
  %cycle
    i = 0     {split off cliparam if any}
    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 == newpoa_filelist; newpoa_filelist == nm; om == om_next
  %repeatuntil om==nil
! Claim workspace for new process
  i = (a7-bytes-256)&-1024
  ownlimit = (freebot+1023)&-1024
  %signal 2,1,bytes,"Not enough workspace" %if i<ownlimit
  freetop = i
  freebot = ownlimit
! Splice in event trap
  poa_evtrap == poa_evtrap_next %while poa_evtrap_next##nil
  trap == newpoa_evtrap
  %if addr(trap)>stacklimit %then newpoa_evtrap == thistrap %elsestart
    trap == trap_next %while addr(trap_next)<stacklimit
    trap_next == thistrap
  %finish
  currentprocess == newprocess; poa == newpoa
! Set up VM tables
  currentprocess_pti == pti
  map range(freetop,stacklimit,readwrite,pti)
  map range(ownbase,ownlimit,readwrite,pti)
  map range(addr(currentprocess),addr(currentprocess)+1024,readonly,pti)
  map range(a5,a5+1024,readwrite,pti)
! Set up heap
  poa_heapbase = freetop
  integer(freetop) = 0
  poa_stacklimit = freetop+256
! Set up supervisor stack frame and join run queue
  ownbase = freebot
  movetosr(16_2700)
  a7 = a5-sizeof(pti)
  *move.w #0,-(sp)  {FW
  *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-1024; a5 = a7
  current process == record(a5-1024)
  currentprocess_asn = (currentprocess_asn+1)!userbit!privbit
  *mtsr #16_0700
  a7 = freetop
  printstring(currentprocess_name;" started"); newline
  %stop
return:
  *move.l (a5),(sp) {Guess what this does}
%end

%externalrecord(process fm)%map create subprocess -
    (%integer size,pc,%string(63)name)
%integer gla = size[3]
! This is an external routine and therefore A4 points at a different GLA
! than the caller's.  We know that the caller pushed A4 before calling
! us, so the stack looks like this:
!  SP -> (NAME, PC, SIZE, LINK, RETURN ADDRESS, CALLER'S GLA).
%integer evl,usp,ssp,bot
%record(process fm)%name newprocess
%record(trap fm)%name trap,thistrap
%record(poa fm)%name newpoa

  %routine hpush(%integer x)
    ssp = ssp-2; half(ssp) = x
  %end

  %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

  thistrap == poa_evtrap; poa_evtrap == thistrap_next
  size = (size+3)&-4
  bot = heapget(size+256+sizeof(trap))
  usp = bot+size+256
  trap == record(usp)
  trap_next == nil; trap_mask == thistrap_mask; trap_gla = a4
  newprocess == record(addr(acquire message buffer))
  ssp = addr(newprocess)+1024
  newpoa == record(ssp)
  newprocess = currentprocess; newprocess_asn = newprocess_asn!128
  newprocess_name = newprocess_name."_".name
  newpoa_heapbase = bot; integer(bot) = 0; newpoa_stacklimit = bot+256
  newpoa_evtrap == trap
  hpush(0); push(pc); hpush(0)
  push(gla;a1;a0;d1;d0)
  push(a6;addr(newpoa);usp;a3;a2;d7;d6;d5;d4;d3;d2)
  newprocess_ssp = ssp
  movetosr(16_2000)
    mmu_ast(1)_asn = currentprocess_asn&127
  movetosr(16_700)
    enqueue(newprocess_header,newprocess_runqueue_header)
  movetosr(0)
  mmu_ast(1)_asn = currentprocess_asn
  %result == newprocess
%end

%externalroutine forgetfile(%string(255)f)
%record(mar fm)%name mar==poa_filelist,pred==nil
  standardise filename(f) %if wildness(f)=0
  %while mar##nil %cycle
    %if matches(mar_name,f) %start
      heapput(mar_start)
      %if pred==nil %start
        poa_filelist == mar_next
      %else
        pred_next == mar_next
      %finish
      dispose(mar)
      %return
    %finish
    pred == mar; mar == mar_next
  %repeat
%end

%externalrecord(mar fm)%name connected mar

%externalroutine connectfile(%string(255)f,%integer mode,
    %integername start,size)
%integer pos,amt
%record(mar fm)%name mar
%record(fcb fm)%name fcb
%string(255)fore,aft
%constinteger bizarre=128,readonly=1
  connected mar == nil
  %if mode=0 %start
    start = 0; size = 0; mode = bizarre
  %finish
  %if mode=bizarre %start
    connectfile(f,readonly,pos,amt)
    start = heapget(amt+start+size)+start
    size = amt
    move(amt,byte(pos),byte(start))
    %if poa_filelist==connected mar %start
      poa_filelist == connected mar_next
      dispose(connected mar)
      connected mar == nil
    %finish
    %return
  %finish
  %signal 3,3,mode,"Invalid mode for CONNECTFILE" %unless mode=readonly
  amt = wildness(f)
  standardise filename(f) %if amt=0
  mar == poa_filelist
  %while mar##nil %cycle
    %if matches(mar_name,f) %start
      start = mar_start; size = mar_size
      connected mar == mar
      %return
    %finish
    mar == mar_next
  %repeat
  %if amt>0 %start
    f = fore.aft %while f -> fore.("*").aft %or f -> fore.("%").aft
    standardise filename(f)
  %finish
  mar == record(heapget(sizeof(mar)-255+length(f)))
  mar_name = f; mar_gla = 0; mar_next == poa_filelist
  fcb == file open input(f)
  size = fcb size(fcb); mar_size = size
  start = heapget(size); mar_start = start
  fcb read(fcb,0,size,byte(start)) %unless size=0
  fcb close(fcb)
  poa_filelist == mar
  connected mar == mar
%end

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

%routine premap(%integer n,mode,as,log)
! Set up a transparently mapped descriptor in the first MMU.
! Use slot N, with MODE either READONLY or READWRITE.
! AS specifies both ASM and ASN, LOG specifies both LAM and LBA.
  mmu_dp = n   {select}
  mmu_ssr = 0  {invalidate}
  mmu_sr = mode; mmu_asm = as>>8; mmu_asn = as
  mmu_lam = log>>16; mmu_lba = log; mmu_pba = log
  %returnif mmu_ldo=0
  rompstr("*MMU desc clash*"); rompsym(nl)
%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.

  %unless cputype=68000 %start
    premap(1,readwrite,16_FFFF,0)
    mmu_ast(1)_asn = 16_FF
    mmu_ast(2)_asn = 16_FF
    premap(0,readwrite,16_8000,0)
    mmu_ast(1)_asn = 0
    mmu_ast(2)_asn = 0
    premap(1, readonly,16_8080,16_ffc00000) {All 4k of local memory}
    premap(2,readwrite,16_c0c0,16_ff808000) {First 32k of main memory}
    premap(3,readwrite,16_8080,16_fc00e000) {Fred Graphics}
    premap(4,readwrite,16_8080,16_ffff4000) {ACIA}
    firstslot = 5; nextslot = 5
    maxslot = stoi(cliparam) %unless cliparam=""
    maxslot = 63 %if maxslot>63; maxslot = firstslot+3 %if maxslot<firstslot+3
{{  printstring("Using "); write(maxslot-firstslot+1,0); printstring(" MMU slots"); newline
  %finish

  activedesc=0
  setupqueue(cold;hot)

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

  gpti == new(gpti); gpti = 0
  maprange(addr(ko(1)),addr(ko(1)[queue  pool size]),privbit+readwrite,gpti)
  maprange(addr(bu(1)),addr(bu(1)[buffer pool  size]),privbit+readwrite{only},gpti)
  maprange(globalcodebase,globalcodelimit,readonly,gpti)
  maprange(memtop-4096,memtop,privbit+readwrite,gpti)

  currentprocess_asn = currentprocess_asn&127
  becomeprocess(1000)
  min = (bpp-1-freebot)>>lbpp
  max = (-freetop)>>lbpp
  %for i = min,1,max %cycle
    d == ppd(i); enqueue(ppd(i)_q,cold)
    d_pte == nil; d_slot = 0; d_mode = 0; d_pba = i<<(lbpp-8)
  %repeat
  semaphorewait(nil) {for now}

%end