*  File  MOUSE:MOUSE.ASM

   bin

vm equ 1
* VM=0: 68000 or 68010, MMUs not used,
*       VBR set up once only.
* VM#0: 68010 required, VBR changed at
*       context switch, MMU ASN likewise,
*       MMU entries made for message buffers.

* Device addresses etc

acias    equ $4000c1
aciad    equ $4000c3

ptm      equ $400100
ptmcrx   equ 0
ptmcr2   equ 2
ptmct3   equ 12

tickler  equ $ff3fff

 ifne vm
mmu0     equ $100000
mmu1     equ $100040
mmuasnud equ $02
mmuasnup equ $04
mmuasnsd equ $0a
mmuasnsp equ $0c
mmuasnia equ $0e
mmuaclba equ $20
mmuaclam equ $22
mmuacpba equ $24
mmuacasn equ $26
mmuacsr  equ $27
mmuacasm equ $28
mmudp    equ $29
*mmuivr  equ $2b
mmugsr   equ $2d
mmulsr   equ $2f
mmussr   equ $31
*mmuidp  equ $39
*mmurdp  equ $3b
mmudto   equ $3d
mmuldo   equ $3f
 endc

* Procedures provided in ROM
* NB the output procedures all
* preserve register contents.

romload    equ $408
romphex8   equ $40c
romphex4   equ $410
romphex2   equ $414
romphex1   equ $418
rompsym    equ $41c
rompstring equ $420

* Process-Own Area offsets

poaevlink   equ $000
poadisplay  equ $004
poaevent    equ $020
poaevextra  equ $024
poaevmess   equ $028
poaheapbase equ $178
poastacklim equ $17c
poacurout   equ $184
poacliparam equ $1d0

* .MOB file header offsets

fe02fe02    equ 0
fe02export  equ 4
fe02import  equ 6
fe02reset   equ 12
fe02main    equ 14
fe02ownsize equ 16

* Kernel object field definitions

* Semaphores, Mailboxes, Run Queues,
* Messages, and Processes all have a
* common header described by the
* fields below (beginning with KER).

* NB Semaphores, Mailboxes, and Run
* Queues are all the same size.

         org 0
kerlock  ds.b 1  (MS bit is lock bit)
kertag   ds.w 1  identifies type of object
kerqueue ds.l 1  queue containing this cell
kerfwd   ds.l 1  next (or first) cell
kerbck   ds.l 1  previous (or last) cell
kerowner ds.l 1  process "owning" this cell
kerparam ds.l 1  counter/semaphore/tickler
kersize  equ *   size of sem/rq/mbx

semcount  equ kerparam  counter of semaphore
mbxsema   equ kerparam  semaphore of mailbox
rqtickler equ kerparam  tickler for run queues

         org kerparam
msgreply ds.l 1  mailbox for answer
msgsize  ds.l 1  data length
msgdata  ds.l 1  (space for actual message)
msgmax   equ 2048-msgdata

         org kerparam
prorq    ds.l 1  target run queue
* Remainder of PCB is of "local" significance
proprio  equ prorq
propoa   ds.l 1  process-own area
provbr   ds.l 1  exception vector table
prossp   ds.l 1  supervisor stack pointer
procpu   ds.l 1  CPU time consumed
prostart ds.l 1  time pro created
protss   ds.w 1  time slice size
protsl   ds.w 1  time slice left
promsg   ds.l 1  allocated message buffer
prombx   ds.l 1  co-process attn mbx
proasd   ds.l 1  VM address space descriptor
proasn   equ proasd  MMU address space number
proname  ds.b 63 process name
promax   equ 1024 (supervisor stack)

   org $1000    beginning of local RAM

* Default exception vector table
* pointed at by most processes' VBRs.
* Actual exception handling is devolved
* to (an)other module(s), hence the -1s.

 dc.l xcodelim    initial SP
 dc.l begin       initial PC
 dc.l       -1,-1,-1,-1,-1,-1
 dc.l -1,-1,-1,-1,-1,-1,-1,-1
 dc.l -1,-1,-1,-1,-1,-1,-1,-1
intbase equ *
 dc.l int0,int1,int2,int3,int4,int5,int6,int7
 dc.l trap0,trap1,trap2,trap3
 dc.l trap4,trap5,trap6,trap7
 dc.l trap8,trap9,trapa,trapb
 dc.l trapc,trapd,trape,trapf

* Mask the 64 obsolete extracode entry points
* with illegal instructions as a precaution
* against old programs going astray.

i equ $4afc4afc
 dc.l i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i
 dc.l i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i
 dc.l i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i
 dc.l i,i,i,i,i,i,i,i,i,i,i,i,i,i,i,i

