         PCC      0                                                             
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
*                                                                               
*        OVERLAY MADE UP OF PINIT CAL PROCESSOR & SUBR'                         
*                                                                               
*        PINIT,   PINTCHK,PINTABNM                                              
*        TMGETLMI (INTERNAL SUBR)                                               
*        TMINTCB (INTERNAL SUBR)                                                
*        TMGETSTI,TMISTI (INTERNAL SUBR)                                        
*                                                                               
         DEF      A:PINIT                                                       
         DO1      #ECB                                                          
         DEF      PINTABNM                                                      
         DEF      PINTX,PINTX1,PINTX5                                           
         DO       #ECB                                                          
         DEF      PINTXSIG,PINTXABN,PINTXR8                                     
         ELSE     #ECB                                                          
         DEF      PINTX4,PINTXBDC                                               
         FIN      #ECB                                                          
OLAYFLAG EQU      'PINI'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** PINIT **'                                                 
         TITLE    '** PINIT - OVERLAY EXITS AND REFS **'                        
         SPACE    5                                                             
PINTX    B        CALSTDX           GO TO STANDARD CAL EXIT                     
PINTX1   B        TMX1                                                          
PINTX5   B        TMX5                                                          
         DO       #ECB                                                          
PINTXSIG B        SIGNAL1                                                       
PINTXABN B        SIGABNM                                                       
PINTXR8  B        *R8                                                           
         ELSE     #ECB                                                          
PINTX4   B        TMX4                                                          
PINTXBDC B        BADCAL                                                        
         FIN      #ECB                                                          
         TITLE    '** PINIT - INIT CAL1 PROCESSOR **'                           
*                                                                               
*        INIT     CAL PROCESSOR, ENTRY FROM CAL1 ENTRY                          
*                                                                               
*        REGISTER USAGE DURING THE CAL                                          
*        R0 - WORKING               R1 - WORKING                                
*        R2 - ECB ID                R3 - FPT                                    
*        R4 - TASK ID, CRNT/NEW     R5 - LMID NEW TASK                          
*        R6 - JOB ID NEW TASK       R7 - TSPACE AREAS, WORKING                  
*        R8-R12 - WORKING                                                       
*        R13 - NON-ZERO IF SECONDARY R14 - WORKING (GETFPTN)                    
*        R15 - TYC AND GETFPTN #                                                
PINIT    LI,R15   0                 INITIALIZE THE TYPE COMPL                   
A:PINIT  EQU      PINIT                                                         
         DO       #ECB                                                          
         LW,R0    0,R3                  IS THE FPT EXTENDED?                    
         CW,R0    XFPTP0                                                        
         BAZ      PINITE1               ILLEGAL FPT                             
         LW,R0    1,R3                  IS THE INIT WITH WAIT?                  
         BIFPRIM  PINIT2                PRIMARY?                                
         CI,R4    CTID                  CONTROL TASK?                           
         BNE      PINIT4                SECONDARY, NOT CTRL TASK                
         CI,R0    FPTF2                 IS CTRL TASK INITING PRIM?              
         BANZ     PINIT4                NO, ITS SECONDARY                       
PINIT2   CI,R0    FPTF3                 WITH WAIT?                              
         BAZ      PINIT4                NO, OK                                  
         LI,R15   TYC6B                 WAIT ERROR                              
         B        PINTX1                                                        
         ELSE     #ECB                                                          
         BIFRBM   PINIT4                                                        
         B        PINTXBDC          CAL NOT ALLOWED EXCEPT INTERNALLY           
         FIN      #ECB                                                          
PINIT4   LW,R9    JOB99             FETCH JOB RE-ENT COUNT                      
         BAL,R8   TMGETJID              LOCATE THE JOB FOR THE                  
         B        PINTX1                TASK, ILLEGAL FOR JOB                   
         PUSH     R9                    SAVE JOB RE-ENT                         
*                                       NOT TO EXIST                            
*                                       R6=JOB ID                               
         DO       #ECB                                                          
         BAL,R8   EMBLDECB          BUILD AN ECB FOR THE                        
         B        PINITE2              INIT EVENT (ERROR)                       
         FIN      #ECB                                                          
*                                   FLAGS ,FPT,S-ECB,PR,CL,                     
*                                       EA,TIME                                 
         LI,R13   FPTF2             SET R13 TO PRIMARY/SECONDARY                
         LS,R13   1,R3                  SWITCH, 0=PRIM, 1=SEC                   
*                                                                               
PINIT5   LI,R15   FPTTNAME          FETCH THE TASK NAME                         
         BAL,R5   GETFPTN               TASK NAME MUST BE PRESENT               
         B        PINITE3               ERROR, DELETE THE ECB                   
         LW,R10   R15                   R10,R11 TO TASK NAME                    
         BEZ      PINITE3               BINARY ZERO=NOT USED, ERROR             
         LI,R15   FPTTNAME+1                                                    
         BAL,R5   GETFPTN                                                       
         LW,R15   BLANKS                                                        
         LW,R11   R15                                                           
*        KEEP TASK NAME IN R10-R11 UNTIL TMGETLMI CALL                          
         LI,R15   0                     RESET TYC=N/BUSY                        
         DO       #ECB                                                          
*                                   SET THE ECB CLASS=X'8000'                   
         LI,R1    FPTF1+FPTF2+FPTF4 +X'0040' IF STOP                            
         LS,R1    1,R3                  +X'0000' IF EXECUTE                     
         AI,R1    X'8000'                                                       
         LI,R7    ECBCLASS              +X'0020' IF SECONDARY                   
         STH,R1   *R2,R7                +X'0000' IF PRIMARY                     
*                                                                               
         LI,R7    ECBTINIT          SET THE ECB TYPE TO INIT                    
         STW,R7   ECBCTL,R2                                                     
