!*
!/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
!
! DOCUMENTATION FOR THIS FILE HANDLING PACKAGE IS:-
!      "FILEHANDLING PACKAGE FOR BASIC ON EMAS"
!           LESLEY BREWIN    FEBRUARY 1979
!
!/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
!
!******************************************************************
!*
!*                         EXTERNAL REFERENCES
!*
!******************************************************************
!
%EXTERNALINTEGERFNSPEC INSTREAM
%EXTERNALINTEGERFNSPEC OUTSTREAM
%EXTERNALROUTINESPEC DEFINE(%STRING(255) PARMS)
%EXTERNALINTEGERFNSPEC EXIST(%STRING(31) S)
%EXTERNALINTEGERFNSPEC UINFI(%INTEGER I)
%EXTERNALROUTINESPEC XDUMP(%STRING(120) COMMENT,%INTEGER ADDR,LEN)
%EXTERNALROUTINESPEC PROMPT(%STRING(15) P)
%SYSTEMROUTINESPEC ETOI(%INTEGER ADDR,LEN)
%SYSTEMROUTINESPEC ITOE(%INTEGER ADDR,LEN)
%SYSTEMROUTINESPEC MOVE(%INTEGER LEN,FROM,TO)
%SYSTEMROUTINESPEC FILL(%INTEGER LEN,ADDR,VAL)
%SYSTEMSTRING(15) %FNSPEC SFROMI(%INTEGER X)
!
!
!******************************************************************
!*
!* SPECS OF ROUTINES DEFINED BELOW
!*
!******************************************************************
!
%INTEGERFNSPEC CLOSEFILE(%INTEGER NUMBER)
%INTEGERFNSPEC OPENFILE(%INTEGER NUMBER,OP,FILEBLOCK)
%INTEGERFNSPEC OUTPUTNL
!*
!******************************************************************
!*
!*                           RECORD DECLARATIONS
!*
!******************************************************************
!
%RECORDFORMAT FDATAFORM (%LONGINTEGER RESTOFFORMAT,FORMAT,  %C
                  %INTEGER INUSING,NFILEBLKS,INPUTFILE,OUTPUTFILE,  %C
                  JLINELIMIT,INTERACT,OPT,FILEBLKSP0,FILEBLKSP1,      %C
                  %INTEGERARRAY FILEBLKTAB(1:32))
%EXTRINSICRECORD FILEDATA (FDATAFORM)
%EXTRINSICSTRING(16) INPUTFILE,OUTPUTFILE
%RECORDFORMAT CONNECTFORM(%INTEGER CONAD,TYPE,ST,END)
%RECORDFORMAT FBRFORM(%INTEGER FILENUMBER, %C
                      %BYTEINTEGERARRAY FILENAME(1:16), %C
                      %BYTEINTEGERARRAY USERNAME(1:8),  %C
                      %INTEGER FILESTATUS,FILEMARGIN, %C
                      FILEROUTE,FILECURR0,FILECURR1,%C
                      FILEBUFFER0,FILEBUFFER1,FILEBUFDR0,FILEBUFDR1,%C
                      FILEENDGOTO,FILERECNUMB,FILEHDLENG,  %C
                      %BYTEINTEGERARRAY FILEBUFF(1:133))
%EXTERNALRECORDARRAY FILEBLOCKTAB(1:16)(FBRFORM)
!
!******************************************************************
!*
!*                            CONSTANTS
!*
!******************************************************************
!
%CONSTSTRING(4) VERSION="2.0"
!?; %CONSTINTEGER DUMPSTREAM=80
%CONSTINTEGER FILEBUFFSIZE=132
%CONSTINTEGER NIL=0
%CONSTINTEGER EOLCHAR=X'15'
! THE FOLLOWING DENOTE STATUS OF FILES OR TYPES OF OPERATION REQUESTED
%CONSTINTEGER NULLSTATUS =0,    %C
              FILEMODEIN  =1,   %C
              FILEMODEOUT =2,    %C
              ASSNDSTATUS=4,    %C
              OPENSTATUS=8,    %C
              ATENDSTATUS=16,    %C
              FILEMODEDEL=32
