Retro1.org codex

*DECK NFETCH
     FUNC    NFETCH(BARRAY,SYMBOL)     I; 
      BEGIN 
*IF,DEF,IMS 
 #
*1DC  NFETCH
*     1.PROC NAME     AUTHOR     DATE 
*       NFETCH        PETER TAM  6/24/77
* 
*     2.FUNCTIONAL DESCRIPTION
*     NFETCH DOES A TABLE LOOKUP OF THE REQUIRED ITEM 
*     TO OBTAIN ITS COORINATES (I.E INDEX WITHIN ARRAY, 
*     STARTING BIT WITHIN WORD AND LENGTH IN BITS)
*     AND RETURNS TO THE CALLER THE REQUIRED FIELD. 
*     THE TABLE CONTAINING THIS INFORMATION IS ASSEMBLED
*     IN THE COMPASS ROUTINE NP$SYM , WHICH IN TURN 
*     USES THE ITEM, DEF AND STATUS MACROS DEFINED IN NETMAC. 
* 
*     3.METHOD USED 
*     NFETCH IS A SYMPL ROUTINE CALLABLE BY FTN CALLING SEQUENCES 
*     TO ACCESS SUPERVISORY MESSAGE FIELDS IN SYMPL COMMON DECKS. 
*     IT IS TO BE ACCESSED AS AN FTN INTEGER FUNCTION 
*        I=NFETCH(ARRAY,ITEM) 
*     WHERE ARRAY IS AN ARRAY CONTAINING THE SUPERVISORY MESSAGE
*     ITEM IS THE LEFT JUSTIFIED ZERO FIELD DISPLAY CODE NAME 
*     OF THE REQUIRED FIELD IN THE SUPERVISORY MESSAGE. 
* 
*     4.ENTRY CONDITIONS
*     SEE FUNCTIONAL DESCRIPTION
* 
*     5. EXIT CONDITIONS
*     THE VALUE OF THE FUNCTION WILL BE SET TO THE FIELD SPECIFIED. 
* 
*     6.COMDECKS CALLED 
*        NP$CRT 
* 
*     7.ROUTINES CALLED 
*        NP$ERR 
* 
*     8.DAYFILE MESSAGES
*        NETWORK APPLICATION ABORTED, RC = 68.
*        NFETCH: ILLEGAL FIELD MNEMONIC.
* 
 #
*ENDIF
*CALL NP$CRT
        XREF    PROC    NP$ERR; 
        XREF    ITEM    NP$SYME    U; 
        XREF    ARRAY   NP$SYM[0:300]   S(2); 
          BEGIN 
            ITEM  SYMNAME         C(0,0,7); 
            ITEM  SYMST           U(0,54,6);
            ITEM  SYMWORD         U(1,6,12);
            ITEM  SYMBIT          U(1,18,12); 
            ITEM  SYMLGTH         U(1,30,12); 
            ITEM  SYMVAL          U(1,0,60);
          END 
        ARRAY  BARRAY[0:O"77777"]   S(1); 
          ITEM  CONTENTS    U;
        ITEM  SYMBOL        U;
        ITEM  I             U;
        ITEM  J             U;
        FOR  I = 0  STEP  1  UNTIL NP$SYME  DO
          BEGIN 
            IF  SYMNAME[I] EQ C<0,7>SYMBOL
              THEN BEGIN
                J           = SYMST[I]; 
                IF  J EQ 4
                  THEN BEGIN
                    NFETCH  = SYMVAL[I];
                    RETURN; 
                  END 
                IF  J EQ 3 OR  J EQ 2 
                  THEN BEGIN
                    NFETCH  = 
                    B<SYMBIT[I],SYMLGTH[I]>CONTENTS[SYMWORD[I]];
                    RETURN; 
                  END 
                IF  J EQ 1
                  THEN BEGIN
                    NFETCH =
                    C<SYMBIT[I],SYMLGTH[I]>CONTENTS[SYMWORD[I]];
                    RETURN; 
                 END
              END 
         END
        NP$ERR("68");                  # ILLEGAL FIELD MNEMONIC.       #
      END 
      TERM