*debug macro
*   move.w sr,-(sp)
*   push d0
*   moveq #'\1',d0
*   jsr rompsym
*   pop d0
*   move.w (sp)+,sr
*   endm

   ttl Mouse Kernel and FE02 Bootstrap - Sep 86

* Configuration constants

   bin

mhz         equ 10
ptm         equ $400100
acia        equ $4000c1  used only to disable ints
eths        equ $07fffc  likewise
tickler     equ $ff3fff

* NB when changing number of run queues or
* priority state descriptors, remember to change
* lines containing *rq*

part1size equ 24
part1     equ d0-d1/a0-a1/a4/a6
part2     equ d2-d7/a2-a5
susp      equ a4

* Offsets for kernel and most system objects

ketag      equ  0   * Tag field and lock bit
kesize     equ  2   * Object size field
kefwd      equ  4   * Next object
kebck      equ  8   * Previous object
keheader   equ 12   * Queue in which object is

* Semaphores

secount    equ 16   * Semaphore count field
seassoc    equ 20   * Associated sempahore
sesize     equ 24

* Mailboxes

mbsema     equ 16   * Doorbell semaphore
mbsize     equ 20

* Messages

mereply    equ 16   * Return address
mesize     equ 20+16 *non-global allowance*

* Run Queues

rqtickler  equ 16   * Address of interrupt register
rqsize     equ 20

* Processes

prtarget   equ 16   * Run queue desired
prasync    equ 20   * Asynchronous mailbox
*                   *non-global* part follows
prssp      equ 24   * system stack pointer
prxvt      equ 28   * exception vector table
prtvt      equ 32   * trap vector table
prreftime  equ 36   * time at which we got cpu
prcputime  equ 40   * cpu time consumed at reftime
prmembot   equ 44   * Low end of store [heap..
prmemtop   equ 48   * High end of store ..stack]
prpoa      equ 52   * FE02 A5
prstate    equ 56   * current scheduling state
prquota    equ 60   * clock ticks left
prhyst     equ 62   * hysteresis for scheduler
prsize     equ 512  * remainder is System Stack

* Interrupt handler descriptors   *non-global*

ihpc       equ 16
iha4       equ 20
ihsize     equ 24

* Scheduling state descriptors   *non-global*

sslower    equ kefwd   * next lower priority state
sshigher   equ kebck   * next higher priority state
sstarget   equ 16      * associated run queue
ssprio     equ 20      * numeric priority (0:min)
ssquota    equ 22      * clock tick allowance
sshyst     equ 24      * hysteresis
*spare     equ 26
sssize     equ 28

* Exception, trap, and interrupt despatching

* Primary exception vector table

  org $1000
  dc.l $3000,startpc
  dc.l ex2,ex3
  dc.l ex4,ex5,ex6,ex7
  dc.l pvh,ex9,exa,exb
  dc.l exn,exn,exn,exn
  dc.l exn,exn,exn,exn
  dc.l exn,exn,exn,exn
  dc.l exn,ih1,ih2,ih3
  dc.l ih4,ih5,ih6,ih7
  dc.l tr0,tr1,tr2,tr3
  dc.l tr4,tr5,tr6,tr7
  dc.l tr8,tr9,tra,trb
  dc.l trc,trd,tre,trf

* Former extracode tables

i2 equ $4afc4afc

  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2
  dc.l i2,i2,i2,i2,i2,i2,i2,i2

* Kernel variables

cpu          dc.l 68000
milliseconds dc.l 0
curpro       dc.l 0

* Kernel statistics counters

ksint0      dc.l 0      *stats*
ksint1      dc.l 0
ksint2      dc.l 0
ksint3      dc.l 0
ksint4      dc.l 0
ksint5      dc.l 0
ksint6      dc.l 0
ksint7      dc.l 0
kstrap0     dc.l 0
kstrap1     dc.l 0
kstrap2     dc.l 0
kstrap3     dc.l 0
kstrap4     dc.l 0
kstrap5     dc.l 0
kstrap6     dc.l 0
kstrap7     dc.l 0
kstrap8     dc.l 0
kstrap9     dc.l 0
kstrapa     dc.l 0
kstrapb     dc.l 0
kstrapc     dc.l 0
kstrapd     dc.l 0
kstrape     dc.l 0
kstrapf     dc.l 0
kssign      dc.l 0
kssigt      dc.l 0
kswaitn     dc.l 0
kswaitt     dc.l 0