%CONSTINTEGER MAXFILES=16;        ! MAX NO OF FILES THAT CAN BE DEFINED CONCURRENTLY
%CONSTINTEGER FILEBLKSIZE=18;        ! SIZE OF FILEBLOCK IN WORDS
%CONSTINTEGER DEFMARGIN=80;        ! DEFAULT MARGIN SIZE
%CONSTINTEGER FOREGROUND=1,   %C
              BACKGROUND=2
%CONSTINTEGER OPTIONE=X'00000010';        ! ECHO OPTION SWITCHED OFF
%CONSTSTRING(14) BASICPROMPT = ":  "
%CONSTSTRING(8) DEFUSER = ""
%CONSTINTEGER ALLBUT3=X'80000000'
!
!******************************************************************
!*
!*                           GLOBALS
!*
!******************************************************************
!
%OWNINTEGER LINECOUNT;     ! COUNT OF LINES OUTPUT TO CURRENT OUT STREAM
%OWNINTEGER DUMMYSTR=25;    ! DUMMY STREAM SELECTED BEFORE CLOSING
%CONSTINTEGER DUMMYBLK=0;    ! CURRENT I/O STREAM
%OWNINTEGER FIRSTLINE;    ! FLAG TO INDICATE WHETHER TO PRINT HEADER.
!
!
!
!******************************************************************
!*
!*                              SERVICE ROUTINES
!*
!******************************************************************
!
!?; %ROUTINE DUMP(%STRING(120) COMMENT,%INTEGER ADDR,LEN)
!?; %INTEGER SAVESTR
!?; SAVESTR=OUTSTREAM
!?; SELECTOUTPUT(DUMPSTREAM)
!?; XDUMP(COMMENT,ADDR,LEN)
!?; NEWLINE
!?; SELECTOUTPUT(SAVESTR)
!?; %END
!
%ROUTINE LOG(%STRING(255) MESSAGE)
%INTEGER SAVESTR
SAVESTR=OUTSTREAM
SELECTOUTPUT(99)
SPACES(9)
PRINTSTRING(MESSAGE)
NEWLINE
SELECTOUTPUT(SAVESTR)
%END;              ! OF LOG
!
%STRING(16)%FN DESPACE(%STRING(16) NAME)
%STRING(16) S,T
! REMOVE SPACES FROM NAME AND CONVERT TO ISO
S=NAME
%WHILE S->S.(E" ").T %THEN S=S.T
ETOI(ADDR(S)+1,LENGTH(S))
%RESULT=S
%END
!
!
!
%INTEGERFN FIND FILE BLOCK(%INTEGER NUMBER)
!
! SEARCH FILEBLOCKTABLE FOR THIS FILE NUMBER AND RETURN THE
! BLOCK NUMBER AS RESULT.
!
%INTEGER NBLKS,I
NBLKS=FILEDATA_NFILEBLKS
%IF NBLKS=0 %THEN %RESULT=-1;    ! FILEBLOCK NOT DEFINED
%CYCLE I=NBLKS*2-1,-2,1
  %EXIT %IF FILEDATA_FILEBLKTAB(I)=NUMBER
%REPEAT
%IF FILEDATA_FILEBLKTAB(I)#NUMBER %THEN %RESULT=-1
%RESULT=(I+1)//2
%END
!
%ROUTINE SETUP FILEBLOCK(%INTEGER FNUM,%STRING(16) FNAME,      %C
                         %STRING(8) UNAME,%INTEGERNAME FBLKNUM)
!
! INITIALISE A FILE BLOCK
!
%INTEGER BLKADDR
%RECORDNAME FBLOCK(FBRFORM)
BLKADDR=ADDR(FILEBLOCKTAB(FBLKNUM))
FILEDATA_FILEBLKTAB(FBLKNUM*2-1)=FNUM
FILEDATA_FILEBLKTAB(FBLKNUM*2)=BLKADDR
FBLOCK==RECORD(BLKADDR)
%IF FNAME=E"" %THEN FILL(16,ADDR(FBLOCK_FILENAME(1)),0) %C
              %ELSE MOVE(16,ADDR(FNAME)+1,ADDR(FBLOCK_FILENAME(1)))
%IF UNAME=E"" %THEN FILL(8,ADDR(FBLOCK_USERNAME(1)),0) %C
                 %ELSE MOVE(8,ADDR(UNAME)+1,ADDR(FBLOCK_USERNAME(1)))
