! Mouse system include file

%option "-low-nonstandard"

! Kernel/Supervisor stuff

%recordformat semaphore fm -
 (%integer tag, %record(*)%name queue,fwd,bck,owner,
  %integer counter)

%recordformat mailbox fm -
 (%integer tag, %record(*)%name queue,fwd,bck,owner,
  %record(semaphore fm)%name semaphore)

%recordformat run queue fm -
 (%integer tag, %record(*)%name queue,fwd,bck,owner,
  %bytename tickler)

%constinteger max message size = 2020

%recordformat message fm -
 (%integer tag, %record(*)%name queue,fwd,bck,sender,
  %record(mailbox fm)%name reply,
  %integer size, %bytearray data(1:max message size))

%recordformat pcb fm (%bytearray supervisor stack (-1024:-1) %or -
  %integer tag, %record(*)%name queue,fwd,bck,owner,
  %record(run queue fm)%name target,
  %integer process own area, vector base register, supervisor stack pointer,
           cpu time, start time,
  %short time slice size, time slice left,
  %record(message fm)%name current message buffer,
  %record(mailbox fm)%name attention mailbox,
  (%record(*)%name address space descriptor %or %byte address space number),
  %string(63)program name)

%recordformat interrupt handler fm -
  (%integer pc,spare,%record(*)%name fwd,bck)

! Fixed-site supervisor variables

@16_11c0-
%record(run queue fm)%namearray runqueue(0:7),
%record(pcb fm)%name current process,
%integer system elapsed time,
%record(semaphore fm)%name object pool semaphore, message pool semaphore,
%record(mailbox fm)%name object pool, message pool, manager mailbox,
%integer boot list, cpu type

@16_3ff0 %integer freebot,freetop,membot,memtop

! Fixed-site routines

@16_3f00-6*64 %routine return from interrupt
@16_3f00-6*63 %routine wait for interrupt
@16_3f00-6*62 %routine add interrupt handler(%integer level)
@16_3f00-6*61 %routine remove interrupt handler
@16_3f00-6*60 %routine int signal semaphore(%record(semaphore fm)%name s)
@16_3f00-6*59 %routine become process(%integer space)        {booting only}
@16_408 %integerfn loadfile(%string(255)file,%integer where) {booting only}

! Supervisor call interface

%integerfn move to sr(%integer x)
  *move.l (sp)+,a0
  *trap #0
  *jmp (a0)
%end

%integerfn or to sr(%integer x)
  *move.l (sp)+,a0
  *trap #1
  *jmp (a0)
%end

%routine set priority(%record(pcb fm)%name process,%integer prio)
  *trap #2
%end

%routine set privilege(%record(pcb fm)%name process,%integer onoff)
  *trap #3
%end

%integerfn process cpu time(%record(pcb fm)%name process)
  %result = process_cputime
%end

%integerfn cputime
  %result = process cpu time(current process)
%end

%integerfn process elapsed time(%record(pcb fm)%name process)
  %result = system elapsed time-process_start time
%end

%integerfn priority(%record(pcb fm)%name process)
  %result = (addr(process_target)-addr(runqueue(0)))//sizeof(runqueue(0))
%end

%integerfn privilege(%record(pcb fm)%name process)
  %result = process_address space number&1
%end

%integerfn semaphore counter(%record(semaphore fm)%name s)
  %result = s_counter
%end

%routine signal semaphore(%record(semaphore fm)%name s)
  *trap #6
%end

%routine semaphore wait(%record(semaphore fm)%name s)
  *trap #7
%end

%record(message fm)%map get message buffer
  *trap #8
%end

%routine put message buffer(%record(message fm)%name m)
  *trap #9
%end

%routine send message -
  (%record(message fm)%name message, %record(mailbox fm)%name dest)
  *trap #10
%end

%record(message fm)%map receive message (%record(mailbox fm)%name mailbox)
  *trap #11
%end

%record(*)%map get kernel object(%integer tag,param)
  *trap #12
%end

%routine put kernel object(%record(*)%name o)
  *trap #13
%end

! Message manipulation

%routine move (%integer bytes,%name from,to)
%label finished,bytewise,trylong
  *move.l a0,d1; *move.l a1,d2
  *sub.l d1,d2; *and.w #1,d2; *bne bytewise  {buffers misaligned ->
  *move.l d0,d2; *ble finished
  *and.w #1,d1; *beq trylong                 {buffers word-aligned ->
  *move.b (a0)+,(a1)+; *subq.l #1,d0         {align them
