Retro1.org codex

*DECK BLDACB
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNT
USETEXT APPSTAT 
USETEXT AT
USETEXT PARAMS
USETEXT PT
USETEXT STATTAB 
USETEXT KDIS
USETEXT KSTTAB
 PRGM BLDACB;                        # BULID ACB ACNT FOR APPLICATION. #
 
 STARTIMS;
 #
*1DC  BLDACB
* 
*     1. PROC NAME             AUTHOR          DATE 
*        BLDACB                N. NICHOLAS     80/08/14 
* 
*     2. FUNCTIONAL DESCRIPTION.
*          PROCESS ACB AND ACNT BUFFERS.
*          FOR APPLICATION NETTING ON.
* 
*     3. METHOD USED. 
* 
*          CHECK FOR DUPLICATE JOB-ID.  FIND FREE AT ENTRY. 
*          IF NO FREE ENTRIES AVAILABLE IN AT  THEN REQUEST 
*          A LARGER BUFFER.  UPDATE HIGHEST APPLICATION NUMBER
*          IN USE IN THE (AT) HEADER.  REQUEST A BUFFER FOR 
*          A APPLICATION CONTROL BLOCK (ACB).  FILL IN ACB
*          INFORMATION.  LINK ACB TO AT ENTRY.  UPDATE
*          STATUS DISPLAY BUFFER INFORMATION IF NECESSARY.
*          REQUEST A BUFFER FOR A APPLICATION CONNECTION
*          TABLE (ACNT).  FILL IN ACNT HEADER INFORMATION.
*          LINK ACB TO ACNT.  RETURN WITH APPLICATION 
*          NUMBER IN PARAMS1. 
* 
*     4. ENTRY PARAMETER. 
* 
*          PARAMS1    =    MINACN        MININUM A C N VALUE
*          PARAMS2    =    MAXACN        MAXIMUM A C N VALUE
*          PARAMS3    =    ANAME         APPLICATION NAME 
*          PARAMS4    =    ONADDR        DATA AVAILABE WORD 
*          JOBID      =    JOBID         APPLICATION JOBID WORD 
* 
*     5. EXIT PARAMETERS. 
* 
*          PARAMS1    =    AN 
* 
*     6. COMDECKS CALLED AND SYMPL TEXT USED. 
* 
*          ACB     ACNT     AT     APPSTAT   NIPDEF 
*           PARAMS    PT  KDIS
*        STATTAB     KSTTAB     OSSIZE
* 
*     7. ROUTINES AND OVERLAYS CALLED.
* 
*          MGROW   COMPASS- WILL GET NEW (AT) BUFFER,TRANSFER 
*                  INFORMATION FROM OLD ( AT ) TO NEW 
*                  ( AT ) AND RELEASE OLD ( AT ) BUFFER.
* 
*          MGETS   COMPASS- WILL GET NEW BUFFERS FOR THE
*                  APPLICATION CONTROL BLOCK ( AT ) AND 
*                  APPLICATION CONNECTION TABLE ( ACNT ). 
* 
*           KPUT - UPDATE K-DISPLAY STATUS BUFFER 
*           KADD - ADD NEW LINE TO STATUS DISPLAY SCREEN
*           DAYTIME - TIME IN DISPLAY 
*           XTRACE - TRACE PROCEDURE CALL 
* 
*     8. DAYFILE MESSAGES AND OTHER INPORTANT INFORMATION.
* 
*          NO DAYFILE MESSAGES. 
*          THIS PROGRAM IS A SECONDARY OVERLAY LOADED 
*          BY SUBROUTINE OVLCALL. WHEN EXECUTION IS 
*          COMPLETED A JUMP IS MADE TO LOCATION RJMAIN
*          TO RETURN TO THE CALLING PROGRAM.
* 
*          W A R N I N G-THIS PROGRAM CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
* 
*          THIS OVERLAY IS CALLED BY - H P N O N -
* 
 #
 STOPIMS; 
# 
           E X T E R N A L    V A R I A B L E S 
# 
 XREF 
   BEGIN
   PROC MGROW;                         # REQUEST A EXTENDED BUFFER     #
   PROC MGETS;                         # REQUEST A NEW BUFFER AREA     #
   PROC XTRACE;                        # RECORD PROCEDURE CELLS        #
   PROC BLDKWL;              # FORMAT KWL TO ADD APP ENTRY TO ST       #
    PROC DAYTIME ;
   LABEL RJMAIN;                       # RETURN ADDRESS IN OVLCALL     #
   END
# 
           I N T E R N A L   V A R I A B L E S
# 
      ITEM UNUSEDAN;                   # APPLICATION NUMBER ( AN )     #
      ITEM TEMPAPI    C(1) ;
      ITEM AKNDX  ; 
      ITEM  KAPP   ;
      ITEM DUPJOBID B;                 # FLAG DUPLICATE JOB-ID         #
      ITEM INDX;                       # INDEX USED FOR SCANING (AT)   #
      ITEM FLAG;                       # DUMMY FLAG                    #
      ITEM DTIME   ;
      ITEM ACNTADDR;                   # POINTER TO (ACNT) BUFFER      #
 
#*****************  E X E C U T A B L E   C O D E     *****************#
 
      BEGIN 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("BDACB") ; 
      CONTROL FI; 
# 
             SET POINTER TO APPLICATION TABLE ( AT ). 
             SCAN ( AT ) FOR OPEN ENTRY IN THE ( AT ).
# 
      UNUSEDAN = 0;                    # A-NUM    USED IN - FOR LOOP   #
      DUPJOBID = FALSE;      # INITIALIZE DUPLIC JOB-ID FLAG           #