FBLOCK_FILENUMBER=FNUM
FBLOCK_FILESTATUS=NULLSTATUS
FBLOCK_FILEENDGOTO=0
FBLOCK_FILEMARGIN=-1
%IF FNUM=0 %THEN %START
  %IF FBLKNUM=1 %THEN FBLOCK_FILEROUTE=98 %C
                %ELSE FBLOCK_FILEROUTE=99
%FINISH %ELSE FBLOCK_FILEROUTE=FBLKNUM
FBLOCK_FILEBUFFER0=X'18000000'!FILEBUFFSIZE
FBLOCK_FILEBUFFER1=ADDR(FBLOCK_FILEBUFF(1))
FBLOCK_FILEHDLENG=18
FBLKNUM=FBLKNUM+1
%END
!
!******************************************************************
!*
!*                                INITFILES
!*
!******************************************************************
!
%EXTERNALINTEGERFN INITFILES
%INTEGER EXECMODE
%STRING(16) NAME
%INTEGER BLKNUM,FLAG,RC
!?; LOG("ENTERED INITFILES")
!?; DEFINE("ST80,DUMPFILE")
%IF FILEDATA_NFILEBLKS#0 %THEN %START;      ! NOT FIRST CALL
  ! CLOSE ALL BUT FILES 0,-1
  %RESULT=CLOSEFILE(-1)
  FILEDATA_NFILEBLKS=3
%FINISH
BLKNUM=1
FIRSTLINE=1;    ! SET FLAG TO PRINT VERSION NO ON FIRST LINE 
FILEDATA_FILEBLKSP0=X'18000000'!(MAXFILES*FILEBLKSIZE)
FILEDATA_FILEBLKSP1=ADDR(FILEBLOCKTAB(1))
EXECMODE=UINFI(2)
! IF DEFAULT INPUT IS NOT DEFINED THEN CREATE INPUT FILEBLOCK WITH VALUE 0
%IF INPUTFILE#"" %THEN %START
  FLAG=EXIST(INPUTFILE)
  %IF FLAG>0 %THEN %START;      ! FILE EXISTS
    DEFINE("ST98,".INPUTFILE)
    ITOE(ADDR(INPUTFILE)+1,LENGTH(INPUTFILE))
    %WHILE LENGTH(INPUTFILE)<16 %THEN INPUTFILE=INPUTFILE.E" "
  %FINISH
%FINISH
%IF INPUTFILE="" %OR FLAG=0 %THEN %START
! NO INPUTFILE GIVEN OR FAILED TO CONNECT INPUT FILE
! IF INTERACTIVE, TAKE INPUT FROM TERMINAL
%IF EXECMODE=FOREGROUND %THEN INPUTFILE=E"INPUT           " %C
                        %ELSE LOG("INPUTFILE DOES NOT EXIST")   %AND %C
                              %RESULT=20;         !!CRASH!!!!!!!
%FINISH
FILEDATA_INPUTFILE=ADDR(FILEBLOCKTAB(BLKNUM))
SETUP FILEBLOCK(0,INPUTFILE,DEFUSER,BLKNUM)
RC=OPENFILE(0,FILEMODEIN,FILEDATA_INPUTFILE)
! IF DEFAULT OUTPUT NOT DEFINED CREATE OUTPUT FILEBLOCK WITH VALUE 0
%IF OUTPUTFILE#"" %THEN %START
  FLAG=EXIST(OUTPUTFILE)
  %IF FLAG>0 %THEN %START;     ! SUCCESS
    DEFINE("ST99,".OUTPUTFILE)
    ITOE(ADDR(OUTPUTFILE)+1,LENGTH(OUTPUTFILE))
    %WHILE LENGTH(OUTPUTFILE)<16 %THEN OUTPUTFILE=OUTPUTFILE.E" "
  %FINISH
%FINISH
%IF OUTPUTFILE="" %OR FLAG=0 %THEN OUTPUTFILE=E"OUTPUT          "
FILEDATA_OUTPUTFILE=ADDR(FILEBLOCKTAB(BLKNUM))
SETUP FILEBLOCK(0,OUTPUTFILE,DEFUSER,BLKNUM)
RC=OPENFILE(0,FILEMODEOUT,FILEDATA_OUTPUTFILE)
!
! CREATE A FILE BLOCK FOR SYSTEM FILE
!
NAME=E"T#SYSFILE       "
SETUP FILEBLOCK(-1,NAME,DEFUSER,BLKNUM)
!
! CHECK WHETHER INTERACTIVE MODE
!
%IF EXECMODE=FOREGROUND %THEN FILEDATA_INTERACT=1        %C
                        %ELSE FILEDATA_INTERACT=0
