Retro1.org codex

HFNTSM

*DECK HFNTSM
USETEXT NIPDEF
USETEXT ACB 
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT AT
USETEXT DRHDR 
USETEXT DUMPFLG 
USETEXT MSGIDX
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
USETEXT RELFILE 
USETEXT SSTCOM
USETEXT STPRESP 
USETEXT SUPMSG
PRGM HFNTSM ; 
STARTIMS ;
 #
*1DC  HFNTSM
* 
*     1. PROC NAME        AUTHOR           DATE 
*        HFNTSM           LIEM T. NGUYEN   88/04/11 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        THIS ROUTINE PROCESSES THE FNT SUPERVISORY MESSAGE.
*                 FNT/DMS 
*                 FNT/DSM 
*                 FNT/IFL 
*                 FNT/IFR 
*                 FNT/RLT 
*                 FNT/RLT 
* 
*     3. METHOD USED
* 
*     4. ENTRY PARAMETERS 
*        PARAMS1 = TRIGGER TO THE STATE TABLE PROCESSOR.
*        PARAMS2 = ACB POINTER OF THE SENDING S.M. APPLICATION. 
* 
*     5. FOR INFORMATION ABOUT OUTPUT PARAMETERS, AS WELL AS
*            DAYFILE MESSAGES,TEXTS ETC. REFER TO THE 
*            IMS OF EACH SPECIFIC ROUTINE.
* 
 #
STOPIMS ; 
    XREF
      BEGIN 
      LABEL RJMAIN ;
      PROC BLINK ;
      PROC MGETS ;
      PROC OSREQ ;
      PROC OMSG ; 
      PROC OSCHAPP ;
      PROC OVLCALL ;
      FUNC XCDD C(10) ; 
      PROC XSTTP ;
      END 
# 
      INTERNAL VARIABLES
# 
# 
                    JUMP TABLE FOR UCP-PFC/SFC PROCEDURES 
# 
 
 SWITCH FNTACTS FDMS,             # PROCESS FNT/DMS/R AND FNT/DSM/R    #
                SFTS,             # SWITCH FILE FROM MASTER TO SLAVE   #
                RFTM,             # RETURN FILE FROM SLAVE TO MASTER   #
                RSFS,             # RESEND FILE TO SLAVE               #
                RSFM,             # RESEND FILE TO MASTER              #
                SMRA,             # SET MASTER REQUEST SLAVE TO ABORT F#
                CIOR,             # FILE AT NIP, DO CIO RETURN         #
                SFTN,             # SLAVE NETTING OFF, SWITCH FNT TO NP#
                SOFM,             # SLAVE NETTED OFF, AFTER IAR/R      #
                PABT,             # PARTNER ABORTED                    #
                SDXA,             # SEND DMS/A OR DSM/A TO SENDING APPL#
                RIAR,             # RE-PROCESS FNT/IAR/R               #
                SBIM,             # SET BITS IN AT OF MASTER           #
                IMSA,             # INFORM MASTER SLAVE ABORTED        #
                SPAP,             # SET PARTNER ADDRESS POINTER        #
                RFWE,             # RETURN FILE WITH ERROR FNT/IFL/A   #
                ABRF,             # ABNORMAL RESPONSE, RETURN FILE     #
                FEND ;
 
    ARRAY RELBUFF S(8) ;
      BEGIN 
      ITEM RELW0  U(00,00,60) ; 
      ITEM RELBID U(00,00,06) ; 
      ITEM RELBBS U(00,06,AL) = [8] ; 
      ITEM RELW1  U(01,00,60) ; 
      ITEM RELW2  U(02,00,60) ; 
      ITEM RELW3  U(03,00,60) ; 
      ITEM RELW4  U(04,00,60) ; 
      ITEM RELW5  U(05,00,60) ; 
      ITEM RELW6  U(06,00,60) ; 
      ITEM RELW7  U(07,00,60) ; 
      END 
    ARRAY ILL$MSG S(6) ;
      BEGIN 
      ITEM ILL$TRG$MSG C(00,00,52) =
            [" HFNTSM   MAST SLAV, ILLEGAL TRIGGER TRG= TT  ST= SS"] ;
      ITEM ILL$MASTER C(01,00,04) ; 
      ITEM ILL$SLAVE  C(01,30,04) ; 
      ITEM ILL$MSG$TR C(04,12,02) ; 
      ITEM ILL$MSG$ST C(05,00,02) ; 
      ITEM ILL$ZERO   U(05,48,12) = [0] ; 
      END 
 
    ITEM CURST         ;
    ITEM OLDTRIG       ;
    ITEM TRIGGER       ;
 
    ITEM BUFADDR       ;
    ITEM CLEARFNT B    ;
    ITEM CURPFCSFC = 0 ;
    ITEM FILEORD       ;
    ITEM FOUND B       ;
    ITEM INDEX         ;
    ITEM OTHERAN       ;
    ITEM REASON U      ;
    ITEM RESP          ;
    ITEM PTNR$ACB U    ;
    ITEM SEND$ACB U    ;
    ITEM SCRATCH C(10) ;
 
    BEGIN                           # HFNTSM                           #
      P<AT>     = PTAT[0] ;            # APPLICATION TABLE             #
      P<ACB>    = 0 ; 
      OTHERAN   = 0 ; 
      SEND$ACB  = ATACBA[PARAMS2] ;    # ACB OF SENDING APPLICATION    #
      PTNR$ACB  = 0 ; 
      REASON    = 0 ; 
      CLEARFNT  = FALSE ; 
 
      IF PARAMS3 NQ 0 
      THEN
        BEGIN 
        P<SUPMSG> = PARAMS3 ; 
        P<SMNVF>  = P<SUPMSG> ; 
        CURPFCSFC = PFCSFC[0] ; 
        END 
 
      CURST   = ACBFNTST[SEND$ACB] ;# CURRENT STATE OF THAT APPLI.     #
      OLDTRIG = ACBFNTCTR[SEND$ACB] ; # LAST TRIGGER TO THIS CALL      #
      TRIGGER = PARAMS1 ; 
      XSTTP(FNORD,CURST,TRIGGER,RESP);
 
      P<STRESP> = LOC(RESP);     #  RESPONSE WORD                      #
 
      IF LEGTRIG[0] 
      THEN
        BEGIN                # LEGAL TRIGGER                           #
        IF ACTION[0] NQ NOCHG 
        THEN
          GOTO FNTACTS[ACTION[0]];     # EXECUTE PROPER ACTION         #
        ELSE
          GOTO FEND ; 
 
