!**********************************************************************
!*
!
!*
!*                COMPILER ENVIRONMENT ROUTINES
!*
!**********************************************************************
!
!
!**********************************************************************
!*
!*                            CONSTANTS
!*
!**********************************************************************
!
%CONSTSTRING(4) VERSION = "1.1"
%CONSTINTEGER SEGMENT=262144,   %C
              SEGMENTK=256
%CONSTINTEGER PAGELEN=60
%CONSTINTEGER NO = 0,         %C
              YES = 1
%CONSTINTEGER FILED=0,          %C
              LOCAL=1,          %C
              ROMF =2
%CONSTINTEGER FILE  =1,        %C
              VSAREA=0
%CONSTINTEGER NIL = 0
%CONSTINTEGER DUMMYSTREAM=10
%CONSTSTRING(1)%ARRAY HEX TAB(0:15)="0","1","2","3","4","5","6","7", %C
              "8","9","A","B","C","D","E","F"
!
!
!
!**********************************************************************
!*
!*                            GLOBALS
!*
!**********************************************************************
!
!?2; %OWNINTEGER TRACE COUNT
!?2; %OWNINTEGER TRACE STREAM
%OWNINTEGER LOG STREAM,LISTING,SOURCESTREAM
%OWNSTRING(6) USER NAME
%OWNSTRING(255) SOURCELIST
%OWNINTEGER FILEOPENFLAG,LINECOUNT,NEWPAGECOUNT,INFILEDEPTH
%OWNINTEGER LISTDIR,SUBHDLEN,PAGEHDLEN
%OWNINTEGERARRAY SEQCOUNT(0:15)
%OWNBYTEINTEGERARRAY FILETYPE(0:15)
%OWNSTRING(255) SUBHEADING,PAGEHEADING
%OWNINTEGER NEWPAGEFLAG,EBCDICFLAG
%OWNBYTEINTEGERARRAY OUTBUFF(0:160)
%OWNINTEGER CURRENTMODULETYPE,OUTFILEPTR,OUTFILELEN,MAXOUTFILELEN, %C
              MODULE ACTIVE,OUTFILECONADDR,CODE
%OWNSTRING(64) OMFLIBNAME
%OWNSTRING(32) OMFMODULENAME
%OWNSTRING(3) DIRECTIVE
!
!**********************************************************************
!*
!*                      EXTERNAL  REFERENCES - SUBSYSTEM
!*
!**********************************************************************
!
!?1; %EXTERNALINTEGERFNSPEC RETURN CODE
%EXTERNALINTEGERFNSPEC OUT STREAM
%EXTERNALROUTINESPEC DEFINE (%STRING(255) PARMS)
%EXTERNALROUTINESPEC PROMPT(%STRING(15) NEW PROMPT)
%EXTERNALSTRINGFNSPEC DATE
%EXTERNALSTRINGFNSPEC TIME
%SYSTEMROUTINESPEC    DESTROY   (%STRING(31) FILE NAME,              %C
                                %INTEGERNAME FLAG)
%SYSTEMSTRINGFNSPEC   CONFILE   (%INTEGER ADDRESS)
%SYSTEMROUTINESPEC    CHANGE FILE SIZE (%STRING(31) FILENAME,     %C
                                %INTEGER NEW SIZE,                   %C
                                %INTEGERNAME FLAG)
%SYSTEMROUTINESPEC    OUTFILE   (%STRING(31) FILE NAME,              %C
                                %INTEGER SIZE,GAP,PROTECTION,       %C
                                %INTEGERNAME CONNECTED ADDR,FLAG)
%SYSTEMSTRINGFNSPEC   NEXT TEMP
%SYSTEMROUTINESPEC    MOVE      (%INTEGER LENGTH,FROM ADDR,TO ADDR)
%SYSTEMROUTINESPEC    ITOE      (%INTEGER ADDRESS,LENGTH)
%SYSTEMROUTINESPEC    ETOI      (%INTEGER ADDRESS,LENGTH)
%SYSTEMROUTINESPEC    FILL      (%INTEGER LENGTH,ADDRESS,FILLER)
%EXTERNALROUTINESPEC OPENSQ(%INTEGER STREAM)
%EXTERNALROUTINESPEC CLOSESQ(%INTEGER STREAM)
%EXTERNALROUTINESPEC WRITESQ(%INTEGER STREAM,%NAME FROM,TO)
%EXTERNALROUTINESPEC METER
%EXTERNALSTRINGFNSPEC UINFS(%INTEGER ENTRY)
!
!**********************************************************************
!*
!*                   MISCELLANEOUS  DECLARATIONS
!*
!**********************************************************************
!?3; %EXTERNALROUTINESPEC XDUMP (%STRING(120) COMMENT,%INTEGER A,L)
!
!**********************************************************************
!*
!*                        SERVICE  ROUTINES
!*
!**********************************************************************
!