* Supervisor variables ($11c0)

runqueues  ds.l 8
curpro     dc.l 0
uptime     dc.l 0
kersema    dc.l 0
msgsema    dc.l 0
kerpool    dc.l 0
msgpool    dc.l 0
managermbx dc.l 0
bootbeg    ds.l 1
cputype    dc.l 68010
atcptetab  dc.l 0
atcslot    equ atcptetab
bootpos    ds.l 1
scratch    ds.l 1

machine equ $3fa8
freebot equ $3ff0
freetop equ $3ff4
membot  equ $3ff8
memtop  equ $3ffc

* Registers pushed on interrupt
part1     equ d0-d1/a0-a1/a4
part1size equ 20

* Registers pushed on context switch
part2     equ d2-d7/a2-a6 [with a4=usp]
part2size equ 44

   org $1240        CODE continues here

push macro
\* move\0 \1,-(sp)
   endm
pop macro
\* move\0 (sp)+,\1
   endm
pushm macro
\* movem.l \1,-(sp)
   endm
popm macro
\* movem.l (sp)+,\1
   endm

string macro
\* dc.b end\@-beg\@
beg\@ dc.b \1
end\@ dc.b 0
   ds.w 0
   endm

print macro
\* push.l a0
   lea a\@,a0
   jsr rompstring
   bra.s b\@
a\@ string <\1>
b\@ pop.l a0
   endm

phex macro
\* push.l d0
   move\0 \1,d0
   jsr romphex\2
   pop.l d0
   endm

bs  equ 8
nl  equ 10
lf  equ 10+128
cr  equ 13+128
del equ 127

newline moveq #nl,d0
   jmp rompsym

space moveq #' ',d0
   jmp rompsym

* Test whether sym pending.
* Read it if so, return -1 if not.

kbtest moveq #127,d0
   btst.b #0,acias
   beq.s kbt9
   and.b aciad,d0
   rts
kbt9 moveq #-1,d0
   rts

kbsym bsr kbtest
   bmi kbsym
   rts

* Queue handling operations

* NB In all these operations, registers
* A0/A1/A4 are used implicitly.
* A0 always points at the queue in question,
* A1 always points at the cell being added
* or removed from the queue, and A4 is used
* as a scratch register, usually to point at
* the cell's neighbour.
* The caller is ASSUMED to be privileged
* and non-interruptable (SR&$FF00=$2700).

* Lock queue for exclusive access.
* Cells may only be inserted into
* or removed from queues if the
* queue has first been locked.
* Queues must remain locked for
* as short a time as possible so
* that competing processors don't
* waste too much time busy-waiting.

lock push.l d0
   moveq #99,d0       try 100 times
lock1 swap d0
   move.w #99,d0
lock2 subq.w #1,d0    delay awhile
   bpl lock2
   swap d0
   tas kerlock(a0)    try again
   dbeq d0,lock1
   beq.s lock3
   print <nl,'Queue lock timeout',nl>
   bra *
lock3 pop.l d0
   rts

* Try in-line first for speed, call
* lock routine only if that fails.

lock macro
\* tas kerlock(a0)
   beq.s \@
   bsr lock
\@ equ *
   endm

unlock macro
\* bclr #7,kerlock(a0)
   endm

* Add cell A1 to TAIL of queue A0

enqueue macro
\* move.l kerbck(a0),a4
   move.l a0,kerfwd(a1)
   move.l a4,kerbck(a1)
   move.l a1,kerfwd(a4)
   move.l a1,kerbck(a0)
   move.l a0,kerqueue(a1)
   endm

* Remove HEAD of queue A0 to A1

dequeue macro
\* move.l kerfwd(a0),a1
   move.l kerfwd(a1),a4
   move.l a0,kerbck(a4)
   move.l a4,kerfwd(a0)
   clr.l kerqueue(a1)
   endm

* Signal semaphore A0.
* This routine is called by the
* supervisor calls (traps) for the
* Deallocate Kernel Object,
* Signal, Send Message, and Put
* Message Buffer services, and is
* also callable from interrupt
* handlers (which are not allowed
* to use TRAPs)

signal or #$700,sr
   lock
   addq.l #1,semcount(a0)
   ble.s signal1
   unlock
   rts

* Someone was waiting on the semaphore, so
* transfer a process to its run queue.

signal1 pushm a0/a1/a4
   dequeue
   unlock
   move.l prorq(a1),a0
   lock
   enqueue
   unlock

* If the target run queue is on a different
* processor, alert its scheduler.

   move.l rqtickler(a0),a1
   cmp.l #tickler,a1
   bne.s signal2

