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  define(integer  strm, size, string  (15) q)
externalroutinespec  control( c 
   integer  max fsys, queues, qconad, remotes, rconad, streams,
   sconad, qnconad,snconad,rnconad, link list conad)
externalroutinespec  read spool config( c 
   string  (6) iu, ou, integer  ifs, ofs,
   string  (11) if, of,
   integername  qs, qconad, rmts, rconad, strms, sconad, 
   integername  qnconad,snconad,rnconad, link list conad)
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, queues, remotes, streams, qconad, rconad,
      sconad, stconad, cstreams, ftp table conad,qnconad,snconad,rnconad, link list conad
   *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
   define(1,64,".JOURNAL")
   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 spool config(user,myname,-1,myfsys,file,config file,
      queues,qconad,remotes,rconad,streams,sconad,
      qnconad,snconad,rnconad, link list conad)
   dresume(-2,0,0);                     !NOW ALLOW ASYNC INTS
   control(max fsys,queues,qconad,remotes,rconad,streams,sconad,
       qnconad,snconad,rnconad, link list conad) if  qconad # 0 and  sconad # 0
   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, queues, remotes, streams, qconad, rconad,
      sconad, stconad, cstreams, ftp table conad,qnconad,snconad,rnconad, link list conad
   *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
   define(1,64,".JOURNAL")
   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 spool config(user,myname,-1,myfsys,file,config file,
      queues,qconad,remotes,rconad,streams,sconad,
      qnconad,snconad,rnconad, link list conad)
   flag = dasyncinh(0);                     !NOW ALLOW ASYNC INTS
   control(max fsys,queues,qconad,remotes,rconad,streams,sconad,
       qnconad,snconad,rnconad, link list conad) if  qconad # 0 and  sconad # 0
   stop ;                               !IF A RETURN IS MADE
end ;                                   !OF start

finish   {NON 2900}

!*
!*
!*
endoffile