*                                                                               
         LW,R7    R2                SET R7=LMIPL WORD BEFORE                    
         AND,R7   M17                   CALLING TMGETLMI                        
         CI,R13   0                     ALWAYS STORE ECB ADDRESS                
         BNE      PINIT6                IF PRIMARY, BITS 0-14                   
         LW,R0    ECBPC,R2              = PRIORITY/SEQUENCE                     
         AND,R0   YFF                   USE FPT/CALLERS VALUE                   
         OR,R7    R0                    FOR LACK OF BETTER                      
         ELSE                       #ECB                                        
         LI,R7    0                 LMIPL VALUE FOR SECONDARY                   
         CI,R13   0                                                             
         BNE      PINIT6            B IF SECONDARY                              
         LW,R7    YFF               PRIO/SEQ FOR PRIMARY                        
         FIN      #ECB                                                          
         LI,R1    LMIINIT+LMILOAD   LMISTAT FOR PRIMARY                         
         B        PINIT7                                                        
*                                                                               
PINIT6   RES      0                                                             
         LI,R1    LMISEC+LMIINIT+LMILOAD  LMISTAT FOR SECONDARY                 
         CI,R6    BKGJID            SET BACKGROUND/FOREGROUND                   
         BNE      %+2                   BIT                                     
         AI,R1    LMIBKG                                                        
PINIT7   RES      0                                                             
         BAL,R8   TMGETLMI          GET THE LMI ENTRY FOR THE                   
         B        PINITE4               ERROR, DELETE THE ECB                   
         PULL     R9                    REFETCH JOB99 COUNT                     
         CW,R9    JOB99                 RE-ENTERED                              
         BNE      PINIT40               YES, RETRY                              
         DO       #ECB                                                          
         LI,R0    0                 SAVE THE LMI INDEX IN THE                   
         STB,R5   R0                   ECB FOR CLEANUP                          
         STW,R0   ECBRECB,R2                                                    
         FIN      #ECB                                                          
*                                                                               
         ENABLE                                                                 
*                                   NOTE THAT ENTRIES ARE                       
*                                       ZEROED WHEN LMI IS                      
*                                       ACQUIRED.                               
         DO       #ECB                                                          
         BAL,R8   EMARECB           LINK THE ECB INTO THE TASKS                 
         B        PINITE8               RECB CHAIN. ERROR EXIT+1                
*                                       GO FREE LMI,ECB                         
         FIN      #ECB                                                          
*                                                                               
*        GET TSPACE FOR LOAD DCB AND FPT                                        
*                                                                               
         LI,R7    32                                                            
         BAL,R8   GETTEMP           GET DCB/FPT SPACE                           
         B        PINITE8           CANT GET SPACE                              
         DO       #ECB                                                          
         STW,R7   ECBDATA,R2        LINK SPACE TO ECB                           
         ELSE                       #ECB                                        
         LW,R0    STISPCE,R4        LINK SPACE TO CALLER FOR NOW                
         STW,R0   0,R7                                                          
         STW,R7   STISPCE,R4                                                    
         FIN                        #ECB                                        
         ENABLE                                                                 
         LI,R0    0                                                             
         LI,R1    31                                                            
         STW,R0   *R7,R1            CLEAR THE TSPACE BLOCK                      
         BDR,R1   %-1                                                           
*                                                                               
*        GET LOAD MODULE FILE IDENTIFIER                                        
*                                                                               
         PUSH     R5                                                            
*        GET FILE ACCOUNT NAME                                                  
         DO       #DFACNT                                                       
         LI,R15   KE                                                            
         BAL,R5   GETPSII           GET ACCOUNT NAME BLOCK POINTER              
         LI,R14   BLANKS            NONE SPECIFIED. DEFAULT IS BLANKS           
         LCI      2                                                             
         LM,R10   *R14              GET ACCOUNT NAME IN R10, R11                
         FIN                        #DFACNT                                     
*        GET DISK AREA NAME                                                     
         LI,R15   -1                                                            
         BAL,R5   GETPSI            GET AREA NAME                               
         NOP      0                 FPT WORD 0 IS ALWAYS PRESENT                
         LI,R12   X'FFFF'                                                       
         AND,R12  R15               AREA NAME RT-ALIGNED IN R12                 
         BNEZ     PINIT12           B IF AREA NAME WAS SPECIFIED                
         DO       #DFACNT                                                       
         CD,R10   BLANKS                                                        
         BE       %+3               B IF ACCOUNT/AREA UNSPEC (AREA FP)          
         CD,R10   ZEROS                                                         
         BNE      PINIT12           B IF ACCOUNT SPEC (PUBLIC AREA)             
         FIN                        #DFACNT                                     
         LI,R12   'FP'              AREA DEFAULT IS FP                          
PINIT12  RES      0                                                             
         PULL     R5                                                            
*        GET TASK NAME                                                          
         LD,R8    LMINAME,R5        TASK NAME FROM LMI                          
*        CONVERT TASK NAME TO LOAD MODULE NAME VIA JPT                          
PINIT15  EQU      %                                                             
         LW,R1    SJI1,R6               NAME VIA JOB PROGRAM                    
         LW,R1    JCBJPT,R1             TABLE, IF NO JPT, DEFAULT               
         BEZ      PINIT20               TO TASK NAME                            
PINIT16  CD,R8    *R1                   TABLE LOOKUP                            
         BNE      PINIT18           B IF NOT MATCHED                            
         AI,R1    2                 POINT TO LD MODULE NAME                     
         LD,R8    *R1               GET IT                                      
         B        PINIT20                                                       
PINIT18  RES      0                                                             
         MTW,4    R1                                                            
         MTB,-4   R1                                                            
         BNEZ     PINIT16                                                       