* Alert our own scheduler only if the new
* process's priority exceeds our own.

   move.l curpro,a4
   cmp #0,a4
   beq.s signal2
   cmp.l prorq(a4),a0
   ble.s signal3

signal2 move.b #255,(a1)
signal3 popm a0/a1/a4
   rts

* Wait on semaphore A0.
* This routine is called by the
* TRAPs for Wait, Allocate Message
* Buffer, and Receive Message, and
* Allocate Kernel Object.

wait or #$700,sr
   cmp #0,a0
   beq idle
   lock
   subq.l #1,semcount(a0)
   bmi.s wait1
   unlock
   rts

* Come here when we have waited and
* been signalled.  Restore SP and A0,
* because we don't know whether we're
* running with 68000 or 68010.

wait9 move.l a0,sp
   pop.l a0
   rts

* Come here when we have established that
* the caller must be suspended.  First we
* undo the counter adjustment and unlock
* the queue, as saving context is deemed
* to take too long to warrant keeping the
* lock for the duration.

wait1 addq.l #1,semcount(a0)
   unlock

* We will now almost certainly relinquish
* the CPU.  Preserve context by creating
* a suitable RTE stack frame.

   push.l a0
   move.l sp,a0      for 68000/68010
   push.w #0
   pea wait9
   push.w sr
   pushm part1       rest of context
   move.l usp,a4
   pushm part2
   move.l (a0),a0
   move.l curpro,a1
   move.l sp,prossp(a1)

* Re-acquire lock and re-adjust counter

   lock
   subq.l #1,semcount(a0)
   bpl.s wait2          oh no ->
   enqueue
   unlock

* Come here to relinquish CPU.
* Before proceeding with the idle task,
* which places the processor into HALTed
* state, invoke the scheduler to make
* certain no other processes are waiting.

idle clr.l curpro
   move.b #255,tickler
   move.l $1000,sp
idleloop stop #$2000
   bra idleloop

* If we get here, someone else has got in
* and signalled the semaphore while we were
* saving our context, so we do not relinquish
* the CPU after all.

wait2 unlock
   lea part2size(sp),sp
   popm part1
   rte

* Trap (Supervisor call) handling

* Exchange contents of SR and D0

trap0 push.w (sp)
   move.w d0,2(sp)
   pop.w d0
   rte

* Or D0 into SR (and return previous SR in D0)

trap1 push.w (sp)
   or.w d0,2(sp)
   pop.w d0
   rte

* Set process priority
* D0: (0:min 7:max)
* A0: process involved
* Effect is immediate, hence we
* relinquish the CPU.

trap2 or #$700,sr
   pushm part1
   and.w #7,d0
   lsl.w #2,d0
   lea runqueues,a1
   move.l (a1,d0.w),a1
   move.l a1,prorq(a0)
   move.l curpro,a1
   move.l usp,a4
   pushm part2
   move.l sp,prossp(a1)
   move.l prorq(a1),a0
   lock
   enqueue
   unlock
   bra idle

* Set process privilege
* D0: (1:on 0:off)
* A0: Process

trap3 or #$700,sr
   tst.b proasn(a0)
   beq.s trap3done    physical mode ->
   bclr #0,proasn(a0)
   and #1,d0
   beq.s trap3done
   bset #0,proasn(a0)
trap3done rte

* Signal sempahore A0

trap6 bsr signal
   rte

* Semaphore wait A0

trap7 bsr wait
   rte

* Procedures to make a system message buffer
* accessible (or inaccessible) to processes
* running in user mode.  Called by Traps which
* send and receive messages and those which
* allocate and deallocate message buffers.
* Stack assumed: RA, PART1, SR, PC, FW,
* A4 assumed to point at PCB.
* In virtual mode, the message buffer always
* appears at address VMA and is two pages long.

vma equ $004000  Virtual Message buffer Address
vms equ 2048     and Size

* If caller is in virtual mode,
* remove the MMU entry for the
* virtual address used to access
* the message buffer, return with
* A0 containing the physical address
* of the message buffer.

unmapbuf btst #5,4+part1size(sp)  supervisor mode?
   bne.s mapdone       yes ->
   tst.b proasn(a4)    virtual mode?
   beq.s mapdone       no ->
 ifne vm
   lea mmu0,a0
   move.b #1,mmudp(a0)
   move.b #0,mmussr(a0)
 endc
   move.l promsg(a4),a0
   clr.l promsg(a4)
mapdone rts

* If caller is in virtual mode,
* make a MMU entry for buffer A0
* and return with A0 containing the
* virtual address.