!
%SYSTEMSTRING(15)%FN SFROMI (%INTEGER X)
%INTEGER REM,NUMB,NF
%STRING(15) ANS
ANS = ''
%IF X < 0 %THEN %START
    NF = YES
    X = X*(-1)
%FINISH %ELSE NF = NO
%CYCLE
NUMB = X
X = X//10
REM = NUMB - X*10
ANS = TOSTRING(REM+'0').ANS
%EXIT %IF X = 0
%REPEAT
%IF NF = YES %THEN ANS = "-".ANS
%RESULT = ANS
%END     ;!  OF SFROMI
!
%INTEGERFN IFROMS (%STRING(20) NUMBER)
%INTEGER I,J,K,L
K=ADDR(NUMBER)
J=0
%CYCLE I=1,1,20
    L = BYTEINTEGER(K+I)
    %IF L<'0' %OR L>'9' %THEN %RESULT = J
    J=(J*10)+L-'0'
%REPEAT
%END     ;!  OF IFROMS
!
%ROUTINE LOG (%STRING(120) MSG)
%INTEGER CURRENT STREAM
CURRENT STREAM = OUTSTREAM
SELECT OUTPUT (LOG STREAM)
SPACES(9)
PRINTSTRING(MSG) ; NEWLINE
SELECT OUTPUT(CURRENT STREAM)
%RETURN
%END     ;!  OF LOG
!
!?1; %STRING(8)%FN HEXOF (%INTEGER X)
!?1; %STRING(8) ANS
!?1; %INTEGER I
!?1; ANS = ''
!?1; %CYCLE I=0,4,28
!?1;     ANS = HEXTAB((X>>I)&X'0000000F').ANS
!?1; %REPEAT
!?1; %RESULT = ANS
!?1; %END     ;!  OF HEXOF
%STRING(255)%FN STRING FROM(%INTEGER LENGTH,ADDRESS)
%STRING(255) S
*LB   _LENGTH
*LDA  _ADDRESS
*LDTB _X'18000000'
*LDB  _%B
*CYD  _0
*LD   _S
*MVL  _%L=1
*MV   _%L=%DR,0,129
%RESULT = S
%END       ;!  OF STRING FROM
!
!
%STRING(160)%FN NEXT LINE
%INTEGER I
%BYTEINTEGERARRAY LINE (0:160)
%WHILE NEXT SYMBOL = NL %THEN SKIP SYMBOL
%CYCLE I=1,1,160
    READ SYMBOL(LINE(I))
    %IF LINE(I) = NL %THEN %EXIT
%REPEAT
LINE(0) = I-1
%RESULT = STRING(ADDR(LINE(0)))
%END     ;!  OF NEXT LINE
!
%STRING(255)%FN DE SPACED (%STRING(255) S)
%STRING(255) B,A
%WHILE S -> B.(" ").A %THEN S = B.A
%RESULT = S
%END    ;!  OF DE SPACED
!
%ROUTINE PRINT PAGE HEADING
PRINTSTRING(PAGEHEADING)
WRITE(NEWPAGECOUNT,4)
NEWLINE
%END
!
%ROUTINE PRINT SUB HEADING
%IF NEWPAGEFLAG=0 %THEN %START
  %IF LINECOUNT+SUBHDLEN>PAGELEN %THEN %START
    NEWPAGEFLAG=1
    %RETURN
  %FINISH