FDMS:                   # PROCESS FNT/DMS/R OR FNT/DSM/R               #
        FOUND = FALSE ;                # PRESET FLAG                   #
 
        FOR INDEX = 1 STEP 1 WHILE
                        INDEX LQ ATHAN[0] AND NOT FOUND 
        DO
          BEGIN                        # LOOP TO SEARCH                #
          IF ATACBA[INDEX] NQ 0 
          THEN
            BEGIN                      # ACB EXISTED                   #
            IF ACBJOBSQN[ATACBA[INDEX]] EQ FNTJSNC[0]  # MATCHING JSN  #
               AND NOT ATNVFN[INDEX]        # AND THIS APPL NOT NETOFF #
                  AND NOT ATNVFF[INDEX]     # NOR FAILED YET           #
            THEN
              BEGIN 
              FOUND   = TRUE ;         # THIS IS THE RIGHT ONE         #
              OTHERAN = INDEX ; 
              END 
            END                        # ACB EXISTED                   #
          END                          # LOOP TO SEARCH                #
        IF FOUND
        THEN
          BEGIN                        # FOUND ACB                     #
          IF ACBPTNRAN[SEND$ACB] EQ 0  # NO OUTSTANDING LOANNING YET   #
          THEN
            BEGIN 
            PTNR$ACB = ATACBA[OTHERAN] ; # LOOK AT THE PARTNER ACB     #
            IF ACBPTNRAN[PTNR$ACB] NQ 0 
              AND ACBPTNRAN[PTNR$ACB] NQ PARAMS2
            THEN
              REASON = MSR"PAS" ;      # PARTNER ALREADY SELECT ANOTHER#
                                       # APPLICATION                   #
            ELSE
              BEGIN                    # OTHER APPL. READY TO BE       #
              ACBPTNRAN[SEND$ACB] = OTHERAN ; 
              ACBPTJSN [SEND$ACB] = FNTJSNC[0] ;  # JSN OF PARTNER     #
              IF PFCSFC[0] EQ FNTDMS
              THEN
                ACBFNTMAS[SEND$ACB] = TRUE ;  # THIS IS THE MASTER     #
              ELSE
                ACBFNTSLA[SEND$ACB] = TRUE ;   # THIS IS A SLAVE       #
 
              IF ACBPTNRAN[PTNR$ACB] NQ 0        # PARTNER IS READY TOO#
              THEN
                NEWSTATE[0] = FNTIDLE ;          # CHANGE TO STATE 2   #
              ELSE
                PTNR$ACB = 0 ;              #DONT UP DATE PARTNER      #
              END                      # OTHER IS READY TO BE PARTNER  #
            END 
          ELSE
            BEGIN                    # MASTER ALREADY SENT FNT/DMS     #
            REASON  = MSR"PAS" ;     # MAY BE ANOTHER LOAN ALREADY EXT #
            END                      # MASTER ALREADY SENT FNT/DMS     #
          END                          # FOUND ACB                     #
        ELSE
          BEGIN                        # NO MATCHED ACB                #
          REASON   = MSR"UNA" ;        # PARTNER UNAVAILABLE           #
          END                          # NO MATCHED ACB                #
 
        CREATB ;                       # GET BUFFER FOR THE RESPONSE SM#
        PFCSFC[0] = CURPFCSFC ; 
        RC[0] = REASON ;
        IF REASON NQ 0
        THEN
          BEGIN 
          EB[0] = TRUE ;              # AB-NORMAL RESPONSE             #
          END 
        ELSE
          BEGIN 
          RB[0] = TRUE ;              # NORMAL RESPONSE                #
          END 
 
        BLINK(BUFADDR,SEND$ACB) ;     # SEND MESSAGE TO APPLICATION    #
 
      GOTO FEND ; 
 