mapbuf btst #5,4+part1size(sp)  supervisor mode?
   bne mapdone         yes ->
   tst.b proasn(a4)    virtual mode?
   beq mapdone         no ->
 ifne vm
   lea mmu0,a1
   move.b #1,mmudp(a1)
   move.b #0,mmussr(a1)
   move.l a0,d0
   lsr.l #8,d0
   move.w d0,mmuacpba(a1)
   move.w #-(vms>>8),mmuaclam(a1)
   move.w #vma>>8,mmuaclba(a1)
   move.b proasn(a4),mmuacasn(a1)
   move.b #$fc,mmuacasm(a1)
   move.b mmuldo(a1),d0
   move.l a0,promsg(a4)  remember phy ad
   lea vma,a0            virtual address
 endc
   rts

* Allocate message buffer from pool,
* return buffer address in A0.

trap8 or #$700,sr
   pushm part1
   move.l msgsema,a0  wait for one
   bsr wait
   move.l msgpool,a0  take one
   lock
   dequeue
   unlock
   move.l a1,a0       initialise it
   clr.l msgreply(a0)
   clr.l msgsize(a0)
   move.l curpro,a4
   move.l a4,kerowner(a0)
   bsr mapbuf
   move.l a0,8(sp)    into stored A0
   popm part1
   rte

* Return message buffer A0 back to pool.

trap9 or #$700,sr
   pushm part1
   move.l curpro,a4
   bsr unmapbuf
   move.l a0,a1
   move.l msgpool,a0
   lock
   enqueue
   unlock
   move.l msgsema,a0
   bsr signal
   popm part1
   rte

* Send message A0 to mailbox A1.
* If A1=0, use MANAGERMAILBOX instead.

trapa or #$700,sr
   pushm part1
   move.l a1,d1
   bne.s sendmsg1        dest specified ->
   move.l managermbx,a1  use default
sendmsg1 move.l curpro,a4
   bsr unmapbuf
   move.l a4,kerowner(a0)
   exg a0,a1
   lock
   enqueue
   unlock
   move.l mbxsema(a0),a0
   bsr signal
   popm part1
   rte

* Receive a message through mailbox A0.

trapb or #$700,sr
   push.l a0
   move.l mbxsema(a0),a0
   bsr wait
   pop.l a0
   pushm part1
   lock
   dequeue
   unlock
   move.l a1,a0
   move.l curpro,a4
   bsr mapbuf
   move.l a0,8(sp)
   popm part1
   rte

* Allocate kernel object to A0,
* setting its tag/param fields to D0/D1.

trapc or #$700,sr
   move.l kersema,a0
   bsr wait
   move.l kerpool,a0
   pushm a1/a4
   lock
   dequeue
   unlock
   move.l a1,a0
   popm a1/a4
   clr.w kerlock(a0)
   move.w d0,kertag(a0)
   clr.l kerqueue(a0)
   move.l a0,kerfwd(a0)
   move.l a0,kerbck(a0)
   move.l curpro,kerowner(a0)
   move.l d1,kerparam(a0)
   rte

* Deallocate kernel object A0

trapd or #$700,sr
   pushm.l a0-a1/a4
   move.l a0,a1
   clr.l kerowner(a1)
   move.l kerpool,a0
   lock
   enqueue
   unlock
   move.l kersema,a0
   bsr signal
   popm a0-a1/a4
   rte

* Traps 4,5 spare
* Traps 14,15 are defined elsewhere

trap4 equ -1
trap5 equ -1
trape equ -1
trapf equ -1

* Interrupt despatching

* When an interrupt occurs, we push a subset
* of the registers (PART1: D0-D1/A0-A1/A4),
* D0-D1/A0-A1 being deemed sufficient for
* simple interrupt handlers to get on with,
* interrupt handlers may use more registers only
* if they take their own steps to preserve them.

* Since our hardware configuration allows only
* auto-vectoring, several device drivers may be
* involved in handling interrupts which use the
* same vector.  Interrupt handlers must therefore
* adhere to a strict discipline as regards
* returning from interrupts, so that on every
* occurrence of a particular interrupt all
* handlers for that vector get invoked in turn.

* Interrupt handlers are linked by means of
* control blocks, which during execution of
* a handler are pointed at by A4.  When a
* handler returns, A4 is pointed at the
* control block of the next handler, from
* which an appropriate PC value is fetched.
* The PC value stored in the notional "last"
* control block is RETINT, when we get there
* the pushed registers are popped and control
* is returned to the interrupted process.

ihpc   equ  0
*spare      4
ihfwd  equ  8
ihbck  equ 12
ihsize equ 16

handlerlist macro
\@ dc.l \2,\@,\@,\@
int\1 pushm part1
   move.l \@+ihfwd,a4
   move.l ihpc(a4),a1
   jmp (a1)
   endm

