SPL,L,O,M 
!     NAME:   LI..
!     SOURCE: 92071-18023 
!     RELOC:  92071-16023 
!     PGMR:   G.A.A.
!     MOD:    M.L.K., E.D.B.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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 LI..(7) "92071-1X023 REV.2041 800711"
! 
!     LI.. IS THE RTE FMGR FILE LIST MODULE 
!          IT IS ENTERED ON COMMAND 
! 
!     LI,NAMR,TY,FREC,LREC
!             -- ---- ----
! 
!     WHERE:
! 
!     NAMR   IS THE NAME REFERENCE INCLUDING
!                 SECURITY CODE AND DISC ID 
! 
!     TY     IS THE LISTING TYPE AND IS ASCII:
! 
!            S OR A OR NULL SOURCE WITH LINE NUMBERS
!            B              BINARY DUMP 
!            D              DIRECTORY HEAD ONLY 
! 
!     FREC   IS THE FIRST RECORD TO PRINT 
! 
!     LREC   IS THE LAST RECORD TO PRINT
! 
! 
!     LISTING FORMAT: 
! 
!L1   NNNNNN  T=TTTTT IS ON CR CCCCC USING BBBB BLKS R=RRRR 
!L2                                   (TIME)
!L3 
! 
!     WHERE:
! 
!     NNNNNN IS THE FILE NAME (OR ****** IF LU) 
!     TTTTT  IS THE FILE TYPE 
!     CCCCC  IS THE CARTRIDGE REFERENCE NUMBER (OR LU IF TYPE 0)
!     BBBB   IS THE FILE EXTENT SIZE
!     RRR    IS THE RECORD LENGTH 
! 
!     S FORMAT: 
!     A 4 DIGIT LINE NUMBER FOLLOWED BY TWO BLANKS FOLLOWED 
!     BY THE ASCII RECORD.
! 
!     B FORMAT IS : 
!       A) THE RECORD HEAD: REC# XXXXX
!       B) N LINES FORMATED AS FOLLOWS: 
!          8 5-DIGIT OCTAL NUMBERS SEPERATED BY BLANKS
!          AND FOLLOWED BY A "*" FOLLOWED BY THE
!          16 ASCII CHARACTERS THE DIGITS REPRESENT.
!          NON-PRINTING CHARACTERS WILL BE FILLED 
!          WITH BLANKS
! 
!     D FORMAT: 
!     ONLY THE HEADER IS PRINTED. 
! 
!  EXTERNAL SUBROUTINES 
      LET EXEC      BE SUBROUTINE,EXTERNAL
      LET CONV.     BE SUBROUTINE,EXTERNAL
      LET JER.      BE SUBROUTINE,EXTERNAL,DIRECT 
      LET L.OPN     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET L.HED     BE SUBROUTINE,EXTERNAL
      LET L.WRT     BE SUBROUTINE,EXTERNAL
      LET L.SPC     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET L.WEF     BE SUBROUTINE,EXTERNAL,DIRECT 
      LET OPEN.     BE SUBROUTINE,EXTERNAL
! 
      LET LOCF      BE SUBROUTINE,EXTERNAL
      LET POSNT     BE SUBROUTINE,EXTERNAL
      LET READF     BE SUBROUTINE,EXTERNAL
      LET CR.LU     BE SUBROUTINE,EXTERNAL
! 
!  INTERNAL SUBROUTINES 
      LET SETA      BE SUBROUTINE,DIRECT
! 
!  EXTERNAL VARIABLES 
      LET BUF.      BE INTEGER,EXTERNAL 
      LET I.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
      LET .E.R      BE INTEGER,EXTERNAL 
! 
!  INTERNAL CONSTANTS 
      LET BL.BL     BE CONSTANT (20040K)         !"  "
      LET BL.T      BE CONSTANT (20124K)         !" T"
      LET EQ.BL     BE CONSTANT (36440K)         !"= "
      LET BL.I      BE CONSTANT (20111K)         !" I"
      LET S.BL      BE CONSTANT (51440K)         !"S "
      LET O.N       BE CONSTANT (47516K)         !"ON"
      LET BL.C      BE CONSTANT (20103K)         !" C"
      LET R.BL      BE CONSTANT (51040K)         !"R "
      LET BL.L      BE CONSTANT (20114K)         !" L"
      LET U.BL      BE CONSTANT (52440K)         !"U "
      LET BL.U      BE CONSTANT (20125K)         !" U"
      LET S.I       BE CONSTANT (51511K)         !"SI"
      LET N.G       BE CONSTANT (47107K)         !"NG"
      LET BL.B      BE CONSTANT (20102K)         !" B"
      LET L.K       BE CONSTANT (46113K)         !"LK"
      LET R.EQ      BE CONSTANT (51075K)         !"R="
      LET A.BL      BE CONSTANT (40440K)         !"A "
      LET B.BL      BE CONSTANT (41040K)         !"B "
      LET D.BL      BE CONSTANT (42040K)         !"D "
      LET R.E       BE CONSTANT (51105K)         !"RE"
      LET C.NO      BE CONSTANT (41443K)         !"C#"
      LET F.I       BE CONSTANT (43111K)         !"FI"
      LET L.E       BE CONSTANT (46105K)         !"LE"
      LET ST.ST     BE CONSTANT (25052K)         !"**"