SFTS:                        # PROCESSING FNT/IFL/R FROM MASTER        #
                             # SWITCH FILE FROM MASTER TO SLAVE        #
      IF ACBPTNRAN[SEND$ACB] NQ 0 
      THEN
        BEGIN                     # PARTNER IS READY FOR FILE          #
                                  # I.E. SLAVE ALREADY SENT FNT/DSM/R  #
        PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;  # ACB OF PARTNER     #
 
        ACBFNTFILE[SEND$ACB] = FNTFILE[0] ; # FILE TO BE SENT TO SLAVE #
        ACBFORDNAL[SEND$ACB] = FNTFNTO[0] ; # FILE ORDINAL FROM MASTER #
 
        SWFTON(SEND$ACB,REASON) ;           # SWITCH FILE FROM SENDING #
                                  # APPL. (MASTER) TO NIP C.P.         #
        IF REASON EQ 0
        THEN
          BEGIN                # SST REQUEST WENT O.K.                 #
 
          SWFTOAP(PTNR$ACB,REASON) ;            # SWITCH FILE TO SLAVE #
          IF REASON NQ 0
          THEN
            BEGIN                   # ABNORMAL REASON CODE FROM SST    #
            IF NOT DONE 
            THEN
              BEGIN                 # WORKLIST HAS BEEN SUSPENDED      #
              # CHANGE STATE OF APPLS TO 4, FILE IS AT NIP C.P., WHEN  #
              # FNT/IFL/R GETS RE-PROCESSED, FILE WILL BE SWITCHED TO  #
              # SLAVE VIA ACTION RSFS (RESEND FILE TO SLAVE).          #
 
              NEWSTATE[0]           = FNTANIP ; 
              ACBFNTANIP [SEND$ACB] = TRUE ;     # SET FILE AT NIP FLAG#
              ACBFNTANIP [PTNR$ACB] = TRUE ;     # SET FILE AT NIP FLAG#
                                    # EXIT THIS ROUTINE, PROCESS AGAIN #
              END 
            ELSE
              BEGIN                 # UNABLE TO SWITCH FILE TO SLAVE   #
                                    # RETURN FILE BACK TO MASTER       #
                                    # THIS IS A PUT ERROR, FILE ALRAEDY#
              SWFTOAP(SEND$ACB,REASON) ;              # AT NIP C.P.,   #
                                       # SEND      IT BACK TO MASTER   #
              IF REASON NQ 0
              THEN
                BEGIN                  # PROBLEM WITH SENDING FILE BACK#
                CIORETF(SEND$ACB) ;    # TO MASTER RETURN IT           #
 
                REASON = RFL"RERR" ;   # ERROR IN RETURNNING FILE TO MS#
                END 
              ELSE
                                    # FILE WENT BACK TO MASTER O.K.    #
                REASON = RFL"PERR" ;  # ERROR IN PUTTING FILE TO SLAVE #
 
              DONE = TRUE ;         # WORKLIST IS COMPLETED            #
              END                   # PUT ERROR                        #
            END                     # ABNORMAL REASON CODE             #
          END                       # SST REQUEST WENT O.K.            #
        ELSE
          BEGIN                     # CANOT GET FILE FROM MASTER       #
          NEWSTATE[0] = CURST ;     # RESTORE CURRENT STATE IF DONE = F#
          REASON = RFL"GERR" ;      # SEND FNT/IFL/A IF FATAL, DONE = T#
          END                       # CAN NOT GET FILE FROM MASTER     #
        END                       # LET LOOK AT THE PARTNER ACB        #
      ELSE
        REASON = RFL"SUNA" ;      # SLAVE IS NOT READY FOR FNT/IFL YET #
 
      IF DONE 
      THEN
        BEGIN                     # THIS PUT WORKLIST DID NOT GET SUSPE#
        CREATB ;                  # GET BUFFER FOR FNT/IFL/N OR IFL/A  #
        IF REASON NQ 0
        THEN
          BEGIN                   # SEND ABNORMAL FNT/IFL TO MASTER    #
          PFCSFC[0] = FNTIFLA ; 
          RC[0]     = REASON ;
          CLEARFNT  = TRUE ;      # SIGNAL TO CLEAR ALL FNT INFO IN ACB#
          END 
        ELSE
          BEGIN                   # NORMAL RESPONSE SENDING            #
          PFCSFC[0] = FNTIFLN ;   # SEND FNT/IFL/N TO MASTER           #
          END 
 
        FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
        BLINK(BUFADDR,SEND$ACB) ;      # LINK IT TO ACB OF MASTER      #
 
        END                       # WORKLIST NOT SUSPENDED             #
                                  # ELSE, WORK LIST IS SUSPENDED, UPDTE#
                                  # STATES, WORLIST WILL BE RE-PROCESSE#
 
      GOTO FEND ; 
RFTM:                        # RETURN FILE FROM SLAVE TO MASTER        #
                             # MASTER SENT FNT/IFR/R TO TERMINATE      #
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;   # ACB OF PARTNER (SLV)#
 
      SWFTON(PTNR$ACB,REASON) ;        # SWITCH FILE FROM SLAVE TO NIP #
      IF REASON EQ 0
      THEN
        BEGIN                # SST REQUEST WENT O.K.                   #
        SWFTOAP(SEND$ACB,REASON) ;     # RETURN        FILE TO MASTER  #
        IF REASON NQ 0
        THEN
          BEGIN                   # CAN NOT RETURN FILE TO MASTER      #
          IF NOT DONE 
          THEN
            BEGIN                 # WORKLIST HAS BEEN SUSPENDED        #
            # CHANGE STATE OF APPLS TO 4, FILE IS AT NIP C.P., WHEN    #
            # FNT/IFR/R GETS RE-PROCESSED, FILE WILL BE SWITCHED TO    #
            # MASTER VIA ACTION RSFM (RESEND FILE TO MASTER) .         #
 
            NEWSTATE[0]           = FNTANIP ; 
            ACBFNTANIP [SEND$ACB] = TRUE ;       # SET FILE AT NIP FLAG#
            ACBFNTANIP [PTNR$ACB] = TRUE ;       # SET FILE AT NIP FLAG#
                                  # EXIT THIS ROUTINE, PROCESS AGAIN   #
            END 
          ELSE
            BEGIN                 # OTHER NON-ZERO REASON CODE FROM SST#
            CIORETF(SEND$ACB) ;   # CAN NOT PUT THE FILE BACK TO MASTER#
            REASON = RFL"RERR" ;  # RETURN ERROR IN FNT/IFR TO MASTER  #
            END                   # RETURN FILE TO CIO                 #
          END                     # CAN NOT RETURN FILE TO MASTER      #
        END                       # SST REQUEST WENT O.K.              #
      ELSE
        BEGIN 
        NEWSTATE[0] = CURST ;     # STAY AT SAME STATE FOR WL SUSPENDED#
        REASON = RFL"GERR" ;      # GET ERROR IN FNT/IFR/A TO MASTER   #
        END 
 
      IF DONE 
      THEN
        BEGIN                     # THIS PUT WORKLIST DID NOT GET SUSPE#
        CREATB ;                  # GET BUFFER FOR FNT/IFR/N OR IFR/A  #
        FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
        IF REASON NQ 0
        THEN
          BEGIN                   # SEND ABNORMAL FNT/IFR TO MASTER    #
          PFCSFC[0] = FNTIFRA ; 
          RC[0]     = REASON ;
          CLEARFNT  = TRUE ;      # CLEAR ALL INFORMATIONS             #
          END 
        ELSE
          BEGIN                   # NORMAL RESPONSE SENDING            #
          PFCSFC[0]   = FNTIFRN ;   # SEND FNT/IFR/N TO SLAVE          #
          NEWSTATE[0] = FNTIDLE ;      # CHANGE TO STATE 2, READY FOR  #
                                       # ANOTHER FILE (I.E. FNT/IFL/R) #
          ACBFNTW1[SEND$ACB]   = 0 ;   # CLEAR THE FILE NAME/ORDINAL   #
          ACBMREQABT[SEND$ACB] = FALSE ;   # CLEAR MASTER REQUEST ABT  #
          ACBFNTW1[PTNR$ACB]   = 0 ;   # CLEAR THE FILE NAME/ORDINAL   #
          ACBMREQABT[PTNR$ACB] = FALSE ;   # CLEAR MASTER REQUEST ABT  #
          END 
 
        BLINK(BUFADDR,SEND$ACB) ; # LINK IT TO MASTER ACB              #
 
        END                       # WORKLIST NOT SUSPENDED             #
                                  # ELSE WORKLIST BEEN SUSPENED, UPDATE#
                                  # STATE, THIS WL WILL BE RE-PROCESSED#
 
      GOTO FEND ; 
