! Disc driving stuff -- drive-independent part. %ownstring(47) copyright disc inc = %c "Copyright (C) 1987, 1988 George D.M. Ross" !externalroutinespec FS insert(%string(31) name, %integer value) !externalpredicatespec FS lookup(%string(31) name, %integername value) %conststring(31) request mailbox name = "DISC_REQUESTS" %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, %integer tag) %constinteger status request = 0 %constinteger read request = 1 %constinteger write request = 2 %constinteger stats request = 3 %ownrecord(mailbox fm)%name disc request mailbox == nil %routine initialise disc %integer i %unless FS lookup(request mailbox name, i) %start printstring("No disc process??") newline %stop %finish disc request mailbox == record(i) %end %integerfn disc size(%integername size 0, size 1) %record(disc message fm) m %record(disc message fm)%name r %record(semaphore fm) s = 0 %record(mailbox fm) b = 0 initialise disc %if disc request mailbox == nil setup semaphore(s) setup mailbox(b, s) setup message(m, size of(m)) m_code = status request send message(m, disc request mailbox, b) r == receive message(b) size 0 = r_p size 1 = r_q %result = r_status %end %routine disc stats(%integername reads, writes, HW) %record(disc message fm) m = 0 %record(disc message fm)%name r %record(semaphore fm) s = 0 %record(mailbox fm) b = 0 initialise disc %if disc request mailbox == nil setup semaphore(s) setup mailbox(b, s) setup message(m, size of(m)) m_code = stats request send message(m, disc request mailbox, b) r == receive message(b) reads = r_p writes = r_q HW = r_r %end %integerfn disc read(%integer block, %bytename buffer) %record(disc message fm) m %record(disc message fm)%name r %record(semaphore fm) s = 0 %record(mailbox fm) b = 0 !! printstring("Read "); phex(block) !! printstring(" into "); phex(addr(buffer)) !! newline initialise disc %if disc request mailbox == nil setup semaphore(s) setup mailbox(b, s) setup message(m, size of(m)) m_code = read request m_block = block m_buffer = addr(buffer) m_size = 1 send message(m, disc request mailbox, b) r == receive message(b) %result = r_status %end %integerfn disc read N(%integer block, blocks, %bytename buffer) %record(disc message fm) m %record(disc message fm)%name r %record(semaphore fm) s = 0 %record(mailbox fm) b = 0 !! printstring("Read "); write(blocks, 0) !! printstring(" from "); phex(block) !! printstring(" into "); phex(addr(buffer)) !! newline initialise disc %if disc request mailbox == nil setup semaphore(s) setup mailbox(b, s) setup message(m, size of(m)) m_code = read request m_block = block m_buffer = addr(buffer) m_size = blocks send message(m, disc request mailbox, b) r == receive message(b) %result = r_status %end %integerfn disc write(%integer block, %bytename buffer) %record(disc message fm) m %record(disc message fm)%name r %record(semaphore fm) s = 0 %record(mailbox fm) b = 0 !! printstring("Write "); phex(block) !! printstring(" from "); phex(addr(buffer)) !! newline initialise disc %if disc request mailbox == nil setup semaphore(s) setup mailbox(b, s) setup message(m, size of(m)) m_code = write request m_block = block m_buffer = addr(buffer) m_size = 1 send message(m, disc request mailbox, b) r == receive message(b) %result = r_status %end %integerfn disc write N(%integer block, blocks, %bytename buffer) %record(disc message fm) m %record(disc message fm)%name r %record(semaphore fm) s = 0 %record(mailbox fm) b = 0 !! printstring("Write "); write(blocks, 0) !! printstring(" from "); phex(block) !! printstring(" from "); phex(addr(buffer)) !! newline initialise disc %if disc request mailbox == nil setup semaphore(s) setup mailbox(b, s) setup message(m, size of(m)) m_code = write request m_block = block m_buffer = addr(buffer) m_size = blocks send message(m, disc request mailbox, b) r == receive message(b) %result = r_status %end %end %of %file