* Scheduling state descriptors

sd macro [prio,lower,higher,hyst,quota]
sd\1 dc.w 'SS',sssize
   dc.l sd\2,sd\3,sd\1
rq\1 dc.l 0
   dc.w \1,\5,\4,0
   endm

   sd 0,0,0,30000,10    *rq*
   sd 1,1,1,30000,15    *rq*
   sd 2,2,3,9,5         *rq*
   sd 3,2,4,9,5         *rq*
   sd 4,3,5,9,5         *rq*
   sd 5,4,5,9,5         *rq*
   sd 6,6,6,30000,5     *rq*
   sd 7,7,7,30000,30000 *rq*

minprio equ sd0  *rq*
maxprio equ sd7  *rq*

* Interrupt handling

push macro
\* move.l \1,-(sp)
   endm

pop macro
\* move.l (sp)+,\1
   endm

pushm macro
\* movem.l \1,-(sp)
   endm

popm macro
\* movem.l (sp)+,\1
   endm

exn rte           * ignore unknown exception

ihlist macro
\* dc.w 'IH',ihsize
   dc.l \*,\*,\*
   dc.l \1,0
   endm

ihl0 ihlist intdone       *dummy*
ihl1 ihlist ticklerint
ihl2 ihlist intdone
ihl3 ihlist intdone
ihl4 ihlist intdone
ihl5 ihlist intdone
ihl6 ihlist clockint
ihl7 ihlist intdone

ih macro
\* addq.l #1,ksint\1    *stats*
   pushm part1
   move.l ihl\1+kefwd,a6
   movem.l ihpc(a6),a0/a4
   jmp (a0)
   endm

ih1 ih 1
ih2 ih 2
ih3 ih 3
ih4 ih 4
ih5 ih 5
ih6 ih 6
ih7 ih 7

intdone popm part1
   rte

* Trap-exception despatching

tr macro
tr\1  addq.l #1,kstrap\1   *stats*
   pea $\1*4
   bra trh
   endm

trh push a0
   move.l curpro,a0
   cmp #0,a0
   beq trapcrash
   move.l prtvt(a0),a0
   add.l 4(sp),a0
   move.l (a0),4(sp)
   pop a0
   rts

   tr 0
   tr 1
   tr 2
   tr 3
   tr 4
   tr 5
   tr 6
   tr 7
   tr 8
   tr 9
   tr a
   tr b
   tr c
   tr d
   tr e
   tr f

* Machine exception despatching

ex macro
ex\1 pea $\1*4
   bra exh
   endm

exh push a0
   move.l curpro,a0
   cmp #0,a0
   beq exccrash
   move.l prxvt(a0),a0
   add.l 4(sp),a0
   move.l (a0),4(sp)
   pop a0
   rts

   ex 2
   ex 3
   ex 4
   ex 5
   ex 6
   ex 7
   ex 8
   ex 9
   ex a
   ex b

* Primary privilege violation handler
* for 68010->68000 compatibility:
* allow moves from SR to -(SP) or Dn
* Also intercept STOP #0

stopzero stop #0
pvh pushm d0/a0
   move.l 10(sp),a0
   move.w (a0),d0
   cmp.w #$40e7,d0
   beq.s pushsr
   and.w #-8,d0
   cmp.w #$40c0,d0
   beq.s readsr
   move.l (a0),d0
   cmp.l stopzero,d0
   beq crash
   popm d0/a0
   bra ex8
pushsr move.l usp,a0
   move.w 8(sp),-(a0)
   move.l a0,usp
   popm d0/a0
   addq.l #2,2(sp)
   move.l #68010,cpu
   rte
readsr moveq #7,d0
   and.w (a0),d0
   lsl.w #5,d0
   lsl.w #4,d0
   add.w #$3017,d0  move.w (sp),d0
   lea nasty,a0
   move.w d0,(a0)
   popm d0/a0
   addq.l #2,2(sp)
nasty nop
   rte

* Queue operation macros for internal use
* NB: Lock/Unlock are not exported.
* WAITs are not available to int handlers.

lock macro
\* tas ketag(\1)
   bpl.s \@a
   push d0
*  pea (\1)
*  bsr niltest
   moveq #-1,d0
\@ tas ketag(\1)
   dbpl d0,\@
   bmi lockcrash
   pop d0
