Retro1.org codex

*DECK HFSPAWN 
USETEXT NIPDEF
USETEXT ACB 
USETEXT AHEADER 
USETEXT APPSTAT 
USETEXT DRHDR 
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT PARAMP
USETEXT SUPMSG
 PRGM HFSPAWN ;              # SPAWN FACILITY TO BRING UP FTPI APPL.   #
 
 STARTIMS;
 #
*1DC  HFSPAWN 
* 
*     1. PROC NAME        AUTHOR           DATE 
*        HFSPAWN          LIEM T. NGUYEN   88/01/15 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        THIS ROUTINE PROCESSES THE SAF/SAR SUPERVISORY MESSAGE.
* 
*     3. METHOD USED
*        CONSTRUCT THE PFN FOR THE JOB BY CONCATINATING THE 5 CHARS 
*        APPLICATION NAME TO "ZZ", THEN CALL GETFIL.
*        IF ERROR IN GETTING FILE, DAYFILE ERROR MESSAGE THEN RETURN. 
*        ELSE ROUTE JOB TO THE INPUT QUEUE. 
* 
*     4. ENTRY PARAMETERS 
*        PARAMP1 = ADDRESS OF THE INI/APP S.M.
* 
* 
 #
 STOPIMS; 
 
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        FUNC GETFIL;         # GET A DIRECT ACCESS PERMANENT FILE      #
        PROC BLINK ;         # LINK SM TO ACB                          #
        PROC MGETS ;         # GET BUFFER FOR RESPONSE                 #
        PROC OMSG;           # DAYFILE ERROR MESSAGE                   #
        PROC ROUTE;          # ROUTE JOB FILE TO INPUT QUEUE           #
        PROC XTRACE;         # TRACE CALL                              #
        LABEL RJMAIN; 
        END 
# 
      LOCAL VARIABLES 
