*DECK XFRINIT 
USETEXT COMCBEG 
USETEXT COMADEF 
USETEXT COMACBF 
USETEXT COMACBX 
USETEXT COMACST 
USETEXT COMAFET 
PROC XFRINIT (ACN, FILENAME, OPCODE, STATIS, DATADEC, TIMEOUT,
              (NOWAIT) ); 
# TITLE XFRINIT - INITIALIZE FILE TRANSFER.  #
  
      BEGIN  # XFRINIT #
  
# 
**    XFRINIT - INITIALIZE FILE TRANSFER. 
* 
*     XFRINIT PERFORMS THE INITIALIZATION REQUIRED PRIOR TO ACTUAL DATA 
*     TRANSFER. 
* 
*     PROC XFRINIT (ACN, FILENAME, OPCODE, STATIS, DATADEC, TIMEOUT), 
*                   (NOWAIT) )
* 
*     ENTRY      ACN        - APPLICATION CONNECTION NUMBER.
*                FILENAME   - FILE NAME TO BE TRANSFERRED, IN DISPLAY 
*                             CODE, 7 CHARACTERS MAXIMUM. 
*                OPCODE     = 0, FILE IS TO BE READ FROM THE NETWORK. 
*                           .NE. 0, FILE TO BE WRITTEN TO NETWORK.
*                STATIS     - CALLING PROGRAM REPLY STATUS
*                             WORD. 
*                DATADEC    - FORMAT OF DATA BEING TRANSFERRED -
*                           - 0, UH 
*                           - 1, UU 
*                           - 2, US 
*                           - 3, C6 
*                           - 4, C8.
*                TIMEOUT    - TIME IN SECONDS TO WAIT FOR A FUNCTION
*                             RESPONSE BEFORE TIMING OUT. 
*                NOWAIT     - NO WAIT FLAG. 
* 
*     EXIT       NONE.
* 
*     PROCESS    INITIALIZE VALUES IN COMMON BLOCKS COMACBX AND COMADFM.
*                  IF COMACBX HAS NOT BEEN INTIALIZED,
*                  THEN 
*                    INITIALIZE VARIOUS DATA CELLS IN COMACBX.
*                  IF 1ST TRANSFER REQUEST: 
*                    CALL RECOVR TO ACTIVATE FIPRPV (REPRIEVE). 
*                    CALL CMMAGR TO ASSIGN CMM GROUP NAME.
*                  CALL CHKFTT TO OBTAIN EMPTY FTT ENTRY. 
*                  IF NO FTT ENTRY FOUND: 
*                    RETURN.
*                  CALL GMEMCMM TO OBTAIN MEMORY FOR FETS, BUFFERS, 
*                                              AND RHF PARAMETER BLOCK. 
*                  SET FTTTIMEOUT = TIMEOUT.
*                  SET FTTDIRECN = OPCODE.
*                  SET FTTSTATADR = STATUS ADDRESS. 
*                  SET FTTDXPA = OK (P$ES$OK).
*                  SET FTTERRORD = 0 (NO ERROR).
*                  CALL BUILDFT TO BUILD FETS, ALLOCATE BUFFER, AND 
*                    BUILD RHF NETXFR REQUEST/REPLY PARAMETER BLOCK.
*                  CALL CALLCIO TO OPEN LOCAL FILE WITHOUT RECALL.
*                  IF SENDING FILE: 
*                    SET FTTSTATE = WAITING FOR FILE OPEN.
*                    CALL PUTLEV7 TO SEND SS COMMAND. 
*                  ELSE:  
*                    SET FTTSTATE = WAITING SS COMMAND. 
* 
# 
      ITEM ACN        I;             # APPLICATION CONNECTION NUMBER #
      ITEM FILENAME   C(7);          # FILE NAME #
      ITEM OPCODE     I;             # READ OR WRITE CODE # 
      ITEM STATIS     I;             # STATUS WORD #
      ITEM DATADEC    I;             # DATA FORMAT DECLARATION #
      ITEM TIMEOUT    I;             # SECONDS TO TIME OUT #
      ITEM NOWAIT     B;             # NO WAIT FLAG # 
# 
****  PROC XFRINIT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BUILDFT;                # BUILT FETS # 
        PROC CALLCIO;                # CALL CIO # 
        PROC CHKFTT;                 # CHECK AND ASSIGN FTT ENTRY # 
        PROC CMMAGR;                 # ASSIGN GROUP NAME #
        FUNC CSET63 B;               # DETERMINE IF 63 CHAR SET # 
        PROC DAYFMSG;                # WRITE DAYFILE MESSAGE #
        PROC FIPRPV;                 # FIP RECOVERY # 
        FUNC GMEMCMM U;              # GET CENTRAL MEMORY VIA CMM # 
        PROC INITIME;                # INITIALIZE FTTTIME # 
        PROC PUTLEV7;                # SEND LEVEL 7 COMMAND # 
        PROC RECOVR;                 # SYSTEM REPRIEVE ROUTINE #
        PROC SETC63;                 # SET TRANSLATION FOR 63 SET # 
        PROC ZEROWDS;                # CLEAR CM BLOCK # 
        END 
  