retint popm part1
   rte

 handlerlist 0,retint
 handlerlist 1,scheduler
 handlerlist 2,retint
 handlerlist 3,retint
 handlerlist 4,retint
 handlerlist 5,retint
 handlerlist 6,timer
 handlerlist 7,retint

* Wait for interrupt  (Co-routine:
* at next interrupt re-enter handler
* at return address)

intwait pop.l ihpc(a4)
   bra.s intnext

* Return from interrupt  (Ignore
* return address, at next interrupt
* enter handler at same place as before)

intret lea 4(sp),sp
intnext move.l ihfwd(a4),a4
   move.l ihpc(a4),a1
   jmp (a1)

* Add interrupt handler A4 to chain D0

intadd push sr
  or #$700,sr
  pushm part1
  and.w #7,d0
  lsl.w #2,d0
  lea intbase,a0
  move.l (a0,d0.w),a0
  lea -ihsize(a0),a0
  move.l ihbck(a0),a1
  move.l a4,ihfwd(a1)
  move.l a4,ihbck(a0)
  move.l a1,ihbck(a4)
  move.l a0,ihfwd(a4)
  popm part1
  pop sr
  rts

* Remove interrupt handler A4

intrem push sr
  or #$700,sr
  pushm part1
  move.l ihbck(a4),a1
  move.l ihfwd(a4),a0
  move.l a1,ihbck(a0)
  move.l a0,ihfwd(a1)
  popm part1
  pop sr
  rts

* Timer interrupt handler:
* Update elapsed-time counter.
* Perform time slicing.

timer or #$700,sr
   lea ptm,a0
   btst #2,ptmcr2(a0)     timer 3 overflow?
   beq retint             no ->
   movep.w ptmct3(a0),d0  placate
   moveq #10,d1
   add.l d1,uptime        update
   move.l curpro,d0       time-slice?
   beq retint             no ->
   move.l d0,a0
   add.l d1,procpu(a0)
   subq.w #1,protsl(a0)
   bpl retint             quantum not expired ->
   cmp.w #-1,protsl(a0)
   bne.s abort
   move.w protss(a0),protsl(a0)
   beq retint             quantum infinite ->
   bset #7,curpro         alert scheduler
   move.b #255,tickler
   bra retint
abort btst #5,part1size(sp)
   bne retint             not user mode ->
   move.w protss(a0),protsl(a0)
   move.l usp,a0
   move.l part1size+2(sp),d0
 ifne vm
   moveq #1,d1
   movec d1,dfc
   moves.l d0,-(a0)
 else
   move.l d0,-(a0)
 endc
   move.l a0,usp
   lea ctrly,a0
   move.l a0,part1size+2(sp)
   bra retint
ctrly moveq #$50,d0
   moveq #1,d1
   lea ctrlystring,a0
   jmp $3f00-6
ctrlystring string <'^Y'>

* Tickler interrupt handler (scheduler)
* Inspect the eight run queues in priority order.
* If the current process has higher priority than
* that associated with the highest waiting process,
* then do nothing.  Otherwise fling out the current
* process (if there is one) and wheel in another.

scheduler or #$700,sr

* Set D1 to a value related to the priority
* of interrupted process, or 0 if there was none,
* or a negative value if a time slice happened.

   move.l curpro,d1
   ble.s wasidle
   move.l d1,a4
   move.l proprio(a4),d1
wasidle moveq #28,d0
   bclr #7,curpro
schedloop lea runqueues,a0
   move.l (a0,d0.w),a0
   cmp.l a0,d1
   bge retint       d1 >= pri(RQ) ->
   lock
   dequeue
   unlock
   cmp.l a0,a1
   bne.s gotone     RQ was not empty ->
   subq #4,d0
   bpl schedloop    inspect next RQ
   bra retint

* Come here with A1 -> competing process

gotone move.l curpro,d0
   beq nosave            no context to save ->
   move.l a1,scratch     remember new process
   move.l d0,a1
   move.l usp,a4         save interrupted context
   pushm part2
   move.l sp,prossp(a1)
   move.l prorq(a1),a0   go back to run queue
   lock
   enqueue
   unlock
   move.l scratch,a1
nosave move.l a1,curpro  now new process
 ifne vm
   move.l provbr(a1),a0
   movec a0,vbr
 endc
   move.l prossp(a1),sp
   popm part2
   move.l a4,usp
   move.l a1,a4
   move.b proasn(a4),d0
 ifne vm
   lea mmu0,a1
   move.b d0,mmuasnud(a1)
   move.b d0,mmuasnup(a1)
   move.b #1,mmudp(a1)
   move.b #0,mmussr(a1)
   move.l promsg(a4),a0
   cmp #0,a0
   beq.s nomap
   bsr mapbuf
 endc