RSFS:                        # RESEND FILE TO SLAVE APPLICATION        #
                             # THIS ACTION IS EXECUTED WHEN FNT/IFL/R  #
                             # GETS RE-PROCESSED                       #
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;   # ACB OF SLAVE        #
 
      SWFTOAP(PTNR$ACB,REASON) ;              # SWITCH FILE TO SLAVE   #
 
      IF REASON EQ 0
      THEN
        BEGIN                # EVERYTHING WENT O.K. THIS TIME          #
        CREATB ;             # GET BUFFER TO SEND FNT/IFL/N TO MASTER  #
        PFCSFC[0]  = FNTIFLN ;    # SEND FNT/IFL/N TO MASTER           #
        FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
        BLINK(BUFADDR,SEND$ACB) ;      # LINK IT TO ACB OF MASTER      #
        END                       # EVERYTHING WENT O.K. THIS TIME     #
      ELSE
        BEGIN                     # NOT O.K.                           #
        IF DONE 
        THEN                      # WORKLIST DIDNOT GET SUSPENDED      #
          BEGIN 
          # UNABLE TO SWITCH FILE TO SLAVE, RETURN FILE BACK TO MASTER #
          # RESPONSE FNT/IFL/A WITH REASON CODE IS PUT ERROR.          #
          SWFTOAP(SEND$ACB,REASON) ;   # AT NIP C.P., SEND IT BACK TO  #
                                       # MASTER                        #
          IF REASON NQ 0
          THEN
            BEGIN 
            CIORETF(SEND$ACB) ;        # NO WAY TO RETURN FILE TO MST  #
            REASON = RFL"RERR" ;       # DO CIO RETURN IT              #
            END 
          ELSE
                                  # FILE WENT BACK TO MASTER O.K.      #
            REASON = RFL"PERR" ;    # ERROR IN PUTTING FILE TO SLAVE   #
 
          DONE = TRUE ;           # WORKLIST IS COMPLETED              #
          CREATB ;             # GET BUFFER TO SEND FNT/IFL/A TO MASTER#
          PFCSFC[0]  = FNTIFLA ;    # SEND FNT/IFL/A TO MASTER         #
          RC[0]      = REASON ; 
          FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
          BLINK(BUFADDR,SEND$ACB) ;      # LINK IT TO ACB OF MASTER    #
          CLEARFNT = TRUE ; 
          END                       # NOT O.K.                         #
        ELSE                        # IF WL BEEN SUSPENDED, NO STATE   #
          NEWSTATE[0] = CURST ;     # CHANGED. WL WILL BE RE-PROCESSED #
        END 
 
      GOTO FEND ; 
RSFM:                        # SWITCH FILE TO MASTER  APPLICATION      #
                             # FNT/IAR/R OR FNT/IFR/R GET REPROCESSED  #
                             # FILE NEEDS TO BE SENT TO MASTER         #
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;   # ACB OF SLAVE        #
      SWFTOAP(SEND$ACB,REASON) ;              # SWITCH FILE TO MASTER  #
 
      IF REASON EQ 0
      THEN
        BEGIN                # EVERYTHING WENT O.K. THIS TIME          #
                                  # UPDATE ACB FOR SLAVE               #
        CREATB ;                  # GET BUFFER FOR FNT/NORMAL RESPONSE #
        PFCSFC[0]  = CURPFCSFC ;
        RB[0]      = TRUE ;       # SET THE NORMAL RESPONSE BIT        #
        FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
        BLINK(BUFADDR,SEND$ACB) ;      # LINK IT TO SLAVE              #
        IF PFCSFC[0] EQ FNTIFRN 
        THEN
          BEGIN 
          NEWSTATE[0] = FNTIDLE ;      # READY FOR ANOTHER FILE        #
          ACBFNTW1  [SEND$ACB] = 0 ;   # CLEAR THE FILE NAME/ORDINAL   #
          ACBMREQABT[SEND$ACB] = FALSE ;   # CLEAR MASTER REQUEST ABT  #
          ACBFNTW1  [PTNR$ACB] = 0 ;   # CLEAR THE FILE NAME/ORDINAL   #
          ACBMREQABT[PTNR$ACB] = FALSE ;   # CLEAR MASTER REQUEST ABT  #
          END 
        ELSE
          CLEARFNT = TRUE ;            # IT IS FNT/IAR/N, CLEAR INFORMA#
        END                       # EVERYTHING WENT O.K. THIS TIME     #
      ELSE
        BEGIN                     # NOT O.K.                           #
        IF DONE 
        THEN                      # WORKLIST DIDNOT GET SUSPENDED      #
          BEGIN 
          CIORETF(SEND$ACB) ;     # RETURN FILE TO CIO                 #
          CREATB ;             # GET BUFFER TO SEND ABNORMAL TO MASTER #
          PFCSFC[0]  = CURPFCSFC ;  # SEND FNT/IAR/A OR FNT/IFR/A TO MS#
          EB[0]      = TRUE ;          # SET THE ABNORMAL BIT          #
          FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
          RC[0] = RFL"RERR" ;          # COULD NOT PUT FILE BACK TO MST#
          BLINK(BUFADDR,SEND$ACB) ;    # LINK IT TO ACB OF MASTER      #
          CLEARFNT = TRUE ; 
          END                       # NOT O.K.                         #
        ELSE
          NEWSTATE[0] = CURST ;        # NO STATE CHANGED, WL SUSPENDED#
        END 
 
      GOTO FEND ; 