%FINISH
PRINTSTRING(SUBHEADING)
NEWLINE
LINECOUNT=LINECOUNT+SUBHDLEN
%END
!
!?; %ROUTINE POSTREPORT(%STRING(40) RTN,%INTEGER RC)
!?; LOG("RETURNED FROM ".RTN." RESULT= ".SFROMI(RC))
!?; %END;         ! OF POST REPORT
!
!?; %ROUTINE EXITREP(%STRING(40) RTN,%INTEGER RC)
!?; LOG("ABOUT TO RETURN FROM ".RTN." RESULT = ".SFROMI(RC))
!?; %END;          ! OF EXITREP
!?1; %ROUTINE ASK FOR STREAM(%INTEGERNAME STREAM,%STRING(15) P)
!?1; %INTEGER X,RC
!?1; %STRING(80) REPLY
!?1; !
!?1; RC = 1
!?1; PROMPT(P)
!?1; %WHILE RC > 0 %THEN %CYCLE
!?1;     REPLY = DESPACED(NEXT LINE)
!?1;     %IF REPLY = "" %THEN %RETURN
!?1;     X = IFROMS(REPLY)
!?1;     %IF X>0 %AND X<80 %THEN STREAM = X %AND %RETURN
!?1; LOG("ABOUT TO CALL DEFINE (".SFROMI(STREAM).",".REPLY.")")
!?1;     DEFINE(SFROMI(STREAM).",".REPLY)
!?1;     X = RETURN CODE
!?1;     %IF X = 0 %THEN %RETURN
!?1;     PRINTSTRING("REPLY NOT VALID")
!?1;     NEWLINE
!?1; %REPEAT
!?1; %RETURN
!?1; %END      ;!  OF ASK FOR STREAM
!
!?2; %ROUTINE TRACE (%STRING(40) RTN,MSG,%INTEGER LNB,N)
!?2; %STRING (132) WORKA,WORKB
!?2; %INTEGER CURRENT STREAM
!?2; TRACE COUNT = TRACE COUNT + 1
!?2; WORKA="TRACE CALL >>".SFROMI(TRACE COUNT)."<<  ".RTN."  ".MSG
!?2; CURRENT STREAM = OUT STREAM
!?2; SELECT OUTPUT (TRACE STREAM)
!?2; NEWLINES(2)
!?2; PRINTSTRING(WORKA)
!?2; NEWLINE
!?2; WORKB="STACK DUMP STARTING FROM LNB, ".SFROMI(N)." WORDS OF PARMS"
!?2; XDUMP(WORKB,LNB,(10+N)*4)
!?2; NEWLINE
!?2; SELECT OUTPUT(CURRENT STREAM)
!?2; %RETURN
!?2; %END       ;!  OF TRACE
!
!######################################################################
!#
!#                     COMPILER ENVIRONMENT ROUTINES
!#
!######################################################################
!
!
!***********************************************************************
!*
!*                INIT CENV
!*
!************************************************************************
!
%EXTERNALINTEGERFN INITCENV(%STRINGNAME SOURCE,OBJ,DIRTRIGCHAR,   %C
SAVELIST, COMPILERIDEN, INITSUBHD, %INTEGER OMFCODE,EBCDIC,LISTDIRS)
%STRING(32) INFILE,LISTFILE
%INTEGER X
!
!?; *STLN_X
!
!?; TRACECOUNT=0
!?; TRACESTREAM=71
!?; ASK FOR STREAM(TRACE STREAM,"TRACE STREAM?  ")
LOGSTREAM=70
!? %C
!?; LOG("ABOUT TO CALL DEFINE(ST70,.OUT)")
DEFINE("ST70,.OUT")
!?; ASK FOR STREAM(LOGSTREAM,"LOGSTREAM?  ")
!
!?; TRACE("INITCENV","",X,13)
LOG("EMAS 2900 -- COMPILER ENVIRONMENT    VERSION ".VERSION)
!
EBCDICFLAG=EBCDIC
SOURCELIST=SOURCE
%IF EBCDICFLAG=1 %THEN ETOI(ADDR(SOURCELIST)+1,LENGTH(SOURCELIST))
%UNLESS SOURCELIST->INFILE.("&").SOURCELIST %THEN INFILE=SOURCELIST
SOURCESTREAM=20
!?; LOG("ABOUT TO CALL DEFINE(ST20,".INFILE.")")
DEFINE("ST20,".INFILE)
LISTING=40
%IF SAVELIST#"" %THEN %START
  LISTFILE=SAVELIST
  %IF EBCDICFLAG=1 %THEN ETOI(ADDR(LISTFILE)+1,LENGTH(LISTFILE))
%FINISH %ELSE LISTFILE="T#LIST"
!?; LOG("ABOUT TO CALL DEFINE(ST40,".LISTFILE.")")
DEFINE("ST40,".LISTFILE)
!?; LOG("ABOUT TO CALL DEFINE(ST10,.NULL)")
DEFINE("ST10,.NULL")
SELECTINPUT(SOURCESTREAM)
INFILEDEPTH=0
DIRECTIVE=DIRTRIGCHAR
LISTDIR=LISTDIRS
CODE=OMFCODE
OMFLIBNAME=OBJ
%IF EBCDICFLAG=1 %THEN ETOI(ADDR(OMFLIBNAME)+1,LENGTH(OMFLIBNAME))
MODULEACTIVE=NO
OUTFILEPTR=0
SUBHEADING=INITSUBHD
!      SET UP PAGE HEADING
PAGE HEADING="    USER ".UINFS(1)."       JOB 12CHARJOBNAM  ".  %C
  COMPILERIDEN."      COMPILATION ".DATE."  ".TIME."   PAGE "
NEWPAGECOUNT=0
NEWPAGEFLAG=1
%RESULT=0
%END
!
!
!***********************************************************************
!*
!*                      ICL9HN ALTER VS
!*
!***********************************************************************
!
%EXTERNALINTEGERFN ICL9HN ALTERVS(%INTEGER ADR0,ADR1,SIZE)
!
! AN EXTRA PARAM (MODE) MAY BE ADDED IN THE FUTURE
%STRING(15) FILENAME
%INTEGER RC,X
!
!?; *STLN_X
!?; TRACE("ALTERVS","",X,3)
!
FILENAME=CONFILE(ADR1)
%IF FILENAME=".NULL" %THEN %RESULT=1
%IF SIZE>-1 %THEN %START
  CHANGE FILE SIZE(FILENAME,SIZE,RC)