PINIT20  RES      0                                                             
*                                                                               
*        INITIALIZE LOAD DCB AND FPT                                            
*                                                                               
         DO       #ECB                                                          
         LW,R7    ECBDATA,R2        GET TSPACE POINTER                          
         ELSE                       #ECB                                        
         LW,R7    STISPCE,R4        GET TSPACE POINTER                          
         FIN                        #ECB                                        
         LW,R0    R7                                                            
         AI,R0    1                 DCB ADDRESS                                 
         LI,R1    X'10'             READ FPT CODE                               
         STB,R1   R0                READ FPT WORD 0                             
         LW,R1    PTISFPT1          READ FPT WORD 1                             
         LCI      2                                                             
         STM,R0   TISFPT,R7         FPT WORDS 0, 1                              
         LM,R0    PTISDCB0                                                      
         STM,R0   1,R7              DCB WORDS 0, 1                              
         STM,R8   6,R7              DCB WORDS 5, 6 (FILE NAME)                  
         STM,R10  10,R7             DCB WORDS 9, 10 (ACNT NAME)                 
         STW,R12  9,R7              DCB WORD 8 (AREA NAME)                      
         LW,R0    PTISDCB7                                                      
         STW,R0   8,R7              DCB WORD 7                                  
*                                                                               
         CI,R13   0                                                             
         BE       PINIT30           B IF PRIMARY INIT REQUESTED                 
         PAGE                                                                   
*                                                                               
*        FINISH OFF SECONDARY INIT REQUEST                                      
*                                                                               
         DO       #MAP                                                          
         LI,R7    PINITRTS          ACQUIRE AN RTS FOR TASK                     
         LI,R1    0                     INITIATION TO USE UNTIL                 
         STH,R7   R1                    THE TASK IT IS LOADING                  
         BAL,R8   GETTEMP               IS SUFFICIENTLY RESIDENT                
         B        PINITE7               TO HAVE AN RTS. ERROR                   
         LW,R0    R7                    R0,R1=STACK CONTROL                     
         AND,R0   M24                   DOUBLEWORD                              
         AI,R0    -1                    ADDRESS-1/SIZE,0                        
         STD,R0   LMIRTS,R5             ATTACHED TO THE LMI                     
*                                                                               
         ENABLE                                                                 
         FIN      #MAP                                                          
*                                                                               
*                                   CREATE AN STCB.  TEMPORARILY                
         LI,R7    STCBSIZE              LINK TO THE CURRENT                     
         BAL,R8   GETTEMP               (INITING) TASK.                         
         B        PINITE6               NO SPACE FOR STCB,                      
*                                       ABORT INIT AND CLEAN UP                 
         LW,R0    R7                    LINK IN TSPACE CHAIN                    
         XW,R0    STISPCE,R4            R0=R7=STCB ADDRESS                      
         STW,R0   0,R7                  REST OF DATA CHAIN                      
*                                                                               
         ENABLE                                                                 
*                                                                               
         LI,R9    0                     SET THE BKG,FGD BIT                     
         CI,R6    BKGJID                IN PCB FLAGS                            
         BNE      %+2                                                           
         LW,R9    Y4                                                            
         AW,R9    PINITPCB              R9=PCB WORD FOR STCB                    
         STW,R9   LMIPCB,R5                                                     
         LI,R10   TDRDLRET          SET R10-R11=ENTRY PSD                       
         LW,R11   Y07                   RETURN TO DISPATCHER                    
*                                                                               
         BAL,R8   TMINTCB           INITIALIZE THE STCB                         