SMRA:                             # MASTER SENDS FNT/IAR/R TO REQUEST  #
                                  # SLAVE APPL. NETOFF.                #
 
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF PARTNER #
 
      ACBSLVGONE[SEND$ACB] = FALSE ;  # CLEAR SLAVE IS GONE FLAG       #
      ACBIARRC  [SEND$ACB] = 0 ;      # CLEAR REASON CODE FIELD        #
 
      ACBMREQABT[PTNR$ACB] = TRUE ; # SET MASTER REQUEST SLAVE TO ABORT#
                                  # FLAG IN SLAVE  ACB                 #
      ATASBI[ACBAN[SEND$ACB]] = TRUE ;               # FORCE THIS TO T #
      ATASBS[ACBAN[SEND$ACB]] = TRUE ;               # SET SWAP OUT BIT#
      DONE = FALSE ;              # SUSPEND TO PROCESS WL FOR MASTER   #
 
      GOTO FEND ; 
CIOR: 
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF PARTNER #
 
      CIORETF(SEND$ACB) ;         # DO CIO RETURN ON FILE, FILE AT NIP #
      GOTO FEND ; 
 
SFTN:                             # SLAVE NETTING OFF, SWITCH FILE TO  #
                                  # NIP                                #
 
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF PARTNER #
      SWFTON(SEND$ACB,REASON) ; 
      ACBSLVGONE[PTNR$ACB] = TRUE ;    # SLAVE IS GONE FLAG TO TRUE    #
      IF REASON NQ 0
      THEN
        BEGIN                # SST REQUEST WAS NO O.K.                 #
        NEWSTATE[0] = FNTLOST ;        # CHANGE TO STATE 5, INSTEAD 4  #
        DONE = TRUE ;                  # WORKLIST COMPLETED            #
        END 
      ELSE
        BEGIN                     # FILE IS AT NIP CP                  #
        ACBFNTANIP[PTNR$ACB] = TRUE ;  # SET FILE IS AT NIP FLAG       #
        ACBIARRC  [PTNR$ACB] = 0 ;
        END                       # FILE IS AT NIP CP                  #
 
      GOTO FEND ; 
 
SOFM:                        # SLAVE NETOFF AFTER MASTER REQUEST SLAVE #
                             # TO NETOFF IA FNT/IAR/R (PROCESS BY SMRA)#
                             # SWITCH FILE FROM SLAVE TO NIP THEN TO   #
                             # MASTER, AND SEND FNT/IAR/N              #
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF MASTER  #
      SWFTON(SEND$ACB,REASON) ;        # SWITCH FILE FROM SLAVE TO NIP #
      ACBSLVGONE[PTNR$ACB] = TRUE ;    # SLAVE IS GONE NOW IN MASTER   #
      IF REASON NQ 0
      THEN
        ACBIARRC[PTNR$ACB] = RFL"RERR" ;     # RETURN ERROR REASON CODE#
      ELSE
        BEGIN 
        ACBIARRC  [PTNR$ACB] = 0 ;
        ACBFNTANIP[PTNR$ACB] = TRUE ;  # SET FILE IS AT NIP FLAG       #
        END 
      DONE = TRUE ;                    # SLAVE WL COMPLETED            #
 
      GOTO FEND ; 
 
PABT:                        # PARTNER APPLICATION ABORTED             #
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF PARTNER #
      CLEARFNT = TRUE ; 
 
      GOTO FEND ; 
SDXA:                             # MASTER OR SLAVE ABORTED BEFORE     #
                                  # FNT/DMS/R OR FNT/DSM/R RECEIVED    #
      CREATB ;                    # GET BUFFER FOR ABNORMAL S.M.       #
      PFCSFC[0] = CURPFCSFC ; 
      EB[0]     = TRUE ;          # MAKE THIS IS AN ABNORMAL S.M.      #
      RC[0]     = MSR"UNA" ;      # RC = PARTNER UNAVAILABLE           #
      CLEARFNT = TRUE ; 
      BLINK(BUFADDR,SEND$ACB) ;   # SEND IT TO SENDING APPL.           #
      GOTO FEND ; 
 