\@a equ *
   endm

unlock macro
\* bclr #7,ketag(\1)
   endm

* Enqueue item A0 on end of queue A1

enqueue macro
   move.l kebck(a1),a2
   move.l a2,kebck(a0)
   move.l a1,kefwd(a0)
   move.l a1,keheader(a0)
   move.l a0,kefwd(a2)
   move.l a0,kebck(a1)
   endm

* Dequeue head of A1 to A0

dequeue macro
   move.l kefwd(a1),a0
   move.l kefwd(a0),a2
   move.l a1,kebck(a2)
   move.l a2,kefwd(a1)
   move.l #0,keheader(a0)
   move.l a0,kefwd(a0)
   move.l a0,kebck(a0)
   endm

* Enqueue item A0 on front of queue A1

requeue macro
   move.l kefwd(a1),a2
   move.l a2,kefwd(a0)
   move.l a1,kebck(a0)
   move.l a1,keheader(a0)
   move.l a0,kebck(a2)
   move.l a0,kefwd(a1)
   endm

* Dequeue tail of A1 to A0

unqueue macro
   move.l kebck(a1),a0
   move.l kebck(a0),a2
   move.l a1,kefwd(a2)
   move.l a2,kebck(a1)
   move.l #0,keheader(a0)
   move.l a0,kefwd(a0)
   move.l a0,kebck(a0)
   endm

iof macro
\* move.w sr,-(sp)
   or #$700,sr
   endm

ion macro
\* move.w (sp)+,sr
   endm

* Exported routines for use by interrupt handlers
* or special code "in the know"

* Add interrupt handler A0 to chain
* of handlers for level D0.
inthandadd pushm d0/a0-a2
   and.l #7,d0
   mulu #ihsize,d0
   lea ihl0,a1
   add.l d0,a1
** iof
   enqueue
** ion
   popm d0/a0-a2
   rts

* Remove interrupt handler A0 from
* whichever chain it is in.
inthandrem pushm a0-a2
   move.l a0,a1
** iof
   dequeue
** ion
   popm a0-a2
   rts

* Wait for interrupt (i.e. at next interrupt
* enter handler at point of call)
intwait move.l (sp),ihpc(a6)

* + return from interrupt (i.e. at next interrupt
* enter handler at same place as before)
* NB BOTH of these two are CALLED.
intret move.l kefwd(a6),a6
   move.l ihpc(a6),(sp)
   move.l iha4(a6),a4
   rts

* Exported entry points for kernel operations
* both for use by interrupt handlers
* and callable as traps.

trapop macro
\* or #$700,sr
  push a2
  lock a1
  \1
  unlock a1
  pop a2
  rte
  endm

intop macro
\* iof
  push a2
  lock a1
  \1
  unlock a1
  pop a2
  ion
  rts
  endm

niltest push a0
  move.l 8(sp),a0
  tst.l kefwd(a0)
  bne.s notnil
  move.l a0,kefwd(a0)
  move.l a0,kebck(a0)
  clr.l keheader(a0)
  move.w #'??',ketag(a0)
  lea uiqmess,a0
  jsr rompstr
  move.l 8(sp),d0
  jsr romphex
  moveq #nl,d0
  jsr rompsym
notnil pop a0
  move.l (sp)+,(sp)
  rts
uiqmess dc.b 255,'*Uninitialised queue ',0
  ds.w 0

intenq  intop  enqueue
trapenq trapop enqueue
intreq  intop  requeue
trapreq trapop requeue
intdeq  move.l a0,a1
        intop  dequeue
trapdeq move.l a0,a1
        trapop dequeue
intunq  move.l a0,a1
        intop  unqueue
trapunq move.l a0,a1
        trapop unqueue

* Extract A0 from whichever queue it is in.
* Result: A0 = that queue (or NIL)

intexq iof
   pushm a1-a2
   move.l keheader(a0),a1
   cmp #0,a1
   beq.s exqno
   lock a1
   cmp.l keheader(a0),a1
   bne.s exqnou
   move.l kebck(a0),a1
   move.l kefwd(a0),a2
   move.l a2,kefwd(a1)
   move.l a1,kebck(a2)
   move.l keheader(a0),a1
   move.l #0,keheader(a0)
   move.l a0,kefwd(a0)
   move.l a0,kebck(a0)
   unlock a1
   popm a1-a2
   ion
   rts
