Retro1.org codex

*DECK NRCSSTP 
USETEXT NIPDEF
USETEXT ACB 
USETEXT APPSTAT 
USETEXT AT
USETEXT MSGIDX
USETEXT PWL 
USETEXT PARAMP
USETEXT PT
USETEXT SSTCOM
      PROC NRCSSTP(ACBD,PWLADD,FNTORD,REASON) ; 
 #
***** 
*    1.PROC NAME             AUTHOR         DATE
*      NRCSSTP               L.T.NGUYEN     84/08/21
* 
*    2.FUNCTIONAL DESCRIPTION:  
*      MAKE SSTP CALL AND PROCESS REASON CODE RETURNED FROM O.S.
* 
*    3.METHOD USED: 
*      SETU UP SSTP PARAMETER BLOCK.
*      CALL OSREQ TO VALIDATE SSTP CALL.
*      PROCESS REASON CODE RETURNED:  
*      - IF NON-ZERO REASON CODE: 
*          IF REASON IS SWAPED OUT LINK THIS PWL TO ACB PWL RING. 
*          ELSE SET UP TO ABORT APPLICATION LATER.
* 
*    4.INPUT PARAMS:  
*      ACBADD - ADDRESS OF ACB OF APPLICATION TO RECIEVE FILE.
*      PWLADD - WORKLIST FROM PIP.
*      FTNORD - ORDINAL FNT OF FILE TO BE SWITCHED. 
*      REASON - REASON CODE RETURN TO CALLER IF ERROR ENCOUTERED. 
* 
*    5.ROUTINES USED: 
*      OMSG :                - SEND DAYFILE MESSAGE.
*      OSCHAPP:              - SCHEDULE THIE APPLICATION. 
*      OSREQ:                - CALL OPERATING SYSTEM TO PROCESS SSTP. 
* 
***** 
 #
 
      XREF
        BEGIN                      # EXTERNAL REFERENCE                #
        PROC ABORT ;
        PROC OMSG ; 
        PROC OSCHAPP ;
        PROC OSREQ ;
        END 
 
      ITEM ACBD U ;                # ACB ADDRESS                       #
      ITEM PWLADD U ;              # PWL ADDRESS                       #
      ITEM FNTORD U ;              # ORDINAL OF FILE                   #
      ITEM INDEX ;
      ITEM REASON U ;              # REASON CODE RETURNED              #
 
 
      BEGIN                        # BEGIN OF NRCSSTP                  #
 
      P<ACB> = ACBD ; 
      P<PWLHDR> = PWLADD   ;
 
      IF ATASBSO[ACBAN[0]]             # APPLICATION SWAPPED OUT       #
      THEN
        BEGIN 
        REASON = RC$UCPSO;             # NO NEED TO ISSUE SST CALL     #
        END 
      ELSE
        BEGIN 
        SSTPARAM[0] = 0;               # CLEAR SST PARAMETER WORD      #
        SSTFNTS[0] = FNTORD;           # FILE-S FNT ORDINAL IN NAM     #
        SSTFC[0] = SSTSQFTUCP;         # SST FUNCTION CODE             #
        SSTJOBID[0] = ACBJNWD[0];      # APP 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         #
        END 
      IF REASON NQ 0
      THEN                             # SST ERROR PROCESSING          #
        BEGIN 
        IF NOT ATASBSO[ACBAN[0]]
        THEN
          BEGIN                        # ISSUE MESSAGE FOR ACTUAL      #
          INDEX = REASON/8;            # ATTEMPT TO ISSUE SST CALL     #
          D14M2[0] = INDEX*O"100" + REASON - INDEX*8 + O"3333"; 
          D14M3[0] = SSTJSN[0]; 
          OMSG(DFMSG14,0);
          END 
        IF REASON EQ RC$UCPSO 
        THEN                           # APP SWAPPED OUT BY OS         #
          BEGIN                        # RESUME PWL PROCESSING         #
          ATPSO[ACBAN[0]] = TRUE; # SET PWL EXIST FLAG                 #
          OSCHAPP(P<ACB>);             # SCHEDULE APPLICATION          #
 
          IF PWLID[0] EQ PWLIDVALUE    # PWL IS FROM INBOUND BUFFER    #
          THEN                         # INITIALIZE PWL RING           #
            BEGIN 
            IF ACBPWLFP[0] EQ 0 
               AND ACBPWLBP[0] EQ 0 
            THEN
              BEGIN                      # PWL RING IS EMPTY           #
              ACBPWLFP[0] = P<PWLHDR>;
              ACBPWLBP[0] = P<PWLHDR>;
              PWLNPWLFP[0] = LOC(ACBPWLFP[0]);
              PWLNPWLBP[0] = LOC(ACBPWLBP[0]);
              END                        # EMPTY PWL RING              #
            ELSE
              BEGIN                      # PWL RING EXISTS, INSERT IT  #
              PWLNPWLFP[0] = LOC(ACBPWLFP[0]) ;  # FORWRAD TO FIRST ONE#
              PWLNPWLBP[0] = ACBPWLBP[0] ;   # BACK TO CURRENT LAST    #
              P<PWLHDR> = ACBPWLBP[0] ;      # LOOKIN AT CURRENT BACK  #
              PWLNPWLFP[0] = PWLADD ;    # FORWARD POINTS TO NEW       #
              ACBPWLBP[0] = PWLADD ;     # ACB BACK TO NEW             #
              END                        # INSERT INTO PWL RING        #
 
            P<PWLHDR> = PWLADD ;
            PWLID[0] = PWLRIDVALUE;    # SET PWL RING ID FOR PWL       #
 
            END 
          END 
 
        ELSE
          BEGIN 
 
          IF REASON EQ RC$UCPNF 
          THEN                         # APPLICATION FAILED            #
            FAILADR = P<ACB>;          # APPLICATION-S ACB ADDRESS     #
 
          ELSE
            BEGIN 
            IF REASON EQ RC$FNTNS OR   # NO ROOM IN UCP-S LOCAL FNT    #
               REASON EQ RC$FLIMIT     # UCP-S FILE LIMIT REACHED      #
            THEN                       # ABORT APPLICATION             #
              BEGIN 
              ABTAPPF = XFNTERR;       # FILE LIMIT OR FNT SPACE ERROR #
              ABTADDR = P<ACB>;        # APPLICATION-S ACB ADDRESS     #
              END 
 
            ELSE                       # NAM SST REQUEST ERROR         #
              ABORT(0,0);              # ABORT NIP                     #
            END 
          END 
 
        END 
 
      RETURN ;
      END 
 
      TERM