constinteger amdahl = 369, xa = 371
CONSTSTRING (1) SNL = "
"
INCLUDE "TARGET"
if TARGET = 2900 start { machine specific constants }
conststringname DATE = X'80C0003F'
conststringname TIME = X'80C0004B'
constinteger SEG SHIFT = 18
finish { 2900 }
!
if TARGET = 370 start
constinteger SEG SHIFT = 16
finish
!
if TARGET = XA or TARGET = AMDAHL start
constinteger SEG SHIFT = 20
finish
!
unless TARGET = 2900 start
constinteger com seg = 31
conststringname DATE = COM SEG << SEG SHIFT + X'3B'
conststringname TIME = COM SEG << SEG SHIFT + X'47'
constinteger uinf seg = 239
finish
!*
!
!<TMODEF
recordformat c
TMODEF(byte FLAG0, FLAG1, FLAG2, FLAG3,
{.04} byteinteger PROMPTCHAR, ENDCHAR,
{.06} bytearray BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))} ,
{.0A} byteinteger PADS, RPTBUF, LINELIMIT, PAGELENG,
{.0E} byteintegerARRAY TABVEC(0:7),
{.16} byteinteger CR, ESC, DEL, CAN,
{.1A} byteinteger FLAGS, INTERNAL STATE, LEADIN1, LEADIN2, XLO, XHI)
{.20}
!<UINFF
recordformat c
DIRINFF (string (6)USER, string (31)JOBDOCFILE,
{.28} integer MARK, FSYS,
{.30} PROCNO, ISUFF, REASON, BATCHID,
{.40} SESS LIMIT, INT COUNT, I2, STARTCNSL,
{.50} AIOSTAT, SCT DATE, SYNC1 DEST, SYNC2 DEST,
{.60} ASYNC DEST, AACCT REC, I3,
{.6C} string (15)JOBNAME,
{.7C} string (31)BASEFILE,
{.9C} integer I4,
{.A0} ITADDR0, ITADDR1, ITADDR2, ITADDR3,
{.B0} ITADDR4, STREAM ID, DIDENT, SCARCITY,
{.C0} PREEMPTAT, string (11)SPOOLRFILE,
{.D0} integer FUNDS, SESSLEN, PRIORITY, DECKS,
{.E0} DRIVES, PART CLOSE,
{.E8} record (TMODEF)TMODES,
{108} integer PSLOT,
{10C} string (63)ITADDR,
{14C} integerarray FCLOSING(0:3), integer CLO FES,
{160} integer OUTPUT LIMIT, I5, I6, I7,
{170} integer OUT, string (15)OUTNAME,
{184} integer HISEG,
{188} string (31)FORK,
{1A8} integer INSTREAM, OUTSTREAM,
{1B0} integer DIRVSN, I8, SCT BLOCK AD,
integer PROTOCOL,
byteinteger ISEPCHL, ISEPCHR, USEPCH, GSEPCH,
string (1)ISEPL, ISEPR, USEP, GSEP,
{ thus a simple filename has the form: }
{ user USEP file }
{ while a complex one has the form: }
{ user ISEPL index ISEPR USEP group GSEP group GSEP file }
integer CLASS, SUBCLASS,
integer UEND)
if TARGET = 2900 start
externalroutinespec dresume(integer a, b, c)
EXTERNALINTEGERFNSPEC PRIME CONTINGENCY(ROUTINE ON TRAP)
externalstringfnspec derrs(integer i)
externalintegerfnspec dsfi(string (6) user, integer i,j,k,l)
finish else start {NON 2900}
EXTERNALINTEGERFNSPEC DPRIME CONTINGENCY(ROUTINE ON TRAP)
externalintegerfnspec dflag(integername flag, stringname txt)
externalintegerfnspec dasyncinh(integername act)
externalintegerfnspec dsfi(stringname file index,integername fsys,
type, set, stringname s, integerarrayname i)
finish {NON 2900}
externalroutinespec print log(integer stream, q)
externalroutinespec control(integer lines, database conad, pointers addr)
externalroutinespec read ft config( c
string (6) iu, ou, integer ifs, ofs,
string (11) if, of,integername lines, database conad, pointers addr)
externalroutinespec on trap
stringfnspec errs(integer flag)
externalinteger my fsys; !FILE SYSTEM OF PROCESS
externalinteger my service number; !SERVICE NUMBER I RECIEVE MESSAGES ON
externalinteger com36; !RESTART AREA
externalinteger bottom of stack; !POINT TO WHICH STACK IS UNWOUND DURING DIAGNOSTICS
externalinteger oper no; !OUTPUT MESSAGES TO THIS OPER
externalstring (6) my name; !NAME OF PROCESS
constinteger abasefile = 32<<SEG SHIFT; !ADDRESS OF BASEFILE
constinteger max fsys = 99
constinteger jrnl = 0
constinteger max instructions = x'FFFFFFF'
conststring (11) config file = "CFILE"
!*
!*
!*
stringfn errs(integer flag)
integer i; string (63) error
if TARGET = 2900 then result = derrs(flag) else START
i = dflag(flag,error)
result = error
FINISH
end
if TARGET = 2900 start
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. *
!* *
!***********************************************************************
recordformat tabf(string (31) name, integer i, j)
record (tabf)arrayformat tablef(1 : count)
record (tabf)arrayname table
recordformat epreff(integer link, refloc, string (31) iden)
record (epreff)name epref
integer ld, loc, link, p, abgla
abgla = abasefile+((integer(abasefile)+x'3FFFF')& c
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) c
if integer((epref_refloc&x'FFFFFF')+abgla) = m'NORT'
link = epref_link
repeat
end ; !OF FILL SYSTEM CALLS
!*
systemroutine ssinit(integer mark, adirinf)
!**********************************************************************
!* *
!* THIS IS THE ROUTINE CALLED BY ASSEMBLER LOADER 'SSLD02' *
!* IT JUST CALLS 'FILL SYSTEM CALLS' AND THEN CONTROL *
!* *
!**********************************************************************
string (31) filename
string (11) file
string (6) user
record (dirinff)name dirinf
integer flag, lines, database conad, pointers addr
*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_INT COUNT, DIRINF_I2)
flag = prime contingency(on trap); !TO CATCH CONTINGENCIES
print string("PRIME CONTINGENCY FAILS ".errs(flag).snl) c
if flag # 0
print log(1,jrnl)
filename = ""
flag = dsfi(my name,my fsys,2,0,addr(filename))
print string("GET CONFIG FROM INDEX FAILS ".errs(flag).snl) c
if flag # 0
unless filename -> user.(".").file start
user = ""
file = ""
finish
read ft config(user,myname,-1,myfsys,file,config file, lines, database conad,pointers addr)
dresume(-2,0,0); !NOW ALLOW ASYNC INTS
control(lines, database conad,pointers addr)
stop ; !IF A RETURN IS MADE
end ; !OF SSINIT
finish else start {NON 2900}
externalroutine start
!**********************************************************************
!* *
!* THIS IS THE ROUTINE CALLED BY DIRECTOR *
!* *
!**********************************************************************
string (31) filename
string (11) file
string (6) user
integerarray dsfiia(0:31)
record (dirinff)name dirinf
integer flag, lines, database conad, pointers addr
*st_10,flag
bottom of stack = flag
dirinf == record(uinf seg << seg shift)
myname = dirinf_user
my fsys = dirinf_fsys
my service number = dirinf_sync1 dest
oper no = dirinf_start cnsl
flag = Dprime contingency(on trap); !TO CATCH CONTINGENCIES
print string("PRIME CONTINGENCY FAILS ".errs(flag).snl) c
if flag # 0
print log(1,jrnl)
filename = ""
flag = dsfi(my name,my fsys,2,0,filename,dsfiia)
print string("GET CONFIG FROM INDEX FAILS ".errs(flag).snl) c
if flag # 0
unless filename -> user.(".").file start
user = ""
file = ""
finish
read ft config(user,myname,-1,myfsys,file,config file, lines, database conad,pointers addr)
flag = dasyncinh(0); !NOW ALLOW ASYNC INTS
control(lines, database conad,pointers addr)
stop ; !IF A RETURN IS MADE
end ; !OF start
finish {NON 2900}
!*
!*
!*
endoffile