! 
!  INTERNAL BUFFERS 
      LET LSTBF(2)  BE INTEGER
      LET LNNO      BE INTEGER
      LET BLWD      BE INTEGER
      LET LBF(128)  BE INTEGER
! 
LI..: SUBROUTINE(N,LIS,ER) GLOBAL 
      IFNOT N THEN [ER_ 50 ;RETURN]              !NO PARMS, EXIT
! 
      NUL_ 0; OPFL_411K                          !SET DFLT OPEN OPTION
      FR_[TYPF_[LIS3_[LIS2_[LIS1_ @LIS+1]+1]+1]+2]+4 !
! 
      LR_ $(FR+4); FR_ $FR                       !GET FIRST AND LAST REC
      IFNOT LR    THEN LR_ FR                    !SET LAST RECORD 
      IF    FR<1  THEN FR_ 1                     !SET DEFAULT 
      IF    LR<1  THEN LR_ 32767                 !SET DEFAULT 
! 
      TYPF_ ($TYPF AND 177400K)+40K              !GET REQUESTED FORMAT
      IF TYPF=40K   THEN [NUL_ 1; TYPF_ S.BL]    !CHANGE TO CORRECT 
      IF TYPF=A.BL  THEN TYPF_ S.BL              !FORMATS 
! 
      IF TYPF=D.BL  THEN GOTO TYPOK              !CHECK FOR LEGAL 
      IF TYPF=B.BL  THEN [OPFL_311K; GOTO TYPOK] !FORMAT
      IF TYPF=S.BL  THEN GOTO TYPOK 
      ER_ 56                                     !BAD FORMAT SO 
      RETURN                                     !RETURN ERROR
! 
TYPOK:OPEN.(I.BUF,$LIS1,N.OPL,OPFL)              !OPEN FILE TO BE LISTED
      LOCF(I.BUF,ER,ER,ER,ER,NSEC,FLU,FTYP,RECS)
! 
      IFNOT NUL     THEN GOTO OK                 !IF NULL, GOT RIGHT FORMAT 
      IFNOT FTYP    THEN GOTO OK                 !TYPE ZERO DFLT IS ASC 
      IF    FTYP=3  THEN GOTO OK                 !SAME FOR TYPE 3 
      IF    FTYP=4  THEN GOTO OK                 !SAME FOR TYPE 4 
      TYPF_B.BL                                  !ELSE USE BINARY FORMAT
! 
OK:   L.OPN                                      !OPEN LIST FILE
      BUF._ BL.BL 
      TB_ @BUF.+1                                !SET POINTERS
! 
!     WRITE FIRST HEADER LINE 
! 
      FOR T_ TB TO TB+36 DO $T_ BL.BL            !BLANK THE BUFFER
      P_ @BUF.                                   !SET BUFFER POINTER
! 
!!!!!!SETA(F.I); SETA(L.E); SETA(EQ.BL)          !PUT "FILE= " IN BUFFER
! 
      IF LIS=3 THEN [                            \IF DISC FILE
          SETA($LIS1); SETA($LIS2); SETA($LIS3)], \PUT FILE NAME IN BUFFER
      ELSE [                                     \ OTHERWISE
          SETA(ST.ST); SETA(ST.ST); SETA(ST.ST)] ! PUT "******" IN BUFFER 
! 
!!!!!!L.HED(BUF.)                                !WRITE FIRST HEADER LINE 
!!!!!!
!!!!!!WRITE SECOND HEADER LINE
!!!!!!
!!!!!!FOR T_ TB TO TB+36 DO $T_ BL.BL            !BLANK THE BUFFER
!!!!!!P_ @BUF.                                   !SET BUFFER POINTER
! 
      SETA(BL.T); SETA(EQ.BL)                    !PUT " T= " IN BUFFER
      CONV.(FTYP,$[P_P+2],5)                     !PUT FILE TYPE IN BUFFER 
! 
      SETA(BL.I); SETA(S.BL); SETA(O.N)          !PUT " IS ON" IN BUFFER
      IF FTYP THEN [                             \IF DISC FILE
          SETA(BL.C); SETA(R.BL);                \PUT " CR " IN BUFFER
          CR.LU(-FLU,T,T,CRN);                   \GET CRN 
          IF CRN > 20000K THEN SETA(CRN),         \PUT ASCII CRN OR 
                          ELSE CONV.(CRN,$[P_P+3],5)], \NUMERIC CRN IN BUFFER 
      ELSE[                                      \OTHERWISE USE LU
          SETA(BL.L); SETA(U.BL);                \PUT " LU " IN BUFFER
          CONV.(FLU,$[P_P+1],2)]                 !
