PROC RPCEJCT ((FETP),(LINES)); # TITLE RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT. # BEGIN # RPCEJCT # # ** RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT. * * COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. * * *RPCEJCT* ISSUES A PAGE EJECT IF THE NUMBER OF * LINES REMAINING ON THE PAGE IS LESS THAN THE NUMBER * OF LINES TO BE CHECKED. * * PROC RPCEJCT((FETP),(LINES)) * * ENTRY (FETP) = FWA OF *FET*. * (LINES) = NUMBER OF LINES TO BE CHECKED. # ITEM FETP I; # *FET* LOCATION # ITEM LINES I; # NUMBER OF LINES TO BE CHECKED # # **** PROC RPCEJCT - XREF LIST BEGIN. # XREF BEGIN PROC RPEJECT; # ISSUES PAGE EJECT # PROC RPSRCH; # SEARCHES PRINT TABLE # END # **** PROC RPCEJCT - XREF LIST END. # DEF LISTCON #0#; # TURN COMDECK LISTING OFF # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END RPSRCH(FETP); # SEARCH PRINT TABLE # # * IF THE NUMBER OF LINES REMAINING ON THE PAGE IS * LESS THAN THE NUMBER OF LINES TO BE CHECKED, ISSUE * A PAGE EJECT. # IF (PRTLINELIM[ORD] - PRTLINE[ORD] + 1) GQ LINES THEN BEGIN RETURN; END RPEJECT(FETP); RETURN; END # RPCEJCT # TERM PROC RPCLOSE((FETP)); # TITLE RPCLOSE - CLOSES A REPORT FILE. # BEGIN # RPCLOSE # # ** RPCLOSE - CLOSES A REPORT FILE. * * THIS PROCEDURE WRITES THE MESSAGE *REPORT * COMPLETE* ON THE REPORT FILE, CLEARS THE * *FET* ADDRESS IN THE PRINT TABLE ENTRY, AND * CALLS *WRITER* TO CLOSE THE REPORT FILE. * * PROC RPCLOSE((FETP)). * * ENTRY (FETP) - ADDRESS OF REPORT FILE *FET*. * = *NULLFILE*, NO REPORT PROCESSING DONE. * (VALUE DEFINED IN *COMUOUT*) * = OTHER, ADDRESS OF *FET*. * * EXIT REPORT FILE IS CLOSED. A PAGE EJECT IS ISSUED AND * *REPORT COMPLETE* IS PRINTED. * * NOTES *RPCLOSE* CALLS *WRITER* TO WRITE AN * END-OF-RECORD ON THE REPORT FILE, AND * CLEARS THE VALUE OF *FETP* FROM THE PRINT * TABLE ENTRY TO INDICATE THAT THE ENTRY * IS NOW EMPTY. # ITEM FETP U; # ADDRESS OF REPORT FILE *FET* # # **** PROC RPCLOSE - XREF LIST BEGIN. # XREF BEGIN PROC RPLINEX; # PRINTS A REPORT LINE # PROC RPSRCH; # SEARCHES THE PRINT TABLE # PROC WRITER; # WRITES *EOR* ON REPORT FILE # END # **** PROC RPCLOSE - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT CONTROL EJECT; # * NO PROCESSING IS DONE IF NO REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * PRINT COMPLETION MESSAGE AND CLEAR THE PRINT TABLE. # RPSRCH(FETP); # SEARCH PRINT TABLE # RPLINEX(FETP,"1**REPORT COMPLETE**",0,20,0); P = FETP; WRITER(RPFET[0],RCL); # WRITE END-OF-RECORD # PRTFETP[ORD] = EMPTY; # CLEAR *FET* ADDRESS FROM TABLE # RETURN; END # RPCLOSE # TERM PROC RPEJECT((FETP)); # TITLE RPEJECT - STARTS A NEW REPORT PAGE. # BEGIN # RPEJECT # # ** RPEJECT - STARTS NEW REPORT PAGE. * * THIS PROCEDURE ADVANCES THE REPORT FILE * TO A NEW PAGE, SETS THE CURRENT LINE NUMBER * EQUAL TO ONE, AND PRINTS THE PAGE HEADING. * * PROC RPEJECT((FETP)). * * ENTRY (FETP) - ADDRESS OF THE REPORT FILE *FET*. * = *NULLFILE*, NO REPORT PROCESSING DONE. * (VALUE DEFINED IN *COMUOUT*) * = OTHER, ADDRESS OF *FET*. * * EXIT NEW PAGE HEADING IS COMPLETED. * * NOTES *RPEJECT* SETS UP THE PAGE HEADER LINE * WITH DATE, TIME, PAGE NUMBER, AND * CARRIAGE CONTROL CHARACTER. AFTER * PRINTING THIS LINE, THE LINE BUFFER * IS BLANK-FILLED AND *XPRC* IS CALLED * TO EXECUTE THE HEADER PROCEDURE. THE * REPORT FILE MUST HAVE ALREADY BEEN OPENED * BY CALLING *RPOPEN*. # ITEM FETP U; # ADDRESS OF REPORT FILE *FET* # # **** PROC RPEJECT - XREF LIST BEGIN. # XREF BEGIN PROC RPSRCH; # SEARCHES THE PRINT TABLE # PROC WRITEH; # WRITES LINE ON REPORT FILE # FUNC XCDD C(10); # CONVERTS INTEGER TO DISPLAY # PROC XPRC; # EXECUTES A PROCEDURE # END # **** PROC RPEJECT - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT ITEM PAGENUM C(10); # PAGE NUMBER IN DISPLAY CODE # CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * UPDATE PAGE AND LINE COUNTS. # RPSRCH(FETP); # SEARCH PRINT TABLE FOR *FETP* # PRTPAGE[ORD] = PRTPAGE[ORD] + 1; PRTLINE[ORD] = 1; PAGENUM = XCDD(PRTPAGE[ORD]); # PAGE NUMBER IN DISPLAY CODE # # * SET UP AND PRINT THE PAGE HEADER LINE. # LIN$CNTRL[ORD] = PRCEJ; # CAUSE PAGE EJECT # LIN$HEAD[ORD] = PRTHEADT[ORD]; # CURRENT MESSAGE # LIN$DATE[ORD] = PRTDATE[ORD]; # CURRENT DATE # LIN$TIME[ORD] = PRTTIME[ORD]; # CURRENT TIME # LIN$PAGE[ORD] = "PAGE"; LIN$PAGENM[ORD] = C<4,6>PAGENUM; # PAGE NUMBER # P = FETP; WRITEH(RPFET[0],LINEBUFF[ORD],LINELEN); # PRINT LINE # PRTLINE[ORD] = PRTLINE[ORD] + 1; # INCREMENT LINE COUNTER # LIN$BUF[ORD] = SPACES; # BLANK FILL *LINEBUFF* # # * EXECUTE SPECIFIED HEADER PROCEDURE. # XPRC(PRTHEADP[ORD],FETP,BLANK); RETURN; END # RPEJECT # TERM PROC RPHEAD((FETP),(MESG),(COL),(LEN)); # TITLE RPHEAD - SETS UP HEADER PRINT FIELD. # BEGIN # RPHEAD # # ** RPHEAD - SETS UP HEADER PRINT FIELD. * * *RPHEAD* SETS UP AN OPTIONAL HEADER PRINT FIELD IN THE * FIRST ONE HUNDRED CHARACTERS OF THE HEADER PAGE LINE. * * PROC RPHEAD((FETP),(MESG),(COL),(LEN)) * * ENTRY (FETP) - ADDRESS OF *FET* FOR REPORT FILE. * (MESG) - HEADER MESSAGE. * (COL) - STARTING COLUMN. * (LEN) - CHARACTER LENGTH OF FIELD. * * EXIT HEADER PRINT FIELD IS SET UP. * * NOTES THE SPECIFIED MESSAGE WILL BE PRINTED ON EVERY * SUBSEQUENT PAGE HEADING UNTIL CHANGED OR CLEARED * BY ANOTHER CALL TO *RPHEAD*. THE MAXIMUM NUMBER * OF CHARACTERS ALLOWED FOR THE HEADER FIELD IS * ONE HUNDRED. * (*COL* + *LEN* -1) MUST BE LESS THAN OR EQUAL * TO ONE HUNDRED. # ITEM FETP U; # ADDRESS OF REPORT FILE FET # ITEM MESG C(100); # HEADER MESSAGE # ITEM COL U; # STARTING COLUMN FOR FIELD # ITEM LEN U; # LENGTH OF PRINT FIELD # # **** PROC RPHEAD - XREF LIST BEGIN. # XREF BEGIN PROC RPSRCH; # SEARCHES PRINT TABLE # END # **** PROC RPHEAD - XREF LIST END. # DEF LISTCON #0#; # TURN LISTING OFF # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * SET UP PRINT FIELD. # RPSRCH(FETP); # FIND PRINT TABLE ENTRY # CPRTHEADT[ORD] = C<0,LEN>MESG; END # RPHEAD # TERM PROC RPLINE((FETP),FIELD,(COL),(LEN),(FLAG)); # TITLE RPLINE - CALLS *RPLINEX* TO PRINT A LINE. # BEGIN # RPLINE # # ** RPLINE - CALLS *RPLINEX* TO PRINT A LINE. * * THIS PROCEDURE CHECKS THE CURRENT LINE NUMBER AND CALLS * *RPEJECT* IF THE LINE LIMIT IS EXCEEDED. IT THEN CALLS * *RPLINEX* TO SET UP PRINT FIELD *FIELD* IN THE LINE BUFFER. * THE LINE IS EITHER PRINTED OR SAVED, DEPENDING ON THE VALUE * OF *FLAG* SPECIFIED. * * PROC RPLINE((FETP),FIELD,(COL),(LEN),(FLAG)). * * ENTRY (FETP) - ADDRESS OF *FET* FOR REPORT FILE. * = *NULLFILE*, NO REPORT PROCESSING IS DONE. * (VALUE DEFINED IN *COMUOUT*) * = OTHER, ADDRESS OF *FET*. * (FIELD) - STRING TO BE PRINTED. * (COL) - STARTING COLUMN FOR *FIELD*. * (LEN) - CHARACTER LENGTH OF *FIELD*. * (FLAG) - INDICATES CONTINUATION OF LINE. * (VALUES DEFINED IN *COMUOUT*) * = *END$LN*, CONTENTS OF BUFFER ARE PRINTED. * = *CONT$LN*, CONTENTS OF BUFFER ARE SAVED. * * EXIT LINE IS PRINTED OR CONTENTS OF BUFFER ARE SAVED * UNTIL NEXT CALL TO *RPLINE*. THE MAXIMUM FIELD * SIZE IS 138 CHARACTERS. # ITEM FETP U; # ADDRESS OF REPORT FILE *FET* # ARRAY FIELD [0:0] S(14); # ARRAY CONTAINING PRINT FIELD # BEGIN ITEM FIELDPR C(00,00,138); # PRINT STRING # END ITEM COL U; # STARTING COLUMN OF FIELD # ITEM LEN U; # LENGTH OF PRINT FIELD # ITEM FLAG U; # INDICATES LINE CONTINUATION # # **** PROC RPLINE - XREF LIST BEGIN. # XREF BEGIN PROC RPEJECT; # STARTS NEW REPORT PAGE # PROC RPLINEX; # PRINTS LINE ON REPORT FILE # PROC RPSRCH; # SEARCHES PRINT TABLE # END # **** PROC RPLINE - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * CHECK LINE COUNT AND PRINT REPORT LINE. # RPSRCH(FETP); # SEARCH FOR MATCHING *FETP* # IF PRTLINE[ORD] GR PRTLINELIM[ORD] THEN # NEW PAGE NEEDED # BEGIN RPEJECT(FETP); END RPLINEX(FETP,FIELD,COL,LEN,FLAG); RETURN; END # RPLINE # TERM PROC RPLINEX((FETP),FIELD,(COL),(LEN),(FLAG)); # TITLE RPLINEX - PRINTS A REPORT LINE. # BEGIN # RPLINEX # # ** RPLINEX - PRINTS A LINE ON THE REPORT FILE. * * *RPLINEX* SETS UP PRINT FIELD *FIELD* IN A LINE BUFFER. * THE CONTENTS OF THE BUFFER ARE EITHER PRINTED OR SAVED, DEPENDING * ON THE VALUE OF *FLAG*. MORE THAN ONE FIELD PER PRINT * LINE CAN BE SPECIFIED BY MAKING MORE THAN ONE CALL TO * *RPLINEX*. * * PROC RPLINEX((FETP),FIELD,(COL),(LEN),(FLAG)). * * ENTRY (FETP) - ADDRESS OF *FET* FOR REPORT FILE. * = *NULLFILE*, NO REPORT PROCESSING IS DONE. * (VALUE DEFINED IN *COMUOUT*) * = OTHER, ADDRESS OF *FET*. * (FIELD) - STRING TO BE PRINTED. * (COL) - STARTING COLUMN FOR *FIELD*. * (LEN) - CHARACTER LENGTH OF *FIELD*. * (FLAG) - INDICATES CONTINUATION OF LINE. * (VALUES DEFINED IN *COMUOUT*) * = *END$LN*, CONTENTS OF BUFFER ARE PRINTED. * = *CONT$LN*, CONTENTS OF BUFFER ARE SAVED. * * EXIT LINE IS PRINTED OR CONTENTS OF BUFFER ARE SAVED * UNTIL NEXT CALL TO *RPLINEX*. THE LINE COUNTER IS * INCREMENTED AS NEEDED. # ITEM FETP U; # ADDRESS OF REPORT FILE *FET* # ARRAY FIELD [0:0] S(14); # ARRAY CONTAINING PRINT FIELD # BEGIN ITEM FIELDPR C(00,00,138); # PRINT STRING # END ITEM COL U; # STARTING COLUMN OF FIELD # ITEM LEN U; # LENGTH OF PRINT FIELD # ITEM FLAG U; # INDICATES LINE CONTINUATION # # **** PROC RPLINEX - XREF LIST BEGIN. # XREF BEGIN PROC RPSRCH; # SEARCHES PRINT TABLE # PROC WRITEH; # WRITES LINE ON REPORT FILE # END # **** PROC RPLINEX - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * THE CHARACTER STRING *FIELD* IS PLACED IN THE * APPROPRIATE LOCATION IN *LINEBUFF*. IF THE VALUE * OF *FLAG* IS *CONT$LN*, THE CONTENTS OF *LINEBUFF* * ARE SAVED. OTHERWISE A LINE IS PRINTED. # RPSRCH(FETP); # FIND PRINT TABLE ENTRY # P = FETP; IF FIELDPR[0] NQ EMPTY # IF *FIELD* CONTAINS STRING # THEN BEGIN CLIN$BUF[ORD] = FIELDPR[0]; # SET UP PRINT FIELD # END IF FLAG EQ CONT$LN # IF LINE CONTINUED # THEN BEGIN RETURN; # SAVE CONTENTS OF *LINEBUFF* # END # * WRITE PRINT LINE. # WRITEH(RPFET[0],LINEBUFF[ORD],LINELEN); IF LIN$CNTRL[ORD] EQ PRDBL THEN # DOUBLE SPACE DONE # BEGIN PRTLINE[ORD] = PRTLINE[ORD] + 2; # INCREMENT LINE COUNT # END ELSE # SINGLE SPACE ASSUMED # BEGIN PRTLINE[ORD] = PRTLINE[ORD] + 1; # INCREMENT BY ONE # END LIN$BUF[ORD] = SPACES; # BLANK FILL *LINEBUFF* # RETURN; END # RPLINEX # TERM PROC RPOPEN((NAME),(FETP),HEADPROC); # TITLE RPOPEN - OPENS A REPORT FILE. # BEGIN # RPOPEN # # ** RPOPEN - OPENS A REPORT FILE. * * THIS PROCEDURE SETS UP THE PRINT TABLE * FOR A REPORT FILE AND CALLS *RPEJECT* * TO START THE FIRST PAGE. * * PROC RPOPEN((NAME),(FETP),HEADPROC). * * ENTRY (NAME) - NAME OF REPORT FILE. * (FETP) - REPORT FILE *FET* OPTION. * = *NULLFILE*, NO REPORT PROCESSING IS DONE. * (VALUE DEFINED IN *COMUOUT*) * = OTHER, ADDRESS OF REPORT FILE *FET*. * (HEADPROC) - HEADER PROCEDURE OPTION. * = *DEFLT$HDR*, DEFAULT PAGE HEADER USED. * (VALUE DEFINED IN *COMUOUT*) * = NAME OF USER-SUPPLIED PROCEDURE TO * BE EXECUTED AFTER EACH PAGE EJECT. * * EXIT REPORT FILE OPENED OR PRINT TABLE FULL. * * NOTES *RPOPEN* INITIALIZES A PRINT TABLE ENTRY FOR * THE REPORT FILE SPECIFIED. UP TO *PRTABENT* REPORT * FILES MAY BE OPEN SIMULTANEOUSLY. AFTER EACH * PAGE EJECT, A LINE IS PRINTED CONTAINING THE * THE CURRENT DATE, TIME, AND PAGE NUMBER. * FOLLOWING THIS THE USER SUPPLIED HEADER PROCEDURE * IS EXECUTED. * TO AVOID RECURSIVE CALLS, THE HEADER PROCEDURE MUST * NOT CALL *RPLINE* OR *RPSPACE*. INSTEAD *RPLINEX* * SHOULD BE USED. TO PRINT A BLANK LINE, CALL: * RPLINEX(FETP,0,0,0,0). # ITEM NAME C(7); # NAME OF THE REPORT FILE # ITEM FETP U; # ADDRESS OF REPORT FILE *FET* # FPRC HEADPROC; # USER-SUPPLIED HEADER PROCEDURE # # **** PROC RPOPEN - XREF LIST BEGIN. # XREF BEGIN PROC CLOCK; # GETS CURRENT TIME # PROC DATE; # GETS CURRENT DATE # PROC RPEJECT; # STARTS NEW REPORT PAGE # PROC RPLINEX; # PRINTS A LINE # PROC RPSRCH; # SEARCHES THE PRINT TABLE # PROC ZSETFET; # INITIALIZES A *FET* # END # **** PROC RPOPEN - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT ITEM DTEMP C(10); # TEMPORARY LOCATION FOR DATE # ITEM TTEMP C(10); # TEMPORARY LOCATION FOR TIME # ITEM PRBUFP U; # ADDRESS OF *CIO* BUFFER # BASED ARRAY HEADWORD [0:0] S(1); # USED TO TEST *HEADPROC* # BEGIN ITEM HEADNAME U(00,00,60); # NAME OF HEADER PROCEDURE # END CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * SEARCH FOR AN EMPTY ENTRY IN THE PRINT TABLE. # RPSRCH(EMPTY); # SEARCH TABLE FOR EMPTY ENTRY # DATE(DTEMP); # GET CURRENT DATE # CLOCK(TTEMP); # GET CURRENT TIME # # * INITIALIZE PRINT TABLE FIELDS. # PRBUFP = LOC(PRBUF[ORD]); # ADDRESS OF *CIO* BUFFER # PRTLFN[ORD] = NAME; PRTLINE[ORD] = MAXLINE; PRTHEADT[ORD] = " "; PRTFETP[ORD] = FETP; PRTPAGE[ORD] = 0; PRTLINELIM[ORD] = PRDEFLIM; PRTDATE[ORD] = DTEMP; PRTTIME[ORD] = TTEMP; # * SAVE ADDRESS OF THE HEADER PROCEDURE. # P = LOC(HEADPROC); IF HEADNAME[0] EQ DEFLT$HDR THEN # DEFAULT HEADER CHOSEN # BEGIN PRTHEADP[ORD] = LOC(RPLINEX); # GET ADDRESS OF *RPLINEX* # END ELSE # HEADER PROVIDED # BEGIN PRTHEADP[ORD] = LOC(HEADPROC); # GET HEADER ADDRESS # END # * INITIALIZE *FET* AND START FIRST PAGE. # ZSETFET(FETP,NAME,PRBUFP,PRBUFL,SFETL); LIN$BUF[ORD] = SPACES; # BLANK FILL *LINEBUFF* # RETURN; END # RPOPEN # TERM PROC RPSPACE((FETP),(SPTYP),(NUM)); # TITLE RPSPACE - DOES REPORT SPACING. # BEGIN # RPSPACE # # ** RPSPACE - DOES REPORT SPACING. * * THIS PROCEDURE DOES VARIOUS TYPES OF REPORT * PROCESSING, DEPENDING ON THE VALUE OF *SPTYP* * SPECIFIED. * * PROC RPSPACE((FETP),(SPTYP),(NUM)). * * ENTRY (FETP) - ADDRESS OF REPORT FILE *FET*. * (SPTYP) - STATUS ITEM INDICATING PROCESSING. * (VALUES DEFINED IN *COMUOUT*) * = *LIMIT*, CHANGE PAGE LINE LIMIT TO *NUM*. * = *LINE*, ADVANCE TO LINE *NUM*. * = *SPACE*, PRINT *NUM* BLANK LINES. * (NUM) - NUMBER USED IN ACCORDANCE WITH THE * VALUE OF *SPTYP*. * * EXIT REPORT SPACING IS COMPLETE. * * ERRORS LINE LIMIT EXCEEDS MAXIMUM. * * MESSAGES * MAXIMUM LINE COUNT TAKEN AS LIMIT.*. # ITEM FETP U; # ADDRESS OF *FET* # ITEM NUM I; # NUMBER OF SPACES, LINE NUMBER, OR NEW LINE LIMIT # # **** PROC RPSPACE - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # DISPLAYS DAYFILE MESSAGE # PROC RPSRCH; # SEARCHES THE PRINT TABLE # PROC RPLINEX; # PRINTS A LINE ON REPORT FILE # PROC RPEJECT; # STARTS NEW REPORT PAGE # END # **** PROC RPSPACE - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT ITEM I I; # INDUCTION VARIABLE # ITEM LINESLEFT U; # LINES LEFT ON PAGE # ITEM SPTYP S:SP; # TYPE OF SPACING SPECIFIED # SWITCH LABTYP:SP # SWITCH CONTROLLING PROCESSING # LIMITYP:LIMIT, # CHANGE PAGE LINE LIMIT # LINETYP:LINE, # ADVANCE TO ABSOLUTE LINE # SPACETYP:SPACE; # PRINT BLANK LINES # CONTROL EJECT; # * NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. # IF FETP EQ NULLFILE THEN BEGIN RETURN; END # * FIND PRINT TABLE ENTRY AND PROCESS REQUEST. # RPSRCH(FETP); GOTO LABTYP[SPTYP]; # DO APPROPRIATE PROCESSING # LIMITYP: # CHANGE LINE LIMIT TO *NUM* # IF NUM LS MAXLC THEN # LIMIT REQUESTED IS PERMISSABLE # BEGIN PRTLINELIM[ORD] = NUM; END ELSE # EXCESSIVE LIMIT REQUESTED # BEGIN PRTLINELIM[ORD] = MAXLC; # MAXIMUM LINE LIMIT USED # MSGITEM[0] = " MAXIMUM LINE COUNT TAKEN AS LIMIT." ; MESSAGE(MSGITEM[0],UDFL1); END RETURN; LINETYP: # SKIP TO LINE NUMBER # IF NUM LQ PRTLINE[ORD] THEN # LINE IS ON NEXT PAGE # BEGIN RPEJECT(FETP); # EJECT TO NEW PAGE # END NUM = NUM - PRTLINE[ORD]; SLOWFOR I = 1 STEP 1 UNTIL NUM DO BEGIN RPLINEX(FETP,BLANK); # PRINT BLANK LINE # END RETURN; SPACETYP: # SKIP SPECIFIED NUMBER OF LINES # IF PRTLINE[ORD] GR PRTLINELIM[ORD] THEN BEGIN RPEJECT(FETP); # EJECT TO NEW PAGE # END LINESLEFT = (PRTLINELIM[ORD] - PRTLINE[ORD]) + 1; IF NUM GQ LINESLEFT THEN # PAGE EJECT NECESSARY # BEGIN NUM = NUM - LINESLEFT; RPEJECT(FETP); END SLOWFOR I = 1 STEP 1 UNTIL NUM DO # PRINT *NUM* BLANK LINES # BEGIN RPLINEX(FETP,BLANK); # PRINT *NUM* BLANK LINES # END RETURN; END # RPSPACE # TERM PROC RPSRCH((FETP)); # TITLE RPSRCH - SEARCHES THE PRINT TABLE. # BEGIN # RPSRCH # # ** RPSRCH - SEARCHES THE PRINT TABLE FOR AN ENTRY WITH A * MATCHING *FETP*. * * *RPSRCH* SEARCHES THE PRINT TABLE FOR EITHER AN EMPTY * ENTRY, OR THE ENTRY FOR A FILE ALREADY OPENED BY * *RPOPEN*. * * PROC RPSRCH((FETP)). * * ENTRY (FETP) - THE *FET* ADDRESS FOR REPORT FILE. * = *EMPTY*, SEARCH FOR EMPTY ENTRY. * (VALUE DEFINED IN *COMUFMT*) * = OTHER, ADDRESS OF *FET*. * * EXIT (ORD) - ITEM IN COMMON CONTAINING THE ORDINAL * OF THE PRINT TABLE ENTRY FOUND. * IF THE PRINT TABLE IS FULL, OR A MATCHING * ENTRY IS NOT FOUND, PROCESSING IS ABORTED. * * MESSAGES * PRINT TABLE ENTRY NOT FOUND.* * * PRINT TABLE FULL.* # ITEM FETP U; # ADDRESS OF REPORT FILE *FET* # # **** PROC RPSRCH - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORTS PROCESSING # PROC MESSAGE; # DISPLAYS DAYFILE MESSAGE # END # **** PROC RPSRCH - XREF LIST END. # DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # *CALL COMAMSS *CALL COMUFMT *CALL COMUOUT CONTROL EJECT; # * FIND PRINT TABLE ENTRY WITH AN EMPTY OR MATCHING *FETP*. # ORD = 1; REPEAT WHILE PRTFETP[ORD] NQ FETP AND ORD LQ PRTABENT DO BEGIN ORD = ORD + 1; END IF ORD GR PRTABENT # MATCHING ENTRY NOT FOUND # THEN BEGIN IF FETP EQ EMPTY # CALLED BY *RPOPEN* # THEN BEGIN MSGITEM[0] = " PRINT TABLE FULL." ; END ELSE BEGIN MSGITEM[0] = " PRINT TABLE ENTRY NOT FOUND." ; END MESSAGE(MSGITEM[0],UDFL1); ABORT; # ISSUE MESSAGE AND ABORT # END RETURN; END # RPSRCH # TERM