! Routines for IMP77 compatiblity with the standard ERCC IMP library.

%external %routine %spec SET RETURN CODE (%integer I)
%external %integer %fn %spec EXIST (%string(255) S)
%external %routine %spec SSFOFF
%external %routine %spec SSFON
%external %string (127) %fn %spec SSFMESSAGE
%external %routine %spec DEF INFO (%integer CHAN, %string (255) %name FILENAME, %integer %name STATUS)
%system %integer %map %spec COMREG (%integer N)
%external %routine %spec CLEAR (%string(255) PARM)
%external %routine %spec DEFINE (%string(255) PARM)
%external %integer %fn %spec IN STREAM
%external %integer %fn %spec OUT STREAM
%external %routine %spec CLOSE STREAM (%integer I)


%const %integer MAX STREAM = 7

%own %string (127) DEFAULT = ""

%external %string(63)%fn itos(%integer n, p)
   %string(255) answer
   %byteintegerarray a(0:64)
   %integer sign, sym, pt, val
   val = p
   %if p > 0 %then p = p+1 %else p = -p
   p = 63 %if p > 63
   sign = ' '
   sign = 0 %if val <= 0
   pt = 0
   %if n < 0 %start
      sign = '-'
      %if n = 16_80000000 %start
         string(addr(a(pt))) = "8463847412"
         pt = 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:
   %if sign # 0 %start
      pt = pt+1;  a(pt) = sign
   %finish
   %while pt < p %cycle
      pt = pt+1;  a(pt) = ' '
   %repeat
   answer = ""
   %cycle
      answer = answer.tostring(a(pt))
      pt = pt-1
   %repeat %until pt = 0
   %result = answer
%end

! S E C T I O N  1  -  Event handling.

%record %format EVENTFM (%integer EVENT, SUB, EXTRA, %string (255) MESSAGE)
%external %record (EVENTFM) EVENT = 0

%external %routine SIGNAL (%integer EV, S, EX)
   ! Note that %signal a,b,c should be replaced by SIGNAL (A,B,C) to fill the
   ! event record.  The EMAS only routine SET EVENT which must be spec'd 
   ! separately can be used to fill the record from an event not signaled by
   ! this routine.
   ! This has fewer restrictions on it than the EMAS %signal mechanism.
   %switch ES (0:15)

   EX=EV %and EV=6 %and S=0 %unless 0<=EV<=15; ! Event out of range.
   EVENT_EVENT = EV
   EVENT_SUB = S
   EVENT_EXTRA = EX
   -> ES (EV)

ES(0): ! Note that the ERCC don't allow this.
       %monitor %if S<0
       SET RETURN CODE (S) %if S>0
       %stop

ES(1): %signal 1, S
ES(2): %signal 2, S
ES(3): %signal 3, S
ES(4): %signal 4, S
ES(5): %signal 5, S
ES(6): %signal 6, S
ES(7): %signal 7, S
ES(8): %signal 8, S
ES(9): %signal 9, S
ES(10): %signal 10, S
ES(11): %signal 11, S
ES(12): %signal 12, S
ES(13): %signal 13, S
ES(14):
ES(15): ! This is not allowed by the ERCC, so it is signaled as 14, but
        ! The event record has the correct value.
        %signal 14, S
%end

%external %routine SET EVENT
   %on 1,2,3,4,5,6,7,8,9 %start
       EVENT = 0
       %return
   %finish
   EVENT_EVENT = EVENT INF >> 8 & 15
   EVENT_EVENT = 9 %if EVENT_EVENT=1
   EVENT_SUB = EVENT INF & 255
!   print string ("** Signal"); write (event_event,1); write (event_sub,1); newline
%end

! S E C T I O N  2   -   File handling

%external %routine SET DEFAULT (%string (5) DEF)
   DEFAULT = DEF
%end

%external %routine CLOSE INPUT
   %integer S
   S = IN STREAM
   %return %if S = 0
   SELECT INPUT (0)
   CLOSE STREAM (S)
   DEFINE (ITOS(S,0).",.NULL")
