Retro1.org codex

*DECK     XSAPPDL 
USETEXT NIPDEF
USETEXT PARAMS
USETEXT SWAPIN
 PRGM XSAPPDL;               # DELINK (NO ACB) SWAPIN ENTRY            #
 
 STARTIMS;
 #
*1DC  XSAPPDL 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        XSAPPDL             E. GEE              77/08/10 
* 
*     2. FUNCTIONAL DESCRIPTION.
*           DELINK ENTRY FROM (NO ACB) SWAPIN CHAIN 
* 
*     3. METHOD USED. 
*          IF ONLY ONE ENTRY IN SWAPIN CHAIN, CLEAR PTRS IN SWAPIN
*          ELSE UPDATE BACKWARD POINTER IN NEXT ENTRY AND 
*               UPDATE FORWARD POINTER IN PREVIOUS ENTRY
* 
*     4. ENTRY PARAMETERS.
*          PARAMS1           ADDRESS OF ENTRY TO DELINK 
* 
*     5. EXIT PARAMETERS. 
*          NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        NIPDEF    OSSIZE    PARAMS    SWAPIN 
* 
*     7. ROUTINES AND OVERLAYS CALLED.
*          XTRACE            RECORD PROCEDURE CALLS 
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
* 
*        THIS PROGRAM IS A SECONDARY OVERLAY LOADED BY SUBROUTINE 
*        OVLCALL.  WHEN EXECUTION HAS COMPLETED, A JUMP IS MADE TO
*          LOCATION RJMAIN TO RETURN TO THE CALLING PROGRAM.
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
* 
*        THIS OVERLAY IS CALLED BY XSAPPRC AND HAPFAIL. 
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF 
   BEGIN
   PROC XTRACE;              # RECORD PROCEDURE CALLS                  #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVLCALL               #
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM NEXT;                  # ADDR OF NEXT ENTRY IN SWAPIN CHAIN      #
 ITEM PREV;                  # ADDR OF PREVIOUS ENTRY IN SWAPIN CHAIN  #
 ITEM SENTRY;                # ADDR OF SWAPIN ENTRY TO DELETE          #
 
#**********************************************************************#
 
      BEGIN 
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("APPDL") ; 
      CONTROL FI; 
 
      SENTRY = PARAMS1;      # ADDR OF SWAPIN ENTRY TO DELETE          #
      P<SWPIE> = SENTRY;
      NEXT = SWPINFP[0];     # ADDR OF NEXT ENTRY IN SWAPIN CHAIN      #
      PREV = SWPINBP[0];     # ADDR OF PREVIOUS ENTRY IN SWAPIN CHAIN  #
# 
      CHECK IF ONLY ONE ENTRY IN SWAPIN CHAIN 
# 
      IF SWAPINFP EQ SWAPINBP 
      THEN                   # ONLY ONE ENTRY IN CHAIN                 #
        BEGIN 
        SWAPINFP = 0;        # ZERO SWAPIN CHAIN FORWARD PTR           #
        SWAPINBP = 0;        # ZERO SWAPIN CHAIN BACKWARD PTR          #
        END 
      ELSE                   # MORE THAN ONE ENTRY IN CHAIN SO DELINK  #
# 
      UPDATE BACKWARD PTR IN NEXT ENTRY 
# 
        BEGIN 
        IF NEXT EQ LOC(SWAPINFP)
        THEN                 # ENTRY TO DELETE IS LAST ONE IN CHAIN    #
          SWAPINBP = PREV;   # UPDATE SWAPIN BACKWARD PTR              #
        ELSE
          BEGIN 
          P<SWPIE> = NEXT;
          SWPINBP[0] = PREV; # UPDATE BACKWARD PTR OF NEXT ENTRY       #
          END 
# 
        UPDATE FORWARD POINTER IN PREVIOUS ENTRY
# 
        IF PREV EQ LOC(SWAPINBP)
        THEN                 # ENTRY TO DELETE IS FIRST ONE IN CHAIN   #
          SWAPINFP = NEXT;   # UPDATE SWAPIN FORWARD PTR               #
        ELSE
          BEGIN 
          P<SWPIE> = PREV;
          SWPINFP[0] = NEXT; # UPDATE FORWARD PTR OF PREVIOUS ENTRY    #
          END 
        END 
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END 
TERM