!
%EXTERNALROUTINE BCONV(%STRING(255) PARMS)
!
!  This routine is used to convert files read from VME/B tapes
!  into character files performing the deblocking of blocks
!  read from the tape and the necessary character code conversions.
!  The files required should be read down from the tape into
!  DATA files in an EMAS process.  This can be conveniently
!  done using the FROMTAPE utility specifying physical
!  files on the tape.  For a single file this is quite simple, eg.
!         FROMTAPE(VMEBTP,P5(U3000,3000),OUTFILE(DATA))
!  For several files it is necessary to process them one at a time
!  or use the more complex facility in FROMTAPE to 
!  process a series of files but skipping the VME/B file
!  labels, eg.
!        FROMTAPE(VMEBTP,P(5-29*3)(U3000,3000),OUTFILE(DATA))
!  This would produce the files OUTFILE, OUTFILE2, , ,OUTFILE9
!
!  The use of the figure 3000 in the examples above is 
!  normally sufficient to accomodate VME/B files which
!  seldom have blocksizes graeter than 2054 bytes.
!
!  Then this conversion routine would have to be applied to all
!  the files thus produced.
!
!  This routine takes a single parameter defining the format
!  of the file as recorded on the tape, ie the VME/B format.
!  This format is found in the file header labels.
!  Two I/O channels have to be defined:
!  Channel 70 must defined the input data as copied from the tape.
!  Channel 71 must define the file to be used for output.
!
!  If anyone using this software finds a bug in it, I shall be
!  only too pleased to hear how they fixed it so that I can
!  incorporate the amendment into my version for the benefit
!  of all other users.
!                             Brian Murdoch, ERCC.
!
%SYSTEMROUTINESPEC MOVE (%INTEGER LEN,FROM,TO)
%SYSTEMROUTINESPEC DUMP (%INTEGER START,FINISH)
%SYSTEMROUTINESPEC ETOI (%INTEGER ADDRESS,LEN)
%EXTERNALROUTINESPEC OPENSQ(%INTEGER CHAN)
%EXTERNALROUTINESPEC CLOSESQ(%INTEGER CHAN)
%EXTERNALROUTINESPEC READSQ(%INTEGER CHAN,%NAME S,F)
%EXTERNALROUTINESPEC READLSQ(%INTEGER CHAN,NAME S,F,%INTEGERNAME LEN)
%EXTERNALROUTINESPEC WRITESQ(%INTEGER CHAN,%NAME S,F)
!
%CONSTINTEGER INPUTCHAN=70,OUTPUTCHAN=71
%CONSTSTRING(1)%ARRAY FORMS(1:5) = "U","F","V","S","X"
%CONSTINTEGER MAXBLKLEN = 10000
!
%INTEGER FLAG,BLKLEN,BLOCK COUNT,RECORD COUNT,RECEND
%INTEGER LAST REC,EOD,RECPTR,RECLEN,FORMAT,I,OUTRECLEN
%INTEGER BUFFADDR
%INTEGER ZLRECCOUNT,SEGLEN,SPANBITS,PTR,MAXRECLEN
%BYTEINTEGERARRAY BUFFER(0:MAXBLKLEN)
%STRING(1) SFORM
%STRING(32) FILE
%SWITCH F(1:4)
%SWITCH S(0:3)
!
%ON %EVENT 9 %START
    -> EOF
%FINISH
!
%ROUTINE FAIL (%STRING(100) MSG)
!
SELECT OUTPUT (0)
NEWLINE
PRINTSTRING(MSG)
NEWLINE
%STOP
%END     ;!  OF FAIL
!
%ROUTINE WRITE RECORD
!
%IF RECORD COUNT = 0 %THEN %START
    SELECT OUTPUT (OUTPUT CHAN)
%FINISH
ETOI(ADDR(BUFFER(RECPTR+4)),RECLEN - 4)
RECEND = RECPTR + RECLEN - 1
%WHILE BUFFER(RECEND) = ' ' %THEN RECEND = RECEND - 1
%IF RECEND - RECPTR > 3 %THEN %START
    %CYCLE I = RECPTR + 4,1,RECEND
        PRINTSYMBOL(BUFFER(I))
    %REPEAT
%FINISH
NEWLINE
!
%RETURN
%END     ;!  OF WRITE RECORD
!
SFORM = PARMS
%CYCLE FORMAT = 1,1,5
    %EXIT %IF SFORM = FORMS(FORMAT)
%REPEAT
%IF FORMAT > 4 %THEN %START
    PRINTSTRING("INVALID FORMAT")
    %STOP
%FINISH
!
FLAG = 0
BLKLEN = 2054
RECORD COUNT = 0
MAXRECLEN = 255
RECLEN = 0
BLOCK COUNT = 0
OPENSQ(INPUTCHAN)
BUFFADDR = ADDR(BUFFER(0))
%WHILE FLAG = 0 %CYCLE
    BLKLEN = 2054
    !READLSQ(INPUTCHAN,BUFFER(0),BUFFER(BLKLEN-1),BLKLEN)
    READSQ(INPUTCHAN,BUFFER(0),BUFFER(2053))
    !%IF BLKLEN = 0 %THEN %EXIT
    LASTREC = BUFFER(6)<<8 + BUFFER(7) + 6
    EOD = LASTREC +               %C
          BUFFER(LASTREC)<<8 +    %C
          BUFFER(LASTREC + 1)
    RECPTR = 8
    %WHILE RECPTR < EOD %CYCLE
        -> F(FORMAT)
