!  File  NMOUSE:LOADER

! Mouse system bootstrap loader,
! "FE02" format linking loader,
! Heap package,
! Basic Imp I/O support.

! The .MOB file produced by this source file is concatenated onto the
! end of PREFIX.MOB using the BUILD program.  The resulting image
! file (called X) is loaded into local memory by the ROM bootstrap.

%option "-low-nons-nodiag-nocheck-nostack-nowarn"  {-half??}
%include "mouse.inc"

! Heap package

! A process's work space is a single contiguous region within which
! heap space is allocated from low addresses upwards while the stack
! grows downwards from high addresses.  POA_HEAPBASE points at the
! (low) base address of this region, POA_STACKLIMIT points at the
! heap front, i.e. the lowest address not allocated to the heap (More
! precisely, because the Imp stack-check compares SP with POA_STACKLIMIT
! from time to time, this actually points 256 bytes further on, giving
! a small safety zone between the heap and stack fronts).
! Each heap cell is prefixed by a 4-byte header word, which is either
! negative (denoting a cell in use), positive (denoting a free cell),
! or zero (denoting the dummy cell at the end (front) of the heap).
! If the value is non-zero, its absolute value is the size of the cell
! including the 4 header bytes, this value is always a multiple of 4,
! even if the requested size was not.  All heap chunks are adjacent,
! so POA_STACKLIM is equal to the sum of the sizes of all the cells,
! plus POA_HEAPBASE+256.

%systemintegerfn freestore
  %result = freetop-freebot %if poa_heapbase=0 {still in boot phase}
  %result = a7-poa_stacklimit                  {normal mode}
%end

%systemintegerfn heapget(%integer need)

! Allocate a heap chunk at least NEED bytes long, initialise it
! to the unassigned pattern, return its address in both A0 and D0.

! Allocation algorithm:
! Always search the entire heap from the beginning, amalgamating
! any adjacent free cells.  Use the smallest cell big enough.  If that
! cell is too big, split it in two, allocating only part of it.  If no
! free cell is found, allocate fresh space by advancing the heap front.