exqnou unlock a1
exqno popm a1-a2
   lea 0,a0
   ion
   rts

trapexq bsr intexq
   rte

* Insert A0 into a queue between items A1 and A2.
* A1 or A2 (but not both) may be NIL, but if not,
* they must be consistent.   Result:
* A0 = queue into which inserted (NIL if not).

intinq iof
   push a3
   cmp #0,a1
   beq.s a1nil
   cmp #0,a2
   beq.s a2nil
nonil move.l keheader(a1),a3
   cmp #0,a3
   beq inqno
   lock a3
   cmp.l keheader(a1),a3
   bne.s inqnou
   cmp.l keheader(a2),a3
   bne.s inqnou
   cmp.l kefwd(a1),a2
   bne.s inqnou
   cmp.l kebck(a2),a1
   bne.s inqnou
   move.l a1,kebck(a0)
   move.l a2,kefwd(a0)
   move.l a3,keheader(a0)
   move.l a0,kefwd(a1)
   move.l a0,kebck(a2)
   unlock a3
   pop a3
   ion
   rts
a1nil cmp #0,a2
   beq.s inqno
   move.l kebck(a2),a1
   bra nonil
a2nil move.l kefwd(a1),a2
   bra nonil
inqnou unlock a3
inqno pop a3
   lea 0,a0
   ion
   rts

trapinq bsr intinq
  rte

* Signal semaphore A0
* and its associated chained semaphores

intsignal iof
   pushm a0-a2
sigmore lock a0
   addq.l #1,secount(a0)   * bump
   bgt.s sigtriv           * no-one to dequeue ->
   addq.l #1,kssign        *stats*
   move.l a0,a1
   dequeue                 * take process from S Q
   unlock a1
   push a1                 * A0=process, TOS=sema
   move.l prtarget(a0),a1  * A1=target of process
   lock a1
   enqueue
   unlock a1
   move.l rqtickler(a1),a0 * tickle processor
   move.b #$ff,(a0)
   pop a0                  * restore sema to A0
   bra.s signext
sigtriv unlock a0
   addq.l #1,kssigt        *stats*
signext move.l seassoc(a0),a0  * move on to
   cmp #0,a0                   * chained semaphore
   bne sigmore                 * if any
   popm a0-a2
   ion
   rts

trapsignal bsr intsignal
   rte

* Test semaphore A0
* Decrement counter only if positive
* Result: D0 = original counter value

inttest iof
   lock a0
   move.l secount(a0),d0
   ble.s negative
   subq.l #1,secount(a0)
negative unlock a0
   ion
   rts

traptest bsr inttest
   rte

* Wait on semaphore A0
* GDMR 11/8/88  Test the semaphore count first before
* saving context.  If it's +ve then don't bother, just
* decrement it and return.  If it's -ve then we'll have
* to wait, so just drop through to do the full works.

* +GDMR
nullwait subq.l #1,secount(a0)
   unlock a0
   addq.l #1,kswaitt    *stats*
   rte
* -GDMR

trapwait or #$700,sr
* +GDMR
   lock a0
   tst.l secount(a0)
   bgt.s nullwait
   unlock a0
* -GDMR
   addq.l #1,kswaitn     *stats*
   pushm part1           * save context
   move.l usp,susp
   pushm part2
   move.l a0,a1
   move.l curpro,a0
   move.l sp,prssp(a0)   * A0=process, A1=semaphore
   bsr gettime
   sub.l prreftime(a0),d0
   add.l d0,prcputime(a0)
   add.l d0,prreftime(a0)
   move.l prstate(a0),a2
   addq.w #1,prhyst(a0)  * reward
   bmi.s staylow
   bgt.s settop
   move.l sshigher(a2),a2 * change to higher prio
   move.l a2,prstate(a0)
   move.l sstarget(a2),prtarget(a0)
settop move.w sshyst(a2),prhyst(a0) * set ceiling
staylow equ *
   lock a1
   subq.l #1,secount(a1)
   bpl.s unsuspend
   enqueue
   unlock a1
   bra maybeidle
unsuspend unlock a1
   popm part2
   move.l susp,usp
   popm part1
   rte

* Get elapsed time to D0
* Interrupts assumed disabled

gettime moveq #99,d0
   sub.b ptm+12,d0
   bne.s gettime1
   btst.b #2,ptm+2
   beq.s gettime1
   tst.b ptm+12
   add.l #100,milliseconds