FILEDATA_JLINELIMIT=-1
FILEDATA_NFILEBLKS=3
LINECOUNT=0
!?; DUMP("INITFILEDATA",ADDR(FILEDATA),184)
!?; DUMP("INITBLOCKTAB",ADDR(FILEBLOCKTAB(1)),400)
PROMPT(BASICPROMPT)
DEFINE("ST25,.NULL")
%RESULT=0
%END;        ! OF INITFILES
!
!******************************************************************
!*
!*                                  OPEN FILE
!*
!******************************************************************
!
%INTEGERFN OPENFILE(%INTEGER NUMBER,OPERATION,FILEBLOCK)
%RECORDNAME FBLOCK(FBRFORM)
%STRING(16)FNAME,FUSER
%STRING(32) FFULLNAME
!?; %STRING(16) PARMS
%INTEGER MODE,ROUTE
!
!?; PARMS=SFROMI(NUMBER).SFROMI(OPERATION).SFROMI(FILEBLOCK)
!?; LOG("ENTERED OPENFILE-NUMBER,OP,BLOCK ".PARMS)
FBLOCK==RECORD(FILEBLOCK)
ROUTE=FBLOCK_FILEROUTE
MOVE(16,ADDR(FBLOCK_FILENAME(1)),ADDR(FNAME)+1)
LENGTH(FNAME)=16
FNAME=DESPACE(FNAME)
%IF FBLOCK_USERNAME(1)#0 %THEN %START
  MOVE(8,ADDR(FBLOCK_USERNAME(1)),ADDR(FUSER)+1)
  LENGTH(FUSER)=8
  FUSER=DESPACE(FUSER)
  FFULLNAME=FUSER.".".FNAME
%FINISH %ELSE FFULLNAME=FNAME
%IF NUMBER#0 %THEN %START
  %IF OPERATION=FILEMODEOUT %THEN MODE=3 %ELSE  MODE=1
! IF INPUTFILE DOESN'T EXIST THEN FAIL
  %IF EXIST(FFULLNAME)=0 %AND OPERATION=FILEMODEIN %THEN %RESULT=9
DEFINE("ST".SFROMI(ROUTE).",".FNAME);    ! ROUTE IS CHANNEL NO
!  FILE NOW EXISTS
FBLOCK_FILESTATUS=FBLOCK_FILESTATUS ! ASSNDSTATUS
%IF OPERATION =FILEMODEDEL %THEN %START;    ! DELETE OPERATION REQUESTED
  FBLOCK_FILESTATUS=FBLOCK_FILESTATUS ! FILEMODEDEL
  %RESULT=0
%FINISH
%FINISH;       ! STREAM SELECTED
FBLOCK_FILESTATUS=FBLOCK_FILESTATUS ! OPENSTATUS ! OPERATION
!  STORE INFO  IN FILEBLOCK
FBLOCK_FILECURR0=X'B1000000'; FBLOCK_FILECURR1=FILEBLOCK; !DUMMY CURR
FBLOCK_FILEBUFFER0=X'18000000'!132
FBLOCK_FILEBUFFER1=ADDR(FBLOCK_FILEBUFF(1))
FILL(132,FBLOCK_FILEBUFFER1,C' ')
%IF OPERATION=FILEMODEIN %THEN %START;      ! INPUT FILE
  FBLOCK_FILEMARGIN=132
  FBLOCK_FILEBUFDR0=NIL
FBLOCK_FILEBUFDR1=NIL
%FINISH %ELSE %START;      ! OUTPUTFILE
  FBLOCK_FILEMARGIN=DEFMARGIN
  FBLOCK_FILEBUFDR0=X'18000000'!FBLOCK_FILEMARGIN
  FBLOCK_FILEBUFDR1=FBLOCK_FILEBUFFER1
