!* MODIFIED 02/09/79 TO VERSION 6 - HANDLE LONG FILENAMES
!* MODIFIED 08/08/79 TO VERSION 5 - CLOSE OUTPUT FILES
!* MODIFIED 19/12/78 TO VERSION 4 - KSV13 BLOCK PREFIX
! BROUGHT FROM 475 AND MODIFIED FOR 2970 - 9/5/78
!!
! ALAN ANDERSON 22/12/77
!!
!!*******************************************************
!!*                                                     *
!!* THIS PROGRAM READS OMF OBJECTS INTO EMAS            *
!!* FROM A TAPE WRITTEN IN VME-K COPY OUT FORMAT.       *
!!*                                                     *
!!*******************************************************
!!
!! TAPE FORMAT IS:
!!     <-----------------FILE 1--------------------->
!! *V* *H* *H* *H* *H* *H* *H*    *D*  *D*    *E* *E*
!! *O* *D* *D* *D* *D* *D* *D* TM *A*->*A* TM *O* *O*  TM < FILE2 >< FILEN > TM TM
!! *L* *R* *R* *R* *R* *R* *R*    *T*  *T*    *F* *F*
!! *1* *1* *2* *3* *4* *5* *6*    *A*  *A*    *1* *2*
!!
!!
 
EXTERNALROUTINE  READKTAPE(STRING (8) TAPE)
EXTERNALROUTINESPEC  OPENOMF(STRING (32) S,INTEGER  N,MODE)
EXTERNALROUTINESPEC  WRITEOMF(INTEGER  N, A,L)
EXTERNALROUTINESPEC  CLOSEOMF(INTEGER  N)
EXTERNALROUTINESPEC  OPENMT(STRING  (6) TAPE)
EXTERNALROUTINESPEC  READMT(INTEGER  AD, INTEGERNAME  L, FLAG)
EXTERNALROUTINESPEC  SKIPMT(INTEGER  N)
EXTERNALROUTINESPEC  SKIPTMMT(INTEGER  N)
EXTERNALROUTINESPEC  REWINDMT
EXTERNALROUTINESPEC  UNLOADMT
EXTERNALROUTINESPEC  PROMPT(STRING  (17) S)
SYSTEMROUTINESPEC  ETOI(INTEGER  A, L)
EXTERNALSTRINGFNSPEC  DATE
EXTERNALSTRINGFNSPEC  TIME
BYTEINTEGERARRAY  B(0 : 4115)
CONSTINTEGER  TM = 1
STRING (255) FILE
INTEGER  FLAG, NUMFILES, LEN, CDISP, LASTDISP, RLEN, I
   ROUTINE  READLINE(STRING  (255) NAME  LINE)
      WHILE  NEXTSYMBOL = NL THEN  SKIPSYMBOL;    ! SKIP BLANK LINES
      LINE = ""
      WHILE  NEXTSYMBOL # NL THEN  LINE = LINE.NEXTITEM C 
         AND  SKIPSYMBOL
      SKIPSYMBOL
   END 
   NUMFILES = 1
   PRINTSTRING("
".DATE." ".TIME." VSN 6
")
   OPENMT(TAPE)
   REWINDMT
   SKIPMT(1);                           ! GET PAST LABEL
   CYCLE ;                              ! THROUGH FILES
NEXTF:
      LEN=4116   ;! MAX LEN
      READMT(ADDR(B(0)),LEN,FLAG);      ! HDR1
      IF  FLAG = TM THEN  START 
         PRINTSTRING("
Tape ends
")
         -> END
      FINISH 
      -> ERRORR UNLESS  FLAG = 0
      -> ERRORF UNLESS  B(6) = X'C8' AND  B(7) = X'C4' C 
         AND  B(8) = X'D9' AND  B(9) = X'F1'
      PRINTSTRING('
File')
      WRITE(NUMFILES,1)
      ETOI(ADDR(B(10)),17);             ! FILE NAME
      B(9) = 17
      PRINTSTRING(" ".STRING(ADDR(B(9))))
      NEWLINE
      SKIPMT(4);                        ! HDR2
      LEN=4116    ;! MAX LEN
      READMT(ADDR(B(0)),LEN,FLAG);      ! HDR6
      -> ERRORR UNLESS  FLAG = 0
      -> ERRORF UNLESS  B(9) = X'F6'
      SKIPMT(1);                        ! SKIP TM
      PROMPT("EMAS filename:")
   GETNAME:
      READLINE(FILE)
      STOP  IF  FILE="NO" OR  FILE="STOP" OR  FILE=".END"
      IF  LENGTH(FILE) > 23 THEN  PRINTSTRING("Illegal filename
") AND  -> GETNAME
     IF  FILE="" THEN  SKIPTMMT(2) AND  ->NEXTF
      OPENOMF(FILE,1,1)
      CYCLE  I = 1,1,10000;             ! THROUGH DATA BLOCKS
          LEN=4116   ;! MAX LEN
         READMT(ADDR(B(0)),LEN,FLAG)
         EXIT  IF  FLAG = TM
         -> ERRORR UNLESS  FLAG = 0
         LASTDISP = B(6)<<8+B(7)
         CDISP = 8
         UNTIL  CDISP > LASTDISP THEN  CYCLE 
            RLEN = B(CDISP)<<8+B(CDISP+1)
->ERRORF IF  RLEN<=0
              WRITEOMF(1,ADDR(B(CDISP+4)),RLEN-4)
            CDISP = CDISP+RLEN
         REPEAT 
      REPEAT 
      CLOSEOMF(1)
      NEWLINE
      WRITE(I-1,1)
      PRINTSTRING(" data blocks read")
      SKIPTMMT(1);                      ! PAST TRAILERS TO NEXT FILE
   REPEAT 
   -> END
ERRORF:
 
   PRINTSTRING("
Tape format error")
   MONITOR 
   -> END
ERRORR:
 
   PRINTSTRING("
READMT fails /")
   WRITE(FLAG,1)
END:
 
   UNLOADMT
END 
ENDOFFILE