!***********************************************************************
! specs in same order as in perqimports file
%routine %spec ILAP monitor (%string (255) S)
%byte %integer %fn %spec default technology
%string (63) %fn %spec itos (%integer n, p)
%routine %spec write (%integer n, p)
%string(127)%fn %spec rtos(%real num,%integer pl,dp)
%routine %spec print(%real num,%integer pl,dp)
%integerfn %spec stoi(%string(63) s)
%integer %fn %spec REM (%integer A, B)
%routine %spec prompt(%string(63) s)
%string (15) %fn %spec timestamp
%real %fn %spec frac pt (%real r)
%routine %spec read (%integer addr, type)
%string (255) %fn %spec sub string (%string (255) st, %integer a, b)
%integerfnspec getvm(%integername size,adr)
%integerfnspec freevm(%integername size,adr)
!***********************************************************************
%externalintegerfnspec outstream
%externalroutinespec dateandtime(%integer timeref)
%externalroutinespec newseg(%shortintegername seg,%shortinteger fsize,finc,fmax)
!***********************************************************************
! Some machine specific utilities for PERQ ILAP

%external %routine ILAP monitor (%string (255) S)
   %integer I
   I = out stream
   select output (0)
   print string ("Monitor:  CPU =PERQ")
{timing info.}
   space;   space
   print string (s)
   newline
%end

%external %byte %integer %fn default technology
   %result = 'N'
%end


%external %string (63) %fn itos (%integer n, p)
   %string(63) answer
   %byteintegerarray a(0:64)
   %integer sign, sym, pt
   %if p > 0 %then p = p+1 %and sign=' ' %else p = -p %and sign=0
   p = 63 %if p > 63
   pt = 0
   %if n < 0 %start
      sign = '-'
      %if n>>16 = 16_8000 %and n&16_ffff = 0 %then %start
         string(addr(a(0))) = "8463847412"
         pt = 10
         -> set
      %finish
      n = -n
   %finish
   %cycle
      sym = n-n//10*10
      pt = pt+1
      a(pt) = sym+'0'
      n = n//10
   %repeat %until n = 0
set:
   pt = pt+1 %and a(pt) = sign %if sign#0
   pt = pt+1 %and a(pt) = ' ' %while pt<p
   answer = ""
   %cycle
      answer = answer.tostring(a(pt))
      pt = pt-1
   %repeat %until pt = 0
   %result = answer
%end

%external %routine write(%integer n,p)
  print string(itos(n,p))
%end

%external %string (127) %fn RTOS (%real NUM, %integer PL, DP)
   %string(127) bs, as
   %if NUM<0 %then bs="-" %and num = -num %else bs = " "
   bs = bs.itos (intpt (NUM), 0)
   bs = " ".bs %while length(bs) <= PL
   as = itos (int(fracpt(num) * 10\DP), 0)
   as = "0".as %while length(as) < DP
   %result = bs.".".as
%end

%external %routine PRINT (%real NUM, %integer PL, DP)
   PRINT STRING (rtos(num,pl,dp))
%end

%externalintegerfn stoi(%string(63) s)
%const %integer true=0, false=1
%integer %fn Base Ok (%integername V, %integer Base)
   %if '0' <= V <= '9' %start
      V = V-'0'
   %finish %else %if 'A' <= V&95 <= 'Z' %start
      V = V&95-'A'+10
   %finish %else %result = false
   %result = true %if V < Base
   %result = false
%end
 %integer N, P, L, Base, Sym, V, Sign
   N = 0
   L = Length(S)
   P = 0
   Base = 10
   Sign = 0
   %cycle
      %result = N %if P = L
      P = P+1;  Sym = Charno(S, P)
      %continue %if Sym = ' '
      %if Sign = 0 %start
         Sign = 1
         %if Sym = '-' %or Sym = '+' %start
            Sign = -1 %if Sym = '-'
            %continue
         %finish
      %finish
      V = Sym
      %if V = '_' %start
         Base = N;  N = 0
         %continue
      %finish
      %signal 4,1 %unless Base Ok(V, Base)=true
      N = N*Base
      %if Sign > 0 %then N = N+V %else N = N-V
   %repeat
%end

%external %integer %fn REM (%integer A, B)
   %result = A - A//B * B
%end

%external %routine prompt(%string(63) s)
  newline ; print string(s)
%end

%external %string (15) %fn timestamp
%string(80) timestr
  dateandtime(addr(timestr))    {provided by f77init}
  %result = timestr
%end

%external %real %fn frac pt (%real r)
   %result = R - intpt (r)
%end

%routine read (%integer addr, type)
   %integer sign, sym, n
   n = 0
   type = type & 255
   %signal 5, 5 %unless type = 16_41 %or type = 16_51
                             {short}          {integer}
   skip symbol %while next symbol <= ' '
   %if next symbol='-' %then skip symbol %and sign = -1 %else sign = 1
   %if '0'<=next symbol<='9' %start
       %while '0' <= next symbol <= '9' %cycle
           read symbol (sym)
           n = n * 10 + sym - '0'
       %repeat
       n = n * sign
       %if type=16_31 %start
           byte integer (addr) = n
       %finish %else %if type=16_41 %start
           half integer (addr) = n
       %finish %else %if type=16_51 %start
           integer (addr) = n
       %finish %else %signal 5, 5
   %finish %else %signal 4, 1
%end

%external %string (255) %fn substring (%string(255) s, %integer from, to)
   %string (255) res
   %integer l, new, i
   l = length(s)
   new = to-from+1
   %signal 5,4 %unless 0 < from <= L %and to <= L %and new >= 0
   res = ""
   res = res.tostring(charno(s,i)) %for i = from, 1, to
   %result = res
%end

%externalintegerfn getvm(%integername size {in words!} ,adr)
%constinteger maxblk=32
%owninteger seg=0,disp=0
%shortinteger sseg
%integer i,j,k
  %if seg=0 %then newseg(sseg,4,4,maxblk) %and seg=sseg
  adr=seg<<16!disp
  disp=disp+(size+1)>>1<<1    {align on double word boundary just in case!}
  %if disp>maxblk*256 %then print string("heap exhausted") %and %stop
  %result=1    {success}
%end

%externalintegerfn freevm(%integername size,adr)
! ignore - no garbage collection implemented!
  %result=1    {success}
%end

%endoffile