SPL,L,O,M 
!     NAME:   TR..
!     SOURCE: 92070-18035 
!     RELOC:  92070-16035 
!     PGMR:   G.A.A., A.M.G 
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
      NAME TR..(8) "  92070-1X035  REV.1941  790712"
! 
!     LE GRAND TR ROUTINE 
! 
!  EXTERNAL SUBROUTINES 
      LET EX..      BE SUBROUTINE,EXTERNAL  !FMGR EXIT ROUTINE
      LET GLOBS     BE SUBROUTINE,EXTERNAL  !SET UP GLOBALS 
      LET IER.      BE SUBROUTINE,EXTERNAL,DIRECT !CHECK ERROR (FM.CM)
      LET OPEN.     BE SUBROUTINE,EXTERNAL  !FILE OPEN OR FAKE OPEN 
      LET READF     BE SUBROUTINE,EXTERNAL  !READ RECORD
!  EXTERNAL INTEGERS
      LET .E.R      BE INTEGER,EXTERNAL     !GLOBAL ERROR CODE
      LET CAM.I     BE INTEGER,EXTERNAL     !COMMAND INPUT DCB
      LET CAMS.     BE INTEGER,EXTERNAL     !TRANSFER STACK 
      LET N.OPL     BE INTEGER,EXTERNAL     !SUB-PARAMETER STORAGE
      LET P.TR      BE INTEGER,EXTERNAL     !TRANSFER STACK POINTER 
! 
! 
TR..: SUBROUTINE(N,LIS,ERR) GLOBAL          !TRANSFER SUBROUTINE
       DCB14_[DCB2_@CAM.I+2]+12             !ADDRESS OF RECORD COUNT, TYPE
! 
      PLIST_[NFI,NFA_@LIS+1]+3              !GET PARAMETER ADDRESSES. 
       IFNOT $NFA THEN $NFA_ -1             !MAKE UNIFORM BACK UP 
      IF $NFA < 0 THEN [                    \IF WE ARE GOING BACK 
BADFILE: PTR_P.TR+6*($NFA-1);               \PULL GOODIES FROM
         IF PTR < @CAMS. THEN PTR _ @CAMS.; \IF TOO FAR, GO TO FIRST
         RC_ $([CR_[NFI_PTR+1]+3]+2);       \SET REST OF STACK
         IF N.OPL < 0 THEN RC_RC+N.OPL;     \IF BACK SPACE REQUESTED
         IF RC < 0 THEN RC_0;               \SET IT UP
         RS_$[P.TR_PTR]],                   \LOOKS GOOD LETS BUY IT 
       ELSE [                               \GOING FORWARD
         RC_0;                              \SET POINTERS FOR RETURN
         CR,PTR_@N.OPL;                     \AND THE CALL 
         IF P.TR-@CAMS. > 48 THEN [         \IF TOO DEEP
            ERR _ 13; RETURN]               \TAKE GAS.
       ]                                    !LOOKS GOOD , LETS DO IT
      CALL GLOBS(N-1,$PLIST,1) ?            \SET UP GLOBALS.
          [ERR _ 48;  RETURN]               !ERROR IN GLOBAL SET. 
      OPEN.(CAM.I,$NFI,$CR  ,411K)          !OPEN NEW INPUT FILE. 
      IF .E.R < 0 THEN[                     \IF ERROR AND HERE THEN SV>3
         N.OPL,$NFA_0;GO TO BADFILE]        !MUST REOPEN ORGIONAL FILE
       $PTR_RS                              !RESET RECORD COUNT 
      IF RC THEN [                          \IF NEEDED. 
        IF $DCB2 THEN[                      \(MUST NOT BE TYPE ZERO)
         UNTIL $DCB14 = RC DO [             \READ AS MANY RECORDS 
            READF(CAM.I,.E.R ,C.BUF,1);     \AS NECESSARY FOR 
            IER.]]]                         !POSITIONING. 
      RETURN
      END 
! 
      END 
     END$ 
                                                                                        