# 
            C H E C K    ( A T )   T A B L E   F O R
            D U P L I C A T I O N    J O B I D
            A N D    F O R    F R E E   ( A T )   E N T R Y 
# 
      FOR INDX =1 STEP 1 WHILE
      INDX LS ATBS[0] AND NOT DUPJOBID
      DO
        BEGIN 
        IF ATACBA[INDX] NQ 0       # CHECK IF APPL/ACB EXIST           #
        THEN
          BEGIN                    # ACB DOES EXIST                    #
          P<ACB> = ATACBA[INDX];   # SET BASED ARRAY ADDRESS           #
          IF INDX LQ ATHAN[0] 
          THEN
            IF ACBJNWD[0] EQ JOBID # COMPARE JOBIDS FOR MATCH          #
            THEN
              DUPJOBID = TRUE;     # SET DUPLICATE JOB-ID FLAG         #
          END 
        ELSE
          IF UNUSEDAN EQ 0
          THEN
            UNUSEDAN = INDX;       # SAVE FREE ( AT ) ENTRY            #
        END 
      BEGIN 
      IF NOT DUPJOBID 
      THEN
        BEGIN 
# 
             FOR STATMENT LOOP COMPLETED
             CHECK IF APPLICATION TABLE HAS 
             AN OPEN ENTRY. 
# 
        IF UNUSEDAN EQ 0 AND ATNFE[0]  EQ 0 
        THEN                           # NO OPEN ENTRY,( AT ) IS FULL  #
          BEGIN                        # EXTENT ( AT ) BUFFER AREA     #
          UNUSEDAN = ATBS[0];          # APPLICATION NUMBER            #
# 
          REQUEST EXTENDED BUFFER   FOR THE ( AT ). 
# 
          MGROW(P<AT>,ATBS[0] + ATESIZE,FLAG);
 
          PTAT[0] = P<AT>;             # SET (AT) ADDR IN PT TABLE     #
          ATHAN[0] = UNUSEDAN;         # HIGHEST APPLICATION ENTRY     #
          ATNFE[0] = ATESIZE;             # UPDATE NO. OF FREE ENTRIES #
          END 
        IF ATHAN[0] LS UNUSEDAN 
        THEN
          BEGIN 
          ATHAN[0] = UNUSEDAN;
          END 
# 
          REQUEST A BUFFER FOR A APPLICATION CONTROL BLOCK
          ( A C B ).
# 
        CONTROL IFEQ STAT,1;
        ST$ACB = ST$ACB + 1 ; 
        CONTROL FI ;
        MGETS(ACBSIZE,ACBADDR,TRUE);
 
        P<ACB> = ACBADDR;               # SET POINTER TO ACB BUFFER    #
        ATACBA[UNUSEDAN] = ACBADDR;    # PUT ACB ADDRESS IN (AT) TABLE #
        ATNFE[0] = ATNFE[0] - 1;   # DECREMENT NO. OF FREE ENTRIES     #
        ACBID[0] = ACBIDVALUE;         # IDENTIFY ACB BUFFER BLOCK     #
        ACBAN[0] = UNUSEDAN;           # ACB LOCATION IN (AT) TABLE    #
        ACBJNWD[0] = JOBID;            # JOB IDENTIFACTION WORD        #
        ACBANAME[0] = C<0,7>PARAMS3;   # JOB NAME                      #
        ACBIAUCPA[0] = PARAMS4; 
        ACBIASCPA[0] = LOC(ACBAAVAL[0]);
        ACBIAFP[0] = 1; 
        ACBIAFC[0] = SFWRITE; 
        DAYTIME(DTIME) ;
        ACBNETONT[0] = DTIME ;
 
        IF KDST[0]
        THEN # STATUS DISPLAY ON, ADD APPLICATION ENTRY TO DISPLAY     #
          BLDKWL(KST"APP",UNUSEDAN,0,KADDIDVALUE);
# 
          REQUEST A BUFFER FOR A APPLICATION CONNECTION 
          TABLE (ACNT) FOR THE APPLICATION PROGRAM, LINK
          THE (ACNT) TO THE APPLICATIONS(ACB) BLOCK, AND
          FILL IN THE (ACNT) CELLS FOR IDENTIFICATION AND 
          INFORMATION WHICH IS NEEDED.
# 
        MGETS(ACNTSIZE,ACNTADDR,TRUE);
 
        P<ACNT> = ACNTADDR;            # ACNT BASED ARRAY ADDRESS      #
        ACNTID[0] = ACNTIDVALUE;       # (ACNT)IDENTIFICATION NUMBER   #
        ACNTMINACN[0] = PARAMS1;       # MININUM  ( A C N ) VALUE      #
        ACNTMAXCN[0] = PARAMS2-PARAMS1+1;  # MAX NO. OF CONNECTIONS    #
        ACNTAN[0] = UNUSEDAN;          # APPLICATION NUMBER            #
        ACNTFFCN[0] = PARAMS1;     # INITIALIZE FIRST FREE CN          #
        ACNTNFE[0] = ACNTSIZE - ACNTHSIZE;  # NUMBER OF FREE ENTRIES   #
# 
          LINK APPLICATION CONNECTION TABLE (ACNT)
          TO THE APPLICATION CONTROL BLOCK ( ACB ). 
          RETURN TO CALLING PRAGRAM WITH (APPLICATION 
          NUMBER ( AN ) IN PARAMS1. 
# 
        ACBACNT[0] = P<ACNT>;          # ADDRESS TO ACNT TABLE         #
        PARAMS1 = UNUSEDAN;            # APPLICATION NUMBER ( AN ).    #
        END 
      ELSE
      PARAMS1 = 0;                 # SET APPLICATION AN TO 0           #
      END 
      GOTO RJMAIN;
      END 
 TERM