gettime1 add.l milliseconds,d0
   rts

* Clock interrupt handler
* (hung off the IPL6 header)

clockint lea ptm,a0
   moveq #4,d0
   and.b 2(a0),d0
   beq intdone               * Not clock ->
   movep.w 12(a0),d0         * Placate
   add.l #100,milliseconds   * Count time
   move.l curpro,d0
   beq intdone               * No process to slice ->
   move.l d0,a0
   subq.w #1,prquota(a0)
   bpl intdone               * Not expired ->
   or #$700,sr
   moveq #7,d0
   and.b part1size(sp),d0    * interrupted IPL
   bne intdone               * in int handler ->
   move.l usp,susp
   pushm part2
   move.l sp,prssp(a0)
   bsr gettime
   sub.l prreftime(a0),d0
   add.l d0,prcputime(a0)
   add.l d0,prreftime(a0)
   move.l prstate(a0),a2
   subq.w #1,prhyst(a0)      * punish
   bpl.s stayhigh
   bgt.s setbot
   move.l sslower(a2),a2     * change to low prio
   move.l sstarget(a2),prtarget(a0)
setbot move.w sshyst(a2),prhyst(a0)
   neg.w prhyst(a0)
stayhigh equ *
   move.l prtarget(a0),a1    * put proc on its RQ
   lock a1
   enqueue
   unlock a1
* fall through to maybeidle

* Tickler interrupt handler
* (hung off IPL1 header)

try macro
   cmp.w sd\1+ssprio,d0
   bge nogo
   move.l rq\1,a1
   lock a1
   dequeue
   cmp.l a0,a1
   bne go
   unlock a1
   endm

maybeidle move.l $1000,sp
   clr.l curpro
ticklerint or #$700,sr
   push a2
* Set D0.W to the priority of the
* interrupted process (-1 if none)
   moveq #-1,d0
   move.l curpro,a2
   cmp #0,a2
   beq.s idling
   move.l prstate(a2),a2
   move.w ssprio(a2),d0
idling equ *
* Scan run queues for higher priority process
   try 7  *rq*
   try 6  *rq*
   try 5  *rq*
   try 4  *rq*
   try 3  *rq*
   try 2  *rq*
   try 1  *rq*
   try 0  *rq*
* If there is none, pretend nothing happened
nogo pop a2
   tst.l curpro
   beq.s idle
   popm part1
   rte
idle move.l $1000,sp
idleloop stop #$2000
   bra idleloop

* Now A0 is the highest priority contender, and
* A1 (still locked) is the queue it came from.

go move.l curpro,d0    
   beq nosave            * No current context ->
   unlock a1
   pop a2
   move.l usp,susp       * Switch contexts
   pushm part2
   move.l a0,a3
   move.l d0,a0          * A0=old, A3=new process
   move.l sp,prssp(a0)
   bsr gettime
   move.l d0,prreftime(a3)
   sub.l prreftime(a0),d0
   add.l d0,prcputime(a0)
   add.l d0,prreftime(a0)
   move.l prtarget(a0),a1
   lock a1
   enqueue               * put old on its RQ
   unlock a1
   move.l a3,a2
unsave move.l a2,curpro
   move.l prssp(a2),sp   * pick up new p's context
   move.l prstate(a2),a0
   move.w ssquota(a0),prquota(a2) * set clock quota
   popm part2
   move.l susp,usp
   popm part1
   rte
nosave unlock a1
   bsr gettime
   move.l d0,prreftime(a0)
   move.l a0,a2
   bra unsave

** End of kernel code, initialisation follows

cr equ 13
lf equ 10
nl equ lf

string macro
\* dc.b \@1-*-1,\1
\@1 equ *
   ds.w 0
   endm

ptext macro
\* lea \@1,a0
   bra.s \@2
\@1 string <\1>
\@2 jsr rompstr
   endm

psym macro
\* moveq #\1,d0
   jsr rompsym
   endm

space macro
\* psym <' '>
   endm

newline macro
\* psym lf
   endm

romload  equ $408
romphex  equ $40c
romphex4 equ $410
romphex2 equ $414
romphex1 equ $418
rompsym  equ $41c
rompstr  equ $420

impsignal equ $3f00-6
psym equ $3f00-144
pstr equ $3f00-150
new  equ $3f00-120

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

