Retro1.org codex

*DECK NP$XCMP 
*IF DEF,XFR 
USETEXT AIPDEF
USETEXT NP$GETS 
USETEXT NP$PUTS 
USETEXT NP$NWL
USETEXT NP$STAT 
USETEXT NP$DB 
USETEXT NX$ACBF 
USETEXT NX$ACBX 
USETEXT NX$MSG
 PROC NP$XCMP ; 
 #
**1DC 
*     1. PROC NAME         AUTHOR        DATE 
*        NP$XCMP           L.T.NGUYEN    83/06/03 
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        CLEAN UP FILE TRANSFER CONNECTION. 
* 
*     3. METHOD USED: 
*        SET THE APPLICATION STATUS ACCORDING TO THE REASON CODE. 
*        SEND LIT/SWH BACK TO ORIGINAL LIST NUMBER. 
*        CLEAR ENTRY IN FTT TABLE.
* 
*     4. INPUT PARAMS:  
*        FTTINDEX - INDEX OF CONNECTION TO BE CLEARED UP. 
* 
*     5. EXIT PARAMS: 
*        NONE.
* 
*     6. NOTES: 
* 
 #
      XREF
        BEGIN 
        PROC NP$PUT ; 
        PROC NP$ZRBK ;
        PROC NP$CIO ;                # CALL CIO                        #
        PROC NP$CMFF; 
        FUNC NP$CDD C(10) ;        # CONVERT INTEGER TO DISPLAY CODE   #
        PROC NP$MSG ; 
        END 
      ITEM SCRATCH ;
      ITEM CODE     I;             # OPERATION CODE                    #
      BEGIN 
 
 
 
 
      P<FET$CIO> = FTTFETADR[FTTINDEX] ; # FET OF CIO BUFFER           #
      P<STATUSWORD> = FTTSTATUS[FTTINDEX] ; 
 
      NUMFILEXFR = NUMFILEXFR - 1 ; 
      CODE = CIO$REWIND;         # REWIND THE FILE                     #
      NP$CIO(CODE) ;             # CALL CIO TO OPEN THE FILE           #
 
# 
      SWITCH THIS CONNECTION TO LIST 0
# 
      LST$ACN[0] = FTTACN[FTTINDEX] ; 
      LST$NLIST[0] = 0 ;
      LOC$HA = LOC(OUT$ABH) ; 
      LOC$TA = LOC(LST$SWH) ; 
      OUT$ABHTLC[0] = 1 ; 
      OPCODE = OP$PUT ; 
*IF DEF,STAT,1
      IAM = TYPE"PUT" ; 
      NP$PUT ;
 
# 
      SET APPLICATION STATUS ACCORDING TO THE STATE TABLE REASON CODE.
# 
      STATUSWD[0] = FTTSTRC[FTTINDEX] ; 
 
# 
      RELEASE ALL THE NEEDED BUFFERS ( CIO FET, WORKING FET, CIO BUFFER 
      WORKING BUFFER ) .
# 
# 
      SET XFR COMPLETION FLAG 
# 
      XFR$COM = TRUE; 
      IDFM$LFN[STATUSWD] = FETLFNC[0] ; 
      NP$MSG(IDFM$MSG[STATUSWD],XFRDTYPE);
      NP$ZRBK(LOC(FETWD[0]),0) ;
      IDFM$LFN[STATUSWD] = FETLFNC[0] ; 
 
      NP$CMFF(P<FET$CIO>) ; 
 
# 
      FREE THE FTT ENTRY. 
# 
      FTTACN[FTTINDEX] = 0 ;
 
      RETURN ;
      END 
      TERM
 
*ENDIF