# 
****  PROC XFRINIT - XREF LIST END. 
# 
  
      ITEM LFETB      I;           # LOCAL FET BUFFER SIZE #
      ITEM RFETB      I;           # RHF FET BUFFER SIZE #
                                               CONTROL EJECT; 
        BEGIN 
  
        IF  TIM$RVADR[0]  EQ  0   # DO 1ST TIME EVER INITIALIZATION # 
        THEN
          BEGIN  # INITIALIZE VARIOUS CELLS IN COMACBX #
          TIM$RVADR[0]  =  LOC(TIM$CURTIM[0]);
          XFRCVTPTR[2] = LOC(CSET1);
          XFRCVTPTR[3] = LOC(CSET2);
  
          IF CSET63 THEN  # GO RESET TRANSLATION TABLES # 
            BEGIN 
            SETC63; 
            END 
          END 
  
        IF NUMFILEXFR EQ 1
        THEN
          BEGIN 
          RECOVR (FIPRPV,O"234",0);  # ACTIVATE FIP REPRIEVE #
          IF NOWAIT                  # IF NOWAIT TRANSFER # 
          THEN
            BEGIN 
            GROUPNAME = 0;           # ASSIGN SAFE CMM BLOCK #
            END 
  
          ELSE                       # WAIT UNTIL TRANSFER COMPLETE # 
            BEGIN 
            GROUPNAME = 1;           # ASSIGN UNSAFE (BELOW HHA) #
            END 
  
          CMMAGR(GROUPNAME, GROUPNAME);  # ASSIGN GROUP NAME #
          END 
  
        RRB$ATA[0] = BKF$ATA[0];
        CHKFTT(ACN);                 # CHECK FILE XFR TABLE FOR SPACE # 
        IF FTTINDEX LT 0           # IF NO FTT ENTRY FOUND #
        THEN
          BEGIN 
          RETURN;                  # STOP # 
          END 
# 
*       OBTAIN MEMORY FOR LOCAL AND RHF FETS, AND RHF PARAMETER BLOCK.
# 
        LFETB = XFRMINBUFL[DATADEC];
        RFETB = XFRMINBUFR[DATADEC];
        IF FETBUFSIZE GT (LFETB+RFETB)  # IF BUFSIZE GT MINIMUM # 
        THEN
          BEGIN 
          IF FETBUFSIZE GT 2*(LFETB+RFETB)
          THEN
            BEGIN 
            LFETB = 0;
            RFETB = 0;
            END 
  
          LFETB = LFETB + 
                (FETBUFSIZE-LFETB-RFETB)*1000/(XFRRATIO[DATADEC]+1000); 
          RFETB = FETBUFSIZE - LFETB; 
          END 
  
        FTTFETADR = GMEMCMM(0, LENFETAPB + LFETB + RFETB);
  
        ZEROWDS(FTTFETADR,LENFETAPB);  # CLEAR FETS # 
  
        P<LFET> = FTTFETADR;       # SET FET POINTERS # 
        P<RFET> = P<LFET> + LEN$LFET + LENRHFPBLK;
        LFETLIM = LFETB;           # SET LOCAL FET BUFFER LENGTH #
        RFETLIM = RFETB;           # SET RHF FET BUFFER LENGTH #
      RFETFETL = LEN$RFETEX;
  
        IF OPCODE EQ RECEIVE
        THEN
          BEGIN 
          FTTDIRECN = RECEIVE;     # DIRECTION = RECEIVE #
          END 
  
        ELSE
          BEGIN 
          FTTDIRECN = SEND;        # DIRECTION = SEND # 
          END 
  
        FTTSTATADR = LOC (STATIS);
        FTTUDD = DATADEC; 
        FTTTIMEOUT = TIMEOUT; 
        FTTPBLKADR = FTTFETADR + LEN$LFET;
        FTTDXPA = P$ES$OK;
        FTTERRORD  = IN$PROGRES;
        FTTTSTATIS = IN$PROGRES;
        BUILDFT (FILENAME);        # BUILD FETS AND RHF PARAM BLOCK # 
  
      CONTROL IFEQ OS$NOSBE;
        IF (DATADEC EQ UH)         # IF SENDING FILE IN UH MODE # 
          AND (OPCODE EQ SEND)
        THEN
          BEGIN 
          LFETRNDM = TRUE;         # CHECK FOR RANDOM FILE #
          LFETIDXLEN = O"777777"; 
          END 
  
      CONTROL ENDIF;
  
        CALLCIO(CIO$OPEN);           # CALL CIO TO OPEN FILE #
        INITIME;                     # INITIALIZE FTTTIME # 
        IF FTTDIRECN EQ SEND       # IF SENDING FILE #
        THEN
          BEGIN 
          PUTLEV7 (AACMD$SS, P$SS$BOI);  # SEND START-DATA COMMAND #
          FTTSTATE = S"SSISSWFACK"; 
          END 
  
        ELSE                       # RECEIVING FILE # 
          BEGIN 
          FTTSTATE = S"WTFRSSCMD";
          END 
  
        END 
  
      END    # XFRINIT #
  
      TERM