# 
      ITEM BUFADDR ;              # ADDRESS OF RESPONDING BUFFER       #
      ITEM I ;                    # FOR INDEX                          #
      ITEM RSTATUS  U;       # RETURN STATUS OF GETFIL CALL            #
 
      ARRAY R$NAME S(1) ; 
        BEGIN 
        ITEM RNAME$U U(0,0,42) ;
        ITEM RNAME    C(0,0,7) ;  # ROOT APPLICATION NAME FROM ACB     #
        END 
 
      ARRAY S$NAME S(1) ; 
        BEGIN 
        ITEM SNAME$U U(0,0,42) ;
        ITEM SNAME   C(0,0,07) ;  # EXTRACTED SPAWN APPLICATION NAME   #
        END 
 
      ARRAY DSPERRMSG  S(4);
        BEGIN 
        ITEM DSPERRTEXT C(0,0,30) = [" DSP ERROR NNB, LFN = XXXXXXX."]; 
        ITEM DSPERRAPPL C(2,12,07) ;
        ITEM DSPERRNN   U(1,6,12);     # ERROR CODE FIELD IN DAY MSG   #
        ITEM DSPERREND  U(3,0,60) = [0];
        END 
 
      ARRAY SPNNAME S(1) ;
        BEGIN 
        ITEM PFNAME   C(00,00,07) ;         # PERMENENT FILE NAME      #
        ITEM SPNZZ    C(00,00,02) = ["ZZ"] ;
        ITEM SPNJOBF  C(00,12,05) ; 
        ITEM SPNZERO  U(00,42,18) = [0] ; 
        END 
 
      ARRAY SPN$MSG S(5); 
        BEGIN                # ERROR MESSAGE                           #
        ITEM MSG1$TEXT   C(00,00,48) =
          ["NIP/NO HSPAWN STARTUP-ZZXXXXX   NOT FOUND.     "];
        ITEM MSG$APPL    C(02,24,05) ;    # SPAWN APPLICATION NAME     #
        ITEM MSG1$END    U(04,48,12) = [0]; 
        END 
 
      ARRAY RPARAM P(7);
        BEGIN                # ROUTE JOB PARAMETER BLOCK               #
        ITEM RPAR$JOBF     C(00,00,07); # NAME OF INIAPPL JOB FILE     #
        ITEM RPAR$EC       U(00,42,06); # ERROR CODE RESPONSE          #
        ITEM RPAR$F        B(00,48,01); # FORCED ORIGIN FLAG           #
        ITEM RPAR$OT       U(00,53,06); # FORCED JOB ORIGIN TYPE       #
        ITEM RPAR$CB       B(00,59,01); # COMPLETION BIT               #
        ITEM RPAR$DISP     C(01,24,02); # FILE DISPOSITION             #
        ITEM RPAR$EP       B(01,47,01); # ERROR PROCESSING FLAG        #
        ITEM RPAR$FSC      B(01,39,01); # FORCE SERVICE CLASS          #
        ITEM RPAR$ID       B(01,58,01); # ROUTE TO CENTRAL SITE        #
        ITEM RPAR$DCF      B(01,55,01); # DISPOSITION CODSET FLAG      #
        ITEM RPAR$SC       C(04,12,02); # SERVICE CLASS                #
        ITEM RPAR$WD0      U(00,00,60) = [0]; 
        ITEM RPAR$WD1      U(01,00,60) = [0]; 
        ITEM RPAR$WD2      U(02,00,60) = [0]; 
        ITEM RPAR$WD3      U(03,00,60) = [0]; 
        ITEM RPAR$WD4      U(04,00,60) = [0]; 
        ITEM RPAR$WD5      U(05,00,60) = [0]; 
        ITEM RPAR$WD6      U(06,00,60) = [0]; 
        END 
 
      CONTROL EJECT;
 
      BEGIN # HSPAWN  # 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("HSPAW");       # TRACE CALL                              #
      CONTROL FI; 
 
      P<ACB> = PARAMP1 ;
      P<AHEADER> = WLADDR + AIPHSIZE ;
      P<SUPMSG>  = P<AHEADER> + ABHSIZE ; 
 
      RNAME[0] = C<0,7> ACBANAME[0] ; 
      SNAME[0] = C<0,7> SAFNAME[0] ;
 
      MGETS(LSAFRSP+BLKHSIZE+ABHSIZE,BUFADDR,TRUE) ;   # GET BUFFER FOR#
                                            #    RESPONSE  S.M.        #
      P<AHEADER> = BUFADDR + BLKHSIZE ; 
      ABHABT[0] = APPCMD ;
      ABHACT[0] = CT60TRANS ; 
      ABHTLC[0] = LSAFRSP ; 
      P<SUPMSG> = P<AHEADER> + ABHSIZE ;
 
 
      FOR I = 0 STEP 1 UNTIL 6
      DO
        BEGIN 
        IF C<I,1> SNAME[0] EQ " " 
        THEN
          BEGIN 
          B<I*6,6> SNAME[0] = 0 ;      # FORCE SPAWN NAME TO TRAILING 0#
          B<I*6,6> RNAME[0] = 0 ;      # FORCE ROOT NAME TO TRAILING 0 #
          END 
        END 
 
      IF RNAME$U[0] NQ SNAME$U[0] 
      THEN
        PFCSFC[0] = SAFSARA ;          # APPL TRIES TO SPAWN DIFF APPL #
      ELSE
        BEGIN                          # APPL TRIES TO SPAWN IFSELF    #
 
        SPNJOBF[0] = C<0,5>SNAME ;       # FETCH 5 CHARS OF APPL. NAME #
 
        RSTATUS = GETFIL(SPNNAME,SPNNAME);     # GET PFN               #
 
        IF RSTATUS NQ 0 
        THEN
          BEGIN 
          MSG$APPL[0] = C<00,05>SAFNAME[0] ;
          OMSG(SPN$MSG,0);       # DAYFILE ZZININD FILE NOT FOUND      #
          PFCSFC[0] = SAFSARA ;     # SENDING ABNORMAL BACK            #
          END 
 
        ELSE       # ZZXXXXX EXISTS, NOW ROUTE JOB TO SYSTEM           #
          BEGIN 
          RPAR$JOBF[0] = PFNAME[0] ;    # SET JOB FILE FILENAME        #
          RPAR$F[0] = TRUE;       # SET TO SYSTEM ORIGIN               #
          RPAR$OT[0] = SYOT;       # SET SYSTEM ORIGIN JOB TYPE        #
          RPAR$CB[0] = FALSE;       # CLEAR COMPLETION BIT             #
          RPAR$DISP[0] = "IN";       # SET FILE DISPOSITION            #
          RPAR$FSC[0] = TRUE;        # SET FORCED SERVICE CLASS FLAG   #
          RPAR$DCF[0] = TRUE;       # SET DISPOSITION CODE SET         #
          RPAR$EP[0] = TRUE;        # SET ERROR PROCESSING FLAG        #
          RPAR$ID[0] = TRUE;       # SET ROUTE TO CENTRAL SITE         #
          RPAR$SC[0] = "NS";        # SET NETWORK SERVICE CLASS        #
          ROUTE(RPARAM,1);       # ROUTE ZZININD TO INPUT QUEUE        #
          PFCSFC[0] = SAFSARN ;          # READY TO SEND NORMAL RESPONS#
          IF RPAR$EC[0] NQ 0
          THEN                 # DSP DETECTED ERROR - FILE NOT ROUTED  #
            BEGIN 
            DSPERRAPPL[0] = PFNAME[0] ; 
            DSPERRNN[0] = RPAR$EC[0] - (RPAR$EC[0]/8)*8 + 
                          (RPAR$EC[0]/8)*64 + O"3333";
            OMSG(DSPERRMSG,0);        # ISSUE DAYFILE MESSAGE          #
            PFCSFC[0] = SAFSARA ;        # NO, NO, IT IS ABNORMAL      #
            END 
          END 
        END                       # APPL TRIES TO SPAWN ITSELF         #
 
      BLINK(BUFADDR,P<ACB>) ;          # LINK THE RESPONSE TO ACB      #
 
      GOTO RJMAIN;
      END 
      TERM