heaplevel equ 0   [byte]
heapsize  equ 0   [long &$ffffff]
heapholes equ 4   hole list
heapfront equ 8   ad of free space
heaplimit equ 12  current expansion limit
heapend   equ 16  max exp lim
hhsize    equ 20  heap header cell size

* Initial entry from ROM is to here

startpc move.w #$2700,sr
   move.b #$11,acia     disable terminal interrupts
   move.b #0,eths       and ether board interrupts

* Make obsolete FREEBOT/TOP appear empty

   move.l memtop,sp
   move.l sp,freebot
   move.l sp,freetop

* initialise the main heap header cell.

   move.l membot,a0
   move.l #hhsize,heapsize(a0)
   move.b #1,heaplevel(a0)
   clr.l heapholes(a0)
   move.l a0,heapfront(a0)
   add.l #hhsize,heapfront(a0)
   move.l sp,heaplimit(a0)
   move.l sp,heapend(a0)

* Set up the FE02 extracode table

xcode macro
   move.l #\2,$3f02-\1
   endm

   moveq #63,d0
   lea $3f00,a0
xcloop move.l #absent,-(a0)
   move.w #$4ef9,-(a0)
   dbra d0,xcloop
   move.l #absent,$3fa4  [screenput]
   move.w #$4ef9,$3fa2
   move.w #$1850,$3fa0   [screenrows/cols]
   xcode 6,signalevent
   xcode 12,mull
   xcode 18,divl
   xcode 120,heapget
   xcode 144,rompsym
   xcode 150,rompstr
   xcode 6*64,intenq
   xcode 6*63,intdeq
   xcode 6*62,intreq
   xcode 6*61,intunq
   xcode 6*60,intinq
   xcode 6*59,intexq
   xcode 6*58,intsignal
   xcode 6*57,inttest
   xcode 6*56,intret
   xcode 6*55,intwait
   xcode 6*54,inthandadd
   xcode 6*53,inthandrem

* Create the master dictionary

   moveq #8,d0
   jsr new
   clr.l (a0)+
   clr.l (a0)+

* Create the run queues

rq macro
   jsr rq
   move.l a0,rq\1
   endm

   rq 7  *rq*
   rq 6  *rq*
   rq 5  *rq*
   rq 4  *rq*
   rq 3  *rq*
   rq 2  *rq*
   rq 1  *rq*
   rq 0  *rq*

* Create the PCB and POA for the initial process

   move.l sp,a0
   moveq #512/4-1,d0
pcbloop clr.l -(a0)
   dbra d0,pcbloop
   move.l a0,a5
   move.l #1024/4-1,d0
poaloop clr.l -(a5)
   dbra d0,poaloop
   move.l a0,curpro
   move.l a5,prpoa(a0)
   move.w #'PR',ketag(a0)
   move.w #prsize,kesize(a0)
   move.l membot,prmembot(a0)
   move.l memtop,prmemtop(a0)
   lea minprio,a1
   move.l a1,prstate(a0)
   move.l sstarget(a1),prtarget(a0)
   move.w ssquota(a1),prquota(a0)
   move.w sshyst(a1),prhyst(a0)
   move.l #defxvt,prxvt(a0)
   move.l #deftvt,prtvt(a0)

* Start the millisecond clock
* and decisecond interrupt generator

   lea ptm,a0
   move.b #1,2(a0)           cr1
   move.b #1,0(a0)           reset
   move.b #99,12(a0)         1kHz -> 10Hz
   move.b #mhz/2*25-1,14(a0) .8/1 MHz -> 1kHz
   move.b #0,2(a0)           cr3
   move.b #$47,(a0)          mode
   move.b #1,2(a0)           cr1
   move.b #0,0(a0)           run

* Set up the user stack and IMP registers,
* switch to user mode with interrupts enabled
* before loading the rest of the system.

   lea 0,a6
   lea 0,a4
   move.l #$80808080,d7
   moveq #0,d6
   moveq #0,d5
   moveq #0,d4
   move.l a5,usp
   move #0,sr

* Establish whether 68000 or 68010

   move sr,-(sp)
   move.w (sp)+,d0

* Read in system base file

  jsr heapguess
  jsr romphex
  space
  lea basefile,a0
  jsr rompstr
   jsr heapguess
   lea basefile,a0
   jsr romload
   jsr new
   newline

* Enter it

