!!
!!*********************************************
!!                                            *
!! EMAS INTERFACE TO OMFOUT (OMF GENERATOR)   *
!!          VERSION 3                         *
!!                                            *
!!*********************************************
!!
SYSTEMINTEGERFNSPEC  OMFOUT( C 
   INTEGER  OPSYS, ATEMP, AWRK, CONTROL, LANG CODE, ADATE,  C 
   ATIME, STRING  (7) SUBNAME, STRING  (4) VERSION,  C 
   STRING  (31) MODULE NAME, MRTPREFIX, CEPREFIX)
EXTERNALROUTINESPEC  OPENOMF(STRING  (32) S, INTEGER  CH, MODE)
EXTERNALROUTINESPEC  WRITE OMF(INTEGER  CH, A, L)
EXTERNALROUTINESPEC  DESTROY(STRING (17) S)
EXTERNALROUTINESPEC  CLOSEOMF(INTEGER  CH)
SYSTEMROUTINESPEC  CONNECT(STRING  (15) S,  C 
   INTEGER  ACCESS, MAXBYTES, PROTECTION,  C 
   RECORDNAME  R, INTEGERNAME  J)
RECORDFORMAT  INRFM(INTEGER  CONAD, FILESIZE,  C 
   BYTEINTEGER  DUM1, DUM2, DUM3, DUM4,  C 
   STRING  (6) DUM5, INTEGER  TYPEDUM6,  C 
   INTEGER  DATASTART, DATAEND, DUM7)
SYSTEMROUTINESPEC  OUTFILE(STRING  (15) S,  C 
   INTEGER  LENGTH, MAXBYTES, PROTECTION,  C 
   INTEGERNAME  CONAD, J)
EXTERNALSTRING  (8) FNSPEC  DATE
EXTERNALSTRING  (8) FNSPEC  TIME
SYSTEMINTEGERMAPSPEC  COMREG(INTEGER  N)
SYSTEMROUTINESPEC  MOVE(INTEGER  L, F, T)
SYSTEMROUTINESPEC  PHEX(INTEGER  N)
SYSTEMROUTINESPEC  ITOE(INTEGER  A, L)
EXTERNALROUTINESPEC  COPY(STRING  (63) S)
EXTERNALROUTINESPEC  DEFINE(STRING  (63) S)
SYSTEMROUTINESPEC  SSERR(INTEGER  N)
!!

!!
ROUTINESPEC  OPUT(STRING (63) S)
OWNINTEGER  SYS=0
EXTERNALROUTINE  COBJ(STRING (63) S)
SYS=1
OPUT(S)
END 
!!
EXTERNALROUTINE  OPUT(STRING  (63) S)
OWNSTRING  (63) SOUTFILE = "NR#OMF",MODULE NAME
STRING  (18) DATIME
STRING  (4) VERSION
STRING  (7) SUBNAME
INTEGER  I, J, ATEMP, AWRK
STRING  (63) SINFILE
STRING  (32) SLISTFILE,BEFORE,AFTER
INTEGER  CONTROL
RECORD  IN(INRFM)
!!
!!
      UNLESS  S -> SINFILE.(",").SOUTFILE C   
         THEN   SINFILE = S
   UNLESS  SOUTFILE -> SOUTFILE.(",").SLISTFILE C 
      THEN  SLISTFILE = ".OUT"
   DEFINE("STREAM01,".SLISTFILE)
   SELECT OUTPUT(99)
   PRINTSTRING("
OPUT R3 V 8/5/80
")
   UNLESS  SLISTFILE = ".OUT" START 
      PRINTSTRING("
    INPUT: ".SINFILE."  OUTPUT: ".SOUTFILE)
      NEWLINE
   FINISH 
   SELECT OUTPUT(1)
   COPY(SINFILE.",SS#TMPOB")
   VERSION = "3.09"   ;! MUST BE FOUR CHARACTERS
   ITOE(ADDR(VERSION)+1,3)
IF  SYS=0 THEN     SUBNAME = "ENV " ELSE  SUBNAME="EXP "
   ITOE(ADDR(SUBNAME)+1,4)
   CONNECT("SS#TMPOB",3,0,0,IN,J)
   SSERR(J) UNLESS  J = 0
  IF  INTEGER(IN_CONAD+12)#1 START 
       PRINTSTRING("
INPUT MUST BE AN OBJECT FILE!
")
STOP 
FINISH 
   ATEMP = IN_CONAD
   OUTFILE("SS#WRK",X'80000',0,0,AWRK,J)
   IF  J = 218 THEN  AWRK = COMREG(14) AND  J = 0
   SSERR(J) UNLESS  J = 0
   OPENOMF(SOUTFILE,2,1)
   CONTROL = COMREG(26)!32;          ! OR IN SHARE 
   IF  SYS=0 THEN  CONTROL=CONTROL!16!32   ;! LIBRARY AND EXCLUSIVE
   DATIME = '19'.DATE.TIME;             ! HAVE TO RE-ARRANGE DATE AND TIME TO ICL FORMAT
   J = ADDR(DATIME);                    ! DD/MM/YY -> 19YY/MM/DD
   MOVE(2,J+3,ADDR(I))
   MOVE(2,J+9,J+3)
   MOVE(2,ADDR(I),J+9)
   ITOE(J+1,18)
IF  SOUTFILE->BEFORE.("_").AFTER THEN  SOUTFILE=AFTER
    IF  SYS=1 THEN  MODULENAME=SOUTFILE ELSEC 
   MODULENAME="ICL9CE".SOUTFILE
   I = OMFOUT(0,ATEMP,AWRK,CONTROL,X'C7',ADDR(DATIME)+1,ADDR( C 
      DATIME)+11,SUBNAME,VERSION,MODULENAME,"","")
CLOSEOMF(2)
DESTROY("SS#WRK")
DESTROY("SS#TMPOB")
   SELECTOUTPUT(99)
   IF  I = 0 THEN  PRINTSTRING("
NO ERRORS ") ELSESTART 
PRINTSTRING("
OMF GEN FAILS: ")
WRITE(I,1)
IF  I=243 THEN  PRINTSTRING(" CORRUP FIXUP ")
IF  I=226 THEN  PRINTSTRING(" CORRUPT OBJECT FILE ")
IF  I=244 THEN  PRINTSTRING(" TOO MANY CHS ")
IF  I=248 THEN  PRINTSTRING(" WORKFILE FULL ")
FINISH 
END 
!!
!!******************
!!
SYSTEMINTEGERFN  SET ALIAS(INTEGER  DR0,DR1)
RESULT  = 0
END 
!!
!!*************************
!!
SYSTEMINTEGERFN  OMFRECORD(INTEGER  DR0,DR1)
INTEGER  I
IF  COMREG(26)&X'800000'#0 START 
   PRINTSTRING("OMFRECORD: ")
   PHEX(DR1)
   SPACE
   PHEX(DR0&X'FFFFFF')
   NEWLINE
CYCLE  I=0,4,28
PHEX(INTEGER(DR1+I))
SPACE
REPEAT 
FINISH 
WRITEOMF(2,DR1,DR0&X'FFFFFF')
RESULT  = 0
END 
!!
ENDOFFILE