nomap popm part1
   rte

* Procedures for system startup

* Allocate and clear a 1k page
* at high end of free store.

grabpage move.l freetop,a0
   move.w #255,d0
grabloop clr.l -(a0)
   dbra d0,grabloop
   move.l a0,freetop
   rts

* Read file whose name is in A0
* into memory at FREEBOT+4, setting
* memory at FREEBOT to its size.
* Then advance FREEBOT by that size
* plus four, rounded up to 4n.
* Return with A0 pointing to start
* of file and D0 containing its size.

loadfile moveq #4,d0
   add.l freebot,d0
   jsr romload
   move.l freebot,a0
   move.l d0,(a0)+
   addq.l #3,d0
   and.w #-4,d0
   clr.l (a0,d0.l)
   add.l a0,d0
   move.l d0,freebot
   move.l -4(a0),d0
   rts

* Routines for scanning boot list file.

sym  equ d0
stop equ d1
temp equ d2
word equ a0
pos  equ a1

rsym moveq #127,sym
   move.l bootbeg,pos  @(size)+4
   move.l -4(pos),pos  size
   add.l bootbeg,pos   @end
   cmp.l bootpos,pos
   bls.s rs3           end reached ->
   move.l bootpos,pos
   and.b (pos)+,sym
   move.l pos,bootpos
   cmp.b #'!',sym   skip comments
   bne.s rs2
rs1 bsr rsym
   cmp.b #nl,sym
   bne rs1
rs2 rts
rs3 moveq #-1,sym
   rts

rword clr.w temp
rw0 bsr rsym
   cmp stop,sym
   ble.s rw2
   cmp #' ',sym
   beq rw0
rw1 addq #1,temp
   move.b sym,(word,temp.w)
   bsr rsym
   cmp stop,sym
   bgt rw1
rw2 move.b temp,(word)
   rts

hextab dc.b '0123456789ABCDEF'
bootlist string 'boot:xx'
  ds.w 0

* Move string \1 to \2 using \3 as temp

movestring macro
\* clr.w \3
   move.b (\1),\3
\@ move.b (\1,\3.w),(\2,\3.w)
   dbra \3,\@
   endm

* Define extracode number \1 as \2

jmpl equ $4ef9
xcode macro
  move.w #jmpl,xcodebase-6*\1
  move.l #\2,xcodebase-6*\1+2
  endm

****************************
* Initial entry is to here *
****************************

* Say hello
* Set up VBR for speed
* But beware in case not 68010

begin print <cr,'Mouse',nl>
  move.b #$15,acias       interrupts off (!)
  lea begin1,a1           intercept illegal inst
  move.l a1,$1010
  move.l #68010,cputype   68010 by default
  moveq #10,d0            perhaps 68000
  lea $1000,a0            now set up VBR
  movec a0,vbr
  clr.l d0                here if OK
begin1 sub.l d0,cputype   0 if OK, 10 if not
  move.l #-1,$1010        cancel intercept

* Set up extracode table

xcodebase equ $3f00
nxcodes   equ 64
xcodelim  equ xcodebase-6*nxcodes

   move.w #nxcodes-1,d0
   lea xcodebase,a0
xcodeloop lea -6(a0),a0
   move.w #$4afc,(a0)
   dbra d0,xcodeloop
   xcode 64,intret
   xcode 63,intwait
   xcode 62,intadd
   xcode 61,intrem
   xcode 60,signal
   xcode 59,becprocess

* Reserve 32k for user and a further
* 1k for "special" tables

   move.l memtop,freetop
   move.l membot,d0     $800000
   add.l #$008400,d0    $808400
   move.l d0,freebot

* Use last 256 bytes of the special
* tables space for the ATCPTE table

   move.l freebot,a0
   moveq #63,d0
atcloop clr.l -(a0)
   dbra d0,atcloop
   move.l a0,atcptetab
   move.b #2,atcslot

* Create 8 run queues

   move.l freebot,a0
   lea runqueues,a1
   moveq #7,d1
rqloop move.l a0,(a1)+
   move.l #'RQ',kerlock(a0)
   move.l a0,kerqueue(a0)
   move.l a0,kerfwd(a0)
   move.l a0,kerbck(a0)
   clr.l kerowner(a0)
   move.l #tickler,rqtickler(a0)
   lea kersize(a0),a0
   dbra d1,rqloop
   move.l a0,freebot

