! Mouse loader
! (c) RWT July 1988

! This file contains the FE02 linking loader, which is used
! both during initial bootstrapping of the system, but also
! later on when the system is up and running.
! The heap package is here too because the loader needs it.
! Those Imp IO routines which need to be accessed GLA-lessly
! (i.e. as extracode/system routines) are also in this file.

%option "-low-nons-half-nodiag-nocheck-nostack-nowarn"
%include "nmouse.inc-nolist"

! 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

%constinteger unassign heap chunks = 1

%systemintegerfn heapget(%integer need)

! 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.

%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 store" %if freestore<amount
  %end

  %if need<=0 %start           {bum parameter:
    a0 = 16_4001; %result = a0 {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
  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

%systemroutine DISPOSE (%name x)
  heapput(addr(x)) %unless x==nil
%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)))
! ** must not say FCB = 0 **
  p == integer(addr(fcb))
  %cycle
    p = 0; p == p[1]; n = n-4
  %repeatuntil n=0
  fcb_filename = f
  %result == fcb
%end

! FE02 Loader stuff

%constinteger jmp=16_4EF9, lea a4=16_49F9, jsr = 16_4eb9, pea = 16_4879

%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 headder contains the magic number.
  %falseif m_size<=sizeof(m_header) %or m_header_tyver#16_fe02
  %true
%end

%integerfn codestart(%record(fe02 header fm)%name h)
! Returns address of start of code section in a code file
  %result = addr(h)+sizeof(h)+h_export+h_import
%end

%record(fe02objectfm)%map next desc(%record(fe02objectfm)%name o)
! Given the variable size object descriptor O in the export or import
! section of a code file, return a reference to the following one.
  o == record((addr(o[1])-255+length(o_name)+1)&\1)
  o == nil %if o_flags=0
  %result == o
%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)