RIAR:                             # RE-PROCESS FNT/IAR/R TO SWITCH FILE#
                                  # FROM NIP C.P. TO MASTER            #
      IF ACBSLVGONE[SEND$ACB] 
      THEN
        BEGIN                     # SLAVE IS GONE NOW, FILE MAY BE AT  #
        IF ACBIARRC[SEND$ACB] EQ 0                 # NIP CONTROL POINT #
        THEN
          BEGIN                # FILE IS AT NIP CP, SWITCH IT TO MASTER#
          SWFTOAP(SEND$ACB,REASON) ;        #   SWITCH FILE TO MASTER  #
          IF REASON NQ 0
          THEN                    # FILE STILL AT NP CP. RETURN IT     #
            CIORETF(SEND$ACB) ;   # CAN NOT PUT THE FILE BACK TO MASTER#
          END 
        ELSE
          REASON = ACBIARRC[SEND$ACB] ; 
 
        DONE = TRUE ;             # FORCE IT TO BE DONE                #
        CREATB ;               # GET BUFFER FOR FNT/IAR/N OR FNT/IAR/A #
        IF REASON NQ 0
        THEN
          BEGIN 
          PFCSFC[0] = FNTIARA ;   # SEND FNT/IAR/A WITH RC = RERR      #
          RC[0]     = RFL"RERR" ; # ERROR OCCURED IN RETURNNING FILE   #
          END 
        ELSE
          BEGIN 
          PFCSFC[0] = FNTIARN ; 
          END 
 
        CLEARFNT = TRUE ;         # CLEAR ALL FNT RELATED INFORMATIONS #
 
        FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
        BLINK(BUFADDR,SEND$ACB) ;      # LINK THIS SM TO MASTER ACB    #
        END 
      ELSE
        BEGIN                     # CONTINUE TO SUSPEND THIS WL TIL SLV#
        DONE = FALSE ;                                # IS GONE        #
        ATASBI[ACBAN[SEND$ACB]] = TRUE ;             # FORCE THIS TO T #
        ATASBS[ACBAN[SEND$ACB]] = TRUE ;             # SET SWAP OUT BIT#
        NEWSTATE[0] = CURST ;     # STAY AT THE SAME STATE             #
        END 
 
      GOTO FEND ; 
 
SBIM:                             # SET BITS IN MASTER TO HAVE FNT/IAR #
                                  # WL REPROCESSED                     #
 
      DONE = FALSE ;              # CONTINUE TO SUSPEND THIS WL UNTIL  #
                                  # SLAVE IS GONE                      #
      ATASBI[ACBAN[SEND$ACB]] = TRUE ;               # FORCE THIS TO T #
      ATASBS[ACBAN[SEND$ACB]] = TRUE ;               # SET SWAP OUT BIT#
 
      GOTO FEND ; 
 
IMSA:                        # INFORM MASTER SLAVE ABORTED I.E. SET    #
                             # FLAGS AND REASON ODE IN MASTER ACB      #
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF MASTER  #
      ACBSLVGONE[PTNR$ACB] = TRUE ;    # SLAVE IS GONE NOW IN MASTER   #
      ACBIARRC[PTNR$ACB] = RFL"RERR" ;       # RETURN ERROR REASON CODE#
 
      GOTO FEND ; 
SPAP:                        # SET PARTNER AB ADDRESS POINTER          #
 
      PTNR$ACB = ATACBA[ACBPTNRAN[SEND$ACB]] ;        # ACB OF MASTER  #
      GOTO FEND ; 
RFWE:                        # RETURN FILE WITH ERROR, BEFORE OR DURING#
                             # PROCESSING FNT/ILF/R, SLAVE ABORTED,    #
                             # RETURN IFL/A RC=PERR AND RETURN FILE TO #
                             # MASTER IF FILE IS ALREADY AT NIP CP.    #
      IF ACBFNTANIP[SEND$ACB] 
      THEN
        BEGIN                     # FILE IS AT NIP CP                  #
        SWFTOAP(SEND$ACB,REASON) ;            # SWITCH FILE TO MASTER  #
        IF REASON NQ 0
        THEN
          BEGIN              # CAN NOT SEND FILE BACK TO MASTER, CIO IT#
          CIORETF(SEND$ACB) ; 
          END 
        END                       # FILE IS AT NIP CP                  #
      CREATB ;                    # GET BUFFER FOR ABNORMAL S.M.       #
      PFCSFC[0] = FNTIFLA ; 
      RC[0]     = RFL"PERR" ;     # RC = PARTNER UNAVAILABLE           #
      FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
      BLINK(BUFADDR,SEND$ACB) ;   # SEND IT TO SENDING APPL.           #
      CLEARFNT = TRUE ; 
      GOTO FEND ; 
 
ABRF:                        # ABNORMAL RSP RETURN FILE. BEFORE OR DUR-#
                             # ING PROCESSING FNT/ILR/R, SLAVE ABORTED,#
                             # RETURN IFR/A RC=RERR AND RETURN FILE TO #
                             # MASTER IF FILE IS ALREADY AT NIP CP.    #
      CREATB ;                    # GET BUFFER FOR ABNORMAL S.M.       #
      IF ACBFNTANIP[SEND$ACB] 
      THEN
        BEGIN                     # FILE IS AT NIP CP                  #
        SWFTOAP(SEND$ACB,REASON) ;            # SWITCH FILE TO MASTER  #
        IF REASON NQ 0
        THEN
          BEGIN              # CAN NOT SEND FILE BACK TO MASTER, CIO IT#
          CIORETF(SEND$ACB) ; 
          PFCSFC[0] = FNTIFRA ; 
          RC [0] = RFL"RERR" ;         # NO FILE BACK TO MASTER        #
          END 
        ELSE
          BEGIN              # FILE WENT BACK TO MASTER OK             #
          PFCSFC[0] = FNTIFRN ; 
          END                # FILE WENT BACK TO MASTER OK             #
        END                       # FILE IS AT NIP CP                  #
      ELSE
        BEGIN                     # FILE IS NOT AT NIP                 #
        PFCSFC[0] = FNTIFRA ; 
        RC[0]     = RFL"RERR" ; 
        END 
      FNTFNTO[0] = ACBFORDNAL[SEND$ACB] ; 
      BLINK(BUFADDR,SEND$ACB) ;   # SEND IT TO SENDING APPL.           #
      CLEARFNT = TRUE ; 
      GOTO FEND ; 
 
