%conststring (13) vsn = "infons....1a "
#datestring
#timestring

!********************************
!*  emas-2900  fep  info server *
!*   file: infos/infosy         *
!*  New Style                   *
!********************************


#options
! prep versions are:-
!
!   f = front ends (all of them)
!   c = Xcall
!   g = Xgate
!   t = fstore
!   a = Amdahl Feps
!   b = big buffer manager (also use i)
!   i = New compiler
!

#if i
%control x'4001'
#else
%control 1
#fi
#if i
%include "b_deimosspecs"
#else
%include "deimosperm"
#fi



%begin

#if ~b
%recordformat lev3f(%byteintegerarray reserved(0:7), %c
       %byteintegerarray a(0:239))
%recordformat mef(%record(mef)%name link,%byteinteger len,type,  %c
   (%record(lev3f) lev3 %or %bytearray params(0:241)))

%recordformat pf(%byteinteger ser,reply,(%byte fn,ss1,  %c
%record(mef)%name mes,%byteinteger gate port, task port %or %c
  %byte a1, a2, b1, b2, c1, c2))
#else
%recordformat lev3f(%bytearray reserved(0:5), %bytearray a(0:239))

%recordformat mef(%integer buff no, len, %byte owner, type, %c
    (%record (lev3f) lev3 %or %bytearray params(0:241)))

%recordformat pf(%byte ser, reply, (%byte fn, ss1, %c
%integer buff no, %byte gate port, task port %or %c
 %byte a1, a2, b1, b2, c1, c2))
#fi

      %recordformat qf(%record (mef) %name e)


      !************************************************************
      !*  upper level (itp&info) handler messages to gate
      !************************************************************
     %include "b_ygatecalls"
      !**************************************************************
      !*         buffer manager calls   (from and to)               *
      !**************************************************************
!     %constinteger buffer here = 0
      !********** to buffer manager ***********
      %constinteger request buffer = 0
      %constinteger release buffer = 1

      !********** various service numbers *************
      %constinteger gate ser = 24
      %constinteger buffer manager = 17

      %constinteger t port = 25;   ! dummy
      %constinteger t3 ser = 21

#if b
      %record (mef) %mapspec map(%integer buff no)
#fi
      %routinespec free buffer(%record (mef) %name mes)
      %routinespec do enable facility(%string (11) address)
      %routinespec to gate(%integer fn, %record (mef) %name mes, %c
        %integer flag)


      !******************************************************
      %record (pf) p

      !* * * * * * * * * * * * * * * * * * 
 
      %constintegername users == k'100014'; ! no of users in buffer seg
      %ownrecord (mef) %name mes
      %ownrecord (lev3f) %name lev3
      %owninteger mon = 0;              ! monitoring flag (set to 'P')
      %owninteger fn = 0, a2 = 0, a, b, c, marku, markser

      %ownstring (63) s, t

      ! l o g g i n g   o n


      %integer i


      !**********************************************
      !*      initialisation                        *
      !**********************************************

      #if i
      use tt(t3 ser)
      #else
      change out zero = t3 ser
      #fi


#if ~b
      i = map virt(buffer manager, 5, 4);   ! map buff man stack to seg 4
      i = map virt(buffer manager, 6, 5)
#else
      i = map virt(buffer manager, 6, 4);   ! get its stack base
#fi

#if f
      p_ser = 0; poff(p);        ! wait for instructions
      a = p_fn; b = p_a2; c = p_c1
         %if a = 7 %then s = "2972-0" %else s = "2988-0"
         charno(s, 6) = b+'0'
#else
#if c
       s = "XCALL"
#else
#if a
      s = "EMASA1"
#else
#if ~t
      s = "PSSE"
#else
      s = "FSTORE"
#fi
#fi
#fi
#fi

      printstring(vsn)
      printstring(s); space
      printstring(datestring); newline
      do enable facility("INFO")

      alarm(500)

      %cycle
         p_ser = 0; poff(p)

         %if p_reply = 0 %start;  ! clock tick
            alarm(500)
            %if 'M' <= int <= 'P' %start
               mon = int-'O'; int = 0
            %finish
            %continue
         %finish