trylong:
  *lsr.l #2,d2; *beq bytewise; *subq.l #1,d2; *swap d2
longouter: *swap d2
longinner: *move.l (a0)+,(a1)+; *dbra d2,longinner
  *swap d2; *dbra d2,longouter; *and.l #3,d0
bytewise: *subq.l #1,d0; *bmi finished; *swap d0
byteouter: *swap d0
byteinner: *move.b (a0)+,(a1)+; *dbra d0,byteinner
  *swap d0; *dbra d0,byteouter
finished:
%end

! Object manipulation

%record(semaphore fm)%map create semaphore(%integer c)
  %result == get kernel object('SE',c)
%end

%record(mailbox fm)%map create mailbox(%record(semaphore fm)%name s)
  %result == get kernel object('MB',addr(s))
%end

%routine delete semaphore(%record(semaphore fm)%name s)
  put kernel object(s)
%end

%routine delete mailbox(%record(mailbox fm)%name m)
  put kernel object(m)
%end
  
%recordformat manager request fm(%integer code,ref,%string(63)s)

%routine define kernel object(%record(*)%name x,%string(63)s)
%record(mailbox fm)%name mb
%record(message fm)%name me
%record(manager request fm)%name re
  mb == create mailbox(create semaphore(0))
  me == get message buffer
  re == record(addr(me_data(1)))
  me_size = sizeof(re); me_reply == mb
  re_code = 0; re_ref = addr(x); re_s = s
  send message(me,nil)
  put message buffer(receive message(mb))
  delete semaphore(mb_semaphore)
  delete mailbox(mb)
%end

%record(*)%map lookup kernel object(%string(63)s)
%record(*)%name x
%record(mailbox fm)%name mb
%record(message fm)%name me
%record(manager request fm)%name re
  mb == create mailbox(create semaphore(0))
  me == get message buffer
  re == record(addr(me_data(1)))
  me_size = sizeof(re); me_reply == mb
  re_code = 1; re_ref = 0; re_s = s
  send message(me,nil)
  me == receive message(mb)
  re == record(addr(me_data(1)))
  x == record(re_ref)
  put message buffer(me)
  delete semaphore(mb_semaphore)
  delete mailbox(mb)
  %result == x
%end

! Simple non-interlocked queue manipulation package,
! compatible with kernel object layouts, but only
! for use with local queues, not kernel queues.

%recordformat queue fm -
 (%integer tag, %record(*)%name queue,fwd,bck)

%routine setup queue (%record(*)%name queue)
! Makes a queue empty
%record(queue fm)%name q
  q == queue
  q_queue == nil
  q_fwd == q
  q_bck == q
%end

%routine enqueue(%record(*)%name cell,queue)
! Add CELL to tail of QUEUE
%record(queue fm)%name c,q,t
  c == cell; q == queue
  t == q_bck
  c_bck == t; c_fwd == q; c_queue == q
  t_fwd == c; q_bck == c
%end

%record(*)%map dequeue(%record(*)%name queue)
! Remove head of QUEUE, if any
%record(queue fm)%name q,c,h
  q == queue
  c == q_fwd; %result == nil %if c==q
  h == c_fwd
  h_bck == q; q_fwd == h
  c_bck == c; c_fwd == c; c_queue == nil
  %result == c
%end

%routine requeue(%record(*)%name cell,queue)
! Add CELL to head of QUEUE
%record(queue fm)%name c,q,h
  c == cell; q == queue
  h == q_fwd
  c_fwd == h; c_bck == q; c_queue == q
  h_bck == c; q_fwd == c
%end

%record(*)%map unqueue(%record(*)%name queue)
! Remove tail of QUEUE, if any
%record(queue fm)%name q,c,t
  q == queue
  c == q_bck; %result == nil %if c==q
  t == c_bck
  t_fwd == q; q_bck == t
  c_bck == c; c_fwd == c; c_queue == nil
  %result == c
%end

%routine exqueue(%record(*)%name cell)
! Remove CELL form whichever queue it is in
%record(queue fm)%name c,l,r
  c == cell; %returnif c_queue==nil
  l == c_bck; r == c_fwd
  l_fwd == r; r_bck == l
%end