!?; POSTREPORT("CHANGE FILE SIZE",RC)
  %IF RC#0 %THEN RC=1
%FINISH
!?; EXITREP("ALTERVS",RC)
%RESULT=RC
%END;             !OF ALTERVS
!*
!*****************************************************************
!*
!*                      ICL9HN CREATE MODULE
!*
!******************************************************************
!
%EXTERNALINTEGERFN ICL9HN CREATE MODULE(%INTEGER NAMDR0,NAMDR1,      %C
                                        FULLNAMDR0,FULLNAMDR1,SIZE)
%STRING(32) FILENAME,FULLNAME,AREANAME,DEFINESTR
%INTEGER X,AREAADDR,FLAG,RC
RC=0
%IF SIZE<0 %THEN MAXOUTFILELEN=SEGMENTK         %C
           %ELSE MAXOUTFILELEN=(SIZE+1023)//1024
%IF NAMDR0=NIL %THEN FILENAME="T#".NEXTTEMP %ELSE %START
FILENAME=STRINGFROM(NAMDR0,NAMDR1)
%IF EBCDICFLAG=1 %THEN ETOI(ADDR(FILENAME)+1,LENGTH(FILENAME))
FILENAME=DESPACED(FILENAME)
%FINISH
OMFMODULENAME=FILENAME
!
!?; *STLN_X
!?; TRACE("CREATE MODULE",                    %C
          "  ".FILENAME."  SIZE=".SFROMI(MAXOUTFILELEN*1024),X,5)
!
%IF CODE=FILED %THEN %START
  MODULEACTIVE=YES
  LOG("CREATE FILE")
  %UNLESS FULLNAMDR0=NIL %THEN %START
    FULLNAME=OMFLIBNAME.".".FILENAME
    FILL(FULLNAMDR0&X'00FFFFFF',FULLNAMDR1,' ')
    ITOE(ADDR(FULLNAME)+1,LENGTH(FULLNAME)) %IF EBCDICFLAG=1
    MOVE(LENGTH(FULLNAME),ADDR(FULLNAME)+1,FULLNAMDR1)
  %FINISH
  %IF FILEOPENFLAG=1 %THEN CLOSESQ(50) %AND FILEOPENFLAG=0
  DEFINESTR="SQ50,".FILENAME.",".SFROMI(MAXOUTFILELEN)
  LOG("CALLING DEFINE(".DEFINESTR.")")
  DEFINE(DEFINESTR)
  FILEOPENFLAG=0
  OUTFILELEN=0
  CURRENT MODULE TYPE = FILE
  RC=0
%FINISH %ELSE %START
%IF MODULEACTIVE=YES %THEN %START
  %IF CURRENT MODULE TYPE=FILE %THEN RC=511
  OUTFILEPTR=OUTFILECONADDR
OUTFILELEN=0
RC=0
%FINISH %ELSE %START
MODULEACTIVE=YES
AREANAME="T#".NEXTTEMP
LOG("CREATE VS AREA")
OUTFILE(AREANAME,SIZE,SEGMENT,0,AREAADDR,FLAG)
!?; POSTREPORT("OUTFILE",RC)
%IF FLAG#0 %THEN %START
  LOG("FAILED TO CREATE VS AREA. FLAG= ".SFROMI(FLAG))
  RC=510
%FINISH %ELSE %START
OUTFILEPTR=AREAADDR
OUTFILECONADDR=AREAADDR
OUTFILELEN=0
CURRENT MODULE TYPE = VSAREA
RC=0
%FINISH
%FINISH
%FINISH
!?; EXITREP("CREATE MODULE",RC)
%RESULT=RC
%END
!
!
!*******************************************************************
!*
!*                        ICL9HN CREATE VS
!*
!***********************************************************************
!
%EXTERNALINTEGERFN ICL9HN CREATEVS(%INTEGER NAMDR0,NAMDR1,SIZE,   %C
                                            MODE,DESCDR0,DESCDR1)
%STRING(32) AREANAME
%INTEGER X,FLAG,AREAADDR,AREASIZE,RC
%IF NAMDR0=NIL %THEN AREANAME="T#".NEXTTEMP %ELSE %START
          AREANAME=STRINGFROM(NAMDR0,NAMDR1)
          %IF EBCDICFLAG=1 %THEN ETOI(ADDR(AREANAME)+1,LENGTH(AREANAME))
          AREANAME="T#".AREANAME
