const integer rtable entry size= 160
const integer max recipients= 512
const integer file header size= 32; !SS STANDARD FILE HEADER SIZE
const integer already exists= 16; !DIRECTOR FLAG
const integer r= b'00000001'; !READ PERMISSION
const integer w= b'00000010'; !WRITE PERMISSION
const integer shared= b'00001000'; !ALLOW OTHERS ACCESS
const integer zerod= b'00000100'; !ZERO FILE ON CREATION
const integer tempfi= b'00000001'; !TEMP FILE ON CREATION
const integer epage size= 4096
const long integer secs70=x'0000000083AA7E80'; ! secs dittom
const integer abasefile= 32<<18; !address of basefile
const integer max instructions= x'FFFFFFF'
const string (1) snl= "
"
external integer my fsys; !file system of process
external integer my service number; !service number i recieve messages on
external integer com36; !restart area
external integer bottom of stack; !point to which stack is unwound during diagnostics
external integer oper no
external string (6) my name; !name of process
system routine spec ndiag(integer pcount, lnb, fault, inf)
external integer fn spec prime contingency(routine ontrap)
external routine spec dresume(integer a, b, c)
external integer fn spec readid(integer adr)
external integer fn spec dset ic(integer k ins)
external string (8) fn spec h to s(integer value, places)
external routine spec send and define(integer strm, size, string (15) q)
external routine spec control(integer rtable conad)
external integer fn spec ddestroy(string (6) user, string (11) file, string (8) date, integer fsys, type)
external string fn spec derrs(integer flag)
external integer fn spec dconnect(string (6) user, string (11) file, integer fsys, mode, apf,
integer name seg, gap)
external integer fn spec ddisconnect(string (6) user, string (11) file, integer fsys, destroy)
external integer fn spec dcreate(string (6) user, string (11) file, integer fsys, nkb, type)
record format fhf(integer end, start, size, type, free hole, datetime, anon link, version)
record format dirinff(string (6) user, string (31) batch cmd file, integer mark, fsys, procno, isuff, reason,
batch id, sess ic lim, scidensad, scidens, startcnsl, msgfad, sct date, sync1 dest, sync2 dest, async dest)
routine fill system calls(integer sctable, count)
! this routine fills in the system call descriptors in the bgla
! using information in a table at sctable. the information
! consists of an i and j value for each of the director routines
! which can be accessed by system call.
! this version updated 22.8.78 for new object file format. rrm.
record format tabf(string (31) name, integer i, j)
record (tabf) array format tablef(1:count)
record (tabf) array name table
record format epreff(integer link, refloc, string (31) iden)
record (epreff) name epref
integer ld, loc, link, p, abgla
abgla = abasefile+((integer(abasefile)+x'3FFFF')&x'FFFC0000')
!basegla starts at first free seg beyond basefile
table == array(sctable, tablef); !map array table onto the system call table
ld = abasefile+integer(abasefile+24); !start of base load data
link = integer(ld+28); !top of epref list
while link#0 cycle
epref == record(link+abasefile); !map each ref onto epref
loc = (epref_refloc&x'FFFFFF')+abgla; !address of plt descriptor
if integer(loc)=m'NORT' start
cycle p = 1, 1, count; !look through sctable
if table(p)_name=epref_iden start
integer(loc) = x'E3000000'!table(p)_i
!sys call descriptor
integer(loc+4) = table(p)_j
!second word
exit
finish
repeat
finish
link = epref_link
repeat
link = integer(ld+28)
while link#0 cycle ; !check for any refs not yet satisfied
epref == record(link+abasefile)
print string(epref_iden." NOT IN SYSTEM CALL TABLE".snl) if integer((epref_refloc&x'FFFFFF')+abgla)=m'NORT'
link = epref_link
repeat
end ; !of fill system calls
routine on trap(integer class, sub class)
! called when a contigency occurs. reads the interrupt data and
! calls the diagnostic routine which returns to a previously defined
! enviroment.
integer array a(0:31)
integer flag, i, caddr
caddr = addr(a(0))
flag = read id(caddr); !read interupt data from director
if flag=0 start ; !interrupt data read ok?
select output(0)
print string("ON TRAP ROUTINE ENTERED CLASS =")
write(class, 2)
print string(" SUB CLASS =")
write(subclass, 2)
printstring(snl."SSN/LNB PSR PC SSR "." SSN/SF IT IC CTB ".snl)
cycle i = 0, 4, 28
print string(h to s(integer(caddr+i), 8)." ")
repeat
print string(snl." XNB B DR0 DR1 "." A0 A1 A2 A3".snl)
cycle i = 32, 4, 60
printstring(h to s(integer(caddr+i), 8)." ")
repeat
printstring(snl." XTRA1 XTRA2".snl)
cycle i = 64, 4, 68
print string(h to s(integer(caddr+i), 8)." ")
repeat
newline
if class=64 or class=66 start ; !timer interrupt or operator message ignore
if flag=64 start ; !run out of instructions
flag = dset ic(max instructions); !ask for more
print string("SET IC X".h to s(max instructions, 8)." FAILS ".derrs(flag).snl) if flag#0
finish
dresume(0, 0, caddr); !resume where we were on interrupt
finish
if class=65 start ; !single character ints
->exit if sub class='A'; !abort
if sub class#'Q' start
print string(myname." INT:".to string(subclass)." ?".snl)
dresume(0, 0, caddr)
finish
!ignore unless int 'q'
sub class = 213
class = 0
finish else sub class = 10
dresume(-1, 0, 0); !allow more ints
ndiag(a(2), a(0), sub class, class)
finish else print string("READ ID FAILS ".derrs(flag).snl)
exit: !to a known enviroment
dresume(-1, 0, 0); !note exit from ontrap
print string(myname." ABORTED".snl)
i = com36
stop if i=0
*lln_i
*exit_0
end ; !of routine on trap
integer fn current packed dt
!***********************************************************************
!* gives current dt in new packed form *
!***********************************************************************
const long integer mill=1000000
*rrtc_0; *ush_-1
*shs_1; *ush_1
*imdv_mill
*isb_secs70; *stuh_ b
*or_x'80000000'
*exit_-64
end
routine connect create(string (11) file, integer size, conmode, conapf, createmode, integer name caddr)
integer seg, gap, flag
record (fhf) name file header
seg = 0; gap = 0
caddr = 0
flag = ddisconnect(myname, file, myfsys, 1)
flag = ddestroy(myname, file, "", myfsys, 0)
flag = dcreate(myname, file, myfsys, (size+1023)>>10, createmode)
if 0#flag#already exists start
printstring("Dcreate ".myname.".".file." fails ".derrs(flag).snl)
return
finish
flag = dconnect(myname, file, myfsys, conmode, conapf, seg, gap)
if seg=0 start
printstring("Dconnect ".myname.".".file." fails ".derrs(flag).snl)
return
finish
caddr = seg<<18
file header == record(caddr)
file header_end = file header size
file header_start = file header size
file header_size = (size+epage size-1)&(-epage size)
file header_datetime = current packed dt
end ; !of connect create
system routine ssinit(integer mark, adirinf)
! this is the routine called by assembler loader 'ssld02'
! it just calls 'fill system calls' and then control
record (dirinff) name dirinf
integer flag, rtable conad, size
*stln_flag
bottom of stack = flag; !diags go no further back than this routine
dirinf == record(adirinf)
myname = dirinf_user
my fsys = dirinf_fsys
my service number = dirinf_sync1 dest
oper no = dirinf_start cnsl
fill system calls(dirinf_scidensad, dirinf_scidens)
flag = prime contingency(on trap); !to catch contingencies
print string("PRIME CONTINGENCY FAILS ".derrs(flag).snl) if flag#0
send and define(1, 64, "JOURNAL")
size = max recipients*rtable entry size+file header size
connect create("RTABLE", size, r!w, 0, zerod!tempfi, rtable conad)
dresume(-2, 0, 0); !now allow async ints
if rtable conad#0 then control(rtable conad) else printstring("MAILER not started".snl)
stop ; !if a return is made
end ; !of ssinit
end of file