* Start the timer

   lea ptm,a0
   move.b #1,ptmcr2(a0)     crx==cr1
   move.b #1,ptmcrx(a0)     stop
   move.b #9,ptmct3(a0)     1kHz -> 100Hz
   move.b #124,ptmct3+2(a0) 125kHz -> 1kHz
   move.b #0,ptmcr2(a0)     crx==cr3
   move.b #$47,ptmcrx(a0)   mode
   move.b #1,ptmcr2(a0)     crx==cr1
   move.b #0,ptmcrx(a0)     go

* Generate the boot list file name.
* By default this is 'BOOT:XX', where
* XX is the APM's ether address, which
* has been stored at MACHINE by the ROM
* bootstrap.

   lea bootlist,a0       copy string to stack
   lea -256(sp),sp
   movestring a0,sp,d0
   lea hextab,a0         overwrite last 2 chars
   clr.w d0
   move.b (sp),d0        length of string
   moveq #15,d1
   and.b machine,d1      LS 4 bits
   move.b (a0,d1.w),(sp,d0.w)
   move.b machine,d1
   lsr.w #4,d1           MS 4 bits
   move.b (a0,d1.w),-1(sp,d0.w)

* If the user has struck a key, ask for
* a non-standard boot list file name.
* Otherwise proceed with the default.

   bsr kbtest
   bmi usethis

* If the response is just RETURN
* or SPACE, we use the default.

   print <'Startup file:'>
   bsr kbsym            read first char
   cmp.b #' ',d0
   ble.s done
   clr.w d1
next addq.b #1,d1
   beq next             wrap round???
   move.b d1,(sp)       update length
   move.b d0,(sp,d1.w)  add character
   bsr rompsym          echo it
read bsr kbsym          read next char
   cmp.b #' ',d0
   ble.s done           line complete ->
   cmp.b #bs,d0
   beq.s nodel
   cmp.b #del,d0
   bne next             add it ->
   subq.w #1,d1         erase
   bmi.s nodel          too far back ->
   print <bs,' ',bs>    echo
   bra read
nodel clr.w d1
   bra read
done bsr newline
   bra.s readbootfile

* Read in the boot list file

usethis move.l sp,a0
   print <'Startup file '>
   bsr rompstring
   bsr newline
readbootfile move.l sp,a0
   bsr loadfile
   move.l a0,bootbeg
   move.l a0,bootpos

* If the file begins with '@', the
* rest of the line contains the name
* of another file, to be used instead
* of the one we've just read.

   cmp.b #'@',(a0)+
   bne.s noindir
   lea -4,a1
   add.l bootbeg,a1
   move.l a1,freebot
   lea (sp),a1
   clr.b (a1)+
indloop move.b (a0)+,d0
   cmp.b #' ',d0
   ble usethis
   move.b d0,(a1)+
   addq.b #1,(sp)
   bra indloop
noindir lea 256(sp),sp   deallocate space for name

* Set ourselves up as a process,
* allocating space for POA and PCB.

*newproc move.l $1000,sp
newproc bsr grabpage
   move.l a0,a5
   bsr grabpage
   move.l a0,curpro
   move.l a0,usp
   move.l a5,sp
   move.l a5,propoa(a0)
   move.l #$80000000+rompsym,poacurout(a5)
   move.l #$1000,provbr(a0)
   move.l runqueues+28,prorq(a0)
   move #$700,sr      enter user mode

* Run the boot list programs

fileloop move.l freetop,sp
   move.l bootpos,d3
   bsr rsym
   tst.l sym
   bmi initdone         end of file reached
   cmp.l #'.',sym
   beq initdone         end of section reached
   cmp.l #' ',sym
   ble.s fileloop       skip blanks
   move.l d3,bootpos    unread symbol again
   lea -256(sp),sp      read file name
   move.l sp,word
   moveq #' ',stop
   bsr rword
   move.l curpro,a0
   lea proname(a0),a0
   movestring sp,a0,d1  store it
   move.l sym,-(sp)
   moveq #4,d0
   add.l freebot,d0
   jsr romphex8
   bsr space
   jsr rompstring       print it
   lea poacliparam(a5),a0
   tst.b (a0)
   beq.s fl0
   bsr space
   jsr rompstring
fl0 move.l (sp)+,sym
   clr.w d1             append ".mob"
   move.b (sp),d1
   add.b #4,(sp)
   move.b #'.',1(sp,d1)
   move.b #'m',2(sp,d1)
   move.b #'o',3(sp,d1)
   move.b #'b',4(sp,d1)
   lea poacliparam(a5),word
   clr.b (word)         clear parameter
   moveq #nl,stop
   cmp.b stop,sym       *SYM still unchanged*
   beq.s noparam
   bsr rword            read parameter