%end

%external %routine OPEN INPUT  (%integer STM, %string(255) FILE)
   %integer  ERRNO, S
   %string (255) FULL FILE, REST
   FULL FILE = FILE
   FULL FILE = FILE.DEFAULT %unless FILE -> ("#").REST %or CHARNO(FILE,1)='.'
   SIGNAL (9, 2, 0) %unless 1<=STM<=MAX STREAM
   FILE = FULL FILE %if EXIST (FULL FILE)#0
   EVENT_MESSAGE = " File does not exist" %and SIGNAL (9, 3, 0) %unless EXIST(FILE)#0 %or CHARNO(FILE,1)='.'
   SSFOFF
   S = IN STREAM;  SELECT INPUT (0);  CLOSE STREAM (STM)
   DEFINE (ITOS(STM, 0).",".FILE)
   ERRNO = COMREG(24)
   EVENT_MESSAGE = SSFMESSAGE %and SIGNAL (9, 3, ERRNO) %if ERRNO#0
   SSFON
   SELECT INPUT (S)
%end


%external %routine ABANDON INPUT
   CLOSE INPUT
%end

%external %routine RESET INPUT
   %integer I
   I = IN STREAM;  SELECT INPUT (0)
   CLOSE STREAM (I)
   SELECT INPUT (I)
%end

%external %string (255) %fn IN FILE NAME
   %string (255) FN
   %integer STATUS
   DEF INFO (IN STREAM, FN, STATUS)
   %result = FN
%end

%external %routine OPEN OUTPUT  (%integer STM, %string(255) FILE)
   %string (255) REST
   %integer ERRNO, S
   FILE = FILE.DEFAULT %unless FILE -> ("#").REST %or CHARNO(FILE,1)='.'
   SIGNAL (9, 2, STM) %unless 1 <= STM <= MAX STREAM
   SSFOFF
   S = OUT STREAM;  SELECT OUTPUT (0);  CLOSE STREAM (STM)
   DEFINE (ITOS(STM, 0).",".FILE)
   ERRNO = COMREG(24)
   EVENT_MESSAGE = SSFMESSAGE %and SIGNAL (9, 3, ERRNO) %if ERRNO#0
   SSFON
   SELECT OUTPUT (S)
%end

%external %routine CLOSE OUTPUT
   %integer S
   S = OUT STREAM
  %return %if S = 0
   SELECT OUTPUT (0)
   CLOSE STREAM (S)
   DEFINE (ITOS(S,0).",.NULL")
%end

%external %routine ABANDON OUTPUT
   ! Still to be written
   SIGNAL (10, 0, 0)
%end

%external %routine RESET OUTPUT
   %integer S
   S = OUT STREAM
   CLOSE STREAM (S)
   SELECT OUTPUT (S)
%end

%external %string (255) %fn OUT FILE NAME
   %string (255) FN
   %integer STATUS
   DEF INFO (OUT STREAM, FN, STATUS)
   %result = FN
%end

%external %integer %fn IN TYPE
   %string(255)  IN
   IN = IN FILE NAME
   %result = 0 %if IN = ".IN"
   %result = -1 %if IN = "" %or IN = ".NULL"
   %result = 1
%end

%external %integer %fn OUT TYPE
   %string(255) OUT
   OUT = OUT FILE NAME
   %result = 0 %if OUT = ".OUT"
   %result = -1 %if OUT = "" %or OUT = ".NULL"
   %result = 1
%end


!! S E C T I O N  3  -   A routine if you rely on NULL defaults

%external %routine IMP77SETUP (%string(255) NOPARM)
   %integer I

   CLEAR ("")
   DEFINE ("1,.IN")
   DEFINE (ITOS(MAX STREAM + 1, 0).",.OUT")
   %for I = 2,1,MAX STREAM %cycle
        DEFINE (ITOS(I, 0).",.NULL")
        DEFINE (ITOS(MAX STREAM + I, 0).",.NULL")
   %repeat
%end

%end %of %file