!
F(3):        !  VARIABLE
        RECLEN = BUFFER(RECPTR)<<8 + BUFFER(RECPTR + 1)
        %IF RECLEN < 5 %THEN %START
            %MONITOR
            PRINTSTRING("INVALID RECORD LENGTH")
            %STOP
        %FINISH
        WRITE RECORD
        RECORD COUNT = RECORD COUNT + 1
        RECPTR = RECPTR + RECLEN
        -> FEND
!
F(4):   !  SPANNED
        !
        !  ONLY EVER GET TO THIS POINT WITH A COMPLETELY
        !  EMPTY BUFFER, IE. WHEN STARTING A FILE OR WHEN A RECORD
        !  ENDED EXACTLY AT THE END OF A BLOCK RATHER THAN
        ! SPANNING INTO THE FOLLOWING BLOCK.
        !
        -> S(BUFFER(RECPTR+2)&X'03')
S(2):   !  A TERMINATING SEGMENT
S(3):   !  AN INTERMEDIATE SEGMENT
        %MONITOR
        FAIL("INVALID SPANNED RECORD FORMAT")
S(0):   !  COMPLETE RECORD
        ->F(3)
        !
S(1):   !  A FIRST SEGMENT.  BY DEFINITION, THIS MUST BE THE LAST
        !  SEGMENT IN THIS BLOCK AND THE RECORD MUST SPAN INTO
        !  THE NEXT BLOCK.
        SEGLEN = BUFFER(RECPTR)<<8 + BUFFER(RECPTR+1)
        %IF RECPTR > 8 %THEN %START
            !  SEGMENT NOT NEAR ENOUGH TO THE START OF THE BUFFER
            !  MUST MOVE IT BACK TO THE START OF THE BUFFER.
            MOVE(SEGLEN,BUFFADDR+RECPTR,BUFFADDR)
            RECPTR = 0
            EOD = SEGLEN
        %FINISH
        !  NOW HAVE TO READ IN SUCCESSIVE BLOCKS UNTIL THE SEGMENT
        !  TERMINATING THE CURRENT RECORD IS FOUND
        !
        RECLEN = SEGLEN
        %CYCLE
            BLKLEN = 2054
            !READMT(BUFFADDR+EOD,BLKLEN,FLAG)
            READSQ(INPUT CHAN,BUFFER(EOD),BUFFER(EOD + BLKLEN))
!            %IF FLAG # 0 %THEN   %START
!            %MONITOR
!            %IF FLAG = 1 %THEN FAIL("PREMATURE EOF IN SPANNED FILE")
!            FAIL ("I/O ERROR")
!            %FINISH
            BLOCK COUNT = BLOCK COUNT + 1
            LASTREC =EOD + BUFFER(EOD+6)<<8 + BUFFER(EOD+7) + 6
            SEGLEN = BUFFER(EOD+8)<<8 + BUFFER(EOD+9)
            SPANBITS = BUFFER(EOD+10)&X'03'
            PTR = EOD
            EOD = LASTREC +         %C
                  BUFFER(LASTREC)<<8 +       %C
                  BUFFER(LASTREC+1) -12
            !  THIS FIGURE OF 12 IS MADE UP OF THE RED TAPE
            !  FOR THE BLOCK PLUS THE RED TAPE FOR THE
            !  FIRST SEGMENT IN THE BLOCK.  'EOD' IS REDUCED 
            !  BY THIS AMOUNT BECAUSE THE FIRST SEGMENT IS
            !  MOVED WITH THE REST OF THE BLOCK TO BE
            !  ADJACENT TO THE PRECEDING PART OF THE
            !  CURRENT RECORD.
            !
            RECLEN = RECLEN + SEGLEN - 4
            MOVE(EOD-PTR,BUFFADDR+PTR+12,BUFFADDR+PTR)
            %IF SPANBITS = 2 %THEN %EXIT
        %REPEAT
        !  HAVE NOW GOT COMPLETE RECORD CONSTRUCTED
        %IF RECLEN > MAXRECLEN %THEN %START
            !  RECORD LONGER THAN ALLOWED
            %MONITOR
            FAIL("RECORD TOO LONG")
        %FINISH
        WRITE RECORD
        RECORD COUNT = RECORD COUNT + 1
        RECPTR = RECPTR + RECLEN
        -> SWEND
        !
SWEND:
    -> FEND
!
FEND:
    %REPEAT
%REPEAT
!
EOF:
CLOSESQ(INPUTCHAN)
!CLOSESQ(OUTPUTCHAN)
SELECT OUTPUT(0)
CLOSESTREAM(OUTPUTCHAN)
WRITE(RECORD COUNT,0)
PRINTSTRING(" RECORDS WRITTEN TO OUTPUT FILE")
NEWLINE
!
%END     ;!  OF BCONV
%ENDOFFILE