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$