fe02     equ 0
export   equ 4
import   equ 6
codesize equ 8
reset    equ 12
begin    equ 14
ownsize  equ 16
fe02size equ 32

   cmp.w #$fe02,fe02(a0)
   bne.s no
   moveq #3,d0
   add.l ownsize(a0),d0
   lsr.l #2,d0
   subq.l #1,d0
   moveq #0,d1
ownloop move.l d1,-(sp)
   dbra d0,ownloop
   move.l sp,a4
   move.w import(a0),d0
   bne.s no
   clr.l d0
   move.w export(a0),d0
   clr.l d1
   move.w reset(a0),d1
   add.l d1,d1
   clr.l d2
   move.w begin(a0),d2
   add.l d2,d2
   lea fe02size(a0,d0.l),a1
   pea 0(a1,d2.l)
   push a0
   jsr 0(a1,d1.l)
   popm a0-a1
   jsr (a1)
no ptext <'Squeak'>
   bra crash
basefile string 'moose:base.mob'

* Default exception and trap vector tables

defxvt dc.l bum,bum,berr,aerr
   dc.l ille,zero,chkf,over
   dc.l priv,trac,ille,ille
   dc.l bum,bum,bum,bum
deftvt dc.l trapmtsr,trapotsr,trapenv,bum
   dc.l bum,bum,trapsignal,trapwait
   dc.l trapenq,trapdeq,trapreq,trapunq
   dc.l trapinq,trapexq,traptest,trapline

* The absent extracode

absent move.l (sp),a0
   clr.l d2
   move.w -2(a0),d2
   moveq #9,d1
   moveq #$70,d0
   lea absmess,a0
   jmp impsignal
absmess string <'Missing extracode'>

* Exception to IMP event conversion

berr moveq #2,d1
   lea berrmess,a0
   bra.s aberr
aerr moveq #3,d1
   lea aerrmess,a0
aberr moveq #$70,d0
   cmp.l #68000,cpu
   beq.s be000
   move.l 10(sp),d2
   move.w (sp),50(sp)
   move.l 2(sp),52(sp)
   move.w #0,56(sp)
   lea 50(sp),sp
   bra.s sig
be000 move.l 2(sp),d2
   lea 8(sp),sp
sig move.l #impsignal,2(sp)
   rte
aerrmess string <'Address error'>
berrmess string <'Bus error'>

event macro
\* lea \@1,a0
   moveq #$5\1,d0
   moveq #\2,d1
   bra sig
\@1 equ *
   string <\3>
   endm

bum  event 0,5,<'Reserved exception'>
zero event 1,4,<'Division by zero'>
chkf event 6,2,<'CHK: Out of range'>
over event 1,4,<'TRAPV: Overflow'>
ille event 0,4,<'Illegal instruction'>
priv event 0,8,<'Privilege violation'>

* Move D0 to SR, returning previous SR to D0

trapmtsr move.w (sp),-(sp)
   move.w d0,2(sp)
   move.w (sp)+,d0
   rte

* Or D0 to SR, returning previous SR to D0

trapotsr move.w (sp),-(sp)
   or.w d0,2(sp)
   move.w (sp)+,d0
   lea ksint0,a0       *stats*
   rte

* Update timers in current PCB, and return
* D0 = cpu type,
* A0 = current PCB,
* A1 = scheduling state for priority 0

trapenv or #$700,sr
   bsr gettime
   move.l curpro,a0
   sub.l prreftime(a0),d0
   add.l d0,prcputime(a0)
   add.l d0,prreftime(a0)
   move.l cpu,d0
   lea minprio,a1
   rte

* Imp line-trace exception

trapline pushm part1
   move.l part1size+2(sp),a0
   moveq #0,d0
   move.w (a0)+,d0
   move.l a0,part1size+2(sp)
   move.w d0,-(sp)
   ptext <'Line '>
   move.w (sp)+,d0
   jsr romphex4
   newline
   popm part1
   rte

* Trace exception

trac pushm part1
   ptext <'PC '>
   move.l part1size+2(sp),d0
   jsr romphex
   newline
   popm part1
   rte

* Preliminary Imp signal routine

signalevent movem.l d0-d2/a0,-(sp)
   ptext <nl,'Premature event '>
   move.l (sp)+,d0
   jsr romphex2
   space
   move.l (sp)+,d0
   jsr romphex2
   space
   move.l (sp)+,d0
   jsr romphex
   space
   move.l (sp)+,a0
   jsr rompstr