%FINISH
FBLOCK_FILERECNUMB=0
!?; DUMP("OPENFILEBLOCK",ADDR(FBLOCK),210)
%RESULT=0
%END;       ! OF OPENFILE
!
!******************************************************************
!*
!*                                   START FILE
!*
!******************************************************************
!
%EXTERNALINTEGERFN STARTFILE(%INTEGER NUMBER,NAMDR0,NAMDR1,USDR0,USDR1)
%STRING(16) FNAME
%STRING(8) UNAME
%INTEGER BLKNUM,RC,NAMELEN,FLAG
!?; LOG("ENTERED STARTFILE".SFROMI(NUMBER))
RC=0
NAMELEN=NAMDR0&X'FF'
MOVE(NAMELEN,NAMDR1,ADDR(FNAME)+1);   ! EBCDIC STRING
LENGTH(FNAME)=NAMELEN
%WHILE LENGTH(FNAME)<16 %THEN FNAME=FNAME.E" "; !SPACE FILL TO 16 CHARS
%IF BYTEINTEGER(ADDR(USDR0))!X'18'=X'18' %THEN %START;! USER GIVEN
  NAMELEN=USDR0&X'FF'
  MOVE(NAMELEN,USDR1,ADDR(UNAME)+1)
  LENGTH(UNAME)=NAMELEN
  %WHILE LENGTH(UNAME)<8 %THEN UNAME=UNAME.E" "; ! SPACE FILL TO 8 CHARS
%FINISH %ELSE UNAME=DEFUSER
BLKNUM=FINDFILEBLOCK(NUMBER)
%IF BLKNUM<0 %THEN %START;      !FILE BLOCK NOT DEFINED
  %IF FILEDATA_NFILEBLKS>=MAXFILES %THEN %RESULT=3;  ! NO ROOM 
  FILEDATA_NFILEBLKS=FILEDATA_NFILEBLKS+1
  BLKNUM=FILEDATA_NFILEBLKS;    ! NEW FILE BLOCK NUMBER
%FINISH %ELSE %START
  %UNLESS NUMBER =0 %THEN %START;    ! CAN'T CLOSE DEFAULT STREAM
    RC=-1
    FLAG=CLOSEFILE(NUMBER)
    %IF FLAG>0 %THEN %RESULT=20;       ! CRASH!!!
  %FINISH
%FINISH
SETUP FILEBLOCK(NUMBER,FNAME,UNAME,BLKNUM)
!?; DUMP("STARTFILEBLOCK",ADDR(FILEBLOCKTAB(BLKNUM-1)),210)
%RESULT=RC
%END;          ! OF START FILE
!
!
!******************************************************************
!*
!*                                  CLOSE
!*
!******************************************************************
!
%INTEGERFN CLOSE(%INTEGER NUMBER,BLKNUM)
! BLKNUM IS AN INDEX INTO FILEBLOCKTAB
!
%RECORDNAME FBLOCK(FBRFORM)
%INTEGER FBADDR,STATUS,RC,CURRBLK,CURRSTR
!?; LOG("ENTERED CLOSE-NUMBER,BLKNUM-".SFROMI(NUMBER).SFROMI(BLKNUM))
RC=0
FBADDR=ADDR(FILEBLOCKTAB(BLKNUM))
FBLOCK==RECORD(FBADDR)
STATUS=FBLOCK_FILESTATUS;    ! SAVE STATUS
FBLOCK_FILESTATUS=NULLSTATUS;    ! RESET STATUS TO NULL
%IF STATUS&FILEMODEOUT # 0 %THEN %START;    ! OUTPUTFILE
! IF BUFFER NOT EMPTY THEN PRINT CONTENTS TO CURRENT OUTFILE
  %IF FBLOCK_FILEBUFDR1#FBLOCK_FILEBUFFER1 %THEN %START; !BUFF NOT EMPTY
    CURRBLK=FILEDATA_OUTPUTFILE
    CURRSTR=OUTSTREAM;    ! SAVE CURRENT STREAM
    %UNLESS BLKNUM=CURRSTR %THEN %START; !FILE NOT CURRENT OUTPUT STREAM
      FILEDATA_OUTPUTFILE=FBADDR
      SELECTOUTPUT(BLKNUM);    ! SELECT STREAM
      RC=OUTPUTNL;    ! OUTPUT BUFFER
      SELECTOUTPUT(CURRSTR);    ! RESELECT SAVED STREAM
      FILEDATA_OUTPUTFILE=CURRBLK
    %FINISH %ELSE %START;   ! SELECT DUMMY STR TO ALLOW CLOSE
      RC=OUTPUTNL
      SELECTOUTPUT(DUMMYSTR)
      FILEDATA_OUTPUTFILE=DUMMYBLK
    %FINISH
  %FINISH
