IDENT ACPD SST ENTRY ACPD ENTRY PAP ENTRY RFL= SYSCOM B1 TITLE ACPD - ANALYZE PERFORMANCE DATA. *COMMENT ACPD - ANALYZE PERFORMANCE DATA. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. SPACE 4,10 ** MPAR - MULTIPLE PRECISION ARRAY. * * NAME MPAR LEN,PREC,LMP * * ENTRY *NAME* = NAME OF DATA ITEM. * *LEN* = NUMBER OF ENTRIES OF DATA ITEM. * *PREC* = PRECISION OF ITEM IN PP WORDS. * *LMP* = POINTER TO LENGTH MULTIPLIER. * * EXIT *NAME* = ORDINAL OF ITEM IN THE CORRESPONDING TABLE. * *P.NAME* = PRECISION OF THE ITEM. * *L.NAME* = LENGTH OF THE ITEM. * * NOTE *MPAR* TABLE FORMAT IS *T 24/NAME,3/TP,6/LMP,4/ICM,11/PREC,12/LEN * * WHERE * * *TP* TYPE OF BLOCK (HEADER, FAST, MEDIUM, SLOW * OR SNAPSHOT LOOP). * *ICM* INDICATES THAT THE FOLLOWING GROUP OF DATA ELEMENTS * (UP TO THE NEXT DEFINITION OF *ICM*) IS EITHER A * SINGLE OR MULTIPLE ELEMENT ENTRY. * * WARNING - IF ARRAY LENGTH IS NOT EQUAL TO ONE. THE ELEMENT * PRECISION MUST NOT BE GREATER THAN TWO. PURGMAC MPAR MACRO MPAR,NAME,LEN,PREC,LMP NOREF .IC,.TYPE,BL .1 IFC EQ,$NAME$$ CON 0 .1 ELSE .2 IFC EQ,$PREC$$ ERR PRECISION NOT SPECIFIED .2 ENDIF IFNE LEN,1,1 ERRNG 2-P.NAME OFFSET CALCULATION ERROR IFEQ BL,0,1 .IC SET 0 NAME EQU .IC .IC SET .IC+1 P.NAME EQU PREC 0 L.NAME EQU LEN 0 VFD 24/4L_NAME,3/.TYPE,6/LMP,4/.ICM,11/P.NAME,12/L.NAME BL SET BL+P.NAME*L.NAME .1 ENDIF ENDM SPACE 4,10 ** DDSC - DATA DESCRIPTION. * * NAME DDSC SDL,DTY,WFA,WFP * * ENTRY *NAME* = ORDINAL OF ITEM IN THE CORRESPONDING * *MPAR* TABLE. * *SDL* = SELECTION BIT. * *DTY* = DATA TYPE OF ITEM. * *WFA* = WEIGHT FACTOR INSTRUCTION. * *WFP* = WEIGHT FACTOR POINTER. * * EXIT *DDSC* ENTRY CONTAINS A POINTER TO THE DECODED * DATA BUFFER *DBUF*, WHERE THE DATA OF THE ITEM * IS DECODED AND STORED. * * NOTE - *DDSC* ENTRY FORMAT IS * *T 1/S,3/D,3/WI,13/WFP,4/ICM,18/LEN,18/FW * * WHERE * * *S* IS *SDL*. * *D* IS *DTY*. * *WI* IS *WFA*. * *ICM* SINGLE/MULTIPLE ELEMENT ENTRY INDICATOR. * *LEN* LENGTH OF THE DATA ELEMENT. * *FW* POINT TO THE DECODED DATA BUFFER WHERE * THE VALUE OF THE DATA ELEMENT IS STORED. * * WARNING - THE *MPAR* TABLE HAS TO BE DEFINED BEFORE * *DDSC* TABLE CAN BE DEFINED. THE RELATIVE POSITION * OF THE DATA ITEMS IN *DDSC* TABLE MUST BE THE SAME * AS IN *MPAR* TABLE. PURGMAC DDSC MACRO DDSC,NAME,SDL,DTY,WFA,WFP NOREF .L,.FW,L._NAME,P._NAME IFGT P._NAME,5 .L SET P._NAME/5*L._NAME ELSE .L SET L._NAME ENDIF VFD 1/SDL,3/DTY,3/WFA,13/WFP,4/0,18/.L,18/.FW .FW SET .FW+.L ENDM SPACE 4,10 ** DSPT - DISPLAY TEXT DEFINITION. * * NAME DSPT MSGE,SBTL,WORD,BITA,BITL * * ENTRY *NAME* = ORDINAL OF ITEM IN THE CORRRESPONDING * *DDSC* TABLE. * *MSGE* = DISPLAY TEXT. * *SBTL* = POINTER TO SUBBLOCK TITLES. * *WORD* = WORD COUNT IN MULTITPLE-WORD ENTRY. * *BITA* = BEGIN BIT POSITION FOR NON-WORD-BOUNDARY * ITEMS. * *BITL* = BIT LENGTH. * * EXIT *DSPT* BUILDS *DSPTENT* TABLE AND *DSPTTXT* TABLE. * THE *DSPTTXT* TABLE CONTAINS TEXTS USED IN THE REPORT. * THE *DSPTENT* ENTRY FORMAT IS * *T 9/NAME,6/WORD,6/BITA,6/BITL,9/SBTL,6/LN,18/BC * * WHERE *LN* IS THE LENGTH IN CHARACTER OF THE TEXT, * AND *BC* IS THE BEGIN CHARACTER POSITION OF THE * TEXT IN *DSPTTXT* TABLE. M2 MICRO 1,,** .BC SET 0 PURGMAC DSPT MACRO DSPT,NAME,MSGE,SBTL,WORD,BITA,BITL NOREF .EC,.LN,.L,.BC,SBT NOREF .WC,.CC,.RC,.I IFC EQ,$SBTL$$ SBT SET 777B ELSE SBT SET SBTL ENDIF M1 MICRO 1,,MSGE .EC SET .EC+1 .LN MICCNT M1 M MICRO 1,,*"M2""M1"* .L MICCNT M USE /DSPTENT/ VFD 9/NAME,6/WORD,6/BITA,6/BITL,9/SBT,6/.LN,18/.BC .BC SET .BC+.LN USE USE /DSPTTXT/ IFNE .LN,0 .WC SET .L/10 .CC SET .WC*10 .RC SET .L-.CC M2 MICRO .CC+1,.RC,*"M"* .I SET 1 DUP .WC MSG MICRO .I,10,*"M"* DATA 10H"MSG" .I SET .I+10 ENDD ELSE DATA 10H"M2" ENDIF USE ENDM SPACE 4,10 ** SMGT - SUBBLOCK REPORT TITLE DEFINITION. * * SMGT MSGE,CNT,STC * * ENTRY *MSGE* = SUBBLOCK REPORT TITLE. * *CNT* = NUMBER OF ENTRIES IN THE SUBBLOCK. * *STC* = STARTING NUMBER. IGNORED IF *CNT* IS OMITTED. * * EXIT *SMGT* BUILDS A TABLE OF DISPLAY TEXT, * TEN CHARACTERS, LEFT JUSTIFIED, BLANK FILLED * FOR EACH ENTRY. PURGMAC SMGT SMGT MACRO MSGE,CNT,STC NOREF .ST,.SM MM MICRO 1,,MSGE .IF IFC NE,$CNT$$ .ST SET STC DUP CNT .IF1 IFLT .ST,10B MC OCTMIC .ST,1 .IF1 ELSE MC OCTMIC .ST,2 .IF1 ENDIF MG MICRO 1,,$"MM""MC"$ .ST SET .ST+1 DATA 10H"MG" .SM SET .SM+1 ENDD .IF ELSE DATA 10H"MM" .SM SET .SM+1 .IF ENDIF ENDM SPACE 4,10 ** DEF - DEFINE CONSTANT. * * DEF NAM#VAL#; * * ENTRY *NAM* = CONSTANT NAME. * *VAL* = CONSTANT VALUE. * * EXIT *DEF* DEFINES SYMBOLIC CONSTANTS USED BY BOTH * SYMPL AND COMPASS PROGRAMS. * * WARNING - *DEF* CAN ONLY BE USED TO DEFINE INTEGER CONSTANTS. * NON-INTEGER CONSTANTS HAVE TO BE CONVERTED TO INTEGER BEFORE * *DEF* CAN BE USED. PURGMAC DEF DEF MACRO VALUE NOREF .BB .NAM MICRO 1,,#_VALUE .BB MICCNT .NAM .BB SET .BB+2 .VAL MICRO .BB,,;_VALUE .VAL MICRO 1,,#".VAL" ".NAM" EQU ".VAL" DEF ENDM SPACE 4,10 ** COMMON DECKS. *CALL COMCMAC *CALL COMSPRD *CALL COMSCPS *CALL COMSEJT *CALL COMSSSD *CALL COMSSCD LIST X *CALL COMSCPD *CALL COMUCPD LIST * TITLE ACPD SPACE 4,10 *** ACPD - ANALYZE PERFORMANCE DATA. * * THIS ENTRY POINT IS NEEDED IN ORDER FOR THE * ABSOLUTE BINARY RECORD NAME TO MATCH WITH THE * DECK NAME *ACPD*. IT CONTAINS ONLY A JUMP * INSTRUCTION TO TRANSFER TO THE MAIN SYMPL * PROGRAM *ACPDM*. ACPD BSS 0 TRANSFER ADDRESS FROM THE LOADER EQ =XACPDM TO SYMPL MAIN PROGRAM TITLE PAP - PROCESS ACPD PARAMETERS. * *PAP* DATA DEFINITIONS. SPACE 4,10 DS DATA 0LSUMMARY SECONDARY DEFAULT VALUE OF S DN DATA 0L9999999 SECONDARY DEFAULT VALUE OF N TARG BSS 0 FN ARG FN,FN INPUT FILE L ARG L,L REPORT FILE S ARG DS,S,400B SUMMARY FILE LO ARG LO,LO LIST OPTION IN ARG IN,IN,400B INTERVAL LENGTH IN MINUTES IC ARG IC,IC,400B INTERVAL RECORD COUNT N ARG DN,N,400B NUMBER OF FILES BT ARG BT,BT BEGINNING TIME ET ARG ET,ET ENDING TIME BD ARG BD,BD BEGINNING DATE ED ARG ED,ED ENDING DATE ARG ERC CON 0 ERROR CODE ERF CON FATAL FATAL ERROR EFL CON 0 ERROR NAME PAR BSS 0 PERROR PARAMETER LIST VFD 60/ERC VFD 60/ERF VFD 60/EFL VARG BSS 0 DATA 0LFN DATA 0LL DATA 0LS DATA 0LLO DATA 0LIN DATA 0LIC DATA 0LN DATA 0LBT DATA 0LET DATA 0LBD DATA 0LED PAP EJECT ** PAP - PROCESS *ACPD* PARAMETERS. * * *PAP* VALIDATES *ACPD* PARAMETERS, AND CONVERTS * PARAMETERS IN DISPLAY CODE NUMBER TO BINARY. PAP SUBR ENTRY/EXIT SB1 1 SA1 ACTR SA4 ARGR SB4 X1 NUMBER OF ARGUMENTS SB5 TARG RJ ARG NZ X1,PAP12 IF ERROR SA5 FN ZR X5,PAP11 IF NO DATA FILE SA5 LO LX5 6 SX4 X5-1RZ ZR X4,PAP1 IF *Z* OPTION NZ X5,PAP11 IF INCORRECT OPTION PAP1 SA5 N CONVERT *N* PARAMETER SB7 B1+ ASSUME DECIMAL CONVERSION RJ DXB NZ X4,PAP11 IF ERROR ZR X6,PAP11 IF ZERO VALUE ENTERED SA6 A5+ SET *N* VALUE SA1 IN SA5 IC ZR X5,PAP2 IF *IC* NOT SPECIFIED ZR X1,PAP2 IF *IN* NOT SPECIFIED SX6 ERM14 * IN AND IC PARAMETER CONFLICT.* EQ PAP13 PROCESS ERROR PAP2 NZ X5,PAP3 IF *IC* SPECIFIED SA5 IN SX6 6 ZR X5,PAP4 IF *IN* NOT SPECIFIED PAP3 RJ DXB NZ X4,PAP11 IF ARGUMENT ERROR ZR X6,PAP11 IF ARGUMENT ERROR PAP4 SA6 A5 SET *IN* OR *IC* VALUE * CHECK FOR *BT* AND *ET* PARAMETERS. SB2 B1+B1 MX0 8*6 SA5 BT-1 PAP7 SA5 A5+B1 ZR X5,PAP8 IF PARAMETER NOT SPECIFIED OR ZERO LX5 2*6 BX2 -X0*X5 SB3 X2-2R24 GE B3,PAP11 IF HOUR .GE. 24 SB3 X2-2R00 NG B3,PAP11 IF HOUR .LT. 00 LX5 2*6 BX2 -X0*X5 SB3 X2-2R60 GE B3,PAP11 IF MINUTE .GE. 60 SB3 X2-2R00 NG B3,PAP11 IF MINUTE .LT. 00 MX4 -6 LX5 6 BX2 -X4*X5 SB3 X2-1R6 GE B3,PAP11 IF SECOND .GE. 6X SB3 X2-1R0 NG B3,PAP11 IF SECOND .LT. 0X LX5 6 BX2 -X4*X5 SB3 X2-1R9 LX5 2*6 GT B3,PAP11 IF SECOND .GT. X9 SB3 X2-1R0 NG B3,PAP11 IF SECOND .LT. X0 LX5 2*6 BX2 -X0*X5 NZ X2,PAP11 IF TIME TOO LONG PAP8 SB2 B2-B1 GT B2,PAP7 IF NOT DONE * CHECK FOR *BD* AND *ED* PARAMETERS. SB2 2 SA5 BD-1 PAP9 SA5 A5+B1 ZR X5,PAP10 IF PARAMETER NOT SPECIFIED OR ZERO LX5 2*6 BX2 -X0*X5 SB3 X2-2R99 GT B3,PAP11 IF YEAR .GT. 99 SB3 X2-2R70 PL B3,PAP9.1 IF YEAR .GE. 70 SB3 X2-2R33 GT B3,PAP11 IF YEAR .GT. 33 SB3 X2-2R00 NG B3,PAP11 IF YEAR .LT. 00 PAP9.1 LX5 2*6 BX2 -X0*X5 SB3 X2-2R12 GT B3,PAP11 IF MONTH .GT. 12 SB3 X2-2R01 NG B3,PAP11 IF MONTH .LT. 01 LX5 2*6 BX2 -X0*X5 SB3 X2-2R31 GT B3,PAP11 IF DAY .GT. 31 SB3 X2-2R01 NG B3,PAP11 IF DAY .LT. 01 MX3 -6 BX4 -X3*X2 SB3 X4-1R9 GT B3,PAP11 IF DATE .GT. X9 SB3 X4-1R0 NG B3,PAP11 IF DATE .LT. X0 LX5 2*6 BX2 -X0*X5 NZ X2,PAP11 IF DATE TOO LONG PAP10 SB2 B2-B1 GT B2,PAP9 IF NOT DONE EQ PAPX RETURN * PROCESS ARGUMENT ERROR. PAP11 SB2 FN GET ARGUMENT NAME SB2 A5-B2 SA4 B2+VARG PAP12 MX0 2*6 BX6 X0*X4 SA6 EFL SX6 ERM1 * ACPD ARGUMENT ERROR - XX.* * PROCESS ERROR. PAP13 SA6 ERC SET ERROR CODE SA1 PAR SET PARAMETER ADDRESS RJ =XPERROR NO RETURN SPACE 4,10 * COMMON DECKS *CALL COMCARG *CALL COMCDXB END ACPD *WEOR PRGM ACPDM; # TITLE ACPDM - ANALYZE PERFORMANCE DATA. # BEGIN # ACPDM # # *** ACPDM - ANALYZE PERFORMANCE DATA. * * ANALYZE PERFORMANCE DATA COLLECTED BY *CPD*. * * COMMAND FORMAT. * * ACPD(P1,P2,...,PN) * * WHERE PI IS ANY OF THE FOLLOWING. * * OPTION DEFAULT DESCRIPTION * * FN=LFN1 SAMPLE DATA FILE NAME. * L=LFN2 OUTPUT REPORT FILE NAME. * S=LFN3 0 SUMMARY FILE NAME. * IF NO EQUIVALENCE, *S* IS ASSUMED * TO BE *SUMMARY*. * IN=NNN 6 MINS INTERVAL LENGTH IN MINUTES. * IF THE IC PARAMETER IS SPECIFIED AND * IN IS NOT, THE IC VALUE IS USED * INSTEAD OF THE IN PARAMETER DEFAULT * TO SPECIFY THE REPORT INTERVAL. USE * OF BOTH THE IN AND IC PARAMETERS * RESULTS IN AN ERROR. * IC=NNN 0 RECORDS INTERVAL RECORD COUNT. SPECIFIES THE * NUMBER OF SAMPLE FILE RECORDS PER * REPORT INTERVAL. USE OF BOTH THE IN * AND IC PARAMETERS RESULTS IN AN ERROR. * N=NNN 1 FILE NUMBER OF FILES TO PROCESS. * IF NO EQUIVALENCE, *ACPD* WILL PROCESS * UNTIL EOI OF *LFN1* IS REACHED. * LO=Z 0 LIST OPTION. IF LO=Z, ELEMENTS * WITH ZERO VALUES WILL BE PRINTED. * IF LO=0 (DEFAULT), THESE ELEMENTS * WILL NOT BE PRINTED. *Z* IS THE * ONLY VALID OPTION. * BT=HHMMSS 0 BEGINNING TIME. IF *BT* IS OMITTED, * PROCESSING WILL BEGIN AT THE * CURRENT DATA FILE POSITION. IF *BT* * IS SPECIFIED, PROCESSING WILL * BEGIN AT THE FILE CONTAINING THE * RECORD WHOSE TIME EQUALS TO *BT*. * BD=YYMMDD 0 BEGINNING DATE. IF *BD* IS OMITTED, * *BD* WILL BE ASSUMED THE DATE OF THE * FILE WHERE THE DATA FILE IS * CURRENTLY POSITIONED. * ET=HHMMSS 0 ENDING TIME. *ACPD* WILL TERMINATE * WHEN THE RECORD WHOSE TIME EQUALS * TO *ET* IS REACHED. * ED=YYMMDD 0 ENDING DATE. *ED* AND *ET* FORM THE * ENDING TIME. IF *ED* IS SPECIFIED BUT * *ET* IS OMITTED, THE ENDING TIME IS * ZERO HOUR OF DAY *ED*. IF *ED* IS * OMITTED BUT *ET* IS SPECIFIED, *ED* * IS SET TO THE VALUE OF *BD*. IF BOTH * *ED* AND *ET* ARE OMITTED, *ACPD* WILL * TERMINATE IF THE FOLLOWING OCCURS : * -NUMBER OF FILES SPECIFIED IN THE * *N* PARAMETER ARE PROCESSED. * -AT EOI OF THE DATA FILE. * * SUMMARY FILE FORMAT. * * THE SUMMARY FILE HAS TWO TYPES OF RECORD, THE HEADER BLOCK * RECORD AND THE DATA BLOCK RECORD. * THE HEADER BLOCK RECORD IS THE HEADER RECORD OF THE DATA * FILE IN THE UNPACKED FORMAT. * EACH DATA BLOCK RECORD CONTAINS VALUES OF THE DATA BLOCK * ELEMENTS IN ONE REPORT INTERVAL. * THE DATA BLOCK RECORD HAS TWO EQUAL LENGTH PARTS. THE * FIRST PART CONTAINS THE AVERAGE VALUES OF THE DATA BLOCK * ELEMENTS. THE SECOND PART CONTAINS THE STANDARD DEVIATIONS * OF EACH DATA BLOCK ELEMENTS. * THE LOOP SAMPLE TIMES AND THE SNAPSHOT ELEMENTS DO NOT * HAVE STANDARD DEVIATIONS (0). * THERE IS AN EOR BETWEEN TWO CONSECUTIVE RECORDS. * * MESSAGES. * * -ACPD ARGUMENT ERROR - XX. * ERROR DETECTED IN COMMAND SYNTAX. * * -BT/BD NOT FOUND. * *BT*/*BD* GREATER THAN THE TIME OF THE LAST DATA RECORD. * * -CPD/ACPD VERSIONS MISMATCH. * *CPD* AND *ACPD* VERSIONS ARE NOT COMPATIBLE. * * -DATA BLOCKS MISSING. * EXPECTED DATA BLOCKS FOLLOWING HEADER BLOCK NOT FOUND. * * -DATA ELEMENT NAME UNDEFINED - XXXX. * DATA ELEMENT XXXX IS NOT DEFINED IN COMMON DECK COMSCPD. * * -DATA FILE POSITIONED AT *EOI*. * DATA FILE IS INITIALLY POSITIONED AT EOI. * * -DATA FILE EMPTY. * DATA FILE IS EMPTY. * * -DATA FILE CONTENT ERROR. * DATA FILE GENERATED BY *CPD* IS NOT IN THE EXPECTED * FORMAT. * * -DATA FILE NOT AT BEGINNING OF A FILE. * AT THE BEGINNING OF PROCESSING, THE DATA FILE IS * POSITIONED EITHER AT THE MIDDLE OF A RECORD, OR * AT THE BEGINNING OF A DATA BLOCK RECORD. * * -DATA FILE NOT FOUND - XXX. * DATA FILE XXX IS NOT LOCAL TO THE JOB AT THE TIME *ACPD* * IS RUNNING. * * -DATA FILE NOT IN CHRONOLOGICAL ORDER. * DATA FILE IS NOT IN THE INCREASING ORDER OF TIME OF THE * RECORDS. * * -IN LESS THAN FILE WRITE TIME. * REPORT TIME INTERVAL LESS THAN FILE WRITE TIME * (*FW*) OF *CPD*. * * -IN AND IC PARAMETER CONFLICT. * THE IN AND IC PARAMETERS WERE BOTH SPECIFIED ON THE *ACPD* * COMMAND. * * -N EXCEEDS NUMBER OF FILES. * NUMBER OF FILES REQUESTED GREATER THAN NUMBER OF FILES * ON THE DATA FILE. * * * NOTE. * * TO BUILD *ACPD*, DO THE FOLLOWING : * * - MODIFY(Z)/*EDIT,ACPD * - COMPASS(I,S=NOSTEXT) * - SYMPL(I) * - LDSET(LIB=SRVLIB,PRESET=ZERO) * - LOAD(LGO) * - NOGO(ACPD,ACPD,$RFL=$) * # # **** PRGM ACPDM - XREF LIST BEGIN. # XREF BEGIN PROC DATBLK; # PROCESS DATA BLOCK # PROC HEADER; # PROCESS HEADER BLOCK # PROC INITLZ; # INITIALIZE *ACPD* # PROC MESSAGE; # ISSUE DAYFILE MESSAGE # PROC RPCLOSE; # CLOSE FILES # END # **** PRGM ACPDM - XREF LIST END. # DEF LISTCON #0#; #TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM DTDC B; # DATA BLOCK DECODED FLAG # ITEM HDDC B; # HEADER BLOCK DECODED FLAG # ITEM I I; # FOR LOOP CONTROL # ITEM LSTM U; # TIME OF LAST RECORD # ITEM EDTM B; # ENDING TIME EXPIRED FLAG # # * BEGIN *ACPDM* PROGRAM. # INITLZ(HDDC,DTDC,EDTM); # INITIALIZE *ACPD* # SLOWFOR I=1 STEP 1 WHILE (I LQ P$N) AND (NOT EDTM) DO BEGIN # PROCESS ONE FILE # HEADER(EDTM,HDDC,LSTM); # PROCESS HEADER BLOCK # IF (NOT EDTM) # NOT EOI # THEN BEGIN DATBLK(EDTM,DTDC,LSTM); # PROCESS DATA BLOCK # END END # PROCESS ONE FILE # IF (P$L NQ NULL) # REPORT FILE SPECIFIED # THEN BEGIN # CLOSE REPORT FILE # RPCLOSE(OFFA); END MESSAGE(" ACPD COMPLETE.",3); END # ACPDM # TERM PROC ACMSTA((STA),(FWA),(DTY),(BCL),(WFP)); # TITLE ACMSTA - PRINT TOTAL STATISTICAL VALUES. # BEGIN # ACMSTA # # ** ACMSTA - PRINT TOTAL STATISTICAL VALUES. * * PRINT PERCENTAGE, STANDARD DEVIATION, AND AVERAGE * OF ONE DATA ELEMENT FOR THE ENTIRE *ACPD* RUN. * * PROC ACMSTA((STA),(FWA),(DTY),(BCL),(WFP)) * * ENTRY STA = STATISTICAL VALUE TO BE COMPUTED. * FWA = ADDRESS OF THE DATA ELEMENT IN TABLE *DDSM*. * DTY = DATA TYPE. * BCL = BEGINNING COLUMN TO PRINT THE VALUE. * WFP = WEIGHT FACTOR. * * EXIT THE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE * OF THE DATA ELEMENT FOR THE ENTIRE RUN ARE PRINTED. # # * PARAMETER LIST. # ITEM STA U; # STATISTIC TO BE COMPUTED # ITEM FWA U; # DATA ELEMENT ORDINAL # ITEM DTY U; # DATA TYPE # ITEM BCL U; # BEGINNING COLUMN # ITEM WFP R; # WEIGHT FACTOR # # **** PROC ACMSTA - XREF LIST BEGIN. # XREF BEGIN FUNC SQRT R; # SQUARE ROOT FUNCTION # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC ACMSTA - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM VL R; # TEMPORARY STORAGE # ARRAY MAXVAL [0:0] P(1); # MAXIMUM VALUE # BEGIN # ARRAY MAXVAL # ITEM MAXR R(00,00,60); # REAL VALUE # ITEM MAXI I(00,00,60); # INTEGER VALUE # END # ARRAY MAXVAL # ARRAY MINVAL [0:0] P(1); # MINIMUM VALUE # BEGIN # ARRAY MINVAL # ITEM MINR R(00,00,60); # REAL VALUE # ITEM MINI I(00,00,60); # INTEGER VALUE # END # ARRAY MINVAL # ARRAY TOTVAL [0:0] P(1); # TOTAL REPORT VALUE # BEGIN # ARRAY TOTVAL # ITEM TOTR R(00,00,60); # REAL VALUE # ITEM TOTI I(00,00,60); # INTEGER VALUE # END # ARRAY TOTVAL # SWITCH STAT:STVAL # STATISTIC # PCSS:PCST, # PERCENTAGE # SDSS:SDST, # STANDARD DEVIATION # AVSS:AVST; # AVERAGE # LABEL PRSTAT; # PRINT TOTAL STATISTICS # # * BEGIN ACMSTA PROC. # P=LOC(DBUF[DCHL + DCDC*DCDL*2]); GOTO STAT[STA]; # * COMPUTE AND PRINT TOTAL PERCENTAGE. # PCSS: # PERCENTAGE # IF (WFP EQ 0) THEN BEGIN TOTR[0]=0.0; END ELSE BEGIN TOTR[0]=(DDSM$SM[FWA]/(ACNS*WFP))*100.0; END MAXR[0]=DDSM$PX[FWA]; # MAXIMUM PERCENTAGE # MINR[0]=DDSM$PN[FWA]; # MINIMUM PERCENTAGE # GOTO PRSTAT; # * COMPUTE AND PRINT TOTAL STANDARD DEVIATION. # SDSS: # STANDARD DEVIATION # VL=DDSM$SM[FWA]/ACNS; TOTR[0]=SQRT(DDSM$SQ[FWA]/ACNS - VL*VL); MAXR[0]=DDSM$SX[FWA]; # MAXIMUM STANDARD DEVIATION # MINR[0]=DDSM$SN[FWA]; # MINIMUM STANDARD DEVIATION # GOTO PRSTAT; # * COMPUTE AND PRINT TOTAL AVERAGE. # AVSS: # AVERAGE # VL=DDSM$SM[FWA]; IF (DTY EQ FLPC) # REAL FORMAT # THEN BEGIN TOTR[0]=VL/ACNS; MAXR[0]=DDSM$AX[FWA]; # MAXIMUM AVERAGE # MINR[0]=DDSM$AN[FWA]; # MINIMUM AVERAGE # END ELSE # NOT REAL FORMAT # BEGIN TOTI[0]=VL/ACNS; MAXI[0]=DDSM$AX[FWA]; # MAXIMUM AVERAGE # MINI[0]=DDSM$AN[FWA]; # MINIMUM AVERAGE # END # * PRINT TOTAL STATISTICS. # PRSTAT: # PRINT STATISTIC VALUES # WRITEV(TOTVAL[0],DTY,BCL+1,9,NLFC); WRITEV(MAXVAL[0],DTY,BCL+10,10,NLFC); WRITEV(MINVAL[0],DTY,BCL+20,10,LFDC); RETURN; END # ACMSTA # TERM PROC ADJUST; # TITLE ADJUST - ADJUST TABLES AND FIELD LENGTH. # BEGIN # ADJUST # # ** ADJUST - ADJUST TABLES AND FIELD LENGTH. * * THIS PROC RECOMPUTES THE FIELD LENGTH AND BUFFER ADDRESSES. * IT ALSO COMPUTES THE DECODED BUFFER ADDRESSES OF TABLES * *DDHD* AND *DDDT*. * THE MASS STORAGE DEVICE SUBBLOCK TITLE TABLE IS CONSTRUCTED * BASED ON THE EST. * * PROC ADJUST * * ENTRY NONE. * * EXIT THE NEW DECODED BUFFER LENGTHS OF THE HEADER * BLOCK *DCHL* AND DATA BLOCK *DCDL* ARE COMPUTED. * THE DECODED BUFFER POINTERS OF TABLES *DDHD* AND * *DDDT* ARE COMPUTED. * NEW FIELD LENGTH IS COMPUTED. * MASS STORAGE DEVICE SUBBLOCK TITLE TABLE IS * CONSTRUCTED. # # **** PROC ADJUST - XREF LIST BEGIN. # XREF BEGIN PROC MEMORY; # REQUEST MEMORY # FUNC XCOD C(10); # NUMBER TO DISPLAY OCTAL # END # **** PROC ADJUST - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF CPWC #5#; # NUMBER OF CHARACTER PER WORD # DEF MXVC #1.0E20#; # MAXIMUM VALUE # DEF NA #"NA"#; # NO ABORT FLAG # DEF RECALL #1#; # RECALL FLAG # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD *CALL COMUEST # * LOCAL VARIABLES. # ITEM BL I; # BUFFER LENGTH # ITEM BLC I; # BUFFER LENGTH # ITEM CBL I; # CURRENT BUFFER LENGTH # ITEM CM C(10)="CM"; # MEMORY ARGUMENT # ITEM I I; # FOR LOOP CONTROL # ITEM IC I; # INCREMENTOR # ITEM J I; # FOR LOOP CONTROL # ITEM L I; # TEMPORARY STORAGE # ITEM LN I; # LENGTH # ITEM M I; # TEMPORARY STORAGE # ITEM MSI I; # *MST* ORDINAL # ITEM N I; # TEMPORARY STORAGE # ITEM ORD C(10); # *MST* ORDINAL DISPLAY # ITEM PR I; # PRECISION # ITEM RBL I; # REQUESTED BUFFER LENGTH # ITEM RDCDL I; # REQUESTED BUFFER LENGTH # ITEM RDCHL I; # REQUESTED BUFFER LENGTH # BASED ARRAY MSD [0:0] P(1); # MASS STORAGE DEVICE # BEGIN # ARRAY MSD # ITEM MSD$WD I(00,00,60); # MSD ENTRY # ITEM MSD$EQ C(00,00,03); # EQUIPMENT NAME # ITEM MSD$OR C(00,18,07); # EQUIPMENT ORDINAL # END # ARRAY MSD # ARRAY STT [0:0] P(1); # MEMORY ARGUMENT # BEGIN # ARRAY STT # ITEM STT$RFL U(00,00,30); # REQUESTED FIELD LENGTH # ITEM STT$CMB U(00,59,01); # COMPLETION BIT # END # ARRAY STT # # * BEGIN ADJUST PROC. # P=LOC(DBUF); # * COMPUTE LENGTH OF THE HEADER BLOCK DECODED BUFFER. # BL=0; P=LOC(HDTR); P=LOC(DDHD); J=0; SLOWFOR M=0 WHILE (MPAR$WD[J] NQ 0) DO BEGIN # COMPUTE HEADER BLOCK LENGTH AND BUFFER ADDRESS # LN=MPAR$LN[J]; IF (MPAR$LMP[J] NQ 0) THEN BEGIN LN=LN*DCHD$WD[DDSC$FW[MPAR$LMP[J]]]; END PR=MPAR$PR[J]; IF (PR GR CPWC) THEN BEGIN LN=(PR/CPWC)*LN; END BLC=BL; IC=MPAR$IC[J]; FASTFOR I=1 STEP 1 UNTIL IC DO BEGIN DDSC$FW[J]=BLC; DDSC$LN[J]=LN; DDSC$IC[J]=IC; BL=BL+LN; BLC=BLC+1; J=J+1; END END # COMPUTE HEADER BLOCK LENGTH AND BUFFER ADDRESS # RDCHL=BL+1; # NEW HEADER BLOCK BUFFER LENGTH # # * COMPUTE THE DATA BLOCK DECODED BUFFER LENGTH. # BL=0; J=0; P=LOC(DATT); SLOWFOR M=0 WHILE (MPAR$WD[J] NQ 0) DO BEGIN # COMPUTE DATA BLOCK LENGTH AND BUFFER ADDRESS # P=LOC(DDHD); LN=MPAR$LN[J]; IF (MPAR$LMP[J] NQ 0) THEN BEGIN LN=LN*DCHD$WD[DDSC$FW[MPAR$LMP[J]]]; END PR=MPAR$PR[J]; IF (PR GR CPWC) THEN BEGIN LN=(PR/CPWC)*LN; END P=LOC(DDDT); BLC=BL; IC=MPAR$IC[J]; FASTFOR I=1 STEP 1 UNTIL IC DO BEGIN DDSC$FW[J]=BLC; DDSC$LN[J]=LN; DDSC$IC[J]=IC; BL=BL+LN; BLC=BLC+1; J=J+1; END END # COMPUTE DATA BLOCK LENGTH AND BUFFER ADDRESS # RDCDL=BL+1; # NEW DATA BLOCK LENGTH # # * COMPUTE NEW FIELD LENGTH. # RBL=RDCHL+(RDCDL*DCDC*2)+(RDCDL*8); # NEW LENGTH # CBL=DCHL+(DCDL*DCDC*2)+(DCDL*8); # OLD LENGTH # HGAD=HGAD + (RBL-CBL); # UPDATE HIGHEST ADDRESS # DCHL=RDCHL; DCDL=RDCDL; IF (HGAD GR CRFL) # EXCEED FIELD LENGTH # THEN BEGIN STT$RFL[0]=HGAD; MEMORY(CM,STT,RECALL,NA); # REQUEST MEMORY # CRFL=STT$RFL[0]; # UPDATE CURRENT FIELD LENGTH # END # * INITIALIZE DECODED BUFFER AND TOTAL BUFFER. # P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); FASTFOR I=0 STEP 1 UNTIL DCDC*DCDL*2 - 1 DO BEGIN DCDT$WD[I]=0; END FASTFOR I=0 STEP 1 UNTIL DCDL-1 DO BEGIN DDSM$IM[I]=0; DDSM$IQ[I]=0; DDSM$AX[I]=0; DDSM$AN[I]=MXVC; DDSM$SX[I]=0; DDSM$SN[I]=MXVC; DDSM$PX[I]=0; DDSM$PN[I]=MXVC; END # * CONSTRUCT THE MASS STORAGE DEVICE SUBBLOCK TITLE TABLE. # P=LOC(DDHD); P=LOC(DCHD$WD[DDSC$FW[ESTB]]); P=LOC(SMGT[EQTN]); MSI=0; SLOWFOR J=0 STEP 1 UNTIL DCHD$WD[DDSC$FW[ESTL]] - 1 DO BEGIN # SEARCH FOR MASS STORAGE DEVICE IN EST # IF (EST$MS[J]) # MASS STORAGE DEVICE # THEN BEGIN # BUILD SUBBLOCK TITLE # MSD$EQ[MSI]="EQ "; MSD$OR[MSI]=BLKC; ORD=XCOD(J); # CONVERT TO DISPLAY # N=0; SLOWFOR I=9 STEP -1 WHILE (CORD NQ BLKC) DO # COUNT NUMBER OF DIGITS # BEGIN N=N+1; END M=I+1; L=0; SLOWFOR I=1 STEP 1 WHILE (I LQ N) DO # BUILD MST ORDINAL # BEGIN CMSD$OR[MSI]=CORD; L=L+1; M=M+1; END MSI=MSI+1; END # BUILD SUBBLOCK TITLE # END # SEARCH FOR MASS STORAGE DEVICE IN EST # MSD$WD[MSI]=0; # END OF TABLE # RETURN; END # ADJUST # TERM PROC CHKSPA((SPC),WFT,PRFLG); # TITLE CHKSPA - CHECK SPECIAL ACTION. # BEGIN # CHKSPA # # ** CHKSPA - CHECK SPECIAL ACTION. * * *CHKSPA* PERFORMS TASKS THAT CANNOT BE TABLE DRIVEN. * CURRENTLY THESE ACTIONS INCLUDE COMPUTING AVAILABLE * MEMORY AND BUFFERED I/O CHECKING. * * PROC CHKSPA((SPC),WFT,PRFLG) * * ENTRY SPC = SPECIAL ACTION CODE. * * EXIT WFT = WEIGHT FACTOR. * PRFLG = FLAG INDICATES IF ELEMENT IS TO BE PROCESSED. # # * PARAMETER LIST. # ITEM SPC I; # SPECIAL ACTION CODE # ITEM WFT R; # WEIGHT FACTOR # ITEM PRFLG B; # PROCESS FLAG # # **** PROC CHKSPA - XREF LIST BEGIN. # XREF BEGIN PROC WRITEV; # WRITE DATA VALUE # END # **** PROC CHKSPA - XREF LIST END. # DEF NPCC #-1.0#; # NO PERCENTAGE FLAG # DEF LISTCON #0#; # TURN OFF COMMON LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM TEM I; # TEMPORARY STORAGE # SWITCH SPAT AVMS, # AVAILABLE MEMORY # BIOS, # BUFFERED I/O # ; # END OF SPAT # # * BEGIN CHKSPA PROC. # P=LOC(DBUF); P=LOC(DDHD); PRFLG=FALSE; GOTO SPAT[SPC]; AVMS: # AVAILABLE MEMORY # WFT=DCHD$WD[DDSC$FW[MEMS]]-DCHD$WD[DDSC$FW[CMRS]]; PRFLG=TRUE; RETURN; BIOS: # BUFFERED I/O PARAMETERS # WFT=DCHD$WD[DDSC$FW[TIOB]]; IF (WFT NQ 0) # SYSTEM HAS BUFFERED I/O # THEN BEGIN PRFLG=TRUE; END RETURN; # * END CASE. # END # CHKSPA # TERM PROC COMPWF((WFA),(WFP),(POS),WFT,PRFLG); # TITLE COMPWF - COMPUTE WEIGHT FACTOR. # BEGIN # COMPWF # # ** COMPWF - COMPUTE WEIGHT FACTOR. * * COMPUTE WEIGHT FACTOR FOR PERCENTAGE CALCULATION. * * PROC COMPWF((WFA),(WFP),(POS),WFT,PRFLG) * * ENTRY WFA = WEIGHT FACTOR INFORMATION. * WFP = WEIGHT FACTOR. * POS = RELATIVE POSITION OF THE WEIGHT FACTOR. * * EXIT WFT = COMPUTED WEIGHT FACTOR. * WFT=-1.0 IF PERCENTAGE NOT TO BE PRINTED. * PRFLG = PROCESS FLAG. # # * PARAMETER LIST. # ITEM WFA U; # WEIGHT FACTOR INFORMATION # ITEM WFP U; # WEIGHT FACTOR # ITEM POS I; # RELATIVE POSITION OF *WFP* # ITEM WFT R; # COMPUTED WEIGHT FACTOR # ITEM PRFLG B; # PROCESS FLAG # # **** PROC COMPWF - XREF LIST BEGIN. # XREF BEGIN PROC CHKSPA; # CHECK SPECIAL ACTION # END # **** PROC COMPWF - XREF LIST END. # DEF NPCC #-1.0#; # NO PERCENTAGE FLAG # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # SWITCH WFAT WGFS, # WEIGHT FACTOR SPECIFIED # NWFS, # NO WEIGHT FACTOR # CWFS, # CONSTANT WEIGHT FACTOR # SPAS, # SPECIAL ACTION # IWFS, # INDIRECT WEIGHT FACTOR # ; # END OF WFAT # # * BEGIN COMPWF PROC. # P=LOC(DBUF); P=LOC(DDHD); PRFLG=TRUE; GOTO WFAT[WFA]; WGFS: # WEIGHT FACTOR SPECIFIED # WFT=DCHD$WD[DDSC$FW[WFP] + POS]; RETURN; NWFS: # NO WEIGHT FACTOR # WFT=NPCC; RETURN; CWFS: # CONSTANT WEIGHT FACTOR # WFT=WFP; IF (WFP EQ 100) # CONSTANT FACTOR IS 100 # THEN # NO PERCENTAGE # BEGIN WFT=NPCC; END RETURN; SPAS: # SPECIAL ACTION # CHKSPA(WFP,WFT,PRFLG); RETURN; IWFS: # INDIRECT WEIGHT FACTOR # WFT=0.0; # TO BE COMPUTED # RETURN; # * END CASE. # END # COMPWF # TERM PROC DATBLK(EDTM,DTDC,LSTM); # TITLE DATBLK - PROCESS DATA BLOCK. # BEGIN # DATBLK # # ** DATBLK - PROCESS DATA BLOCK. * * DATBLK PROCESSES DATA BLOCKS OF EACH FILE IN THE DATA FILE. * * PROC DATBLK(EDTM,DTDC,LSTM) * * ENTRY EDTM = TRUE IF ENDING TIME REACHED, * FALSE IF OTHERWISE. * DTDC = INDICATE IF DATA BLOCK HAS BEEN DECODED. * FILE IS POSITIONED AT THE FIRST DATA BLOCK RECORD. * * EXIT TIME = TRUE IF ENDING TIME REACHED. * LSTM = TIME OF LAST RECORD. * DATA FILE IS POSITIONED AT EITHER *EOI* OR * AT *EOF* OF THE CURRENT FILE. IF TIME IS TRUE, * DATA FILE IS AT THE RECORD CONTAINING THE * ENDING TIME. # # * PARAMETER LIST. # ITEM EDTM B; # ENDING TIME OR EOI FLAG # ITEM DTDC B; # DECODE DATA BLOCK FLAG # ITEM LSTM U; # TIME IF LAST RECORD # # **** PROC DATBLK - XREF LIST BEGIN. # XREF BEGIN PROC DECODE; # DECODE *CIO* INPUT BUFFER DATA # FUNC DTMNUM U; # CONVERT DATE/TIME TO BINARY # PROC PERROR; # PROCESS ERROR # PROC PUTDAT; # PRINT DATA BLOCK ELEMENTS # PROC READRC; # READ ONE RECORD FROM DATA FILE # PROC WRTSUM; # WRITE SUMMARY FILE # END # **** PROC DATBLK - XREF LIST END. # DEF DOTC #TRUE#; # FLAG # DEF MXVC #1.0E10#; # MAXIMUM VALUE # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM BC I; # BEGINNING COLUMN # ITEM FW I; # FILE WRITE TIME # ITEM I I; # FOR LOOP CONTROL # ITEM J I; # FOR LOOP CONTROL # ITEM K I; # FOR LOOP CONTROL # ITEM NS I; # SAMPLING FREQUENCY # ITEM PT I; # ADDRESS OF DECODED DATA BLOCK # ITEM STAT I; # I/O STATUS # ITEM TM I; # TIME OF CURRENT RECORD # # * BEGIN DATBLK PROC. # P=LOC(DBUF); P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); TLFG=1; # SUBTITLE IS TO BE PRINTED # # * DETERMINE REPORT INTERVAL LENGTH. # P=LOC(DDHD); FW=DCHD$WD[DDSC$FW[DLFW]]; # FILE WRITE TIME # IF (P$IN NQ 0) # INTERVAL TIME SPECIFIED # THEN BEGIN NS=(P$IN*60)/FW; # NUMBER OF RECORDS PER INTERVAL # IF (NS EQ 0) # *IN* .LT. *FW* # THEN BEGIN PERROR(ERM10,FATAL,NULL); # IN LESS THAN FILE WRITE TIME # END END ELSE BEGIN NS=P$IC; # NUMBER OF RECORDS PER INTERVAL # END IF (DTDC) # FIRST DATA BLOCK DECODED # THEN BEGIN BC=2; # COLLECT NEXT SAMPLE # ACNS=1; TM=P$BT; DTDC=FALSE; END ELSE # NOT DECODED # BEGIN BC=1; # COLLECT FIRST SAMPLE # ACNS=0; TM=DTMNUM(DCHD$WD[DDSC$FW[DATE]],DOTC,TRUE)*SHFC; TM=TM + DTMNUM(DCHD$WD[DDSC$FW[TIME]],DOTC,FALSE); END # * PROCESS DATA BLOCKS UNTIL EITHER END OF * CURRENT FILE OR END TIME IS REACHED. # PT=LOC(DCDT); P=LOC(DDDT); STAT=EORC; TCOL=0; # TOTAL NUMBER OF COLUMNS # SLOWFOR K=1 STEP 1 WHILE (STAT EQ EORC) AND (P$ET GR TM) DO BEGIN # COLLECT DATA # # * COLLECT DATA FOR 10 COLUMNS AND PUT THEM IN THE DECODED * DATA BLOCK BUFFER *DCDT*. *PT* IS THE ADDRESS OF WHERE THE * DECODED DATA ARE TO BE STORED IN *DCDT*. FOR EACH COLUMN, THE * NUMBER OF DATA BLOCKS NEEDED TO COLLECT IS DETERMINED BY *NS*. # SLOWFOR I=1 STEP 1 UNTIL DCDC DO BEGIN # PROCESS 10 COLUMNS # SLOWFOR J=BC STEP 1 UNTIL NS DO BEGIN # COLLECT DATA FOR THE I-TH COLUMN # IF (IBWA GQ IBNW) # INPUT BUFFER EXHAUSTED # THEN BEGIN # GET NEXT RECORD # READRC(STAT); # READ NEXT RECORD # IF (STAT NQ EORC) # EOF OR EOI # THEN BEGIN TEST K; # END OF CURRENT FILE # END IBWA=0; # RESET INPUT BUFFER POINTER # END # GET NEXT RECORD # DECODE(LOC(DATT),PT); # DECODE DATA BLOCK # ACNS=ACNS+1; # NUMBER OF DATA BLOCKS DECODED # TM=DCDT$WD[(I-1)*DCDL + DDSC$FW[PDTM]]; # GET TIME # IF (TM GQ P$ET) # CURRENT TIME GREATER THAN # THEN # ENDING TIME # BEGIN TEST K; # ENDING TIME REACHED # END END # COLLECT DATA FOR THE I-TH COLUMN # BC=1; TCOL=TCOL+1; PT=PT+DCDL; # NEXT BUFFER ADDRESS # END # PROCESS 10 COLUMNS # # * DATA OF THE FAST, MEDIUM, SLOW, AND SNAPSHOT LOOPS FOR 10 * COLUMNS HAVE BEEN DECODED AND SAVED IN DECODED DATA BLOCK * BUFFER *DCDT*. NOW PRINT THE DATA TO THE REPORT FILE AND * THE SUMMARY FILE IF THE SUMMARY FILE IS SPECIFIED. # PUTDAT(NS,DCDC); # COMPUTE DATA BLOCK ELEMENTS # IF (P$S NQ NULL) # SUMMARY FILE SPECIFIED # THEN BEGIN WRTSUM(DCDC); # WRITE SUMMARY FILE # END # * REINITIALIZE THE DECODED DATA BLOCK BUFFER FOR NEXT * COLLECTION OF DATA. # PT=LOC(DCDT); SLOWFOR I=0 STEP 1 UNTIL DCDC*DCDL*2 - 1 DO BEGIN DCDT$WD[I]=0; END END # COLLECT DATA # # * PROCESS END CASE. * THE NUMBER OF COLUMNS MAY NOT BE 10, AND THE NUMBER OF DATA * BLOCKS COLLECTED FOR THE LAST COLUMN MAY NOT BE *NS*. # IF (STAT NQ EORC) # EOF OR EOI # THEN BEGIN J=J-1; END # * IF LAST COLUMN DOES NOT HAVE ENOUGH BLOCKS, IGNORE LAST * COLUMN. # IF (J LS NS) # NOT ENOUGH BLOCKS # THEN BEGIN # IGNORE LAST INCOMPLETED COLUMN # I=I-1; IF (I EQ 0) # ONLY ONE COLUMN COLLECTED # THEN BEGIN I=1; NS=J; END END # IGNORE LAST INCOMPLETED COLUMN # IF (NS GR 0) # LAST COLUMN HAS DATA # THEN BEGIN PUTDAT(NS,I); # PROCESS LAST COLLECTION # IF (P$S NQ NULL) # SUMMARY FILE SPECIFIED # THEN # WRITE SUMMARY FILE # BEGIN WRTSUM(I); END END IF (I GR (DCDC-3)) # MORE THAN 7 COLUMNS COLLECTED # OR (NS EQ 0) # NO BLOCK WAS COLLECTED # THEN # PRINT TOTAL ON NEXT PAGE # BEGIN PUTDAT(NS,0); # PRINT TOTAL # END # * THE CURRENT FILE IS DONE. CHECK IF THERE IS ANOTHER FILE * TO REPORT. # IF (P$ET LQ TM) # ENDING TIME REACHED # OR (STAT EQ EOIC) # EOI ENCOUNTERED ON FILE # THEN BEGIN EDTM=TRUE; # ENDING TIME REACHED OR EOI # END ELSE # DONE WITH THE CURRENT FILE # BEGIN LSTM=TM; # TIME OF LAST RECORD # END RETURN; END # DATBLK # TERM PROC DATELM(FLG,MS1,MS2,(WFA),(WFP),(POS),(DTY),(FWA),(NSF)); # TITLE DATELM - PROCESS ONE DATA BLOCK ELEMENT. # BEGIN # DATELM # # ** DATELM - PROCESS ONE DATA BLOCK ELEMENT. * * COMPUTE AND PRINT ONE DATA BLOCK ELEMENT-S STATISTICAL * VALUES (AVERAGE, STANDARD DEVIATION, AND PERCENTAGE). * * PROC DATELM(FLG,MS1,MS2,(WFA),(WFP),(POS),(DTY),(FWA),(NSF)) * * ENTRY FLG = TRUE IF SUB BLOCK TITLE IS TO BE PRINTED. * MS1 = SUB BLOCK TITLE. * MS2 = DATA ELEMENT NAME. * WFA = WEIGHT FACTOR INFORMATION. * WFP = WEIGHT FACTOR. * POS = RELATIVE POSITION OF WEIGHT FACTOR. * DTY = DATA TYPE. * FWA = ADDRESS OF THE ELEMENT IN TABLE *DCDT*. * NSF = NUMBER OF RECORDS PER INTERVAL. * NIPP = (COMMON BLOCK *CIOCOMM*) NUMBER OF INTERVALS * PER PAGE. * * EXIT THE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE * OF THE DATA ELEMENT AT TEN INTERVALS ARE COMPUTED * AND PRINTED. * IF THE WEIGHT FACTOR IS THE CONSTANT 1, THE AVERAGE * WILL NOT BE PRINTED. * THE PERCENTAGE WILL NOT BE PRINTED IF THE ELEMENT * DOES NOT HAVE A WEIGHT FACTOR, OR THE WEIGHT FACTOR * IS THE CONSTANT 100. # # * PARAMETER LIST. # ITEM FLG B; # SUBBLOCK TITLE FLAG # ITEM MS1 C(40); # SUBBLOCK TITLE # ITEM MS2 C(30); # DATA ELEMENT NAME # ITEM WFA U; # WEIGHT FACTOR INFORMATION # ITEM WFP U; # WEIGHT FACTOR # ITEM POS I; # RELATIVE POSITIN OF *WFP* # ITEM DTY U; # DATA TYPE # ITEM FWA U; # ADDRESS OF ENTRY # ITEM NSF I; # NUMBER OF SAMPLES PER INTERVAL # # **** PROC DATELM - XREF LIST BEGIN. # XREF BEGIN PROC ACMSTA; # COMPUTE TOTAL STATISTICS # PROC COMPWF; # COMPUTE WEIGHT FACTOR # PROC PRDTEL; # PRINT ONE ROW OF DATA ELEMENT # FUNC SQRT R; # SQUARE ROOT # PROC WRITEV; # WRITE ONE VALUE # END # **** PROC DATELM - XREF LIST END. # DEF AVGC #"AV"#; # AVERAGE # DEF PCTC #"PC"#; # PERCENTAGE # DEF SDVC #"SD"#; # STANDARD DEVIATION # DEF ZOPC #"Z"#; # *Z* OPTION # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM AV R; # AVERAGE VALUE # ITEM BCL I; # BEGIN COLUMN TO PRINT # ITEM I I; # FOR LOOP CONTROL # ITEM NIP R; # NUMBER OF COLUMNS PER PAGE # ITEM NSR R; # NUMBER OF BLOCKS PER COLUMN # ITEM PRFLG B; # PROCESS FLAG # ITEM SM R; # INTERVAL SUM # ITEM SQ R; # INTERVAL SUM SQUARED # ITEM SSM R; # SUM OF SUBTOTAL # ITEM SSQ R; # SQUARED SUM OF SUBTOTAL # ITEM SWF R; # SUM OF WEIGHT FACTOR # ITEM WFT R; # WEIGHT FACTOR # ARRAY TEM [1:11] P(3); # COMPUTED STATISTIC VALUES # BEGIN ITEM TEM$AV R(00,00,60); # AVERAGE # ITEM TEM$SD R(01,00,60); # STANDARD DEVIATION # ITEM TEM$PC R(02,00,60); # PERCENTAGE # END # * BEGIN DATELM PROC. # COMPWF(WFA,WFP,POS,WFT,PRFLG); # COMPUTE WEIGHT FACTOR # IF (NOT PRFLG) # NOT TO PROCESS THIS ELEMENT # THEN BEGIN RETURN; END P=LOC(DBUF); P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); P=LOC(DDDT); # * CHECK IF ENTIRE LINE IS ZERO. IF SO, DO NOT PRINT THIS LINE. # SM=0; SLOWFOR I=1 STEP 1 UNTIL NIPP DO BEGIN SM=SM + DCDT$SM[(I-1)*DCDL + FWA]; END IF (SM EQ 0.0) AND (P$LO NQ ZOPC) AND (NIPP GR (DCDC-3)) THEN BEGIN RETURN; END IF (NIPP LQ (DCDC-3)) # PRINT TOTAL ON THIS PAGE # THEN # CHECK IF TOTAL IS 0 # BEGIN IF (DDSM$IM[FWA] EQ 0) AND (P$LO NQ ZOPC) THEN BEGIN RETURN; END END # * CHECK IF SUBTITLE HAS BEEN PRINTED. # IF (FLG) # SUBTITLE NOT PRINTED # THEN # PRINT SUBTITLE # BEGIN WRITEV(MS1,CHRC,1,22,LFDC); FLG=FALSE; # INDICATE SUBTITLE WAS PRINTED # END WRITEV(MS2,CHRC,1,22,NLFC); # WRITE DATA ELEMENT NAME # # * COMPUTE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE * FOR *NIPP* INTERVALS. THE COMPUTED VALUES ARE SAVED * IN ARRAY *TEM*. # BCL=BCLC; # BEGIN COLUMN TO PRINT # NSR=NSF; # CONVERT TO REAL # NIP=NIPP; # CONVERT TO REAL # SSM=0.0; SSQ=0.0; SWF=0.0; IF (NIPP GR 0) THEN BEGIN # COMPUTE INTERVAL STATISTICS # FASTFOR I=1 STEP 1 UNTIL NIPP DO BEGIN # COMPUTE *AV*, *SD*, *PC* # SM=DCDT$SM[(I-1)*DCDL + FWA]; SSM=SSM+SM; SQ=DCDT$SQ[(I-1)*DCDL+DCDC*DCDL+FWA]; SSQ=SSQ+SQ; AV=SM/NSR; # AVERAGE # TEM$AV[I]=AV; TEM$SD[I]=SQRT(SQ/NSR - AV*AV); # STANDARD DEVIATION # DCDT$SQ[(I-1)*DCDL+DCDC*DCDL+FWA]=TEM$SD[I]; # SAVE *SD* # DCDT$SM[(I-1)*DCDL+FWA]=TEM$AV[I]; # SAVE *AV* # IF (WFA EQ IWFC) # INDIRECT WEIGHT FACTOR # THEN # GET WEIGHT FACTOR # BEGIN WFT=DCDT$SM[(I-1)*DCDL + DDSC$FW[WFP]]/NSR; SWF=SWF+WFT; END IF (WFT LQ 0) THEN BEGIN TEM$PC[I]=0.0; END ELSE BEGIN TEM$PC[I]=(AV/WFT)*100.0; # PERCENTAGE # END END # COMPUTE *AV*, *SD*, *PC* # # * COMPUTE AVERAGE, STANDARD DEVIATION, AND PERCENTAGE * OF SUBTOTAL. THE PRECEDING INTERVALS ARE CONSIDERED * AS ONE INTERVAL. # IF (TCOL GR (DCDC-3)) # PRINT SUBTOTAL # THEN BEGIN # COMPUTE SUBTOTAL STATISTICS # I=NIPP+1; TEM$AV[I]=SSM/(NIP*NSR); # AVERAGE # TEM$SD[I]=SQRT(SSQ/(NIP*NSR)-(TEM$AV[I]*TEM$AV[I])); IF (WFA EQ IWFC) # INDIRECT WEIGHT FACTOR # THEN BEGIN WFT=SWF/NIP; # WEIGHT FACTOR # END IF (WFT LQ 0) THEN BEGIN TEM$PC[I]=0.0; END ELSE BEGIN TEM$PC[I]=(TEM$AV[I]/WFT)*100.0; END BCL=BCL + I*10; END # COMPUTE SUBTOTAL STATISTICS # ELSE # NO SUBTOTAL # BEGIN BCL=BCL + NIPP*10; END END # COMPUTE INTERVAL STATISTICS # # * PRINT VALUES SAVED IN ARRAY *TEM*. * AVERAGE VALUES ARE NOT PRINTED IF THE WEIGHT FACTOR * IS 1. * PERCENTAGE VALUES ARE NOT PRINTED IF *WFT* IS LESS THAN 0. * THE TOTAL STATISTIC VALUES ARE NOT PRINTED IF THERE ARE * MORE THAN 7 COLUMNS PRINTED ON A PAGE, I.E. IF THE NUMBER * OF INTERVALS PER PAGE *NIPP* IS GREATER THAN 7. # IF (WFA NQ CWFC) OR (WFP NQ 1) THEN BEGIN # PRINT *AV* # WRITEV(AVGC,CHRC,BCLC-2,2,NLFC); IF (NIPP GR 0) # MORE THAN 1 COLUMN # THEN BEGIN PRDTEL(LOC(TEM$AV[1]),DTY,LOC(DDSM$AX[FWA])); END IF (NIPP LQ (DCDC-3)) # PRINT TOTAL ON SAME PAGE # THEN BEGIN ACMSTA(STVAL"AVST",FWA,DTY,BCL,0); # TOTAL AVERAGE # END END # PRINT *AV* # WRITEV(SDVC,CHRC,BCLC-2,2,NLFC); IF (NIPP GR 0) # MORE THAN 1 COLUMN # THEN BEGIN # PRINT *SD* # PRDTEL(LOC(TEM$SD[1]),FLPC,LOC(DDSM$SX[FWA])); END # PRINT *SD* # IF (NIPP LQ (DCDC-3)) # PRINT TOTAL ON SAME PAGE # THEN BEGIN ACMSTA(STVAL"SDST",FWA,FLPC,BCL,0); # STANDARD DEVIATION # END IF (WFT GQ 0.0) # PERCENTAGE TO BE PRINTED # THEN BEGIN # PRINT *PC* # WRITEV(PCTC,CHRC,BCLC-2,2,NLFC); IF (NIPP GR 0) # MORE THAN 1 COLUMN # THEN BEGIN PRDTEL(LOC(TEM$PC[1]),FLPC,LOC(DDSM$PX[FWA])); END IF (WFA EQ IWFC) # INDIRECT WEIGHT FACTOR # THEN BEGIN WFT=DDSM$SM[DDSC$FW[WFP]]/ACNS; # TOTAL WEIGHT FACTOR # END IF (NIPP LQ (DCDC-3)) # TOTAL IS PRINTED ON SAME PAGE # THEN BEGIN ACMSTA(STVAL"PCST",FWA,FLPC,BCL,WFT); # TOTAL PERCENTAGE # END END # PRINT *PC* # RETURN; END # DATELM # TERM PROC DECODE((DTA),(BFA)); # TITLE DECODE - DECODE DATA. # BEGIN # DECODE # # ** DECODE - DECODE DATA. * * DECODE DATA IN *CIO* INPUT BUFFER, AND PUT THEM * IN CORRESPONDING DECODED BUFFER. * * PROC DECODE((DTA),(BFA)) * * ENTRY DTA = ADDRESS OF DATA DESCRIPTION TABLE * (*DDHD* OR *DDDT*). * BFA = ADDRESS OF THE BUFFER WHERE THE DECODED DATA * ARE TO BE SAVED (*DCHD* OR *DCDT*). * IBWA = CURRENT *CIO* INPUT BUFFER ADDRESS. * * EXIT IBWA = ADDRESS OF NEXT *CIO* INPUT BUFFER WORD. * DECODED DATA ARE ACCUMULATED IN THE APPROPRIATE * BUFFER. # # * PARAMETER LIST. # ITEM BFA I; # BUFFER ADDRESS # ITEM DTA I; # DATA DESCRIPTOR TABLE ADDRESS # # **** PROC DECODE - XREF LIST BEGIN. # XREF BEGIN FUNC GETVAL I; # GET VALUE FROM *CIO* BUFFER # PROC PERROR; # PROCESS ERROR # END # **** PROC DECODE - XREF LIST END. # DEF CNIC #"CNIL"#; # FAST LOOP SAMPLE # DEF CPWC #5#; # NUMBER OF BYTES # DEF CTMC #"CTML"#; # MEDIUM LOOP SAMPLE # DEF CTOC #"CTOL"#; # SLOW LOOP SAMPLE # DEF HDLC #0#; # HEADER LOOP FLAG # DEF PDTC #"PDTM"#; # PACKED DATE AND TIME # DEF SNLC #4#; # SNAP SHOT LOOP FLAG # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM AV R; # AVERAGE VALUE # ITEM BA I; # BYTE ADDRESS OF *CIO* BUFFER # ITEM BASE I; # BEGIN ADDRESS OF REPEAT GROUP # ITEM C I; # DECODED DATA BUFFER ADDRESS # ITEM CQ I; # DECODED DATA BUFFER ADDRESS # ITEM I I; # FOR LOOP CONTROL # ITEM IC I; # INCREMENTOR # ITEM J I; # FOR LOOP CONTROL # ITEM K I; # FOR LOOP CONTROL # ITEM L I; # FOR LOOP CONTROL # ITEM LMP I; # LENGTH MULTIPLIER # ITEM LN I; # LENGTH OF ENTRY # ITEM M I; # FOR LOOP CONTROL # ITEM NM C(4); # DATA ELEMENT NAME # ITEM OF I; # OFFSET # ITEM PR I; # NUMBER OF PP WORDS OCCUPIED # ITEM TP U; # DATA TYPE OF ELEMENT # ITEM VL I; # DECODED VALUE # ITEM VLR R; # DECODED VALUE # BASED ARRAY BUF [0:0] P(1); # DECODED BUFFER # BEGIN # ARRAY BUF # ITEM BUF$WD U(00,00,60); # DECODED DATA # ITEM BUF$SQ R(00,00,60); # SUM SQUARE # ITEM BUF$SM R(00,00,60); # SUM # ITEM BUF$ET U(00,00,30); # INTERVAL START TIME # ITEM BUF$BT U(00,30,30); # INTERVAL END TIME # END # ARRAY BUF # ARRAY SPT [1:3] P(1); # LOOP SAMPLE TIMES # BEGIN # ARRAY SPT # ITEM SPT$WD I(00,00,60); # SAMPLE TIME # END # ARRAY SPT # # * BEGIN DECODE PROC. # P=LOC(DBUF); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); P=DTA; P=LOC(DDHD); P=BFA; BA=IBWA*CPWC; IF (MPAR$TP[0] NQ HDLC) # NOT HEADER BLOCK # THEN BEGIN # GET LOOP SAMPLE TIMES # FASTFOR I=1 STEP 1 UNTIL 3 DO BEGIN SPT$WD[I]=GETVAL(BA+SPLA$WD[I],2); END END # GET LOOP SAMPLE TIMES # # * FOLLOW TABLE *MPAR* TO EXTRACT DATA FROM *CIO* BUFFER AND PUT * THEM IN THE DECODED DATA BUFFER. * THE VALUES STORED IN THE DECODED DATA BUFFER FOR THE DATA * BLOCK ELEMENTS ARE THE CUMULATIVE AVERAGES. THE AVERAGE OF * EACH DATA BLOCK ELEMENT IS COMPUTED BY TAKING THE EXTRACTED * VALUE AND DIVIDING IT BY THE RESPECTIVE LOOP-S SAMPLE TIME * (*SPT* ARRAY). THE SQUARED AVERAGES ARE ALSO COMPUTED FOR * THE DATA BLOCK ELEMENTS. # C=0; # BEGIN ADDRESS TO STORE AVERAGE # OF=DCDL*DCDC; # OFFSET # J=0; SLOWFOR M=0 WHILE (MPAR$WD[J] NQ 0) DO BEGIN # FOLLOW TABLE *MPAR* # BASE=J; LMP=1; IF (MPAR$LMP[J] NQ NULL) THEN BEGIN LMP=DCHD$WD[DDSC$FW[MPAR$LMP[J]]]; # REPEAT GROUP LENGTH # END # * *LMP* IS GREATER THAN 1 IF THE REPEAT GROUP HAS * MULTIPLE ENTRIES. # FASTFOR K=1 STEP 1 UNTIL LMP DO BEGIN # COLLECT REPEAT GROUP VALUES # J=BASE; IC=MPAR$IC[J]; # * *IC* IS THE SIZE OF THE REPEAT GROUP. * SINGLE ELEMENTS HAVE *IC* EQUAL TO 1. # FASTFOR L=1 STEP 1 UNTIL IC DO BEGIN # COLLECT ONE ENTRY OF REPEAT GROUP # NM=MPAR$NM[J]; # NAME # TP=MPAR$TP[J]; # TYPE # LN=MPAR$LN[J]; # LENGTH # PR=MPAR$PR[J]; # PRECISION # IF (PR GR CPWC) THEN BEGIN LN=(PR/CPWC)*LN; PR=CPWC; END # * *LN* IS GREATER THAN 1 IF THE ELEMENT HAS MULTIPLE * ENTRIES. # FASTFOR I=1 STEP 1 UNTIL LN DO BEGIN # COLLECT VALUE OF ONE ENTRY # CQ=C + OF; # ADDRESS OF SQUARED AVERAGE # VL=GETVAL(BA,PR); # GET VALUE FROM *CIO* BUFFER # IF (TP EQ HDLC) # HEADER BLOCK # OR (TP EQ SNLC) # SNAPSHOT LOOP # THEN BEGIN # COLLECT VALUES # # * HEADER BLOCK AND SNAPSHOT LOOP DATA ELEMENTS ARE NOT CUMULATIVE * VALUES. # IF (NM EQ PDTC) # PACKED DATE AND TIME # THEN BEGIN # GET TIME # BUF$ET[CQ]=VL-(VL/SHFC)*SHFC; # INTERVAL END TIME # IF (DDSM$BT[C] EQ 0) # TOTAL *BT* NOT COLLECTED # THEN BEGIN DDSM$BT[C]=VL; # TOTAL BEGIN TIME # END IF (BUF$BT[CQ] EQ 0) # INTERVAL *BT* NOT COLLECTED # THEN BEGIN BUF$BT[CQ]=BUF$ET[CQ]; # INTERVAL BEGIN TIME # END END # GET TIME # BUF$WD[C]=VL; IF (TP EQ SNLC) # SNAPSHOT LOOP # THEN BEGIN DDSM$IM[C]=VL; END END # COLLECT VALUES # ELSE # FAST, MEDIUM, SLOW LOOP # BEGIN # DECODE DATA BLOCK VALUES # # * THE FAST, MEDIUM, AND SLOW LOOP DATA ELEMENTS ARE CUMULATIVE * VALUES. THE VALUES SAVED IN THE DECODED BUFFER ARE CUMULATIVE * AVERAGE VALUES. THE AVERAGE VALUE IS COMPUTED BY TAKING THE * VALUE DECODED FROM THE INPUT BUFFER (READ IN FROM THE DATA * FILE) AND DEVIDE IT BY THE RESPECTIVE LOOP SAMPLE TIME. * THE AVERAGE SQUARE IS ALSO COMPUTED AND SAVED IN THE DECODED * BUFFER FOR EACH DATA BLOCK ELEMENTS. # IF (NM EQ CNIC) OR (NM EQ CTMC) OR (NM EQ CTOC) # LOOP SAMPLE TIMES # THEN # ACCUMULATE SAMPLE TIMES # BEGIN BUF$WD[C]=BUF$WD[C] + VL; DDSM$IM[C]=DDSM$IM[C] + VL; END ELSE BEGIN # COMPUTE CUMULATIVE *AV* AND SQUARED *AV* # IF (SPT$WD[TP] NQ 0) # NUMBER OF SAMPLES .NE. 0 # THEN BEGIN VLR=VL; AV=VLR/SPT$WD[TP]; BUF$SM[C]=BUF$SM[C] + AV; BUF$SQ[CQ]=BUF$SQ[CQ] + AV*AV; DDSM$SM[C]=DDSM$SM[C] + AV; DDSM$SQ[C]=DDSM$SQ[C] + AV*AV; END END # COMPUTE CUMULATIVE *AV* AND SQUARED *AV* # END # DECODE DATA BLOCK VALUES # C=C+1; # NEXT DECODED BUFFER ADDRESS # BA=BA+PR; # NEXT *CIO* BUFFER BYTE ADDRESS # END # COLLECT VALUE OF ONE ENTRY # J=J+1; END # COLLECT ONE ENTRY OF REPEAT GROUP # END # COLLECT REPEAT GROUP VALUES # END # FOLLOW TABLE *MPAR* # # * CHECK IF THERE IS ANY MISSING ELEMENTS. THE VALUE OF * *IBWA* HAS TO BE A MULTIPLE OF *IBNW*, FOR THE *CIO* BUFFER * HAS TO CONTAIN A MULTIPLE NUMBER OF DATA BLOCKS OR * HEADER BLOCK. # C=BA/CPWC; IBWA=C+1; # NEXT *CIO* BUFFER ADDRESS # J=BA - (C*CPWC); IF (J NQ 0) THEN BEGIN C=C+1; END I=IBNW - (IBNW/C)*C; IF (I NQ 0) # NOT A MULTIPLE OF *IBNW* # THEN BEGIN PERROR(ERM6,FATAL,NULL); # DATA FILE CONTENT ERROR # END RETURN; END # DECODE # TERM PROC DETMXM(MXP,MNP,(MXI),(MNI),(DTY)); # TITLE DETMXM - DETERMINE MAXIMUM AND MINIMUM VALUES. # BEGIN # DETMXM # # ** DETMXM - DETERMINE MAXIMUM AND MINIMUM VALUES. * * DETERMINE THE MINIMUM AND MAXIMUM VALUES OF ONE * REPORT LINE. THE MAXIMUM VALUE IS INDICATED BY BRACKETS, * THE MINIMUM VALUE IS INDICATED BY PARENTHESES. * * PROC DETMXM(MXP,MNP,(MXI),(MNI),(DTY)) * * ENTRY MXP = MAXIMUM VALUE ADDRESS. * MNP = MINIMUM VALUE ADDRESS. * MXI = INTERVAL CONTAINING MAXIMUM VALUE. * MNI = INTERVAL CONTAINING MINIMUM VALUE. * DTY = DATA TYPE. * * EXIT MAXIMUM AND MINIMUM VALUES ARE INDICATED BY * BRACKETS AND PARENTHESES, RESPECTIVELY. # # * PARAMETER LIST. # ITEM MXP U; # ADDRESS OF MAXIMUM VALUE # ITEM MNP U; # ADDRESS OF MINIMUM VALUE # ITEM MXI I; # COLUMN OF MAXIMUM VALUE # ITEM MNI I; # COLUMN OF MINIMUM VALUE # ITEM DTY U; # DATA TYPE # # **** PROC DETMXM - XREF LIST BEGIN. # XREF BEGIN FUNC XCDD C(10); # BINARY TO DISPLAY DECIMAL # FUNC XCED C(10); # BINARY TO *E* FORMAT # FUNC XCOD C(10); # BINARY TO DISPLAY OCTAL # FUNC XCFD C(10); # BINARY TO DISPLAY REAL # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC DETMXM - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF LBKC #"["#; # LEFT BRACKET # DEF LPRC #"("#; # LEFT PARENTHESIS # DEF MAXF #1.0E4#; # MAXIMUM VALUE OF *F* FORMAT # DEF RBKC #"]"#; # RIGHT BRACKET # DEF RPRC #")"#; # RIGHT PARENTHESIS # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM I I; # FOR LOOP CONTROL # ITEM MN I; # TEMPORARY VALUE # ITEM MNF R; # TEMPORARY VALUE # ITEM MX I; # TEMPORARY VALUE # ITEM MXF R; # TEMPORARY VALUE # ARRAY OCV [0:0] P(1); # OCTAL VALUE # BEGIN # ARRAY OCV # ITEM OC$WD C(00,00,10); # VALUE # ITEM OC$NP C(00,06,09); # NO POSTFIX # END # ARRAY OCV # ARRAY TM [0:0] P(1); # TEMPORARY BUFFER # BEGIN # ARRAY TM # ITEM TM$WD C(00,00,10); # DISPLAY CODE MINIMUM VALUE # ITEM TM$W1 C(00,00,09); # VALUE WITH NO POSTFIX # END # ARRAY TM # ARRAY TX [0:0] P(1); # TEMPORARY BUFFER # BEGIN # ARRAY TX # ITEM TX$WD C(00,00,10); # DISPLAY CODE MAXIMUM VALUE # ITEM TX$W1 C(00,00,09); # VALUE WITH NO POSTFIX # END # ARRAY TX # BASED ARRAY VLMN [0:0] P(1); # MINIMUM VALUE # BEGIN # ARRAY VLMN # ITEM VLMN$F R(00,00,60); # REAL VALUE # ITEM VLMN$N I(00,00,60); # INTEGER VALUE # END # ARRAY VLMN # BASED ARRAY VLMX [0:0] P(1); # MAXIMUM VALUE # BEGIN # ARRAY VLMX # ITEM VLMX$F R(00,00,60); # REAL VALUE # ITEM VLMX$N I(00,00,60); # INTEGER VALUE # END # ARRAY VLMX # # * BEGIN DETMXM PROC. # IF (P$L EQ NULL) # NO REPORT FILE # THEN BEGIN RETURN; END # * CONVERT MAXIMUM AND MINIMUM VALUES TO DISPLAY CODE. # P=LOC(MXP); P=LOC(MNP); IF (DTY EQ FLPC) # REAL VALUE # THEN BEGIN IF (VLMX$F[0] GQ MAXF) THEN BEGIN # CONVERT TO *E* FORMAT # MXF=VLMX$F[0]; TX$WD[0]=XCED(MXF); END # CONVERT TO *E* FORMAT # ELSE BEGIN # CONVERT TO *F* FORMAT # MX=VLMX$F[0]*1000.0 + 0.5; TX$WD[0]=XCFD(MX); END # CONVERT TO *F* FORMAT # IF (VLMN$F[0] GQ MAXF) THEN BEGIN # CONVERT TO *E* FORMAT # MNF=VLMN$F[0]; TM$WD[0]=XCED(MNF); END # CONVERT TO *E* FORMAT # ELSE BEGIN # CONVERT TO *F* FORMAT # MN=VLMN$F[0]*1000.0 + 0.5; TM$WD[0]=XCFD(MN); END # CONVERT TO *F* FORMAT # END ELSE BEGIN IF (DTY EQ INTC) # INTEGER VALUE # THEN BEGIN TX$WD[0]=XCDD(VLMX$N[0]); TM$WD[0]=XCDD(VLMN$N[0]); END ELSE # OCTAL VALUE # BEGIN OC$WD[0]=XCOD(VLMX$N[0]); TX$W1[0]=OC$NP[0]; OC$WD[0]=XCOD(VLMN$N[0]); TM$W1[0]=OC$NP[0]; END END # * ENCLOSE THE MAXIMUM AND MINIMUM VALUES BY BRACKETS AND * PARENTHESES, RESPECTIVELY. # SLOWFOR I=0 STEP 1 WHILE (CTX$WD[0] EQ BLKC) DO; MX=MXI*10 + I + 14; WRITEV(LBKC,CHRC,MX,1,NLFC); MX=BCLC + MXI*10; WRITEV(RBKC,CHRC,MX,1,NLFC); SLOWFOR I=0 STEP 1 WHILE (CTM$WD[0] EQ BLKC) DO; MN=MNI*10 + I + 14; WRITEV(LPRC,CHRC,MN,1,NLFC); MN=BCLC + MNI*10; WRITEV(RPRC,CHRC,MN,1,NLFC); RETURN; END # DETMXM # TERM FUNC DTMNUM((VALUE),(FORM),(PDOS)) I; # TITLE DTMNUM - CONVERT DATE/TIME TO NUMBER. # BEGIN # DTMNUM # # ** DTMNUM - CONVERT DATE/TIME TO NUMBER. * * CONVERT DISPLAY DATE/TIME TO THE PACKED FORMAT. * * FUNC DTMNUM((VALUE),(FORM),(PDOS)) * * ENTRY VALUE = VALUE TO BE CONVERTED. * FORM = IF TRUE, THE VALUE IS IN FORMAT * XX.YY.ZZ. * IF FALSE, THE VALUE IS IN FORMAT * XXYYZZ. * PDOS = IF TRUE, THE PACKED DATE 1970 OFFSET APPLIES. * IF FALSE, NO OFFSET IS APPLIED. * * EXIT VALUE IS CONVERTED TO PACKED FORMAT, AS IN * THE PACKED DATE AND TIME FORMAT. # # * PARAMETER LIST. # ITEM VALUE C(10); # VALUE TO BE CONVERTED # ITEM FORM B; # FORMAT OF DATE OR TIME # ITEM PDOS B; # APPLY PACKED DATE OFFSET # # **** FUNC DTMNUM - XREF LIST BEGIN. # XREF BEGIN PROC PERROR; # PROCESS ERROR # END # **** FUNC DTMNUM - XREF LIST END. # DEF ZERC #"0"#; # CHARACTER 0 # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM E I; # EXPONENTIAL # ITEM I I; # FOR LOOP CONTROL # ITEM N I; # TEMPORARY VARIABLE # ITEM T U; # TIME # ARRAY TM [0:0] P(1); # VALUE TO BE CONVERTED # BEGIN # ARRAY TM # ITEM TM$WD C(00,00,10); # VALUE # ITEM TM$XX C(00,00,02); # XX OF XXYYZZ # ITEM TM$YY C(00,12,02); # YY OF XXYYZZ # ITEM TM$ZZ C(00,24,02); # ZZ OF XXYYZZ # ITEM TM$X1 C(00,06,02); # XX OF XX.YY.ZZ # ITEM TM$D1 C(00,18,01); # DELIMITER # ITEM TM$Y1 C(00,24,02); # YY OF XX.YY.ZZ # ITEM TM$D2 C(00,36,01); # DELIMITER # ITEM TM$Z1 C(00,42,02); # ZZ OF XX.YY.ZZ # END # ARRAY TM # # * BEGIN DTMNUM FUNC. # TM$WD[0]=VALUE; IF (FORM) # FORMAT XX.YY.ZZ # THEN # CONVERT TO FORMAT XXYYZZ # BEGIN TM$XX[0]=TM$X1[0]; TM$YY[0]=TM$Y1[0]; TM$ZZ[0]=TM$Z1[0]; END IF (TM$WD[0] EQ 0) THEN BEGIN DTMNUM=0; RETURN; END # * CONVERT TO THE PACKED FORMAT. # N=0; E=1; FASTFOR I=0 STEP 2 UNTIL 5 DO BEGIN T=C<5-I,1>TM$WD[0] - ZERC; T=(C<4-I>TM$WD[0] - ZERC)*10 + T; N=N+T*E; E=E*64; END IF (PDOS) # CONVERTING DATE # THEN # CHECK DATE RANGE # BEGIN IF (N LS Y70C) # DATE IN 21ST CENTURY # THEN BEGIN N=N+Y30C; # BIAS 21ST CENTURY DATES # END ELSE # DATE IN 20TH CENTURY # BEGIN N=N-Y70C; # BIAS 20TH CENTURY DATES # END END DTMNUM=N; RETURN; END # DTMNUM # TERM PROC GETMSG((ENT),MSG); # TITLE GETMSG - GET REPORT MESSAGE. # BEGIN # GETMSG # # ** GETMSG - GET REPORT MESSAGE. * * GET MESSAGES FROM COMMON BLOCK *DSPTTXT*. * * PROC GETMSG((ENT),MSG) * * ENTRY ENT = INDEX OF TABLE *DSPT* ENTRY. * * EXIT MSG = MESSAGE EXTRACTED FROM COMMON BLOCK *DSPTTXT*. # # * PARAMETER LIST. # ITEM ENT I; # INDEX OF TABLE *DSPT* # ITEM MSG C(50); # REPORT TITLES # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM BA I; # BYTE ADDRESS # ITEM BC I; # BEGINNING CHARACTER POSITION # ITEM LN I; # MESSAGE LENGTH IN CHARACTER # BASED ARRAY TXT [0:0] P(1); # MESSAGE BUFFER # BEGIN # ARRAY TXT # ITEM TXT$MS C(00,00,60); # MESSAGE # END # ARRAY TXT # # * BEGIN GETMSG PROC. # LN=DSPT$LN[ENT]; # NUMBER OF CHARACTERS # BC=DSPT$BC[ENT]; # BEGINNING CHARACTER POSITION # BA=BC - (BC/10)*10; P=LOC(DSTX$TX[BC/10]); MSG=CTXT$MS[0]; RETURN; END # GETMSG # TERM FUNC GETVAL((BA),(PR)) I; # TITLE GETVAL - GET VALUE FROM *CIO* BUFFER. # BEGIN # GETVAL # # ** GETVAL - GET VALUE FROM *CIO* BUFFER. * * EXTRACT VALUES FROM THE *CIO* BUFFER OF THE DATA FILE. * * FUNC GETVAL((BA),(PR)) I * * ENTRY BA = BYTE ADDRESS OF THE VALUE TO BE EXTRACTED. * PR = NUMBER OF BYTES TO BE EXTRACTED. * * EXIT THE VALUE IS EXTRACTED FROM BUFFER *WSAI*. # # * PARAMETER LIST. # ITEM BA I; # BYTE ADDRESS # ITEM PR I; # PRECISION # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM BC I; # BYTE ADDRESS # ITEM T I; # TEMPORARY VALUE # ITEM WA I; # *CIO* BUFFER WORD ADDRESS # BASED ARRAY WSA [0:0] P(1); # WORKING BUFFER # BEGIN # ARRAY WSA # ITEM WSA$C C(00,00,20); # BUFFER ENTRY # END # ARRAY WSA # # * BEGIN GETVAL FUNC. # WA=BA/5; # ADDRESS TO EXTRACT THE VALUE # P=LOC(WSAI$WD[WA]); T=BA*2; # NUMBER OF CHARACTERS # BC=T - (T/10)*10; # BEGIN CHARACTER POSITION # GETVAL=CWSA$C[0]; RETURN; END # GETVAL # TERM PROC HDRELM((ENP),(FCL),(LCL)); # TITLE HDRELM - PRINT HEADER BLOCK ELEMENT. # BEGIN # HDRELM # # ** HDRELM - PRINT HEADER BLOCK ELEMENT. * * PRINT ONE ELEMENT OF HEADER BLOCK. * * PROC HDRELM((ENP),(FCL),(LCL)) * * ENTRY ENP = INDEX OF THE *DSPT* ENTRY POINTING TO * THE HEADER BLOCK ELEMENT BEING PROCESSED. * FCL = BEGINNING COLUMN TO PRINT THE HEADER BLOCK * ELEMENT NAME. * LCL = BEGINNING COLUMN TO PRINT THE HEADER BLOCK * ELEMENT VALUE. * * EXIT THE HEADER BLOCK ELEMENT IS PRINTED TO THE REPORT * FILE. # # * PARAMETER LIST. # ITEM ENP I; # INDEX OF DSPT ENTRY # ITEM FCL I; # BEGIN COLUMN TO PRINT NAME # ITEM LCL I; # BEGIN COLUMN TO PRINT VALUE # # **** PROC HDRELM - XREF LIST BEGIN. # XREF BEGIN PROC GETMSG; # GET TITLE FROM TABLE *DSPTTXT* # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC HDRELM - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM BL I; # BIT LENGTH # ITEM BT I; # BIT POSITION # ITEM D I; # DATA TYPE # ITEM J I; # POINTER TO *DDHD* TABLE # ITEM L I; # TITLE LENGTH IN CHARACTERS # ITEM MSG C(50); # TEMPORARY BUFFER # ITEM T I; # POINTER TO *DCHD* TABLE # ITEM VALUE I; # TEMPORARY VALUE # ITEM WC I; # WORD COUNT # # * BEGIN HDRELM PROC. # P=LOC(DBUF); P=LOC(DDHD); J=DSPT$PT[ENP]; # INDEX OF TABLE *DDSC* # L=DSPT$LN[ENP]; T=DDSC$FW[J]; # INDEX OF TABLE *DCHD* # D=DDSC$TY[J]; # DATA TYPE # GETMSG(ENP,MSG); WRITEV(MSG,CHRC,FCL,L,NLFC); BL=DSPT$BL[ENP]; # GET BIT LENGTH # WC=DSPT$WC[ENP]; # WORD COUNT # IF (BL EQ 0) # ACCESS FULL WORD # THEN BEGIN VALUE=DCHD$WD[T+WC]; END ELSE # ACCESS PARTIAL WORD # BEGIN BT=DSPT$BT[ENP]; VALUE=BDCHD$WD[T+WC]; END WRITEV(VALUE,D,LCL,10,LFDC); RETURN; END # HDRELM # TERM PROC HEADER(TMED,HDDC,(LSTM)); # TITLE HEADER - PROCESS HEADER BLOCK. # BEGIN # HEADER # # ** HEADER - PROCESS HEADER BLOCK. * * *HEADER* BUILDS THE REPORT TITLE AND PROCESSES THE HEADER BLOCK * OF EACH FILE IN THE DATA FILE. * * PROC HEADER(TMED,HDDC,(LSTM)) * * ENTRY HDDC = TRUE IF HEADER BLOCK HAS BEEN DECODED. * LSTM = TIME OF LAST RECORD. * * EXIT TMED = TRUE IF *N* PARAMETER EXCEEDS NUMBER OF FILES. * HDDC = FALSE * ELEMENTS IN HEADER BLOCK ARE PRINTED TO THE * REPORT FILE. # # * PARAMETER LIST. # ITEM TMED B; # EOI FLAG # ITEM HDDC B; # DECODE HEADER BLOCK FLAG # ITEM LSTM U; # ENDING TIME OF PREVIOUS FILE # # **** PROC HEADER - XREF LIST BEGIN. # XREF BEGIN PROC ADJUST; # ADJUST TABLES AND FIELD LENGTH # PROC BZFILL; # BLANK/ZERO FILL ITEM # PROC DECODE; # DECODE *CIO* INPUT BUFFER DATA # FUNC DTMNUM U; # CONVERT DATE/TIME TO BINARY # PROC PERROR; # PROCESS ERROR # PROC PUTEST; # PRINT EST # PROC PUTHDR; # PRINT HEADER ELEMENTS # PROC PUTSCI; # PRINT JOB CONTROL BLOCK # PROC READRC; # READ AND SKIP # PROC RPHEAD; # PRINT *ACPD* TITLE # PROC WRITER; # *CIO* WRITER # PROC WRITEW; # *CIO* WRITEW # END # **** PROC HEADER - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD *CALL COMABZF # * LOCAL VARIABLES. # ITEM D I; # TEMPORARY VARIABLE # ITEM L I; # TEMPORARY VARIABLE # ITEM STAT I; # I/O STATUS # ITEM T I; # TEMPORARY VARIABLE # BASED ARRAY HEAD [0:0] P(1); # HEADER SYSTEM DESIGNATOR # BEGIN # ARRAY HEAD # ITEM HEAD$SD C(00,00,70); # SYSTEM DESIGNATOR # END # ARRAY HEAD # ARRAY TEXT [0:0] S(10); # HEADER TEXT # BEGIN # ARRAY TEXT # ITEM TXT$H1 C(00,00,16); # *ACPD* VERSION # ITEM TXT$VR C(01,00,10); # VERSION NUMBER # ITEM TXT$H2 C(02,00,10)=[" "]; # BLANK FILL # ITEM TXT$SD C(03,00,70); # SYSTEM DESIGNATOR # END # ARRAY TEXT # # * BEGIN HEADER PROC. # P=LOC(HDTR); P=LOC(DDHD); P=LOC(DBUF); # * *HDDC* IS NOT TRUE IF *HEADER* IS CALLED TO PROCESS THE NEXT * DATA FILE. *HDDC* IS TRUE IF THE FIRST FILE IS BEING PROCESSED. * IF THE LATER IS TRUE, ALL THE ERROR CHECKING HAS BEEN DONE BY * *INITLZ*. # IF (NOT HDDC) # HEADER BLOCK NOT DECODED # THEN BEGIN # READ HEADER BLOCK OF NEXT FILE # READRC(STAT); # READ HEADER BLOCK # IF (STAT NQ EORC) # EOF OR EOI ENCOUNTERED # THEN BEGIN IF (IBNW GR 0) # INPUT BUFFER NOT EMPTY # THEN BEGIN PERROR(ERM4,FATAL,NULL); # DATA BLOCKS MISSING # END IF (P$N LS 9999999) # EQUIVALENCED *N* PARAMETER # THEN BEGIN PERROR(ERM9,INFOM,NULL); # *N* EXCEEDS NUMBER OF FILES # END TMED=TRUE; RETURN; END IF (P$VERS NQ WSAI$VS[0]) # *CPD* AND *ACPD* INCOMPATBLE # THEN BEGIN PERROR(ERM13,FATAL,NULL); # CPD/ACPD VERSIONS MISMATCH # END IBWA=0; DECODE(LOC(HDTR),LOC(DCHD)); # DECODE HEADER BLOCK # ADJUST; # ADJUST TABLES AND FIELD LENGTH # # * CHECK IF FILES IN CHRONOLOGICAL ORDER. # T=DTMNUM(DCHD$WD[DDSC$FW[TIME]],TRUE,FALSE); D=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC; IF (LSTM GR (D+T)) # DATA FILE NOT IN ORDER # THEN BEGIN PERROR(ERM8,FATAL,NULL); END END # READ HEADER BLOCK OF NEXT FILE # ELSE # HEADER BLOCK HAS BEEN DECODED # BEGIN HDDC=FALSE; END # * BUILD THE REPORT TITLE. # T=DDSC$FW[CPDV]; # *ACPD* VERSION POINTER # TXT$VR[0]=DCHD$CW[T]; TXT$H1[0]=" A C P D - VER "; T=DDSC$FW[SYSV]; # SYSTEM DESIGNATOR POINTER # P=LOC(DCHD$CW[T]); T=MPAR$PR[SYSV]*2; BZFILL(HEAD,TYPFILL"BFILL",T); TXT$SD[0]=HEAD$SD[0]; IF (P$L NQ NULL) # REPORT FILE SPECIFIED # THEN BEGIN L=30 + T; # LENGTH OF HEADER TEXT # RPHEAD(OFFA,TEXT,2,L); # SET UP *ACPD* TITLE # PUTHDR; # PRINT HEADER BLOCK ELEMENTS # PUTEST; # PRINT EST # PUTSCI; # PRINT JOB CONTROL BLOCK # END IF (P$S NQ NULL) # SUMMARY FILE SPECIFIED # THEN # WRITE SUMMARY FILE # BEGIN WRITEW(FETS,DCHD,DCHL,0); WRITER(FETS,1); END RETURN; END # HEADER # TERM PROC INITLZ(HDDC,DTDC,EDTM); # TITLE INITLZ - INITIALIZE PARAMETERS AND OPEN FILES. # BEGIN # INITLZ # # ** INITLZ - INITIALIZE PARAMETERS AND OPEN FILES. * * PROCESS *ACPD* COMMAND PARAMETERS, INITIALIZE *ACPD*, * AND OPEN FILES. * * PROC INITLZ(HDDC,DTDC,EDTM) * * ENTRY NONE. * * EXIT HDDC = INDICATE IF HEADER BLOCK HAS BEEN DECODED. * DTDC = INDICATE IF DATA BLOCK HAS BEEN DECODED. * TIME = TRUE IF BEGINNING TIME GREATER THAN * ENDING TIME. # # * PARAMETER LIST. # ITEM HDDC B; # DECODED HEADER BLOCK FLAG # ITEM DTDC B; # DECODED DATA BLOCK FLAG # ITEM EDTM B; # ENDING TIME FLAG # # **** PROC INITLZ - XREF LIST BEGIN. # XREF BEGIN PROC ADJUST; # ADJUST TABLES AND FIELD LENGTH # PROC DECODE; # DECODE *CIO* INPUT BUFFER DATA # FUNC DTMNUM I; # CONVERT TIME/DATE TO BINARY # PROC FILINFO; # GET FILE INFORMATION # PROC MEMORY; # REQUEST MEMORY # PROC PAP; # PROCESS *ACPD* PARAMETER # PROC PERROR; # PROCESS ERROR # PROC READRC; # READ ONE RECORD FROM DATA FILE # PROC REPTLE; # PRINT REPORT SUBTITLE # PROC RPOPEN; # OPEN FILES # PROC ZSETFET; # INITIALIZE *CIO* FET # END # **** PROC INITLZ - XREF LIST END. # DEF CNIC #"CNIL"#; # FAST LOOP SAMPLE # DEF CTMC #"CTML"#; # MEDIUM LOOP SAMPLE # DEF CTOC #"CTOL"#; # SLOW LOOP SAMPLE # DEF MXVC #1.0E20#; # MAXIMUM VALUE # DEF NA #"NA"#; # NO ABORT FLAG # DEF RECALL #1#; # RECALL FLAG # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM BA I; # BYTE ADDRESS # ITEM CM C(10)="CM"; # REQUEST CM FLAG # ITEM D I; # TEMPORARY VARIABLE # ITEM DM I; # TEMPORARY VARIABLE # ITEM I I; # FOR LOOP CONTROL # ITEM J I; # FOR LOOP CONTROL # ITEM STAT I; # I/O STATUS # ITEM T I; # TEMPORARY VARIABLE # ITEM TM I; # TIME # ARRAY FINFO [0:0] P(5); # *FILINFO* PARAMETER BLOCK # BEGIN # ARRAY FINFO # ITEM FIN$FN C(00,00,07); # FILE NAME # ITEM FIN$LN U(00,42,06)=[5]; # PARAMETER BLOCK LENGTH # ITEM FIN$US U(00,48,12)=[1]; # COMPLETION STATUS # ITEM FIN$WD U(01,00,60); # PARAMETER BLOCK WORD # ITEM FIN$EI B(01,36,01); # EOI STATUS # ITEM FIN$EF B(01,37,01); # EOF STATUS # ITEM FIN$BI B(01,38,01); # BOI STATUS # END # ARRAY FINFO # ARRAY STT [0:0] P(1); # MEMORY ARGUMENT # BEGIN # ARRAY STT # ITEM STT$RFL U(00,00,30); # REQUEST FIELD LENGTH # END # ARRARY STT # # * BEGIN INITLZ PROC. # PAP; # PROCESS *ACPD* PARAMETERS # # * OPEN FILES. # ZSETFET(LOC(FETI),P$FN,LOC(WSAI),WSAL+1,FENL+1); FIN$FN[0]=P$FN; FILINFO(FINFO); # CHECK STATUS OF INPUT FILE # IF (FIN$WD[0] EQ NULL) # NO STATUS # THEN BEGIN PERROR(ERM11,FATAL,P$FN); # DATA FILE NOT FOUND # END IF (FIN$EI[0]) # EOI # THEN BEGIN PERROR(ERM12,FATAL,NULL); # DATA FILE POSITIONED AT EOI # END IF (NOT (FIN$EF[0] OR FIN$BI[0])) # NOT AT EOF NOR BOI # THEN BEGIN PERROR(ERM7,FATAL,NULL); END OFFA=LOC(FETO); IF (P$L NQ NULL) # REPORT FILE SPECIFIED # THEN # OPEN REPORT FILE # BEGIN RPOPEN(P$L,OFFA,REPTLE); END IF (P$S NQ NULL) # SUMMARY FILE SPECIFIED # THEN # OPEN SUMMARY FILE # BEGIN ZSETFET(LOC(FETS),P$S,LOC(WSAS),WSAL+1,FENL+1); END # * REQUEST CURRENT FIELD LENGTH. # MEMORY(CM,STT,RECALL,NA); CRFL=STT$RFL[0]; # CURRENT FIELD LENGTH # HGAD=CRFL; # HIGHEST ADDRESS # # * CHECK IF *CPD* AND *ACPD* VERSIONS ARE THE SAME. # READRC(STAT); # READ HEADER BLOCK # IF (STAT NQ EORC) # EOF OR EOI ENCOUNTERED # THEN BEGIN PERROR(ERM5,FATAL,NULL); # DATA FILE EMPTY # END IF (P$VERS NQ WSAI$VS[0]) # *CPD* AND *ACPD* INCOMPATBLE # THEN BEGIN PERROR(ERM13,FATAL,NULL); # CPD/ACPD VERSIONS MISMATCH # END # * VALIDATE BEGIN AND END TIMES. * IF NO *BD* SPECIFIED, BEGIN DATE IS THE DATE OF THE * HEADER RECORD OF THE CURRENT FILE. * IF NO *ED* SPECIFIED, END DATE IS THE SAME AS BEGIN DATE. * IF NO *ET*/*ED* SPECIFIED, END DATE IS SET TO MAXIMUM. # P=LOC(DBUF); P=LOC(DDHD); IBWA=0; DECODE(LOC(HDTR),LOC(DCHD)); # DECODE HEADER BLOCK # ADJUST; # ADJUST TABLES AND FIELD LENGTH # HDDC=TRUE; # HEADER BLOCK HAS BEEN DECODED # IF (P$BD EQ NULL) # NO BEGINNING DATE # THEN BEGIN DM=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC; END ELSE # *BD* SPECIFIED # BEGIN DM=DTMNUM(P$BD,FALSE,TRUE)*SHFC; END P$BT=DM + DTMNUM(P$BT,FALSE,FALSE); IF (P$ED NQ NULL) # END DATE SPECIFIED # THEN BEGIN P$ET=(DTMNUM(P$ED,FALSE,TRUE)*SHFC) + DTMNUM(P$ET,FALSE,FALSE); END ELSE # NO END DATE # BEGIN IF (P$ET NQ NULL) # END TIME SPECIFIED # THEN BEGIN P$ET=DM + DTMNUM(P$ET,FALSE,FALSE); END ELSE # *ET*/*ED* ARE NOT SPECIFIED # BEGIN P$ET=MXDC*SHFC + MXTC; # 33/12/31 23.59.59 # END END IF (P$BT GQ P$ET) # BEGIN TIME .GE. END TIME # THEN BEGIN EDTM=TRUE; # ENDING TIME REACHED # RETURN; END TM=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC; TM=TM + DTMNUM(DCHD$WD[DDSC$FW[TIME]],TRUE,FALSE); IF (P$BT GR TM) # *BT* .GT. TIME OF FIRST DATA RECORD # THEN BEGIN DTDC=TRUE; # DECODE DATA BLOCK # END ELSE BEGIN DTDC=FALSE; # NOT DECODE DATA BLOCK # END # * COMPUTE BYTE ADDRESSES OF SAMPLE TIMES IN * INPUT FILE-S WORKING STORAGE AREA. # BA=0; P=LOC(DATT); SLOWFOR I=0 STEP 1 WHILE (MPAR$NM[I] NQ CTOC) DO BEGIN # COMPUTE SAMPLE TIME BYTE ADDRESS # IF (MPAR$NM[I] EQ CNIC) # FAST LOOP SAMPLE # THEN BEGIN SPLA$WD[MPAR$TP[I]]=BA; END ELSE BEGIN IF (MPAR$NM[I] EQ CTMC) # MEDIUM LOOP SAMPLE # THEN BEGIN SPLA$WD[MPAR$TP[I]]=BA; END END BA=MPAR$LN[I]*MPAR$PR[I] + BA; END # COMPUTE SAMPLE TIME BYTE ADDRESS # SPLA$WD[MPAR$TP[I]]=BA; # SLOW LOOP SAMPLE # READRC(STAT); # READ FIRST DATA BLOCK # IF (STAT NQ EORC) # NO DATA BLOCKS # THEN BEGIN PERROR(ERM4,FATAL,NULL); # DATA BLOCKS MISSING # END P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); # * POSITION FILE AT CORRECT RECORD. # STAT=0; IBWA=0; SLOWFOR J=0 WHILE (P$BT GR TM) AND (STAT NQ EOIC) DO BEGIN # READ FILE # IF (IBWA GQ IBNW) # INPUT BUFFER EXHAUSTED # THEN BEGIN # GET NEXT BUFFER # READRC(STAT); # READ NEXT RECORD # IBWA=0; IF (STAT NQ EORC) # END OF CURRENT FILE # THEN BEGIN # CHECK IF EOF OR EOI # IF (STAT EQ EOFC) # PREVIOUS READ ENCOUNTERED EOF # THEN BEGIN # GET NEXT FILE # READRC(STAT); # READ HEADER BLOCK OF NEXT FILE # IF (STAT NQ EORC) # NO DATA BLOCKS FOLLOW # THEN BEGIN PERROR(ERM4,FATAL,NULL); # DATA BLOCKS MISSING # END DECODE(LOC(HDTR),LOC(DCHD)); # DECODE HEADER BLOCK # ADJUST; # ADJUST TABLES AND FIELD LENGTH # P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); P=LOC(DDHD); D=DTMNUM(DCHD$WD[DDSC$FW[DATE]],TRUE,TRUE)*SHFC; # GET DATE ON RECORD # T=DTMNUM(DCHD$WD[DDSC$FW[TIME]],TRUE,FALSE); # GET TIME ON RECORD # IF (TM GR (D+T)) # PREVIOUS TIME .GT. CURRENT TIME # THEN BEGIN PERROR(ERM8,FATAL,NULL); END TM=D + T; # SET TO CURRENT TIME # TEST J; # GO PROCESS DATA BLOCKS # END # GET NEXT FILE # ELSE # PREVIOUS READ ENCOUNTERD *EOI* # BEGIN PERROR(ERM3,FATAL,NULL); # BT/BD NOT FOUND # END END # CHECK IF EOF OR EOI # END # GET NEXT BUFFER # DECODE(LOC(DATT),LOC(DCDT)); P=LOC(DDDT); TM=DCDT$WD[DDSC$FW[PDTM]]; # GET TIME # # * REINITIALIZE BUFFER OF FIRST COLUMN. # FASTFOR I=0 STEP 1 UNTIL DCDL - 1 DO BEGIN DCDT$WD[I]=0; DCDT$WD[I + DCDL*DCDC]=0; DDSM$IM[I]=0; DDSM$IQ[I]=0; END END # READ FILE # IF (P$ET LQ TM) # READ PAST ENDING TIME # THEN BEGIN EDTM=TRUE; END RETURN; END # INITLZ # TERM PROC PERROR((ERCD),(EROR),(ERNM)); # TITLE PERROR - ISSUE ERROR MESSAGE. # BEGIN # PERROR # # ** PERROR - ISSUE ERROR MESSAGE. * * ISSUE ERROR MESSAGE TO THE USER DAYFILE AND ABORT * THE JOB IF THE ERROR IS FATAL. * * PROC PERROR(ERCD,EROR,ERNM) * * ENTRY ERCD = ERROR CODE. * EROR = ERROR LEVEL. * ERNM = ERROR NAME. * * EXIT JOB ABORTED IF *EROR*=FATAL. * OTHERWISE, RETURN TO CALLING PROGRAM. * * MESSAGES * * 1. ACPD ARGUMENT ERROR - XX. * 2. ACPD/CPD VERSIONS MISMATCH. * 3. BT/BD NOT FOUND. * 4. DATA BLOCKS MISSING. * 5. DATA ELEMENT NAME UNDEFINED - XXXX. * 6. DATA FILE CONTENT ERROR. * 7. DATA FILE EMPTY. * 8. DATA FILE NOT AT BEGINNING OF FILE. * 9. DATA FILE NOT FOUND - XXXXXXX. * 10. DATA FILE NOT IN CHRONOLOGICAL ORDER. * 11. DATA FILE POSITIONED AT EOI. * 12. IN AND IC PARAMETER CONFLICT. * 13. IN LESS THAN FILE WRITE TIME. * 14. N EXCEEDS NUMBER OF FILES. # # * PARAMETER LIST. # ITEM ERCD I; # ERROR CODE # ITEM EROR I; # ERROR LEVEL # ITEM ERNM C(10); # ERROR NAME # # **** PROC PERROR - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT JOB # PROC MESSAGE; # ISSUE DAYFILE MESSAGES # END # **** PROC PERROR - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF DOLC #"$"#; # DOLLAR SIGN # DEF PRDC #"."#; # PERIOD # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM J I; # FOR LOOP CONTROL # ITEM L I; # FOR LOOP CONTROL # ARRAY ERMS [1:ERMSC] S(4); # ERROR MESSSAGES # BEGIN # ARRAY ERMS # ITEM ER$MS C(00,00,38) = # ERROR MESSAGES # [" ACPD ARGUMENT ERROR - $.", " DATA ELEMENT NAME UNDEFINED - $.", " BT/BD NOT FOUND.", " DATA BLOCKS MISSING.", " DATA FILE EMPTY.", " DATA FILE CONTENT ERROR.", " DATA FILE NOT AT BEGINNING OF FILE.", " DATA FILE NOT IN CHRONOLOGICAL ORDER.", " N EXCEEDS NUMBER OF FILES.", " IN LESS THAN FILE WRITE TIME.", " DATA FILE NOT FOUND - $.", " DATA FILE POSITIONED AT EOI.", " ACPD/CPD VERSIONS MISMATCH.", " IN AND IC PARAMETER CONFLICT."]; ITEM ER$ZR C(03,48,02) = [0,0,0,0,0,0,0,0,0,0,0,0,0,0]; # ZERO FILLED LAST BYTE # END # ARRAY ERMS # # * BEGIN PERROR PROC. # IF (ERNM NQ 0) # NAME SPECIFIED # THEN BEGIN # FILL IN ERROR NAME # SLOWFOR J=2 STEP 1 WHILE (CER$MS[ERCD] NQ DOLC) DO; # LOOK FOR DOLLAR SIGN # SLOWFOR L=0 STEP 1 WHILE (CERNM NQ 0) AND (CERNM NQ BLKC) DO BEGIN CER$MS[ERCD]=CERNM; J=J+1; END CER$MS[ERCD]=PRDC; END # FILL IN ERROR NAME # MESSAGE(ER$MS[ERCD],3); # ISSUE ERROR MESSAGE # IF (EROR NQ FATAL) THEN BEGIN RETURN; # TO CALLING PROGRAM # END ABORT; END # PERROR # TERM PROC PRDTEL((PVL),(DTY),(TMX)); # TITLE PRDTEL - PRINT ONE LINE OF DATA ELEMENT. # BEGIN # PRDTEL # # ** PRDTEL - PRINT ONE LINE OF DATA ELEMENT. * * PRINT VALUES IN ONE LINE OF ONE DATA ELEMENT. * * PROC PRDTEL((PVL),(DTY),(TMX)) * * ENTRY PVL = POINTER TO VALUES. * DTY = DATA TYPE. * TMX = POINTER TO CURRENT TOTAL MAXIMUM AND * MINIMUM VALUES. * * EXIT ONE ROW OF THE DATA ELEMENT-S VALUES ARE PRINTED. * THE SUBTOTAL IS ALSO PRINTED, ALONG WITH THE * MAXIMUM AND MIN VALUES OF THAT ROW. # # * PARAMETER LIST. # ITEM PVL U; # POINTER TO VALUES # ITEM DTY I; # DATA TYPE # ITEM TMX U; # POINTER TO TOTAL MAXIMUM VALUE # # **** PROC PRDTEL - XREF LIST BEGIN. # XREF BEGIN PROC DETMXM; # DETERMINE MAXIMUM AND MINIMUM # PROC WRITEV; # WRITE VALUE # END # **** PROC PRDTEL - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM CL I; # COLUMN # ITEM CR I; # CARRIAGE CONTROL # ITEM I I; # FOR LOOP CONTROL # ITEM IC I; # INCREMENTOR # ITEM MN I; # MINIMUM INTERVAL # ITEM MX I; # MAXIMUM INTERVAL # ITEM X R; # TEMPORARY VARIABLE # BASED ARRAY MXN [0:0] S(2); # TOTAL MAXIMUM/MINIMUM VALUES # BEGIN # ARRAY MXN # ITEM MXN$MX R(00,00,60); # TOTAL MAXIMUM VALUE # ITEM MXN$MN R(01,00,60); # TOTAL MINIMUM VALUE # END # ARRAY MXN # BASED ARRAY VAL [1:11] P(1); # VALUES TO BE PRINTED # BEGIN # ARRAY VAL # ITEM VL$F R(00,00,60); # REAL VALUE # ITEM VL$N I(00,00,60); # INTEGER VALUE # END # ARRAY VAL # # * BEGIN PRDTEL PROC. # IF (NIPP LQ (DCDC-3)) # PRINT TOTAL ON SAME LINE # THEN # DO NOT LINE FEED # BEGIN CR=NLFC; END ELSE BEGIN CR=LFDC; # LINE FEED # END # * DETERMINE MINIMUM AND MAXIMUM INTERVALS. # P=PVL; P=TMX; MX=1; MN=1; FASTFOR I=1 STEP 1 UNTIL NIPP DO BEGIN # FIND MAXIMUM AND MINIMUM COLUMNS # IF (VL$F[I] GR VL$F[MX]) THEN BEGIN MX=I; # CURRENT MAXIMUM POSITION # END IF (VL$F[I] LS VL$F[MN]) THEN BEGIN MN=I; # CURRENT MINIMUM POSITION # END END # FIND MAXIMUM AND MINIMUM COLUMNS # # * UPDATE CURRENT VALUES OF TOTAL MAXIMUM AND MINIMUM. # IF (VL$F[MX] GR MXN$MX[0]) # INTERVAL MAXIMUM .GT. TOTAL MAXIMUM # THEN BEGIN MXN$MX[0]=VL$F[MX]; # UPDATE TOTAL MAXIMUM # END IF (VL$F[MN] LS MXN$MN[0]) # INTERVAL MINIMUM .LT. TOTAL MINIMUM # THEN BEGIN MXN$MN[0]=VL$F[MN]; # UPDATE TOTAL MINIMUM # END IF (DTY NQ FLPC) # NOT FLOATING POINT # THEN # CONVERT VALUES TO INTEGER # BEGIN FASTFOR I=1 STEP 1 UNTIL NIPP+1 DO BEGIN X=VL$F[I]; VL$N[I]=X; END END # * NOW PRINT THE VALUES IN ONE LINE STARTING FROM * COLUMN *BCLC*. # CL=BCLC; FASTFOR I=1 STEP 1 UNTIL NIPP DO BEGIN WRITEV(VL$F[I],DTY,CL,10,NLFC); CL=CL+10; END # * INDICATE MINIMUM AND MAXIMUM INTERVAL VALUES BY ENCLOSING * THEM IN PARENTHESES AND BRACKETS, RESPECTIVELY. # IF (MX NQ MN) THEN BEGIN DETMXM(VL$F[MX],VL$F[MN],MX,MN,DTY); END IF (TCOL GR (DCDC-3)) THEN BEGIN WRITEV(VL$F[NIPP+1],DTY,CL+1,9,CR); # WRITE SUBTOTAL # END RETURN; END # PRDTEL # TERM PROC PUTBLK((NSF),(FWA),(LWA)); # TITLE PUTBLK - PRINT ELEMENTS OF ONE LOOP OF DATA BLOCK. # BEGIN # PUTBLK # # ** PUTBLK - PRINT ELEMENTS OF ONE LOOP OF DATA BLOCK. * * PUTBLK IS THE DRIVER IN PRINTING THE DATA BLOCK ELMENTS * (FAST LOOP, MEDIUM LOOP, SLOW LOOP). * * PROC PUTBLK((NSF),(FWA),(LWA)) * * ENTRY NSF = NUMBER OF RECORDS PER INTERVAL. * FWA = FIRST WORD ADDRESS OF LOOP IN TABLE *DSPT*. * LWA = LAST WORD ADDRESS OF LOOP IN TABLE *DSPT*. * * EXIT DATA ELEMENTS OF ONE LOOP ARE PRINTED BY THE * ORDER SPECIFIED IN TABLE *DSPT*. # # * PARAMETER LIST. # ITEM NSF I; # NUMBER OF RECORDS PER INTERVAL # ITEM FWA I; # *FWA* OF BLOCK IN *DSPT* TABLE # ITEM LWA I; # *LWA* OF BLOCK IN *DSPT* TABLE # # **** PROC PUTBLK - XREF LIST BEGIN. # XREF BEGIN PROC DATELM; # PROCESS ONE DATA BLOCK ELEMENT # PROC GETMSG; # GET MESSAGE FROM *DSPTTXT* # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC PUTBLK - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF NSBC #O"777"#; # NO SUBBLOCK FLAG # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM CT I; # INDEX OF *DSPT* TABLE # ITEM FG B; # FLAG TO PRINT SUBBLOCK TITLE # ITEM FW I; # INDEX OF *DCDT* TABLE # ITEM I I; # FOR LOOP CONTROL # ITEM IC I; # INCREMENTOR # ITEM J I; # INDEX # ITEM LN I; # LENGTH OF DATA ITEM # ITEM MS1 C(50); # TEMPORARY BUFFER # ITEM POS I; # RELATIVE POSITION OF *WFP* # ITEM PT I; # INDEX OF *DDDT* TABLE # ITEM SM I; # SAMPLE TIMES # ITEM ST I; # POINTER TO SUBTABLE # ITEM SUM I; # SAMPLE TIMES SUBTOTAL # ITEM T I; # TEMPORARY STORAGE # ITEM TY I; # DATA TYPE # ITEM WA I; # WEIGHT FACTOR INFORMATION # ITEM WIC I; # INCREMENTOR OF WEIGHT FACTOR # ITEM WP I; # WEIGHT FACTOR # ARRAY MS2 [0:2] P(1); # SUBBLOCK MESSAGE BUFFER # BEGIN # ARRAY MS2 # ITEM MS2$MS C(00,00,10)=[" "," "," "]; # MESSAGE BUFFER # END # ARRAY MS2 # # * BEGIN PUTBLK PROC. # P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); PT=DSPT$PT[FWA]; # POINTER TO *DDDT* # GETMSG(FWA,MS1); WRITEV(MS1,CHRC,1,22,NLFC); # * PRINT SAMPLE TIMES. *NIPP* IS THE NUMBER OF COLUMNS PER PAGE. # J=BCLC; # STARTING POSITION TO PRINT # SUM=0; P=LOC(DDDT); SLOWFOR I=1 STEP 1 UNTIL NIPP DO BEGIN SM=DCDT$WD[(I-1)*DCDL + DDSC$FW[PT]]; WRITEV(SM,INTC,J,10,NLFC); SUM=SUM+SM; J=J+10; END IF (NIPP GR (DCDC-3)) # MORE THAN 7 COLUMNS # THEN # NO TOTAL ON THIS PAGE # BEGIN WRITEV(SUM,INTC,J,10,LFDC); # PRINT SUBTOTAL # END ELSE # PRINT TOTAL ON SAME PAGE # BEGIN IF (NIPP GR 0) # MORE THAN 1 COLUMN COLLECTED # AND (TCOL GR (DCDC-3)) THEN # PRINT SUBTOTAL # BEGIN WRITEV(SUM,INTC,J,10,NLFC); J=J+10; END SUM=DDSM$IM[DDSC$FW[PT]]; # TOTAL SAMPLES # WRITEV(SUM,INTC,J,10,LFDC); END # * COMPUTE AND PRINT LOOP ELEMENTS. * THE PROCESSING OF THE LOOP ELEMENTS WILL FOLLOW THE * INSTRUCTIONS CONTAINED IN THE *DSPT* TABLE FROM * *FWA* TO *LWA*. # CT=FWA+1; FASTFOR I=0 WHILE (CT LQ LWA) DO BEGIN # FOLLOW TABLE *DSPT* # PT=DSPT$PT[CT]; # POINTER TO *DDSC* TABLE # IF NOT (DDSC$SD[PT]) # ELEMENT IS NOT SELECTED # THEN BEGIN CT=CT+1; TEST I; # SKIP IT # END ST=DSPT$ST[CT]; # POINTER TO SUBTITLE TABLE # GETMSG(CT,MS1); WA=DDSC$WA[PT]; # WEIGHT FACTOR INFORMATION # WP=DDSC$WP[PT]; # WEIGHT FACTOR # IF (WA EQ WGFC) # WEIGHT FACTOR SPECIFIED # THEN BEGIN # CHECK IF MULTIPLE WEIGHT FACTORS # P=LOC(DDHD); IF (DDSC$LN[WP] GR 1) # MORE THAN 1 WEIGHT FACTOR # THEN BEGIN WIC=DDSC$IC[WP]; # WEIGHT FACTOR INCREMENTOR # END ELSE BEGIN WIC=0; END P=LOC(DDDT); END # CHECK IF MULTIPLE WEIGHT FACTORS # TY=DDSC$TY[PT]; # DATA TYPE # FW=DDSC$FW[PT]; # POINTER TO *DCDT* TABLE # LN=DDSC$LN[PT]; # NUMBER OF ENTRIES # IC=DDSC$IC[PT]; # INCREMENTOR # # * IF THE POINTER TO SUBBLOCK TITLE TABLE *ST* IS NIL (*NSBC*), * THE ELEMENT IS A SINGLE ENTRY ELEMENT OR HAS NO SUBTITLES. # IF (ST EQ NSBC) # SINGLE ENTRY OR NO SUBTITLE # THEN BEGIN # PROCESS SINGLE ENTRY OR NO SUBTITLE ELEMENT # FG=FALSE; # DO NOT PRINT SUBBLOCK TITLE # POS=0; # FIRST WEIGHT FACTOR POSITION # SLOWFOR J=1 STEP 1 WHILE (J LS LN) DO BEGIN DATELM(FG,BLKC,MS1,WA,WP,POS,TY,FW,NSF); CT=CT+1; GETMSG(CT,MS1); FW=FW+IC; POS=POS+WIC; END DATELM(FG,BLKC,MS1,WA,WP,POS,TY,FW,NSF); END # PROCESS SINGLE ENTRY OR NO SUBTITLE ELEMENT # # * THE ELEMENT HAS SUBTITLES TO BE PROCESS. EACH ENTRY OF THE * MULTIPLE-ENTRY ELEMENT HAS A SUBTITLE DEFINED IN TABLE *SMGT*. # ELSE BEGIN # MULTIPLE ENTRIES # T=ST; FG=TRUE; # PRINT SUBBLOCK # POS=0; FASTFOR J=1 STEP 1 UNTIL LN DO BEGIN # PROCESS ONE ENTRY OF MULTIPLE-ENTRY ELEMENT # MS2$MS[1]=SMGT$TX[T]; IF (MS2$MS[1] EQ BLKC) # END OF SUBBLOCK TABLE # THEN BEGIN T=ST; # RESET *SMGT* POINTER # CT=CT+1; # NEXT *DSPT* ELEMENT # GETMSG(CT,MS1); MS2$MS[1]=SMGT$TX[T]; FG=TRUE; # PRINT SUBBLOCK # END DATELM(FG,MS1,MS2,WA,WP,POS,TY,FW,NSF); T=T+1; FW=FW+IC; POS=POS+WIC; END # PROCESS ONE ENTRY OF MULTIPLE-ENTRY ELEMENT # END # MULTIPLE ENTRIES # CT=CT+1; END # FOLLOW TABLE *DSPT* # END # PUTBLK # TERM PROC PUTDAT((NSF),(NIN)); # TITLE PUTDAT - PRINT DATA BLOCK ELEMENTS. # BEGIN # PUTDAT # # ** PUTDAT - PRINT DATA BLOCK ELEMENTS. * * PRINT FAST, MEDIUM, SLOW, AND SNAPSHOT LOOPS. * * PROC PUTDAT((NSF),(NIN)) * * ENTRY NSF = NUMBER OF RECORDS PER INTERVAL. * NIN = NUMBER OF INTERVALS PER PAGE. * TABLE *DCDT* CONTAINS DATA BLOCK ELEMENT VALUES. * * EXIT DATA BLOCK ELEMENTS ARE PRINTED TO THE REPORT * FILE. # # * PARAMETER LIST. # ITEM NSF I; # NUMBER OF RECORDS PER INTERVAL # ITEM NIN I; # NUMBER OF INTERVALS PER PAGE # # **** PROC PUTDAT - XREF LIST BEGIN. # XREF BEGIN PROC PUTBLK; # PRINT ONE LOOP DATA ELEMENTS # PROC PUTSNS; # PRINT SNAPSHOT LOOP ELEMENTS # PROC RPEJECT; # PAGE EJECT # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC PUTDAT - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM FW I; # LOOP BEGINNING INDEX # ITEM LW I; # LOOP ENDING INDEX # ITEM MSG C(30)="**********************"; # LOOP REPORT SEPARATOR # # * BEGIN PUTDAT PROC. # NIPP=NIN; IF (P$L NQ NULL) # REPORT FILE SPECIFIED # THEN BEGIN RPEJECT(OFFA); # PAGE EJECT # END P=LOC(DBUF); P=LOC(DDHD); IF (DCHD$WD[DDSC$FW[DLIL]] NQ 0) # FAST LOOP WAS COLLECTED # THEN BEGIN FW=HDML; LW=FW+FSML-1; PUTBLK(NSF,FW,LW); # PROCESS FAST LOOP # WRITEV(MSG,CHRC,1,22,LFDC); END IF (DCHD$WD[DDSC$FW[DLML]] NQ 0) # MEDIUM LOOP WAS COLLECTED # THEN BEGIN FW=HDML+FSML; LW=FW+MDML-1; PUTBLK(NSF,FW,LW); # PROCESS MEDIUM LOOP # WRITEV(MSG,CHRC,1,22,LFDC); END IF (DCHD$WD[DDSC$FW[DLOL]] NQ 0) # SLOW LOOP WAS COLLECTED # THEN BEGIN FW=HDML+FSML+MDML; LW=FW+SLML-1; PUTBLK(NSF,FW,LW); # PROCESS SLOW LOOP # WRITEV(MSG,CHRC,1,22,LFDC); END IF (NIN GR 0) # NUMBER OF COLUMNS .GT. 0 # AND (DCHD$WD[DDSC$FW[DLFW]] NQ 0) # SNAPSHOT WAS COLLECTED # THEN BEGIN FW=HDML+FSML+MDML+SLML; LW=FW+SNML-1; TLFG=2; PUTSNS(FW,LW); # PROCESS SNAPSHOT LOOP ELEMENTS # TLFG=1; END RETURN; END # PUTDAT # TERM PROC PUTEST; # TITLE PUTEST - PRINT *EST*. # BEGIN # PUTEST # # ** PUTEST - PRINT *EST*. * * PRINT *EST* TABLE. * * PROC PUTEST * * ENTRY TABLE *DCHD* CONTAINS HEADER BLOCK ELEMENT VALUES. * * EXIT EST IS WRITTEN TO THE REPORT FILE. * * NOTE. * * THE SYMBOL *SROS* DEFINED IN THIS ROUTINE HAS TO HAVE * THE SAME VALUE AS THE SYMBOL *SROS* DEFINED IN COMMON * DECK *COMSCPS*. * THE ITEMS *FATT* AND *FATL* HAVE TO BE CHANGED ACCORDINGLY * IF CHANGE IS MADE TO THE FILE TYPES. # # **** PROC PUTEST - XREF LIST BEGIN. # XREF BEGIN PROC RPEJECT; # PAGE EJECT # PROC WRITEV; # WRITE DATA ELEMENT # FUNC XCOD C(10); # BINARY TO DISPLAY OCTAL # END # **** PROC PUTEST - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF CHSC #"S"#; # CHARACTER S # DEF CHXC #"X"#; # CHARACTER X # DEF MGMC #"MT"#; # *MT* TAPE # DEF MGNC #"NT"#; # *NT* TAPE # DEF MNSC #"-"#; # MINUS SIGN # DEF MXMSA #47#; # MAXIMUM MS ALLOCATABLE DEVICE # DEF SROS #8#; # SECONDARY ROLLOUT DEVICE # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD *CALL COMUEST # * LOCAL VARIABLES. # ITEM FATL C(12) = "TIORDPLBSRRN"; # FILES TYPE # ITEM FATT C(12); # TEMPORARY BUFFER # ITEM I I; # FOR LOOP CONTROL # ITEM J I; # FOR LOOP CONTROL # ITEM L I; # FOR LOOP CONTROL # ITEM M I; # TEMPORARY STORAGE # ITEM MSG C(50); # TEMPORARY BUFFER # ITEM MXRS I; # NUMBER OF *MSAL* CATEGORIES # ITEM MSI I; # MST ORDINAL # ITEM MSIC I; # MST INCREMENTOR # ITEM MUI I; # MST ORDINAL # ITEM MUIC I; # MST INCREMENTOR # ITEM N I; # TEMPORARY STORAGE # ARRAY CHNN [0:1] P(1); # CHANNELS # BEGIN # ARRAY CHNN # ITEM CH U(00,00,60); # CHANNEL WORD # ITEM CHAPFLAG B(00,48,01); # CHANNEL ACCESS PATH FLAG # ITEM CHSTATUS U(00,49,02); # CHANNEL STATUS # ITEM CHNUMBER U(00,55,05); # CHANNEL NUMBER # END # ARRAY CHNN # ARRAY TEM [0:0] P(1); # TEMPORARY BUFFER # BEGIN # ARRAY TEM # ITEM TEM$TYPE U(00,01,11); # EQUIPMENT TYPE # END # ARRAY TEM # # * BEGIN PUTEST PROC. # P=LOC(DBUF); P=LOC(DDHD); TLFG=3; # INDICATES PRINTING EST # RPEJECT(OFFA); # * PRINT EST ENTRY. # P=LOC(DCHD$WD[DDSC$FW[ESTB]]); MSI=0; MSIC=DDSC$IC[TRKC]; MUI=0; MUIC=DDSC$IC[MSUN]; SLOWFOR I=0 STEP 1 UNTIL DCHD$WD[DDSC$FW[ESTL]] - 1 DO BEGIN # PROCESS ONE EST ENTRY # IF (EST$EQDE[I] EQ NULL) # ENTRY NOT DEFINED # THEN BEGIN TEST I; END WRITEV(I,OC2C,4,3,NLFC); # EST ORDINAL # TEM$TYPE[0]=EST$TYPE[I]; WRITEV(TEM,CHRC,11,2,NLFC); # DEVICE TYPE # IF EST$STATUS[I] EQ 0 # ON DEVICE # THEN MSG="ON"; ELSE BEGIN IF EST$STATUS[I] EQ 1 # IDLE DEVICE # THEN MSG="IDLE"; ELSE BEGIN IF EST$STATUS[I] EQ 2 # OFF DEVICE # THEN MSG="OFF"; ELSE # DOWN DEVICE # MSG="DOWN"; END END WRITEV(MSG,CHRC,16,3,NLFC); # DEVICE STATUS # IF (NOT EST$MS[I]) # NOT MASS STORAGE DEVICE # THEN BEGIN N=EST$EQU[I]; WRITEV(N,OC2C,22,2,NLFC); # EQUIPMENT NUMBER # N=EST$UN[I]; WRITEV(N,OC2C,26,2,NLFC); # UNIT NUMBER # END ELSE # MASS STORAGE DEVICE # BEGIN IF (EST$RMVE[I]) # REMOVABLE MASS STORAGE DEVICE # THEN BEGIN N=DCHD$WD[DDSC$FW[MSUN]+MUI]; WRITEV(N,OC2C,26,2,NLFC); END MUI=MUI + MUIC; END # * PRINT CHANNELS. # CH[0]=EST$CHANA[I]; # CHANNEL A # CHAPFLAG[0]=EST$CHAAE[I]; # CHANNEL A ACCESS ENABLED FLAG # CHSTATUS[0]=EST$CHAST[I]; # CHANNEL A STATUS # CH[1]=EST$CHANB[I]; # CHANNEL B # CHAPFLAG[1]=EST$CHBAE[I]; # CHANNEL B ACCESS ENABLED FLAG # CHSTATUS[1]=EST$CHBST[I]; # CHANNEL B STATUS # FASTFOR L=0 STEP 1 UNTIL 1 DO BEGIN # PRINT CHANNEL NUMBER # IF (CHAPFLAG[L]) # CHANNEL ACCESS PATH ENABLED # THEN BEGIN IF (CHSTATUS[L] EQ 0) # CHANNEL IS UP # THEN BEGIN WRITEV(CHNUMBER[L],OC2C,30+3*L,2,NLFC); END ELSE BEGIN WRITEV("**",CHRC,30+3*L,2,NLFC); END END END # PRINT CHANNEL NUMBER # # * PRINT EST ENTRY IN FULL WORD, AND DEVICE TRACK CAPACITY. # N=EST$LHDE[I]; WRITEV(N,OC3C,42,10,NLFC); N=EST$RHDE[I]; WRITEV(N,OC3C,52,10,NLFC); N=EST$LHAE[I]; WRITEV(N,OC3C,63,10,NLFC); N=EST$RHAE[I]; IF (NOT EST$MS[I]) # NOT MASS STORAGE DEVICE # THEN BEGIN WRITEV(N,OC3C,73,10,LFDC); TEST I; END ELSE BEGIN # MASS STORAGE DEVICE # WRITEV(N,OC3C,73,10,NLFC); N=DCHD$WD[DDSC$FW[TRKC] + MSI]; WRITEV(N,OC2C,87,4,NLFC); # TRACK CAPACITY # MSI=MSI+MSIC; # * PRINT THE MASS STORAGE ALLOCATION TABLE. # IF (I GR MXMSA) # EST ORDINAL .GT. *MXMSA* # THEN BEGIN WRITEV(BLKC,CHRC,95,1,LFDC); # LINE FEED # END ELSE # EST ORDINAL .LE. *MXMSA* # BEGIN # CHECK FILE TYPE ON THE DEVICE # FATT="------------"; MXRS=DCHD$WD[DDSC$FW[CON8]]; SLOWFOR J=0 STEP 1 UNTIL MXRS-1 DO BEGIN L=DDSC$FW[MSAA] + J; IF (B<12+I,1>DCHD$WD[L] EQ 1) THEN BEGIN CFATT=CFATL; END END IF (EST$SYS[I]) # SYSTEM FILE ON DEVICE # THEN BEGIN MSG=CHXC; END ELSE BEGIN MSG=MNSC; END WRITEV(MSG,CHRC,94,1,NLFC); # * PRINT THE THRESHOLD OF THE NUMBER OF SECTORS ROLLED IF * THE DEVICE IS SECONDARY ROLLOUT. # IF (CFATT NQ CHSC) # NOT SECONDARY ROLLOUT # THEN BEGIN WRITEV(FATT,CHRC,95,MXRS,LFDC); END ELSE # SECONDARY ROLLOUT # BEGIN WRITEV(FATT,CHRC,95,MXRS,NLFC); WRITEV("THRESHOLD = ",CHRC,109,12,NLFC); WRITEV(DCHD$WD[DDSC$FW[SROT]],OC1C,121,5,NLFC); WRITEV("SECTORS",CHRC,127,7,LFDC); END END # CHECK FILE TYPE ON THE DEVICE # END # MASS STORAGE DEVICE # END # PROCESS ONE EST ENTRY # RETURN; END # PUTEST # TERM PROC PUTHDR; # TITLE PUTHDR - PROCESS HEADER BLOCK. # BEGIN # PUTHDR # # ** PUTHDR - PROCESS HEADER BLOCK. * * PRINT FIRST PAGE OF HEADER BLOCK ELEMENTS. * * PROC HEADER * * ENTRY TABLE *DCHD* CONTAINS HEADER BLOCK ELEMENT VALUES. * * EXIT HEADER BLOCK ELEMENTS ARE PRINTED TO THE REPORT * FILE. # # **** PROC PUTHDR - XREF LIST BEGIN. # XREF BEGIN PROC HDRELM; # PROCESS HEADER BLOCK ELEMENT # PROC RPEJECT; # PAGE EJECT # PROC RPSPACE; # LINE FEED # PROC WRITEV; # WRITE ONE ELEMENT # END # **** PROC PUTHDR - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM I I; # FOR LOOP CONTROL # ITEM MSG C(50); # TEMPORARY BUFFER # # * BEGIN PUTHDR PROC. # TLFG=0; # INDICATES NO SUBTITLE # RPEJECT(OFFA); RPSPACE(OFFA,2,1); # * PRINT START DATE AND START TIME OF THE DATA FILE. # HDRELM(0,11,34); # START DATE # HDRELM(1,11,34); # START TIME # # * PRINT *ACPD* PARAMETERS. # RPSPACE(OFFA,2,1); WRITEV("DATA FILE NAME",CHRC,11,14,NLFC); WRITEV(P$FN,CHRC,40,7,LFDC); IF (P$IN NQ 0) THEN BEGIN WRITEV("REPORT INTERVAL (MINUTES)",CHRC,11,25,NLFC); WRITEV(P$IN,INTC,37,10,LFDC); END ELSE BEGIN WRITEV("REPORT INTERVAL (RECORDS)",CHRC,11,25,NLFC); WRITEV(P$IC,INTC,37,10,LFDC); END RPSPACE(OFFA,2,1); FASTFOR I=APPM STEP 1 UNTIL HWCF-1 DO BEGIN HDRELM(I,11,40); END # * PRINT THE HARDWARE CONFIGURATION. # RPSPACE(OFFA,2,1); FASTFOR I=HWCF STEP 1 UNTIL CMCF-1 DO BEGIN HDRELM(I,11,40); END # * PRINT THE CMR CONFIGURATION. # RPSPACE(OFFA,2,1); FASTFOR I=CMCF STEP 1 UNTIL SASC-1 DO BEGIN HDRELM(I,11,40); END # * PRINT THE SYSTEM ASSEMBLY CONSTANTS. # RPSPACE(OFFA,2,1); FASTFOR I=SASC STEP 1 UNTIL SDLP-1 DO BEGIN HDRELM(I,11,47); END # * PRINT THE SYSTEM DELAY PARAMETERS. # RPSPACE(OFFA,2,1); FASTFOR I=SDLP STEP 1 UNTIL BFIO-1 DO BEGIN HDRELM(I,11,47); END # * PRINT THE TOTAL NUMBER OF HIGH SPEED DISK BUFFERS * AND EXTENDED MEMORY/PP BUFFERS. # RPSPACE(OFFA,2,1); FASTFOR I=BFIO STEP 1 UNTIL HDML-1 DO BEGIN HDRELM(I,11,47); END RETURN; END # PUTHDR # TERM PROC PUTSCI; # TITLE PUTSCI - PRINT SYSTEM CONTROL INFORMATION. # BEGIN # PUTSCI # # ** PUTSCI - PRINT SYSTEM CONTROL INFORMATION. * * PRINT SYSTEM CONTROL INFORMATION. * * PROC PUTSCI * * ENTRY TABLE *DCHD* CONTAINS HEADER BLOCK ELEMENT VALUES. * * EXIT SYSTEM CONTROL INFORMATION (SERVICE CLASSES, * PRIORITY, ETC.) ARE PRINTED TO THE REPORT FILE. # # **** PROC PUTSCI - XREF LIST BEGIN. # XREF BEGIN PROC RPEJECT; # PAGE EJECT # PROC RPSPACE; # LINE FEED # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC PUTSCI - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD *CALL COMUJCA # * LOCAL VARIABLES. # ITEM I I; # FOR LOOP CONTROL # ITEM VALUE I; # TEMPORARY STORAGE # # * BEGIN PUTSCI PROC. # TLFG=0; # INDICATES NO SUBTITLE # P=LOC(DBUF); P=LOC(DDHD); RPEJECT(OFFA); RPSPACE(OFFA,2,1); WRITEV("SYSTEM CONTROL INFORMATION",CHRC,11,26,LFDC); RPSPACE(OFFA,2,1); WRITEV("SERVICE QUEUE",CHRC,11,15,NLFC); WRITEV(" PRIORITIES",CHRC,26,25,NLFC); WRITEV("SERVICE LIMITS",CHRC,77,14,LFDC); WRITEV("CLASS",CHRC,11,5,NLFC); WRITEV("CP CT CM NJ TD",CHRC,69,29,LFDC); WRITEV("FL AM TP AJ DT",CHRC,69,29,LFDC); WRITEV("IL LP UP WF IP",CHRC,31,28,NLFC); WRITEV("EC EM DS FC CS FS",CHRC,69,29,LFDC); WRITEV("PR SE RS US",CHRC,69,23,LFDC); P=LOC(DCHD$WD[DDSC$FW[JCBA]]); # * PRINT SERVICE CLASS INFORMATION. # SLOWFOR I=1 STEP 1 UNTIL DCHD$WD[DDSC$FW[MXNS]]-2 DO BEGIN # PROCESS ONE SERVICE CLASS # RPSPACE(OFFA,2,1); WRITEV(JCST$SC[I],CHRC,13,2,NLFC); # SERVICE CLASS NAME # WRITEV("IN",CHRC,22,2,NLFC); WRITEV(JCA$INLP[I],OC2C,36,4,NLFC); WRITEV(JCA$INUP[I],OC2C,43,4,NLFC); VALUE=2**JCA$INWF[I]; WRITEV(VALUE,OC2C,49,4,NLFC); WRITEV(JCA$CP[I],OC2C,67,4,NLFC); WRITEV(JCA$CT[I],OC2C,75,4,NLFC); WRITEV(JCA$CM[I],OC2C,81,4,NLFC); WRITEV(JCA$NJ[I],OC2C,88,4,NLFC); WRITEV(JCA$TD[I],OC2C,94,4,LFDC); WRITEV("EX",CHRC,22,2,NLFC); WRITEV(JCA$EXIL[I],OC2C,29,4,NLFC); WRITEV(JCA$EXLP[I],OC2C,36,4,NLFC); WRITEV(JCA$EXUP[I],OC2C,43,4,NLFC); VALUE=2**JCA$EXWF[I]; WRITEV(VALUE,OC2C,49,4,NLFC); WRITEV(JCA$EXIP[I],OC2C,55,4,NLFC); WRITEV(JCA$FL[I],OC2C,67,4,NLFC); WRITEV(JCA$AM[I],OC2C,71,8,NLFC); WRITEV(JCA$TP[I],OC2C,81,4,NLFC); WRITEV(JCA$AJ[I],OC2C,88,4,NLFC); WRITEV(JCST$SC[JCA$DT[I]],CHRC,96,2,LFDC); WRITEV("OT",CHRC,22,2,NLFC); WRITEV(JCA$OTLP[I],OC2C,36,4,NLFC); WRITEV(JCA$OTUP[I],OC2C,43,4,NLFC); VALUE=2**JCA$OTWF[I]; WRITEV(VALUE,OC2C,49,4,NLFC); WRITEV(JCA$EC[I],OC2C,67,4,NLFC); WRITEV(JCA$EM[I],OC2C,75,4,NLFC); WRITEV(JCA$DS[I],OC2C,84,1,NLFC); WRITEV(JCA$FC[I],OC2C,89,1,NLFC); WRITEV(JCA$CS[I],OC2C,93,1,NLFC); WRITEV(JCA$FS[I],OC2C,97,1,LFDC); WRITEV(JCA$PR[I],OC2C,67,4,NLFC); WRITEV(JCA$SE[I],OC2C,75,4,NLFC); WRITEV(JCA$RS[I],OC2C,81,4,NLFC); WRITEV(JCA$US[I],OC2C,88,4,LFDC); END # PROCESS ONE SERVICE CLASS # RETURN; END # PUTSCI # TERM PROC PUTSNS((FWA),(LWA)); # TITLE PUTSNS - PROCESS SNAPSHOT LOOP ELEMENTS. # BEGIN # PUTSNS # # ** PUTSNS - PROCESS SNAPSHOT LOOP ELEMENTS. * * PUTSNS IS THE DRIVER OF THE SNAPSHOT LOOP ELEMENTS. * * PROC PUTSNS((FWA),(LWA)) * * ENTRY FWA = FIRST WORD ADDRESS OF SNAPSHOT LOOP * ELEMENTS IN TABLE *DSPT*. * LWA = LAST WORD ADDRESS OF SNAPSHOT LOOP * ELEMENTS IN TABLE *DSPT*. * * EXIT SNAPSHOT LOOP ELEMENTS ARE PRINTED TO THE REPORT * FILE. # # * PARAMETER LIST. # ITEM FWA I; # *FWA* IN *DSPT* TABLE # ITEM LWA I; # *LWA* IN *DSPT* TABLE # # **** PROC PUTSNS - XREF LIST BEGIN. # XREF BEGIN PROC GETMSG; # GET TITLE FROM TABLE *DSPTTXT* # PROC WRITEV; # WRITE DATA ELEMENT # END # **** PROC PUTSNS - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF BPCC #6#; # NUMBER OF BITS PER CHAR # DEF NSBC #O"777"#; # NO SUBBLOCK FLAG # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM BL U; # BIT LENGTH # ITEM BT I; # BIT POSITION # ITEM FW I; # POINTER TO *DCDT* TABLE # ITEM I I; # FOR LOOP CONTROL # ITEM IC I; # INCREMENTOR # ITEM J I; # FOR LOOP CONTROL # ITEM K I; # FOR LOOP CONTROL # ITEM L I; # FOR LOOP CONTROL # ITEM LN U; # TITLE LENGTH IN CHARACTERS # ITEM MSG C(50); # TEMPORARY BUFFER # ITEM N I; # TEMPORARY STORAGE # ITEM PT I; # POINTER TO *DDDT* TABLE # ITEM ST U; # POINTER TO SUBTITLE TABLE # ITEM VL I; # TEMPORARY VALUE # ITEM WC I; # WORD COUNT # # * BEGIN PUTSNS PROC. # P=LOC(DBUF[DCHL]); P=LOC(DDDT); FASTFOR I=FWA STEP 1 UNTIL LWA DO BEGIN # FOLLOW TABLE *DSPT* # PT=DSPT$PT[I]; # POINTER TO *DDSC* # ST=DSPT$ST[I]; # POINTER TO *SMGT* # BL=DSPT$BL[I]; # BIT LENGTH # LN=DSPT$LN[I]; GETMSG(I,MSG); FW=DDSC$FW[PT]; IC=DDSC$IC[PT]; # INCREMENTOR # # * IF BIT LENGTH *BL* IS ZERO, THE VALUE IS A FULL WORD VALUE. * THE VALUE IS PRINTED IN FIVE 12-BIT BYTES, IN SUCCESSIVE ROWS. # IF (BL EQ 0) # NO BIT LENGTH # THEN BEGIN # ACCESS FULL WORD # WRITEV(MSG,CHRC,1,LN,LFDC); FASTFOR J=1 STEP 1 UNTIL DDSC$LN[PT] DO BEGIN # PROCESS ONE ENTRY # IF (ST NQ NSBC) # SUBTITLE PRESENT # THEN # PRINT SUBTITLE # BEGIN MSG=SMGT$TX[ST+J-1]; WRITEV(MSG,CHRC,10,10,NLFC); END FASTFOR L=0 STEP 1 UNTIL 4 DO BEGIN # BREAK A WORD INTO FIVE BYTES # N=31; SLOWFOR K=1 STEP 1 UNTIL NIPP DO # PRINT BYTE L OF COLUMN K # BEGIN VL=CDCDT$CW[(K-1)*DCDL + FW]; WRITEV(VL,OC3C,N,4,NLFC); N=N+10; END WRITEV(BLKC,CHRC,N+2,1,LFDC); # LINE FEED # END # BREAK A WORD INTO FIVE BYTES # FW=FW+IC; END # PROCESS ONE ENTRY # END # ACCESS FULL WORD # # * IF BIT LENGTH *BL* IS NON ZERO, THE VALUE IS A PARTIAL WORD * VALUE. *WC* IS THE WORD COUNT INDICATING WHAT WORD IN A * MULTIPLE-ENTRY ELEMENT THAT CONTAINS THE VALUE. IF THE ELEMENT * IS A SINGLE-ENTRY ELEMENT, *WC* IS ZERO. *BL* AND *BT* ARE * THE NUMBER OF BITS AND THE STARTING BIT POSITION, RESPECTIVELY. # ELSE BEGIN # ACCESS PARTIAL WORD # WRITEV(MSG,CHRC,1,LN,NLFC); BT=DSPT$BT[I]/BPCC; # CHARACTER POSITION # WC=DSPT$WC[I]; # WORD POSITION # BL=BL/BPCC; # NUMBER OF CHARACTERS # N=BCLC + 2; SLOWFOR J=1 STEP 1 UNTIL NIPP DO BEGIN VL=CDCDT$CW[(J-1)*DCDL + FW + WC]; WRITEV(VL,INTC,N,8,NLFC); N=N+10; END WRITEV(BLKC,CHRC,N+2,1,LFDC); # LINE FEED # END # ACCESS PARTIAL WORD # END # FOLLOW TABLE *DSPT* # RETURN; END # PUTSNS # TERM PROC READRC(STAT); # TITLE READRC - READ DATA FILE. # BEGIN # READRC # # ** READRC - READ DATA FILE. * * READ ONE RECORD FROM THE DATA FILE. * * PROC READRC(STAT) * * ENTRY THE DATA FILE. * * EXIT STAT = STATUS CODE. * ONE RECORD OF THE DATA FILE IS READ TO * WORKING STORAGE AREA *WSAI*. * THE NUMBER OF WORDS READ *IBNW* IS UPDATED. # # * PARAMETER LIST. # ITEM STAT I; # STATUS CODE # # **** PROC READRC - XREF LIST BEGIN. # XREF BEGIN PROC READSKP; # READ AND SKIP # END # **** PROC READRC - XREF LIST END. # DEF RFETL #8#; # FET LENGTH # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMAFET *CALL COMUCPD # * LOCAL VARIABLES. # ARRAY STT [0:0] P(1); # STATUS CODE # BEGIN # ARRAY STT # ITEM STT$STAT U(00,42,18); # STATUS # ITEM STT$LN U(00,42,04); # LEVEL NUMBER # ITEM STT$AT U(00,46,04); # ABNORMAL TERMINATION CODE # ITEM STT$CODE U(00,50,10); # REQUEST/RETURN CODE # END # ARRAY STT # # * BEGIN READRC PROC. # P=LOC(FETI); FET$IN[0]=FET$FRST[0]; # SET *IN* = *FIRST* # FET$OUT[0]=FET$FRST[0]; # SET *OUT* = *FIRST* # READSKP(FETSET,0,1); IBNW = FET$IN[0] - FET$OUT[0]; # NUMBER OF WORDS READ # STT$LN[0]=FET$LN[0]; STT$AT[0]=FET$AT[0]; STT$CODE[0]=FET$CODE[0]; STAT=STT$STAT[0]; RETURN; END # READRC # TERM PROC REPTLE; # TITLE REPTLE - PRINT REPORT SUBTITLE. # BEGIN # REPTLE # # ** REPTLE - PRINT REPORT SUBTITLE. * * *REPTLE* PRINTS THE SUBTITLE AT EACH PAGE EJECT. * THE SUBTITLE TO BE PRINTED DEPENDS ON THE VALUE * OF *TLFG* (COMMON BLOCK *CIOCOMM*). * * PROC REPTLE * * ENTRY NIPP = NUMBER OF INTERVALS PER PAGE * (COMMON BLOCK *CIOCOMM*). * TLFG = SUBTITLE FLAG (COMMON BLOCK *CIOCOMM*). * IF *TLFG* IS : * 0 NO SUBTITLE. * 1 PRINT SUBTITLE FOR DATA BLOCK. * 2 PRINT SUBTITLE FOR SNAPSHOT. * 3 PRINT SUBTITLE FOR EST REPORT. * * EXIT SUBTITLE IS PRINTED ON TOP OF EACH PAGE. # # **** PROC REPTLE - XREF LIST BEGIN. # XREF BEGIN FUNC EDATE C(10); # CONVERT NUMBER TO DATE # FUNC ETIME C(10); # CONVERT NUMBER TO TIME # PROC RPLINEX; # PRINT ONE LINE # FUNC XCDD C(10); # CONVERT TO DISPLAY DECIMAL # END # **** PROC REPTLE - XREF LIST END. # DEF ASTC #"*"#; # ASTERISK # DEF BLKC #" "#; # BLANK # DEF PRDC #"."#; # PERIOD # DEF SLSC #"/"#; # SLASH # DEF ZERC #"0"#; # CHARACTER ZERO # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM ESTFS B=TRUE; # FIRST EST SUBTITLE FLAG # ITEM HRS I; # HOUR # ITEM I I; # FOR LOOP CONTROL # ITEM J I; # TEMPORARY VARIABLE # ITEM MNS I; # MINUTE # ITEM MSG C(40); # TEMPORARY STORAGE # ITEM N I; # TEMPORARY VARIABLE # ITEM N1 I; # TEMPORARY VARIABLE # ITEM N2 I; # TEMPORARY VARIABLE # ITEM OF I; # OFFSET # ARRAY T [0:0] P(1); # TEMPORARY STORAGE # BEGIN ITEM T$WD C(00,00,10); # TEN CHARACTER WORD # ITEM T$3C C(00,00,03); # THREE CHARACTER ITEM # ITEM T$2C C(00,00,02); # TWO CHARACTER ITEM # ITEM T$1C C(00,00,01); # ONE CHARACTER ITEM # ITEM T$ZC C(00,06,01); # ZERO FILL # END ARRAY TEM [0:0] P(1); # TEMPORARY STORAGE # BEGIN # ARRAY TEM # ITEM TEM$WD C(00,00,10); # TEN CHARACTER ITEM # ITEM TEM$3C C(00,42,03); # THREE CHARACTER ITEM # ITEM TEM$2C C(00,48,02); # TWO CHARACTER ITEM # END # * BEGIN REPTLE PROC. # IF (TLFG EQ 0) OR (P$L EQ NULL) # NO TITLE OR NO REPORT FILE # THEN BEGIN RETURN; # NO SUBTITLE # END IF (TLFG EQ 3) # PRINTING EST # THEN BEGIN # PRINT EST SUBTITLE # RPLINEX(OFFA,BLKC,1,1,LFDC); RPLINEX(OFFA,BLKC,1,1,LFDC); IF (ESTFS) # FIRST EST SUBTITLE # THEN BEGIN MSG="EQUIPMENT STATUS TABLE"; RPLINEX(OFFA,MSG,5,22,LFDC); ESTFS=FALSE; END ELSE # SECOND EST SUBTITLE # BEGIN MSG="EQUIPMENT STATUS TABLE (CONTINUED)"; RPLINEX(OFFA,MSG,5,35,LFDC); END MSG="NO. TYPE STAT EQ UN CHANNELS"; RPLINEX(OFFA,MSG,5,33,NLFC); MSG="EST ENTRY"; RPLINEX(OFFA,MSG,42,9,NLFC); MSG="TRACK FILES"; RPLINEX(OFFA,MSG,86,17,LFDC); RPLINEX(OFFA,BLKC,1,1,LFDC); RETURN; END # PRINT EST SUBTITLE # P=LOC(DBUF[DCHL]); P=LOC(DBUF[DCHL + DCDC*DCDL*2]); P=LOC(DDDT); # * PRINT INTERVAL TIMES. # RPLINEX(OFFA,BLKC,1,1,LFDC); # LINE FEED # IF(P$IN NQ 0) THEN BEGIN TEM$WD=XCDD(P$IN); END ELSE BEGIN TEM$WD=XCDD(P$IC); END T$3C[0]=TEM$3C[0]; RPLINEX(OFFA,T,1,3,NLFC); IF (P$IN NQ 0) # INTERVAL TIME SPECIFIED # THEN BEGIN RPLINEX(OFFA," MINS INTERVAL ",5,14,NLFC); END ELSE BEGIN RPLINEX(OFFA," RECS INTERVAL ",5,14,NLFC); END J = BCLC + 1; OF=DCDC*DCDL + DDSC$FW[PDTM]; SLOWFOR I=1 STEP 1 UNTIL NIPP DO BEGIN # PRINT INTERVAL TIME # N=DCDT$ET[(I-1)*DCDL + OF]; # INTERVAL END TIME # T$WD[0]=ETIME(N); # CONVERT TO DISPLAY TIME # RPLINEX(OFFA,T,J,9,NLFC); J=J+10; END # PRINT INTERVAL TIME # # * PRINT TITLES OF SUBTOTAL AND TOTAL. IF SNAPSHOT * LOOP IS BEING PRINTED, THESE TITLES WILL NOT BE * PRINTED. # IF (TLFG EQ 1) # NOT PRINTING SNAPSHOT ELEMENTS # THEN BEGIN # PRINT TIME # # * PRINT SUBTOTAL HEADER. SUBTOTAL IS NOT PRINTED IF THE SUBTOTAL * AND THE TOTAL COLUMNS ARE THE SAME, I.E. IF THE TOTAL COLUMNS * PRINTED *TCOL* IS LESS THAN 7 COLUMNS. THE SUBTOTAL HEADER IS * NOT PRINTED IF THE CURRENT PAGE IS USED TO PRINT THE TOTAL * STATISTICS ONLY (*NIPP* IS 0). # IF (NIPP GR 0) AND (TCOL GR (DCDC-3)) THEN BEGIN # COMPUTE AND PRINT LENGTH OF SUBTOTAL # N=P$IN*NIPP; # LENGTH OF SUBTOTAL # HRS=N/60; # NUMBER OF HOURS # MNS=N - (HRS*60); # NUMBER OF MINUTES # TEM$WD=XCDD(HRS); T$3C[0]=TEM$3C[0]; IF (T$2C[0] EQ BLKC) THEN BEGIN T$ZC[0]=ZERC; END RPLINEX(OFFA,T,J,3,NLFC); RPLINEX(OFFA,":",J+3,1,NLFC); TEM$WD=XCDD(MNS); T$2C[0]=TEM$2C[0]; IF (T$1C[0] EQ BLKC) THEN BEGIN T$1C[0]=ZERC; END RPLINEX(OFFA,T,J+4,2,NLFC); END # COMPUTE AND PRINT LENGTH OF SUBTOTAL # # * PRINT TOTAL HEADER. TOTAL HEADER IS NOT PRINTED IF MORE * THAN 7 COLUMNS ARE PRINTED ON THE CURRENT PAGE. # IF (NIPP GR (DCDC-3)) THEN BEGIN RPLINEX(OFFA," HR",J+6,3,LFDC); END ELSE BEGIN # COMPUTE AND PRINT LENGTH OF TOTAL # IF (NIPP GR 0) AND (TCOL GR (DCDC-3)) THEN BEGIN RPLINEX(OFFA," HR",J+6,3,NLFC); J=J+10; END P=LOC(DBUF); P=LOC(DDHD); N=(DCHD$WD[DDSC$FW[DLFW]]*ACNS)/60; # TOTAL MINUTES # HRS=N/60; # TOTAL HOURS # MNS=N - (HRS*60); TEM$WD[0]=XCDD(HRS); T$3C[0]=TEM$3C[0]; IF (T$2C[0] EQ BLKC) THEN BEGIN T$ZC[0]=ZERC; END RPLINEX(OFFA,T,J,3,NLFC); RPLINEX(OFFA,":",J+3,1,NLFC); TEM$WD[0]=XCDD(MNS); T$2C[0]=TEM$2C[0]; IF (T$1C[0] EQ BLKC) THEN BEGIN T$1C[0]=ZERC; END RPLINEX(OFFA,T,J+4,2,NLFC); RPLINEX(OFFA," HR",J+6,3,NLFC); # * PRINT HEADERS FOR THE MAXIMUM AND MINIMUM STATISTIC COLUMNS. # P=LOC(DDDT); N1=DDSM$BT[DDSC$FW[PDTM]]; # TOTAL BEGIN TIME # N2=DDSM$ET[DDSC$FW[PDTM]]; # TOTAL END TIME # T$WD[0]=EDATE(N1/SHFC); # CONVERT TO DATE # RPLINEX(OFFA,T,J+11,9,NLFC); RPLINEX(OFFA,"TO ",J+21,3,NLFC); T$WD[0]=EDATE(N2/SHFC); RPLINEX(OFFA,T,J+23,9,LFDC); END # COMPUTE AND PRINT LENGTH OF TOTAL # END # PRINT TIME # ELSE # PRINTING SNAPSHOT ELEMENTS # BEGIN RPLINEX(OFFA,BLKC,J,1,LFDC); END # * PRINT SECOND LINE OF THE SUBTITLE. # J=BCLC + 1; SLOWFOR I=1 STEP 1 UNTIL NIPP DO BEGIN RPLINEX(OFFA," INTERVAL",J,9,NLFC); J=J+10; END IF (TLFG EQ 1) # NOT PRINTING SNAPSHOT ELEMENTS # THEN BEGIN # PRINT SUBTOTAL AND TOTAL HEADERS # IF (NIPP GR (DCDC-3)) THEN # PRINT TOTAL ON NEXT PAGE # BEGIN RPLINEX(OFFA," SUBTOTAL",J,9,LFDC); END ELSE # PRINT TOTAL ON THE SAME PAGE # BEGIN # PRINT SUBTOTAL AND TOTAL HEADERS ON SAME PAGE # IF (NIPP GR 0) # TOTAL IS NOT FIRST COLUMN # AND (TCOL GR (DCDC-3)) THEN BEGIN RPLINEX(OFFA," SUBTOTAL",J,9,NLFC); J=J+10; END RPLINEX(OFFA," TOTAL",J,9,NLFC); RPLINEX(OFFA," *MAX* ",J+10,10,NLFC); RPLINEX(OFFA," *MIN* ",J+20,10,LFDC); END # PRINT SUBTOTAL AND TOTAL HEADERS ON SAME PAGE # END # PRINT SUBTOTAL AND TOTAL HEADERS # ELSE # PRINTING SNAPSHOT ELEMENTS # BEGIN RPLINEX(OFFA,BLKC,J,1,LFDC); END RPLINEX(OFFA,BLKC,1,1,LFDC); # LINE FEED # RETURN; END # REPTLE # TERM PROC WRITEV(PVL,(DTY),(BCL),(FWD),(CRC)); # TITLE WRITEV - WRITE TO REPORT FILE. # BEGIN # WRITEV # # ** WRITEV - WRITE TO REPORT FILE. * * WRITE ONE VALUE TO THE REPORT FILE. * * PROC WRITEV(PVL,(DTY),(BCL),(FWD),(CRC)) * * ENTRY PVL = VALUE TO BE PRINTED. * DTY = DATA TYPE. * BCL = BEGINNING COLUMN TO WRITE. * FWD = FIELD WIDTH. * CRC = CARRIAGE CONTROL. * *LFD* IF LINE FEED AT THE END OF THE LINE * *NLF* IF NO LINE FEED * * EXIT THE VALUE IS PRINTED TO THE REPORT FILE ACCORDING * TO THE SPECIFIED FORMAT. # # * PARAMETER LIST. # ITEM PVL U; # ADDRESS OF VALUE # ITEM DTY I; # DATA TYPE # ITEM BCL I; # BEGINNING COLUMN # ITEM FWD I; # FIELD WIDTH # ITEM CRC I; # CARRIAGE CONTROL # # **** PROC WRITEV - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK/ZERO FILL ITEM # PROC RPLINE; # PRINT ONE REPORT LINE # FUNC XCDD C(10); # BINARY TO DISPLAY DECIMAL # FUNC XCED C(10); # BINARY TO DISPLAY *E* FORMAT # FUNC XCFD C(10); # BINARY TO DISPLAY REAL # FUNC XCOD C(10); # BINARY TO DISPLAY OCTAL # END # **** PROC WRITEV - XREF LIST END. # DEF BLKC #" "#; # BLANK # DEF MAXF #1.0E4#; # MAXIMUM VALUE OF *F* FORMAT # DEF ZERC #"0"#; # CHARACTER 0 # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD *CALL COMABZF # * LOCAL VARIABLES. # ITEM N I; # TEMPORARY VARIABLE # ITEM NF R; # TEMPORARY VARIABLE # ITEM T1 I; # TEMPORARY VARIABLE # ITEM T2 I; # TEMPORARY VARIABLE # ARRAY P [0:0] P(1); # TEMPORARY BUFFER # BEGIN # ARRAY P # ITEM P$WD C(00,00,10); # 10 CHAR VALUE # ITEM P$WF C(00,06,09); # 9 LEAST SIGNIFICANT DIGITS # END # ARRAY P # ARRAY TEM [0:0] P(1); # DISPLAY CODE VALUE # BEGIN # ARRAY TEM # ITEM T$WD C(00,00,10); # VALUE # ITEM T$W1 C(00,00,09); # VALUE WITH NO POSTFIX # ITEM T$W2 C(00,54,01); # *B* POSTFIX # END # ARRAY TEM # BASED ARRAY VAL [0:0] P(1); # VALUE TO BE PRINTED # BEGIN # ARRAY VAL # ITEM VAL$C C(00,00,50); # CHARACTER TYPE # ITEM VAL$N I(00,00,60); # INTEGER TYPE # ITEM VAL$F R(00,00,60); # REAL TYPE # END # ARRAY VAL # SWITCH TYPE CHRS, # CHARACTER # FLPS, # FLOATING POINT # INTS, # INTEGER # OC1S, # OCTAL WITH *B* POSTFIX # OC2S, # OCTAL WITH NO POSTFIX # OC3S, # *B* POSTFIX, ZERO FILLED # OC4S, # OCTAL, ALLOWING FOR *UESC* # ; # END OF TYPE # LABEL EXIT; # END CASE # # * BEGIN WRITEV PROC. # IF (P$L EQ NULL) # NO REPORT FILE # THEN # SUPPRESS REPORT FILE # BEGIN RETURN; END P=LOC(PVL); GOTO TYPE[DTY]; CHRS: # CHARACTER # BZFILL(VAL,TYPFILL"BFILL",FWD); RPLINE(OFFA,C<0,FWD>VAL$C[0],BCL,FWD,CRC); RETURN; FLPS: # FLOATING POINT # IF (VAL$F[0] GQ MAXF) # PRINT IN *E* FORMAT # THEN BEGIN NF=VAL$F[0]; T$WD[0]=XCED(NF); END ELSE # PRINT IN *F* FORMAT # BEGIN N=VAL$F[0]*1000.0 + 0.5; T$WD[0]=XCFD(N); END GOTO EXIT; INTS: # INTEGER # T$WD[0]=XCDD(VAL$N[0]); GOTO EXIT; OC1S: # OCTAL POSTFIXED WITH *B* # P$WD[0]=XCOD(VAL$N[0]); T$W1[0]=P$WF[0]; T$W2[0]="B"; GOTO EXIT; OC2S: # OCTAL WITHOUT *B* POSTFIX # T$WD[0]=XCOD(VAL$N[0]); GOTO EXIT; OC3S: # OCTAL NO POSTFIX, ZERO FILLED # T$WD[0]=XCOD(VAL$N[0]); SLOWFOR N=0 STEP 1 WHILE CT$WD[0] EQ BLKC DO # CONVERT BLANK TO DISPLAY 0 # BEGIN CT$WD[0]=ZERC; END GOTO EXIT; OC4S: # OCTAL WITH *B*, SHIFTED *UESC* # T1 = P; T2 = P; P = LOC(DBUF); P = LOC(DDHD); P$WD[0]=XCOD(VAL$N[0]*2**DCHD$WD[DDSC$FW[UESC]]); P = T1; P = T2; T$W1[0]=P$WF[0]; T$W2[0]="B"; EXIT: RPLINE(OFFA,C<10-FWD,FWD>T$WD[0],BCL,FWD,CRC); RETURN; END # WRITEV # TERM PROC WRTSUM((NIP)); # TITLE WRTSUM - WRITE SUMMARY FILE. # BEGIN # WRTSUM # # ** WRTSUM - WRITE SUMMARY FILE. * * WRITE DATA BLOCK ELEMENTS TO SUMMARY FILE. * * PROC WRTSUM((NIP)) * * ENTRY TABLE *DCDT*. * NIP = NUMBER OF INTERVALS PER PAGE. * * EXIT THE AVERAGE AND STANDARD DEVIATION OF EACH * DATA BLOCK ELEMENT ARE WRITTEN TO THE SUMMARY * FILE. # # * PARAMETER LIST. # ITEM NIP I; # NUMBER OF INTERVALS PER PAGE # # **** PROC WRTSUM - XREF LIST BEGIN. # XREF BEGIN PROC WRITER; # WRITE EOR # PROC WRITEW; # *CIO* WRITEW # END # **** PROC WRTSUM - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM I I; # FOR LOOP CONTROL # ITEM WA I; # ADDRESS OF DECODED BUFFER # BASED ARRAY SUM [0:0] P(1);; # DUMMY BUFFER # # * BEGIN WRTSUM PROC. # P=LOC(DBUF[DCHL]); WA=1; SLOWFOR I=1 STEP 1 UNTIL NIP DO BEGIN P=LOC(DCDT$WD[WA]); WRITEW(FETS,SUM,DCDL,0); # WRITE AVERAGE # P=LOC(DCDT$WD[DCDC*DCDL + WA]); WRITEW(FETS,SUM,DCDL,0); # WRITE STANDARD DEVIATION # WRITER(FETS,1); # WRITE EOR # WA=WA + DCDL; END RETURN; END # WRTSUM # TERM FUNC XCED((NUM)) C(10); # TITLE XCED - CONVERT NUMBER TO THE DISPLAY *E* FORMAT. # BEGIN # XCED # # ** XCED - CONVERT NUMBER TO THE DISPLAY *E* FORMAT. * * *XCED* CONVERTS A REAL NUMBER TO THE FORTRAN *E* FORMAT. * THE NUMBER HAS TO BE GREATER THAN 1.0E4 AND LESS THAN * (2**32 - 1). * THE RESULT IS A NORMALIZED NUMBER IN DISPLAY CODE. * THE FORMAT OF THE CONVERTED NUMBER IS : * * BB.XXXXEYY * * THE VALUE IS RIGHT-JUSTIFIED, BLANK FILLED. * IF THE EXPONENT *YY* IS ONLY ONE DIGIT LONG, * THE MANTISSA *XXXX* IS INCREASED TO FIVE DIGITS. * * FUNC XCED((NUM)) C(10) * * ENTRY NUM = NUMBER TO BE CONVERTED. * * EXIT THE NUMBER IS NORMALIZED AND CONVERTED TO * DISPLAY CODE. # # * PARAMETER LIST. # ITEM NUM R; # NUMBER TO BE CONVERTED # # **** FUNC XCED - XREF LIST BEGIN. # XREF BEGIN FUNC XCDD C(10); # BINARY TO DISPLAY DECIMAL # END # **** FUNC XCED - XREF LIST END. # DEF LISTCON #0#; # TURN OFF COMMON DECK LISTING # *CALL COMUCPD # * LOCAL VARIABLES. # ITEM EXP I; # EXPONENT # ITEM I I; # FOR LOOP CONTROL # ITEM J I; # FOR LOOP CONTROL # ITEM NUMF R; # TEMPORARY VARIABLE # ITEM NUMI I; # TEMPORARY VARIABLE # ITEM P I; # POSITION OF *E* # ITEM TEM1 C(10); # TEMPORARY VARIABLE # ARRAY TEM [0:0] P(1); # TEMPORARY STORAGE # BEGIN # ARRAY TEM # ITEM T$WD C(00,00,10); # CONVERTED NUMBER # ITEM T$DP C(00,12,01); # DECIMAL POINT # END # ARRAY TEM # # * BEGIN XCED FUNC. # NUMF=NUM; EXP=0; # * NORMALIZE THE NUMBER. # SLOWFOR I=1 WHILE (NUMF GQ 1.0) DO BEGIN NUMF=NUMF/10.0; EXP=EXP + 1; END T$WD[0]=XCDD(EXP); T$DP[0]="."; # DECIMAL POINT # P=8; # POSITION OF *E* # IF (EXP GQ 10) THEN BEGIN P=7; END NUMI=NUM; TEM1=XCDD(NUMI); # * MOVE THE MOST SIGNIFICANT DIGITS TO *TEM*. # SLOWFOR I=0 STEP 1 WHILE (CTEM1 EQ " ") DO; # FIND THE FIRST DIGIT # FASTFOR J=3 STEP 1 UNTIL P-1 DO BEGIN # MOVE THE MOST SIGNIFICANT DIGITS # CT$WD[0]=CTEM1; I=I+1; END # MOVE THE MOST SIGNIFICANT DIGITS # CT$WD[0]="E"; # PLACE THE *E* CHARACTER # XCED=T$WD[0]; RETURN; END # XCED # TERM