Retro1.org codex

*DECK NSTORE
      PROC  NSTORE(BARRAY,SYMBOL,VALUE);
      BEGIN 
*IF,DEF,IMS 
 #
*1DC  NSTORE
*     1.PROC NAME     AUTHOR     DATE 
*       NFETCH        PETER TAM  5/24/77
* 
*     2.FUNCTIONAL DESCRIPTION
*     NSTORE IS A SYMPL ROUTINE CALLABLE BY AN FNT CALLING
*     SEQUENCE, TO STORE FIELDS IN SUPERVISORY MESSAGES.
*        CALL NSTORE(ARRAY,F1,F2) 
*     WHERE 
*        ARRAY IS THE FWA OF THE SUPERVISORY MESSAGE
*        F1 IS THE LEFT JUSTIFIED ZERO FILLED DISPLAY CODED 
*           NAME OF THE FIELD TO BE STORED
*        F2 IS THE LEFT JUSTIFIED ZERO FILLED DISPLAY CODED 
*           NAME OF THE VALUE OF THE FIELD TO BE STORED 
*     F2 MAY ALSO BE A CONSTANT VALUE TO BE STORED
* 
*     3.METHOD USED 
*     NSTORE WILL STORE F2 IN FIELD F1 IN THE ARRAY 
* 
*     IT USES A TABLE LOOK-UP TECHNIQUE TO FIND THE 
*        A. VALUE OF F2 
*        B. THE DESCRIPTION OF WHERE IN THE ARRAY F1 IS 
* 
*     THESE TABLES ARE ASSEMBLED INTO THE COMPASS ROUTINE 
*     NP$SYM, WHICH USES THEIR DEFINITION IN NETMAC.
* 
* 
*     4.ENTRY CONDITIONS
*     ARRAY CONTAINS THE SUPERVISORY MESSAGE
*     F1 IS THE DISPLAY CODE NAME OF THE REQUIRED FIELD 
* 
*     5.EXIT CONDITIONS 
*     THE VALUE F2 WILL BE STORED IN FIELD F1 OF ARRAY
* 
*     6.COMDECKS CALLED 
*        NP$CRT 
* 
*     7.ROUTINES CALLED 
*     NFETCH
*        NP$ERR 
* 
*     8.DAYFILE MESSAGES
*        NETWORK APPLICATION ABORTED, RC = 69.
*        NSTORE: ILLEGAL FIELD MNEMONIC.
* 
* 
 #
*ENDIF
*CALL NP$CRT
        XREF    FUNC    NFETCH    I;
        XREF PROC       NP$ERR; 
        XREF    ITEM    NP$SYME             U;
        XREF    ITEM    NP$SYMI             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    VALUE                   I;
        ITEM    SYMBOL                  U;
        ITEM    I                       U;
        ITEM    J                       U;
        ITEM    II                      U;
          II  =  (LOC(NP$SYMI)-LOC(NP$SYM))/2;
          FOR I = II 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
        NP$ERR("69");                  # ILLEGAL FIELD MNEMONIC.       #
            END 
            IF  J EQ 3 OR J EQ 2  THEN BEGIN
              IF VALUE NQ 0 
              AND B<42,18>VALUE EQ 0
              AND SYMLGTH[I] LQ 18
              THEN BEGIN
                VALUE  =    NFETCH(0,VALUE);
              END 
              B<SYMBIT[I],SYMLGTH[I]>CONTENTS[SYMWORD[I]]  =  VALUE;
              RETURN; 
            END 
            IF  J EQ 1 THEN BEGIN 
              IF VALUE NQ 0 
              AND B<42,18>VALUE EQ 0
              AND SYMLGTH[I] LQ 18
              THEN BEGIN
                VALUE  =    NFETCH(0,VALUE);
              END 
             B<SYMBIT[I],6*SYMLGTH[I]>CONTENTS[SYMWORD[I]]  =  VALUE; 
              RETURN; 
            END 
          END 
        END 
        NP$ERR("69");                  # ILLEGAL FIELD MNEMONIC.       #
      END 
      TERM