Retro1.org codex

*DECK DLNBH 
USETEXT DLFPDEF 
USETEXT ABH 
USETEXT DIRTBLH 
USETEXT ERRMSG
USETEXT OUTCDA
USETEXT NHEADER 
USETEXT ZHRCD 
PROC DLNBH;                  # SELECT NETWORK MESSAGES FOR OUTPUT      #
 
*IF DEF,IMS 
 #
*1DC  DLNBH 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        DLNBH               P.C.TAM             79/01/10 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        SELECT NETWORK MESSAGES FOR OUTPUT 
* 
*     3. METHOD USED
*        LOOP THROUGH NETWORK BLOCK PROCESSING TABLE. PROCESS 
*        EACH ENTRY AS FOLLOWS UNTIL EITHER THE CHOSEN FLAG 
*        IS CLEARED OR ALL ENTRIES ARE PROCESSED. 
*        C         CHECK IF CANCEL FLAG IS SET IN DBC.
*                  IF NOT SET, CLEAR CHOSEN FLAG. 
*        F         CHECK IF NO FORMAT EFFECTOR FLAG IS SET IN 
*                  DBC. IF NOT SET, CLEAR CHOSEN FLAG.
*        P         CHECK IF PARITY/AUTO INPUT FLAG IS SET IN
*                  DBC. IF NOT SET, CLEAR CHOSEN FLAG.
*        X         CHECK IF TRANSPARENT DATA FLAG IS SET IN DBC.
*                  IF NOT SET, CLEAR CHOSEN FLAG. 
*        DN        COMPARE NODE NUMBER IN NETWORK BLOCK PROCESSING
*                  TABLE WITH DN IN MESSAGE. IF NO MATCH, 
*                  CLEAR CHOSEN FLAG. 
*        SN        COMPARE SOURCE NODE IN NETWORK BLOCK PROCESSING
*                  TABLE WITH SN IN MESSAGE. IF NO MATCH, 
*                  CLEAR CHOSEN FLAG. 
*        CN        COMPARE CONNECTION NUMBER IN NETWORK BLOCK 
*                  PROCESSING TABLE WITH CN IN MESSAGE. IF NO MATCH,
*                  CLEAR CHOSEN FLAG. 
* 
*     4. ENTRY PARAMETER. 
*        DIRTBLH   COMMON BLOCK CONTAINING SELECTION CRITERIA 
*        ZHRCD     COMMON BLOCK HOLDING THE NETWORK BLOCK HEADER
* 
*     5. EXIT PARAMETER.
*        CHOSEN    IN ZHRCD, SET IF MESSAGE IS SELECTED.
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ABH       DIRTBLH   DLFPDEF   ERRMSG 
*        OUTCDA    NHEADER   ZHRCD
* 
*     7. ROUTINES CALLED
*        DLABEND             ABORT PROGRAM
*        DLDFM               ISSUE DAYFILE MESSAGE
* 
*     8. DAYFILE MESSAGES 
*        BAD DIRECTIVE TABLE ENTRY. 
* 
 #
*ENDIF
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC DLABEND;        # ABORT PROGRAM                           #
        PROC DLDFM;          # ISSUE DAYFILE MESSAGE                   #
        END 
 
# 
      LOCAL VARIABLES 
# 
      SWITCH CRIT 
              ERR, ERR, ERR, ERR, ERR, ERR, ERR,ERR,L$C, L$F, L$P, ERR, 
              ERR, L$X, L$DN, L$SN, L$CN, ERR, ERR, ERR, ERR, ERR, ERR; 
 
      ITEM
      I,                     # INDEX VARIABLE                          #
      K,                     # TEMPORARY VARIABLE                      #
      TEMPABH;               # TEMPORARY ABH                           #
 
# ******************************************************************** #
      BEGIN 
      P<NHEADER> = LOC(ZHWD1[0]) + BLKHSIZE;
      P<ABH> = LOC(TEMPABH);
      ABHDBC[0] = NHDBC[0]; 
      FOR I = 1 STEP 1 WHILE I LQ DIRNUMH AND CHOSEN
      DO
        BEGIN 
        GOTO CRIT[DIRHID[I]]; 
L$C:                         # CANCEL FLAG PROCESSING                  #
        IF ABHCAN[0] NQ 1 
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
L$F:                         # NO FORMAT EFFECTOR PROCESSING           #
        IF ABHNFE[0] NQ 1 
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
L$P:                         # PARITY / AUTO INPUT FLAG PROCESSING     #
        IF ABHBIT[0] NQ 1 
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
L$X:                         # TRANSPARENT BIT PROCESSING              #
        IF ABHXPT[0] NQ 1 
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
L$DN:                        # DESTINATION NODE PROCESSING             #
        IF DIRHVAL[I] NQ DN[0]
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
L$SN:                        # SOURCE NODE PROCESSING                  #
        IF DIRHVAL[I] NQ SN[0]
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
L$CN:                        # CONNECTION NUMBER PROCESSING            #
        IF DIRHVAL[I] NQ CN[0]
        THEN
          CHOSEN = FALSE; 
        GOTO NEXT;
ERR:  
      DLDFM(BAD$DNTRY);      # BAD DIRECTIVE TABLE ENTRY               #
      DLABEND;               # ABORT PROGRAM                           #
NEXT: 
        END 
      END 
TERM