crash move #$2700,d0
   trap #0
   move.b acia+2,d0
   move.b acia+2,d0
hang btst #0,acia
   beq hang
   reset
   move.l 0,sp
   move.l 4,-(sp)
   rts

trapcrash pop a0
   ptext <nl,'* Anony-mouse-trap'>
   bra crash
exccrash pop a0
   ptext <nl,'* Anonymous exception'>
   bra crash
lockcrash push a0
   ptext <nl,'* Lock timeout for '>
   pop d0
   jsr romphex
   bra crash

* Allocate space for and initialise a run queue

rq moveq #rqsize,d0
   jsr new
   move.w #'RQ',ketag(a0)
   move.w #rqsize,kesize(a0)
   move.l a0,kefwd(a0)
   move.l a0,kebck(a0)
   clr.l keheader(a0)
   move.l #tickler,rqtickler(a0)
   rts

* Grab a heap chunk of size D0 bytes
* and return its start address in A0 and D0.
* Used only during initialisation, hence no
* limit checking or hole searching.

heapget move.l membot,a0
   addq.l #7,d0
   and.b #$fc,d0
   add.l d0,heapfront(a0)
   move.l heapfront(a0),a0
   sub.l d0,a0
   move.l d0,(a0)+
   move.b #1,-4(a0)
   move.l a0,d0
   rts

* Preview the address of the next heap chunk
* which HEAPGET would allocate, but without
* actually allocating it.  Used during file
* loading before we know how big the file is.

heapguess moveq #-4,d0
   bra heapget

* 32-bit nultiply and divide

mull movem.l d1-d4,-(sp)
   moveq #0,d4
   move.l d0,d2
   bpl.s m1
   neg.l d0
   moveq #1,d4
   move.l d0,d2
m1 swap d2
   move.l d1,d3
   bpl.s m2
   neg.l d1
   eor.w #1,d4
   move.l d1,d3
m2 swap d3
   tst.w d2
   beq.s maz     * A>>16=0 ->
   tst.w d3
   beq.s mbz     * B>>16=0 ->
   mulu d0,d3
   mulu d1,d2
   mulu d1,d0
   add.l d3,d2
   swap d0
   add.w d2,d0
   swap d0
   bra.s mv      * mandatory overflow ->
maz tst.w d3
   beq.s mabz    * A>>16=B>>16=0 ->
   mulu d0,d3
   mulu d1,d0
   swap d0
   add.w d3,d0
   swap d0
   swap d3
   tst.w d3
   bne.s mv      * certain overflow ->
   bra.s mvt     * possible overflow ->
mbz mulu d1,d2
   mulu d1,d0
   swap d0
   add.w d2,d0
   swap d0
   swap d2
   tst.w d2
   bne.s mv
   bra.s mvt
mabz mulu d1,d0
mvt tst.l d0
   bmi.s mv
   btst #0,d4
   beq.s m8
   neg.l d0
m8 tst.l d0
   movem.l (sp)+,d1-d4
   rts
mv btst #0,d4
   beq.s m9
   neg.l d0
m9 tst.l d0
   movem.l (sp)+,d1-d4
   or.b #2,ccr
   rts

divl     movem.l d2-d4,-(sp)
         clr     d4
         move.l  d1,d2
         beq.s   zdivoflow
         bpl.s   divpos1
         neg.l   d2
         or      #2,d4
divpos1  move.l  d0,d1
         bpl.s   divpos2
         neg.l   d1
         eor.l   #3,d4
divpos2  clr.l   d0
         move.l  #1,d3
         bra.s   divsulps
divsulp  lsl.l   #1,d2
         lsl.l   #1,d3
divsulps cmp.l   d2,d1
         bhi.s   divsulp
divlp    cmp.l   d2,d1
         bcs.s   divnosub
         add.l   d3,d0
         sub.l   d2,d1
divnosub lsr.l   #1,d2
         lsr.l   #1,d3
         bne     divlp
         lsr     #1,d4
         bcc.s   nonegrem
         neg.l   d1
nonegrem tst     d4
         beq.s   nonegquo
         neg.l   d0
nonegquo tst.l   d0
         movem.l (sp)+,d2-d4
         rts
zdivoflow movem.l (sp)+,d2-d4
         divu #0,d0
         rts

   end