%FINISH
AREASIZE=SIZE
%IF AREASIZE>SEGMENT %THEN AREASIZE=SEGMENT
!
!?; *STLN_X
!?; TRACE("CREATEVS",AREANAME,X,6)
!
OUTFILE(AREANAME,AREASIZE,SEGMENT,0,AREAADDR,FLAG)
%IF FLAG#0 %THEN %START
LOG("RETURNED FROM OUTFILE, FLAG=".SFROMI(FLAG))
RC=1 
%FINISH %ELSE %START
INTEGER(DESCDR1)=X'18000000' ! AREASIZE
INTEGER(DESCDR1+4)=AREAADDR
RC=0
%FINISH
!?; EXITREP("CREATEVS",RC)
%RESULT=RC
%END
!
!***********************************************************************
!*
!*                    ICL9HN END MODULE
!*
!*************************************************************
!
%EXTERNALINTEGERFN ICL9HN ENDMODULE(%INTEGER DELETE)
%INTEGER X,RC
!
RC=0
!?; *STLN_X
!?; TRACE("ENDMODULE",                              %C
 "ACTUALSIZE=".SFROMI(OUTFILELEN).":REQSIZE=".      %C
  SFROMI(MAXOUTFILELEN*1024),X,1)
!
%IF MODULEACTIVE=NO %THEN %START
  LOG("NO MODULE ACTIVE")
  RC=1
%FINISH %ELSE %START
MODULEACTIVE=NO
%IF CURRENTMODULETYPE=FILE %THEN %START
  %IF FILEOPENFLAG=1 %THEN CLOSESQ(50) %AND FILEOPENFLAG=0
%FINISH
%IF DELETE#0 %THEN %START
  DESTROY(OMFMODULENAME,RC)
!?; POSTREPORT("DESTROY",RC)
  %IF RC#0 %THEN %START
    LOG("FAILED TO DESTROY ".OMFMODULENAME." RC=".SFROMI(RC))
    RC=1
  %FINISH %ELSE RC=-1
%FINISH
%FINISH
!?; EXITREP("ENDMODULE",RC)
%RESULT=RC
%END
!
!************************************************************
!*
!*                         ICL9HN LOG
!*
!************************************************************
!
%EXTERNALINTEGERFN ICL9HN LOG(%INTEGER MESSDR0,MESSDR1,DESTINATION)
!
!    SID D403  FOR CTM INTERFACE DEFN OF MESSAGE TYPE VALUES
!
%INTEGER L,CURRENTSTREAM,X,RC
%STRING(138) S
%UNLESS -1<=DESTINATION<=15 %THEN %RESULT=1
RC=0
!
!?; *STLN_X
!?; TRACE("LOG","MSG LOGGED TO APPROPRIATE LOG STREAM",X,3)
!
L=MESSDR0&X'000000FF'
%IF L>108 %THEN L=108
CURRENT STREAM=OUTSTREAM
SELECT OUTPUT(LOGSTREAM)
S=STRINGFROM(L,MESSDR1)
ETOI(ADDR(S)+1,L) %IF EBCDICFLAG=1
PRINTSTRING(TIME.S)
NEWLINE
SELECT OUTPUT(CURRENT STREAM)
%RESULT=0
%END

!
!************************************************************
!* 
!*                           ICL9HN MONITOR
!*
!************************************************************
!
%EXTERNALINTEGERFN ICL9HN MONITOR(%INTEGER TAG)
%INTEGER CURRENT STREAM,X
!
!?; *STLN_X
!?; TRACE("MONITOR","",X,1)
!
CURRENTSTREAM=OUTSTREAM
SELECT OUTPUT(LOGSTREAM)
PRINTSTRING(SFROMI(TAG)."METERING INFORMATION FOLLOWS")
NEWLINE
METER
NEWLINE
SELECTOUTPUT(CURRENT STREAM)
!?; EXITREP("MONITOR",0)
%RESULT=0
%END
!
!************************************************************
!*
!*                         ICL9HN NEW SUBHEADING
!*
!************************************************************
!
%EXTERNALINTEGERFN ICL9HN NEW SUBHEADING(%INTEGER SUBHDDR0,SUBHDDR1,  %C
                                                  LINES,NEWPAGE)
%INTEGER X,L,RC
!
RC=0
L=SUBHDDR0&X'000000FF'
SUBHEADING=STRINGFROM(L,SUBHDDR1)
%IF EBCDICFLAG=1 %THEN ETOI(ADDR(SUBHEADING)+1,ADDR(SUBHEADING))
SUBHDLEN=LINES
!
!?; *STLN_X
!?; TRACE("NEW SUBHEADING",">>".SUBHEADING."<<",X,4)
!
%IF LINECOUNT+LINES>PAGELEN %THEN NEWPAGEFLAG=1
%IF NEWPAGE>0 %THEN %START
  %IF LINECOUNT>(PAGELEN-1/NEWPAGE*PAGELEN) %THEN NEWPAGEFLAG=1