%FINISH %ELSE %START;    ! INPUT FILE
  CURRBLK=FILEDATA_INPUTFILE
  CURRSTR=INSTREAM
  %IF CURRBLK=FBADDR %THEN %START;    ! FILE IS CURR INPUT STREAM
    SELECTINPUT(DUMMYSTR);      ! SELECT DUMMY STREAM TO ALLOW CLOSE
FILEDATA_INPUTFILE=DUMMYBLK
  %FINISH
%FINISH
CLOSESTREAM(BLKNUM);      ! CLOSE STREAM
!?; DUMP("CLOSEBLOCK",ADDR(FBLOCK),210)
%RESULT=RC
%END
!
!******************************************************************
!*
!*                                   CLOSE FILE
!*
!******************************************************************
!
%EXTERNALINTEGERFN CLOSEFILE(%INTEGER NUMBER)
!
! IF NUMBER IS 0 THEN CLOSE ALL FILES
!              ALLBUT3 THEN CLOSE ALL BUT FILES 0 AND -1
!  OTHERWISE CLOSE FILE WITH NUMBER 'NUMBER'
!
%INTEGER COUNT,FBLK,STR,RC,LAST,I
!?; LOG("ENTERED CLOSEFILE ".SFROMI(NUMBER))
RC=0
%IF NUMBER#0 %AND NUMBER#ALLBUT3 %THEN %START;    ! NORMAL CASE
  FBLK=FINDFILEBLOCK(NUMBER);             ! FIND FILEBLOCK
  %IF FBLK<0 %THEN %RESULT=4;      ! FILE BLOCK NOT DEFINED
  %RESULT=CLOSE(NUMBER,FBLK);      ! CLOSE FILE
%FINISH
%IF NUMBER=0 %THEN LAST=1 %ELSE LAST=4
COUNT=FILEDATA_NFILEBLKS
%RESULT=0 %IF COUNT<LAST
%CYCLE I=COUNT*2,-2,LAST*2
  STR=FILEDATA_FILEBLKTAB(I-1)
  FBLK=I//2
  RC=CLOSE(STR,FBLK)
%REPEAT
%IF NUMBER=0 %THEN FILEDATA_NFILEBLKS=0
%RESULT=RC
%END;      ! OF CLOSE FILE
!
!******************************************************************
!*
!*                                    START IO
!*
!******************************************************************
!
%EXTERNALINTEGERFN STARTIO(%INTEGER NUMBER,OPERATION)
! FILE WITH NUMBER NUMBER IS OPENED IN DIRECTION SPECIFIED BY OPERATION
! OR IF OPERATION IS DELETE, THE DESC TO THE FILEBLOCK IS RETURNED
! IN THE B REGISTER.
!
%RECORDNAME FBLOCK(FBRFORM)
%INTEGER RC,FILEBLK,STATUS,BLKNUM,FLAG,ROUTE
!?; LOG("ENTERED STARTIO- NUMBER,OP-".SFROMI(NUMBER).SFROMI(OPERATION))
RC=0
BLKNUM=FIND FILEBLOCK(NUMBER)
%IF BLKNUM<0 %THEN %RESULT=5;  ! BLOCK NOT DEFINED
%IF NUMBER=0 %AND OPERATION=FILEMODEIN %THEN BLKNUM=BLKNUM-1
FILEBLK=FILEDATA_FILEBLKTAB(BLKNUM*2);   ! ADDR OF FILE BLOCK
%IF OPERATION#0 %THEN %START;    ! OPER 0 RETURN DESC IN B REG
  %UNLESS (OPERATION=FILEMODEIN %AND FILEBLK=FILEDATA_INPUTFILE) %OR %C
          (OPERATION=FILEMODEOUT %AND FILEBLK=FILEDATA_OUTPUTFILE)   %C
  %THEN %START