! 
      IF FTYP THEN[                              \IF DISC FILE, 
          SETA(BL.U); SETA(S.I); SETA(N.G);      \PUT " USING" IN BUFFER
          CONV.(NSEC/2,$[P_P+3],5);              \PUT FILE SIZE IN BUFFER 
          SETA(BL.B); SETA(L.K);                 \PUT " BLKS R=" IN BUFFER
          SETA(S.BL); SETA(R.EQ);                \
          CONV.(RECS,$[P_P+2],4)]                !PUT RECORD LEN IN BUFFER
! 
      L.WRT(BUF.,P-TB+2)                         !WRITE THE HEADER
! 
!     WRITE SECOND HEADER LINE
! 
      FOR T_ TB TO TB+36 DO $T_ BL.BL            !BLANK THE BUFFER
      L.HED(BUF.)                                !WRITE THE HEADER
! 
!     START LIST PROCESSING 
! 
      IF TYPF=D.BL THEN GOTO EOF                 !DONE IF HEAD ONLY 
      L.SPC                                      !SPACE A LINE
      IF FTYP=6 THEN $(@I.BUF+2)_1               !FORCE TYPE 6 TO 1 
! 
      RC_ FR                                     !SET FIRST RECORD NUMBER 
      POSNT(I.BUF,.E.R,FR,1)                     !LOCATE FIRST RECORD 
      JER.                                       !CHECK FOR ERRORS
! 
NEXT: IF RC>LR THEN GOTO EOF                     !CHECK IF FINISHED 
      READF(I.BUF,.E.R,LBF,128,L)                !READ RECORD 
      IF .E.R = -12 THEN GOTO EOF                !IF EOF, GO EXIT 
      JER.                                       !CHECK FOR ERRORS
      IF L<0 THEN GOTO EOF                       !SOFT EOF? 
! 
      IFNOT TYPF=S.BL THEN GOTO BIN              !IF SOURCE LISTING 
! 
!     WRITE ASCII RECORD
! 
      CONV.(RC,LNNO,4)                           !PUT RECORD NUMBER IN
      BLWD_ BL.BL                                !BUFFER
      L.WRT(LSTBF,L+4)                           !WRITE THE LINE
      GOTO NEXTR                                 !AND DO NEXT RECORD
! 
!     WRITE BINARY RECORD 
! 
BIN:  P_ @BUF.                                   !SET UP BUFFER POINTER 
      SETA(R.E); SETA(C.NO); SETA(BL.BL)         !PUT "REC#  " IN BUFFER
      CONV.(RC,$[P_P+2],5)                       !PUT RECORD # IN BUFFER
      L.SPC                                      !SPACE A LINE
      L.WRT(BUF.,6)                              !WRITE THE RECORD NUMBER 
      L.SPC                                      !SPACE A LINE
! 
      IFNOT L THEN GOTO NEXTR                    !CHECK FOR NO DATA 
! 
      F_@LBF                                     !SET BUFFER POINTER
! 
NEXTL:FOR T_TB TO TB+36 DO $T_BL.BL              !CLEAR BUFFER
      P,ST_[WP_TB]+27                            !INITIALIZE POINTERS 
      UP_ -1                                     !SET UPPER FLAG TRUE 
! 
      REPEAT 8 TIMES DO [                        \
          IF [HI_$F->8 AND 177K]>137K OR HI<40K THEN HI_ 40K; \ 
          IF [LOW_ $F AND 177K]>137K OR LOW<40K THEN LOW_ 40K; \
          SETA((HI-<8) + LOW);                     \
          T2_ [T_$F-<1] AND 1;                   \
          $WP_[IF UP THEN (T2-<8)+([T_T-<3] AND 7)+30060K, \
                     ELSE T2 + 20060K];          \
          REPEAT 2 TIMES DO[                     \
              $[WP_WP+1]_(([T_T-<3] AND 7)-<8)+  \
                         ([T_T-<3] AND 7)+ 30060K]; \ 
          IFNOT UP THEN $[WP_WP+1]_(((T-<3) AND 7)-<8)+30040K; \
          WP_WP+1;                               \
          UP_ NOT UP;                            \
          F_ F+1;                                \
          IFNOT [L_L-1] THEN GOTO PREPR]         !
! 
PREPR:P_ P+1
! 
LNCK: IF $[P_P-1]=BL.BL THEN GO TO LNCK          !FIND LAST NON-BLANK 
      $ST_  $ST+12K                              !SET THE STAR SEPARATOR
      L.WRT(BUF.,P-TB+2)                         !WRITE THE LINE
! 
      IF L THEN GOTO NEXTL                       !CHECK FOR MORE DATA 
! 
NEXTR:RC_ RC+1                                   !INCREMENT REC COUNT 
      GOTO NEXT                                  !DO NEXT 
! 
EOF:  L.WEF                                      !WRITE EOF 
      RETURN
      END 
! 
!     SETA: STEP P AND SET PARAMETER INTO $P
! 
SETA: SUBROUTINE(PRA) DIRECT
      $[P_P+1]_PRA
      RETURN
      END 
      END 
! 
      END$
                                                                                    