Retro1.org codex

*DECK NVFUPRP 
USETEXT          TEXTNVF
USETEXT          TEXTSS 
USETEXT          TXTANVF
      PROC NVFUPRP; 
# TITLE NVFUPRP - PERFORM NVF REPRIEVE PROCESSING # 
 
      BEGIN 
# 
**    NVFUPRP - PERFORM NVF REPRIEVE PROCESSING.
* 
*     C. J. BRION       83/12/12. 
* 
*     THIS ROUTINE PERFORMS THE REPRIEVE PROCESSING FUNCTIONS 
*     THAT ARE UNIQUE FOR THE NVF PROGRAM. CURRENTLY, ONLY A GLOBAL 
*     SPIDA CALL IS MADE IN ORDER TO INSURE THAT ALL PIDS DEFINED 
*     FOR THE NHP NETWORK ARE SET UNAVAILABLE.
* 
*     A CALL IS THEN MADE TO THE PAT1 ENTRY POINT OF THE SS ROUTINE 
*     SSSPAT IN ORDER TO COMPLETE REPRIEVE PROCESSING.
* 
* 
*     PROC NVFUPRP
* 
*     ENTRY      NONE.
* 
*     EXIT       GLOBAL SPIDA CALL MADE AND CONTROL TRANSFERRED 
*                TO SSSPAT ENTRY POINT PAT1.
# 
 
# 
****  PROC NVFUPRP XDEF LIST. 
# 
      XDEF
        BEGIN 
        LABEL NVFPRPE;                   # EXT LABEL FOR REPRIEVE      #
        END 
# 
****
# 
 
# 
****  PROC NVFUPRP - XREF LIST. 
# 
      XREF
        BEGIN 
        PROC DFC;                        # DECREMENT FAMILY COUNT      #
        PROC SPIDA;                      # MACREL SETPIDA I/F ROUTINE  #
        LABEL PAT1;                      # SSPAT ENTRY POINT PAT1      #
        END 
 
 
# 
**    SPIDBLK - SETPIDA PARAMETER BLOCK.
* 
*     THIS PARAMETER BLOCK DEFINES THE SETPIDA FUNCTION PARAMETERS
*     FOR SETTING ALL NHP CONNECTED PIDS UNAVAILABLE. 
# 
 
      ARRAY SPIDBLK [00:00] S(2); 
        BEGIN 
        ITEM SPI$FC     U(00,00,12) = [1]; # SET NW STATUS FC          #
        ITEM SPI$NP     U(00,12,12) = [1]; # NUMBER PIDS = 1           #
        ITEM SPI$NW     U(00,24,12) = [1]; # NHP NW ID                 #
        ITEM SPI$RES1   U(00,36,23) = [0]; # RESERVED                  #
        ITEM SPI$CBIT   B(00,59,01) = [TRUE]; # COMPLETE BIT           #
        ITEM SPI$PID    C(01,00,03) = ["***"]; # GLOBAL ALL PIDS       #
        ITEM SPI$RES2   U(01,18,38) = [0]; # RESERVED                  #
        ITEM SPI$ST     U(01,56,04) = [0]; # NETWORK UNAVAIL STATUS    #
        END 
 
      ITEM BLKADDR      I;               # SPIDA ADDRESS CELL          #
      ITEM I            I;               # LOOP COUNT                  #
      ITEM PTR          I;               # POINTER OF IFMC TABLE       #
 
      CONTROL EJECT;
 
NVFPRPE:  
 
# 
*     ISSUE SETPIDA MACREL CALL USING THE SPIDBLK PARAMETER BLOCK.
# 
 
      BLKADDR = LOC(SPIDBLK[0]);
      SPIDA(BLKADDR); 
 
# 
*     SEARCH IFMC TABLE, FOR EACH IFMC$COUNT GREATER THAN ZERO, 
*     ISSUE CPM73B REQUESTS TO DECREMENT FAMILY COUNTS UNTIL
*     IFMC$COUNT EQUAL TO ZERO. 
# 
 
      FOR PTR=0 STEP 1 UNTIL (IFCLNGTH-1) 
      DO
        BEGIN 
        FOR I=0 STEP 1 UNTIL (IFMC$COUNT[PTR]-1)
        DO
          BEGIN 
          CPB$WORD[0]=0;
          CPB$FNAM[0]=IFMC$FNAM[PTR]; 
          DFC(CPMBUF);
          END 
        END 
 
# 
*     CALL SSSPAT ENTRY POINT PAT1 TO CONTINUE REPRIEVE PROCESSING. 
*     THERE IS NO RETURN FROM SSSPAT. 
# 
 
      GOTO PAT1;
 
      END # NVFUPRP # 
 TERM