%FINISH
%IF NEWPAGE<=-1 %THEN NEWPAGEFLAG=1
%IF NEWPAGEFLAG=1 %THEN RC=-1
!?; EXITREP("NEWSUBHD",RC)
%RESULT=RC
%END
!
!**************************************************************
!*
!*                ICL9HN NEWLINE
!*
!*************************************************************
!
%EXTERNALINTEGERFN ICL9HN NEWLINE(%INTEGER LINES)
%INTEGER X,CURRENTSTREAM
!
!?; *STLN_X
!?; TRACE("NEWLINE","",X,1)
!
%IF LINECOUNT+LINES>PAGELEN %THEN NEWPAGEFLAG=1 %ELSE %START
  CURRENTSTREAM=OUTSTREAM
  SELECT OUTPUT(LISTING)
  NEWLINES(LINES)
 LINECOUNT=LINECOUNT+LINES
  SELECT OUTPUT(CURRENT STREAM)
%FINISH
%RESULT=0
!?; EXITREP("NEWLINE",0)
%END
!
!*************************************************************
!*
!*                    ICL9HN NEWPAGE
!*
!************************************************************
!
%EXTERNALINTEGERFN ICL9HN NEWPAGE
%INTEGER X
!
!?; *STLN_X
!?; TRACE("NEWPAGE","",X,0)
!
NEWPAGEFLAG=1
!?; EXITREP("NEWPAGE",0)
%RESULT=0
%END
!
!************************************************************
!*
!*                     ICL9HN OUTPUTLINE
!*
!************************************************************
!
%EXTERNALINTEGERFN ICL9HN OUTPUT LINE(%INTEGER BUFFDR0,BUFFDR1)
%INTEGER CURRENTSTREAM,X,LEN,LINES
!
!?; *STLN_X
!?; TRACE("OUTPUTLINE","",X,2)
!
CURRENTSTREAM=OUTSTREAM
SELECT OUTPUT(LISTING)
%IF NEWPAGEFLAG=1 %THEN %START
LOG("ABOUT TO THROW NEWPAGE. NUM. LINES ON CURRPAGE=".SFROMI(LINECOUNT))
  NEWPAGE
!??;  NEWLINES(4)
  NEWPAGECOUNT=NEWPAGECOUNT+1
  LINECOUNT=0
  PRINT PAGE HEADING
  PRINT SUBHEADING
  NEWPAGEFLAG=0
  LINECOUNT=LINECOUNT+PAGEHDLEN+SUBHDLEN
%FINISH
LEN=BUFFDR0&X'00FFFFFF'
MOVE(LEN,BUFFDR1,ADDR(OUTBUFF(1)))
OUTBUFF(2)=LEN-2
%IF EBCDICFLAG=1 %THEN ETOI(ADDR(OUTBUFF(3)),LEN-2)
PRINTSTRING(STRING(ADDR(OUTBUFF(2))))
LINECOUNT=LINECOUNT+1
SELECT OUTPUT(CURRENT STREAM)
!?; EXITREP("OUTPUTLINE",0)
%RESULT=0
%END
!
!***********************************************************************
!*
!*                       ICL9HN OUTPUT RECORD
!*
!***********************************************************************
!
%EXTERNALINTEGERFN ICL9HN OUTPUT RECORD(%INTEGER BUFFDR0,BUFFDR1)
%BYTEINTEGERARRAYNAME OMFARRAY
%BYTEINTEGERARRAYFORMAT OMFREC(1:262144)
%INTEGER RECLEN,X,RC
RECLEN=BUFFDR0&X'00FFFFFF'
OUTFILELEN=OUTFILELEN+RECLEN+2
!
!?; *STLN_X
!?; TRACE("OUTPUTRECORD","LENGTH=".SFROMI(RECLEN),X,2)
!
OMFARRAY==ARRAY(BUFFDR1,OMFREC)
%IF CURRENTMODULE TYPE=FILE %THEN %START
  %IF FILEOPENFLAG=0 %THEN OPENSQ(50) %AND FILEOPENFLAG=1
  LOG("OUTPUT RECORD TO FILE")
  WRITESQ(50,OMFARRAY(1),OMFARRAY(RECLEN))
  RC=0
%FINISH %ELSE %START
  LOG("OUTPUT RECORD TO VS AREA")
  %IF OUTFILELEN>SEGMENT %THEN %START
    LOG("SIZE OF OMF WRITTEN TO VS EXCEEDS ONE SEG ".SFROMI(OUTFILELEN))
    RC=1
  %FINISH %ELSE %START
  MOVE(2,ADDR(RECLEN)+2,OUTFILEPTR)
  OUTFILEPTR=OUTFILEPTR+2
  MOVE(RECLEN,BUFFDR1,OUTFILEPTR)
  OUTFILEPTR=OUTFILEPTR+RECLEN
  RC=0
