I/%CONTROL X'0FFFFFFF'///
#INS 1
!!*************************************************************
!!
!!  OMFOUT
!!
!!  EDINBURGH'S IMP MODULE OMF8
!!  ADAPTED FOR USE IN BSV35/KSV17 PASCAL SYSTEM (PASCAL 20)
!!
!!  T.MOORE    MARCH '80
!!
!!*************************************************************
!!
#ALT 53-57
%EXTERNALINTEGERFNSPEC ICL9HNCREATEALIAS ( %C
          %INTEGER NAMEDRO,NAMEDR1,DUMDRO,DUMDR1)
%EXTERNALINTEGERFNSPEC ICL9HNOUTPUTRECORD(%INTEGER BUFFERDRO,BUFFERDR1)
#INS 63
%ROUTINESPEC MOVE (%INTEGER LENGTH,FROM,TO)
%ROUTINESPEC PHEX (%INTEGER N)
#INS 77
%INTEGERFNSPEC OMFRECORD (%INTEGER BUFFDRO,BUFFDR1)
%ROUTINESPEC EXITOMFOUT (%INTEGER RESULTVALUE)
#INS 118
%CONSTINTEGER OMF FILE WRITE FAILURE = 1000000
%CONSTINTEGER OMF CREATEALIAS FAILURE = 1000001 
#INS 214
%INTEGER LNB OF OMFOUT
#INS 222
   *STLN_LNB OF OMFOUT
#
T789 R/C3C5D9D9/D3D7D7D4/ R/CERR/LPPM/
DEL 791-793
T794 R/+5/+4/ D/+I/
#INS 863
!!
!!***********
!!  MOVE
!!
   %ROUTINE MOVE (%INTEGER LENGTH,FROM,TO)
   %INTEGER I
       %RETURNIF LENGTH <= 0
       I = X'18000000'!LENGTH
       *LSS_FROM
       *LUH_I
       *LDTB_I
       *LDA_TO
       *MV_%L=%DR
   %END
!!
!!***********
!!  PHEX
!!
   %CONSTINTEGERARRAY HX(0 : 15) = %C
   '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
   %ROUTINE PHEX (%INTEGER N)
   %INTEGER I,J,H
       H = ADDR(N)
       %CYCLE I = 0,1,3
          J = BYTEINTEGER(I+H)
          PRINTSYMBOL(HX(J>>4))
          PRINTSYMBOL(HX(J&15))
       %REPEAT
   %END
#
T1221./SSMESSA/ P./%C/
T+1 D/%AND/
T1241 I$      %STRING (32) SEBCDIC$$$
T1243 I$          SEBCDIC = S
          ITOE (ADDR(SEBCDIC)+1, LENGTH(SEBCDIC))
          I = ICL9HNCREATEALIAS (X'18000000'!LENGTH(SEBCDIC), %C
                                 ADDR(SEBCDIC)+1, 0, 0)
$
P+1
I$      %IF I>0 %THEN EXITOMFOUT(OMF CREATEALIAS FAILURE)$$$
?INS 1247
!!**************************************
!! PROCEDURE TO WRITE OMF RECORD
!!
   %INTEGERFN OMFRECORD (%INTEGER BUFFDRO,BUFFDR1)
   %INTEGER RC
      RC = ICL9HNOUTPUTRECORD(BUFFDRO,BUFFDR1)
      EXIT OMFOUT(OMF FILE WRITE FAILURE) %IF RC > 0
      %RESULT=0
   %END
!!
!!*****************************************
!!  PROCEDURE TO FORCE EXIT FROM OMFOUT
!!
   %ROUTINE EXIT OMFOUT (%INTEGER RESULT VALUE)
        *LSS_RESULT VALUE
        *LLN_LNB OF OMFOUT
        *EXIT_-64
   %END
?DEL 1248-1249
DEL 1252
E