%constinteger unassign heap chunks = 1
%integer bestsize=maxint,bestpos=0
%integer limit=poa_stacklimit-256
%integer pos=poa_heapbase

  %routine check space(%integer amount)
    %signal 2,1,amount,"not enough heap space" %if freestore<amount
  %end

  %if need<=0 %start             {bum parameter:
    a0 = memtop+1; %result = a0  {force invalid result
  %finish
  need = (need+3)&-4             {round up to 4n}

! Special case: This is still during bootstrapping,
! where a process heap has not yet been established.

  %if pos=0 %start
    check space(need)
    pos = freebot; freebot = freebot+need
    a0 = pos; %result = pos
  %finish

! Normal case:

  need = need+4                  {add 4 for header word}
  %while pos<limit %cycle        {scan heap}
    %if integer(pos)<0 %start    {cell in use}
      pos = pos-integer(pos)
    %elseif integer(pos)>0       {cell free - try to amalgamate}
      integer(pos) = integer(pos)+integer(pos+integer(pos)) -
      %while pos+integer(pos)<limit %and integer(pos+integer(pos))>0
      %if bestsize>=integer(pos)>=need %start  {better fit}
        bestsize = integer(pos); bestpos = pos
      %finish
      pos = pos+integer(pos)
    %finishelseexit              {end of list, should not happen}
  %repeat
  pos = bestpos
  %if pos#0 %start               {suitable hole found}
    %if bestsize-need>=8 %start  {worth splitting}
      integer(pos+need) = bestsize-need
    %else
      need = bestsize            {use it all}
    %finish
  %else                          {no hole found: extend front}
    check space(need+256)
    pos = limit
    poa_stacklimit = poa_stacklimit+need
    integer(pos+need) = 0
  %finish
  integer(pos) = -need
  $if unassign heap chunks # 0
    a0 = pos+need
    d0 = need>>2-2
    *swap d0
o:  *swap d0
i:    *move.l d7,-(a0)
      *dbra d0,i
      *swap d0
    *dbra d0,o
  $finish
  pos = pos+4
  a0 = pos; %result = pos
%end

%systemroutine heapput(%integer where)

! Disposal algorithm:
! Try to amalgamate the cell being freed with any cells adjacent to
! it on the higher address side.  Then, if the resulting cell is
! at the heap front, move back the front.  Otherwise simply mark the
! cell as free by making its negative header word positive.

%integer limit=poa_stacklimit-256,size
%integer pos=where
  %returnif pos=0        {dispose NIL??}
  pos = pos-4            {point at header word}
  %returnunless poa_heapbase<=pos<limit  {not within heap bounds}
  size = -integer(pos)
  %returnunless size>0   {already disposed??}
  size = size+integer(pos+size) %while -
    pos+size<limit %and integer(pos+size)>0
  %if pos+size=limit %start
    size = 0
    poa_stacklimit = pos+256
  %finish
  integer(pos) = size
%end

%routine DISPOSE (%name x)
  heapput(addr(x))
%end

%systemstring(*)%map NEW STRING (%string(*)%name s)
! Allocate a chunk just big enough to hold string S, then
! copy S into it and return a reference to the chunk.
%string(*)%name h
  h == string(heapget(length(s)+1))
  h = s; %result == h
%end

%systemrecord(fcb fm)%map NEW FCB (%string(*)%name f)
! Allocate a file control block of variable size, just big
! enough to hold the file name F (remember that the file
! name is the last field in the FCB), copy F into this
! field and clear the rest of the FCB.
%integer n
%record(fcb fm)%name fcb
%integername p
  n = sizeof(fcb)-256
  fcb == record(heapget(n+1+length(f)))
  p == integer(addr(fcb))
  %cycle
    p = 0; p == p[1]; n = n-4
  %repeatuntil n=0
  fcb_filename = f
  %result == fcb
%end

! Loader

%constinteger jmp=16_4EF9, lea a4=16_49F9, jsr=16_4eb9, pea=16_4879, rts=16_4e75
%constinteger dodgy = 1
%constinteger extbit=16_4000,procmask=16_3000,
              system=16_1000,external=16_2000,dynamic=16_3000

%predicate executable(%record(mar fm)%name m)
! True iff the file described by M is big enough to contain
! an FE02 header and that header contains the magic number.
%record(fe02 header fm)%name h == m_header
  %falseif m_size<=sizeof(h) %or h_tyver#16_fe02
  %falseif m_gla=dodgy
  %falseunless m_size>=sizeof(h)+h_export+h_import+h_codesize
  %true
%end

%record(fe02object fm)%map next loader record(%record(fe02object fm)%name r)
! Given the variable size loader record R in the export or import
! section of a code file, return a reference to the following one.
  r == record((addr(r[1])-255+length(r_name)+1)&\1)
  r == nil %if r_flags=0
  %result == r
%end

%systemintegerfn stringdiff (%string(*)%name a,b)
! Result is <=> zero iff a<=>b,
! but upper/lower case (etc) are treated as equivalent.
%register(a0)%bytename p,q
%register(d1)%integer m,n
  p == length(a); q == length(b)
  m = p-q
  %if m<=0 %then n = p %else n = q
  %cycle
    n = n-1; %result = m %if n<0
    p == p[1]; q == q[1]
    %result = (p!32)-(q!32) %unless (p!32)-(q!32)=0
  %repeat
%end

! NB MAR_GLA values:
! zero: module not yet loaded
! odd:  module cannot be loaded
! pos:  module loaded, value = GLA
! neg:  main program module not yet reset, value = -GLA,

%integerfnspec load module(%record(mar fm)%name m)

%predicate load object -
  (%record(fe02 object fm)%name object,%record(fe02 indir fm)%name ref)

! If the required OBJECT can be found in some module,
! then load that module if it is not already loaded, and
! fill in the particulars of the object in the REF record.
! This will involve accessing its first 4, 6, or 12 bytes.
! For a data object,          REF_ADDRESS will point at it.
! For an %EXTERNAL procedure, REF will contain: LEA glabase,A4;
!                                               JMP entrypoint.
! For a %SYSTEM procedure,    REF will contain: JMP entrypoint.
! For a %DYNAMIC procedure,   REF will contain: PEA object;
!                                               JSR dynref.

%record(mar fm)%name m
%record(fe02header fm)%name h
%record(fe02object fm)%name o
%integer codestart,flags
%label dynref

  %predicate compatible(%record(fe02 object fm)%name want,have)
  ! If WANT is a data object, HAVE has to be too.
  ! If WANT or HAVE is %DYNAMIC, treat it as %EXTERNAL.
  ! If WANT is %EXTERNAL, HAVE may be %SYSTEM or %EXTERNAL.
  ! If WANT is %SYSTEM, HAVE must be %SYSTEM (it may be %EXTERNAL,
  !       but only if the module exporting it is GLA-less).
  ! In addition, the types of WANT and HAVE must agree,
  !       unless either of them is coded as zero (wildcard).
  %integer wt,ht
    wt = want_flags&procmask; wt = external %if wt=dynamic
    ht = have_flags&procmask; ht = external %if ht=dynamic
    %unless wt=ht %start
      %if wt=external %start
        %falseunless ht=system
      %elseif wt=system
        %falseunless ht=external
        %falseunless h_ownsize=0
      %else
        %false
      %finish
    %finish
    wt = want_type; ht = have_type
    %unless wt=ht %start
      %falseunless wt=0 %or ht=0
    %finish
    %true
  %end

! If the reference is dynamic, we defer loading until the thing is
! actually used.  At boot-time (as indicated by POA_HEAPBASE being 0)
! we speed things up slightly by pretending all external references
! are dynamic, thus not loading some modules which will not be needed.
! If REF_OP1 is PEA, then the object has actually been called.

  flags = object_flags&procmask
  flags = dynamic %if flags=external %and poa_heapbase=0
  flags = 0 %unless flags=dynamic
  flags = 0 %if ref_op1=pea
  %if flags#0 %start
    ref_op1 = pea; ref_opd1 = addr(object)
    ref_op2 = jsr; ref_opd2 = addr(dynref)
    %true
  %finish
  m == poa_filelist
  %while m##nil %cycle       {search all modules whether loaded or not}
    h == m_header
    o == record(addr(h[1]))
    o == nil %ifnot executable(m) %or h_export=0
    %while o##nil %cycle
      %if stringdiff(object_name,o_name)=0 %start  {found it}
        %if compatible(object,o) %start            {yes really}
          %if loadmodule(m)=0 %start               {load the module}
            event_message = "*Cannot load "
            event_message = event_message.object_name
            %false
          %finish
          codestart = addr(h)+sizeof(h)+h_export+h_import
          flags = object_flags&procmask
          flags = system %if  o_flags&procmask=system -
                         %or (o_flags&procmask=external %and h_ownsize=0)
          %if flags=system %start      {6-byte entry sequence}
            ref_op1 = jmp; ref_opd1 = codestart+o_offset
          %elseif flags=0              {data object}
            ref_address = m_gla+o_offset
          %else                        {12-byte entry sequence}
            ref_op1 = lea a4; ref_opd1 = m_gla
            ref_op2 = jmp; ref_opd2 = codestart+o_offset
          %finish
          %true
        %finish
        flags = 'm'       {mode or type mismatch}
      %finish
      o == next loader record(o)    {try next export in module}
    %repeat
    m == m_next           {try next file}
  %repeat
  %if flags='m' %start
    event_message = "*Mismatch for "
  %else
    event_message = "*Cannot find "
  %finish
  event_message = event_message.object_name
  %false

@0(a7)%integerarray r(0:14),
      %record(fe02indir fm)%name dref,
      %record(fe02object fm)%name dobject
dynref:
  *movem.l d0-d7/a0-a6,-(sp)
  dref == dref[-1]
  %if load object(dobject,dref) %and dref_op1#pea %start
    *movem.l (sp)+,d0-d7/a0-a6
    *move.l (sp)+,(sp)
    *rts
  %finish
  printstring(event_message); newline
  *movem.l (sp)+,d0-d7/a0-a6
  *lea 8(sp),sp
  *clr.l d0
  *rts
  %false
%end

%systemintegerfn load module(%record(mar fm)%name m)
! Load the specified module if it is not already loaded.
! This involves allocating space for its OWN area, calling
! its reset routine to initialise that area, and then satisfying
! any external references, filling in the gaps in the own area.
! Result is the main entry point PC, zero if unsuccessful.
%integer gla,pos,ok,codestart
%record(fe02 object fm)%name o
%record(fe02 header fm)%name h == m_header
%record(fe02 indir fm)%name d

  %result = 0 %unless executable(m)
  codestart = addr(h)+sizeof(h)+h_export+h_import
  ok = h_main<<1+codestart
  %result = ok %if m_gla>0       {already loaded
{{rompstr("Loading ";m_name)
  %if m_gla<0 %start             {GLA already allocated
    m_gla = -m_gla
{{rompstr(" main program GLA: ")
  %elseif h_ownsize=0            {no GLA wanted:
    m_gla = memtop               {use invalid address
{{rompstr(" no GLA: ")
  %else
    m_gla = heapget(h_ownsize)   {allocate GLA
{{rompstr(" new GLA: ")
  %finish
{{romphex(m_gla); rompsym('-')
! Unassign the GLA
  d0 = (h_ownsize+3)>>2-1
  a0 = m_gla
  %while d0>=0 %cycle
loop: *move.l d7,(a0)+; *dbra d0,loop
    d0 = d0-65536
  %repeat
{{romphex(a0); rompsym(nl)
! Call reset routine
  gla = m_gla
  pos = h_reset<<1+codestart
  *move.l pos,a0
  *move.l gla,a1
  *move.l a4,-(sp)
  *move.l a1,a4
  *jsr (a0)
  *move.l (sp)+,a4
! Satisfy import requirements
  o == record(addr(h[1])+h_export)
  o == nil %if h_import=0
  %while o##nil %cycle
    %if o_flags&extbit#0 %start
      d == record(o_offset+gla); d_op1 = 0 {not PEA}
      %unless loadobject(o,d) %start
        printstring(event_message); newline
        ok = 0
      %finish
    %finish
    o == next loader record(o)
  %repeat
  %if ok=0 %start
    m_gla = dodgy
    printstring("*Unable to load ";m_name); newline
  %finish
  %result = ok
%end

%systempredicate dynamically loaded (%string(255)s,%integername pc,gla)
! Attempt to load external procedure specified in S.
! If found, return TRUE and set PC to its entry point, and GLA
! to the address of the relevant module's data area (0 if none).
%constinteger extbit=16_4000,external=16_2000,jmp=16_4ef9
%record(fe02 object fm)object
%record(fe02 indir fm)indir
  object = 0
  object_flags = extbit+external
  object_name = s
  indir_op1 = pea
  %if load object(object,indir) %start
    %if indir_op1=jmp %start
      gla = 0; pc = indir_opd1
      %true
    %finish
    %if indir_op2=jmp %start
      gla = indir_opd1; pc = indir_opd2
      %true
    %finish
  %finish
  %false
%end

! IO package

%routine standardise (%string(*)%name name)
! Locate entry point for the external procedure STANDARDISE FILE NAME,
! not defined in this module, and then call it with NAME as parameter.
%integer pc,gla
  %returnunless dynamically loaded("standardisefilename",pc,gla)
  *move.l name,a0
  *move.l pc,a1
  *move.l gla,a2
  *move.l a4,-(sp)
  *move.l a2,a4
  *jsr (a1)
  *move.l (sp)+,a4
%end

%conststring eofnull="Attempt to read from null file"

%routine FCB op (%registerrecord(fcb fm)%name fcb,
   %integer code,p1,p2,%name b)
! Perform operation specified by CODE (which is CBOP* where * is
! one of {CLOSE, ABORT, FLUSH, REFRESH, WRITE, READ}, on the file
! associated with FCB, using parameters P1, P2, and B.
  *move.l a4,-(sp)
  *move.l fcb_pc,a2
  *move.l fcb_gla,a4
  *jsr (a2)
  *move.l (sp)+,a4
%end

%systemroutine FCB close (%record(fcb fm)%name x)
! Close input or output file normally
  fcb op(x,cbopclose,0,0,nil) %unless x==nil
%end

%systemroutine FCB abort (%record(fcb fm)%name x)
! Close input or output file abnormally
  fcb op(x,cbopabort,0,0,nil) %unless x==nil
%end

%systemroutine FCB flush (%record(fcb fm)%name x)
! Write contents of file buffer into file and maintain high water mark
  fcb op(x,cbopflush,-1,0,nil) %unless x==nil
%end

%systemroutine FCB refresh (%record(fcb fm)%name x)
! Fill the file buffer by reading from the file
  %signal 9,,,eofnull %if x==nil
  fcb op(x,cboprefresh,0,0,nil)
%end

%systemroutine FCB write -
  (%record(fcb fm)%name x,%integer position,amount,%name b)
! Independently of the buffer in the FCB, write AMOUNT bytes into
! the file at offset POSITION, from user buffer B.
! If POSITION<0, use and update the current position noted in FCB.
  %returnif x==nil
  %if position<0 %start
    fcb op(x,cbopwrite,x_p-x_fs,amount,b)
    x_p = x_fs+position+amount; x_l = x_p
    x_fl = x_p %if x_p>x_fl
  %else
    fcb op(x,cbopwrite,position,amount,b)
  %finish
%end

%systemroutine FCB read -
  (%record(fcb fm)%name x,%integer position,amount,%name b)
! Independently of the buffer in the FCB, read AMOUNT bytes from
! the file at offset POSITION, into user buffer B.
! Use and update position in FCB if POSITION<0.
  %signal 9,,,eofnull %if x==nil
  %if position<0 %start
    fcb op(x,cbopread,x_p-x_fs,amount,b)
    x_p = x_fs+position+amount; x_l = x_p
  %else
    fcb op(x,cbopread,position,amount,b)
  %finish
%end

%systemrecord(fcb fm)%map FCB open (%integer code,%string(*)%name file,%name x)
! Call the appropriate device driver to perform the operation specified
! by CODE on the specified FILE (with extra parameter X if appropriate).
! FILE (and X if relevant) are assumed to be already STANDARDISED.
! If CODE is FOP* with * one of {OPENI, OPENO, OPENM, OPENA} then return a
! file control block (FCB) as result, for use with the above IO procedures.
! If CODE is something else, simply perform the operation directly, in which
! case the result is undefined.
%string(255)dev
%bytename d,f
%integer pc,gla,p

  %record(fcb fm)%map call it(%integer a,%name b,c)
    *move.l a4,-(sp)
    *move.l gla,a4
    *move.l pc,a2
    *jsr (a2)
    *move.l (sp)+,a4
  %end

! Make DEV equal to "FOP_".<the leading component of FILE>

  d == length(dev); f == length(file)
  dev = "FOP_"
  p = 2 {past the initial colon}
  %cycle
    %exitif p>f %or f[p]=':'
    d = d+1; d[d] = f[p]; p = p+1
  %repeat
  %if dynamically loaded(dev,pc,gla) %start
    %result == call it(code,file,x)
  %finish
  dev = "No device driver for ".file
  %signal 3,3,,dev
%end

%systemroutine FILE OP (%integer code,%string(*)%name file,%name x)
! Perform direct (non-FCB) operation CODE on file FILE (with parameter X).
%record(fcb fm)%name dummy
  dummy == fcb open(code,file,x)
%end

%routine streamcheck(%integer n)
  %returnif 0<=n<=7
  %signal 6,2,n,"Stream number out of range 0:7"
%end

%systemroutine selectinput(%integer stream)
  streamcheck(stream)
  poa_curin == poa_in(stream)
  poa_instream = stream
%end

%systemroutine selectoutput(%integer stream)
  streamcheck(stream)
  poa_curout == poa_out(stream)
  poa_outstream = stream
%end

%routine OPENINPUT (%integer s,%string(255)f)
%record(fcb fm)%name fcb
  selectinput(s)
  standardise(f)
  fcb == fcb open(fopopeni,f,nil)
  fcb_next == poa_in(s)
  poa_in(s) == fcb
  poa_curin == fcb
%end

%routine OPENOUTPUT (%integer s,%string(255)f)
%record(fcb fm)%name fcb
  selectoutput(s)
  standardise(f)
  fcb == fcb open(fopopeno,f,nil)
  fcb_next == poa_out(s)
  poa_out(s) == fcb
  poa_curout == fcb
%end

%systemintegerfn nextsymbol
%register(a0)%record(fcb fm)%name cb == poa_curin
  %if addr(cb)>0 %start
    %if cb_p>=cb_l %start
      *move.l a4,-(sp)
      a4 = cb_gla
      a1 = cb_fastpc
      *jsr (a1)
      *move.l (sp)+,a4
    %finish
    %result = byte(cb_p)
  %finish
  *temp
  %signal 9,,,eofnull
%end

%systemintegerfn readsymbol
%register(a0)%record(fcb fm)%name cb == poa_curin
  %if addr(cb)<=0 %or cb_p>=cb_l %start
    *jsr nextsymbol
  %finish
  cb_p = cb_p+1
  %result = byte(cb_p-1)
%end

%systemroutine printsymbol(%registerinteger k)
%register(a0)%record(fcb fm)%name cb == poa_curout
  %if addr(cb)>0 %start
    %if cb_p<cb_l %start
      byte(cb_p) = k; cb_p = cb_p+1
    %else
      k = k&255
      *move.l a4,-(sp)
      a4 = cb_gla
      a1 = cb_fastpc
      *jsr (a1)
      *move.l (sp)+,a4
    %finish
  %elseif addr(cb)<0  {special access to terminal}
    *jmp (a0)
  %finish
%end

%systemroutine printstring(%string(255)s)
%integer i
  printsymbol(charno(s,i)) %for i = 1,1,length(s)
%end

%systemroutine SET INPUT (%integer byte)
  %returnunless addr(poa_curin)>0
  byte = 0 %if byte<0
  byte = poa_curout_fl-poa_curout_fs %if byte>poa_curout_fl-poa_curout_fs
  poa_curin_p = poa_curin_fs+byte
  poa_curin_l = poa_curin_p %unless poa_curin_bs<=poa_curin_p<=poa_curin_l
%end

%systemroutine SET OUTPUT (%integer byte)
  %on 9 %start
    poa_curout_p = poa_curout_fs+byte
    poa_curout_l = poa_curout_bl
    %return
  %finish
  %returnunless addr(poa_curout)>0
  byte = 0 %if byte<0
  byte = poa_curout_fl-poa_curout_fs %if byte>poa_curout_fl-poa_curout_fs
  %unless poa_curout_bs <= poa_curout_fs+byte <= poa_curout_bl %start
    poa_curout_p = poa_curout_bl
    poa_curout_p = poa_curout_fl %if poa_curout_fl<poa_curout_bl
    fcb flush(poa_curout)
    poa_curout_p = poa_curout_fs+byte
    fcb refresh(poa_curout)
  %finish
  poa_curout_p = poa_curout_fs+byte
  poa_curout_l = poa_curout_bl
%end

%systemroutine RESET INPUT
  setinput(0)
%end

%systemroutine RESET OUTPUT
  setoutput(0)
%end

%systemroutine fcb lock(%record(fcb fm)%name cb)
  %returnif cb==nil
  cb_next == record(addr(cb_next)!16_80000000)
%end

%systemroutine fcb unlock(%record(fcb fm)%name cb)
  %returnif cb==nil
  cb_next == record(addr(cb_next)&16_7fffffff)
%end

%systempredicate fcb locked(%record(fcb fm)%name cb)
  %trueif cb==nil
  %trueif addr(cb_next)<0
  %false
%end

%systemroutine lock all streams
%integer i
  fcb lock(poa_in(i)) %for i = 0,1,7
  fcb lock(poa_out(i)) %for i = 0,1,7
%end

%systemroutine unlock all streams
%integer i
  fcb unlock(poa_in(i)) %for i = 0,1,7
  fcb unlock(poa_out(i)) %for i = 0,1,7
%end

%systemroutine CLOSE INPUT
%record(fcb fm)%name this,next
  this == poa_curin; %returnif fcb locked(this)
  next == this_next
  this_next == nil
  poa_curin == next
  poa_in(instream) == next
  fcb close(this)
%end

%systemroutine CLOSE OUTPUT
%record(fcb fm)%name this,next
  this == poa_curout; %returnif fcb locked(this)
  next == this_next
  this_next == nil
  poa_curout == next
  poa_out(outstream) == next
  fcb flush(this)
  fcb close(this)
%end

%systemroutine ABORT OUTPUT
%record(fcb fm)%name this,next
  this == poa_curout; %returnif fcb locked(this)
  next == this_next
  this_next == nil
  poa_curout == next
  poa_out(outstream) == next
  fcb abort(this)
%end

%systemroutine close all streams
%integer i
%record(fcb fm)%name cb
  poa_curin == nil
  %for i = 7,-1,0 %cycle
    %cycle
      cb == poa_in(i); %exitif fcb locked(cb)
      poa_in(i) == cb_next; cb_next == nil
      fcbclose(cb)
    %repeat
  %repeat
  selectinput(0)
  poa_curout == nil
  %for i = 7,-1,0 %cycle
    %cycle
      cb == poa_out(i); %exitif fcb locked(cb)
      poa_out(i) == cb_next; cb_next == nil
      %if event_event!event_sub=0 %then fcbclose(cb) %else fcbabort(cb)
    %repeat
  %repeat
  selectoutput(0)
%end

! Bootstrap loader begins here

%begin

%constinteger -
  xc20 = 16_3f02-6*20,
  xc21 = 16_3f02-6*21,
  xc22 = 16_3f02-6*22,
  xc23 = 16_3f02-6*23,
  xc24 = 16_3f02-6*24,
  xc25 = 16_3f02-6*25,
  xc26 = 16_3f02-6*26,
  xc27 = 16_3f02-6*27,
  xc28 = 16_3f02-6*28,
  xc29 = 16_3f02-6*29,
  xc32 = 16_3f02-6*32,
  xc33 = 16_3f02-6*33

%record(mar fm)%name p,q
%record(fe02 header fm)%name self

!%string(255)%fn custom file
!! Return a filename of the form "boot:mxx" where xx is the
!! (hex) ether station address of the machine being booted.
!%string(255)filename="boot:m"
!%bytename f == length(filename)
!@16_3fa8 %byte machine
!  %routine add hex digit(%integer n)
!    n = n&15; n = n+7 %if n>9
!    f = f+1; f[f] = n+'0'
!  %end
!  add hex digit(machine>>4)
!  add hex digit(machine&15)
!  %result = filename
!%end

%routine add mar(%string(255)name,%integer start,size)
! Add a Module Activation Record for the specified file.
%record(mar fm)%name mar,x
  mar == record(heapget(sizeof(mar)-255+length(name)))
  mar_start = start; mar_size = size; mar_gla = 0
  mar_name = name; mar_next == nil
  x == poa_filelist
  %if x==nil %then poa_filelist == mar %elsestart
    x == x_next %while x_next##nil
    x_next == mar
  %finish
%end

%routine split(%string(255)line,%string(*)%name verb,param)
! Split line into verb and parameter (separated by one or more spaces)
! (string resolution not available at this low level)
%bytename l,v,p
%integer i
  l == length(line); v == length(verb); p == length(param)
  v = 0
  %while v<l %and l[v+1]#' ' %cycle
    v = v+1; v[v] = l[v]
  %repeat
  i = v+1
  i = i+1 %while i<=l %and l[i]=' '
  p = 0
  %while i<=l %cycle
    p = p+1; p[p] = l[i]; i = i+1
  %repeat
%end

%routine hang
  *lea 0,a0; *trap #7 {semaphorewait(nil)}
%end

%routine loadfile(%string(255)line,%integername xpos,xsize)
%string(255)file
%integer pos,size
  split(line,file,cliparam)
  pos = freebot
{{romphex(pos); space; printstring(file); newline
  size = romreadfile(file,pos)
  freebot = (pos+size+3)&-4
  add mar(line,pos,size)
  xpos = pos %unless xpos==nil
  xsize = size %unless xsize==nil
%end

%routine obeyfile(%string(255)file)
! Read in a command file, keep track of where it is
! using POS and SIZE, scan it using POINTER.
! Load any files called for in it, recursive command
! command files are allowed (using '@').
%integer pos,size,pointer
%string(255)line
%bytename l

  %integerfn rsym
  ! Return the next character in the current command file,
  ! advancing the pointer.  Return -1 if off end.
    %if pointer=0 %or pointer>=pos+size %start
      pointer = 0
      %result = -1
    %finish
    pointer = pointer+1; %result = byte(pointer-1)
  %end

  %routine rline
  ! Read a line into global string LINE, assuming L points at its length.
  ! Comments (starting with '!' and preceded by any number of spaces,
  ! and continuing to the end of line, are skipped, as are leading spaces.
  ! Blank lines may be returned.
  %integer sym
    l = 0
    %cycle
      sym = rsym; %exitif sym<=nl  {end of line or file}
      %if sym='!' %start           {start of comment}
        sym = rsym %until sym<=nl  {skip rest of line}
        %exit
      %finish
      %unless sym=' ' %and l=0 %start  {not leading space}
        l = l+1; l[l] = sym
      %finish
    %repeat
    l = l-1 %while l[l]=' '        {delete trailing spaces}
  %end

  loadfile(file,pos,size)
  pointer = pos
  l == length(line)
  %cycle
    rline; %returnif pointer=0  {end of file}
    %continueif l=0             {blank line}
    %returnif l[1]='.'          {end marker}
    %if l[1]='@' %start
      obeyfile(substring(line,2,l))
    %else
      loadfile(line,nil,nil)
    %finish
  %repeat
%end {obeyfile}

%routine run(%record(mar fm)%name m)
! Invoke the program described by M.
%record(process fm)%name newprocess
%record(poa fm)%name newpoa
%record(mar fm)%name om,nm
%integer p,gla

  %on %event 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
    freebot = ownbase
    %returnif event_event!event_sub=0
    rompstr("Program ")
    %if currentprocess_name="" -
    %then romphex(a5-1024) %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)
    hang %unless a5=memtop-1024
    %return
  %finish

  %returnunless executable(m)
  event = 0
  ownbase = freebot
  stacklimit = freetop
  gla = (stacklimit-sizeof(poa_evtrap)-m_header_ownsize)&-4
  m_gla = -gla
  split(m_name,m_name,cliparam)
  currentprocess_name = substring(m_name,1,length(m_name)-4)  {.mob}
  p = loadmodule(m)
  m_gla = gla %andstopif p=0
  a0 = p; a4 = gla; a7 = a4; *jsr (a0)
  %stop
%end {run}

! Note where we have been loaded

  self == record(a0)

! Register the extracode entry points

  *lea heapget,a0;      *move.l a0,xc20
  *lea dispose,a0;      *move.l a0,xc21
  *lea nextsymbol,a0;   *move.l a0,xc22
  *lea readsymbol,a0;   *move.l a0,xc23
  *lea printsymbol,a0;  *move.l a0,xc24
  *lea printstring,a0;  *move.l a0,xc25
  *lea openinput,a0;    *move.l a0,xc26
  *lea openoutput,a0;   *move.l a0,xc27
  *lea selectinput,a0;  *move.l a0,xc28
  *lea selectoutput,a0; *move.l a0,xc29
  *lea closeinput,a0;   *move.l a0,xc32
  *lea closeoutput,a0;  *move.l a0,xc33

! Carve up memory

  a5 = memtop-1024
  currentprocess == record(a5-1024)
  freetop = memtop-4096
  freebot = membot + (32*1024+256)
  freetop = freetop-sizeof(ko); ko == array(freetop)
  freetop = freetop-sizeof(bu); bu == array(freetop)
  currentprocess = 0
  *lea rompsym,a0; *add.l #16_80000000,a0; *move.l a0,poa_curout

! Read in files needed to build the system

  printstring("Loading"); newline
  global code base = freebot
  add mar("nmouse:loader.mob",addr(self),
          sizeof(self)+self_export+self_import+self_codesize)
  loadfile("nmouse:super.mob",nil,nil)
  loadfile("nmouse:mapper.mob",nil,nil)
  obeyfile("nmouse:boot.com")            {or custom file}
  freebot = (freebot+1023)&-1024
  global code limit = freebot

! Now run loaded object files in sequence

  p == poa_filelist_next
  %while p##nil %cycle
    q == poa_filelist
    q_gla = 0 %and q == q_next %until q==nil
    run(p)
    p == p_next
  %repeat

! Finally fade away

  printstring("Booting complete"); newline
  freebot = -freebot
  freetop = -freetop
  hang

%end