! r.d.eager contains code for output accounts in comm control,
! lp adaptor and cp adaptor
! version of 13/06/80
! dec 79: include an oper adaptor
! have only one service number, x'37'
! other possible changes
! make initialisation call of cc initialise adaptors as well
! make it possible to deallocate/allocate all devices
!* communications record format - extant from chopsupe 20a onwards *
record format comf(integer ocptype, ipldev, sblks, sepgs, ndiscs, ddtaddr, gpctabsize, gpca, sfctabsize, sfca,
sfck, dirsite, dcodeda, suplvn, wasklokcorrect, date0, date1, date2, time0, time1, time2, epagesize, users,
cattad, dqaddr, byte integer nsacs, resv1, sacport1, sacport0, nocps, resv2, ocpport1, ocpport0,
integer itint, contypea, gpcconfa, fpcconfa, sfcconfa, blkaddr, dptaddr, smacs, trans, long integer kmon,
integer ditaddr, smacpos, supvsn, pstva, secsfrmn, secstocd, sync1dest, sync2dest, asyncdest, maxprocs,
inspersec, elaphead, commsreca, storeaad, procaad, sfcctad, drumtad, tslice, sp0, sp1, sp2, sp3, sp4, sp5, sp6,
sp7, sp8, lstl, lstb, pstl, pstb, hkeys, hoot, sim, clkx, clky, clkz, hbit, slaveoff, inhssr, sdr1, sdr2, sdr3,
sdr4, sesr, hoffbit, s2, s3, s4, end)
record format pe(integer dserv, sserv, p1, p2, p3, p4, p5, p6)
record format parmf(integer dserv, sserv, p1, p2, p3, p4, p5, p6, link)
!***********************************************************************
!* service numbers and activity numbers *
!***********************************************************************
!* global constants
const integer virtual= x'81000000'
const integer not allocated= x'F0F0F0F0'
const integer empty= x'F0F0'
const integer attention= 1
const integer normal termination= 8
const integer auto= x'00008400'
const integer ebc nl= 21
const integer ebc lf= 37
const integer ebc ff= 12
const integer ebc cr= 13
const integer ebc vp= 34
const integer ebc ms= 32
const integer ebc mnl= 33
const integer ebc sp= 64
const string (1) snl= "
"
!* comms controller activities
const integer init= 0
const integer connect= 1
const integer connect reply= 13
const integer enable= 2
const integer claim amt index reply= 14
const integer enable reply= 15
const integer disable= 4
const integer disable reply= 16
const integer disconnect= 5
const integer disconnect reply= 17
const integer control msg6= 6
const integer control msg6 reply= 18
const integer control msg7= 7
const integer control msg7 reply= 19
const integer transfer requested= 10
const integer page here= 11
const integer transfer completed= 12
!* comms controller requests and reply service numbers
const integer comms command= x'00370000'
const integer claim block= x'00080001'
const integer block claimed= comms command!claim amt index reply
const integer free block= x'00080002'
const integer claim page= x'00040001'
const integer page claimed= comms command!page here
const integer free page= x'00040002'
const integer request transfer= comms command!transfer requested
const integer transfer complete= comms command!transfer completed
!* adaptor activities
const integer deallocated= x'00000001'
const integer allocated= x'00000002'
const integer execute fails= x'00000003'
const integer initialise= x'00000004'
const integer interrupt= x'00000005'
const integer go ahead= x'00000006'
const integer send control= x'00000007'
const integer clock tick= x'00000008'
const integer allocate request= x'00000009'
const integer oper com reply= x'0000000A'
const integer deallocate request= x'0000000B'
!* adaptor service numbers
const integer op service= x'32'
const integer lp service= x'33'
if cr fitted=yes start
const integer cr service= x'34'
finish
if cp fitted=yes start
const integer cp service= x'35'
finish
const integer mk1 fe service= x'39'
const integer op command= op service<<16
const integer lp command= lp service<<16
if cr fitted=yes start
const integer cr command= cr service<<16
else
const integer cr command= not allocated
finish
if cp fitted=yes start
const integer cp command= cp service<<16
else
const integer cp command= not allocated
finish
const integer mk1 fe command= mk1 fe service<<16
!* adaptor requests and replies service numbers
const integer gpc command= x'00300000'
const integer allocate device= gpc command!x'0000000B'
const integer lp allocated= lp command!allocated
if cr fitted=yes start
const integer cr allocated= cr command!allocated
finish
if cp fitted=yes start
const integer cp allocated= cp command!allocated
finish
const integer mk1 fe allocated= mk1 fe command!allocated
const integer deallocate device= gpc command!x'00000005'
const integer lp deallocated= lp command!deallocated
if cr fitted=yes start
const integer cr deallocated= cr command!deallocated
finish
if cp fitted=yes start
const integer cp deallocated= cp command!deallocated
finish
const integer mk1 fe deallocated= mk1 fe command!deallocated
const integer execute chain= gpc command!x'0000000C'
const integer lp executed= lp command!execute fails
if cr fitted=yes start
const integer cr executed= cr command!execute fails
finish
if cp fitted=yes start
const integer cp executed= cp command!execute fails
finish
const integer mk1 fe executed= mk1 fe command!execute fails
const integer lp interrupt= lp command!interrupt
if cr fitted=yes start
const integer cr interrupt= cr command!interrupt
finish
if cp fitted=yes start
const integer cp interrupt= cp command!interrupt
finish
const integer mk1 fe interrupt= mk1 fe command!interrupt
const integer elapsed int command= x'000A0001'; !TICK EVERY N SECS
const integer mk1 fe clock tick=mk1 fe command!clock tick
const integer mk1 fe oper com reply= mk1 fe command!oper com reply
const integer oper command req= x'0032000E'
const integer secs per tick= 15
if mon level&2#0 start
extrinsic long integer kmon; !bit 2**sno is set when service sno is to be monitored
finish
external routine spec dump table(integer table, address, length)
external routine spec dpon(record (pe) name mess, integer secs)
external routine spec pon(record (pe) name mess)
external routine spec gdc(record (pe) name mess)
external routine spec pkmon rec(string (20) text, record (pe) name mess)
external routine spec op mess(string (63) s)
external routine spec monitor(string (63) s)
external routine spec move alias "S#MOVE"(integer length, from, to)
external routine spec etoi alias "S#ETOI"(integer address, length)
external routine spec i to e alias "S#ITOE"(integer address, length)
external integer fn spec realise(integer virtual address)
external integer fn spec new pp cell
external routine spec elapsed int(record (pe) name p)
external string fn spec strint(integer i)
if multi ocp=no start
routine spec comms control(record (pe) name mess)
routine spec mk1 fe adaptor(record (pe) name mess)
else
external routine spec reserve log
external routine spec release log
finish
external routine spec return pp cell(integer cell)
if mon level&256#0 start ; !include harvesting?
routine spec harvest(integer event, process, len, a, b, c, d, e)
external integer trace= no; !initially no trace
external integer trace events= 0; !initially no events to trace
external integer trace process= 0; !initially no process to trace
finish
!***********************************************************************
!* *
!* stream types. *
!* *
!* even streams: input streams *
!* odd streams: output streams *
!* *
!* stream states. *
!* *
!* from state title to state *
!* 1-> 0: unused ->2 *
!* 3-> 1: disconnecting ->0 *
!* 0-> 2: connecting ->3 *
!* 2,4,5-> 3: connected ->1,6 *
!* 8-11-> 4: suspending ->3 *
!* 8-11-> 5: aborting ->3 *
!* 3-> 6: claiming -> 7 *
!* 6-> 7: enabling ->8 *
!* 7-> 8: enabled ->4,5,9-11 *
!* 8-> 9: queued ->4,5,10 *
!* 8,9-> 10: paging in ->4,5,11 *
!* 8,10-> 11: active ->4,5,8,10 *
!* *
!* *
!* stream buffer modes. *
!* *
!* bits 2**0 to 2**3 *
!* 0: sequential 2: sequential continuation *
!* 1: circular *
!* *
!* bits 2**4 to 2**7 *
!* 0: iso 2: binary *
!* 1: ebcidic 3: control *
!* *
!* adaptor types. *
!* *
!* device type device mnemonic adaptor name *
!* 1 pt not available *
!* 2 pr not available *
!* 3 cp cp adaptor *
!* 4 cr cr adaptor *
!* 5 m0 not available *
!* 6 lp lp adaptor *
!* 7 gp not available *
!* 8 op oper adaptor *
!* 9 gu not available *
!* 10 dr not available *
!* 11 na not available *
!* 12 ct not available *
!* 13 su not available *
!* 14 fe mk1 fe adaptor *
!* 15 lk not available *
!* *
!* device no. *
!* *
!* can currently be in the range 0 - 9. *
!* when combined with an adaptor type a device mnemonic is produced *
!* i.e. lp0 to lp9 or fe0 to fe9. *
!* *
!***********************************************************************
record format sr(half integer stream no, external stream no, byte integer state, mode, adaptor no, device no,
integer length, owner, caller, amt index, start, cursor, link)
record format br(integer stream no, external stream no, amt index, offset, length, real address, p5, p6, link)
record format comms inff(integer index addr, next free buffer, queued stream head, queued stream tail)
const integer max stream= maxprocs*3-1
own integer array stream index(0:max stream)= c
empty(max stream+1)
own record (sr) array format sarf(0:4095); !mapped onto parm table
own record (sr) array name stream tab; !stream table array
own record (br) array format barf(0:4095); !mapped onto the parm table
own record (br) array name buffer tab; !buffer table array
own record (parmf) array format parf(0:4095); !mapped onto parm table
own record (parmf) array name parm tab; !parm table array
own record (comf) name com area
own record (comms inff) comms
if sfc fitted=yes start
const integer drum update= 5; !drum update and recapture
else
const integer drum update= 1; !only recapture
finish
const integer no drum update= 0; !no drum update and no recapture
const integer byte mask= x'FF'
const integer short mask= x'FFFF'
const integer top short mask= x'FFFF0000'
const integer top bit mask=x'80000000'
const integer cc activity mask=31
const integer queued flag=x'40'
!* stream states
const integer disconnecting= 1; !waiting on adaptor action
const integer connecting= 2; !waiting on adaptor action
const integer connected= 3; !waiting on user action
const integer suspending= 4; !waiting on adaptor action
const integer aborting= 5; !waiting on adaptor action
const integer claiming= 6; !waiting on global controller action
const integer enabling= 7; !waiting on adaptor action
const integer enabled= 8; !waiting on user action
const integer queued= 9; !waiting on a free epage (buffer)
const integer paging in= 10; !waiting on global controller action
const integer active= 11; !waiting on adaptor action
!* stream buffer modes
const integer sequential= 0; !first enable on a stream possible special adaptor action
const integer circular= 1
const integer sequential continuation= 2; !a subsequent sequential enable no special action
const integer iso= 0
const integer ebcidic= 1
const integer binary= 2
!* control = 3
!* adaptor types
const integer cp= 3
const integer cr= 4
const integer lp= 6
const integer op= 8
const integer fe= 14
!***********************************************************************
!* the next array is a mapping from adaptor types to service numbers *
!***********************************************************************
const integer array adapt(0:15)= c
not allocated(3),cp command,cr command,not allocated,lp command,
not allocated,op command,
not allocated(5),mk1 fe command,not allocated
!***********************************************************************
!* the next array is a mapping from states to reply activities *
!***********************************************************************
const integer array sub ident(0:active)= c
-1,disconnect reply<<16,connect reply<<16,-1,disable reply<<16(2),
-1,enable reply<<16,-1(4)
external routine comms control(record (pe) name mess)
!***********************************************************************
!* *
!* After initialization, all free buffer records are held on a *
!* linked list, the first element of which is pointed at by "next *
!* free buffer". the maximum buffer (e page) allocation is *
!* given by the global controller at initialisation. the comms *
!* controller can then own up to this allocation of epages. *
!* if there are no free buffers, streams requiring a buffer are *
!* held on a linked list, the first element of which is pointed at *
!* by "queued stream head" and the last element of which is pointed *
!* at by "queued stream tail". *
!* if the list is empty, both the head and tail pointers will *
!* be set to "empty" (x'f0f0'). *
!* space for stream descriptors and buffer descriptors is allocated *
!* dynamically by claiming param cells from the dynamically extendable*
!* param table via a call on "new pp cell". stream descriptors are *
!* accessed indirectly through the array "stream index" but buffer *
!* descriptors are accessed directly. when descriptors are no longer *
!* required the space is returned to the param table via a call on *
!* "return pp cell". *
!* note: all page sharing and page recapture is handled by the *
!* global controller. the comms controller only requests "page ins" *
!* and "page outs". it is up to the global controller to supply the *
!* latest copy of the page and to update the relevant copies. *
!* *
!***********************************************************************
! %if mon level&256 # 0 %start; !include harvesting?
integer proc no
! %finish
integer status
integer call proc
const integer successful= 0, unsuccessful = 1
record (sr) name stream; integer stream no
record (br) name buffer; integer buffer no
integer temp, dserv, dact, old state, link
if monlevel&4#0 start
own integer array pool size(-19:comms epages)
own integer queued store, queued disc, not queued store, not queued disc, free buffers
integer i, l, t
finish
switch com(init:control msg7 reply)
routine spec release page(integer drum up)
routine spec release buffer(integer drum up)
integer fn spec unlink stream(integer stream no)
routine spec get page(integer stream no)
routine spec release block
!===================================
const integer check ftp streams=yes
if check ftp streams=yes start
integer device no, ext stream
finish
!===================================
!***********************************************************************
!* main program *
!***********************************************************************
!** monitor
if mon level&2#0 and (kmon>>(comms command>>16))&1#0 then pkmon rec("Comms Control: ", mess)
dserv = mess_dserv
dact = dserv&cc activity mask
->com(dact) if dact<=connect; !connect or init?
stream no = mess_p1; !pull out stream number first always in p1
if 0<stream no<=max stream start ; !within range?
temp = stream index(stream no)
if temp#empty start ; !allocated?
stream == stream tab(temp)
proc no = ((stream_owner>>16)-64)&(max procs-1)
if dact<transfer requested start
call proc = ((mess_sserv>>16)-64)&(max procs-1)
if call proc#proc no start
unless proc no<=2 or (proc no<=5 and mess_sserv>>16=x'32') start
!This is primarily (the <=5... bit) to allow OPER ADAPTOR to
!muck about with comms streams owned by executives.
op mess("Comms: illegal use of stream ".strint(stream no))
op mess("Comms: caller ".strint(call proc).", owner ".strint(proc no))
printstring("Comms control: offending POFF -".snl)
pkmon rec("Comms control: ", mess)
return
finish
finish
stream_caller = mess_sserv
finish else status = mess_p2
->com(dact)
finish
finish
no stream:
print string("Comms Control: Stream not allocated ".snl)
pkmon rec("Comms Control: ", mess)
return unless dact<transfer requested
mess_dserv = mess_sserv; !reply to caller
mess_sserv = dserv
mess_p2 = unsuccessful
pon(mess)
return
!***********************************************************************
!* *
!* this section handles: *
!* 1). communications controller initialisation *
!* *
!***********************************************************************
com(init): !** command: initialise (or print monitoring)
if mess_p2>0 start
stream tab == array(mess_p3, sarf); !address supplied by global controller
buffer tab == array(mess_p3, barf); !address of parm array supplied by global controller
parm tab == array(mess_p3, parf); !parm table array
com area == record(x'80000000'+48<<18)
comms_index addr = addr(stream index(0))
comms_queued stream head = empty
comms_queued stream tail = empty
com area_commsreca = addr(comms)
link = new pp cell; !get a buffer entry from param table
comms_next free buffer = link; !head of list
for temp = 1, 1, mess_p2 cycle ; !get other buffers
buffer == buffer tab(link); !map buffer
buffer = 0
buffer_stream no = empty
if temp=mess_p2 then link = empty else link = new pp cell
!last buffer?
buffer_link = link; !link buffers together
repeat
if monlevel&4#0 then free buffers = comms epages
else ; !print monitoring
if monlevel&4#0 start
l = 0
l = l+pool size(i) for i = 1, 1, comms epages
t = l
t = t+pool size(i) for i = -19, 1, 0
if multiocp=yes then reserve log
newlines(2)
printstring("Buffer use (on transfer request) - 100% =")
write(t, 1); newline
printstring("buffer pool: availability =")
write(l*100//t, 1); printstring("%"); newline
write(i, 4) for i = 1, 1, comms epages
newline; space
for i = 1, 1, comms epages cycle
write(pool size(i)*100//t, 3)
printstring("%")
repeat
newline
printstring("buffer queue: requests queued =")
write(100-(l*100//t), 1); printstring("%"); newline
write(i, 4) for i = 1, 1, 20
printstring("+"); newline; space
for i = 0, -1, -19 cycle
write(pool size(i)*100//t, 3)
printstring("%")
repeat
newline
l = queued store+queued disc
if l#0 then l = queued store*100//l
printstring("Pagein for queued buffers: ")
write(l, 1); printstring("% store, ")
write(100-l, 1); printstring("% disc")
newline
l = not queued store*100//(not queued store+not queued disc)
printstring("Pagein for available buffers: ")
write(l, 1); printstring("% store, ")
write(100-l, 1); printstring("% disc")
newlines(2)
if multiocp=yes then release log
pool size(i) = 0 for i = -19, 1, comms epages
queued store = 0; queued disc = 0
not queued store = 0; not queued disc = 0
finish
finish
return
!***********************************************************************
!* *
!* this section handles: *
!* 1). commands from communications users. *
!* 2). replies from the global controller in response *
!* to calls generated by commands. *
!* 3). replies from an adaptor in response *
!* to calls generated by a command. *
!* *
!***********************************************************************
com(connect): !** command: connect stream to communications user
!===================================
if check ftp streams=yes start
ext stream = mess_p3&short mask
if (mess_p3>>24)&15=fe and 8<ext stream<350 start
stream no = mess_p1&1
if stream no#ext stream&1 start
op mess("Comms: I/O mismatch in connect".tostring(17))
->no stream
finish
device no = (mess_p3>>16)&byte mask
for stream no = stream no+2, 2, max stream-(1-stream no) cycle
if stream index(stream no)=empty then continue
if stream tab(stream index(stream no))_external stream no=ext stream and c
stream tab(stream index(stream no))_device no=device no and c
stream tab(stream index(stream no))_adaptor no=fe start
op mess("Comms: duplicate FEP stream ".strint(ext stream).tostring(17))
if stream tab(stream index(stream no))_owner#mess_p2 then ->no stream
op mess("Comms: old str ".strint(stream no)." discarded")
return pp cell(stream index(stream no))
stream index(stream no) = empty
exit
finish
repeat
finish
finish
!======================================
stream no = mess_p1&1; !make even or odd i.e. input or output
for stream no = stream no+2, 2, max stream-(1-stream no) cycle
if stream index(stream no)=empty start ; !found a free stream
stream index(stream no) = new pp cell; !get a stream table entry
stream == stream tab(stream index(stream no))
stream = 0
stream_stream no = stream no
stream_caller = mess_sserv
stream_owner = mess_p2; !high level control messages sent on this service
if mon level&256#0 start ; !include harvesting?
proc no = ((stream_owner>>16)-64)&(max procs-1)
harvest(14, proc no, 8, stream no, mess_p3, 0, 0, 0) if c
trace=yes and trace events&(1<<14)#0 and (trace process=-1 or trace process=proc no)
finish
stream_length = stream no; !set for replies from front end
stream_cursor = mess_p5; !set for reply to connect only
stream_mode = mess_p6; !set to pass unit size into the adaptor
stream_adaptor no = (mess_p3>>24)&15
if adapt(stream_adaptor no)=not allocated start
status = unsuccessful
->return cell
finish
stream_device no = (mess_p3>>16)&byte mask
stream_external stream no = mess_p3&short mask
stream_amt index = not allocated
stream_link = empty
stream_state = connecting
->update adaptor
finish
repeat
->no stream
com(connect reply): !** adaptor reply: stream connected
if mon level&256#0 start ; !include harvesting?
harvest(15, proc no, 4, stream no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<15)#0 and (trace process=-1 or trace process=proc no)
finish
if status=successful start
stream_state = connected
->reply to caller; !note, p3 = nsi or x25 indication from fep
finish else ->return cell
com(enable): !** command: enable stream
! p1 p2 p3 p4 p5 p6
!Old format: stream da lim mode cursor<<16!start length
!Newformat: stream 1<<31!da lim<<16!mode cursor start length
! Formats are distinguished by top bit in da. This change is for multi-console
! printer. Uses a (nominally) circular buffer (as required by fep), hence length
! is limited to '7fff'. So to access last 32k of a 128k block, halfwords start
! and length are insufficient.
if stream_state=connected and mess_p6>0 start
stream_state = claiming
stream_length = mess_p6-1
if mess_p2&top bit mask#0 start ; !new format
mess_p2 = mess_p2&(¬(top bit mask))
stream_mode = mess_p3&bytemask
mess_p3 = mess_p3>>16
stream_start = mess_p5
if stream_mode&15=circular then stream_cursor = mess_p4 else stream_cursor = 0
else
stream_mode = mess_p4&bytemask
if stream_mode&15=circular start
stream_start = mess_p5&short mask
stream_cursor = mess_p5>>16
else
stream_start = mess_p5
stream_cursor = 0
finish
finish
if mon level&256#0 start ; !include harvesting?
harvest(16, proc no, 12, stream no, stream_mode, mess_p6, 0, 0) if c
trace=yes and trace events&(1<<16)#0 and (trace process=-1 or trace process=proc no)
finish
!** claim block from the global controller
mess_dserv = claim block
mess_sserv = block claimed
!** p1=stream no, p2=disc address, p3=flags/epages. user supplied cannot check
pon(mess)
return
finish else status = unsuccessful
->reply to caller
com(claim amt index reply): !** global controller reply: block claimed
if mon level&256#0 start ; !include harvesting?
harvest(17, proc no, 8, stream no, status, 0, 0, 0) if c
trace=yes and trace events&(1<<17)#0 and (trace process=-1 or trace process=proc no)
finish
if status<=0 start ; !block unsuccessful
!* 0 change block size in situ
!* -1 no amt cells
!* -2 not enough garbage
!* -3 change block size while still in use
stream_state = connected
status = status-1; !zero normally successful
->reply to caller
finish
stream_amt index = status<<16
stream_state = enabling
->update adaptor
com(enable reply): !** adaptor reply: stream enabled
if mon level&256#0 start ; !include harvesting?
harvest(18, proc no, 4, stream no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<18)#0 and (trace process=-1 or trace process=proc no)
finish
if status=successful start
stream_state = enabled
return if stream_mode&15#circular
else
stream_state = connected
release block
finish
->reply to caller
com(disable): !** command: disable stream (suspend or abort)
if mon level&256#0 start ; !include harvesting?
harvest(19, proc no, 12, stream no, mess_p2, stream_state, 0, 0) if c
trace=yes and trace events&(1<<19)#0 and (trace process=-1 or trace process=proc no)
finish
if stream_state>=enabled and suspending<=mess_p2<=aborting start
old state = stream_state; !remember state
stream_state = mess_p2; !set to suspending or aborting
return if old state>=paging in; !wait for completion of page in or transfer
stream no = unlink stream(stream no) if old state=queued
release block
->update adaptor
finish else status = unsuccessful
->reply to caller
com(disable reply): !** adaptor reply: disabled
if mon level&256#0 start ; !include harvesting?
harvest(20, proc no, 4, stream no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<20)#0 and (trace process=-1 or trace process=proc no)
finish
stream_state = connected
status = successful; !always successful
->reply to caller; !note, p3 = accounting info from adaptor
com(disconnect): !** command: disconnect stream
if mon level&256#0 start ; !include harvesting?
harvest(21, proc no, 4, stream no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<21)#0 and (trace process=-1 or trace process=proc no)
finish
if stream_state=connected start
stream_state = disconnecting
->update adaptor
finish else status = unsuccessful
->reply to caller
com(disconnect reply): !** adaptor reply: stream disconnected
if mon level&256#0 start ; !include harvesting?
harvest(22, proc no, 4, stream no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<22)#0 and (trace process=-1 or trace process=proc no)
finish
status = successful; !always successful
->return cell; !note, p3 = disconnect reason from fep
com(control msg6): !** command: send high level control message which generates no reply
if mon level&256#0 start ; !include harvesting?
harvest(23, proc no, 12, stream no, dact, stream_state, 0, 0) if c
trace=yes and trace events&(1<<23)#0 and (trace process=-1 or trace process=proc no)
finish
mess_sserv = comms command!control msg6 reply
->pon adaptor
com(control msg7): !** command: send high level control message which generates a reply
if mon level&256#0 start ; !include harvesting?
harvest(23, proc no, 12, stream no, dact, stream_state, 0, 0) if c
trace=yes and trace events&(1<<23)#0 and (trace process=-1 or trace process=proc no)
finish
status = mess_sserv&x'80000000'; !called or ponned?
mess_dserv = send control!adapt(stream_adaptor no)
mess_sserv = comms command!control msg7 reply
if multiocp=no and stream_adaptor no=fe then mk1 fe adaptor(mess) else pon(mess)
if status=0 then ->reply to caller; !ponned, so pon a reply
mess_p2 = 0; !status
mess_p5 = stream_cursor
return ; !back to caller
!***********************************************************************
!* *
!* this section handles: *
!* 1). transfer requests from an adaptor. *
!* 2). replies from the global controller in response *
!* to calls generated by transfer requests. *
!* 3). transfer complete replies from an adaptor. *
!* *
!***********************************************************************
com(transfer requested): !** adaptor request: transfer request
if stream_state=enabled start ; !ignore if suspending or aborting
stream_cursor = status&short mask if c
status#0 and stream_mode&15=circular and 0<=status&short mask<=stream_length
if comms_next free buffer=empty start ; !no buffer available
if mon level&256#0 start ; !include harvesting?
harvest(27, proc no, 4, stream no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<27)#0 and (trace process=-1 or trace process=proc no)
finish
stream_state = queued; !so wait.
stream_link = empty
if comms_queued stream head=empty then comms_queued stream head = stream no else c
stream tab(stream index(comms_queued stream tail))_link = stream no
comms_queued stream tail = stream no
else ; !buffer available
buffer no = comms_next free buffer
buffer == buffer tab(buffer no)
comms_next free buffer = buffer_link
buffer = 0
buffer_link = empty
stream_link = buffer no
get page(stream no)
finish
if monlevel&4#0 start
if free buffers<-19 then pool size(-19) = pool size(-19)+1 else c
pool size(free buffers) = pool size(free buffers)+1
free buffers = free buffers-1
finish
finish
return
com(page here): !** global controller reply: current owner's page here
if stream_state=paging in start ; !check buffer not disabled (suspend or abort)
if mon level&256#0 start ; !include harvesting?
harvest(30, proc no, 8, stream no, (mess_sserv&255)<<24!(mess_p5&255)<<16!(mess_p6&short mask), 0, 0,
0) if trace=yes and trace events&(1<<30)#0 and (trace process=-1 or trace process=proc no)
finish
op mess("Comms page in fails") if mess_p3#0
!* should deal with transfer failures here?
!* p_p3 = 0 ok
!* p_p3 = 1 parity error
!* p_p3 > 1 zero page
if status=-1 start
op mess("Comms: deadlock page recovery")
mess = 0
mess_dserv = claim page
mess_sserv = page claimed
mess_p1 = buffer tab(stream_link)_amt index
mess_p2 = stream no
dpon(mess, 2); !2 secs delay
return
finish
if monlevel&4#0 start
t = mess_sserv&255
if dserv&queued flag#0 start
if t=1 then queued store = queued store+1 else queued disc = queued disc+1
else
if t=1 then not queued store = not queued store+1 else not queued disc = not queued disc+1
finish
finish
buffer tab(stream_link)_real address = status; !real page address
stream_state = active
mess_sserv = transfer complete
mess_dserv = go ahead!adapt(stream_adaptor no)
mess_p2 = stream_link
mess_p5 = stream_device no; ! for use by OPER
if multi ocp=no and stream_adaptor no=fe then mk1 fe adaptor(mess) else pon(mess)
return
else ; !buffer disabled
buffer no = stream_link
buffer == buffer tab(buffer no)
release buffer(no drum update)
release block
->update adaptor
finish
com(transfer completed): !** adaptor reply: transfer complete
if mon level&256#0 start ; !include harvesting?
harvest(31, proc no, 12, stream no, mess_p2, mess_p3, 0, 0) if c
trace=yes and trace events&(1<<31)#0 and (trace process=-1 or trace process=proc no)
finish
!* p2 has bits set with significance 2**0 next page required
!* 2**1 page not eligible for recapture
!* 2**2 update users cursor
!* p3 has number of bytes transfered
buffer no = stream_link
buffer == buffer tab(buffer no)
stream_cursor = stream_cursor+mess_p3; !add in length transfered
if mess_p3>=buffer_length or stream_state#active start
!end of buffer or buffer disabled
if stream_cursor>=(stream_length+1) start ; !end of section (wrap round or suspend)
if stream_mode&15=circular then stream_cursor = mess_p3-buffer_length { only OPERs can wrap round } else c
stream_state = suspending
finish
if stream_state=active start ; !check not disabled (suspend or abort)
if status&1#0 start ; !get the next page.
release page(no drum update); !release page to get another
get page(stream no)
return
finish
else ; !disabled (suspend or abort)
release buffer(no drum update)
release block
->update adaptor
finish
finish
if status&2=0 then temp = drum update else temp = no drum update
release buffer(temp)
stream_state = enabled
if status&4#0 start ; !update users cursor
mess_dserv = stream_owner
mess_sserv = dserv
mess_p2 = stream_cursor
mess_p3 = 0; !must be zero otherwise signifies an abort
pon(mess)
finish
return
update adaptor:
!send low level control info to the adaptor
mess = 0
mess_p1 = sub ident(stream_state)!stream no
mess_p2 = stream_state<<24!stream_mode<<16!(stream_length&x'FFFF')
mess_p3 = stream_cursor
mess_p4 = stream index(stream no); ! when connecting, set to cell
mess_p5 = stream_device no; ! for OPER
mess_p6 = stream_length
mess_sserv = dserv
pon adaptor:
mess_dserv = send control!adapt(stream_adaptor no)
if multi ocp=no and stream_adaptor no=fe then mk1 fe adaptor(mess) else pon(mess)
return
com(control msg6 reply): !** adaptor reply: control message 6 reply
if mon level&256#0 start ; !include harvesting?
harvest(24, proc no, 12, stream no, dact-12, stream_state, 0, 0) if c
trace=yes and trace events&(1<<24)#0 and (trace process=-1 or trace process=proc no)
finish
if status=successful then return else ->reply to caller; !??????
com(control msg7 reply): !** adaptor reply: control message 7 reply
if mon level&256#0 start ; !include harvesting?
harvest(24, proc no, 12, stream no, dact-12, stream_state, 0, 0) if c
trace=yes and trace events&(1<<24)#0 and (trace process=-1 or trace process=proc no)
finish
return
reply to caller:
stream no = -1
return cell:
mess_sserv = dserv
mess_dserv = stream_caller
mess_p2 = status
mess_p6 = mess_p3; !see connect reply, disable reply, disconnect reply
mess_p3 = stream_owner
mess_p4 = stream_state
mess_p5 = stream_cursor
pon(mess)
unless stream no<0 start
return pp cell(stream index(stream no))
stream index(stream no) = empty
finish
return
routine release page(integer drum up)
!***********************************************************************
!* *
!* send a page out request to the global controller. specifying *
!* whether the drum copy is to be updated, whether the page has been *
!* written to and whether the page is eligible for recapture. *
!* no reply is given by the global controller *
!* bit significance: *
!* 2**0 - recapturable *
!* 2**1 - make new *
!* 2**2 - drum update *
!* 2**3 - written to *
!* *
!***********************************************************************
record (pe) mess
mess = 0
mess_dserv = free page
mess_sserv = dserv
mess_p1 = buffer_amt index; !index<<16!epage
mess_p2 = (1-(stream no&1))<<3!drum up
if mon level&256#0 start ; !include harvesting?
harvest(25, proc no, 12, stream no, mess_p1, mess_p2, 0, 0) if c
trace=yes and trace events&(1<<25)#0 and (trace process=-1 or trace process=proc no)
finish
pon(mess)
end ; !of routine release page
routine release buffer(integer drum up)
!***********************************************************************
!* *
!* release a comms page from its allocation. if a transfer request is *
!* queued request another page. *
!* *
!***********************************************************************
integer tempst no
release page(drum up)
buffer_stream no = empty
stream_link = empty
if comms_queued stream head#empty start ; !page frame required
tempst no = unlink stream(comms_queued stream head)
stream tab(stream index(tempst no))_link = buffer no
if monlevel&4#0 then tempst no = tempst no!queued flag<<24
get page(tempst no)
else ; !return buffer to free list
buffer_link = comms_next free buffer
comms_next free buffer = buffer no
if monlevel&4#0 then free buffers = free buffers+1
finish
end ; !of routine release buffer
integer fn unlink stream(integer tempst no)
!***********************************************************************
!* *
!* remove a queued transfer from the linked list *
!* *
!***********************************************************************
integer stream id, stream link, link
record (sr) name tempst
if mon level&256#0 start ; !include harvesting?
harvest(28, proc no, 4, tempst no, 0, 0, 0, 0) if c
trace=yes and trace events&(1<<28)#0 and (trace process=-1 or trace process=proc no)
finish
if monlevel&4#0 then free buffers = free buffers+1
link = stream tab(stream index(tempst no))_link
stream tab(stream index(tempst no))_link = empty
if comms_queued stream head=tempst no start
comms_queued stream head = link
comms_queued stream tail = empty if comms_queued stream head=empty
else
stream link = comms_queued stream head
until stream link=tempst no cycle
stream id = stream link
tempst == stream tab(stream index(stream id))
stream link = tempst_link
repeat
tempst_link = link
comms_queued stream tail = stream id if comms_queued stream tail=tempst no
finish
result = tempst no
end ; !of integerfn unlink stream
routine get page(integer tempst no)
!***********************************************************************
!* *
!* calculate the next page required and request it from the global *
!* controller. *
!* *
!***********************************************************************
record (pe) mess
record (sr) name tempst
integer epage, length, offset, esize
if monlevel&4#0 start
integer queued flag
finish
if monlevel&4#0 then queued flag = tempst no>>24 and tempst no = tempst no&short mask
tempst == stream tab(stream index(tempst no))
tempst_state = paging in
esize = com area_epagesize<<10; !calculate the epage size in bytes
offset = tempst_cursor+tempst_start; !offset in the file section
epage = offset//esize; !calculate in which page
offset = offset-epage*esize; !offset in page
length = (tempst_length+1)-tempst_cursor; !calculate length
length = esize-offset if offset+length>esize
!length within page
buffer_stream no = tempst no
buffer_external stream no = tempst_external stream no
buffer_amt index = tempst_amt index!epage
buffer_offset = offset
buffer_length = length
mess = 0
mess_dserv = claim page
if monlevel&4#0 then mess_sserv = page claimed!queued flag else mess_sserv = page claimed
mess_p1 = buffer_amt index
mess_p2 = tempst no
if mon level&256#0 start ; !include harvesting?
harvest(29, proc no, 12, stream no, mess_p1, buffer_length, 0, 0) if c
trace=yes and trace events&(1<<29)#0 and (trace process=-1 or trace process=proc no)
finish
pon(mess)
end ; !of routine get page
routine release block
!***********************************************************************
!* *
!* release the page and buffer if the stream has one and then release *
!* the file section from the active memory table *
!* *
!***********************************************************************
record (pe) mess
mess = 0
mess_dserv = free block
mess_sserv = dserv
mess_p1 = stream no
mess_p2 = stream_amt index>>16
if mon level&256#0 start ; !include harvesting?
harvest(26, proc no, 8, stream no, mess_p2, 0, 0, 0) if c
trace=yes and trace events&(1<<26)#0 and (trace process=-1 or trace process=proc no)
finish
pon(mess)
stream_amt index = not allocated
end ; !of routine release block
end ; !of routine comms control
external routine mk1 fe adaptor(record (pe) name mess)
!***********************************************************************
!* service 57 (x39) *
!* drives the mk1 front end to comms controller spec *
!* can manage up to 10 front ends (fe0-fe9) using a 512 byte area *
!* for each which is provided on allocation *
!***********************************************************************
if sseries=no start
record format daf(integer lst0, lst1, rcb0, rcb1, rcb2, rcb3, rcb4, rcb5, rcb6, rcb7, lb0, lb1, al00, al01,
al10, al11, stream, name, cob start, cob index, head, tail, ident, co head, co tail, max qd transfers,
max qd control msgs, total qd transfers, total qd control msgs, bytes of control input,
bytes of control output, bytes of data input, bytes of data output, control input transfers,
control output transfers, data input transfers, data output transfers, output updates, update overwrites,
control input xbit set, control output xbit set, data input xbit set, data output xbit set,
byte integer attn set, spare, device no, failures, byte integer array cib, cob(0:167),
integer array buffqsize(0:20))
else
record format daf(integer tcb0 command, tcb0 ste, tcb0 length, tcb0 address, tcb0 next tcb, tcb0 response,
integer array tcb0 preamble, tcb0 postamble(0:3), integer tcb1 command, tcb1 ste, tcb1 length,
tcb1 address, tcb1 next tcb, tcb1 response, integer array tcb1 preamble, tcb1 postamble(0:3),
integer stream, name, cob start, cob index, head, tail, ident, co head, co tail, max qd transfers,
max qd control msgs, total qd transfers, total qd control msgs, bytes of control input,
bytes of control output, bytes of data input, bytes of data output, control input transfers,
control output transfers, data input transfers, data output transfers, output updates, update overwrites,
control input xbit set, control output xbit set, data input xbit set, data output xbit set,
byte integer attn set, spare, device no, failures, byte integer array cib, cob(0:167))
finish
record format gpcf(integer ser, gptsm, propaddr, ticks, caa, grcb ad, lba, ala, state, resp0, resp1, sense1,
sense2, sense3, sense4, repsno, base, id, dlvn, mnemonic, entsize, paw, usaw0, urcb ad, sense ad, logmask,
trt ad, ua size, ua ad, timeout, props0, props1)
record format cr(integer message ident, p2, p3, p4, p5, p6)
record format oper command f(integer dest, srce, string (23) txt)
own integer array device to da ad(0:9)= c
not allocated(10)
own integer timer started
const integer cib length= 168; !7 control messages
const integer cob length= 168
const integer max failures= 5
const byte integer array retry delay(0:max failures)= c
0,1,0,2,0,3
const integer control msg length= 24
const integer control msg descriptor= control msg length!x'18000000'
const integer control in msg descriptor= control msg descriptor - 4
const integer idle= x'F0F0F0F0'
const integer control in=-2
const integer control out=-1
const integer data stream= 0
if sseries=no start
const integer long block mask= x'0400'
const integer x mask= x'0200'
const integer y mask= x'0100'
else
const integer long block mask= x'04000000'
const integer x mask= x'02000000'
const integer y mask= x'01000000'
finish
integer stream no, buffer no, device no
integer temp, length, message ident, s ident, search index, cib index, dact, control addr, l, f, t, x,
interrupt analysis flags, xbit set
record (pe) gpc req
record (pe) cmes
record (gpcf) name gpc entry
record (daf) name device area
record (sr) name stream
record (br) name buffer
record (cr) name control
record (parmf) name parm cell
record (oper command f) oper command
record (pe) name oc
switch act(0:deallocate request)
const integer testing=yes
routine start device(integer stream no, ext stream no, real address, start, length)
if sseries=no start
const integer array lb mask(0:1)= c
x'00F00202', x'80F00302'
else
const integer array lb mask(0:1)= c
x'2F004002', x'2F004083'
finish
if sseries=no start
device area_lst1 = x'80000001'!real address
device area_lb1 = lb mask(stream no&1)
device area_al10 = length
device area_al11 = start
else
device area_tcb0 response = 0
device area_tcb1 command = lb mask(stream no&1)
if real address=0 then device area_tcb1 ste = device area_tcb0 ste else c
device area_tcb1 ste = real address!1
device area_tcb1 length = length
device area_tcb1 address = start
device area_tcb1 response = 0
finish
device area_stream = stream no
device area_name = ext stream no<<16!length
gpc req = 0
gpc req_dserv = execute chain
gpc req_sserv = mk1 fe executed
if sseries=no start
gpc req_p1 = addr(device area_rcb0)
else
gpc req_p1 = addr(device area_tcb0 command)
finish
gpc req_p2 = device area_ident
if sseries=no start
gpc req_p3 = x'11'; !paw function<<4!saw flags
finish
!! %if monlevel&2#0 %and (kmon>>mk1 fe service)&1#0 %then
!! printstring("FE: start device, st=".strint(stream no)." xst=".strint(ext stream no)." len=".strint(length).snl)
if multi ocp=yes then pon(gpc req) else gdc(gpc req)
end ; !of routine start device
routine queue
!* queue a high or low level control message for output as the cob is full
integer temp
temp = new pp cell
parm cell == parm tab(temp)
control addr = addr(parm cell_p1)
if device area_co head=empty then device area_co head = temp else parm tab(device area_co tail)_link = temp
parm cell_link = empty
device area_co tail = temp
if mon level&4#0 start
device area_total qd control msgs = device area_total qd control msgs+1
l = device area_co head
f = 1
while l#device area_co tail cycle
f = f+1
l = parm tab(l)_link
repeat
if f>device area_max qd control msgs then device area_max qd control msgs = f
finish
end ; !of routine queue
routine log event(string (63) text, record (pe) p)
op mess("FE".tostring(device no+'0').": ".text)
pkmon rec("Mk1 FE Adaptor:",p)
dumptable(80,mess_p3,512)
end ; !of log event
!***********************************************************************
!* main program *
!***********************************************************************
if mon level&2#0 and (kmon>>mk1 fe service)&1#0 then pkmon rec("Mk1 FE Adaptor: ", mess)
dact = mess_dserv&short mask
!*****
! nothing from DCU will make any sense 'till I redo DCU!!!!
!******
if dact=interrupt start ; !from gpc mess_p3=gpc area adrress
interrupt analysis flags = mess_p1>>20&15
gpc entry == record(mess_p3); !map device area
device area == record(gpc entry_ua ad); !map private device area
device no = device area_device no
stream no = device area_stream
else
if go ahead<=dact<=send control start ; !from comms mess_p1=strm&short mask
stream no = mess_p1&short mask
temp = stream index(stream no)
if temp=empty then return ; !can happen on fepdown
stream == stream tab(temp)
device no = stream_device no
if device to da ad(device no)=not allocated start
!send failure replies
cmes = 0
if mess_p1&top short mask#0 then cmes_dserv = comms command!mess_p1>>16 else cmes_dserv = mess_sserv
cmes_sserv = mess_dserv
cmes_p1 = stream no
cmes_p2 = 1
pon(cmes)
return
finish else device area == record(device to da ad(device no))
finish
finish
->act(dact)
act(0): !** print monitoring if collected
if mon level&4#0 start
if multi ocp=yes then reserve log
for device no = 0, 1, 9 cycle
if device to da ad(device no)#not allocated start
device area == record(device to da ad(device no))
newlines(2)
print string("FE".to string(device no+'0'). c
" Log Bytes Transfers XBIT Set Bytes/Transfer")
newline
print string("Data Input ")
f = device area_bytes of data input
write(device area_bytes of data input, 10)
t = device area_data input transfers
write(device area_data input transfers, 10)
x = device area_data input xbit set
write(device area_data input xbit set, 10)
write(device area_bytes of data input//device area_data input transfers, 10) if c
device area_data input transfers#0
newline
print string("Data Output ")
f = f+device area_bytes of data output
write(device area_bytes of data output, 10)
t = t+device area_data output transfers
write(device area_data output transfers, 10)
x = x+device area_data output xbit set
write(device area_data output xbit set, 10)
write(device area_bytes of data output//device area_data output transfers, 10) if c
device area_data output transfers#0
newline
print string("Control Input ")
f = f+device area_bytes of control input
write(device area_bytes of control input, 10)
t = t+device area_control input transfers
write(device area_control input transfers, 10)
x = x+device area_control input xbit set
write(device area_control input xbit set, 10)
write(device area_bytes of control input//device area_control input transfers, 10) if c
device area_control input transfers#0
newline
print string("Control Output ")
f = f+device area_bytes of control output
write(device area_bytes of control output, 10)
t = t+device area_control output transfers
write(device area_control output transfers, 10)
x = x+device area_control output xbit set
write(device area_control output xbit set, 10)
write(device area_bytes of control output//device area_control output transfers, 10) if c
device area_control output transfers#0
newline
print string("Totals ")
write(f, 10)
write(t, 10)
write(x, 10)
write(f//t, 10) if t#0
newline
print string("Output Updates ")
write(device area_output updates, 10)
newline
print string("Update Overwrites")
write(device area_update overwrites, 8)
newline
print string("Overwrite Ratio")
if device area_update overwrites>0 then c
write(device area_output updates//device area_update overwrites, 10) else write(0, 10)
print string(":1")
newline
print string("Queued Transfers")
write(device area_total qd transfers, 9)
newline
print string("Queued Control ")
write(device area_total qd control msgs, 10)
newline
print string("Max Queued Trans")
write(device area_max qd transfers, 9)
newline
print string("Max Queued Control")
write(device area_max qd control msgs, 7)
newlines(2)
if sseries=no start
t = 0
t = t+device area_buffqsize(l) for l = 0, 1, 20
printstring("Transfer queue sizes (idle =")
if t=0 then printstring(" 100%)") else start
write(device area_buffqsize(0)*100//t, 1)
printstring("%)")
newline
write(f, 4) for f = 1, 1, 20
printstring("+")
newline; space
for f = 1, 1, 20 cycle
write(device area_buffqsize(f)*100//t, 3)
printstring("%")
repeat
finish
newlines(2)
device area_buffqsize(f) = 0 for f = 0, 1, 20
finish
device area_max qd transfers = 0
device area_max qd control msgs = 0
device area_total qd transfers = 0
device area_total qd control msgs = 0
device area_bytes of control input = 0
device area_bytes of control output = 0
device area_bytes of data input = 0
device area_bytes of data output = 0
device area_control input transfers = 0
device area_control output transfers = 0
device area_data input transfers = 0
device area_data output transfers = 0
device area_output updates = 0
device area_update overwrites = 0
device area_control input xbit set = 0
device area_control output xbit set = 0
device area_data input xbit set = 0
device area_data output xbit set = 0
finish
repeat
if multi ocp=yes then release log
finish
return
act(interrupt): !** device interrupt (normal, abnormal or attention)
->atten if interrupt analysis flags=attention
->abnormal termination unless interrupt analysis flags&normal termination=normal termination
!** normal termination interrupt
if device area_failures#0 start
op mess("FE".to string(device no+'0')." Transfer Recovered")
device area_failures = 0
finish
if sseries=no start
length = device area_al10-gpc entry_resp1&short mask
!number of bytes transfered
xbit set = gpc entry_resp0&x mask
else
length = device area_tcb1 length-device area_tcb1 response&short mask
!number of bytes transfered
xbit set = device area_tcb1 response&x mask
finish
!! %if monlevel&2#0 %and (kmon>>mk1 fe service)&1#0 %then
!! printstring("FE: termination, st=".strint(stream no)." bytes=".strint(length)." xbit=".strint(xbit set).snl)
if stream no=control out start ; !control output termination
if length#(length//control msg length)*control msg length start
if length#1 start ; !due to a quirk of the gpc 1 is not an error
op mess("FE".tostring(device no+'0')." partial control msg output".tostring(17))
dump table(80, mess_p3, gpc entry_entsize)
finish
length = (length//control msg length)*control msg length
finish
if mon level&4#0 start
device area_bytes of control output = device area_bytes of control output+length
device area_control output transfers = device area_control output transfers+1
device area_control output xbit set = device area_control output xbit set+1 if xbit set#0
finish
device area_cob index = device area_cob index-length
!*mc move(device area_cob index,addr(device area_cob(length)), %c
addr(device area_cob(0))) if device area_cob index > 0
!shuffle down?
if device area_cob index>0 start
l = device area_cob index
f = addr(device area_cob(length))
t = addr(device area_cob(0))
*ldtb_x'18000000'
*ldb_l
*lda_f
*cyd_0
*lda_t
*mv_ l = dr
finish
device area_cob start = 0
while device area_co head#empty and device area_cob index<cob length cycle
parm cell == parm tab(device area_co head)
!*mc move(control msg length,addr(parm cell_p1),addr( %c
device area_cob(device area_cob index)))
t = addr(device area_cob(device area_cob index))
*lsd_parm cell
*iad_8
*ldtb_control msg descriptor
*lda_t
*mv_ l = dr
device area_cob index = device area_cob index+control msg length
temp = parm cell_link
return pp cell(device area_co head)
device area_co head = temp
device area_co tail = empty if temp=empty
repeat
->make idle
finish
if stream no=control in start ; !control input termination
if length#(length//control msg length)*control msg length start
if length#1 start ; !due to a quirk of the gpc not an error if 1
op mess("FE".tostring(device no+'0')." partial control msg input".tostring(17))
dump table(80, mess_p3, gpc entry_entsize)
finish
length = (length//control msg length)*control msg length
finish
if mon level&4#0 start
device area_bytes of control input = device area_bytes of control input+length
device area_control input transfers = device area_control input transfers+1
device area_control input xbit set = device area_control input xbit set+1 if xbit set#0
finish
cib index = 0
cmes_sserv = mess_dserv
while cib index<length cycle
control == record(addr(device area_cib(cib index)))
temp = control_message ident
s ident = temp&short mask
stream no = temp>>16
if 0<=stream no<=max stream and stream index(stream no)#empty start
!valid stream?
cmes_p1 = stream no
!*mc move(control msg length-4,addr(control_p2),addr(cmes_p2))
t = addr(cmes_p2)
*lsd_control
*iad_4
*ldtb_control in msg descriptor
*lda_t
*mv_ l = dr
if s ident=0 then cmes_dserv = stream tab(stream index(stream no))_owner else c
cmes_dserv = comms command!s ident
!! %if monlevel&2#0 %and (kmon>>mk1 fe service)&1#0 %then pkmon rec("FE pons:", cmes)
if testing=yes start
stream == stream tab(stream index(stream no))
if stream_adaptor no#fe or stream_device no#device no or (0#s ident#transfer requested and c
sub ident(stream_state)#s ident<<16) start
pkmonrec("Comms: stream ", record(addr(stream)))
log event("bad low level con".tostring(17), cmes)
finish else pon(cmes)
finish else pon(cmes)
else
print string("Mk1 FE Adaptor: FE".to string(device no+'0')." Bad stream number ".strint(stream no).snl)
finish
cib index = cib index+control msg length
repeat
->make idle
finish
if mon level&4#0 start
if stream no&1=1 start ; !output
device area_bytes of data output = device area_bytes of data output+length
device area_data output transfers = device area_data output transfers+1
device area_data output xbit set = device area_data output xbit set+1 if xbit set#0
else
device area_bytes of data input = device area_bytes of data input+length
device area_data input transfers = device area_data input transfers+1
device area_data input xbit set = device area_data input xbit set+1 if xbit set#0
finish
finish
cmes = 0
cmes_sserv = mess_dserv
cmes_dserv = transfer complete
cmes_p1 = stream no
if sseries=no start
cmes_p2 = 3 if gpc entry_resp0&long block mask#0
!next page required and dont recapture
else
cmes_p2 = 3 if device area_tcb1 response&long block mask#0
!next page required and dont recapture
finish
cmes_p3 = length
if sseries=no start
temp = gpc entry_resp0&y mask; !send high level control message to signal end of message
else
temp = device area_tcb1 response&y mask; !send high level control message to signal end of message
finish
cmes_p2 = cmes_p2!4 if temp#0
pon(cmes)
->make idle
abnormal termination: !** abnormal termination interrupt
print string("Mk1 FE Adaptor: Abterm FE".to string(device no+'0')." ".strint(device area_failures).snl)
pkmon rec("Mk1 FE Adaptor: ", mess)
if device area_failures<=max failures start
!try again?
gpc req = 0
gpc req_dserv = execute chain
gpc req_sserv = mk1 fe executed
if sseries=no start
gpc req_p1 = addr(device area_rcb0)
else
gpc req_p1 = addr(device area_tcb0 command)
finish
gpc req_p2 = device area_ident
if sseries=no start
gpc req_p3 = x'11'; !paw function<<4!saw flags
finish
dpon(gpc req, retry delay(device area_failures))
!try again in ? seconds
device area_failures = device area_failures+1
else
down:
op mess("FE".to string('0'+device no)." DOWN".to string(17)); !flash
dump table(80,mess_p3,gpc entry_ent size)
if stream no>=data stream start ; !fail transfer in progress
cmes = 0
cmes_dserv = transfer complete
cmes_sserv = mess_dserv
cmes_p1 = stream no
cmes_p2 = 2; !dont recapture
pon(cmes)
finish
while device area_head#empty cycle ; !fail all queued transfers
buffer == buffer tab(device area_head)
device area_head = buffer_link
device area_tail = empty if device area_head=empty
cmes = 0
cmes_dserv = transfer complete
cmes_sserv = mess_dserv
cmes_p1 = buffer_stream no
cmes_p2 = 2; !dont recapture
pon(cmes)
repeat
for stream no = 0, 1, max stream cycle
if stream index(stream no)#empty start
stream == stream tab(stream index(stream no))
if stream_adaptor no=fe and stream_device no=device no start
!connected thru this front end
cmes = 0
cmes_sserv = mess_dserv
cmes_p1 = stream no
if stream no&1=0 and sub ident(stream_state)=-1 start
!input stream not waiting on a reply
cmes_dserv = stream_owner; !then send a high level control msg
cmes_p2 = stream_cursor
cmes_p3 = x'01590000'; !control (e o t) y
pon(cmes)
else ; !waiting on a reply
if sub ident(stream_state)#-1 start
cmes_dserv = comms command!sub ident(stream_state)>>16
!simulate one
cmes_p2 = 1; !failure
pon(cmes)
finish
finish
finish
finish
repeat
device area_stream = idle
device area_cob start = 0
device area_cob index = 0
device area_failures = 0
gpc req = 0
gpc req_dserv = deallocate device
gpc req_sserv = mk1 fe deallocated
gpc req_p1 = m'FE0'!device no
pon(gpc req)
device to da ad(device no) = not allocated
if com area_ipldev<0 start
oper command_dest = oper command req
oper command_srce = mk1 fe oper com reply
oper command_txt = "FEPUP 0"
oc == oper command
oc_p2 = oc_p2!device no
dpon(oper command, 600); !after 10 mins
finish
finish
return
atten: !** attention interrupt
!!%if monlevel&2#0 %and (kmon>>mk1 fe service)&1#0 %then printstring("FE: atten from device".snl)
if mess_p1&x'1FF00'=x'08000' start ; !expected attn ?
if stream no=idle start
if device to da ad(device no)=not allocated start
! mess_dserv = x'32000b'
!flash off
! pon(mess)
op mess("FE".to string(device no+'0')." UP")
device to da ad(device no) = addr(device area)
finish
make idle:
device area_stream = idle
if interrupt analysis flags=attention or xbit set#0 or device area_attn set#0 start
!control input pending
device area_attn set = 0
start device(control in, control in, 0, addr(device area_cib(0)), cib length)
return
finish
if device area_cob index>0 start ; !control output pending.
start device(control out, control out, 0, addr(device area_cob(0)), device area_cob index)
device area_cob start = device area_cob index
return
finish
if device area_head#empty start ; !data transfer queued
buffer == buffer tab(device area_head)
device area_head = buffer_link
device area_tail = empty if device area_head=empty
start device(buffer_stream no, buffer_external stream no, buffer_real address, buffer_offset,
buffer_length)
return
finish
finish else device area_attn set = 1
else
op mess("FE".to string(device no+'0')." Unexpected attention")
pkmon rec("Mk1 FE Adaptor: ", mess)
finish
return
act(deallocate request): !** operator can now invoke reallocation following
! a disconnect/reconnect sequence by gpc
device no = mess_p1
if 0<=device no<=9 and device to da ad(device no)#not allocated start
device area == record(device to da ad(device no))
stream no = device area_stream
->down
finish
opmess("FE".tostring(device no+'0')." not allocated")
return
act(deallocated): !** reply from gpc
if mess_p1#0 then opmess("FE: Dealloc fails ".strint(mess_p1&short mask))
return
act(allocate request): !** operator request to recover fe
device no = mess_p1
if device to da ad(device no)=not allocated start
gpc req = 0
gpc req_dserv = allocate device
gpc req_sserv = mk1 fe allocated
gpc req_p1 = m'FE0'!device no
gpc req_p2 = mk1 fe interrupt
pon(gpc req)
finish else opmess("FE".tostring(device no+'0')." Already allocated")
return
act(allocated): !** device allocated by gpc
if mess_p1=0 start ; !allocated
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
device no = gpc entry_mnemonic&byte mask-'0'
device to da ad(device no) = gpc entry_ua ad
if sseries=no start
device area_lst0 = x'02201000'; !local segment table entry r2, w2, max len 1 epage
device area_lst1 = x'00000000'
device area_rcb0 = x'00000002'; !rcb flags etc
device area_rcb1 = realise(addr(device area_lst0))
!segment table (real address)
device area_rcb2 = 8; !logic block byte count
device area_rcb3 = addr(device area_lb0); !logic block address (virtual)
device area_rcb4 = 16; !address list byte count
device area_rcb5 = addr(device area_al00)
!address list address (virtual)
device area_rcb6 = 0; !unused
device area_rcb7 = 0; !unused
device area_lb0 = x'84300500'; !write control (ext stream no)<<16!length
device area_lb1 = x'00000000'; !read or write data
device area_al00 = 4; !length of ext stream no and length field
device area_al01 = addr(device area_name)
!address of stream field
device area_al10 = 0; !length of read / write area
device area_al11 = 0; !address of read / write area
else
com area == record(x'80000000'!48<<18)
device area_tcb0 command = x'2F404085'; !write control chained
device area_tcb0 ste = integer(addr(device area)<<1>>19<<3+com area_pstva+4)!1
device area_tcb0 length = 4
device area_tcb0 address = addr(device area_name)
device area_tcb0 next tcb = addr(device area_tcb1 command)
device area_tcb0 response = 0
device area_tcb1 command = 0
device area_tcb1 ste = 0
device area_tcb1 length = 0
device area_tcb1 address = 0
device area_tcb1 next tcb = 0
device area_tcb1 response = 0
finish
device area_ident = mess_p2
device area_name = 0; !control information sent written here
device area_stream = idle
device area_cob start = 0
device area_cob index = 0
device area_head = empty
device area_tail = empty
if mon level&4#0 start
device area_max qd transfers = 0
device area_max qd control msgs = 0
device area_total qd transfers = 0
device area_total qd control msgs = 0
device area_bytes of control input = 0
device area_bytes of control output = 0
device area_bytes of data input = 0
device area_bytes of data output = 0
device area_control input transfers = 0
device area_control output transfers = 0
device area_data input transfers = 0
device area_data output transfers = 0
device area_output updates = 0
device area_update overwrites = 0
device area_control input xbit set = 0
device area_control output xbit set = 0
device area_data input xbit set = 0
device area_data output xbit set = 0
finish
device area_co head = empty
device area_co tail = empty
device area_attn set = 0
device area_device no = device no
device area_failures = 0
finish
if timer started=no start
mess = 0
mess_dserv = elapsed int command; !tick every n secs
mess_sserv = mk1 fe clock tick
mess_p1 = mk1 fe clock tick
mess_p2 = secs per tick
if multi ocp=no then elapsed int(mess) else pon(mess)
timer started = yes
finish
return
act(execute fails): !** execute chain fails
gpc entry == record(mess_p3)
dump table(80, mess_p3, gpc entry_ent size)
device area == record(gpc entry_ua ad)
device no = device area_device no
stream no = device area_stream
->abnormal termination; ! treat as abterm for better diagnostics
!* above entries are called by gpc
!* below entries are called by comms control
act(go ahead): !** transfer go ahead
buffer no = mess_p2
buffer == buffer tab(buffer no)
if device area_stream#idle start ; !queue a transfer
buffer_link = empty
if device area_head=empty then device area_head = buffer no else c
buffer tab(device area_tail)_link = buffer no
device area_tail = buffer no
if mon level&4#0 start
device area_total qd transfers = device area_total qd transfers+1
l = device area_head
f = 1
while l#device area_tail cycle
f = f+1
l = buffer tab(l)_link
repeat
if f>device area_max qd transfers then device area_max qd transfers = f
f = 20 if f>20
finish
else
start device(stream no, buffer_external stream no, buffer_real address, buffer_offset, buffer_length)
if monlevel&4#0 then f = 0
finish
if monlevel&4#0 and sseries=no then device area_buffqsize(f) = device area_buffqsize(f)+1
return
act(send control): !** control message
message ident = stream_external stream no<<16!mess_p1>>16
mess_p1 = message ident
!!%if monlevel&2#0 %and (kmon>>mk1 fe service)&1#0 %then pkmon rec("FE co msg:", mess)
if message ident&short mask=0 and mess_sserv&short mask=control msg7 reply start
!high level and update message
device area_output updates = device area_output updates+1 if mon level&4#0
search index = device area_cob start
cycle
control addr = addr(device area_cob(0))+search index
if search index>=device area_cob index start
!end of whats in buffer?
if device area_cob index>=cob length start
!cob buffer full
temp = device area_co head
while temp#empty cycle ; !scan down existing queue
parm cell == parm tab(temp)
if message ident=parm cell_p1 start
!update?
device area_update overwrites = device area_update overwrites+1 if mon level&4#0
control addr = addr(parm cell_p1)
->out
finish else temp = parm cell_link
repeat
queue
out:
finish else device area_cob index = device area_cob index+control msg length
exit
finish
if integer(control addr)=message ident start
device area_update overwrites = device area_update overwrites+1 if mon level&4#0
exit
finish
search index = search index+control msg length
repeat
! cmes = 0
! cmes_dserv = mess_sserv
! cmes_sserv = mess_dserv
! cmes_p1 = stream no
! %if multi ocp = no %then comms control(cmes) %else pon(cmes)
!reply message updated
else
if device area_cob index<cob length start
!cob buffer full?
control addr = addr(device area_cob(device area_cob index))
device area_cob index = device area_cob index+control msg length
finish else queue
finish
!*mcmove(control msg length,addr(mess_p1),control addr)
*lsd_mess
*iad_8
*ldtb_control msg descriptor
*lda_control addr
*mv_ l = dr
start device(control out, control out, 0, addr(device area_cob(0)), device area_cob index) and c
device area_cob start = device area_cob index if device area_stream=idle
return
act(clock tick): !send control msg every n secs to confirm fes are up
for device no = 0, 1, 9 cycle
unless device to da ad(device no)=not allocated start
device area == record(device to da ad(device no))
if device area_cob index=0 and device area_stream=idle start
mess = 0
mess_p1 = -1; !dummy stream no for fe to ignore
control addr = addr(device area_cob(0))
device area_cob index = control msg length
!*mcmove(control msg length,addr(mess_p1),control addr)
*lsd_mess
*iad_8
*ldtb_control msg descriptor
*lda_control addr
*mv_ l = dr
start device(control out, control out, 0, addr(device area_cob(0)), control msg length)
device area_cob start = control msg length
finish
finish
repeat
return
act(oper com reply): !ignore reply to fepup message
!!
end ; !of routine mk1 fe adaptor
external routine lp adaptor(record (pe) name mess)
!***********************************************************************
!* service 51 (x33) *
!* drives the line printer to comms controller spec *
!* accepts the data as iso, ebcidic or binary. iso is translated to *
!* ebcidic using the master translate tables. ebcidic data is *
!* translated to a subset of ebcidic depending on the rep in the *
!* printer to avoid non printing characters fouling things up. *
!* binary data is left alone. *
!* can manage up to 10 printers (lp0-lp9) using a 128 byte area for *
!* each which is provided on allocation *
!***********************************************************************
record format gpcf(integer last dest, gptsm, propaddr, ticks, caa, grcb ad, lba,
(integer last tcb addr or integer ala), integer state, resp0, resp1, sense1, sense2, sense3, sense4,
repsno, base, id, dlvn, mnemonic, entsize, paw, usaw0, urcb ad, sense ad, logmask, trt ad, ua size, ua ad,
timeout, props0, props1)
if sseries=no start
record format daf(integer lst0, lst1, rcb0, rcb1, rcb2, rcb3, rcb4, rcb5, rcb6, rcb7, lb0, lb1, lb2, al00,
al01, stream no, mode, buffer no, trt ad, ident)
else
record format daf(half integer stream no, buffer no, integer trt ad, addr tcb, byte integer mode,
ident, device no, s, integer tcb0 command, tcb0 ste, tcb0 length, tcb0 address, tcb0 next tcb,
tcb0 response, (integer tcb0 fragment length, tcb0 nulls or integer array tcb0 preamble,
tcb0 postamble(0:3)), integer tcb1 command, tcb1 ste, tcb1 length, tcb1 address, tcb1 next tcb,
tcb1 response, integer array tcb1 preamble(0:3), tcb1 postamble(0:2), byte integer array chars(0:131))
finish
routine spec reply to comms control(integer act, stream no, flag, count)
routine spec get next buffer
own integer array device to da ad(0:9)= c
not allocated(10)
own byte integer array pagesize(0:9); ! set on connect
own byte integer array countsw(0:9); ! guards against counting same epage twice
own integer array pagecount(0:9); ! count of pages since last connect
own byte integer array linecount(0:9); ! count of lines on current page
own integer array fefftab(0:7)= x'00080400',x'E0000000',0(6)
! ff,nl,msp,mnl,vp
! %owninteger last allocated to other = -1; !who last had device
record (pe) req
record (pe) rep
record (gpcf) name gpc entry
record (daf) name device area
record (sr) name stream
record (br) name buffer
integer stream no, buffer no, state, start, sstart, p, l, s
integer buffer end, sent, device no, act
integer i, char, line, long line, line begin, trt ad, interrupt analysis flags
long integer savedr, saveacc
switch dact(0:deallocate request)
switch states(0:active)
if mon level&2#0 and (kmon>>lp service)&1#0 start
pkmon rec("LP Adaptor: ", mess)
finish
act = mess_dserv&short mask
if act=interrupt start ; !from gpc mess_p3=gpc area adrress
interrupt analysis flags = mess_p1>>20&15
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
stream no = device area_stream no
else
if go ahead<=act<=send control start ; !from comms mess_p1=strm&short mask
stream no = mess_p1&short mask
stream == stream tab(stream index(stream no))
device no = stream_device no
finish
finish
->dact(act)
dact(interrupt): !** device interrupt (normal, abnormal, attention)
unless interrupt analysis flags=attention start
if sseries=no start
i = (device area_rcb3-addr(device area_lb0))>>2+gpc entry_resp0&byte mask
else
if interrupt analysis flags&normal termination=0 and c
gpc entry_last tcb addr=addr(device area_tcb0 command) then i = 0 else i = 2
finish
if interrupt analysis flags&normal termination#normal termination and c
mess_p4&x'FF'=normal termination<<4 and integer(gpc entry_sense ad)=x'20000004' then c
long line = yes else long line = no
if i=2 and mess_p2#-1 start ; !on the write data and not a time out
if sseries=no start
sent = device area_al00-gpc entry_resp1&short mask
else
sent = device area_tcb1 length-device area_tcb1 response&short mask+device area_tcb0 fragment length+dev c
ice area_tcb0 nulls
finish
if long line=no start ; !was it a long line then no need to scan back
if sent>0 start
buffer == buffer tab(device area_buffer no)
start = virtual+buffer_real address+buffer_offset
buffer end = start+sent-1
if sent>133 then line begin = buffer end-132 else line begin = start
line = buffer end-line begin+1; !in case preceeding line was long
for i = buffer end, -1, line begin cycle
char = byte integer(i)
if (sseries=yes and char=x'07') or char=ebc nl or char=ebc cr or char=ebc ff then c
line = buffer end-i and exit
repeat
!set up chain to merge the end of the line onto the head
if line=0 start
if sseries=no start
device area_rcb3 = addr(device area_lb2)
device area_lb2 = x'80700300'
else
device area_addr tcb = addr(device area_tcb1 command)
finish
else
if sseries=no start
device area_rcb3 = addr(device area_lb0)
device area_lb1 = x'8A700000'!line
device area_lb2 = x'80700000'
else
device area_addr tcb = addr(device area_tcb0 command)
device area_tcb0 length = line
for i = 0, 1, line cycle ; ! protem - try MSP
device area_chars(i) = ebc sp
repeat
finish
finish
finish
else ; !tag on a new line
if sseries=no start
device area_rcb3 = addr(device area_lb1)
device area_lb1 = x'8A700300'!ebc nl
device area_lb2 = x'80700000'
else
device area_addr tcb = addr(device area_tcb0 command)
device area_tcb0 length = 1
device area_chars(0) = ebc nl
finish
stream == stream tab(stream index(stream no))
device no = stream_device no
if pagesize(device no)#0 then start
linecount(device no) = linecount(device no)+1
while linecount(device no)>=pagesize(device no) cycle
pagecount(device no) = pagecount(device no)+1
linecount(device no) = linecount(device no)-pagesize(device no)
repeat
countsw(device no) = yes; ! avoid counting the buffer again
finish
sent = sent-1; !send the char that caused the long line again
finish
finish else sent = 0
!send reply to comms control
req = 0
req_sserv = mess_dserv
req_dserv = transfer complete
req_p1 = stream no
req_p2 = 3; !get next page and dont recapture
if interrupt analysis flags&normal termination=0 and long line=no start
req_p2 = req_p2!4; !inform user
req_p5 = integer(gpc entry_sense ad)
req_p6 = integer(gpc entry_sense ad+4)
finish
req_p3 = sent
pon(req)
get next buffer if long line=yes and interrupt analysis flags&normal termination=0
else
!** attention interrupt
if mess_p1&auto=auto then start
if stream index(stream no)#empty start
stream == stream tab(stream index(stream no))
device no = stream_device no
countsw(device no) = yes; ! remember, to avoid counting buffer twice
finish
get next buffer
finish
finish
return
dact(execute fails): !** execute chain fails
gpc entry == record(mess_p3)
dump table(81, mess_p3, gpc entry_ent size)
return
dact(allocated): !** device allocated by gpc
if mess_p1=0 start ; !allocated
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
device no = gpc entry_mnemonic&byte mask-'0'
device to da ad(device no) = gpc entry_ua ad
! %if gpc entry_last dest # lp interrupt %then last allocated to other = %c
! last allocated to other ! 1<<device no
device area_ident = mess_p2; !save gpc identifier
device area_mode = 0; !iso by default
device area_stream no = mess_p5
device area_buffer no = 0
device area_trt ad = gpc entry_trt ad
if sseries=no start
device area_lst0 = x'00F01000'; !local segment table entry r15 max len 1 epage
device area_lst1 = 0
device area_rcb0 = x'0000000F'; !rcb flags etc
device area_rcb1 = realise(addr(device area_lst0))
device area_rcb2 = 12; !logic block byte count
device area_rcb3 = addr(device area_lb2); !logic block address
device area_rcb4 = 8; !address_list byte count
device area_rcb5 = addr(device area_al00)
!address list address
device area_rcb6 = 0; !unused
device area_rcb7 = 0; !unused
device area_lb0 = x'8A700300'!ebc ms
device area_lb1 = x'8A700000'; !number of spaces
device area_lb2 = x'80700300'; !write buffer
device area_al00 = 0; !buffer length
device area_al01 = 0; !buffer offset
else
device area_tcb0 command = x'27404083'
device area_tcb0 ste = integer(addr(device area)<<1>>19<<3+com area_pstva+4)!1
device area_tcb0 length = 0
device area_tcb0 address = addr(device area_chars(0))
device area_tcb0 next tcb = addr(device area_tcb1 command)
device area_tcb1 command = x'27004083'
device area_tcb1 ste = 0
device area_tcb1 length = 0
device area_tcb1 address = 0
device area_tcb1 next tcb = 0
device area_tcb0 response = 0
device area_addr tcb = addr(device area_tcb1 command)
for i = 0, 1, 131 cycle
device area_chars(i) = ebc sp
repeat
finish
finish
reply to comms control(mess_p4, mess_p5, mess_p1, 0)
return
dact(deallocate request): !** operator request to force deallocation
device no = mess_p1
if 0<=device no<=9 and device to da ad(device no)#not allocated start
device area == record(device to da ad(device no))
stream no = device area_stream no
stream == stream tab(stream index(stream no))
if stream_state>=enabled start
mess_dserv = stream_caller
reply to comms control(disable, stream no, aborting, 0)
finish
if stream_state=connected start
mess_dserv = stream_caller
mess_p1 = stream no
mess_p2 = 1; !fail the connect request
pon(mess)
reply to comms control(disconnect, stream no, 0, 0)
finish
mess_dserv = lp command!deallocate request
dpon(mess, 4)
finish else op mess("LP Adapt: device free")
return
dact(deallocated): !** device deallocated by gpc
device no = mess_p6
device to da ad(device no) = not allocated
reply to comms control(mess_p4, mess_p5, mess_p1, 0)
return
dact(go ahead): !** transfer go ahead
buffer no = mess_p2
buffer == buffer tab(buffer no)
device area == record(device to da ad(device no))
device area_buffer no = buffer no
start = virtual+buffer_real address+buffer_offset
sstart = start
i to e(start, buffer_length) if device area_mode=iso
if device area_mode#binary start ; !translate it to the ebcidic characters in the current rep
i = buffer_length
trt ad = device area_trtad
if byteinteger(start)=ebc vp and device area_mode=ebcidic and i>1 start
!do not translate vp and qualifier
i = i-2
start = start+2
finish
*lb_i; *jat_14, <l99>
*ldtb_x'18000000'; *ldb_ b ; *lda_start
*lss_trt ad; *luh_x'18000100'
*ttr_ l = dr
l99:
finish
s = pagesize(device no); ! make local copies for efficiency
->trans if s=0
if countsw(device no)=yes then start ; ! this epage already counted
countsw(device no) = no
->trans
finish
p = pagecount(device no)
l = linecount(device no)
*mpsr_x'0480'; ! set bound check inhibit so that
! modd will work sensibly
i = buffer_length
*lss_fefftab+4; ! address of format effector table
*luh_0; ! form bit descriptor
*st_saveacc; ! for subsequent scans
*lda_sstart; ! form descriptor to buffer
*ldtb_x'18000000'
*ldb_i
next:
!* start of main loop
*jat_11, <done>; ! jzdl - end of buffer
*lsd_saveacc; ! descriptor to bitmap
*tch_ l = dr ; ! scan for format effector
*jat_11, <done>; ! jzdl - not found
*std_savedr; ! for next scan
*lss_(dr ); ! examine character
*icp_ebc nl
*jcc_6, <notnl>
*lss_1
*j_<add>
notnl:
*icp_ebc ff
*jcc_6, <notff>
p = p+1; ! increment page count
l = 0; ! reset line count
->loop
notff:
*modd_1; ! advance to qualifier
*jat_11, <done>; ! unlikely - no qualifier
*std_savedr
*icp_ebc mnl
*jcc_6, <notmnl>
*lss_(dr ); ! number of lines
*j_<add>
notmnl:
*icp_ebc ms; ! multiple space - process but ignore
*jcc_8, <loop>; ! j if is ms
notms:
*icp_ebc vp
*jcc_6, <notvp>
*lss_(dr ); ! get destination line number
*st_i
if i>l then l = i
if i=0 then p = p+1 and l = 0; ! treat as formfeed
->loop
notvp:
monitor("BAD FORMAT EFFECTOR")
add:*iad_l
*st_l
while l>=s cycle
l = l-s; ! decrement line count
p = p+1; ! increment page count
repeat
loop:
*ld_savedr
*modd_1; ! advance to next character
*j_<next>
done:
pagecount(device no) = p; ! copy back the counts
linecount(device no) = l
*mpsr_x'FB40'; ! clear bound check inhibit
trans:
!and initiate the transfer
if sseries=no start
device area_lst1 = x'80000001'!buffer_real address
device area_al00 = buffer_length
device area_al01 = buffer_offset
else
l = 0
p = 0
if device area_addr tcb=addr(device area_tcb0 command) and device area_chars(0)=ebc sp start
! fragment to tack on
l = device area_tcb0 length
i = l
while i<132 and i-l+p<buffer_length cycle
char = byteinteger(sstart)
exit if char=ebc nl or char=ebc cr or char=ebc ff
device area_chars(i) = char
sstart = sstart+1
if char=x'07' then p = p+1 else i = i+1; ! omit nulls
repeat
l = i-l
device area_tcb0 length = i
device area_tcb1 length = buffer_length-l-p
if device area_tcb1 length<=0 start ; ! file must be corrupt
opmess("Corrupt print file!!!")
if multi ocp=yes then reserve log
printstring("LP adaptor - corrupt print file:")
dumptable(0, buffer_real address+x'81000000', buffer_length)
if multi ocp=yes then release log
req = 0; ! tell Comms Controller
req_sserv = mess_dserv
req_dserv = transfer complete
req_p1 = device area_stream no
pon(req)
return
finish
device area_tcb1 address = buffer_offset+l+p
else
device area_tcb1 length = buffer_length
device area_tcb1 address = buffer_offset
finish
device area_tcb0 fragment length = l
device area_tcb0 nulls = p
device area_tcb0 response = 0
device area_tcb1 response = 0
device area_tcb1 ste = buffer_real address!1
finish
req = 0
req_dserv = execute chain
req_sserv = lp executed
if sseries=no start
req_p1 = addr(device area_rcb0)
else
req_p1 = device area_addr tcb
finish
req_p2 = device area_ident
if sseries=no start
req_p3 = 1<<4!1; !(paw function)<<4!saw flags
finish
pon(req)
return
dact(send control): !** control message
state = mess_p2>>24
->states(state)
states(connecting): !** allocate device
pagecount(device no) = 0; ! initialise output accounting
linecount(device no) = 0
pagesize(device no) = (mess_p2>>16)&x'FF'
! page size passed from caller
countsw(device no) = no
req = 0
req_dserv = allocate device
req_sserv = lp allocated
req_p1 = m'LP0'!device no
req_p2 = lp interrupt
req_p4 = mess_p1>>16
req_p5 = stream no
pon(req)
return
states(enabling): !** request first page
reply to comms control(mess_p1>>16, stream no, 0, 0)
device area == record(device to da ad(device no))
device area_mode = mess_p2>>20&3; !iso ebcidic or binary
! %if (last allocated to other>>device no)&1 = 1 %start; !insert form feed?
! last allocated to other = last allocated to other !! (1<<device no)
if mess_p2>>16&3=sequential start ; ! insert ff if not sequential continuation
if sseries=no start
device area_rcb3 = addr(device area_lb1)
device area_lb1 = x'8A700300'!ebc ff
else
device area_addr tcb = addr(device area_tcb0 command)
device area_tcb0 length = 1
device area_chars(0) = ebc ff
finish
finish
get next buffer
return
states(disconnecting): !** deallocate device
req = 0
req_dserv = deallocate device
req_sserv = lp deallocated
req_p1 = m'LP0'!device no
req_p4 = mess_p1>>16
req_p5 = stream no
req_p6 = device no
pon(req)
return
states(aborting):
! last allocated to other = last allocated to other ! (1<<device no)
states(suspending):
reply to comms control(mess_p1>>16, stream no, 0, (pagecount(device no)<<16)!linecount(device no))
!always reply
return
routine reply to comms control(integer act, stream no, flag, count)
rep = 0
rep_dserv = comms command!act
rep_sserv = mess_dserv
rep_p1 = stream no
rep_p2 = flag
rep_p3 = count
pon(rep)
end ; !of routine reply to comms control
routine get next buffer
req = 0
req_dserv = request transfer
req_sserv = lp command
req_p1 = stream no
pon(req)
end ; !of routine get next buffer
end ; !of routine lp adaptor
if cr fitted=yes start
external routine cr adaptor(record (pe) name mess)
!***********************************************************************
!* service 52 (x34) *
!* drives the card reader to comms controller spec with some *
!* nasty fiddles when a card wont fit into remains of an epage *
!* can manage up to 10 readers (cr0-cr9) using a 512 byte area for *
!* each which is provided on allocation *
!***********************************************************************
integer i, j, stream no, device no, state, sent, act, buffer no, interrupt analysis flags, start
record format gpcf(integer ser, gptsm, propaddr, ticks, caa, grcb ad, lba, ala, state, resp0, resp1,
sense1, sense2, sense3, sense4, repsno, base, id, dlvn, mnemonic, entsize, paw, usaw0, urcb ad, sense ad,
logmask, trt ad, ua size, ua ad, timeout, props0, props1)
if sseries=no start
const integer max trans=36
record format daf(integer lst0, lst1, rcb0, rcb1, rcb2, rcb3, rcb4, rcb5, rcb6, rcb7, stream no, mode,
goah ad, goah len, curtrlen, buffer no, ident, blocked, integer array lbe(0:maxtrans-1),
ale(0:max trans*2-1))
else
const integer max trans=8
record format tcbf(integer cmd, ste, len, datad, ntcb, resp, integer array pre, post(0:3))
record format daf(record (tcbf) array tcb(0:max trans-1), integer stream no, mode, goah ad, goah len,
curtrlen, buffer no, ident, blocked)
finish
own integer array device to da ad(0:9)= c
not allocated(10)
routine spec translate and shuffle(integer address, integer name len)
routine spec reply to comms control(integer act, stream no, flag)
routine spec get next buffer
record (gpcf) name gpc entry
record (daf) name device area
record (sr) name stream
record (br) name buffer
record (pe) req, rep
const integer array card bytes(iso:binary)= c
80, 80, 160
const integer array card size(iso:binary)= c
81, 80, 160
switch dact(0:send control)
switch states(0:active)
if mon level&2#0 and (kmon>>cr service)&1#0 start
pkmon rec("CR Adaptor: ", mess)
finish
act = mess_dserv&short mask
if act=interrupt start ; !from gpc mess_p3=gpc area adrress
interrupt analysis flags = mess_p1>>20&15
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
stream no = device area_stream no
else
if act>=go ahead start ; !from comms mess_p1=strm&short mask
stream no = mess_p1&short mask
stream == stream tab(stream index(stream no))
device no = stream_device no
finish
finish
->dact(act)
dact(interrupt): !** device interrupt (normal, abnormal, attention)
unless interrupt analysis flags=attention start
buffer == buffer tab(device area_buffer no)
start = virtual+buffer_real address+device area_goah ad
if interrupt analysis flags&normal termination=normal termination start
translate and shuffle(start, device area_cur tr len) if device area_mode=iso
device area_goah len = device area_goah len-device area_curtrlen
device area_goah ad = device area_goah ad+device area_curtrlen
->read; !read more if room
else
i = mess_p1&255; ! failing CCB entry
sent = card size(device area_mode)*i; !bytes read ok
translate and shuffle(start, sent) if sent>0 and device area_mode=iso
device area_goah len = device area_goah len-sent
!tell comms control by a call to update cursor
req = 0
req_dserv = transfer complete
req_sserv = mess_dserv
req_p1 = stream no
req_p2 = 2; !next page not reqd and dont recapture
if sent>0 start
req_p2 = req_p2!4
req_p5 = integer(gpc entry_sense ad)
req_p6 = integer(gpc entry_sense ad+4)
device area_blocked = 1
finish
req_p3 = buffer_length-device area_goah len
pon(req)
finish
else
!** attention interrupt
get next buffer if mess_p1&auto=auto and device area_blocked=0
finish
return
dact(execute fails): !** execute chain fails
gpc entry == record(mess_p3)
dump table(82, mess_p3, gpc entry_ent size)
return
dact(allocated): !** device allocated by gpc
if mess_p1=0 start ; !allocated
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
device no = gpc entry_mnemonic&byte mask-'0'
device to da ad(device no) = gpc entry_ua ad
device area_ident = mess_p2; !save gpc identifier
device area_stream no = mess_p5
device area_mode = 0; !read in non binary mode
device area_blocked = 0
device area_goah len = 0
device area_goah ad = 0
device area_curtr len = 0
device area_buffer no = 0
if sseries=no start
device area_lst0 = x'0FF01000'
device area_lst1 = x'00000000'
device area_rcb0 = x'0000800F'
device area_rcb1 = realise(addr(device area_lst0))
device area_rcb2 = 144; !bytes of logic block
device area_rcb3 = addr(device area_lbe(0))
device area_rcb4 = 288; !bytes of address list
device area_rcb5 = addr(device area_ale(0))
device area_rcb6 = x'FC01'; !set nr mode
device area_rcb7 = 0
for i = 0, 2, 70 cycle
device area_ale(i) = x'58000050'; !80 byte entry
repeat
finish
finish
reply to comms control(mess_p4, mess_p5, mess_p1)
return
dact(deallocated): !** device deallocated by gpc
device no = mess_p6
device to da ad(device no) = not allocated
reply to comms control(mess_p4, mess_p5, mess_p1)
return
dact(go ahead): !** transfer go ahead
!ie comms has paged in buffer
buffer no = mess_p2
buffer == buffer tab(buffer no)
device area == record(device to da ad(device no))
if sseries=no then device area_lst1 = x'80000001'!buffer_real address
device area_goah len = buffer_length
device area_goah ad = buffer_offset
device area_buffer no = buffer no
read: !try to read cards
if device area_goah len<card size(device area_mode) start
!not room for even 1 card
if device area_goah len>0 start
j = virtual+buffer_real address+device area_goah ad
for i = 0, 1, device area_goah len-1 cycle
byte integer(i+j) = 0; !fill partcard with nulls
repeat
finish
req = 0
req_dserv = transfer complete
req_sserv = cr command
req_p1 = stream no
req_p2 = 3; !please provide next page and dont recapture this one
req_p3 = buffer_length
pon(req)
return
finish
!there is room for at least one card. set up chain
i = 0
cycle
exit if i>=max trans or device area_goah len-card size(device area_mode)*(i+1)<0
if sseries=no start
device area_lbe(i) = x'04400200'+2*i; !chain ignre longblk&read
device area_ale(2*i) = x'58000000'!card bytes(device area_mode)
device area_ale(2*i+1) = device area_goah ad+card size(device area_mode)*i
else
device area_tcb(i) = 0
device area_tcb(i)_cmd = x'2440C002'
device area_tcb(i)_ste = buffer_real address!1
device area_tcb(i)_len = card bytes(device area_mode)
device area_tcb(i)_datad = device area_goah ad+card size(device area_mode)*i
device area_tcb(i)_ntcb = addr(device area_tcb(i))+14*4
if device area_mode#binary then device area_tcb(i)_pre(0) = x'FC01' else c
device area_tcb(i)_pre(0) = x'FC02'
finish
i = i+1
repeat
if sseries=no start
device area_lbe(i-1) = device area_lbe(i-1)&x'F3FFFFFF'; ! dechain
if device area_mode#binary then device area_rcb6 = x'FC01' else device area_rcb6 = x'FC02'
else
device area_tcb(i-1)_cmd = device area_tcb(i-1)_cmd&x'FFBFFFFF'
device area_tcb(i-1)_ntcb = 0
finish
device area_cur tr len = card size(device area_mode)*i
req = 0
req_dserv = execute chain
req_sserv = cr executed
if sseries=no start
req_p1 = addr(device area_rcb0)
req_p3 = 1<<4!1; ! PAW fn & SAW flags
finish else req_p1 = addr(device area_tcb(0))
req_p2 = device area_ident
pon(req)
return
dact(send control): !** control message
state = mess_p2>>24
->states(state)
states(connecting): !** allocate device
req = 0
req_dserv = allocate device
req_sserv = cr allocated
req_p1 = m'CR0'!device no
req_p2 = cr interrupt
req_p4 = mess_p1>>16
req_p5 = stream no
pon(req); !try to allocate
return
states(disconnecting): !** deallocate device
req = 0
req_dserv = deallocate device
req_sserv = cr deallocated
req_p1 = m'CR0'!device no
req_p4 = mess_p1>>16
req_p5 = stream no
req_p6 = device no
pon(req)
return
states(enabling): !** request first page
reply to comms control(mess_p1>>16, stream no, 0)
device area == record(device to da ad(device no))
device area_mode = mess_p2>>20&3; !iso ebcidic or binary?
if device area_blocked=0 then get next buffer else device area_blocked = 0
return
states(suspending):
states(aborting):
reply to comms control(mess_p1>>16, stream no, 0)
return
routine reply to comms control(integer act, stream no, flag)
rep = 0
rep_dserv = comms command!act
rep_sserv = mess_dserv
rep_p1 = stream no
rep_p2 = flag
pon(rep)
end ; !of routine reply to comms control
routine get next buffer
req = 0
req_dserv = request transfer
req_sserv = cr command
req_p1 = stream no
pon(req)
end ; !of routine get next buffer
routine translate and shuffle(integer start, integer name len)
integer card addr, l, to
e to i(start, len); !translate cards to iso
to = start; !place card is to be shuffled to
for card addr = start, 81, start+len-81 cycle ; !cycle up each card
for l = 79, -1, 0 cycle ; !cycle down each character
->m if byteinteger(card addr+l)#' '
!char not a space
repeat
l = -1; !card all spaces
m: byteinteger(card addr+l+1) = nl
l = l+2; !length of card
move(l, card addr, to) if card addr#to
to = to+l
repeat
len = to-start; !number of chars remaining
end ; !of routine translate and shuffle
end ; !of routine cr adaptor
finish ; !of conditional compilation of cr adaptor
if cp fitted=yes start
external routine cp adaptor(record (pe) name mess)
!***********************************************************************
!* service 53 (x35) *
!* drives the card punch to comms controller spec with some *
!* nasty fiddles when a card wont fit into remains of an epage *
!* cards are just punched from disc in ebcdic and spooler informed *
!* can manage up to 10 punches (cp0-cp9) using a 160 byte area for *
!* each which is provided on allocation *
!***********************************************************************
integer i, j, stream no, device no, state, act, buffer no, sym, interrupt analysis flags
record format gpcf(integer ser, gptsm, propaddr, ticks, caa, grcb ad, lba, ala, state, resp0, resp1,
sense1, sense2, sense3, sense4, repsno, base, id, dlvn, mnemonic, entsize, paw, usaw0, urcb ad, sense ad,
logmask, trt ad, ua size, ua ad, timeout, props0, props1)
if sseries=no start
record format daf(integer lst0, lst1, rcb0, rcb1, rcb2, rcb3, rcb4, rcb5, rcb6, rcb7, lbe0, ale0, ale1,
stream no, buffer no, goah ad, goah len, posn, mode, ident, byte integer array card(0:79))
else
record format daf(integer tcb cmd, tcb ste, tcb len, tcb datad, tcb ntcb, tcb resp, tcb pre0, tcb pre1,
tcb pre2, tcb pre3, tcb post0, tcb post1, tcb post2, tcb post3, stream no, buffer no, goah ad, goah len,
posn, mode, ident, byte integer array card(0:79))
finish
own integer array device to da ad(0:9)= c
not allocated(10)
own byte integer array countsw(0:9); ! guards against counting same epage twice
own integer array cardcount(0:9); ! count of cards punched
routine spec reply to comms control(integer act, stream no, flag, count)
routine spec get next buffer
record (gpcf) name gpc entry
record (daf) name device area
record (sr) name stream
record (br) name buffer
record (pe) req, rep
switch dact(0:send control)
switch states(0:active)
if mon level&2#0 and (kmon>>cp service)&1#0 start
pkmon rec("CP Adaptor: ", mess)
finish
act = mess_dserv&short mask
if act=interrupt start ; !from gpc mess_p3=gpc area adrress
interrupt analysis flags = mess_p1>>20&15
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
stream no = device area_stream no
else
if act>=go ahead start ; !from comms mess_p1=strm&short mask
stream no = mess_p1&short mask
stream == stream tab(stream index(stream no))
device no = stream_device no
finish
finish
->dact(act)
dact(interrupt): !** device interrupt (normal, abnormal, attention)
unless interrupt analysis flags=attention start
buffer == buffer tab(device area_buffer no)
if interrupt analysis flags&normal termination=normal termination start
device area_posn = 0; !no unpunched card in buffer
i = 0 and ->epage used if device area_goah len=0
!finished buffer empty
stream == stream tab(stream index(stream no))
device no = stream_device no
->punch; !punch more if room
else
!tell comms control by a call to update cursor
req = 0
req_dserv = transfer complete
req_sserv = cp command
req_p1 = stream no
req_p2 = 6; !next page not reqd and dont recapture this one
req_p3 = buffer_length-device area_goah len
req_p5 = integer(gpc entry_sense ad)
req_p6 = integer(gpc entry_sense ad+4)
pon(req)
finish
else
!** attention interrupt
if mess_p1&auto=auto then start
stream == stream tab(stream index(stream no))
device no = stream_device no
countsw(device no) = yes; !remember this, so that epage not counted twice
get next buffer
finish
finish
return
dact(execute fails): !** execute chain fails
gpc entry == record(mess_p3)
dump table(83, mess_p3, gpc entry_ent size)
return
dact(allocated): !** device allocated by gpc
if mess_p1=0 start ; !allocated
gpc entry == record(mess_p3)
device area == record(gpc entry_ua ad)
device no = gpc entry_mnemonic&byte mask-'0'
device to da ad(device no) = gpc entry_ua ad
device area_ident = mess_p2; !save gpc identifier
device area_stream no = mess_p5
device area_mode = 0; !read in non binary mode
device area_buffer no = 0
device area_goah ad = 0
device area_goah len = 0
device area_posn = 0
if sseries=no start
device area_lst0 = 0; ! not used
device area_lst1 = 0; ! not used
device area_rcb0 = x'00008002'
device area_rcb1 = 0; ! not used
device area_rcb2 = 4; !bytes of logic block
device area_rcb3 = addr(device area_lbe0)
device area_rcb4 = 8; !bytes of address list
device area_rcb5 = addr(device area_ale0)
device area_rcb6 = x'FC01'; !set nr mode
device area_rcb7 = 0
device area_lbe0 = x'80000300'
device area_ale0 = x'58000050'
device area_ale1 = addr(device area_card(0))
else
device area_tcb cmd = x'2000C083'
device area_tcb ste = realise(addr(device area)&x'FFFC0000')!1
device area_tcb len = 80
device area_tcb datad = addr(device area_card(0))
device area_tcb ntcb = 0
device area_tcb pre0 = x'FC01'
finish
finish
reply to comms control(mess_p4, mess_p5, mess_p1, 0)
return
dact(deallocated): !** device deallocated by gpc
device no = mess_p6
device to da ad(device no) = not allocated
reply to comms control(mess_p4, mess_p5, mess_p1, 0)
return
dact(go ahead): !transfer go ahead
!ie comms has paged in buffer
buffer no = mess_p2
buffer == buffer tab(buffer no)
device area == record(device to da ad(device no))
device area_goah len = buffer_length
device area_goah ad = buffer_offset
device area_buffer no = buffer no
punch: !try to punch cards
!copy a card into device area_card and spacefill. spanned cards have
!1st part in buffer and device area_posn indicates next free byte.
!device area_posn=80 indicates complete card in buffer in ebcdic
!as happens after an abnormal termination
i = device area_posn
->fire if i=80; !card all ready to fire io
j = 0
cycle
sym = byte integer(virtual+device area_goah ad+j+buffer_real address)
if device area_mode#binary start
if device area_mode=iso start
exit if sym=nl or sym=12; !control char
else
exit if sym=ebc nl or sym=ebc lf or sym=12
finish
finish
!if buffer full then treat as newline except arrange for the last char
!to become the first char on the next(overflow) card unlike the nl char
!which is discarded. nb care needed not to get blank card unnecessarily
if i>=80 then j = j-1 and exit
device area_card(i) = sym
i = i+1
j = j+1
->epage used if j>=device area_goah len
repeat
!control char found
device area_goah len = device area_goah len-(j+1)
device area_goah ad = device area_goah ad+j+1
if device area_mode#binary start
if device area_mode=iso then sym = ' ' else sym = ebc sp
device area_card(i) = sym and i = i+1 while i<80
i to e(addr(device area_card(0)), 80) if device area_mode=iso
finish
device area_posn = 80; !card read in ebcdic
if countsw(device no)=yes then countsw(device no) = no else cardcount(device no) = cardcount(device no)+1
fire:
req = 0
req_dserv = execute chain
req_sserv = cp executed
if sseries=no start
req_p1 = addr(device area_rcb0)
req_p3 = 1<<4!1
finish else req_p1 = addr(device area_tcb cmd)
req_p2 = device area_ident
req_p3 = 1<<4!1
pon(req)
return
epage used: !await next go ahead
device area_posn = i; !some iso chars in buffer
req = 0
req_dserv = transfer complete
req_sserv = cp command
req_p1 = stream no
req_p2 = 3; !please provide next page and dont recapture this one
req_p3 = buffer_length
pon(req)
return
dact(send control): !** control message
state = mess_p2>>24
->states(state)
states(connecting): !** allocate device
cardcount(device no) = 0; !initialise output accounting
countsw(device no) = no
req = 0
req_dserv = allocate device
req_sserv = cp allocated
req_p1 = m'CP0'!device no
req_p2 = cp interrupt
req_p4 = mess_p1>>16
req_p5 = stream no
pon(req); !try to allocate
return
states(disconnecting): !** deallocate device
req = 0
req_dserv = deallocate device
req_sserv = cp deallocated
req_p1 = m'CP0'!device no
req_p4 = mess_p1>>16
req_p5 = stream no
req_p6 = device no
pon(req)
return
states(enabling): !** request first page
reply to comms control(mess_p1>>16, stream no, 0, 0)
device area == record(device to da ad(device no))
device area_mode = (mess_p2>>20)&3; !iso ebc or binary
get next buffer
return
states(suspending):
states(aborting):
reply to comms control(mess_p1>>16, stream no, 0, cardcount(device no))
return
routine reply to comms control(integer act, stream no, flag, count)
rep = 0
rep_dserv = comms command!act
rep_sserv = mess_dserv
rep_p1 = stream no
rep_p2 = flag
rep_p3 = count; ! accounting info
pon(rep)
end ; !of routine reply to comms control
routine get next buffer
req = 0
req_dserv = request transfer
req_sserv = cp command
req_p1 = stream no
pon(req)
end ; !of routine get next buffer
end ; !of routine cp adaptor
finish
if monlevel&256#0 start ; !include monitoring?
if multi ocp=yes start
external routine spec semaloop(integer name sema)
own integer trace sema= -1
finish
external string fn spec h to s(integer i, p)
external integer fn spec s to i(string (255) name s)
const integer emas page size= epagesize*1024
const integer start page= x'500'; !first available page on fsys to trace to
const integer nbuffs= 2; !maybe more for fast machines & multi ocps
const integer combine sno= x'380000'
const integer page out reply= 1; !activity numbers in combine
const integer start harvest= 2
const integer page got= 3
const integer stop harvest= 4
own integer trace fsys= -1; !trace output to this fsys initially not set
own integer end page= 0; !last available e page on fsys to trace to
own integer current page= 0; !initially not set
own integer events lost= 0; !count of events lost when no buffer available
own integer buffer pointer= 0; !next free hole in current buffer
own integer current buffer= 0; !current buffer if # 0
own integer next buffer= 0; !next buffer if # 0
own integer count= 0; !count of pages claimed
record format bufferf(integer virt address, store index, link)
own record (bufferf) array buffers(1:nbuffs)
record format ddtform(integer ser, pts, propaddr, stick, stats, rqa, lba, ala, state, iw1, iw2, sense1,
sense2, sense3, sense4, repsno, base, id, dlvn, mnemonic, string (6) lab, byte integer mech)
external routine tracer(string (63) s)
!* This routine handles text commands from the operator to set up
!* and control the trace procedure. The commands handled are
!*
!* TRACE TO vollabel !Nominates disc volume trace to be logged to
!* TRACE event process !specifies which event is to be traced (-1 all)
!* and which process is to be traced (-1 all).
!* !Events can be added to but not processes.
!* TRACE ON !initiates tracing (above commands must have
!* previously been given)
!* TRACE OFF !terminates tracing. Not final trace may be
!* added to by setting trace on again.
record (pe) p
record (ddtform) name disc
string (63) label, temp
integer i, j
->set fsys if s->temp.("TO ").label and temp=""
->set on if s="ON"
->set off if s="OFF"
if trace fsys#-1 and trace=no start ; !trace fsys must first be set
!and trace not started
i = s to i(s); !get events to trace from string
if -1<=i<=31 start ; !within range
j = s to i(s); !get process to trace from string
if -1<=j<=max procs and j#0 start
!within range
if i<=0 then trace events = i else trace events = trace events!1<<i
trace process = j
return
finish
finish
finish
err:
op mess("TRACE ".s." ?")
return
set on: !start tracing check trace fsys set and events set first
->err if trace fsys=-1 or trace events=0 or trace=yes
if current page<end page start
p = 0
p_dserv = combine sno!start harvest
pon(p); !request combine to get buffers and start tracing
finish else op mess("TRACE AREA FULL")
return
set off: !stop tracing check tracing was on
->err if trace#yes
p = 0
p_dserv = combine sno!stop harvest
pon(p)
return
set fsys: !set the trace fsys checking it is there
!* CHECKS
!* WHETHER THE LABEL IS A VALID LENGTH
!* TRACING IS NOT ALREADY IN PROGRESS
!* WHETHER SPECIFIED DISC IS ON-LINE
!* THAT ITS CONSISTENCY CHECK HAS BEEN DONE
!* THAT IT IS NOT THE IPL DISC
!* THAT THE TRACE AREA DOES NOT OVERLAP THE FILE SYSTEM
!* SETS (if above checks succeed)
!* TRACE FSYS
!* END PAGE OF TRACE AREA
!* START PAGE OF TRACE AREA
if length(label)=6 and trace=no and com area_ndiscs>0 start
for i = 0, 1, com area_ndiscs-1 cycle
disc == record(integer(com area_ditaddr+4*i))
if disc_lab=label and disc_dlvn>=0 and disc_dlvn#com area_suplvn and disc_base>start page start
trace fsys = disc_dlvn; !set fsys no
end page = disc_base-1; !page before start of file system
current page = start page; !set to start of trace area
op mess("TRACE AREA ".label." X".h to s(start page, 3)." TO X".h to s(end page, 3))
exit
finish
repeat
return if trace fsys#-1
finish
->err
end ; !of routine trace
routine fill(integer length, from, filler)
!***********************************************************************
!* *
!* FILL "LENGTH" BYTES "FROM" WITH CHARACTER "FILLER" *
!* *
!***********************************************************************
*lb_length
*ldtb_x'18000000'
*ldb_ b
*lda_from
*lb_filler
*mvl_ l = dr
end ; !of routine fill
routine page out
record (pe) p
fill(emas page size-buffer pointer, buffers(current buffer)_virt address+buffer pointer, 0); !clear rest of buffer
p = 0
p_dserv = x'210002'; !write out to disc
p_sserv = combine sno!page out reply; !reply to combine
p_p1 = current buffer
p_p2 = trace fsys<<24!current page
p_p3 = buffers(current buffer)_virt address
pon(p)
current page = current page+1
if trace=yes start ; !ignore if trace over
if current page>=end page start ; !end of trace area
p = 0
p_dserv = combine sno!stop harvest
pon(p); !notify combine to stop
op mess("TRACE AREA FULL")
finish
current buffer = next buffer; !get next buffer
if current buffer#0 start ; !there was one
next buffer = buffers(current buffer)_link
!relink chain
buffer pointer = 0; !set to start of buffer
finish
finish
end ; !of routine page out
routine return buffer(integer buff no)
record (pe) p
p = 0
p_dserv = x'60000'; !return page
p_p1 = buff no
p_p2 = buffers(buff no)_store index
pon(p)
end ; !of routine return buffer
external routine harvest(integer event, proc, len, a, b, c, d, e)
integer bytes, address, ocp, i
record format dataf(byte integer event, proc, ocp, len, long integer clock, integer array a(0:4))
long integer clock
record (dataf) name data
bytes = len+12
*rrtc_0
*st_clock
if multi ocp=yes start
*lss_(3); *ush_-26
*and_3; *st_ocp
*inct_trace sema
*jcc_8, <tgot1>
semaloop(trace sema)
tgot1:
finish else ocp = 0
if current buffer#0 start ; !buffer available?
address = buffers(current buffer)_virt address+buffer pointer
data == record(address)
data_event = event; !log data in buffer
data_proc = proc
data_ocp = ocp
data_len = len
data_clock = clock
! move(len,addr(a),address+12) %if len > 0
if len>0 start
address = address+12
i = addr(a)
*ldtb_x'18000000'
*ldb_len
*lda_i
*cyd_0
*lda_address
*mv_ l = dr
finish
buffer pointer = buffer pointer+bytes
page out if buffer pointer+32>=emas page size or trace=no
!buffer nearly full or trace stops
op mess("END OF TRACE X".h to s(current page-1, 3)) if trace=no
finish else events lost = events lost+1
trace sema = -1 if multi ocp=yes
end ; !of routine harvest
external routine combine(record (pe) name p)
switch act(page out reply:stop harvest)
integer buff no
buff no = p_p1; !normally in p1
if multi ocp=yes start
*inct_trace sema
*jcc_8, <tgot2>
semaloop(trace sema)
tgot2:
finish
->act(p_dserv&x'FFFF')
act(page out reply):
op mess("TRACE PAGE OUT FAILS") if p_p2#0
if trace=yes start ; !still tracing
if current buffer=0 start ; !buffer urgently required
current buffer = buff no
buffer pointer = 0
else ; !link to free list
buffers(buff no)_link = next buffer
next buffer = buff no
finish
finish else return buffer(buff no); !tracing has stopped
trace sema = -1 if multi ocp=yes
return
act(start harvest):
p = 0
p_dserv = x'50000'; !get page
p_sserv = combine sno!page got; !reply here
p_p2 = 1; !do not zero
for buff no = 1, 1, n buffs cycle
p_p1 = buff no
pon(p)
repeat
next buffer = 0; !head of free list
count = 0; !of buffers which have arrived
trace sema = -1 if multi ocp=yes
return
act(page got):
buffers(buff no)_virt address = p_p4
buffers(buff no)_store index = p_p2
buffers(buff no)_link = next buffer; !link in to free list
next buffer = buff no
count = count+1; !count arrivals
if count=nbuffs start ; !all have arrived start harvest
current buffer = next buffer; !get first buffer from free list
next buffer = buffers(current buffer)_link
buffer pointer = 32; !leave room for a file header
events lost = 0
op mess("START OF TRACE X".h to s(current page, 3))
trace = yes
trace sema = -1 if multi ocp=yes
harvest(64, 0, 12, nbuffs, trace events, trace process, 0, 0)
!trace starts
return
finish
trace sema = -1 if multi ocp=yes
return
act(stop harvest):
while next buffer#0 cycle ; !release queued buffers
return buffer(next buffer)
next buffer = buffers(next buffer)_link
repeat
trace = no
trace sema = -1 if multi ocp=yes
harvest(65, 0, 4, events lost, 0, 0, 0, 0); !trace ends
return
end ; !of routine combine
finish
end of file