Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
prtutl.bli
There are no other files named prtutl.bli in the archive.
!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
%%
%
THIS MODULE CONTAINS ALL THE REPORT PRINTING UTILITY ROUTINES
PUTLIN - PRINTS A LINE WITH <CRLF>
PUTSKP - PRINTS A <CRLF>
PUTPAG - PRINTS A <FF> FOLLOWED BY THE HEADER FOR THE CURRENT REPORT
COLUMN - FORCES NEXT CHAR IN LINE TO APPEAR AT SPECIFIED COLUMN
UPDATE - INSERTS RANDOMNESS IN A LINE AND UPDATES THE GOODIES
INITLN - CLEARS AND INITIALIZES A LINE
MAKHDR - MAKES PAGE HEADERS FOR EACH REPORT
%
%%
MODULE PRTUTL (MLIST,FSAVE,TIMER=EXTERNAL(SIX12)) =
BEGIN
REQUIRE COMMON.BLI;
REQUIRE ENTRY.BLI;
COMMENT(PUTLIN);
! SUBROUTINE PUTLIN
! ========== ======
! THIS ROUTINE INSERTS A LINE IN THE OUTPUT FILE,
! PRECEEDED BY THE REPORT NAME, AND OPTIONALLY
! REINITIALIZES THE LINE BUFFER. NOTE THAT
! PUTLIN CALLS PUTPAG WHICH CALLS PUTLIN AGAIN.
! LAST MODIFIED ON 1 AUG 74 BY JG.
GLOBAL ROUTINE PUTLIN(LINEPTR,ERASE) =
BEGIN
LOCAL ERRORCODE,HDRPTR;
MAP PRINTLINE LINEPTR,
HEADER HDRPTR,
REPBLK CURREP;
BIND CRLF = PLIT ASCII '?M?J';
MACRO ERCHECK =
IF .ERRORCODE IS -1 ! MEANS OUTPUT I/O ERROR
THEN BEGIN
ERTEXT(35); PRTSPC(.OTCHNL); ! PRINT MSG
RETURN FALSE ! RETURN SHAMEFULLY
END$;
IF .CURREP[NAMECOUNT] GTR 0 ! PRINT REPORT NAME ONLT IF ONE WAS SPECIFIED
THEN BEGIN
ERRORCODE _ OTBYT(.OTCHNL,.CURREP[NAMECOUNT],CURREP[REPORTNAME]<FIRSTINCR>);
ERCHECK;
END;
ERRORCODE _ OTBYT(.OTCHNL,.LINEPTR[LINECT],LINEPTR[LINEST]<FIRSTINCR>); ! PRINT THE LINE
ERCHECK;
ERRORCODE _ OTBYT(.OTCHNL,2,CRLF<FIRSTINCR>); ! AND ADD THE <CRLF>
ERCHECK;
IF .ERASE THEN INITLN(.LINEPTR); ! WANT TO REINITIALIZE THE LINE
HDRPTR _ .CURREP[PAGEHEADPTR]; ! GET PTR TO HEADER BLOCK FOR THIS REPORT
HDRPTR[LINENO] _ .HDRPTR[LINENO] +1; ! INCREMENT LINE COUNT
IF .HDRPTR[LINENO] GEQ PAGESIZE ! END OF PAGE?
THEN RETURN PUTPAG(.HDRPTR) ! YES, WRITE NEW HEADER LINES
ELSE RETURN TRUE
END;
COMMENT(PUTSKP);
! SUBROUTINE PUTSKP
! ========== ======
! THIS ROUTINE PRINTS A NULL LINE (CRLF) IN THE
! REPORT OUTPUT FILE.
! LAST MODIFIED ON 26 JUL 74 BY JG.
GLOBAL ROUTINE PUTSKP =
BEGIN
BIND DUMMY = PLIT(0,-1); ! THIS IS REALY A "PRINTLINE"
PUTLIN(DUMMY,NOCLEAR) ! FAKE OUT PUTLIN
END;
COMMENT(PUTPAG);
! SUBROUTINE PUTPAG
! ========== ======
! THIS ROUTINE INSERTS A FORMFEED IN THE REPORT OUTPUT
! FILE AND PRINTS THE HEADER LINES FOR THAT FILE. NOTE
! THAT PUTPAG CALLS PUTLIN DIRECTLY AND INDIRECTLY
! THROUGH PUTSKP. PUTLIN SHOULD NOT IN TURN CALL
! PUTPAG AGAIN UNLESS PAGESIZE IS BOUND TO SOMETHING
! LESS THAN 5.
! LAST MODIFIED ON 15 AUG 74 BY JG.
GLOBAL ROUTINE PUTPAG (HDRPTR) =
BEGIN
LOCAL PNUM[5];
MAP HEADER HDRPTR;
BIND DUMMY = PLIT(0,1,0,'?L'); ! ANOTHER DUMMY "PRINTLINE"
HDRPTR[LINENO] _ 0; ! ZERO LINE NUMBER TO PREVENT RECURSIVE CALLS
HDRPTR[PAGENO] _ .HDRPTR[PAGENO]+1; ! INCREMENT PAGE COUNT
CNVCHR(.HDRPTR[PAGENO],PNUM,10); ! CONVERT IT TO CHAR
COPYA(PNUM[STRING]<FIRSTINCR>,..HDRPTR[LINEP1],0);! STICK IT IN THE FIRST HEADER LINE
IF PUTLIN(DUMMY,NOCLEAR) IS FALSE ! OUTPUT A <FF>
THEN RETURN FALSE;
IF PUTLIN(.HDRPTR[LINEP1],NOCLEAR) IS FALSE ! PRINT FIRST HEADER LINE
THEN RETURN FALSE;
IF PUTSKP() IS FALSE ! SKIP A LINE
THEN RETURN FALSE;
IF .HDRPTR[LINEP2] ISNOT NULL ! ONLY PRINT IF ITS THERE
THEN IF PUTLIN(.HDRPTR[LINEP2],NOCLEAR) IS FALSE
THEN RETURN FALSE;
IF .HDRPTR[LINEP3] ISNOT NULL ! SAME HERE
THEN IF PUTLIN(.HDRPTR[LINEP3],NOCLEAR) IS FALSE
THEN RETURN FALSE;
TRUE
END;
COMMENT(COLUMN);
! SUBROUTINE COLUMN
! ========== ======
! THIS ROUTINE FORCES THE NEXT CHARACTER TO BE INSERTED
! IN A LINE TO APPEAR AT THE SPECIFIED COLUMN. IF THAT
! COLUMN HAS ALREADY BEEN PAST, THE LINE IS WRITTEN OUT
! AND A NEW LINE CREATED. THIS ROUTINE WILL INSERT TABS,
! AND THEN SPACES, TO REACH THE DESIRED COLUMN.
! LAST MODIFIED ON 29 JUL 74 BY JG.
GLOBAL ROUTINE COLUMN (LINEPTR,COL) =
BEGIN
LOCAL TABS,SPACES;
BIND TAB = "?I", SPACE = " ";
MAP PRINTLINE LINEPTR;
IF .COL GTR LINESIZE THEN RETURN FALSE; ! SOMEONE GOOFED
IF .COL EQL .LINEPTR[LINEPO] THEN RETURN TRUE; ! WE WERE THERE
IF .COL LSS .LINEPTR[LINEPO] ! MUST PRINT LINE AND GET NEW ONE
THEN IF PUTLIN(.LINEPTR,CLEAR) IS FALSE
THEN RETURN FALSE;
TABS _ (.COL-1)/8 - (.LINEPTR[LINEPO]-1)/8; ! FIGURE OUT HOW MANY TABS NEEDED
SPACES _ IF .TABS IS 0 ! AND HOW MANY SPACES
THEN .COL-.LINEPTR[LINEPO]
ELSE (.COL-1) MOD 8;
LINEPTR[LINEBP] _ DUPL(DUPL(.LINEPTR[LINEBP],TAB,.TABS),SPACE,.SPACES);
LINEPTR[LINEPO] _ .COL; ! UPDATE THE COLUMN
LINEPTR[LINECT] _ .LINEPTR[LINECT] + .TABS + .SPACES;! AND THE CHARACTER COUNT
TRUE
END;
COMMENT(UPDATE);
! SUBROUTINE UPDATE
! ========== ======
! THIS ROUTINE COPIES A STRING INTO A LINE AND UPDATES
! ALL THOSE NICE THINGS THAT KEEP TRACK OF WHAT'S GOING
! ON. THIS ROUTINE ASSUMES THAT STRPTR IS AN INCREMENT
! TYPE BYTE POINTER AND THAT THE STRING CONTAINS NO
! TABS,ECT, THAT SCREW UP THE POSITION COUNT. NOTE THAT
! THIS ROUTINE DOES NOT CHECK IF THE STRING WILL PUT
! CHARACTERS BEYOND THE END OF THE LINE BUFFER. THE
! CALLING PROGRAM MUST SEE TO THAT.
! LAST MODIFIED ON 30 JUL 74 BY JG.
GLOBAL ROUTINE UPDATE (LINPTR,COL,STRPTR,COUNT) =
BEGIN
LOCAL PLUS;
MAP PRINTLINE LINPTR;
IF .COL GTR 0 ! FORCE TO SPECIFIED COLUMN
THEN IF COLUMN(.LINPTR,.COL) IS FALSE
THEN RETURN FALSE;
PLUS _ COPYA(.STRPTR,.LINPTR[LINEBP],.COUNT); ! PLUS IS CHAR COUNT ADDED TO LINE
LINPTR[LINECT] _ .LINPTR[LINECT]+.PLUS; ! UPDATE CHAR COUNT
LINPTR[LINEPO] _ .LINPTR[LINEPO]+.PLUS; ! AND POSITION (REMENBER THE RESTRICTION ON TABS?)
LINPTR[LINEBP] _ BYTOFF(LINPTR[LINEST],.LINPTR[LINECT]+1);! RECALCULATE THE LINE PTR
TRUE
END;
COMMENT(INITLN);
! SUBROUTINE INITLN
! ========== ======
! THIS ROUTINE CLEARS AND INITIALIZES A PRINTLINE.
! LAST MODIFIED ON 30 JUL 74 BY JG.
GLOBAL ROUTINE INITLN (LINPTR) =
BEGIN
MAP PRINTLINE LINPTR;
LINPTR[LINEBP] _ LINPTR[LINEST]<FIRSTINCR>; ! FIRST CHAR IN TEXT
LINPTR[LINECT] _ 0; ! NO CHARS
LINPTR[LINEPO] _ 1; ! START AT POSITION 1
ZERO(LINPTR[LINEST],PRINTSIZE-3) ! ZERO THE TEXT PORTION
END;
COMMENT(MAKHDR);
! SUBROUTINE MAKHDR
! ========== ======
! THIS ROUTINE CREATES HEADERS FOR THE REPORT POINTED TO
! BY CURREP. IT DOES THE FOLLOWING THINGS:
!
! 1) MAKES THE STANDARD FIRST LINE TO BE PRINTED
! ON EVERY PAGE WHICH INCLUDES THINGS LIKE REPORT
! NAME, DATE, TIME, ECT.
! 2) MAKES A MIDDLE HEADING LINE IF ONE OF THE FOLLOWING
! IS TRUE:
! A) "ALL" IS SPECIFIED.
! B) "SEQUENCE" IS SPECIFIED.
! C) BOTH "SOURCES" AND "MPPS" ARE SPECIFIED.
! D) BOTH "CODES" AND "CLASSES" ARE SPECIFIED.
! THIS IS BECAUSE THESE HEADINGS REQUIRE TWO LINES.
! 3) MAKES A THIRD HEADER LINE.
!
! THE PROGRAM MAKES USE OF THREE PLITS - LXC, LXF, AND L2P,
! WHERE X IS 1 AND 2, TO PLACE THE FIELD HEADINGS IN THE
! PROPER COLUMNS. LXC IS THE COLUMN THAT THE FIELD HEADER IS
! SUPPOSED TO START IN WHEN "ALL" IS SPECIFIED. LXF IS THE
! FUDGE FACTOR THAT IS SUBTRACTED FROM SUCCEEDING FIELDS'
! COLUMN PRINT POSITIONS WHEN THIS FIELD IS OMITTED. L2P IS
! THE DATA PRINT POSITION AND IS PLACED IN THE REPORT BLOCK
! WHERE THAT FIELD SELECT FLAG WAS. BUT IF THE FOLLOWING
! CODE IS NOT QUITE CLEAR, DON'T WORRY, IT'S ALL DONE
! WITH MIRRORS ANYWAY. NOTE THAT WE IGNORE
! THE POSIBLE ERROR RETURN FROM UPDATE SINCE WE
! KNOW EXACTLY WHERE THINGS ARE GOING. THIS
! MEANS THAT UPDATE SHOULD NEVER CALL COLUMN,
! WHICH IS THE ONLY SOURCE OF ERROR IN UPDATE.
! LAST MODIFIED ON 16 AUG 74 BY JG.
GLOBAL ROUTINE MAKHDR =
BEGIN
MACRO DEF = = PLIT ASCIZ$;
BIND
QMCS DEF 'MCS REPORT GENERATOR',
QPAGE DEF 'PAGE ',
QSEQ DEF 'SEQUENCE',
QSOURCE DEF 'SOURCE TERM.',
QTRANS DEF 'TRANSACTION CODE',
QNUM DEF 'NUMBER',
QDATE DEF 'DATE',
QTIME DEF 'TIME',
QMPP1 DEF 'OR MPP',
QMPP2 DEF 'MPP',
QMES1 DEF 'OR MESSAGE CLASS',
QMES2 DEF 'MESSAGE CLASS',
QDEST DEF 'DESTINATIONS',
% BEWARE YE WHO MODIFIY THESE PLITS !!
(PLEASE BE CAREFUL ...) %
L1C = PLIT( 2,51,79),
L1F = PLIT(16,32),
SQ = 0, ST = 1, TC = 2,
L2C = PLIT( 3,23,37,54,79,99),
L2F = PLIT(16,16,12,32,20),
L2P = PLIT( 2,19,35,50,83,99),
NU = 0, DA = 1, TI = 2, MP = 3, MC = 4, DS = 5;
LOCAL HDRPTR,HP,P1,P2,FUDGE;
MAP REPBLK CURREP,
HEADER HDRPTR,
PRINTLINE HP:P1:P2;
IF .CURREP[IOBSEL] IS XINPUT ! OPTIMIZE THE PAGE HEADINGS
THEN CURREP[MPPSEL] _ CURREP[CLSSEL] _ CURREP[DSTSEL] _ FALSE;
IF .CURREP[IOBSEL] IS XOUTPUT
THEN CURREP[SORSEL] _ CURREP[CODSEL] _ FALSE;
IF (HDRPTR _ CURREP[PAGEHEADPTR] _ ALLOC(HEADERSIZE)) IS NULL ! GET A HEADER BLOCK
THEN RETURN FALSE;
IF (HDRPTR[LINEOT] _ ALLOC(PRINTSIZE)) IS NULL ! GET THE OUTPUT LINE
THEN RETURN FALSE;
INITLN(.HDRPTR[LINEOT]); ! INITIALIZE IT
HDRPTR[PAGENO] _ 0; ! NO PAGES YET
HDRPTR[LINENO] _ 0; ! NOR ANY LINES
IF (HP _ ALLOC(PRINTSIZE)) IS NULL ! GET LINE FOR FIRST HEADER
THEN RETURN FALSE;
INITLN(.HP); ! INITIALIZE IT
UPDATE(.HP,1,QMCS<FIRSTINCR>,0); ! INSERT STANDARD HEADING
IF .CURREP[NAMECOUNT] ISNOT 0
THEN UPDATE(.HP,41,CURREP[REPORTNAME]<FIRSTINCR>,.CURREP[NAMECOUNT]);
UPDATE(.HP,65,CHRDAT<FIRSTINCR>,12);
UPDATE(.HP,89,CHRTIM<FIRSTINCR>,8);
UPDATE(.HP,121,QPAGE<FIRSTINCR>,0);
HP[LINEBP] _ BYTOFF(HP[LINEST],.HP[LINECT]-4); ! FUDGE THE COUNT BECAUSE PAGE NO. COMES IN PUTPAG
HDRPTR[LINEP1] _ .HP;
IF .CURREP[SEQSEL] OR (.CURREP[SORSEL] AND .CURREP[MPPSEL]) OR (.CURREP[CODSEL] AND .CURREP[CLSSEL])
THEN BEGIN ! WE REQUIRE 2 LINES FOR FIELD HEADINGS
IF (P1 _ ALLOC(PRINTSIZE)) IS NULL ! GET FIRST THE LINE
THEN RETURN FALSE;
INITLN(.P1); ! INITIALIZE IT
FUDGE _ 0;
IF NOT .CURREP[DATSEL] THEN FUDGE _ .L2F[DA];
IF NOT .CURREP[TIMSEL] THEN FUDGE _ .FUDGE+.L2F[TI];
IF .CURREP[SEQSEL] ! WE NEED SEQUENCES
THEN UPDATE(.P1,.L1C[SQ],QSEQ<FIRSTINCR>,0)
ELSE FUDGE _ .FUDGE+.L1F[SQ];
IF .CURREP[SORSEL] AND .CURREP[MPPSEL] ! MUST PRINT SOURCE HEADING HERE
THEN UPDATE(.P1,.L1C[ST]-.FUDGE,QSOURCE<FIRSTINCR>,0)
ELSE IF NOT .CURREP[SORSEL] AND NOT .CURREP[MPPSEL]
THEN FUDGE _ .FUDGE+.L1F[ST];
IF .CURREP[CODSEL] AND .CURREP[CLSSEL] ! MUST PRINT CODE HEADING HERE
THEN UPDATE(.P1,.L1C[TC]-.FUDGE,QTRANS<FIRSTINCR>,0)
END
ELSE P1 _ NULL; ! THERE IS NO FIRST FIELD HEADING LINE
IF (P2 _ ALLOC(PRINTSIZE)) IS NULL ! GET SECOND LINE
THEN RETURN FALSE;
INITLN(.P2); ! INITIALIZE IT
FUDGE _ 0;
IF .CURREP[SEQSEL] ! REST OF SEQUENCE HEADING
THEN BEGIN
UPDATE(.P2,.L2C[NU],QNUM<FIRSTINCR>,0);
CURREP[SEQSEL] _ .L2P[NU]
END
ELSE FUDGE _ .L2F[NU]; ! WAS NOT REQUIRED
IF .CURREP[DATSEL] ! NEED DATES
THEN BEGIN
UPDATE(.P2,.L2C[DA]-.FUDGE,QDATE<FIRSTINCR>,0);
CURREP[DATSEL] _ .L2P[DA]-.FUDGE
END
ELSE FUDGE _ .FUDGE+.L2F[DA]; ! DON'T NEED DATES
IF .CURREP[TIMSEL] ! NEED TIMES
THEN BEGIN
UPDATE(.P2,.L2C[TI]-.FUDGE,QTIME<FIRSTINCR>,0);
CURREP[TIMSEL] _ .L2P[TI]-.FUDGE;
END
ELSE FUDGE _ .FUDGE+.L2F[TI]; ! NO TIMES
IF .CURREP[SORSEL] OR .CURREP[MPPSEL] ! SOURCES OR MPPS?
THEN BEGIN
IF .CURREP[SORSEL] AND .CURREP[MPPSEL] ! WE HAVE BOTH
THEN UPDATE(.P2,.L2C[MP]-.FUDGE,QMPP1<FIRSTINCR>,0)
ELSE IF .CURREP[SORSEL] AND NOT .CURREP[MPPSEL] ! ONLY SOURCES
THEN UPDATE(.P2,.L2C[MP]-.FUDGE,QSOURCE<FIRSTINCR>,0)
ELSE UPDATE(.P2,.L2C[MP]-.FUDGE,QMPP2<FIRSTINCR>,0);! ONLY MPPS
IF .CURREP[SORSEL] THEN CURREP[SORSEL] _ .L2P[MP]-.FUDGE;
IF .CURREP[MPPSEL] THEN CURREP[MPPSEL] _ .L2P[MP]-.FUDGE
END
ELSE FUDGE _ .FUDGE+.L2F[MP]; ! DIDN'T NEED EITHER
IF .CURREP[CODSEL] OR .CURREP[CLSSEL] ! SAME DEAL AS WITH SOURCES AND MPPS
THEN BEGIN
IF .CURREP[CODSEL] AND .CURREP[CLSSEL]
THEN UPDATE(.P2,.L2C[MC]-.FUDGE,QMES1<FIRSTINCR>,0)
ELSE IF .CURREP[CODSEL] AND NOT .CURREP[CLSSEL]
THEN UPDATE(.P2,.L2C[MC]-.FUDGE,QTRANS<FIRSTINCR>,0)
ELSE UPDATE(.P2,.L2C[MC]-.FUDGE,QMES2<FIRSTINCR>,0);
IF .CURREP[CODSEL] THEN CURREP[CODSEL] _ .L2P[MC]-.FUDGE;
IF .CURREP[CLSSEL] THEN CURREP[CLSSEL] _ .L2P[MC]-.FUDGE
END
ELSE FUDGE _ .FUDGE+.L2F[MC]; ! SKIP THEM ALL
IF .CURREP[DSTSEL] ! NEED DESTS
THEN BEGIN
UPDATE(.P2,.L2C[DS]-.FUDGE,QDEST<FIRSTINCR>,0);
CURREP[DSTSEL] _ .L2P[DS]-.FUDGE
END;
IF .P1 IS NULL ! NO FIRST LINE
THEN BEGIN
HDRPTR[LINEP2] _ .P2;
HDRPTR[LINEP3] _ NULL
END
ELSE BEGIN ! TWO LINES
HDRPTR[LINEP2] _ .P1;
HDRPTR[LINEP3] _ .P2
END;
TRUE
END;
END ELUDOM; ! END OF PRINT UTILITY MODULE ...