%systempredicate 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(marfm)%name m
%record(fe02headerfm)%name h
%record(fe02objectfm)%name o
%integer 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 object_flags&procmask=dynamic %and ref_op1#pea %start
    ref_op1 = pea; ref_opd1 = addr(object)
    ref_op2 = jsr; ref_opd2 = addr(dynref)
    %true
  %finish
  flags = 0
  m == poa_filelist
  %while m##nil %cycle       {search all modules whether loaded or not}
    h == m_header
    o == record(addr(h[1]))
    o == nil %if m_gla&1#0  {module dodgy} -
             %ornot 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
          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(h)+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(h)+o_offset
          %finish
          %true
        %finish
        flags = 'm'       {mode or type mismatch}
      %finish
      o == nextdesc(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(fe02indirfm)%name dref,
      %record(fe02objectfm)%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
    *=16_4e74; *=4  {*rtd #4}
  %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
%record(fe02 object fm)%name o
%record(fe02 header fm)%name h == m_header

  %result = 0 %if m_gla&1#0      {dodgy} -
     %ornot executable(m)
  ok = h_main<<1+codestart(h)
  %result = ok %if m_gla>0       {already loaded
  %if m_gla<0 %start             {GLA already allocated
    m_gla = -m_gla
  %elseif h_ownsize=0            {no GLA wanted:
    m_gla = memtop               {use invalid address
  %else
    m_gla = heapget(h_ownsize)   {allocate GLA
  %finish
! 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
! Call reset routine
  gla = m_gla
  pos = h_reset<<1+codestart(h)
  *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
      %unless loadobject(o,record(o_offset+gla)) %start
        printstring(event_message); newline
        ok = 0
      %finish
    %finish
    o == nextdesc(o)
  %repeat
  %if ok=0 %start
    m_gla = 1   {mark as 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 indir fm)indir
%record(fe02 object fm)object
  indir = 0
  object = 0
  object_flags = extbit+external
  object_name = s
  %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

! End of loader

! Start of IO package

%routine standardise (%string(*)%name name)
%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)
  *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 file normally (input or output)
  fcb op(x,cbopclose,0,0,nil) %unless x==nil
%end

%systemroutine FCB abort (%record(fcb fm)%name x)
! Close file abnormally (input or output,
! but for input it does the same as CLOSE FCB).
  fcb op(x,cbopabort,0,0,nil) %unless x==nil
%end

%systemroutine FCB flush (%record(fcb fm)%name x)
! Write contents of file buffer (X_P-X_BS bytes at X_BS) to file
! at position X_BS-X_FS in file.
! Maintain high water mark (set X_FL to X_P if X_P>X_FL).
! If X_P=X_L, advance the buffer through the file (normally by
! leaving X_BS and X_BL alone and subtracting X_BL-X_BS from
! X_FS and X_FL.  Return with X_L=X_BL.
! Normally return with X_P=X_BS, but if CH>=0, in the case of
! non-buffered devices (in which case X_BS=X_BL), write the one
! byte CH to the device, in the case of buffered devices, add CH
! to the buffer (and return with X_P=X_BS+1).
  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 X_BL-X_BS bytes (less if near
! end of file) from such a position in the file that byte X_P-X_FS
! of the file will be in the buffer.  This will usually involve
! updating X_FS and X_FL and X_P (but always return such that
! X_P-X_FS before is the same as X_P-X_FS after, i.e. X_P-X_FS
! denotes the current position in the file, we do not automatically
! return with X_P=X_BS, although this will normally be the case).
! Normally return with X_L=X_BL (unless near the end of 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)
! Ignoring the buffer pointers in the FCB, write AMOUNT bytes to
! the file at POSITION in the file, from user buffer B.
! Use current position indicated in FCB if POSITION<0.
  %returnif x==nil
  position = x_p-x_fs %if position<0
  fcb op(x,cbopwrite,position,amount,b)
%end

%systemroutine FCB read -
  (%record(fcb fm)%name x,%integer position,amount,%name b)
! Ignoring the buffer pointers in the FCB, read AMOUNT bytes from
! place POSITION in the file, to user buffer B.
! Use current position indicated in FCB if POSITION<0.
  %signal 9,,,eofnull %if x==nil
  position = x_p-x_fs %if position<0
  fcb op(x,cbopread,position,amount,b)
%end

%systemrecord(fcb fm)%map FCB open (%integer code,%string(*)%name file,%name x)
! Either (if CODE is one of FOP OPEN I/O/M/A) open the specified FILE,
! returning an appropriate FCB, or perform a direct non-FCB file operation,
! which might involve a second string or buffer parameter in X.
! FILE (and X if relevant) are assumed to be already STANDARDISED.
%string(255)dev
%bytename d,f
%integer pc,gla,p

  %record(fcbfm)%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)
%record(fcbfm)%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
    *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)
  %returnif poa_curin==nil
  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)
  %returnif poa_curout==nil
  %unless poa_curout_bs <= poa_curout_fs+byte <= poa_curout_bl %start
    poa_curout_l = poa_curout_fl %if poa_curout_bs<=poa_curout_fl<poa_curout_bl
    poa_curout_p = poa_curout_l
    fcb flush(poa_curout)
    poa_curout_p = poa_curout_fs+byte
    poa_curout_l = poa_curout_p
    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 CLOSE INPUT
%record(fcbfm)%name this,next
  this == poa_curin; %returnif this==nil
  next == this_next; %returnif addr(next)<0
  this_next == nil
  poa_curin == next
  poa_in(instream) == next
  fcb close(this)
%end

%systemroutine CLOSE OUTPUT
%record(fcbfm)%name this,next
  this == poa_curout; %returnif this==nil
  next == this_next; %returnif addr(next)<0
  this_next == nil
  poa_curout == next
  poa_out(outstream) == next
  fcb flush(this)
  fcb close(this)
%end

%systemroutine ABORT OUTPUT
%record(fcbfm)%name this,next
  this == poa_curout; %returnif this==nil
  next == this_next; %returnif addr(next)<0
  this_next == nil
  poa_curout == next
  poa_out(outstream) == next
  fcb abort(this)
%end

%begin

%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
  %result = "mouse:boot.com"
%end

%routine note file(%string(255)name,%integer start,size)
! Add a file connection / 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 process command file(%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,mpos,msize
%string(255)line
%bytename l

  %integerfn readfile(%integername size)
  ! Read in the file, allocating space for it.
  ! Result is WHERE it has been put.  SIZE is also set.
  %integer pos
    pos = (freebot+1023)&-1024
    romphex(pos); space; printstring(file)
    size = romreadfile(file,pos)
    newline
    freebot = (pos+size+3)&-4
    global code limit = freebot
    %result = pos
  %end

  %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

  pos = readfile(size)
  note file(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         {chained file}
      process command file(substring(line,2,l))
    %else
      split(line,file,cliparam)
      mpos = readfile(msize)
      note file(line,mpos,msize)
    %finish
  %repeat
%end {process command file}

%routine run(%record(mar fm)%name m)
%record(processfm)%name newprocess
%record(poafm)%name newpoa
%record(marfm)%name om,nm
%integer p,gla,fb

  %on %event 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
    %returnif currentprocess==record(memtop-1024) {called from BECOMEPROCESS}
    %if currentprocess_stackbase=0 %start  {before BECOMEPROCESS}
      %unless event_event!event_sub!event_extra=0 %start {Not normal stop}
        printstring("Program ";m_name;" crashed ")
        romphex1(event_event); space; romphex2(event_sub); space
        romphex(event_extra); space; printstring(event_message)
        newline
      %finish
      freebot = fb
      %return
    %finish
    rompstr("Process ";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
  %finish {%on}

  %returnunless executable(m)
  event = 0
  fb = freebot; freebot = (freebot+1023)&-1024
  newprocess == record(freetop-1024)
  newprocess = currentprocess
  currentprocess == newprocess
  newpoa == record(freetop-2048)
  newpoa = poa
  poa == newpoa
  currentprocess_ownbase = freebot
  currentprocess_stacklimit = freetop-2048
  p = freetop-2048-12
  integer(p) = p
  integer(p+4) = integer(poa_evlink+4)
  integer(p+8) = a4
  gla = p-m_header_ownsize
  m_gla = -gla
  split(m_name,m_name,cliparam)
  currentprocess_name = m_name
  p = loadmodule(m)
  m_gla = gla %andstopif p=0
  a0 = p; a4 = gla; a7 = a4; *jsr (a0)
  %stop
%end {run}

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

%constinteger -
  newpos=16_3f02-6*20,dispos=newpos-6,
  nsympos=dispos-6,rsympos=nsympos-6,
  psympos=rsympos-6,pstrpos=psympos-6,
  opipos=pstrpos-6,opopos=opipos-6,
  selipos=opopos-6,selopos=selipos-6,
  clipos=selopos-18,clopos=clipos-6

  *lea heapget,a0;      *move.l a0,newpos
  *lea dispose,a0;      *move.l a0,dispos
  *lea nextsymbol,a0;   *move.l a0,nsympos
  *lea readsymbol,a0;   *move.l a0,rsympos
  *lea printsymbol,a0;  *move.l a0,psympos
  *lea printstring,a0;  *move.l a0,pstrpos
  *lea openinput,a0;    *move.l a0,opipos
  *lea openoutput,a0;   *move.l a0,opopos
  *lea selectinput,a0;  *move.l a0,selipos
  *lea selectoutput,a0; *move.l a0,selopos
  *lea closeinput,a0;   *move.l a0,clipos
  *lea closeoutput,a0;  *move.l a0,clopos
  *lea rompsym,a0; *add.l #16_80000000,a0; *move.l a0,poa_curout

  freetop = memtop-4096
  freebot = membot+32*1024

  note file("mouse:loader.mob",addr(self),
            sizeof(self)+self_export+self_import+self_codesize)
  newline
  process command file(custom file)

  freebot = (freebot+1023)&-1024
  message pool == new(message pool)
  object pool == new(object pool)

  currentprocess == record(memtop-1024)
  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
  hang
%end