Retro1.org codex

*DECK NS$NDF
USETEXT COM$NS
USETEXT DEF$NS
USETEXT NDF$NS
USETEXT ERR$NS
 
PROC NS$NDF(NDFPFN,ERRCODE); # DEFINE NPU DUMP FILE                    #
 
# TITLE NS$NDF - DEFINE NPU DUMP FILE.                                 #
 
      BEGIN    # NS$NDF # 
# 
**    NS$NDF - DEFINE NPU DUMP FILE.
* 
*     J.C. LEE    1981
* 
*     THIS ROUTINE DEFINES AN NPU DUMP FILE.
* 
*     PROC NS$NDF(NDFPFN,ERRCODE) 
* 
*     ENTRY:  
*       NDFPFN - NPU DUMP FILE PERMANENT FILE NAME. 
* 
*     EXIT: 
*       ERRCODE - ERROR CODE. 
* 
*     METHOD: 
*       TRY THE FOLLOWING 256 TIMES OR TIL A FILE IS DEFINED: 
*         FORMAT PFN OF NDF 
*         DEFINE NDF AS A PRIVATE DIRECT ACCESS 
*         PERMANENT FILE. 
*       IF DUMP INDEX FULL, FLAG ERROR. 
*       UPDATE DUMP NUMBER. 
* 
# 
 
      ITEM NDFPFN     C(7);  # PFN OF NPU DUMP FILE                    #
      ITEM ERRCODE    U;     # ERROR CODE                              #
 
      $BEGIN
      XREF
        BEGIN 
        PROC NS$DBG;         # TRACE PROCEDURE CALL                    #
        END 
      $END
 
      XREF
        BEGIN 
        FUNC DEFINE;         # DEFINE A DIRECT ACCESS PERMANENT FILE   #
        FUNC NS$FEC U;       # FORMAT ERROR CODE                       #
        FUNC NS$CHD C(4);    # CONVERT TO 4 DISPLAY HEX CHAR           #
        END 
 
      ITEM INDEX      I;     # LOOP VARIABLE                           #
      ITEM STAT       U;     # RETURN STATUS FROM DEFINE               #
      ITEM TEMP       C(4);  # TEMPORARY                               #
 
CONTROL EJECT;
 
      $BEGIN
      NS$DBG("NDF");         # TRACE CALL                              #
      $END
 
      ERRCODE = 0;
      STAT = 1; 
 
      FOR INDEX = DN STEP 1 WHILE STAT NQ 0 
        AND INDEX LQ (MAX$NDFDN+DN) # TRY MAXIMUM 256 TIMES            #
      DO
        BEGIN 
# 
        FORMAT PERMANENT FILE NAME OF NDF 
# 
        C<0,2>NDFPFN = "NP";             # NDF FILE IDENTIFIER         #
        TEMP = NS$CHD(INDEX); # CONVERT TO DISPLAY HEXADECIMALS        #
        C<2,2>NDFPFN = C<2,2>TEMP; # DUMP INDEX IN DISPLAY HEX         #
        C<4,3>NDFPFN = NIN; # DISPLAY CODE DECIMAL NIN                 #
# 
        DEFINE NDF AS A PRIVATE DIRECT ACCESS PERMANENT FILE
# 
        STAT = DEFINE(NDFPFN,NDFPFN,NDF$PW,NDF$CT,NDF$MODE,NDF$AC); 
        END 
 
      IF STAT NQ 0
      THEN                               # DUMP INDEX FULL             #
        BEGIN 
        ERRCODE = NS$FEC(EC"ERR$DN",0); 
        END 
 
      DN = B<52,8>INDEX; # UPDATE DUMP NUMBER                          #
 
      RETURN; 
      END 
      TERM