Retro1.org codex

*DECK NVFTRLC 
USETEXT TEXTSS
USETEXT TEXTNVF 
USETEXT TXTANVF 
USETEXT TXSMNVF 
USETEXT TXTAPSS 
USETEXT TXTSUSS 
PROC NVFTRLC(PT,SMOUT,ERKOD); 
# TITLE - NVFTRLC - REFUSE LOAN CONNECTION REQUEST #
      BEGIN # NVFTRLC # 
# 
**    NVFTRLC - REFUSE LOAN CONNECTION REQUEST. 
* 
*     C. BRION  83/11/02. 
* 
*     THIS PROCEDURE IS RESPONSIBLE FOR RESTORING THE VCB BUFFER, 
*     ISSUING A VCB WRITE REQUEST, ISSUING A CR/RCN/A SM OR CR/SWH/R
*     SM, RELEASING THE PTAC ENTRY SPACE IF RCN/A ISSUED AND RELEASING
*     THE SPTAC ENTRY SPACE IF IT EXISTS. 
* 
*     NVFTRLC(PT,SMOUT,ERKOD) 
* 
*     ENTRY:  
*       PT = ENTRY ORDINAL OF PTAC
*       SMOUT = FLAG INDICATING WHETHER A CR/RCN/A OR CR/SWH/R SM 
*               SHOULD BE ISSUED. 
*       ERKOD = ERROR CODE THAT IS TO BE STORED INTO THE OUTGOING SM. 
* 
* 
*     EXIT: 
*       A CR/RCN/A OR CR/SWH/R SM WILL BE ISSUED.  THE VCB WRITE REQUEST
*       MAY BE ISSUED, THE SPTAC TABLE ENTRY SPACE WILL BE RELEASED AND 
*       THE PTAC MAY BE RELEASED. 
# 
      CONTROL EJECT;
 
# 
****  PROC NVFTRLC XREF LIST
# 
      XREF
        BEGIN 
        PROC NVFUMQE;                    # MAKE QUEUE ENTRY            #
        PROC SSTRTS;                     # SS-RELEASE TABLE SPACE      #
        FUNC XSFW  C(7);                 # SPACE FILL WORD             #
        END 
# 
****
# 
 
 
      ITEM ADDR         I;               # ADDRESS OF VCB WR REQ Q NTRY#
      ITEM ERKOD        I;               # ERROR CODE FOR SM OUT       #
      ITEM I            I;               # LOOP VARAIABLE              #
      ITEM LEN          I;               # LEN OF VCB WR REQ Q NTRY    #
      ITEM PT           I;               # PTAC ENTRY ORDINAL          #
      ITEM SMOUT        B;               # TYPE OF SM OUT INDICATOR    #
                                         # TRUE = RCN, FALSE = SWH     #
 
# 
*     IF CR/RCN/A IS TO BE SENT, SET THE CR/RCN/A FLAG IN THE PTAC
*     TABLE.
# 
      IF SMOUT
      THEN
        BEGIN 
        PTA$RCNA[PT] = TRUE;
# 
*     CLEAR VCB BUFFER. 
# 
        P<VCBBUF> = LOC(MSGBUF[0]); 
        FOR I = 0 STEP 1 UNTIL VCBSIZ$
        DO
          BEGIN 
          MSG$WORD[I] = 0;
          END 
# 
*     RESTORE VCB FROM PTAC ENTRY.
# 
        VCB$CACA[0]   = PTA$CACA[PT]; 
        VCB$ALIFAM[0] = PTA$ALIFAM[PT]; 
        VCB$FAMIND[0] = PTA$FAMIND[PT]; 
        VCB$ALIUSR[0] = PTA$ALIUSR[PT]; 
        VCB$USRIND[0] = PTA$USRIND[PT]; 
        VCB$ALIAPP[0] = PTA$ALIAPP[PT]; 
        VCB$APPIND[0] = PTA$APPIND[PT]; 
        VCB$VDSF[0]  = PTA$VDSF[PT];
        VCB$PRIAN[0] = 0; 
        VCB$RCNA[0]  = PTA$RCNA[PT];
        VCB$LCF[0]   = PTA$LCF[PT]; 
        VCB$TN[0]    = PTA$TN[PT];
        VCB$HW[0]    = PTA$HW[PT];
        VCB$VTP[0]   = PTA$VTP[PT]; 
        VCB$ICF[0]   = PTA$ICF[PT]; 
        VCB$ALIF[0]  = PTA$ALIF[PT];
        VCB$VCB[0]   = PTA$VCB[PT]; 
        VCB$NET[0]   = PTA$NET[PT]; 
        VCB$CNTIME[0] = PTA$CNTIME[PT]; 
        VCB$SWTIME[0] = PTA$SWTIME[PT]; 
        VCB$FWORD[0] = PTA$FWORD[PT]; 
        VCB$UWORD[0] = PTA$UWORD[PT]; 
        VCB$DT[0]    = PTA$DT[PT];
        VCB$TC[0]    = PTA$TC[PT];
        VCB$AACN[0]  = CRAACN[0]; 
        VCB$SWAPAN[0] = PTA$PRIAN[PT];
        VCB$UBZ[0]   = PTA$UBZ[PT]; 
        VCB$XBZ[0]   = PTA$XBZ[PT]; 
        VCB$DBZ[0]   = PTA$DBZ[PT]; 
        VCB$SDT[0]   = PTA$SDT[PT]; 
        VCB$DO[0]    = PTA$DO[PT];
        VCB$SL[0]    = PTA$SL[PT];
