Retro1.org codex

*DECK HGETNWL 
USETEXT NIPDEF
USETEXT NWLHEAD 
USETEXT SYSCOMD 
      PROC HGETNWL(NEXTNWL); # UPDATE RA.SSC TO PROVIDE NEW NWL        #
 STARTIMS;
 #
*1DC  HGETNWL 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HGETNWL                                 82/12/13 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        UPDATE RA.SSC TO PROVIDE NEW NWL 
* 
*     3. METHOD USED
*        ALLOCATE A SECOND BUFFER TO SUPPORT DOUBLE 
*        BUFFERING OF INCOMING WORKLISTS. 
* 
*     4. ENTRY PARAMETERS 
*        NEXTNWL - FWA OF NEXT NWL BUFFER 
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF     NWLHEAD     SYSCOMD 
* 
*     7. ROUTINES CALLED
*        ABORT - ABORT NIP
*        MGETS - ALLOCATE BUFFER
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS PROCEDURE IS CALLED BY ITABS AND HHIR.
 #
 STOPIMS; 
# 
      FORMAL PARAMETERS 
# 
      ITEM NEXTNWL    U;     # FWA OF NEW NWL BUFFER                   #
# 
      EXTERNAL PARAMETERS 
# 
      XREF
        BEGIN 
        PROC MGETS;          # ALLOCATE BUFFER FOR NWL                 #
        PROC ABORT;          # ABORT CONTROL POINT                     #
        PROC XTRACE;         # TRACE PROC CALLS                        #
        END 
# 
      LOCAL PARAMETERS
# 
      ITEM BUFFWA     U;     # FWA OF ASSIGNED BUFFER                  #
      BASED ARRAY SCPBUF [0:0] P(1);
        BEGIN                # SCP BUFFER HEADER                       #
        ITEM SCPB$ID   U(00,00,06); # BUFFER IDENTIFIER                #
        ITEM SCPB$BS   U(00,06,18); # BUFFER SIZE                      #
        ITEM SCPB$NEXT U(00,42,18); # NEXT NWL BUFFER                  #
        ITEM SCPB$HDR  U(00,00,60); # NWL HEADER WORD                  #
        END 
 
      CONTROL IFEQ DEBUG,1; 
      ARRAY MSG$HGNWL [0:0] S(3); 
        BEGIN 
        ITEM MSGTXT C(00,00,28) = 
          ["NIP/HGETNWL-BAD NWL BUFFER."];
        ITEM MSGEND U(02,48,12) = [0];
        END 
      CONTROL FI; 
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("HGNWL");
      CONTROL FI; 
 
      P<SCPBUF> = NEXTNWL;   # FWA OF NEXT NWL BUFFER                  #
 
      CONTROL IFEQ DEBUG,1; 
      IF SCPB$ID[0] NQ NWLIDVALUE 
      THEN                   # NEXT PTR IS NOT A NWL BUFFER            #
        BEGIN                # ABORT NIP                               #
        ABORT(MSG$HGNWL,0);  # ABORT NIP                               #
        END 
      CONTROL FI; 
 
      SSCAP[0] = P<SCPBUF> + BLKHSIZE; # NEXT NWL ADDRESS              #
      SSCLK[0] = FALSE; # ALLOW INCOMING NWL                           #
 
      MGETS(NWLSIZE,BUFFWA,FALSE); # BUFFER AHEAD FOR ANOTHER NWL      #
      SCPB$NEXT[0] = BUFFWA; # SET BUFFER ADDRESS FOR NWL              #
      P<SCPBUF> = BUFFWA ;     # POINTING TO THE SECOND NWL            #
      SCPB$ID[0] = NWLIDVALUE; # SET NWL IDENTIFIER                    #
 
      RETURN; 
      END 
      TERM