FEND: 
 
      IF CLEARFNT 
      THEN
        BEGIN                     # CLEAR ALL FNT WORD IN ACB'S        #
        ACBFNTW0[SEND$ACB] = 0 ;
        ACBFNTW1[SEND$ACB] = 0 ;
        IF PTNR$ACB NQ 0
        THEN
          BEGIN                   # ACB OF PARTNER APPLICATION         #
          ACBFNTW0[PTNR$ACB] = 0 ;
          ACBFNTW1[PTNR$ACB] = 0 ;
          END 
        END 
      ELSE
        BEGIN 
                                  # UPDATE STATE/TRIGGER FOR SENDING AP#
        ACBFNTLST[SEND$ACB] = ACBFNTST[SEND$ACB] ;
        ACBFNTLTR[SEND$ACB] = ACBFNTCTR[SEND$ACB] ; 
        ACBFNTST [SEND$ACB] = NEWSTATE[0] ; 
        ACBFNTCTR[SEND$ACB] = PARAMS1 ; 
                                  # UPDATE STATE/TRIGGER FOR PARTNER AP#
        IF PTNR$ACB NQ 0
        THEN
          BEGIN 
          ACBFNTLST[PTNR$ACB] = ACBFNTST[SEND$ACB] ;
          ACBFNTLTR[PTNR$ACB] = ACBFNTCTR[SEND$ACB] ; 
          ACBFNTST [PTNR$ACB] = NEWSTATE[0] ; 
          ACBFNTCTR[PTNR$ACB] = PARAMS1 ; 
          END 
        END 
 
      GOTO RJMAIN ; 
 
      END                           # LEGAL TRIGGER                    #
    ELSE
      BEGIN                         # ILLEGAL TRIGGER                  #
      ILL$MASTER[0] = ACBJOBSQN[SEND$ACB] ; 
      IF PTNR$ACB NQ 0
      THEN
        ILL$SLAVE [0] = ACBJOBSQN[PTNR$ACB] ; 
      ELSE
        ILL$SLAVE [0] = "    " ;
      SCRATCH       = XCDD(TRIGGER) ; # CONVERT TRIGGER NUM TO DISPLAY #
      ILL$MSG$TR[0] = C<8,2> SCRATCH ;
      SCRATCH       = XCDD(CURST) ;   # CONVERT STATE NUM TO DISPLAY   #
      ILL$MSG$ST[0] = C<8,2> SCRATCH ;
      OMSG (ILL$TRG$MSG,0) ;
      IF PARAMS3 NQ 0 
      THEN
        BEGIN 
        CREATB ;                       # GET BUFFER FOR THE RESPONSE SM#
        PFCSFC[0] = CURPFCSFC ; 
        RC[0]     = RFL"ILSQ" ; 
        EB[0]     = TRUE ;            # AB-NORMAL RESPONSE             #
        BLINK(BUFADDR,SEND$ACB) ;     # SEND MESSAGE TO APPLICATION    #
        END 
      GOTO RJMAIN ; 
      END                           # ILLEGAL TRIGGERS                 #
 
 
                                                 CONTROL EJECT; 
 
 
      PROC SWFTON(ACBD,REASON) ;
# 
      SWITCH FILE FROM APPLICATION CONTROL POINT TO NIP CONTROL POINT 
# 
 
      ITEM ACBD U ;                # ACB ADDRESS                       #
      ITEM PTNR U ;                # ACB OF PARTNER                    #
      ITEM REASON U ;              # REASON CODE RETURNED              #
 
        BEGIN                        # SWITCH FILE TO NIP C.P.         #
        SSTPARAM[0] = 0;                   # CLEAR SST PARAMETER WORD  #
        SSTFNTS[0]  = ACBFORDNAL[ACBD] ;   # FILE ORDINAL              #
        SSTFC[0]    = SSTSQFFUCP;          # SST FUNCTION CODE         #
        SSTJOBID[0] = ACBJNWD[ACBD] ;      # ADD JOB IDENTIFICATION    #
        SSTPADDR[0] = LOC(SSTPARAM[0]);    # FWA OF SST PARAMETER BLOCK#
 
 
        OSREQ(SSTCALL[0]);           # ISSUE SST RA+1 CALL             #
 
        REASON = SSTRC[0];           # SST COMPLETION STATUS           #
        PTNR = ATACBA[ACBPTNRAN[ACBD]] ;        # ACB OF PARTNER       #
 
        IF REASON NQ 0
        THEN                         # SST ERROR PROCESSING            #
          BEGIN 
          INDEX = REASON/8; 
          D14M2[0] = INDEX*O"100" + REASON - INDEX*8 + O"3333"; 
          D14M3[0] = SSTJSN[0]; 
          OMSG(DFMSG14,0);             # DAYFILE SST RETURN STATUS     #
 
          IF REASON EQ RC$UCPSO OR   # APP SWAPPED OUT BY OS           #
             REASON EQ RC$UCPNF      # APP FAILED                      #
          THEN
            BEGIN 
 
            IF REASON EQ RC$UCPSO 
            THEN                     # RESUME HOST WORKLIST PROC       #
              BEGIN                  # WHEN APP IS SWAPPED BACK IN     #
              IF ACBFNTMAS[ACBD]          # THIS IS THE MASTER         #
              THEN
                BEGIN 
                ATASBS[ACBAN[ACBD]] = TRUE;        # APP SWAPPED OUT   #
                ATASBI[ACBAN[ACBD]] = TRUE ;       # FORCE THIS TO T   #
                END 
              ELSE
                BEGIN 
                ATASBS[ACBAN[PTNR]] = TRUE;          # APP SWAPPED OUT #
                ATASBI[ACBAN[PTNR]] = TRUE ;         # FORCE THIS TO T #
                END 
 
              OSCHAPP(ACBD) ;          # SCHEDULE APPLICATION          #
              END 
            DONE = FALSE ;           # SUSPEND THE WORKLIST PROCESSING #
            END 
          END 
        ELSE
          BEGIN                        # FILE SWITCHING WENT O.K.      #
          ACBFORDNAL[ACBD] = SSTFNTR[0] ; # UPDATE THE ORDINAL OF FILE #
          ACBFORDNAL[PTNR] = SSTFNTR[0] ; 
          END 
 
        RETURN ;
        END 
 
                                       CONTROL EJECT ;
 
      PROC CIORETF(ACBD) ;             # ISSUE CIO (070) RETURN FILE   #
      ITEM ACBD U ;                    # ACB ADDRESS                   #
        BEGIN                          # RETFILE                       #
 
        P<DRHDRWD> = LOC(RELBUFF) ; 
        P<PARAMB>  = P<DRHDRWD> + BLKHSIZE ;
        RELBID     = CPCRIDVALUE ;
        RELBBS     = PARSIZE + BLKHSIZE ; 
                                        # PARAMETER BLOCK ADDRESS      #
        FET$LFN   [0] = ACBFNTFILE [ACBD]; # LOCAL FILE NAME           #
        REQWORD   [0] = 0;           # ZERO PP CALL WORD               #
        PADDR     [0] = P<PARAMB>;
        PPNAME    [0] = PP$CIO; 
        FET$STAT  [0] = CIORETURN;   # CIO FUNCTION REQUEST CODE       #
        FET$UP    [0] = TRUE;        # SET USER PROCESSING FLAG        #
        FET$EP    [0] = TRUE;        # SET ERROR PROCESSING FLAG       #
        FET$CIOFNT[0] = ACBFORDNAL[ACBD] ;
 
        OSREQ(REQWORD[0]) ;          # ISSUE THE OS CALL               #
        RETURN ;
        END 
 
                                       CONTROL EJECT ;
 
      PROC SWFTOAP(ACBD,REASON) ; 