#if ~b
         mes == p_mes
#else
         %if p_buff no = 0 %then mes == null %else %c
           mes == map(p_buff no)
#fi
         fn = p_fn; a2 = p_a2
         %if mon # 0 %start
            printstring("From Gate, fn="); write(fn, 1)
            printstring(", G Port ="); write(p_gate port, 1)
            printstring(", T Port ="); write(p_task port, 1)
            printstring(", Flag ="); write(a2, 1)
            newline
         %finish
      p_task port = t port


      %if p_fn = Connect %start
         To Gate(accept call, null, 0)

           { NB Buffer can be SHORT}
         p_task port = t port
         lev3 == mes_lev3
         lev3_a(i) = 0 %for i = 0, 1, 91
         mes_len = 0
         string(addr(lev3_a(1))) = s
         %if mon # 0 %then write(users, 1) %and newline
         lev3_a(0) = 0
         lev3_a(1) = x'86' ; ! marker for new response
         %if users < 0 %then marku = 0 %and markser = 1 %else %c
                             marku = users %and markser = 2
         lev3_a(15) = markser
         lev3_a(17) = marku
       { _a(18) annd _a(19) are total emas users}
         lev3_a(20) = x'ff'
       { _a(20) indication of system load}
       { _a(21) to _a(64) - reserved}
       { _a(65) to _a(127) - alert text}
         string(addr(lev3_a(64))) = "EMAS Service on Amdahl V7"
         lev3_a(64) = 0;    ! no string length - this is in previous field
         mes_len = 65+26
         To Gate(Put Output, Mes, 0)
         %continue
      %finish

      %if p_fn = disconnect %start
         to gate(disconnect, mes, 0) %unless a2 = 1
         %continue
      %finish

      %unless mes == null %then free buffer(mes)
      to gate(disconnect, null, 0) %unless fn = enable output

      %repeat

     %record (mef) %map map(%integer buff no)
        ! New compiler  - so must get 0
        *mov_1,0
        *mov_#10,1;     ! desired vm seg no *2 ie 4*2
        *iot
        %result == record(k'120000')
     %end
#if b
      %routine free buffer(%record (mef) %name mes)
         %record (pf) p
         %integer buff no
      
             ! nb: routine ASSUMES buffer is mapped on
         buff no = mes_buff no
         %unless mes == null %start
            !There really is a buffer
               !Tell Buffer Manager it can have its buffer back.
               p_ser = buffer manager ;p_reply = id
               p_fn = release buffer
               p_buff no = buff no
               pon(p)
         %finish
      %end ;!of Free Buffer
#else

      %routine free buffer(%record (mef) %name mes)
         %record (pf) p
            p_ser = buffer manager; p_reply = own id
            p_fn = release buffer; p_mes == mes
            pon(p)
      %end
#fi

      %routine do enable facility(%string (11) address)
            p_ser = buffer manager; p_reply = id
            p_fn = request buffer
            ponoff(p)
            p_ser = gate ser; p_reply = own id
            p_fn = enable facility; p_a2 = 1
#if b
            mes == map(p_buff no)
            mes_owner = own id
#else
            mes == p_mes
#fi
            string(addr(mes_params)) = address
            pon(p)
      %end

      %routine crunch
         printstring("Info - crashed
")
         *=k'104001'
      %end

      %routine to gate(%integer fn, %record (mef) %name mes, %c
         %integer flag)

        %if mon # 0 %start
             select output(0); printstring("To gate:"); write(fn, 1)
             printstring(", Gate Port"); write(p_gate port, 1)
            printstring(", Flag"); write(flag, 1); newline
            select output(0)
          %finish

         %if addr(mes)&k'140000'=k'140000' %or addr(mes)&k'77'#0 %then crunch

         p_ser = gate ser; p_reply = own id
         p_fn = fn
#if b
         %if mes == null %then p_buff no = 0 %else p_buff no = mes_buff no
#else
         p_mes == mes
#fi
         p_a2 = flag
         pon(p)
      %end

%endofprogram