%FINISH
%FINISH
!?; EXITREP("OUTPUTRECORD",RC)
%RESULT=RC
%END
!
!****************************************************************
!*
!*                          ICL9HN READ CARD
!*
!************************************************************
!
%EXTERNALINTEGERFN ICL9HNREADCARD(%INTEGER BUFFDR0,BUFFDR1,      %C
                                           SEQDR0,SEQDR1,LENDR0,LENDR1)
%INTEGER SP,RC,LINES,PTR,X
%STRING(32) NEXT
%STRING(3) TRIG
%STRING(5) DIR
%STRING(2) NUMLINES
%STRING(160) LINE
%INTEGER BUFFLEN
%STRING(15) SEQNUM
%STRING(2) DEPTH
%BYTEINTEGERARRAYNAME CARD
%BYTEINTEGERARRAYFORMAT CARDFORM(0:160)
%STRING(5)%FNSPEC READDIR(%INTEGERNAME PTR)
%STRING(32)%FNSPEC READDIRPARM(%INTEGERNAME PTR)
%SWITCH SW(0:2)
%ON %EVENT 9 %START
!?; LOG("INPUT ENDED  -- TYPE & DEPTH ".SFROMI(FILETYPE(INFILEDEPTH)) %C
  .SFROMI(INFILEDEPTH))
  RC=0
  ->SW(FILETYPE(INFILEDEPTH))
SW(0):
     %IF SOURCELIST="" %THEN %RESULT=-3
     %UNLESS SOURCELIST->NEXT.("&").SOURCELIST %THEN NEXT=SOURCELIST
     SELECTINPUT(DUMMYSTREAM)
     CLOSESTREAM(SOURCESTREAM)
!?; LOG("ABOUT TO CALL DEFINE(ST20,".NEXT.")")
     DEFINE("ST20,".NEXT)
     SELECT INPUT(SOURCESTREAM)
     %RESULT=-2
SW(1): 
     RC=-1
SW(2):
     INFILEDEPTH=INFILEDEPTH-1
     SOURCESTREAM=SOURCESTREAM-1
     SELECT INPUT(SOURCESTREAM)
     CLOSESTREAM(SOURCESTREAM+1)
     %IF RC<0 %THEN %RESULT=RC
     ->READ
%FINISH
!
RC=0
!?; *STLN_X
!?; TRACE("READ CARD","",X,6)
!
%IF EBCDICFLAG=1 %THEN SP=C' ' %ELSE SP=' '
BUFFLEN=BUFFDR0&X'00FFFFFF'
FILL(BUFFLEN,BUFFDR1,SP)
READ:
LINE=NEXT LINE
%IF SEQDR0#NIL %THEN %START
  SEQNUM=SFROMI(SEQCOUNT(INFILEDEPTH))
  DEPTH=SFROMI(INFILEDEPTH)
  SEQNUM=DEPTH."/".SEQNUM
  MOVE(LENGTH(SEQNUM),ADDR(SEQNUM)+1,SEQDR1)
%FINISH
SEQCOUNT(INFILEDEPTH)=SEQCOUNT(INFILEDEPTH)+1
%IF EBCDICFLAG=1 %THEN ITOE(ADDR(LINE)+1,LENGTH(LINE))
MOVE(LENGTH(LINE),ADDR(LINE)+1,BUFFDR1)
%IF LENDR0#NIL %THEN INTEGER(LENDR1)=LENGTH(LINE)
TRIG=FROMSTRING(LINE,1,3)
%IF TRIG=DIRECTIVE %THEN %START
  PTR=4
  CARD==ARRAY(ADDR(LINE),CARDFORM)
  DIR=READ DIR(PTR)
  %IF DIR="READ" %THEN %START
    NEXT=READ DIRPARM(PTR)
    INFILEDEPTH=INFILEDEPTH+1
   FILETYPE(INFILEDEPTH)=2
    SOURCESTREAM=SOURCESTREAM+1
    SEQCOUNT(INFILEDEPTH)=1
!?; LOG("ABOUT TO CALL DEFINE(ST".SFROMI(SOURCESTREAM).",".NEXT.")")
    DEFINE("ST".SFROMI(SOURCESTREAM).",".NEXT)
    SELECTINPUT(SOURCESTREAM)
%IF LISTDIR=YES %THEN RC=-512 %ELSE RC=511
  %FINISH %ELSE %START
    %IF DIR="LINES" %THEN %START
      NUMLINES=READ DIRPARM(PTR)
      LINES=IFROMS(NUMLINES)
      %IF LINES<=0 %THEN %RESULT=RC
      %IF LINECOUNT+LINES>PAGELEN %THEN NEWPAGEFLAG=1 %ELSE %START
        LINECOUNT=LINECOUNT+LINES
        NEWLINES(LINES)
      %FINISH
      RC=0
    %FINISH %ELSE %START
      %IF DIR="PAGE" %THEN %START
        NEWPAGEFLAG=1
        RC=0
      %FINISH %ELSE LOG("INVALID DIRECTIVE".DIR)
    %FINISH
  %FINISH
