Retro1.org codex

*DECK NP$PUT
USETEXT AIPDEF
USETEXT NP$GETS 
USETEXT NP$MODE 
USETEXT NP$NWL
USETEXT NP$NWNC 
USETEXT NP$PUTS 
*IF,DEF,DEBUG 
USETEXT NP$DB 
*ENDIF
*IF,DEF,STAT
USETEXT NP$STAT 
USETEXT NP$ONAM 
*ENDIF
PROC NP$PUT;
*IF DEF,IMS 
 #
*1DC  NP$PUT
* 
*     1. PROC NAME           AUTHOR              DATE 
*        NP$PUT              J.C. LEE            78/10/10 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        THIS ROUTINE IS CALLED BY NETPUT AND NETPUTF TO BUILD A PUT
*        REQUEST IN THE NWL WORKLIST AND SEND THE WORKLIST TO NIP 
*        WHEN APPROPRIATE.
* 
*     3. METHOD USED
*        FORMATS A NETPUT ENTRY IN THE WORKLIST. THE MESSAGE TEXT 
*        LENGTH IS COMPUTED FROM THE APPLICATION CHARACTER TYPE AND 
*        THE TEXT LENGTH IN CHARACTERS IN THE APPLICATION BLOCK 
*        HEADER WORD. IF THERE IS ROOM IN THE WORKLIST, THE TEXT IS 
*        COPIED FROM THE TEXT AREA TO THE NWL.  IF THERE IS NOT ENOUGH
*        ROOM FOR THE MESSAGE IN THE WORKLIST, PUT THE ADDRESS WHERE
*        THE TEXT CAN BE FOUND IN THE WORKLIST, AND SEND IT TO NIP. 
* 
*        IF THE DOWNLINE MESSAGE BUFFERING FEATURE IS IN USE AND THERE
*        IS NOT ENOUGH ROOM FOR THE MESSAGE IN THE WORKLIST, SEND THE 
*        EXISTING WORKLIST TO NIP AND THEN ATTEMPT TO STORE THE MESSAGE 
*        IN THE WORKLIST.  IF THERE IS STILL NOT ENOUGH ROOM FOR THE
*        MESSAGE, PUT THE ADDRESS OF THE TEXT IN THE WORKLIST AND SEND
*        IT TO NIP. 
* 
*     4. ENTRY CONDITIONS 
*        ACLN - NUMBER OF FRAGMENTED BUFFERS
*        IAM - ROUTINE CURRENTLY EXECUTING
*        LOC$HA - ADDRESS OF HEADER AREA
*        LOC$TA - ADDRESS OF TEXT AREA
*        OPCODE - OPCODE VALUE
*        NEXT - NEXT AVAILABLE SPACE POINTER IN WORKLIST
*        SPACE$LEFT - NUMBER OF CELLS AVAILABLE IN WORKLIST 
* 
*     5. EXIT CONDITIONS
*        NEXT - UPDATE TO NEXT AVAILABLE SPACE POINTER IN WORKLIST
*        SPACE$LEFT - UPDATE TO NUMBER OF AVAILABLE CELLS IN WORKLIST 
*        I$FLAG - TRUE IF INPUT DATA QUEUED IN NIP
*        S$FLAG - TRUE IF A NON-EMPTY SMB OR SM QUEUED IN NIP 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        AIPDEF    NP$CRT    NP$DB     NP$GETS
*        NP$MODE   NP$NWL    NP$PUTS   NP$STAT
* 
*     7. ROUTINES CALLED
*        NP$DBG  - FORMAT AND LOG DEBUG MESSAGES IN ZZZZZDN 
*        NP$ERR  - ERROR PROCESSOR
*        NP$SEND - SEND WORKLIST TO NIP 
*        NP$SN   - INCREMENT STATISTICS COUNTERS
*        NP$UCV  - UPDATE CONTROL VARIABLES 
*        NP$USI  - UPDATE S AND I BITS IN NSUP
* 
*     8. DAYFILE MESSAGES 
*        NETWORK APPLICATION ABORTED, RC = 32.
*        NP$PUT: REQUEST INVALID BEFORE NETON.
* 
*        NETWORK APPLICATION ABORTED, RC = 43.
*        NP$PUT: PREVIOUS REQUEST INCOMPLETE. 
* 
* 
 #
*ENDIF
 
   BEGIN
 
*CALL NP$CRT
    XREF
      BEGIN 
*IF DEF,DEBUG 
      PROC NP$DBG;                      # LOGS MESSAGES TO ZZZZZDN     #
*ENDIF
      PROC NP$ERR;                      # ERROR PROCESSOR              #
      PROC NP$SEND;                     # SEND NWL TO NIP              #
      PROC NP$UCV;                      # UPDATE CONTROL VARIABLES     #
      PROC NP$USI;                      # UPDATE S AND I BITS IN NSUP  #
*IF DEF,STAT
      PROC NP$SN;                       # INCREMENT STATISTICS COUNTERS#
*ENDIF
      END 
# 
      LOCAL VARIABLES 
# 
      BASED ARRAY MEM P(1); 
        BEGIN 
        ITEM MEMWORD I; 
        END 
 
      ITEM SAVEMODE  B;                # SAVE VALUE OF PARALLEL MODE   #
 
 
#**********************************************************************#
# 
      NP$PUT EXECUTION BEGINS HERE
# 
      IF NOT ACCEPTED 
      THEN
        NP$ERR("32");                  # REQUEST INVALID BEFORE NETON. #
      IF DEFER$PRO
      THEN
        NP$ERR("43");                  # PREVIOUS REQUEST INCOMPLETE.  #
*IF DEF,STAT
# 
      UPDATE STATISTICS COUNTERS