*                                                                               
*                                   ACQUIRE AN STI ENTRY                        
*                                                                               
         LW,R9    XECBPR                R9=X'FFFF' IF BKG                       
         DO       (#MAP+#UST)>0                                                 
         CI,R6    BKGJID                BACKGROUND JOB?                         
         BE       PINIT26                                                       
         LS,R9    ECBPC,R2              SET R9=PRIORITY WORD                    
         LI,R1    1                     FORCE THE PRIORITY INTO                 
PINIT22  LB,R0    R9,R1                 ACCEPTABLE RANGE, NOT                   
         CI,R0    X'F0'                 >= F0 IN EITHER BYTE                    
         BL       PINIT24               OK                                      
         LI,R0    X'EF'                 SET TO LARGEST LEGAL                    
         STB,R0   R9,R1                 VALUE                                   
PINIT24  AI,R1    -1                    DO THE NEXT BYTE                        
         BEZ      PINIT22                                                       
         FIN      (#MAP+#UST)>0                                                 
PINIT26  LW,R1    R4                    SAVE THE CURRENT TASK ID                
*                                                                               
         AND,R7   M17                   R7=STITCB WORD                          
         OR,R7    XSTIUSED                                                      
         DO       #TSLICE                                                       
         LW,R0    1,R3                                                          
         CI,R0    FPTF5             IS TASK TO BE TIME SLICED                   
         BAZ      PINIT26A          B IF NO                                     
         CW,R0    XFPTP8            WAS PRIORITY DEFAULTED                      
         BANZ     %+2               B IF NO - USER SUPPLIED                     
         LW,R9    XECBPR            DEFAULT X'FFFF' PRIORITY                    
         PUSH     R5                SAVE LMI #                                  
         LI,R15   FPTPRIO           GET ACTUAL PRIORITY WORD                    
         BAL,R5   GETFPTN                                                       
         LW,R9    XECBPR            SHOULD NOT HAPPEN                           
         CI,R15   0                 IS IT BINARY ZERO                           
         BE       PINIT26G          B IF YES - DEFAULT TO FFFF                  
         CI,R15   X'FFFF'           IS IT FFFF                                  
         BNE      PINIT26H          NO LEAVE PRIORITY ALONE                     
PINIT26G LW,R9    XECBPR            DEFAULT TO FFFF                             
PINIT26H PULL     R5                RESTORE LMI #                               
PINIT26A EQU      %                                                             
         FIN      #TSLICE                                                       
         BAL,R8   TMGETSTI              GET AN STI ENTRY                        
         B        PINITE5               NO SPACE                                
*                                                                               
*                                   FINISH INITIALIZING STCB                    
*                                                                               
         DO       #MAP                                                          
         LW,R0    PINITPSD          ALTER THE ENTRY PSD IN THE                  
         STW,R0   STCBPSD*2,R7          STCB TO THE SECONDARY                   
         PUSH     R7                                                            
         LI,R7    STCBTAST          SIZE OF TEMP AST                            
         BAL,R8   GETTEMP           GET IT FROM TSPACE                          
         B        PINITE9           TSPACE NOT AVAILABLE                        
         LI,R0    0                                                             
         LI,R1    STCBTAST-1                                                    
         STW,R0   *R7,R1            ZERO THE TEMP AST                           
         BDR,R1   %-1                                                           
         STW,R0   *R7                                                           
         LW,R0    R7                                                            
         PULL     R7                                                            
         STW,R0   STCBAST,R7        PUT AST POINTER IN STCB                     
         ENABLE                                                                 
         FIN      #MAP                                                          
*                                       TASK INITIATION ENTRY NOW               
*                                       THAT IT IS NOT LINKED TO                
*                                       THE INITING TASK                        
         STB,R4   R7                ALSO SET THE TASK ID, STCB                  
         STW,R7   STCBSTCB,R7           ADDRESS.                                
*                                                                               
*                                   LMI,STI,STCB,ECB ALL COMPLETED              
*                                   START THE TASK INITIATION                   
         DO       #MAP                                                          
         LI,R12   0                 RESET ALL STISTAT FLAGS                     
         DO       #TSLICE                                                       
         LI,R0    FPTF5                                                         
         CW,R0    1,R3                                                          
         BAZ      %+2               B IF TASK IS NOT TO BE TIMESLICED           
         LI,R12   STISLICE          GET TIMESLICE FLAG FOR STISTAT              
         FIN                        #TSLICE                                     
         DISABLE                    GOING                                       
         LW,R1    SJI1,R6               IS JOB TERMINATING                      
         LW,R0    0,R1                  IF SO, GIVE '63'                        
         CW,R0    XJCBJTM               ERROR AND EXIT                          
         BANZ     PINITE10          B IF TERMINATING                            
         STB,R12  STISTAT,R4        REMOVE IN INITIATION BIT                    
         LW,R0    ECBFPT,R2         SET THE ECB IN PROCESS                      
         OR,R0    XECBINP                                                       
         STW,R0   ECBFPT,R2                                                     
         ENABLE                                                                 
*                                                                               
         BAL,R8   TMTPRIO           IF THE INITIATION IS TO BE                  
*                                   EXECUTED AT A HIGHER PRIORITY               
*                                   THAN THE CALLER, GO START IT                
         B        PINTXSIG          ENTER THE SIGNAL CAL, POST                  
*                                   ECB CREATION PHASE                          
*                                                                               
*                                   PRIMARY TASK, LMI CREATED.                  
*                                   REMOVE DUMMY SECONDARY BIT                  
         FIN      #MAP                                                          
         PAGE                                                                   
*                                                                               
*        FINISH OFF PRIMARY INIT REQUEST (ALSO SECONDARY IF UNMAPPED)           
*                                                                               
PINIT30  RES      0                                                             
         DO       #RUNQ                                                         
*                                                                               
*        DETERMINE SEQUENCE NUMBER WITHIN PRIORITY                              
*        FOR PRIMARY LOADING                                                    
*                                                                               
PINIT30A RES      0                 RESTART HERE IF REENTERED                   
         ENABLE                                                                 
         LW,R15   RUN99             LMI REENTRANCE COUNT                        
         LW,R8    LMIPL,R5          PRIO/SEQ OF TASK BEING INITTED              
         LB,R1    LMI#              NR OF LMI ENTRIES                           
PINIT30B RES      0                 LOOP THRU LMI                               
*                                   FIND PENDING LOADS AT SAME PRIORITY         
         LH,R0    LMISTAT,R1                                                    
         CI,R0    LMIRUNQ                                                       
         BAZ      PINIT30D          B IF NOT A PENDING PRIM LOAD                
         LW,R9    YFF                                                           
         CS,R8    LMIPL,R1                                                      
         BNE      PINIT30D          B IF NOT AT SAME PRIORITY                   
         LW,R9    YFFFE                                                         
         CS,R8    LMIPL,R1                                                      
         BG       PINIT30D          B IF ALREADY AT LATER SEQUENCE              
         LS,R8    LMIPL,R1          SAVE THIS PRIO/SEQ                          
PINIT30D RES      0                                                             
         BDR,R1   PINIT30B          LOOP THRU LMI                               
         DISABLE                                                                
         CW,R15   RUN99                                                         
         BNE      PINIT30A          B IF REENTERED                              
         AI,R8    X'00020000'       STEP PAST SAVED SEQUENCE NR                 
         STW,R8   LMIPL,R5          USE THIS FOR NEW TASKS PRIO/SEQ             
*                                                                               
PINIT32  RES      0                                                             
*        STAY DISABLED UNTIL TASK IS QUEUED                                     
         FIN                        #RUNQ                                       
         DISABLE                                                                
         LW,R1    SJI1,R6               IS JOB TERMINATING                      
         LW,R0    0,R1                                                          
         CW,R0    XJCBJTM                                                       
         BANZ     PINITE10              YES, EXIT                               
         DO       #ECB                                                          
         LW,R0    ECBFPT,R2             SET THE ECB IN-PROCESS                  
         OR,R0    XECBINP                                                       
         STW,R0   ECBFPT,R2                                                     
         ELSE                       #ECB                                        
         LB,R1    PCBPOINT                                                      
         LW,R7    STISPCE,R1        GET DCB/FPT SPACE ADDR                      
         STD,R7   LMIRTS,R5         ATTACH DCB/FPT TO NEW TASK                  
         LW,R7    0,R7                                                          
         STW,R7   STISPCE,R1        DETACH IT FROM CALLER                       
         FIN      #ECB                                                          
         LH,R0    LMISTAT,R5                                                    
         OR,R0    XLMIRUNQ          ADD RUNQING BIT TO                          
         STH,R0   LMISTAT,R5        MAKE NEW TASK LOADABLE                      
         ENABLE                                                                 
         BAL,R11  FGLTRIG           TRIGGER THE CONTROL TASK                    
*                                                                               
         DO       #ECB                                                          
         B        PINTXSIG          ENTER THE SIGNAL CAL, POST                  
         ELSE     #ECB                                                          
         B        PINTX4                                                        
         FIN      #ECB                                                          
*                                   ECB CREATION PHASE.                         
PINIT40  RES      0                                                             
         LD,R0    ZEROS                                                         
         STD,R0   LMINAME,R5        JOB REENTRANCE COUNT CHANGED. FREE LMI      
         STH,R0   LMISTAT,R5        AND RETRY                                   
         ENABLE                                                                 
         LW,R9    JOB99                 REFETCH JOB RE-ENT COUNT                
         PUSH     R9                    AND SAVE IT                             
         BAL,R8   TMGETJID             SEARCH FOR THE JOB                       
         B        PINITE4               NOT FOUND THIS TIME                     
         B        PINIT5                RETRY WHOLE THING                       
*                                       EXCL GETTING ECB                        
*                                                                               
*        ERROR EXITS TO CLEAN UP PARTIALLY CREATED TASK WHEN                    
*        ERRORS ARE FOUND IN THE PROCESSING                                     
*                                                                               
PINITE1  LI,R15   TYCTRAP           NO PARMS, TRAP                              
         B        PINTX                                                         
*                                                                               
PINITE2  PULL     R9                ECB ERROR, REMOVE JOB 99                    
         B        PINTX1                AND TAKE ERROR EXIT                     
*                                                                               
PINITE3  LI,R15   TYC62             NO TASK NAME ERROR                          
PINITE4  PULL     R9                    REMOVE JOB99 COUNT                      
         B        PINTX5                EXIT DELETING THE ECB                   
*                                                                               
PINITE5  EQU      %                                                             
         LW,R0    STCBAST,R7        CHECK FOR AST SPACE                         
         BEZ      PINITE5A          B IF NONE                                   
         PUSH     R7                SAVE STCB ADDRESS                           
         LI,R0    0                                                             
         DISABLE                                                                
         XW,R0    STCBAST,R7        CLEAR AST ENTRY                             
         LW,R7    R0                GET TSPACE ADDRESS AND COUNT                
         BAL,R8   RELTEMPI          RETURN TEMP SPACE                           
         ENABLE                                                                 
         PULL     R7                GET STCB ADDRESS                            
PINITE5A EQU      %                                                             
         LI,R0    STCBSIZE                                                      
         STB,R0   R7                FREE THE RTS, STCB AND LMI                  
         DISABLE                                                                
         BAL,R8   RELTEMP           RELEASE STCB TSPACE                         
*                                                                               
PINITE6  EQU      %                 FREE THE RTS ACQUIRED                       
         DO       #MAP                                                          
         LD,R7    LMIRTS,R5                                                     
         MTW,1    R7                    RESTORE TO THE CORRECT                  
         LI,R0    PINITRTS              START ADDRESS AND STORE                 
         STB,R0   R7                    THE LENGTH                              
         DISABLE                                                                
         LD,R12   ZEROS                                                         
         STD,R12  LMIRTS,R5             DETATCH FROM THE LMI                    
         BAL,R8   RELTEMP               AND RELEASE                             
         FIN      #MAP                                                          
PINITE7  LB,R4    TCBPOINT          RESTORE R4 TO CURRENT TASK                  
         DO       #ECB=0                                                        
         LW,R7    STISPCE,R4        UNLINK DCB/FPT SPACE FROM CALLER            
         LW,R0    0,R7                                                          
         DISABLE                                                                
         STW,R0   STISPCE,R4                                                    
         BAL,R8   RELTEMP                                                       
         FIN                        #ECB=0                                      
*                                   WAS BEYOND ADDRECB CALL                     
PINITE8  PUSH     2,R2              SAVE FPT ECB ADDRESS                        
         PUSH     R15               SAVE TYC                                    
         BAL,R8   TTJOB                 AND TERM JOB IF TASK                    
         LD,R12   ZEROS                 WAS HOLDING TASK                        
         PULL     R15               RESTORE TYC                                 
         PULL     2,R2                                                          
         DISABLE                                                                
         STD,R12  LMINAME,R5                                                    
         STH,R12  LMISTAT,R5                                                    
         MTW,1    RUN99                                                         
         ENABLE                                                                 
         B        PINTX5            TAKE EXIT WHICH DELETES THE                 
*                                   ECB INCLUDING THE DATA AREA                 
*                                   IF ONE WAS ACQUIRED.                        
PINITE9  RES      0                 FREE THE STI ENTRY ACQUIRED                 
         PULL     R7                                                            
PINITE9A RES      0                                                             
         LI,R0    0                                                             
         STW,R0   STITCB,R4                                                     
         DO1      #MULTDSP                                                      
         XPSD,0   TMDQR                 REMOVE FROM DISP QUEUE                  
         ENABLE                                                                 
         B        PINITE5               BACKOUT CAL                             
*                                                                               
PINITE10 RES      0                                                             
         LI,R15   TYC63             TYC = BAD JOB NAME                          
         CI,R13   0                                                             
         BNE      PINITE9A          B IF INITTING A SEC LM                      
         B        PINITE7           FINISH ERROR EXIT                           
         PAGE                                                                   
         DO       #ECB                                                          
****************************                                                    
*                                                                               
*        ABNORMAL SUBROUTINE FOR PINIT (INIT TYPE) ECB'S                        
*                                                                               
PINTABNM DISABLE                                                                
         LW,R0    ECBFPT,R2         IS THE ECB POSTED NOW?                      
         CW,R0    XECBBUSY                                                      
         BANZ     PINTA1                NO, CONTINUE                            
         AI,R8    1                     YES, TAKE POSTED EXIT                   
         B        PINTXR8                                                       
PINTA1   CW,R0    XECBINP           IS THE IN-PROCESS BIT SET?                  
         BANZ     PINTXABN              YES, INIT CAL WAS DONE                  
*                                       WHEN TERM OR DELFPT OCCURED.            
*                                       CLEANUP AS A STD SIGNAL.                
         ENABLE                     NOT FULLY INITIATED.  TASK                  
*                                       WAS TERMINATED DURING                   
*                                       INIT CAL. BACK OUT                      
*                                       SPACE ACQUIRED.                         
         LW,R0    ECBRECB,R2        IS THE R-TASK ID SET                        
         BEZ      PINTXABN              NO, NO LMI WAS ACQUIRED.                
*                                       NO SPECIAL RELEASES REQUIRED            
         LB,R5    R0                SET R5=LMID                                 
         PUSH     R8                SAVE THE EXIT WHILE RELEASING               
*                                       SPACE                                   
*                                                                               
         LW,R0    ECBPC,R2          WAS THE INIT A PRIMARY TASK?                
         CW,R0    FPTF2                                                         
         BAZ      PINTA8                YES, NO STI,STCB LOGIC REQ              
         LW,R0    LMISDT,R5         WAS AN STI ENTRY ACQUIRED?                  
         BEZ      PINTA7            NO                                          
*                                                                               
         LB,R4    R0                    R4=TASK ID                              
         DISABLE                    VERIFY THAT STI IN DISPATCH                 
         DO       #MULTDSP                                                      
         LB,R6    STIDNXT               CHAIN BEFORE TRYING TO                  
PINTA2   CB,R4    R6                    DE-LINK                                 
         BE       PINTA3                FOUND, DE-LINK                          
         LB,R6    STIDNXT,R6            SEARCH ON TO END OF                     
         BNEZ     PINTA2                CHAIN (0)                               
         B        PINTA4                NEVER WAS CHAINED,                      
*                                       DO NOT TRY TO DE-LINK                   
PINTA3   EQU      %                 REMOVE THE STI FROM THE                     
         XPSD,0   TMDQR                 THERE IS ONE AND ROLL                   
         FIN      #MULTDSP                                                      
*                                       OUT CHAINS                              
PINTA4   LW,R7    STITCB,R4         SET R7=LOC OF STCB TO FREE.                 
         LI,R0    0                 FREE THE STI ENTRY                          
         STW,R0   STITCB,R4                                                     
         ENABLE                                                                 
         DO       #MAP                                                          
         LW,R0    STCBAST,R7                                                    
         BEZ      PINTA6            B IF TEMP AST NOT ACQUIRED                  
         PUSH     R7                                                            
         LW,R7    R0                                                            
         BAL,R8   RELTEMP           RELEASE TEMP AST TSPACE                     
         PULL     R7                                                            
         FIN                        #MAP                                        
PINTA6   LI,R0    STCBSIZE          NOW FREE THE STCB WHOSE ADDR                
         STB,R0   R7                    IS IN R7                                
         BAL,R8   RELTEMP                                                       
*                                                                               
PINTA7   EQU      %                                                             
         DO       #MAP                                                          
         LD,R7    LMIRTS,R5         FREE THE RTS SPACE ACQUIRED                 
         CW,R7    M24                   IF ANY                                  
         BAZ      PINTA8                NONE                                    
         MTW,1    R7                    RESTORE R7 TO START ADDR                
         LI,R0    PINITRTS              AND SIZE                                
         STB,R0   R7                                                            
         BAL,R8   RELTEMP                                                       
         FIN      #MAP                                                          
*                                                                               
PINTA8   LW,R0    LMIJID,R5         TERM JOB IF THIS IS                         
         LB,R6    R0                    HOLDING TASK                            
         PUSH     2,R2                  SAVE ECB AND FPT                        
         BAL,R8   TTJOB                 TERM JOB                                
         PULL     2,R2                                                          
         LI,R0    0                 FREE THE LMI ENTRY                          
         DISABLE                                                                
         STH,R0   LMISTAT,R5                                                    
         LI,R1    0                     ZERO NAME                               
         STD,R0   LMINAME,R5                                                    
         MTW,1    RUN99                                                         
         ENABLE                                                                 
         PULL     R8                RESTORE LINK                                
         B        PINTXABN                                                      
*                                       EXIT                                    
         FIN      #ECB                                                          
*                                                                               
         PAGE                                                                   
*                                                                               
*        PROTOTYPE TABLES                                                       
*                                                                               
PTISDCB0 DATA     X'0B000081'       LOAD DCB WORD 0                             
         DATA     X'03000000'       LOAD DCB WORD 1                             
PTISDCB7 DATA     P1+#DFACNT*(P2+P3)  LOAD DCB WORD 7                           
PTISFPT1 DATA     P3+P4+P8+P10+F3+F7  LOAD FPT WORD 1                           
         DO       #MAP                                                          
PINITPCB GEN,8,24 X'B0',0           RBM,SECONDARY,MAPPED TASK, NO PCB           
         ELSE     #MAP                                                          
PINITPCB GEN,8,24 X'20',0           SECONDARY ONLY                              
         FIN      #MAP                                                          
*                                   ********  ADD TI ADDR ******                
         DO1      #MAP                                                          
PINITPSD GEN,9,1,5,17  0,1,0,TI     FIRST WORD OF ENTRY PSD TO                  
         TITLE    '** PINIT - TM SUB TO GET/INIT AN STI **'                     
******************                                                              
*    TMGETSTI    *                  SUBROUTINES TO ACQUIRE AND                  
*    TMISTI      *                  INITIALIZE AN STI ENTRY                     
******************                                                              
*                                                                               
* ENTRY  R1       CALLERS TASK ID                                               
*        R5       NEW LOAD MODULE ID                                            
*        R6       JOB ID                                                        
*        R7       TCB WORD FOR NEW STI ENTRY                                    
*        R9       STIPRIO WORD FOR NEW STI ENTRY                                
*        BAL,R8   TMGETSTI                                                      
* EXIT   +1       NO SPACE ERROR, R15=X'66' ENABLED                             
*        +2       GOOD, R4=STI ENTRY                                            
*                 STI, LMI, AND STCB LINKED TOGETHER                            
*                 STI INITIALIZATION COMPLETE                                   
*                 STI IN DISPATCHER QUEUE                                       
*                 INTERRUPTS ENABLED                                            
*                                                                               
* REGISTERS USED:  R0,R1,R4,R9 (R15 IF ERRORS)                                  
* REGISTERS SAVED:  R2,R3,R5-R8,R10-R14 (R15 IF GOOD)                           
*                                                                               
* STACK WORDS: NONE                                                             
* SUBROUTINES CALLED: TMDQA                                                     
*                                                                               
TMGETSTI DISABLE                    FIRST SEARCH STI FOR A FREE                 
*                                       ENTRY                                   
         LB,R4    STI#                                                          
TMGS1    LW,R0    STITCB,R4         ENTRY USED?                                 
         BEZ      TMGS2                 NO                                      
         BDR,R4   TMGS1                 CONTINUE SEARCHING                      
         ENABLE                                                                 
         LI,R15   TYC66                 SET TYC=LACK OF SPACE                   
         B        *R8               EXIT                                        
TMGS2    RES      0                 INITIALIZE THE STI ENTRY                    
         LW,R0    0,R7              UNLINK TCB FROM CALLER                      
         STW,R0   STISPCE,R1                                                    
         STW,R7   STITCB,R4         LINK TO NEW STI                             
         STW,R9   STIPRIO,R4            STIPRIO                                 
         STB,R6   STIJID,R4             STORE JOB ID                            
         STB,R5   STILMID,R4            STORE LMID                              
         LW,R0    R5                CALC RTS FOR K:RTS                          
         SLS,R0   1                                                             
         AI,R0    LMIRTS                                                        
         STW,R0   STIXRTS,R4        USED FOR ENTRY                              
         DO       #MULTDSP                                                      
         STB,R4   STIDNXT,R4            CHAIN THE TASK TO                       
         STB,R4   STIRNXT,R4            ITSELF UNTIL CHAINED                    
         FIN      #MULTDSP                                                      
         LI,R0    STIINIT                                                       
         STB,R0   STISTAT,R4        PREVENT PREMATURE DISPATCH                  
         LI,R0    0                                                             
         STB,R4   R0                                                            
         STW,R0   LMISDT,R5         PUT STI INDEX IN LMI                        
         LI,R0    0                                                             
         STH,R0   STIOVID,R4        ZERO THE REST OF THE STI                    
         STB,R0   STICOUNT,R4                                                   
         DO       #TSLICE                                                       
         LW,R1    QMIN              TIME QUANTUM                                
         STB,R1   STIQMIN,R4                                                    
         STB,R0   STIQMAX,R4                                                    
         FIN      #TSLICE                                                       
         STH,R0   STITICK,R4        ZERO TIME ACCOUNTING                        
         DO1      #ECB                                                          
         STW,R0   STITIME,R4                                                    
         STW,R0   STISPCE,R4                                                    
         LI,R1    0                                                             
         STD,R0   STIRTSB,R4                                                    
         ENABLE                                                                 
         DO1      #MULTDSP                                                      
         XPSD,0   TMDQA             ADD THE STI TO THE DISPATCHER               
*                                       QUEUE                                   
         AI,R8    1                 SKIP RETURN                                 
         B        *R8               EXIT                                        
         TITLE    '** PINIT - TM SUB TO INIT STCB/TCB (TMINTCB) **'             
*******************                                                             
*     TMINTCB     *                 SUBROUTINE TO INITIALIZE A                  
*******************                     TCB OR STCB                             
*                                                                               
* ENTRY  R7       TCB OR STCB ADDRESS, BYTE0=LENGTH                             
*        R4       TASK ID                                                       
*        R9       PCB WORD FOR TCB                                              
*        R10-R11  ENTRY PSD FOR TCB                                             
*        BAL,R8   TMINTCB                                                       
* EXIT   +1       R7, BYTE 0,= TASK ID AT EXIT                                  
*                                                                               
* REGISTERS USED: R0,R1                                                         
*           SAVED: R2-R15                                                       
* STACK WORDS: NONE                                                             
* SUBROUTINES: NONE                                                             
*                                                                               
TMINTCB  LI,R0    0                 PREZERO THE TCB,STCB                        
         LB,R1    R7                    GET THE LENGTH                          
         B        TMINT2                                                        
TMINT1   STW,R0   *R7,R1                                                        
TMINT2   BDR,R1   TMINT1                                                        
         STW,R0   0,R7                  ZERO THE ZEROTH WORD                    
         LB,R0    R7                COMPUTE THE CC FOR INTERMED                 
         AI,R0    -10                   PSD FROM TCB LENGTH                     
         CI,R0    16                    STCB LENGTH>16                          
         BLE      TMINT3                < OR = 16, LEAVE                        
         LI,R0    16                    SET TO 16 (0)                           
TMINT3   SLS,R0   28                    SHIFT TO CC                             
         AND,R7   M24                   ISOLATE TCB ADDR                        
         OR,R0    R7                    AND COMBINE IT WITH CC                  
         AI,R0    4                     TCB PLUS 4 AND STORE                    
         STW,R0   TCBIPSD*2,R7          INTO INTERMED PSD                       
         STW,R11  TCBIPSD*2+1,R7        INH BITS = ENTRY VAL                    
         AW,R0    TMINTSTM          BUILD AND STORE A STM COMMAND               
         STW,R0   TCBSTM,R7                                                     
         DO       #ONLINE           SET LCFI INTO LINKG IF ONLINE               
         LW,R0    %+1                                                           
         LCFI     0                                                             
         STW,R0   3,R7                                                          
         MTW,-1   2,R7                                                          
         FIN                                                                    
         LW,R0    BALRBMSV          STORE A BAL COMMAND                         
         STW,R0   TCBBAL,R7                                                     
         STW,R9   TCBPCB,R7         STORE THE PCBPOINT WORD                     
         STB,R4   R7                BUILD AND STORE THE TCBPOINT                
         STW,R7   TCBTCB,R7             WORD                                    
         LI,R1    TCBEPSD           SET THE ENTRY PSD                           
         STD,R10  *R7,R1                                                        
         B        *R8                                                           
*                                                                               
TMINTSTM STM,R0   +10-4                                                         
         TITLE    '** PINIT - TM SUB TO GET LMI ;ENTRY (TMGETLMI )**'           
*******************                                                             
*     TMGETLMI    *                 SUBROUTINE TO AQUIRE AN LMI                 
*******************                 ENTRY                                       
* ENTRY  R1       STATUS HALFWORD FOR LMISTAT                                   
*        R6       JOB ID                                                        
*        R7       LMIPL VALUE (PRIO-SEQ,SIG ADDR OR ECBID)                      
*        R10-R11  TASK NAME                                                     
*        BAL,R8   TMGETLMI                                                      
* EXITS  +1       ERROR EXIT, R15=ERROR CODE, ENABLED                           
*                             R0=RUN CAL VERSION OF ERROR CODE                  
*                             R5=LMI INDEX IF A DUPLICATE FOUND                 
*        +2       NORMAL EXIT, R5=LMI INDEX, DISABLED                           
* REGISTERS USED: R0,R1,R5,R8,R9,R15 IF ERRORS                                  
*          SAVED: R2-R4,R6-R7,R10-R14,R15 IF NO ERRORS                          
* STACK WORDS: NONE                                                             
* SUBROUTINES: NONE                                                             
*                                                                               
TMGETL0  ENABLE                     ENTER ENABLED MODE                          
TMGETLMI AND,R8   M24               SET R8,BYTE 0=0 (FREE LMI)                  
         LW,R9    RUN99             GET RE-ENTRANCY COUNT                       
         LB,R5    LMI#                                                          
TMGETL1  LH,R0    LMISTAT,R5        IS THE ENTRY USED?                          
         BEZ      TMGETL3               NO                                      
         CI,R0    LMIT              IS THE ENTRY SCHEDULED FOR                  
         BANZ     TMGETL4               RELEASE, IGNORE IF YES                  
         CD,R10   LMINAME,R5        IS THE TASK NAME EQUAL TO                   
         BNE      TMGETL4               THE NEW ONE BEING ADDED?                
         LW,R0    LMIJID,R5         IS THE JOB ALSO EQUAL?                      
         LB,R0    R0                    JOB DEFINED YET                         
         BEZ      TMGETL2               NO, ERROR                               
         CW,R6    R0                                                            
         BNE      TMGETL4               NO                                      
TMGETL2  LI,R15   TYC62             SET R15 TO ILLEGAL TASK TYC                 
         B        *R8                    ERROR EXIT                             
TMGETL3  STB,R5   R8                SAVE FREE ENTRY LOCATION                    
TMGETL4  BDR,R5   TMGETL1           CONTINUE SEARCHING                          
         DISABLE                    CHECK RE-ENTRANCY COUNT                     
         CW,R9    RUN99                 SHOULD WE RETRY?                        
         BNE      TMGETL0               YES                                     
         LB,R5    R8                    CHECK BYTE 0, R8- WAS                   
         BNEZ     TMGETL5               A FREE ENTRY FOUND?                     
         ENABLE                                                                 
         LI,R15   TYC66             SET R15=NO SPACE TYC                        
         B        *R8                   ERROR EXIT                              
TMGETL5  STH,R1   LMISTAT,R5        STORE LMI STATUS                            
         STD,R10  LMINAME,R5            TASK NAME                               
         LD,R0    ZEROS                 ZERO THE REST OF THE LMI                
         STB,R6   R0                                                            
         STW,R0   LMIJID,R5             JOB ID                                  
         LI,R0    0                                                             
         STW,R0   LMIPCB,R5             PCB/FWA AND FLAGS                       
         STW,R7   LMIPL,R5              STORE 'PL' WORD                         
         STW,R0   LMISDT,R5             SDT HEAD, TASK ID                       
         DO       #ECB                                                          
         STW,R0   LMIAET,R5             AET LENGTH AND ADDRESS                  
         STW,R0   LMISECB,R5            S-ECB COUNT AND HEAD                    
         STW,R0   LMIRECB,R5            R-ECB COUNT AND HEAD                    
         FIN      #ECB                                                          
         DO1      #MAP                                                          
         STW,R0   LMIRFT,R5             RFT TABLE ADDR                          
         STD,R0   LMIRTS,R5             RTS CONTROL DOUBLEWORD                  
         LI,R0    255                   MAX COUNTS                              
         STB,R0   LMIMAXS,R5            MAX S-ECBS                              
         STB,R0   LMIMAXR,R5            MAX R-ECBS                              
         MTW,1    RUN99             INCREMENT RE-ENTRANCY COUNT                 
         AI,R8    1                 EXIT TO GOOD EXIT                           
         B        *R8                                                           
         OLAYEND                                                                
         END                                                                    