# 
*     ISSUE VCB WRITE REQUEST.
# 
        ADDR = PTA$VCB[PT]; 
        LEN = VCBSIZ$ * 10; 
        NVFUMQE(P<VRQ>,VCBBUF[0],0,ADDR,LEN); 
        END 
# 
*     RELEASE SPTAC TABLE SPACE IF IT EXISTS. 
# 
      IF PTA$SPTAC[PT]
      THEN
        BEGIN 
        FOR I = 0 STEP SPT$ESIZE[I] WHILE 
          ((I LS SPTACL) AND (SPT$VCB[I] NQ PTA$VCB[PT])) 
        DO
          BEGIN 
          END 
        IF I LS SPTACL
        THEN
          BEGIN 
          SSTRTS(P<SPTAC>,I,SPT$ESIZE[I]);
          END 
        END 
# 
*     CLEAR THE OUTGOING SM AREA. 
# 
      FOR I = 0 STEP 1 UNTIL MSBFNVL
      DO
        BEGIN 
        MSG$WORD[I] = 0;
        END 
# 
*     ISSUE EITHER A CR/SWH OR CR/RCN/A SM. 
# 
      IF SMOUT
      THEN
        BEGIN 
# 
*     CR/RCN/A TO BE SENT.
# 
        PFCSFC[1] = CRRCN;
        ADDR = 0; 
        LEN = 1;
        EB[1] = TRUE; 
        CRRRCN[1] = ERKOD;
        CRACN[1] = PTA$ACN[PT]; 
        NVFUMQE(P<CTQ>,APSM[1],APPPR$,ADDR,LEN);
# 
*     RELEASE PTAC ENTRY SPACE. 
# 
        PT = PT * PTACSIZ$; 
        SSTRTS(P<PTAC>,PT,PTACSIZ$);
        END 
      ELSE
        BEGIN 
# 
*     CR/SWH/R SM TO BE SENT. 
# 
        CRSAHMT[1] = PTA$AHMT[PT];
        CRSAHDS[1] = PTA$AHDS[PT];
        CRSAAWC[1] = PTA$AAWC[PT];
        CRSATWD[1] = PTA$ATWD[PT];
        CRSWOCN[1] = PTA$OCN[PT]; 
        PFCSFC[1]  = CRSWH; 
        CRNACN[1]  = PTA$ACN[PT]; 
        CRABL[1]   = PTA$ABL[PT]; 
        CRSWSDT[1] = PTA$SDT[PT]; 
        CRDT[1]    = PTA$DT[PT];
        CRSWTC[1]  = PTA$TC[PT];
        CRSWIC[1]  = PTA$ICF[PT]; 
        CRSWORD[1] = PTA$DO[PT];
        CRSTNAM[1] = XSFW(PTA$TN[PT]);
        CRSWPW[1]  = PTA$PW[PT];
        CRSWPL[1]  = PTA$PL[PT];
        CRSWSL[1]  = PTA$SL[PT];
        CRSWDBZ[1] = PTA$DBZ[PT]; 
        CRSWXBZ[1] = PTA$XBZ[PT]; 
        CRSWUBZ[1] = PTA$UBZ[PT]; 
        CRSWHW[1]  = PTA$HW[PT];
        CRSWVTP[1] = PTA$VTP[PT]; 
        CRSWAN[1]  = PTA$PRIAN[PT]; 
        CRSWFAM[1] = XSFW(PTA$FNAM[PT]);
        CRSWFO[1]  = PTA$FORD[PT];
        CRSWUN[1]  = XSFW(PTA$UNUM[PT]);
        CRSWUI[1]  = PTA$UIDX[PT];
        CRSWLST[1]  = ERKOD;
 
# 
*     CLEAR ACN FIELD OF PTAC ENTRY AS ACN COULD BE REUSED AFTER A
*     CR/SWH REQUEST IS ISSUED. 
# 
        PTA$ACN[PT] = 0;
        NVFUMQE(P<CTQ>,APSM[1],APPPR$,0,LCRSWH);
        END 
 
      END # NVFTRLC # 
 TERM