%FINISH
!?; EXITREP("READ CARD",RC)
%RESULT=RC
!
!
%STRING(5)%FN READDIR(%INTEGERNAME PTR)
%INTEGER J
%STRING(5) S
S=""
%WHILE CARD(PTR)=' ' %THEN PTR=PTR+1
%CYCLE J=PTR,1,PTR+4
  %EXIT %UNLESS 'A'<=CARD(J)<='Z'
  S=S.TOSTRING(CARD(J))
%REPEAT
PTR=J
%RESULT=S
%END
%STRING(32)%FN READ DIRPARM(%INTEGERNAME PTR)
%STRING(32) S
%INTEGER J
S=""
%WHILE CARD(PTR)#'(' %THEN PTR=PTR+1
%CYCLE J=PTR+1,1,PTR+32
  %EXIT %IF CARD(J)=')'
  %UNLESS CARD(J)=' ' %THEN S=S.TOSTRING(CARD(J))
%REPEAT
%IF J=PTR+32 %AND CARD(J)#')' %THEN LOG("NAME TOO LONG IN DIR")
PTR=J+1
%RESULT=S
%END
%END
!
!***********************************************************************
!*
!*                         ICL9HN READ LINE
!*
!******************************************************************
!
%EXTERNALINTEGERFN ICL9HN READLINE(%INTEGER BUFFDR0,BUFFDR1,   %C
                                            SIZEDR0,SIZEDR1)
%INTEGER BUFFLEN,RC,X
%STRING(32) NEXT
%STRING(160) LINE
%SWITCH SW(0:2)
%ON %EVENT 9 %START
!?; LOG("INPUT ENDED -- TYPE & DEPTH ".SFROMI(FILETYPE(INFILEDEPTH)) %C
.SFROMI(INFILEDEPTH))
  RC=0
  ->SW(FILETYPE(INFILEDEPTH))
SW(0):
     %IF SOURCELIST="" %THEN %RESULT=-3
     %UNLESS SOURCELIST->NEXT.("&").SOURCELIST %THEN NEXT=SOURCELIST
     SELECTINPUT(DUMMYSTREAM)
     CLOSESTREAM(20)
!?; LOG("ABOUT TO CALL DEFINE(ST20,".NEXT.")")
     DEFINE("ST20,".NEXT)
     SELECTINPUT(20)
     %RESULT=-2
SW(1):
     RC=-1
     INFILEDEPTH=INFILEDEPTH-1
     SOURCESTREAM=SOURCESTREAM-1
     SELECT INPUT(SOURCESTREAM)
     CLOSESTREAM(SOURCESTREAM+1)
     %IF RC<0 %THEN %RESULT=RC
     ->READ
SW(2):
     LOG("INVALID FILETYPE")
     %RESULT=1
%FINISH
!
!?; *STLN_X
!?; TRACE("READ LINE","",X,4)
!
RC=0
READ:
LINE = NEXT LINE
BUFFLEN=BUFFDR0&X'00FFFFFF'
%IF LENGTH(LINE)>BUFFLEN %THEN LENGTH(LINE)=BUFFLEN %AND RC=-255
%IF EBCDICFLAG=1 %THEN ITOE(ADDR(LINE)+1,LENGTH(LINE))
MOVE(LENGTH(LINE),ADDR(LINE)+1,BUFFDR1)
%IF SIZEDR0#NIL %THEN INTEGER(SIZEDR1)=LENGTH(LINE)
!?; EXITREP("READLINE",RC)
%RESULT=RC
%END
!
!************************************************************************
!*
!*                       NOT YET USED FNS --- SIMPLY TRACE CALLS
!*
!***********************************************************************
%EXTERNALINTEGERFN ICL9HNQUOTA
%INTEGER X
!
!?; *STLN_X
!?; TRACE("QUOTA","",X,0)
!
%RESULT=150
%END
!
!
%EXTERNALINTEGERFN ICL9HN CREATEALIAS(%INTEGER NAMDR0,NAMDR1,         %C
                                               DUMDR0,DUMDR1)
%INTEGER X
!
!?; *STLN_X
!?; TRACE("CREATE ALIAS","",X,4)
!
%RESULT=0
%END
!
!
%EXTERNALINTEGERFN ICL9HN COPYFILE(%INTEGER NAMDR0,NAMDR1,FULLDR0,  %C
                                            FULLDR1,PREFDR0,PREFDR1)
%INTEGER X
!
!?; *STLN_X
!?; TRACE("COPYFILE","",X,6)
!
%RESULT=0
%END
!
!
%EXTERNALINTEGERFN ICL9HN SETDUMPER(%INTEGER DUMPLNB,DPROCDR0,DPROCDR1)
%INTEGER X
!
!?; *STLN_X
!?; TRACE("SETDUMPER","",X,3)
!
%RESULT=0
%END
!
!
%ENDOFFILE