# 
      NP$SN(IAM);                       # INCREMENT STATISTICS COUNTER #
*ENDIF
*IF DEF,DEBUG 
# 
      LOG MESSAGE ON DEBUG FILE ZZZZZDN 
# 
      DB$OP = OPCODE; 
 
      NP$DBG; 
 
*ENDIF
      NWL[NEXT] = 0;                    # CLEAR NWL OPCODE WORD        #
      NWL$ID[NEXT] = AWLID; 
      NWL$OP[NEXT] = OP$PUT;
      P<MEM> = LOC$HA;                  # HEADER AREA                  #
      ABH[NEXT+1] = MEMWORD;
*IF DEF,STAT
 
      IF ABH[NEXT+1] GR 0 
      THEN
        BEGIN 
        J = TYPE"ODB" + ABH$ABT[NEXT+1] - 1;
        NP$SN(J); 
        END 
 
*ENDIF
# 
      COMPUTE TEXT LENGTH IN WORDS
# 
      ACT = ABH$ACT[NEXT+1];
      IF (ACT EQ 0) OR                  # ACT VALUE = 0                #
         (ACT GR CT6DISPLAY)            # ACT VALUE TOO LARGE          #
      THEN                              # INVALID ACT VALUE SPECIFIED  #
        BEGIN 
        TLW = ABH$TLC[NEXT+1];          # FAKE TLW VALUE               #
        END 
      ELSE                              # VALID CHAR TYPE SPECIFIED    #
        BEGIN 
        TLW = (2 * ABH$TLC[NEXT+1] + NW$ROUND[ACT]) / NW$FACT[ACT]; 
        END 
# 
      SET UP THE NWL ENTRY
# 
      BS = OPABHSIZ;                    # INITIALIZE NWL ENTRY SIZE    #
      ISSUE = TRUE;                     # INITIALIZE FLAG TO SEND NWL  #
      IF OPCODE EQ OP$PUTF
      THEN
        RETURN ;
      IF TLW LQ (SPACE$LEFT - GMMESIZE - NXTSIZE) 
      THEN
 
        BEGIN                           # ROOM FOR OP,ABH,TEXT AND GSM #
        J = NEXT + OPABHSIZ;            # BEGINNING ADDR FOR TEXT IN WL#
        P<MEM> = LOC$TA;                # TEXT AREA ADDRESS IN APP FL  #
        FOR I=0 STEP 1 UNTIL (TLW-1) DO 
          NWL[I+J] = MEMWORD[I];        # COPY TEXT TO NWL             #
        BS = TLW + OPABHSIZ;            # RESET NWL ENTRY SIZE         #
# 
    WORKLIST IS SENT TO NIP IF THERE IS NOT ENOUGH ROOM FOR ANOTHER 
    PUT ENTRY PLUS A GSM EBTRY OR IF IT IS A PUT FROM SUPERVISOR. 
# 
        ISSUE = (SPACE$LEFT - BS) LS (NXTSIZE + GMMESIZE);
        END 
 
      ELSE                              # NOT ENOUGH ROOM FOR MSG IN   #
        BEGIN                           # WORKLIST                     #
        IF DOWNUSE
        THEN                            # DOWNLINE MSG BUFFERING IN USE#
          BEGIN 
          SAVEMODE = PARALLEL;          # SAVE CURRENT MODE            #
          PARALLEL = FALSE;             # TEMP. TURN OFF PARALLEL MODE #
          NP$SEND;                      # SEND CURRENT WORKLIST TO NIP #
          PARALLEL = SAVEMODE;          # RESTORE MODE                 #
 
          NWL[NEXT] = 0;                # RESTORE OP CODE AND ABH IN   #
          NWL$ID[NEXT] = AWLID;         # WORKLIST, AS THESE WERE NOT  #
          NWL$OP[NEXT] = OP$PUT;        # SENT TO NIP.                 #
          ABH[NEXT+1] = MEMWORD;
 
          IF TLW LQ (SPACE$LEFT - GMMESIZE - NXTSIZE) 
          THEN                          # NOW ROOM FOR MSG + HDR + GSM #
            BEGIN 
            J = NEXT + OPABHSIZ;        # BEGINNING ADDR FOR TEXT IN WL#
            P<MEM> = LOC$TA;            # TEXT AREA IN APP FL          #
            FOR I = 0 STEP 1 UNTIL (TLW-1)
            DO
              BEGIN 
              NWL[I+J] = MEMWORD[I];    # COPY TEXT TO NWL             #
              END 
            BS = TLW + OPABHSIZ;        # RESET NWL ENTRY SIZE         #
                                        # DECIDE IF WL GOES TO NIP NOW #
            ISSUE = (SPACE$LEFT - BS) LS (NXTSIZE + GMMESIZE);
            END 
          ELSE                          # MSG IS LARGER THAN BUFFER    #
            BEGIN 
            NWL$TA[NEXT] = LOC$TA;      # SET TO TEXT AREA ADDRESS     #
            END 
          END 
        ELSE                            # DOWNLINE BUFFERING NOT IN USE#
          BEGIN 
          NWL$TA[NEXT] = LOC$TA;        # SET TO TEXT AREA ADDRESS     #
          END 
        END 
 
# 
      UPDATE HEADER AND CONTROL VARIABLES 
# 
      NP$UCV; 
 
      IF ISSUE
      THEN
        NP$SEND;                        # SEND WORKLIST TO NIP         #
 
# 
      UPDATE THE S AND I BITS IN THE NSUP WORD
# 
      NP$USI; 
      RETURN;                           # RTN TO CALLER FOR COMPLETION #
   END # NP$PUT # 
TERM