# 
      SWITCH FILE FROM NIP CONTROL POINT TO APPLICATION CONTROL POINT 
# 
 
      ITEM ACBD   U ;              # ACB ADDRESS                       #
      ITEM PTNR   U ;              # ACB OF PARTNER                    #
      ITEM FNTORD U ;              # ORDINAL OF FILE                   #
      ITEM INDEX    ; 
      ITEM REASON U ;              # REASON CODE RETURNED              #
 
 
      BEGIN                        # BEGIN OF SWFTOAP                  #
 
      SSTPARAM[0] = 0;                 # CLEAR SST PARAMETER WORD      #
      SSTFNTS [0] = ACBFORDNAL[ACBD] ;    # FILE-S FNT ORDINAL IN NAM  #
      SSTFC   [0] = SSTSQFTUCP;           # SST FUNCTION CODE          #
      SSTJOBID[0] = ACBJNWD[ACBD] ;    # APP JOB IDENTIFICATION        #
      SSTPADDR[0] = LOC(SSTPARAM[0]);  # FWA OF SST PARAMETER BLOCK    #
 
 
#     IF ATASBSO[ACBAN[ACBD]] #        # APPLICATION SWAPPED OUT       #
#     THEN    # 
#       BEGIN # 
#       REASON = RC$UCPSO #            # NO NEED TO ISSUE SST CALL     #
#       END   # 
#     ELSE    # 
        BEGIN 
        OSREQ(SSTCALL[0]);             # ISSUE SST RA+1 CALL           #
        REASON = SSTRC[0];             # SST COMPLETION STATUS         #
        END 
 
      PTNR = ATACBA[ACBPTNRAN[ACBD]] ;
 
      IF REASON NQ 0
      THEN                             # SST ERROR PROCESSING          #
        BEGIN 
        INDEX = REASON/8; 
        D14M2[0] = INDEX*O"100" + REASON - INDEX*8 + O"3333"; 
        D14M3[0] = SSTJSN[0]; 
        OMSG(DFMSG14,0);             # DAYFILE SST RETURN STATUS       #
 
        IF REASON EQ RC$UCPSO OR       # APP SWAPPED OUT BY OS         #
           REASON EQ RC$UCPNF          # APP FAILED                    #
        THEN
          BEGIN 
          IF REASON EQ RC$UCPSO 
          THEN                     # RESUME HOST WORKLIST PROC         #
            BEGIN                  # WHEN APP IS SWAPPED BACK IN       #
            IF ACBFNTMAS[ACBD]              # THIS IS THE MASTER       #
            THEN
              BEGIN 
              ATASBS[ACBAN[ACBD]] = TRUE;            # APP SWAPPED OUT #
              ATASBI[ACBAN[ACBD]] = TRUE ;           # FORCE THIS TO T #
              END 
            ELSE
              BEGIN 
              ATASBS[ACBAN[PTNR]] = TRUE;            # APP SWAPPED OUT #
              ATASBI[ACBAN[PTNR]] = TRUE ;           # FORCE THIS TO T #
              END 
 
            OSCHAPP(ACBD) ;        # SCHEDULE APPLICATION              #
            END 
          ELSE
            FAILADR = ACBD ;           # APPLICATION-S ACB ADDRESS     #
          DONE = FALSE ;           # SUSPEND THE WORKLIST PROCESSING   #
          END 
        END 
      ELSE
        BEGIN                          # FILE SWITCHING WENT O.K.      #
        ACBFORDNAL[ACBD] = SSTFNTR[0] ;   # UPDATE THE ORDINAL IN APP1 #
        ACBFORDNAL[PTNR] = SSTFNTR[0] ;   # UPDATE THE ORDINAL IN APP2 #
        END 
 
      RETURN ;
 
      END 
 
                                       CONTROL EJECT; 
 
 
      PROC CREATB ; 
        BEGIN                          # CREATB                        #
        MGETS(LFNTRSP+BLKHSIZE+ABHSIZE,BUFADDR,TRUE) ; # GET BUFFER FOR#
                                            #    RESPONSE  S.M.        #
        P<AHEADER> = BUFADDR + BLKHSIZE ; 
        ABHABT [0] = APPCMD ; 
        ABHACT [0] = CT60TRANS ;
        ABHTLC [0] = LFNTRSP ;
        P<SUPMSG> = P<AHEADER> + ABHSIZE ;
 
        RETURN ;
        END                            # CREATB                        #
    END 
    TERM
Retro1.org codex

Table of Contents

HFNTSM

Table Of Contents

Source Code