!  FILE ALREADY OPEN IN CORRECT DIRECTION
!
    FBLOCK==RECORD(FILEBLK)
    STATUS=FBLOCK_FILESTATUS
    %IF STATUS=NULLSTATUS %THEN %START;       ! FILE NOT OPEN
      RC=-1
      FLAG=OPENFILE(NUMBER,OPERATION,FILEBLK)
      %IF FLAG#0 %THEN RC=FLAG
    %FINISH %ELSE %START
      %IF STATUS&OPERATION =0 %THEN RC=6;     ! NOT OPEN IN REQUIRED DIRN
  %FINISH
!
! FILE NOW OPEN IN CORRECT DIRECTION
  ROUTE=FBLOCK_FILEROUTE
! SET CURRENT INPUT / OUTPUT FILE AND SELECT IT
  %IF  OPERATION=FILEMODEIN %THEN FILEDATA_INPUTFILE=FILEBLK %C
                            %AND SELECTINPUT(ROUTE)
  %IF OPERATION=FILEMODEOUT %THEN FILEDATA_OUTPUTFILE=FILEBLK %C
                            %AND SELECTOUTPUT(ROUTE)
!?; DUMP("STARTIOBLOCK",ADDR(FBLOCK),210)
%FINISH
%FINISH
!
!?; DUMP("FILEDATASTIO",ADDR(FILEDATA),184)
!?; LOG("BLKNUM,FILEBLK= ".SFROMI(BLKNUM).SFROMI(FILEBLK))
! LOAD B REG WITH ADDR OF FILEBLOCK
*LB_FILEBLK
!
%RESULT=RC
%END;      ! OF STARTIO
!
!******************************************************************
!*
!*                                   INPUT NL
!*
!******************************************************************
!
%EXTERNALINTEGERFN INPUTNL
%INTEGER I,J,BUFFLEN,SYM,RC,IRC,PROMPTLEN
%STRING(15) PROMPTMSG
%RECORDNAME FBLOCK,OUTFBLOCK(FBRFORM)
! INPUT ENDED TRAP
%ON %EVENT 9 %START
!?; LOG("END OF INPUT FILE")
  FBLOCK_FILESTATUS=FBLOCK_FILESTATUS!ATENDSTATUS
!?; DUMP("ENDTRAPBLOCK",ADDR(FBLOCK),210)
  %RESULT=1
%FINISH
!?; LOG("ENTERED INPUTNL")
RC=0
FBLOCK==RECORD(FILEDATA_INPUTFILE)
%IF FBLOCK_FILESTATUS&ATENDSTATUS#0 %THEN %RESULT=2;    ! CHECK FOR EOF
%IF FILEDATA_INTERACT#0 %THEN %START;           ! INTERACTIVE?
  OUTFBLOCK==RECORD(FILEDATA_OUTPUTFILE)
!?; DUMP("INBLOCK",ADDR(FBLOCK),210)
!?; DUMP("OUTBLOCK",ADDR(OUTFBLOCK),210)
PROMPTLEN=OUTFBLOCK_FILEBUFDR1-OUTFBLOCK_FILEBUFFER1;  ! PROMPT SET?
%IF PROMPTLEN#0 %THEN %START;              ! PROMPT REQUESTED
!  PROMPT FOR INPUT
    %IF PROMPTLEN>15 %THEN PROMPTLEN=15
    MOVE(PROMPTLEN,OUTFBLOCK_FILEBUFFER1,ADDR(PROMPTMSG)+1)
    OUTFBLOCK_FILEBUFDR0=X'18000000'!OUTFBLOCK_FILEMARGIN
    OUTFBLOCK_FILEBUFDR1=OUTFBLOCK_FILEBUFFER1
    ETOI(ADDR(PROMPTMSG)+1,PROMPTLEN)
    LENGTH(PROMPTMSG)=PROMPTLEN
    PROMPT(PROMPTMSG);           ! SET PROMPT
  %FINISH
%FINISH
BUFFLEN=FBLOCK_FILEMARGIN
%CYCLE I=1,1,BUFFLEN+1;      ! READ LINE INTO INPUT BUFFER
  READSYMBOL(SYM)
  %EXIT %IF SYM=NL
  FBLOCK_FILEBUFF(I)=SYM
%REPEAT
PROMPT(BASICPROMPT);   ! RESET BASIC PROMPT
%IF SYM#NL %THEN %START
  PRINTSTRING("LINE TOO LONG")
  RC=-5
