SPL,L,O,M ! NAME: LI.. ! SOURCE: 92070-18023 ! RELOC: 92070-16023 ! PGMR: G.A.A. ! MOD: M.L.K. ! ! *************************************************************** ! * (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 LI..(7) " 92070-1X023 REV.1941 790712" ! ! ! 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 FIRST RECORD TO PRINT ! ! LREC LAST RECORD TO PRINT ! ! ! EACH LISTING WILL BE PROCEEDED BY THE HEAD: ! ! NAMEL T=XXXXX IS ON PK XXXXX USING XXXX BLKS R=XXXX ! XX:XX AM MON., XX DEC., 1978 ! ! ! ! ! ! S FORMAT IS A BLANK FOLLOWED BY 4 DIGIT ! LINE NUMBER FOLLOWED BY TWO BLANKS FOLLOWED ! BY THE 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 REP. ! NON-PRINTING CHARACTERS WILL BE FILLED ! WITH BLANKS ! ! D FORMAT IS THE HEAD ONLY ! ! ! EXTERNAL SUBROUTINES LET CONV. BE SUBROUTINE,EXTERNAL LET DR.RD BE SUBROUTINE,EXTERNAL LET EXEC BE SUBROUTINE,EXTERNAL LET FTIME BE SUBROUTINE,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT LET LOCF BE SUBROUTINE,EXTERNAL LET OPEN. BE SUBROUTINE,EXTERNAL LET READF BE SUBROUTINE,EXTERNAL LET WRITF BE SUBROUTINE,EXTERNAL ! EXTERNAL FUNCTIONS LET IFTTY BE FUNCTION,EXTERNAL ! EXTERNAL VARIBLES LET .E.R BE INTEGER,EXTERNAL LET BUF. BE INTEGER,EXTERNAL LET D.LB BE INTEGER,EXTERNAL LET I.BUF BE INTEGER,EXTERNAL LET N.OPL BE INTEGER,EXTERNAL LET O.BUF BE INTEGER,EXTERNAL LET TMP. BE INTEGER,EXTERNAL ! INTERNAL SUBROUTINES LET SETA BE SUBROUTINE,DIRECT LET SPACE BE SUBROUTINE,DIRECT LET WRIT BE SUBROUTINE,DIRECT ! INTERNAL CONSTANTS ! HL 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 DST 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(NOC,LIS ,ER) GLOBAL ! IFNOT NOC THEN[ ER_ 50 ;RETURN] !NO PARMS, EXIT OPFL_411K !SET DFLT OPEN OPTION NUL_0 !PRESET NULL PRAM FLAG LR_ $([FR_[TYPF_[LIS1_ @LIS+1]+4]+4]+4) ! TYPF_($TYPF AND 177400K)+40K IF [FR_$FR] THEN[ \SET FIRST AND LAST REC IFNOT LR THEN LR_ FR] !DEFAULTS IF TYPF=A.BL THEN GOTO STYP !CHECK FOR IF TYPF=40K THEN[NUL_1;GO TO STYP] !LEGAL IF TYPF=D.BL THEN GOTO TYPOK !OPTIONS IF TYPF=B.BL THEN[OPFL_311K;GO TO TYPOK] !NULL A,S,B,D IF TYPF#S.BL THEN [ER_56;RETURN] !NO, RETURN 56 ! STYP: TYPF_S.BL !FORCE NULL,ATOS TYPOK:OPLS_ @TMP.+3 !GET LIST UNIT OP LIST OPEN.(I.BUF,TMP.,$OPLS, 0) !OPEN LIST FILE OPEN.(O.BUF,$LIS1,N.OPL,OPFL) !OPEN FILE TO BE LISTED ! LOCF(O.BUF,.E.R ,LP,LP,LP,NSEC,FLU,FTYP,RECS) IFNOT NUL THEN GOTO OK !IF NULL, CHOSE RITE OPTION 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 CTYP: TYPF_B.BL !ELSE USE BINARY FORMAT ! OK: LOCF(I.BUF,.E.R ,LP,LP,LP,LP,LLU) !GET LIST LU EXEC(13,LLU,DVT6) !GET LIST LU TYPE CODE P36_[P3_@LIS +4]+33 !SET UP LIST ADDRESSES LP_1 !SET LINE PRINTER FLAG IF (DVT6 AND 37400K)<5000K THEN LP_0 TTY_IFTTY(LLU) !INTERACTIVE DEVICE? FOR T_ P3 TO P36 DO[$T_20040K] !BLANK THE BUFFER P_P3-1 SETA(BL.T) !SET BLANK T SETA(EQ.BL) !SET = BLANK P_P+2 CONV.(FTYP,$P,5) !SET TYPE SETA(BL.I) !SET BLANK I SETA(S.BL) !SET S BLANK SETA (O.N) !SET ON IF FTYP THEN[SETA(BL.C);SETA(R.BL);DR.RD(1,-FLU,\ 0);T_$$@D.LB;N_5],\ ELSE[SETA(BL.L);SETA(U.BL);T_FLU;N_2] P_P + N/2 CONV.(T,$P,N) IFNOT FTYP THEN[N_13;GO TO WRHD] SETA(BL.U) !SET USING SETA(S.I ) SETA(N.G ) P_P+3 ! CONV.(NSEC/2,$P,5) ! SETA(BL.B) !SET BLKS R= SETA(L.K) SETA(S.BL) SETA(R.EQ) ! P_P+2 ! CONV.(RECS,$P,4) ! N_27 ! WRHD: TB_[BF_[IF TYPF=S.BL THEN @LSTBF,ELSE @BUF.]]+1 $BF_20040K !BLANK FIRST WORD P_LIS1 FOR T_TB TO TB+N DO [$T_$P;P_P+1] !MOVE LINE IF LIS #3 THEN[$([P_TB+1]+1)_DST; \IF FAKE FILE, REPLACE NAME $P_DST;$TB_DST] !WITH "******" WRIT !WRITE THE HEAD ! ! WRITE OUT DATE AND TIME ! P_ BF !RESET BUFFER POINTER FOR I_ 1 TO 4 DO[ SETA(20040K)] !SPACE OVER FTIME($[P_ P+1]) !GET DATE AND TIME N_ 19 !SET LINE LENGTH WRIT !WRITE OUT LINE ! IF TYPF=D.BL THEN GOTO EOF !DONE IF HEAD ONLY SPACE !SPACE A LINE IF FTYP=6 THEN $(@O.BUF+2)_1 !FORCE TYPE 6 TO 1 RC_1 NEXT: P_BF !INITIALIZE BUFFER POINTER SETA(R.E) !SET UP SETA(C.NO) !REC# XXXXX SETA(20040K) P_P+2 CONV.(RC,$P,5) !SET NUMBER READF(O.BUF,.E.R ,LBF,128,L) !READ RECORD IF .E.R = -12 THEN GO TO EOF !IF EOF, GO EXIT JER. !CHECK FOR ERRORS IF L <0 THEN GOTO EOF !SOFT EOF? IF RC < FR THEN GOTO NEXTR !SKIP TO FIRST REC N_L+3 IF TYPF=S.BL THEN[CONV.(RC,LNNO,4);BLWD_20040K;\ L_0;GO TO WRTIT] !JUST LISTING, GO WRIT ! SPACE !SPACE A LINE N_5 !WRITE THE RECORD NUMBER WRIT ! SPACE !SPACE A LINE ! F_@LBF !SET BUFFER POINTER NEXTL:IFNOT L THEN[ \IF NO DATA GET NEXT NEXTR: RC_ RC+1; \INCREMENT REC COUNT IF LR THEN[ IF RC > LR THEN GOTO EOF]; \END OF RANGE? GOTO NEXT] !DO NEXT P_[ST_[WP,T_TB]+27]+1 !INITIALIZE POINTERS REPEAT 36 TIMES DO[ $T_20040K; T_T+1] UP_ -1 !SET UPPER FLAG TRUE REPEAT 8 TIMES DO THRU PTSTP IF[T2_ [T_$F]AND 77400K]>57400K THEN GOTO BLANK IF T2>17777K THEN GOTO OKUP ! BLANK:T_ (T AND 177K)+20000K ! OKUP: IF [T2_($F AND 177K)]<140K THEN[IF T2> 37K THEN\ GO TO OKLOW] ! T_ (T AND 77400K) +40K ! OKLOW:DO[ $P_T AND 77577K;P_P+1] ! 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] ! IF UP THEN GOTO PTSTP ! $[WP_WP+1]_(((T-<3) AND 7)-<8)+30040K ! PTSTP:DO[WP_WP+1;UP_NOT UP;F_F+1;IFNOT [L_L-1] THEN\ GO TO PREPR] ! ! PREPR:IF $[P_P-1]=20040K THEN GO TO PREPR !FIND LAST !NON BLANK N_ P-TB+1 !PRINT LENGTH ! $ST_ $ST +12K !SET THE STAR SEPARATOR ! WRTIT:WRIT !TRANSMIT THE LINE ! GOTO NEXTL !GO DO NEXT LINE ! EOF: WRITF(I.BUF,.E.R ,$BF,-1) !WRITE EOF JER. ! RETURN END ! ! SETA: SUBROUTINE(PRA)DIRECT !STEP P AND SET PRA IN P INDIRECT $[P_P+1]_PRA RETURN END ! ! WRIT: SUBROUTINE DIRECT!WRITE ON I.BUF BUFFER AT BF IF LP !OR TB IF NOT LP WITH LENGTH N+LP !IF TTY -LIMIT LENGTH TO 72. IF TTY THEN[IF N>36 THEN N_36] WRITF(I.BUF,.E.R ,$(TB-LP),N+LP) JER. RETURN END ! ! SPACE:SUBROUTINE DIRECT !SPACE THE LIST DEVICE N_1 !SET LENGTH TO ONE WORD DO[T_$TB;$TB_ 20040K]!SET BLANK IN BUFFER WRIT !WRIT BLANK LINE $TB_T !RESTORE OLD CONTENTS RETURN !RETURN END END END$