! Disc driving stuff -- drive-independent part. %externalstring(47) copyright indep %alias "GDMR_(C)_DISC.INDEP" = %c "Copyright (C) 1987 George D.M. Ross" %externalroutinespec FS insert(%string(31) name, %integer value) %externalpredicatespec FS lookup(%string(31) name, %integername value) %include "GDMR_H:Dump.Inc" %recordformat disc message fm(%record(message fm) system part, ((%integer code, block, buffer, size) %c %or (%integer status, p, q, r)), %record(disc message fm)%name forward, backward) %constinteger status request = 0 %constinteger read request = 1 %constinteger write request = 2 %constinteger stats request = 3 %ownrecord(queue fm) disc queue = 0 %ownrecord(semaphore fm) disc sema = 0 %ownrecord(mailbox fm) disc mailbox = 0 ! Disc requests are linked together on a doubly-linked list, sorted by disc ! address. At present there is only one queue, shared among all the drives ! attached to the controller, sorted by disc address ignoring the drive ID, ! which is reasonably fair if there are two or more drives (it's irrelevant ! if there's only one), and preserves the property that the middle of the disc ! (address-wise) receives preferential treatment over the extremities. ! This queue is alternately traversed forwards and backwards, the direction ! being switched when there are no more requests left in the current direction ! of travel. The current request is removed from the queue, with the next ! request (if any) also being noted -- this "next request" is thus guaranteed ! to be the next one processed, even if intervening addresses are subsequently ! added to the queue; again, this seems reasonably fair. %owninteger requests pending = 0 %ownrecord(disc message fm)%name pending queue head == nil %ownrecord(disc message fm)%name pending queue tail == nil %ownrecord(disc message fm)%name current request == nil %ownrecord(disc message fm)%name next request == nil %owninteger direction = 0 %routine dump queue(%string(63) where) %record(disc message fm)%name m printstring(where); print symbol(':'); newline %if current request == nil %start printstring("No current request") %else phex(addr(current request)) printstring(" -> "); phex(addr(current request_forward)) printstring(" <- "); phex(addr(current request_backward)) write(current request_code, 4); space; phex(current request_block) space; phex(current request_buffer); write(current request_size, 1) %finish newline %if next request == nil %start printstring("No next request") %else phex(addr(next request)) printstring(" -> "); phex(addr(next request_forward)) printstring(" <- "); phex(addr(next request_backward)) write(next request_code, 4); space; phex(next request_block) space; phex(next request_buffer); write(next request_size, 1) %finish newline write(requests pending, 0); printstring(" pending") %if direction = 0 %then printstring(" ->") %c %else printstring(" <-") newline m == pending queue head %while m ## nil %cycle phex(addr(m)) printstring(" -> "); phex(addr(m_forward)) printstring(" <- "); phex(addr(m_backward)) write(m_code, 4); space; phex(m_block) space; phex(m_buffer); write(m_size, 1) newline m == m_forward %repeat %end %routine do pending %recordformat r fm(%integerarray d, a(0 : 7)) %ownrecord(r fm) saved r = 0 %owninteger i !! dump queue("Do pending "); newline requests pending = requests pending - 1 %if requests pending = 0 %start ! Only the one was waiting. Note it, then mark the queue as empty. ! NB the next request pointer is also zapped here for safety. current request == pending queue head; ! Head == only request pending queue head == nil pending queue tail == nil next request == nil %else ! More than one pending. If the next request pointer is non-null ! then use that, else reverse the direction of motion and choose ! the first request in whichever direction we now happen to be ! travelling. current request == next request %if current request == nil %start ! No more. Reverse direction and choose first. direction = \direction %if direction = 0 %then current request == pending queue head %c %else current request == pending queue tail %finish !! printstring("Current "); phex(addr(current request)) !! printstring(", -> "); phex(addr(current request_forward)) !! printstring(", <- "); phex(addr(current request_backward)) !! printstring(", dir "); write(direction, 0) !! printstring(", code "); write(current request_code, 0) !! printstring(", block "); write(current request_block, 0); newline ! We've chosen our request. Unlink it from the queue. First the ! next entry's back-pointer. %if current request_forward == nil %start pending queue tail == current request_backward %else current request_forward_backward == current request_backward %finish ! Now the previous entry's forward-pointer. %if current request_backward == nil %start pending queue head == current request_forward %else current request_backward_forward == current request_forward %finish ! Finally, choose the "next request". %if direction = 0 %start ! Choose next forward next request == current request_forward %else ! Choose next backward next request == current request_backward %finish %finish ! Now decide if we should read or write. %if current request_code = read request %start ! Read buffer !L! %if direction = 0 %then lights or A(lights read) %c !L! %else lights or B(lights read) current request_status = do disc read(current request_block, current request_size, byteinteger(current request_buffer)) %else %if current request_code = write request ! Write buffer !L! %if direction = 0 %then lights or A(lights write) %c !L! %else lights or B(lights write) current request_status = do disc write(current request_block, current request_size, byteinteger(current request_buffer)) %else ! Dud request *movem.l D0-D7/A0-A7, saved r printstring("Disc (do pending): corrupt request ") write(current request_code, 0); space phex(current request_code); printstring(" at ") phex(addr(current request)); newline dump(size of(current request), byteinteger(addr(current request))) %for i = 0, 1, 7 %cycle phex(saved r_d(i)) space %repeat newline %for i = 0, 1, 7 %cycle phex(saved r_a(i)) space %repeat newline dump queue("Dud request"); newline current request_p = current request_code current request_status = -4 %finish !L! lights and A(\ lights clear) !L! lights and B(\ lights clear) send message(current request, current request_system part_reply, nil) %c %if current request_system part_reply ## nil current request == nil %end %routine add pending(%record(disc message fm)%name x) %ownrecord(disc message fm)%name m !! printstring("Add pending: "); phex(addr(x)) !! write(x_block, 1); newline %if requests pending <= 0 %start !! printstring("Queue empty"); newline ! Queue is empty pending queue head == x pending queue tail == x x_backward == nil x_forward == nil requests pending = 1 disc HW = 1 %if disc HW = 0 %return %finish ! one or more already there, so we'll have to scan the list requests pending = requests pending + 1 disc HW = requests pending %if disc HW < requests pending m == pending queue head %cycle %if m == nil %start ! Insert new tail of queue !! printstring("Add at tail"); newline x_forward == nil x_backward == pending queue tail pending queue tail_forward == x pending queue tail == x %return %else %if m_block & block mask > x_block & block mask ! Insert in front of current entry !! printstring("Add before "); phex(addr(m)); newline x_forward == m %if m_backward == nil {first entry} %then pending queue head == x %c %else m_backward_forward == x x_backward == m_backward m_backward == x %return %finish m == m_forward %repeat %end %routine pending request(%record(disc message fm)%name x) %if x_code = status request %start ! Status enquiry x_status = 0 x_p = drive 0 size x_q = drive 1 size x_r = 0; ! Meantime send message(x, x_system part_reply, nil) %else %if x_code = read request %or x_code = write request add pending(x) %else %if x_code = stats request x_status = 0 x_p = disc reads x_q = disc writes x_r = disc HW; disc HW = 0; ! Clear? send message(x, x_system part_reply, nil) %else ! Unrecognised request x_p = x_code x_status = -1 send message(x, x_system part_reply, nil) %finish %end %routine disc process %ownrecord(disc message fm)%name x initialise disc %cycle x == receive message(disc mailbox) pending request(x) %cycle %cycle x == dequeue(disc mailbox_queue) %exit %if x == nil semaphore wait(disc mailbox_semaphore) pending request(x) %repeat %if requests pending > 0 %then do pending %c %else %exit %repeat %repeat %end %externalintegerfnspec free store %begin %ownrecord(semaphore fm) disaster = 0 %record(poa fm)%name P %integer i %on 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 %start ! Last-chance disaster-trap P == POA printstring("Disc: unexpected event "); write(P_event, 0) space; write(P_event sub, 0); space; phex(P_event extra) space; printstring(P_event message) printstring(" at or about PC "); phex(P_event PC) newline %for i = 0, 1, 15 %cycle phex(P_event r(i)); space newline %if i & 7 = 7 %repeat newline dump queue("Last chance trap") semaphore wait(disaster) %finish i = set SR (0) open input(3, ":N"); select input(3) open output(3, ":T"); select output(3) setup semaphore(disaster) setup queue(disc queue) setup semaphore(disc sema) setup mailbox(disc mailbox, disc sema) FS insert(request mailbox name, addr(disc mailbox)) {} printstring("Disc: "); write(free store, 0) {} printstring(" free"); newline disc process printstring("Disc process stopping??") newline %end %end %of %file