%FINISH
!  DEAL WITH THE EMPTY RECORD --  INSERT A SPACE
%IF I=1 %THEN FBLOCK_FILEBUFF(1)=' ' %AND I=2  %ELSE %START
! REMOVE TRAILING SPACES
  %CYCLE J=I-1,-1,1
    %IF FBLOCK_FILEBUFF(J)#' ' %THEN %EXIT
  %REPEAT
  I=J
%FINISH
ITOE(FBLOCK_FILEBUFFER1,I);     ! CONVERT LINE TO EBCDIC
FBLOCK_FILEBUFF(I+1)=EOLCHAR
FBLOCK_FILEBUFDR0=X'18000000'!I+1
FBLOCK_FILEBUFDR1=FBLOCK_FILEBUFFER1
FBLOCK_FILERECNUMB=FBLOCK_FILERECNUMB+1
! IF DEFAULT INPUT IS 0 BUT NOT INTERACTIVE CHECK FOR ECHO OPTION
%IF FBLOCK_FILENUMBER=0 %AND FILEDATA_INTERACT=0 %THEN %START
  %IF FILEDATA_OPT&OPTIONE=0 %THEN %START
    !
    ! PRINT INPUT STRING TO CURRENT OUTPUT FILE
    !
    OUTFBLOCK==RECORD(FILEDATA_OUTPUTFILE)
    MOVE(I,FBLOCK_FILEBUFFER1,OUTFBLOCK_FILEBUFFER1)
    OUTFBLOCK_FILEBUFDR0=OUTFBLOCK_FILEBUFFER0-I
    OUTFBLOCK_FILEBUFDR1=OUTFBLOCK_FILEBUFFER1+I
    IRC=OUTPUTNL
    %IF IRC>0 %THEN %RESULT=1
    !%IF ERROR %THEN %RESULT=1
  %FINISH
%FINISH
!?; DUMP("INPUTNLFILEBLOCK",ADDR(FBLOCK),210)
%RESULT=RC
%END
!
!******************************************************************
!*
!*                                   OUTPUT NL
!*
!******************************************************************
!
%EXTERNALINTEGERFN OUTPUTNL
%RECORDNAME FBLOCK(FBRFORM)
%STRING(133) LINE
%INTEGER BUFFLEN,RC
!?; LOG("ENTERED OUTPUTNL")
RC=0
FILEDATA_RESTOFFORMAT=FILEDATA_FORMAT
FBLOCK==RECORD(FILEDATA_OUTPUTFILE)
BUFFLEN=FBLOCK_FILEBUFDR1-FBLOCK_FILEBUFFER1
! CHECK FOR LINE TOO LONG
%IF BUFFLEN>FBLOCK_FILEMARGIN %THEN BUFFLEN=FBLOCK_FILEMARGIN %AND RC=-4
FBLOCK_FILERECNUMB=FBLOCK_FILERECNUMB+1
FBLOCK_FILEBUFDR0=X'18000000'!FBLOCK_FILEMARGIN
FBLOCK_FILEBUFDR1=FBLOCK_FILEBUFFER1
%IF BUFFLEN=0 %THEN PRINTSTRING(">> <<") %ELSE %START
MOVE(BUFFLEN,FBLOCK_FILEBUFFER1,ADDR(LINE)+1)
LENGTH(LINE)=BUFFLEN
ETOI(ADDR(LINE)+1,BUFFLEN)
%IF FIRSTLINE=1 %THEN %START ;      ! PRINT HEADER
  FIRSTLINE=0
  LINE=LINE."  EMAS INTERFACE (VERSION ".VERSION.")"
%FINISH
PRINTSTRING(LINE)
%FINISH
NEWLINE
!?; DUMP("OUTPUTNLBLOCK",ADDR(FBLOCK),210)
%RESULT=RC
%END
!
!******************************************************************
!*
!*                                   TO JOURNAL
!*
!******************************************************************
!
%EXTERNALINTEGERFN TOJOURNAL
!?; LOG("ENTERED TOJOURNAL")
NEWLINE
%RESULT=0
%END
!
!******************************************************************
!*
!*                                   UNSAVE
!*
!******************************************************************
!
%EXTERNALINTEGERFN UNSAVE
!?; LOG("ENTERED UNSAVE")
NEWLINE
%RESULT=0
%END
%ENDOFFILE