noparam move.l sp,a0    read the file
   bsr loadfile
   lea 256(sp),sp
   cmp.w #$fe02,fe02fe02(a0)
   bne dontrun          wrong magic word ->
   tst.w fe02import(a0)
   bne dontrun          file needs imports ->
   push.l a6            set Imp event trap
   push.l a4
   pea trap
   push.l #0
   move.l sp,(a5)
   moveq #3,d0
   add.l fe02ownsize(a0),d0
   and #-4,d0
   sub.l d0,sp          space for owns
   move.l sp,a4
   clr.l d0
   move.w fe02export(a0),d0  export size
   lea 32(a0,d0),a1     code base
   push.l a1
   move.w fe02main(a0),d0
   add.l d0,(sp)
   add.l d0,(sp)        main entry point
   move.w fe02reset(a0),d0
   add.l d0,a1
   add.l d0,a1          reset entry point
   push.l a0            remember file start ad
   lea $7fffffff,a6     set up registers & display
   lea $a3a3a3a3,a3
   lea $a2a2a2a2,a2
   move.l #$80808080,d7
   move.l #$d6d6d6d6,d6
   move.l #$d5d5d5d5,d5
   move.l #$000000d4,d4
   move.l #$d3d3d3d3,d3
   move.l #$d2d2d2d2,d2
   move.l #$d1d1d1d1,d1
   move.l #$d0d0d0d0,d0
   move.l a6,poadisplay(a5)
   move.l a6,poadisplay+4(a5)
   move.l a6,poadisplay+8(a5)
   move.l a6,poadisplay+12(a5)
   move.l a6,poadisplay+16(a5)
   move.l a6,poadisplay+20(a5)
   move.l a6,poadisplay+24(a5)
   jsr (a1)             call reset routine
   popm a0/a1
   jsr (a1)             enter main program
   moveq #0,d0
   jsr xcodebase-6      stop if it returns

* Come here when the file is not of the
* expected object format, or has import
* requirements (external references).

dontrun print <' loaded',nl>
   bra fileloop

* Event trap block

   bra.w initdone
trap dc.w -1       event mask

* Come here following an IMP event,
* usually because the program has
* stopped normally.

   move.l curpro,a0
   cmp.l freetop,a0
   bne.s stopped
   print <' done',nl>
   bra fileloop
stopped equ *
   lea proname(a0),a0
   jsr rompstring
   print <' stopped '>
   phex.b poaevent(a5),1
   bsr space
   phex.b poaevent+1(a5),2
   bsr space
   phex.l poaevextra(a5),8
   bsr space
   lea poaevmess(a5),a0
   jsr rompstring
   bsr newline
   bra stopproc

* Initialisation complete

initdone equ *
   print <'Initialisation complete',nl>
stopproc move.b #cr,d0
   jsr rompsym
   move.w #$2700,d0
   trap #0
   bra idle

* Loaded program calls to here if it
* wants to become a process.  D0 is
* the amount of work space it requires.

becprocess print <' running',nl>
   move.l #2048+1023,d1
   add.l freebot,d1
   and.w #-1024,d1      lower bound
   neg.l d0
   bne.s bec1
   move.l d1,d0         take all
   bra.s bec2
bec1 add.l sp,d0
   and.w #-1024,d0      page-align lower limit
bec2 move.l d0,freetop
   cmp.l d1,d0
   bhs.s becok          all is well ->
   print <nl,'Not enough memory for '>
   move.l curpro,a0
   lea.l proname(a0),a0
   jsr rompstring
   bsr newline
   move.w #$2700,d0
   trap #0
   bsr kbsym
reboot reset
   lea reboot1,a1  intercept illegal
   move.l a1,$1010 instruction in 68000
   lea 0,a0
   movec a0,vbr
reboot1 move.l (a0)+,sp
   move.l (a0),-(sp)
   rts
becok move.l d0,a0      create Imp heap
   move.l a0,poaheapbase(a5)
   lea 16(a0),a0
   move.l #$01000010,-16(a0)
   clr.l -12(a0)
   move.l a0,-8(a0)
   clr.l -4(a0)
   lea 256(a0),a0       note stack limit
   move.l a0,poastacklim(a5)
   move.l (sp)+,a0      PC
   move.w #$2700,d0     switch to super mode
   trap #0
   push.w #0            create RTE frame
   push.l a0
   push.w #0
   pushm part1          save context
   move.l usp,a4
   pushm part2
   move.l curpro,a1
   move.l sp,prossp(a1)
   move.l prorq(a1),a0  add to run queue
   lock
   enqueue
   unlock
   bra newproc

   end