         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      A:RBMEND                                                      
OLAYFLAG EQU      'INIT'                                                        
         SYSTEM   CPRMON                                                        
RBMEND   EQU      %-1                                                           
A:RBMEND EQU      RBMEND                                                        
         PCC      0                                                             
         TITLE    '** INIT - QUICK PATCHES **'                                  
***********************************************************                     
*                                                         *                     
*        R B M   I N I T I A L I Z E   R O U T I N E      *                     
*                                                         *                     
***********************************************************                     
*                                                                               
*                                   RUNS EVERY TIME RBM IS BOOTED FROM          
*                                     THE RAD, AND THEN IS OVERLAID             
*                                     BY BACKGROUND PROGRAMS.                   
*                                   BOOTS IN ALL RESIDENT FGD. PROGRAMS         
*                                     FROM THE RAD.                             
*                                                                               
INIT     EQU      %                 MUST BE REMOVED                             
         RD,R0    0                 CHECK SENSE SWITCHES                        
         BCR,8    INITGO                                                        
         BCR,4    INITGO                                                        
         B        %-3               IF BOTH SS1,2 SET, HANG                     
         B        INIT              GO CHECK AGAIN                              
********                                                                        
INITGO   RES      0                                                             
         BCR,2    QEND              IF SS3 IS OFF, NO Q PATCH                   
         BCR,12   QEND              IF NO INPUT SPECIFIED, NO Q PATCH EITHER    
         LI,R1    C                 OPLB C INDEX                                
         LB,R1    OPLBS2,R1         GET THE DCT INDEX OF C DEVICE               
         LH,R0    DCT1,R1           GET THE C  DEVICE ADDRESS                   
*                                                                               
         RD,R0    0                                                             
         BCS,8    QPATCHA           READ Q PATCHES FROM C DEVICE                
         BCR,4    INIT                                                          
*                                   READ Q PATCHES FROM OC DEVICE               
         LI,R1    OC                                                            
         LB,R1    OPLBS2,R1         GET DCT INDEX OF OC                         
         LH,R0    DCT1,R1           GET OC DEVICE ADDRESS                       
*                                                                               
         LI,R1    X'86'             OPCODE FOR TTY                              
         STB,R1   :CDW:             PUT IN CDW                                  
QPATCHA  RES      0                                                             
         STW,R0   :ADD:                                                         
QPATCH   BAL,R8   READCARD          QUICK PATCH ROUTINE                         
         LB,R15   INITBUF1                                                      
         CI,R15   ' '               IS IT A BLANK                               
         BE       QEND              YES                                         
*                                   NO                                          
         CI,R15   X'15'             IS IT A NL CODE                             
         BE       QEND              YES                                         
*                                   NO                                          
         LI,R15   0                 R15=ADDRESS VALUE                           
         LI,R7    0                 R7=SCAN CHARACTER OFFSET                    
         BAL,R8   QBUILD            CALL SCAN/BUILD SUBR.                       
         LW,R1    R15               R1=ADDRESS TO PATCH                         
         LI,R15   0                 START BUILDING DATA VALUE                   
QPTCH1   BAL,R8   QBUILD            CALL IT AGAIN                               
         STW,R15  0,R1              STORE THE PATCH                             
         B        QPATCH            LOOP                                        
QBUILD   LB,R0    INITBUF1,R7       BYPASS BLANKS BEFORE DATA                   
         CI,R0    ' '                                                           
         BNE      QBLD1                 END                                     
         AI,R7    1                                                             
         CI,R7    80                    END OF CARD?                            
         BGE      *R8                   DROP IT                                 
         B        QBUILD                                                        
QBLD1    LB,R0    INITBUF1,R7       FETCH THE NEXT CHARACTER                    
         AI,R7    1                 ADVANCE SCAN REG                            
         CI,R0    ' '               END OF SCAN?                                
         BE       *R8               EXIT                                        
         CI,R0    X'15'                                                         
         BE       *R8               EXIT IF NEW-LINE                            
         CI,R0    '+'               END OF SCAN WITH OFFSET                     
         BNE      QBLD2                 NO                                      
         AI,R15   RBM                  YES, ADD RBM OFFSET                      
         B        *R8                   EXIT                                    
*                                                                               
QBLD2    CI,R0    '0'               IS THE HEX CHAR A-F?                        
         BGE      %+2                   NO, ASSUME 0-9                          
         AI,R0    -'A'+X'A'             CONVERT FROM BCD TO HEX                 
         AND,R0   M4                    MASK OFF ALL BUT HEX                    
         SLS,R15  4                 ADD INTO BUILDING WORD                      
         AW,R15   R0                                                            
         B        QBLD1             CONTINUE                                    
*                                                                               
* QUICK PATCH CARD READ                                                         
*                                                                               
READCARD LI,R0    DA(:CDW:)         SUBROUTINE TO READ A CARD                   
         SIO,R1   *:ADD:                                                        
         BCS,12   %-1               LOOP UNTIL ACCEPTED                         
         TIO,R1   *:ADD:                                                        
         BCS,12   %-1               WAIT UNTIL DONE                             
         B        *R8                                                           
:ADD:    DATA     3                                                             
         BOUND    8                                                             
:CDW:    GEN,8,24 6,BA(INITBUF1)    READ AUTOMATIC                              
         GEN,8,24 X'0A',80          HTE,SIL 80 BYTES                            
         TITLE    '** INIT - BASIC LOW CORE SETUP **'                           
QEND     EQU      %                                                             
         DO       #BOOTOV                                                       
*        B        INITBOOT                                                      
         LB,R1    MDDCTI            R1 = DCTX OLD SP AREA                       
         LH,R0    DCT1,R1           R0 = OLD SP DISC ADDRESS                    
         CW,R0    X'25'             HAVE WE BOOTED FROM NEW DRIVE               
         BE       INITBOOT                                                      
*                                                                               
*        SEARCH DCT TABLE FOR SWITCH ADDRESS                                    
*                                                                               
* R0 = ADR OF OLD SP DISK                                                       
* R1 = DCTX OF OLD SP DISK                                                      
*                                                                               
         LW,R2    X'25'                                                         
         LH,R3    DCT1              NO OF DEVICES                               
         CH,R2    DCT1,R3                                                       
         BE       %+3                                                           
         BDR,R3   %-2                                                           
         B        %                 IMPOSSIBLE                                  
*                                                                               
* R2 = ADR OF NEW SP DISK                                                       
* R3 = DCTX OF NEW SP DISK                                                      
*                                                                               
         LW,R5    X'14B'            LENGTH OF MD                                
         CB,R3    MDDCTI,R5         AREA ON OLD SP DISK                         
         BNE      %+4               NO                                          
         LB,R7    MDFLAG,R5         YES, DEALLOCATE AREA                        
         AND,R7   X7F                                                           
         STB,R7   MDFLAG,R5                                                     
         CB,R1    MDDCTI,R5         AREA ON OLD SP DISK                         
         BNE      %+2                                                           
         STB,R3   MDDCTI,R5         YES, CHANGE TO NEW DEVICE                   
         BDR,R5   %-8                                                           
         STB,R3   MDDCTI            CHANGE SP TO NEW DEVICE                     
INITBOOT RES      0                                                             
         FIN      #BOOTOV                                                       
IPLTEMP  EQU      %                                                             
         LI,R6    GTBL+8                                                        
         STW,R6   0,R6              REINITIALIZE TSPACE HEADS                   
         AI,R6    -1                                                            
         CI,R6    GTBL                                                          
         BG       %-3                                                           
         LI,R6    8                 LARGEST BLOCK                               
         LI,R14   S:TEMPN           NUMBER OF WORDS                             
         AI,R14   S:TEMP            BASE OF SPACE                               
         STW,R14  GUTEMP            UPPER BOUND                                 
         LI,R14   S:TEMP            GET BASE                                    
IPLTMP2  LW,R13   R14               PRESERVE                                    
         AW,R13   GINC,R6           HOW MUCH LEFT                               
         CW,R13   GUTEMP            ANY                                         
         BLE      IPLTMP1           YES                                         
         BDR,R6   IPLTMP2           TRY SMALLER                                 
         B        IPLTMPZ           DONE                                        
IPLTMP1  LW,R7    R14               BASE OF SPACE                               
         LW,R0    GINC,R6           SIZE OF SPACE                               
         AI,R0    -1                ADJUST FOR 256                              
         STB,R0   R7                SET UP FOR CALL                             
         BAL,R8   RELTEMP           RELEASE IT                                  
         LW,R14   R13               RESTORE                                     
         B        IPLTMP2           DO NEXT                                     
         PAGE                                                                   
IPLTMPZ  EQU      %                                                             
         LI,R0    OLAYFWA           SET UP OMAN MAP                             
         SLS,R0   -9                CREATE PAGE ADDRESS                         
         STW,R0   OMANFWA                                                       
         LI,R1    -(#SIGMA9M*1+(1-#SIGMA9M)*3)                                  
IPLOMAN  AI,R0    1                 INCRE PAGE ADR                              
         DO       #SIGMA9M                                                      
         STH,R0   OMANPAGE+1,R1                                                 
         ELSE     #SIGMA9M                                                      
         STB,R0   OMANPAGE+1,R1                                                 
         FIN      #SIGMA9M                                                      
         BIR,R1   IPLOMAN                                                       
*        INITIALIZE KEY-IN SPACE                                                
         LI,R7    KEYBYTES                                                      
         SLS,R7   17                                                            
         STW,R7   K:KEYDCB+3        SET BYTE LENGTH IN KEYIN DCB                
         LI,R7    KEYBUF            ADDRESS OF KEYIN BUFFER                     
         STW,R7   K:KEYDCB+2        SET BUFFER WORD ADDRESS IN DCB              
         SLS,R7   2                 MAKE BYTE ADDRESS                           
         STW,R7   K:KEYIN+1         SET FOR USE BY OVERLAYS                     
         AI,R7    KEYBYTES          POINT PAST END OF BUFFER                    
         SLS,R7   -2                MAKE WORD ADDRESS                           
         STW,R7   K:KEYIN           SET FOR USE BY OVERLAYS                     
*        END KEYIN SPACE INITIALIZATION                                         
         LI,R1    FGDPSD            INIT CELL FOR FGD      /SIG7-4986/*C015732  
         STW,R1   K:INITX            ROOT LOADER           /SIG7-4986/*C015732  
*                                                                               
*                                                                               
*                                                                               
*                                                                               
INIT20   RES      0                                                             
*                                                                               
* ADJUST K:DCT PTRS                                                             
*                                                                               
         LI,R0    DCT7                                                          
         STW,R0   K:DCT1            FUDGE K:DCT1                                
         LI,R0    DCT1                                                          
         STW,R0   K:DCT1X           STORE REAL DCT1 TABLE ADDRESS               
         PAGE                                                                   
*                                                                               
         LCI      4                                                             
         LM,R0    OPRCRASH          GET OPERATOR CRASH                          
         STM,R0   X'26'             PUT INTO LOC 26                             
         LW,R0    K:SYS1            MOVE SYSTEM ID FROM SYSGEN-                 
         STW,R0   K:SYSTEM          SAVED CELL TO STND LOCATION                 
*                                                                               
         LW,R3    POFFXPSD                                                      
         STW,R3   X'51'             POWER OFF                                   
*                                                                               
         LW,R3    PONXPSD                                                       
         STW,R3   X'50'                                                         
*                                                                               
         LW,R3    K:HIINT                                                       
         AND,R3   M16                                                           
         LW,R0    SPRXPSD                                                       
INIT20C  STW,R0   0,R3                                                          
         AI,R3    -1                                                            
         CI,R3    X'52'                                                         
         BGE      INIT20C                                                       
*                                                                               
         DO       #SIGMA9                                                       
         LW,R3    MFIXPSD                                                       
         STW,R3   X'57'             MEMORY FAULT INTERRUPT HOOK                 
*                                                                               
         LW,R3    PFIXPSD                                                       
         STW,R3   X'56'             PROCESSOR FAULT INTERRUPT                   
*                                                                               
         FIN      #SIGMA9                                                       
         LW,R3    CLKXPSD                                                       
         STW,R3   X'5B'             COUNTER 4 ZERO INT LOCATION                 
         LW,R3    CLKMTW                                                        
         STW,R3   X'55'             COUNTER 4 PULSE                             
         LW,R3    IOXPSD                                                        
         STW,R3   X'5C'             INITIALIZE I/O INT LOCATION                 
         LW,R3    CPXPSD                                                        
         STW,R3   X'5D'             INITIALIZE C PANEL INT LOCATION             
*                 FIND DEFERED I/O CLEANUP LEVEL                                
         LW,R3    K:IOWD                                                        
         BLEZ     INIT21            SKIP IF NOT AN ADDRESS                      
         AND,R3   M4                MASK OUT GROUP LEVEL                        
         AI,R3    -2                                                            
         BLZ      INIT21            B IF NOT AN EXTERNAL                        
         SLS,R3   4                 EXTERNAL GROUP NUMBER TIMES 16              
         AI,R3    X'60'             PLUS ADDRESS OF FIRST GROUP                 
         LW,R4    K:IOGL                                                        
         SLS,R4   16                                                            
INIT23   SLS,R4   1                                                             
         BCS,8    INIT22            BRANCH IF BIT ON                            
         AI,R3    1                 INCREMENT ADDRESS                           
         B        INIT23            LOOP                                        
         PAGE                                                                   
INIT22   LW,R4    DIOXPSD                                                       
         STW,R4   0,R3              INITIALIZE DIO INT LOC                      
INIT21   LI,R1    TRAPEND-TRAPPSD   SET UP TRAP ADDRESSES                       
         LW,R0    TRAPPSD-1,R1                                                  
         STW,R0   X'3F',R1                                                      
         BDR,R1   %-2                                                           
         LI,R0    SERDEV                                                        
         STW,R0   K:SERDEV                                                      
         LI,R0    REQCOM                                                        
         STW,R0   K:REQCOM                                                      
         LI,R4    QUEUE                                                         
         STW,R4   K:QUEUE                                                       
         PAGE                                                                   
INIT24   DISABLE                    HOLD INTERRUPTS                             
*                                                                               
* ARM AND ENABLE CLOCK, I/O, MFI, AND PFI INTERRUPT LEVELS                      
         LI,R1    BIT19+((BIT20+BIT21)*#SIGMA9)+BIT25+BIT26                     
         WD,R1    X'1200'                                                       
*                                                                               
         LW,R2    K:IOGL            GET I/O DEFERRED LEVEL                      
         BLEZ     INIT25            BRANCH IF NOT SPECIAL LEVEL                 
*                                                                               
         LW,R1    K:IOWD            GET CONTROL WORD FOR TRIGGER                
         AI,R1    -X'500'           CONVERT TO ARM/ENABLE                       
         WD,R2    0,R1              DO IT                                       
*                                                                               
INIT25   RES      0                                                             
*                                                                               
*        CODING TO INITIALIZE ALL PHASES OF TASK MANAGEMENT                     
*                                                                               
         LI,R15   0                 SET R15 = 0                                 
         LI,R1    500               CONVERT UTIMES FROM ITS                     
         LI,R0    0                     ASSEMBLED VALUE OF                      
         DW,R0    UTIMESI               2 MS INTERVALS PER USER                 
         STW,R1   UTIMES                INTERVAL TO USER INTERVALS              
         STW,R1   UTIME                 INIT K:U/K: TIMER COUNT                 
         PAGE                                                                   
*                                       PER SECOND.                             
*                                   INITIALIZE THE DISPATCHER                   
*                                       LEVELS                                  
         LI,R10   TDRDL                 R10-R11=ENTRY PSD                       
         LI,R11   0                                                             
*                                                                               
         LH,R3    RDLILVL1                                                      
         LI,R0    0                 ZERO HI+1 GROUP,LEVEL ENTRIES               
         STH,R0   RDLILVL2,R3                                                   
         STH,R0   RDLIGRP2,R3                                                   
         LB,R2    STI#              NO. OF STI ENTRIES                          
         AI,R2    1                 FOR OFFSET                                  
*                                                                               
INIT3    RES      0                                                             
         AI,R2    -1                NEXT ENTRY                                  
         LI,R0    RBMJID            SET UP STIJID                               
         STB,R0   STIJID,R2                                                     
         LI,R0    CTLMID            SET UP STILMID                              
         STB,R0   STILMID,R2                                                    
         LI,R0    X'FEFE'           SET UP STIPRIO                              
         SLS,R0   16                                                            
         STW,R0   STIPRIO,R2                                                    
         LW,R0    RDLITCB,R3        SET UP STITCB                               
         AND,R0   M17               MASK ADDRESS                                
         OR,R0    XSTIUSED          MARK USED                                   
         STW,R0   STITCB,R2                                                     
         LI,R0    STIPRIM                                                       
         STB,R0   STISTAT,R2        SET UP STISTAT                              
         LW,R7    RDLITCB,R3        SET R7 TO THE TCB FOR RDL                   
         LI,R0    X'0F'             CREATE XPSD                                 
         STB,R0   R7                                                            
         OR,R7    Y008              LOAD REG PTR                                
         LH,R5    RDLIADD,R3           STORE XPSD INTO INT LOC                  
         STW,R7   0,R5                                                          
         EOR,R7   Y008              TURN OFF LRP FLAG                           
         STB,R2   R7                SET UP TCBPOINT                             
         STW,R7   RDLITCB,R3        IN RDLI                                     
         LW,R9    R3                    R9=PCB WORD, RDLI INDEX                 
         AW,R9    Y8                        +RBM BIT IN FLAGS                   
         AND,R7   M24                   ISOLATE TCB ADDR                        
         LW,R0    R7                    AND COMBINE IT WITH CC                  
         AI,R0    4                     TCB PLUS 4 AND STORE                    
         STW,R0   TCBIPSD*2,R7          INTO INTERMED PSD                       
         AW,R0    TMINTSTM          BUILD AND STORE A STM COMMAND               
         STW,R0   TCBSTM,R7                                                     
         LW,R0    BALRBMSV          STORE A BAL COMMAND                         
         STW,R0   TCBBAL,R7                                                     
         STW,R9   TCBPCB,R7         STORE THE PCBPOINT WORD                     
         STB,R2   R7                PUT TASKID IN TCB                           
         STW,R7   TCBTCB,R7             WORD                                    
         LI,R1    TCBEPSD           SET THE ENTRY PSD                           
         STD,R10  *R7,R1                                                        
*                                                                               
         DO1      #MULTDSP                                                      
         STB,R15  RDLISTI,R3        ZERO THE DISPATCHER SUB-                    
*                                       CHIAN HEAD                              
         LH,R9    RDLILVL1,R3       SET ALL RDL LEVELS ARMED                    
         LH,R6    RDLIGRP1,R3       ENABLED                                     
         WD,R9    -X'0500',R6       ARM AND ENABLE                              
         WD,R9    0,R6              TRIGGERED                                   
         LH,R9    RDLILVL2,R3       SET ALL EXISTING STL LEVELS                 
         BEZ      INIT4                 NONEXISTANT                             
         LW,R0    STLXPSD               STORE THE XPSD                          
         STW,R0   1,R5                                                          
         LH,R6    RDLIGRP2,R3       DISARMED,DISABLED                           
         WD,R9    -X'0600',R6                                                   
         WD,R9    -X'0200',R6                                                   
*                                                                               
INIT4    BDR,R3   INIT3             DO THE NEXT RDL,STL PAIR                    
         DO       #MULTDSP                                                      
         STB,R15  STIDNXT           ZERO DISPATCHER CHAIN HEADS                 
         STB,R15  STIRNXT                                                       
         FIN      #MULTDSP                                                      
         PAGE                                                                   
*                                                                               
INIT5    LI,R2    INITTM            PERMANENT RBM TASKS ARE                     
*                                       INITIALIZED ,  R2=                      
*                                       LIST OF ADDRESSES OF                    
*                                       TABLE ENTRIES FOR TASK                  
*                                       MGMT INITIALIZATION.                    
INIT6    LW,R3    0,R2              FETCH THE NEXT TABLE ADDRESS                
         BEZ      INIT7                 DONE                                    
*                                   ACQUIRE AND INITIALIZE                      
*                                       AN LMI ENTRY                            
         LW,R5    0,R3              SET R5=LMI ENTRY FOR TASK                   
*                                                                               
         LW,R1    1,R3                  1 - STATUS FOR LMI                      
         STH,R1   LMISTAT,R5                                                    
         LW,R10   2,R3                  2,3 - TASK NAME FOR LMI                 
         LW,R11   3,R3                                                          
         STD,R10  LMINAME,R5                                                    
         LW,R0    4,R3                  4 - FLAGS,PCB(FWA)                      
         STW,R0   LMIPCB,R5                                                     
         LW,R0    5,R3                  5 - LWA                                 
         LB,R6    R0                    SET R6=JID                              
         STW,R0   LMIJID,R5                                                     
         STW,R15  LMIPL,R5              ZERO PUBLIBS WORD                       
         LW,R0    6,R3                  6 - SD HEAD                             
         STW,R0   LMISDT,R5                                                     
         LW,R0    7,R3                  7,8 - RTS DOUBLE WORD                   
         LW,R1    8,R3                                                          
         STD,R0   LMIRTS,R5                                                     
         LW,R0    9,R3                  9 - MAX S ECB                           
         STB,R0   LMIMAXS,R5                                                    
         LW,R0    10,R3                 10 - MAX R ECB                          
         STB,R0   LMIMAXR,R5                                                    
         LW,R0    11,R3                 11 - AET LENGTH,ADDR                    
         DO       #ECB                                                          
         STW,R0   LMIAET,R5                                                     
         STW,R15  LMISECB,R5            ZERO SECB,RECB HEADS                    
         STW,R15  LMIRECB,R5                                                    
         FIN      #ECB                                                          
*                                                                               
*                                   ACQUIRE AND INITIALIZE                      
*                                       AN STI ENTRY                            
         AI,R3    12                POSITION R3 TO THE STI                      
*                                       TABLE (MAKES CHG EASIER)                
         LW,R4    0,R3                  0 - TASK ID TO R4                       
         LW,R0    6,R3                  6 - OLD RTS ENTRY                       
         STW,R0   STIXRTS,R4                                                    
         STB,R5   STILMID,R4            LMID                                    
         STB,R6   STIJID,R4             JOB ID                                  
         LW,R7    1,R3                  1 - TCB ADDR, FLAGS                     
         STW,R7   STITCB,R4                                                     
         LW,R0    4,R3                  4 - PCB FOR STCB                        
         STW,R0   STCBPCB,R7                                                    
         LW,R0    5,R3                  5 - TCB FOR STCB                        
         STW,R0   STCBSTCB,R7                                                   
         LW,R9    2,R3                  2 - PRIORITY WORD                       
         STW,R9   STIPRIO,R4                                                    
         LW,R0    3,R3                  3 - STAT BYTE FOR STI                   
         STB,R0   STISTAT,R4            STORE THE STATUS BYTE                   
         LI,R0    0                                                             
         STH,R0   STIOVID,R4        ZERO THE REST OF THE STI                    
         STB,R0   STICOUNT,R4                                                   
         DO1      #ECB                                                          
         STW,R0   STITIME,R4                                                    
         STW,R0   STISPCE,R4                                                    
         LI,R1    0                                                             
         STD,R0   STIRTSB,R4                                                    
*                                                                               
         DO1      #MULTDSP          QUEUES ONLY WITH MULT DISP                  
         XPSD,0   TMDQA             ADD THE STI TO THE DISPATCHER               
         AI,R2    1                 ADVANCE R2 TO THE NEXT TABLE                
         B        INIT6                 AND CONTINUE                            
*                                                                               
INIT7    RES      0                                                             
         LI,R0    INIT8             SET STCB EPSD=INIT8                         
         STW,R0   CTSTCB                                                        
         LI,R1    1                 SET SOFTWARE TRIGGER                        
         STW,R1   TDTRIG                                                        
         DO       #MULTDSP                                                      
         LH,R3    RDLILVL1          INDEX TO LOWEST DISPATCHER                  
         LW,R1    RDLITCB,R3        HIS OR HER TCBPOINT                         
         STW,R1   TCBPOINT                                                      
         LW,R0    TCBPCB,R1         GET PCB INFO                                
         STW,R0   PCBPOINT                                                      
         FIN      #MULTDSP                                                      
         B        TDSTLIDL          GO TO IDLE, ENABLES AND                     
*                                   SHOULD RETURN TO INIT8 AS                   
*                                   A DISPATCHED VERSION OF THE                 
*                                   CONTROL TASK                                
INIT9    CRASH    'SPACE NOT AVAILABLE TO INITIATION'                           
*                                                                               
TMINTSTM STM,R0   +10-4                                                         
         PAGE                                                                   
INIT8    EQU      %                 CONTINUE WITH INITIATION                    
********************************************                                    
*      JCB INITIALIZATION                  *                                    
********************************************                                    
*                                                                               
         LW,R1    K:FGDBG2          GET # OF WORDS IN BKGD, CONVERT             
         SW,R1    K:BACKBG           TO PAGES   AND                             
         SLS,R1   -9                 STORE IN JCBBKG+1,HW 0                     
         STH,R1   JCBBKG+1                                                      
         LI,R1    1                                                             
         LW,R2    RBMJCBA                                                       
         STW,R2   SJI1,R1                                                       
         LD,R2    RBMTEXT                                                       
         STD,R2   SJI2,R1                                                       
         LI,R1    2                                                             
         LW,R2    BKGJCBA                                                       
         STW,R2   SJI1,R1                                                       
         LD,R2    BKGTEXT                                                       
         STD,R2   SJI2,R1                                                       
         LH,R5    OPLBS1            NO.OF OP LABEL TABLE ENTRIES                
         STB,R5   JCBRBM+JCBOPL1    SET IN RBM JCB                              
         STB,R5   JCBRBM+JCBOPL2                                                
         STB,R5   JCBBKG+JCBOPL1    SET IN BKG JCB                              
         STB,R5   JCBBKG+JCBOPL2                                                
         DO       #ECB                                                          
INIT80   EQU      %                                                             
         LW,R7    K:JAET            SEE IF AN AET IS REQUIRED                   
         SLS,R7   1                 NO. ENTRIES * 2 WORDS/ENTRY                 
         BEZ      INIT83            NO AET REQUIRED                             
         BAL,R8   GETTEMP           GET AET SPACE                               
         B        INIT9             NO TSPACE AVAILABLE                         
         LW,R5    Y2                SET AET LINKED BIT IN JCB                   
         MTW,0    JCBBKG+JCBAET                                                 
         BEZ      INIT80A           FIRW                                        
         STW,R7   JCBRBM+JCBAET                                                 
         STS,R5   JCBRBM                                                        
         B        INIT80B                                                       
INIT80A  RES      0                                                             
         STW,R7   JCBBKG+JCBAET     LINK TO JCBBKG                              
         STS,R5   JCBBKG                                                        
INIT80B  RES      0                                                             
         LI,R1    0                 ZERO TSPACE                                 
         LB,R6    R7                                                            
         BNEZ     INIT81            ZERO MEANS 256 WORDS                        
         LI,R6    256                                                           
INIT81   AI,R6    -1                                                            
INIT82   STW,R1   *R7,R6                                                        
         BDR,R6   INIT82                                                        
         STW,R1   *R7                                                           
         MTW,0    JCBRBM+JCBAET                                                 
         BEZ      INIT80                                                        
         FIN      #ECB                                                          
INIT83   LI,R7    S:JPT             SEE IF A JPT IS REQUIRED                    
         BNEZ     %+2               SKIP IF ZERO                                
         LI,R7    1                 DEFAULT TO 4                                
         SLS,R7   2                 NO. ENTRIES * 4 WORDS/ENTRY                 
         BEZ      INIT86            NO JPT REQUIRED                             
         BAL,R8   GETTEMP           GET JPT SPACE                               
         B        INIT9             NO JPT SPACE                                
         STW,R7   JCBBKG+JCBJPT     LINK JPT TO JCBBKG                          
         LW,R5    Y1                SET JPT LINKED BIT IN JCB                   
         STS,R5   JCBBKG                                                        
         LI,R1    0                 ZERO TSPACE                                 
         LB,R6    R7                                                            
         BNEZ     INIT84            ZERO MEANS 256 WORDS                        
         LI,R6    256                                                           
INIT84   AI,R6    -1                                                            
INIT85   STW,R1   *R7,R6                                                        
         BDR,R6   INIT85                                                        
         STW,R1   *R7                                                           
         LB,R7    R7                GET JPT SPACE FOR RBM JOB                   
         BAL,R8   GETTEMP           GET SOME SPACE                              
         B        INIT9             NO SPACE                                    
         STW,R7   JCBRBM+JCBJPT     SET IN RBM JCB                              
         LW,R5    Y1                SET JPT LINKED BIT IN JCB                   
         STS,R5   JCBRBM                                                        
         LI,R1    0                 ZERO SPACE                                  
         LB,R6    R7                                                            
         BNEZ     INIT84A                                                       
         LI,R6    256                                                           
INIT84A  AI,R6    -1                                                            
INIT85A  STW,R1   *R7,R6                                                        
         BDR,R6   INIT85A                                                       
         STW,R1   *R7                                                           
*                                                                               
*                                                                               
*                                                                               
INIT86   RES      0                                                             
         LH,R1    OPLBS1            INITIALIZE OPLBS3                           
INIT87   LB,R6    OPLBS2,R1                                                     
         STB,R6   OPLBS3,R1                                                     
         BDR,R1   INIT87                                                        
         TITLE    '** INIT - SYSTEM PATCHING **'                                
         DO       #PATCH                                                        
INIT26C  RD,R0    0                 ANY MODIFY COMMANDS                         
         BCR,12   INIT29            SKIP IF NO PATCHING                         
*                                                                               
*                                                                               
*  SYSTEM PATCHING  *                                                           
*                                                                               
*                                                                               
INIT26D  STCF     R14               SAVE SW SETTING                             
         LI,R0    0                 SET=0 TO ALLOW RDING COMMANDS FROM          
         STW,R0   INIT59            RESET OC FLAG          /SIG7-5418/*C5732 C01
         STW,R0   DISPFLAG          RESET DISPLAY FLAG IN CORE                  
         LCF      R14                                      /SIG7-5418/*C5732 C01
         BCS,4    INIT27D           SS2 INDICATES OC PATCHING                   
         LI,R1    39                MSG4-5 BYTE COUNT      /SIG7-5418/*C5732 C01
         STB,R1   INITMSG4          RESET DEFAULT          /SIG7-5418/*C5732 C01
         STB,R1   INITMSG5               BYTE COUNT        /SIG7-5418/*C5732 C01
         LI,R1    50                MSG6 BYTE COUNT        /SIG7-5418/*C5732 C01
         STB,R1   INITMSG6          REST DEFAULT B/CNT     /SIG7-5418/*C5732 C01
         LI,R1    1                 READ C DEVICE                               
         B        INIT27I                                                       
*                                                                               
INIT27D  LI,R14   15                INPUT VIA OC                                
         STB,R14  INITMSG4          SHORTEN                                     
         STB,R14  INITMSG5           ERROR                                      
         STB,R14  INITMSG6            MESSAGES                                  
         MTW,1    INIT59            SET OC FLAG                                 
         LI,R1    K2                READ OC DEVICE                              
         B        INIT27I           STORE OPLB INDEX IN DCB                     
         PAGE                                                                   
*                                                                               
* READ PATCH CARDS HERE                                                         
*                                                                               
INIT27I  LI,R2    7                 BUILD DCB WORD                              
         STB,R1   F:SI,R2                                                       
         LI,R7    INITSCAN          SET UP SCAN PARAM ADDR.                     
INIT27K  LW,R0    INIT105           BASE OF LAST MODULE                         
         STW,R0   INIT105T          SAVE AS LAST                                
         STB,R2   INITBUF1          SET 1ST CHAR NE ECLAM                       
INIT27L  RES      0                                                             
         CAL1,1   RDSI              READ IN MODIFY/END CARD/SIG7-5432/*C5732 C01
         CAL1,1   WTLL              WRITE PATCH CARD OUT TO LL                  
*                                                                               
INIT27LW RES      0         RETURN FROM CHECK CAL IF STILL BUSY                 
         CAL1,1   CKLL              CHECK LL OUTPUT                             
* NO WAIT PRINT WAS USED TO PREVENT BUFFER AHEAD OF PRINT LINE                  
         LI,R0    1                                                             
         STW,R0   INITSCAN+1                                                    
         LI,R0    0                                                             
         STW,R0   INITSCAN+2                                                    
         STW,R0   INITSCAN+3                                                    
         STW,R0   INIT101                                                       
         BAL,R8   SCANIPL           SCAN COMMAND                                
         CI,R6    0                                                             
         BLE      INIT52                                                        
         LW,R9    YFFFFFF                                                       
         CS,R8    MOD               IS IT !MODIFY                               
         BE       INIT27M                                                       
         CS,R8    DISP              IS IT DISPLAY                               
         BNE      %+3                                                           
         MTW,1    DISPFLAG          YES, SET FLAG                               
         B        INIT27K           GO GET NEXT CARD                            
*                                                                               
*                                                                               
         CS,R8    CLRTEXT           IS A CLEAR CARD                             
         BE       INITCLR           YES                                         
*                                   NO                                          
         CS,R8    END               IS IT !END                                  
         BNE      INIT52            NO                                          
*                                   YES                                         
         PAGE                                                                   
*                                                                               
* END CARD PROCESSING                                                           
*                                                                               
         CI,R6    2                  YES. CHECK IF RBM TO BE MOD. ON RAD        
         BE       INIT28R                                                       
         MTW,1    INIT101           SET END FLAG                                
INIT27M  LI,R0    1                 SCAN FOR SROU,OLAY,RBM,ABS,PATCH            
         STW,R0   INITSCAN+2                                                    
         BAL,R8   SCANIPL                                                       
         MTW,0    INIT101           IF !END CARD CHECK FOR RBM                  
         BEZ      INIT27N                                                       
         CI,R6    2                                                             
         BNE      INIT52                                                        
         CI,R10   0                                                             
         BE       INIT28R           NOT PRESENT                                 
         CW,R8    ALTKWDS                                                       
         BE        INIT28R          GO END RBM                                  
         B        INIT52            ILL. END PARAM.                             
INIT27N  CI,R6    0                                                             
         BNE      INIT52                                                        
         BAL,R7   CPRSYMBL          CHECK CPR SYMBOL TABLE                      
         B        %+2               NOT FOUND                                   
         B        INIT28C           FOUND                                       
         LI,R7    INITSCAN          RESTORE SCAN TABLE POINTER                  
         LI,R2    7                                                             
         LW,R9    YFFFFFF                                                       
         CS,R8    ALTKWDS-1,R2                                                  
         BE       BTABLE-1,R2                                                   
         BDR,R2   %-2                                                           
         B        INIT52            ILL. KEYWORD                                
         PAGE                                                                   
DISP     DATA     'DISP'                                                        
DISPFLAG DATA     0                 SET=1 IF DOING DISP CARD                    
*                                                                               
*                                                                               
*        LW,9     THING TO TRANSLATE                                            
*        BAL,15   HEX2BCD                                                       
*        R10,11 = BCD WORD UPON RETRUN                                          
*                                                                               
HEX2BCD  LW,11    9                                                             
         LI,9     0                                                             
         MTB,4    15                                                            
HEX2BCD2 SLS,10   4                                                             
         SLD,10   4                                                             
         CI,10    8                                                             
         BAZ      %+3                                                           
         CI,10    6                                                             
         BANZ     %+2                                                           
         AI,10    X'39'                                                         
         AI,10    X'B7'                                                         
         MTB,-1   15                                                            
         BNEZ     HEX2BCD2                                                      
         CI,9     0                                                             
         BNEZ     %+3                                                           
         LW,9     10                                                            
         B        HEX2BCD2-1        SECOND,REPLACE FIRST                        
         LW,11    9                                                             
         XW,10    11                                                            
         B        *15                                                           
*                                                                               
*                                                                               
         PAGE                                                                   
*                                                                               
* CLEAR AREA CARD PROCESSING                                                    
*                                                                               
INITCLR  RES      0                                                             
         LI,R0    1                                                             
         STW,R0   INITSCAN+2                                                    
INITCLR2 RES      0                                                             
         BAL,R8   SCANIPL           SCAN FOR AREA NAME                          
         CI,R6    1                                                             
         BL       INIT52            ERROR IF NOT EOF OR EOC                     
*                                   OK                                          
         SLS,R8   -16               MOVE AREA NAME TO RIGHT                     
         LI,R9    0                                                             
         LI,R10   0                 CLEAR FILE NAME TO ZERO                     
         CAL1,1   CLEARASN          ASSIGN DCB TO AREA                          
         CAL1,1   CLEAROPN          OPEN DCB                                    
         CAL1,1   CLEARWRT          WRITE ZEROS INTO FIRST SECTOR               
         CAL1,1   CLEARCLS          CLOSE DCB                                   
         CI,R6    2                 IS IT END OF CARD                           
         BL       INITCLR2          NO, GET ANOTHER AREA                        
         B        INIT27K           YES, PROCESS NEXT CARD                      
*                                                                               
* DCB AND FPTS FOR CLEAR CARD                                                   
*                                                                               
CLEARDCB GEN,8,24 7,1                                                           
         GEN,8,24 10,0                                                          
         DATA     ZEROS                                                         
         DATA     INIT52,INIT52                                                 
         DATA     0,0                                                           
*                                                                               
CLEARASN GEN,8,1,23 8,1,CLEARDCB                                                
         DATA     X'90000000'                                                   
         DATA     INIT52            ERROR EXIT                                  
         DATA     R8                AREA/NAME BLOCK ADDRESS                     
*                                                                               
CLEAROPN GEN,8,24 X'14',CLEARDCB                                                
         DATA     X'C0000000'                                                   
         DATA     INIT52,INIT52     ERROR AND ABN                               
*                                                                               
CLEARWRT GEN,8,24 X'11',CLEARDCB                                                
         DATA     X'12000101'                                                   
         DATA     4                 BYTE COUNT OF 4 (HARDWARE CLEARS REST)      
         DATA     0                 SECTOR ZERO OF AREA IS KEY                  
*                                                                               
CLEARCLS GEN,8,24 X'15',CLEARDCB                                                
         DATA     INIT52,INIT52     ERROR,ABN                                   
         PAGE                                                                   
*                                                                               
****PROCESS (SETRACE,TASK,BUFFER,NO.)******                                     
*                                                                               
INITSETR LI,R0    0                 SET DEFAULTS                                
         STW,R0   S:TRACET          CLEAR TASK                                  
         LW,R0    K:FGDBG2                                                      
         SLS,R0   -1                BOUND IT                                    
         SLS,R0   1                                                             
         STW,R0   INITSETN          BASE FOR TRACEB                             
         LI,R0    100               NO. OF EVENTS                               
         STW,R0   INITSETE          SAVE IT                                     
         CI,R6    2                                                             
         BE       INITS2            DONE                                        
         MTW,1    INITSCAN+1        SET FOR HEX                                 
         BAL,R8   SCANIPL                                                       
         CI,R6    0                                                             
         BL       INIT52            ERROR                                       
         STW,R8   S:TRACET          TASK NO.                                    
         CI,R6    2                                                             
         BE       INITS2            DONE                                        
         BAL,R8   SCANIPL                                                       
         CI,R6    0                                                             
         BL       INIT52                                                        
         SLS,R8   -1                BOUND IT                                    
         SLS,R8   1                                                             
         STW,R8   INITSETN          BASE FOR TRACEB                             
         CI,R6    2                                                             
         BE       INITS2            DONE                                        
         BAL,R8   SCANIPL                                                       
         CI,R6    0                                                             
         BL       INIT52                                                        
         STW,R8   INITSETE          NO. OF EVENTS                               
INITS2   RES      0                                                             
         LW,R0    INITSETN                                                      
         STW,R0   S:TRACEN          NEW BASE                                    
         AI,R0    TRACEND-TRACEB    INST. AREA                                  
         STW,R0   S:TRACE           STACK POINTER                               
         AI,R0    2                                                             
         LW,R1    S:TRACEP                                                      
         SLS,R1   1                                                             
         AW,R0    R1                NO. OF EP'S                                 
         AI,R0    X'10'             ROUND IT                                    
         AND,R0   FFFFFFF0                                                      
         AI,R0    -1                                                            
         STW,R0   TRACESTK          BUILD STACK DW                              
         LW,R1    INITSETE          NO. OF EVENTS                               
         MI,R1    24                WORDS/EVENT                                 
         AI,R1    X'8000'                                                       
         SLS,R1   16                                                            
         AI,R1    X'8000'                                                       
         STW,R1   TRACESTK+1                                                    
*                                   MOVE TRACE TO NEW LOCATION                  
         LI,R1    TRACEND-TRACEB+2                                              
         LW,R0    S:TRACEP                                                      
         SLS,R0   1                                                             
         AW,R1    R0                                                            
         LW,R0    TRACEB,R1                                                     
         STW,R0   *S:TRACEN,R1                                                  
         BDR,R1   %-2                                                           
         LW,R0    TRACEB            LAST WORD                                   
         STW,R0   *S:TRACEN                                                     
*                                                                               
         LW,R0    S:TRACEN                                                      
         STW,R0   OMANTPSD+2        SET UP OMAN                                 
         LI,R0    1                 SET EXTERNAL TRACE SWITCH                   
         STW,R0   S:TRACES                                                      
         B        INIT27K                                                       
*        NOTE: S:TRACE .NE. 0 TELLS OMAN TO BRANCH TO TRACE                     
*              S:TRACES.EQ. 0 TELLS TRACE NOT TO PUT EVENT IN BUFFER            
*        ONCE (TRACE) CARD PROCESSING MODIFIES THE EIP TABLES                   
*        OMAN MUST GO TO TRACE EVEN IF WE ONLY EXIT AGAIN                       
*                                                                               
FFFFFFF0 DATA     X'FFFFFFF0'                                                   
INITSETN DATA     0                                                             
INITSETE DATA     0                                                             
         PAGE                                                                   
*                                                                               
****PROCESS (TRACE,STATE)********                                               
*                                                                               
INITRACE RES      0                                                             
         MTW,0    S:TRACE           DID WE PROCESS (SETTRACE) CARD              
         BEZ      INIT52            NO, ERROR                                   
         BAL,R8   SCANIPL                                                       
         CI,R6    0                                                             
         BL       INIT52            ERROR                                       
         SLS,R8   -16                                                           
         AND,R8   M16                                                           
         CI,R8    'ON'              STATE ON                                    
         BE       %+3               YES                                         
         LI,R14   0                                                             
         B        %+3                                                           
         LI,R14   1                                                             
         LW,R4    S:TRACEP          GET NO. OF EP'S                             
         LW,R15   R6                SAVE AS FLAG                                
INITRACN CI,R15   2                 ALL                                         
         BNE      INITRACX          NO                                          
INITRACA LW,R0    EPIEP,R4          GET EP                                      
         BEZ      INITRACL          DON'T TRACE NON-EXISTENT                    
         MTW,0    R14               ON OR OFF                                   
         BEZ      INITRACZ          OFF                                         
*                                   TURN TRACE ON FOR THIS EP                   
         CW,R0    XBIT8             ON OR OFF                                   
         BANZ     INITRACL          ON,OK                                       
         LI,R1    0                 CLEAR OP CODE                               
         STB,R1   R0                                                            
         LI,R1    X'048'            set to cal1                                 
         SLS,R1   20                POSITION                                    
         STS,R1   R0                SET IT IN                                   
INITRACS STW,R0   EPIEP,R4          STORE IT                                    
INITRACL CI,R15   2                                                             
         BNE      INITRACN                                                      
         BDR,R4   INITRACN          NEXT                                        
         B        INIT27K           DONE                                        
*                                                                               
*                                   TURN TRACE OFF FOR THIS EP                  
INITRACZ CW,R0    XBIT8             ON OR OFF                                   
         BAZ      INITRACL          OFF,OK                                      
         LH,R2    R0                GET OVERLAY ID                              
         AND,R2   X7F               CLEAR REST                                  
         CI,R2    0                 RESIDENT OLAY                               
         BNE      %+3               NO                                          
         LI,R1    X'6800'           USE A BRANCH                                
         B        %+2                                                           
         LI,R1    X'0400'           CAL1                                        
         STS,R1   R2                GATHER IN OVID                              
         STH,R2   R0                PUT IT TOGETHER                             
         B        INITRACS                                                      
*                                                                               
INITRACX CI,R6    2                                                             
         BE       INIT27K           DONE                                        
         BAL,R8   SCANIPL                                                       
         CI,R6    0                                                             
         BL       INIT52            ERROR                                       
         LW,R4    S:TRACEP          GET NO. OF EP'S                             
         CD,R8    TRACESTK,R4       THIS IT                                     
         BE       %+3               YES                                         
         BDR,R4   %-2               NEXT                                        
         B        INIT52            ERROR                                       
         B        INITRACA          GO FIX IT                                   
         PAGE                                                                   
*                                                                               
****PROCESS (OLAY,NAME,LOC)****                                                 
*                                                                               
INIT27P  BAL,R8   SCANIPL           SACN FOR OLAYNAME IN OV TBL                 
         CI,R6    0                                                             
         BNE      INIT52                                                        
         LH,R4    OVLOAD1                                                       
         CW,R8    OVLOAD2,R4                                                    
         BE       INIT27R                                                       
         BDR,R4   %-2                                                           
         CW,R8    INITNAME          IS IT INIT                                  
         BNE      INIT52            ERROR                                       
         LI,R0    INIT              BASE OF INIT                                
         STW,R0   INIT99            BASE                                        
         LI,R0    INITEND                                                       
         B        INIT27R2          PROCESS                                     
INIT27R  LW,R0    EPIEP,R4          IS IT RESIDENT                              
         BEZ      INIT27R1          JCP AND SSOLAYS                             
         AND,R0   Y007F             MASK OFF OVERLAY ID                         
         BNEZ     INIT27R1          NOT RESIDENT                                
         LW,R0    OVISK,R4          GET BASE ADR                                
         SLS,R0   -2                WORD ADR                                    
         STW,R0   INIT99            BASE OF OLAY                                
         SLS,R0   2                                                             
         AH,R0    OVLOAD1,R4        LENGTH OF OLAY                              
INIT27R2 SLS,R0   -2                WORD ADR                                    
         STW,R0   INIT102           END ADR                                     
         MTW,1    INITSCAN+1                                                    
         BAL,R8   SCANIPL                                                       
         CI,R6    1                                                             
         BNE      INIT52            ERROR                                       
         STW,R8   INIT100           LOCATION                                    
         LI,R2    1                 TREAT AS RBM                                
         B        INIT28D                                                       
INIT27R1 LH,R15   OVLOAD1,R4        OLAY SIZE OF FPT                            
*                                                                               
         SLS,R15  -2                CALC. END. ADDR. OF OVLAY                   
         STW,R15  R13                                                           
         LI,R0    OLAYFWA           FWA OF OLAY                                 
         STW,R0   INIT105           SET 'R' VALUE MODIFIER                      
         LW,R8    EPIEP,R4          IS IT A SUB SYS                             
         BNEZ     INIT27R3          NOT SUB SYS                                 
         LW,R0    K:BACKBG          YES, GET 'R' VALUE                          
         STW,R0   INIT105           MODIFIER FOR JCP                            
INIT27R3 LI,R0    INITEND           USE BACKGRD AS BUFFER                       
         SLS,R0   -2                FWA OF BCKGRND.                             
         AI,R0    1                                                             
         LW,R14   S:TRACEP          GET NO. OF EP'S                             
         SLS,R14  1                 DOUBLE IT                                   
         AW,R0    R14                                                           
INIT27S  AW,R13   R0                LWA OF OLAY                                 
         AI,R13   -1                                                            
*                                                                               
         LI,R14   0                 ALLOW ADDING TO END OF OLAY IF SUF          
         LI,R1    SPINDEX           GET SECTOR SIZE TO SEE IF ANY ROOM          
         LB,R1    MDDISCI,R1        REMAINS AT END OF THE SECTOR                
         LH,R8    DISCNWPS,R1                                                   
         DW,R14   R8                                                            
         CI,R14   0                 ANY UNUSED SPACE?                           
         BE       %+2               NO                                          
         AI,R15   1                 YES                                         
         MW,R15   R8                                                            
         AW,R15   R0                                                            
         AI,R15   -1                                                            
         STW,R15  INIT102           ENDING ADDR. OF LAST WORD IN SECTO          
         LI,R15   0                 EXTEND COUNT                                
         STW,R0   INIT99                                                        
         STW,R4   INITOLAY          SAVE OLAY ID                                
         BAL,R8   INIT28RX          READ THE OLAY                               
         MTW,1    INITSCAN+1        SET F1= HEX                                 
         BAL,R8   SCANIPL                                                       
         CI,R6    1                                                             
         BNE      INIT52                                                        
         STW,R8   INIT100           SAVE INITIAL LOC. TO ALTER                  
         B        INIT28E           GO PROCESS VALUE FIELDS                     
         PAGE                                                                   
*                                                                               
****PROCESS (SROU,NAME,LOC)****                                                 
*                                                                               
INIT27T  BAL,R8   SCANIPL           SCAN FOR SROU NAME                          
         CI,R6    0                                                             
         BNE      INIT52            ERROR                                       
         LI,R1    RELOC4-RELOC3     CHECK FOR                                   
         CD,R8    SIMROU,R1          LEGAL NAME                                 
         BE       INIT27V           YES                                         
         BDR,R1   %-2                                                           
         B        INIT52            ERROR                                       
INIT27V  LW,R0    RELOC3,R1         GET ADDRESS OF                              
         LW,R0    *R0                ROUTINE                                    
         BEZ      INIT52            NO, ERROR.                                  
         STW,R0   INIT99                                                        
         AW,R0    SROUSIZE,R1       FIND ENDING ADDRESS                         
         AI,R0    -1                                                            
         STW,R0   INIT102                                                       
         MTW,1    INITSCAN+1        SET F1= HEX                                 
         BAL,R8   SCAN                                                          
         CI,R6    1                                                             
         BNE      INIT52            ERROR                                       
         STW,R8   INIT100           SAVE INITIAL LOC. TO ALTER                  
         B        INIT28D                                                       
*                                                                               
****PROCESS (PATCH,LOC)****                                                     
*                                                                               
INIT27Z  MTW,0    K:PTCH            WAS PATCH AREA ALLOC. AT SYSGEN             
         BNEZ     INIT27Z1          YES                                         
         LI,R0    INITMSG6                                                      
         B        INIT55                                                        
INIT27Z1 MTW,1    INITSCAN+1        READ IN HEX LOCATION                        
         BAL,R8   SCANIPL                                                       
         CI,R6    1                                                             
         BNE      INIT52            ERROR                                       
         STW,R8   INIT100           SAVE REL. LOC TO ALTER                      
         LW,R0    K:PTCH            GET PATCHFWA FOR LOWER                      
         STW,R0   INIT99            LIMIT                                       
         LW,R0    K:PTCHND          GET PATCHLWA FOR UPPER                      
         STW,R0   INIT102           LIMIT                                       
         B        INIT28D                                                       
         PAGE                                                                   
*                                                                               
****PROCESS (RBM,LOC)****                                                       
*                                                                               
INIT28   MTW,1    INITSCAN+1        SCAN FOR INIT. RBM LOC. TO ALTER            
         BAL,R8   SCANIPL                                                       
         CI,R6    1                                                             
         BNE      INIT52            ERROR                                       
         STW,R8   INIT100                                                       
         LI,R0    RBM                                                           
         STW,R0   INIT99                                                        
         LI,R0    INITEND                                                       
         SLS,R0   -2                                                            
         STW,R0   INIT102                                                       
         B        INIT28D                                                       
*                                                                               
****PROCESS (ABS,LOC)****                                                       
*                                                                               
INIT28B  LI,R0    0                                                             
         STW,R0   INIT99            SET F1=CONVERT TO HEX                       
         LI,R0    X'1FFFF'          NO LIMIT ON ABS                             
         STW,R0   INIT102                                                       
         MTW,1    INITSCAN+1                                                    
         BAL,R8   SCANIPL                                                       
         CI,R6    1                                                             
         BNE      INIT52            ERROR                                       
         STW,R8   INIT100                                                       
         B        INIT28D                                                       
*                                                                               
****PROCESS (SYMBOL,LOC)                                                        
*                                                                               
INIT28C  RES      0                                                             
         LI,R7    INITSCAN          RESTORE SCAN TABLE POINTER                  
         STW,R8   INIT99            BASE OF MODIFY RANGE                        
         LI,R0    INITEND                                                       
         SLS,R0   -2                WORD ADDRESSING                             
         STW,R0   INIT102           LIMIT OF MODIFY RANGE                       
         MTW,1    INITSCAN+1        FLAG: SCAN HEX                              
         BAL,R8   SCANIPL           GET LOC                                     
         CI,R6    1                                                             
         BNE      INIT52            B IF BAD CMND FORM                          
         STW,R8   INIT100           DISPLACEMENT FROM (INIT99)                  
         PAGE                                                                   
*                                                                               
****PROCESS 'VALUE' FIELDS****                                                  
*                                                                               
INIT28D  LW,R1    INIT99            GET LOAD LOCATION AS                        
         STW,R1   INIT105           VALUE MODIFIER                              
INIT28E  LW,R0    INIT105T          LAST CARD                                   
         CW,R0    INIT105           HAS IT CHANGED                              
         BE       %+2               NO                                          
         STW,R0   INIT105Z          YES,CHANGE Z VALUE                          
         LW,R1    INIT99            GET LOAD LOCATION                           
         AW,R1    INIT100                                                       
INIT28F  RES      0                                                             
         LI,R8    2                                                             
         STW,R8   INITSCAN+1        FLAG:  SCAN HEX                             
         BAL,R8   SCANIPL           SCAN VALUE TO STORE                         
         CI,R6    0                                                             
         BL       INIT52            B IF SCAN ERROR                             
         BE       %+3               B IF (LOC,SYMBOL) FORM                      
         AW,R8    R12               ADD VALUE MODIFIER                          
         B        INIT28H                                                       
*        (LOC,SYMBOL) FORM                                                      
         LW,R14   R8                SAVE LOC                                    
         LI,R8    1                                                             
         STW,R8   INITSCAN+1        FLAG:  SCAN EBCDIC                          
         BAL,R8   SCANIPL           GET SYMBOL                                  
         CI,R6    1                                                             
         BL       INIT52            B IF BAD CMND FORM                          
         BAL,R7   CPRSYMBL          GET SYMBOL VALUE                            
         B        INIT51            BAD SYMBOL                                  
         AW,R8    R14               ADD LOC TO SYMBOL VALUE                     
         LI,R7    INITSCAN          RESTORE R7                                  
INIT28H  ANLZ,R0  INIT28I2          DOES PATCH FALL OUTSIDE OF AREA             
         CW,R0    INIT102                                                       
         BLE      INIT28I           NO                                          
         LI,R0    INITMSG5          YES, ERROR                                  
         B        INIT55                                                        
INIT28I  RES      0                                                             
         MTW,0    DISPFLAG                                                      
         BEZ      INIT28I2                                                      
         LW,R9    R1                CONVERT ADDRESS                             
         BAL,R15  HEX2BCD                                                       
         STW,R11  BUF2+3                                                        
         LW,R9    *R1               CONVERT OLD VALUE                           
         BAL,R15  HEX2BCD                                                       
         STW,R10  BUF2+7                                                        
         STW,R11  BUF2+8                                                        
         LW,R9    R8                CONVERT NEW VALUE                           
         BAL,R15  HEX2BCD                                                       
         STW,R10  BUF2+12                                                       
         STW,R11  BUF2+13                                                       
         CAL1,1   WTLL2             WRITE OUT BUFFER                            
         CAL1,1   CKLL2             CHEK WRITE O|PERATION                       
         B        %+2                                                           
INIT28I2 STW,R8   *R1               STORE VALUE                                 
         CI,R2    3                 IF ADDING TO END OF OLAY KEEP BYTE          
         BNE      INIT28I1                                        COUNT.        
         CW,R13   R1                                                            
         BL       INIT28I1          EXCEEDS OLAY                                
         CW,R1    R15               IS THIS LLARGEST                            
         BLE      %+2               NO                                          
         LW,R15   R1                KEEP THIS ONE                               
INIT28I1 AI,R1    1                                                             
         CI,R6    2                 ALL ALTERS MADE                             
         BNE      INIT28F           NO                                          
*                                                                               
         MTW,0    DISPFLAG                                                      
         BNEZ     INIT27K           REA ANOTHER CARD                            
         CI,R2    3                 IF OLAY ALTER ON RAD                        
         BNE      INIT27K           OTHERWISE GET NEXT COMMAND                  
         CI,R15   0                 UPDATE BYTE COUNT IN OVLOAD TABLE           
         BE       INIT28P           AND FPT IF OLAY INCREASES IN SIZE.          
         SW,R15   INIT99            SUB BASE                                    
         AI,R15   1                 OFFSET                                      
         SLS,R15  2                 BYTES                                       
         CH,R15   OVILG,R4          LARGER THAN PRESENT                         
         BLE      %+2               NO                                          
         STH,R15  OVILG,R4          SAVE NEW LENGTH                             
         B        INIT28P                                                       
*    INIT28P WRITES SEGMENTS AND JCP ONLY TO RAD                                
INIT28P  BAL,R8   INIT28WX          WRITE IT OUT                                
         B         INIT27K          GO READ ANOTHER COMMAND                     
         PAGE                                                                   
*                                                                               
* INIT28R                                                                       
*                                                                               
INIT28R  RES      0                                                             
         LW,R0     F:DCB                                                        
         CW,R0     Y002             WAS F:DCB OPEND                             
         BAZ       %+2              B IF NOT                                    
         CAL1,1    INITCLS          CLOSE IT                                    
         LI,R1    X'0100'                                                       
         LI,R2    1                  RESTORE DCB                                
         STH,R1   F:DCB+1,R2                                                    
         LI,R0    0                                                             
         STW,R0   F:DCB+5                                                       
         STW,R0   F:DCB+6                                                       
         CAL1,1   F:SICLS                                                       
         CAL1,1   F:LLCLS           CLOSE BOTH SI AND LL                        
         MTW,0     INIT101          B IF THIS RBM ISNOT TO BE                   
         BEZ       INIT29           WRITTEN TO RAD                              
         PAGE                                                                   
*                                                                               
* WRITE OUT CPR FILE WITH PATCHES                                               
*                                                                               
* ADDRESSES X'2A', X'2C', AND X'2D' ARE EXECUTED IN THE BOOT STRAP              
*                                                                               
* ADDRESS X'37' IN THE BOOTSTRAP MUST CONTAIN THE SP DEVICE ADDRESS             
*                                                                               
* ADDRESS X'3B' IN THE BOOTSTRAP MUST CONTAIN THE SECTOR SIZE                   
* IN BYTES FOR THE SP DEVICE                                                    
*                                                                               
* THE I/O SYSTEM CANNOT BE USED FOR THIS WRITE BECAUSE THE                      
* I/O TABLES WOULD BE WRITTEN OUT WITH A Q ENTRY ACTIVE                         
*                                                                               
CPRWRITE RES      0                                                             
         LB,R7    IOQ4              # OF IOQ ENTRIES                            
         MTB,0    IOQ3,R7           IS Q ENTRY ACTIVE                           
         BNEZ     %-2               YES, START OVER                             
         BDR,R7   %-2               LOOP TIL ALL I/O ACTIVITY QUIET             
*                                                                               
         DO       #ERRORLOG                                                     
         LW,R0    LOGSTACK+1                                                    
         AND,R0   M15               MASK OFF ANY WORD COUNT                     
         LCW,R0   R0                MAKE IT NEGATIVE                            
         MSP,R0   LOGSTACK          SUPPRESS ANY OLD LOG ENTRIES                
         FIN      #ERRORLOG                                                     
         LI,R6    SPINDEX           POINT AT SP AREA                            
         LB,R7    MDDCTI,R6         SET DCT INDEX SO ABS SECTOR OK              
*                                                                               
         EXU      X'2A'             GET LAST SECTOR # IN R14                    
         EXU      X'2C'             GET NR OF SECS TO WRITE IN R13              
*                                                                               
         LW,R0    X'3B'             GET SECTOR SIZE IN BYTES                    
         STW,R0   CPRWBPS           AND PUT IN WRITE ORDER                      
*                                                                               
         EXU      X'2D'             GET START BA IN R2                          
CPRWLOOP RES      0                                                             
         STW,R2   CPRWWCDW          PUT IN BYTE ADDRESS                         
         MTB,1    CPRWWCDW          AND THE WRITE ORDER                         
*                                                                               
         BAL,R5   CVTDISC           CONVERT TO REAL SEEK ADDRESS IN R12         
         B        INITERR           ERROR                                       
         STW,R12  CPRWSEEK          AND STORE                                   
*                                                                               
         LI,R0    DA(CPRWCDW)       CDW ADDRESS FOR SEEK/WRITE                  
         SIO,R8   *X'37'            WRITE A SECTOR                              
*                                                                               
CPRWWAIT LI,R1    1000                                                          
         BDR,R1   %                 WAIT 1 MS                                   
*                                                                               
         TIO,R8   *X'37'            IS I/O DONE                                 
         BCS,12   CPRWWAIT          NO, WAIT SOME MORE                          
*                                   YES                                         
         SW,R2    CPRWBPS           SUBTRACT SECTOR COUNT FROM BA               
         AI,R14   -1                DECREASE SECTOR NUMBER                      
*                                                                               
         BDR,R13  CPRWLOOP          AND WRITE OUT NEXT SECTOR                   
*                                                                               
         B        INIT29            EXIT WHEN DONE                              
         PAGE                                                                   
*                                                                               
* CDW FOR CPR WRITE                                                             
*                                                                               
         BOUND    8                                                             
CPRWCDW  GEN,8,24 3,BA(CPRWSEEK)    SEEK ORDER                                  
         GEN,8,24 X'20',4           BYTE COUNT OF 4 WORKS ALWAYS                
*                                                                               
CPRWWCDW DATA     0                 WRITE, BA OF X'40' TO START WITH            
CPRWBPS  DATA     0                 BYTE COUNT FOR ONE SECTOR                   
*                                                                               
CPRWSEEK DATA     0                                                             
*                                                                               
*                                                                               
         PAGE                                                                   
*                                                                               
*                                                                               
*        INIT28RX READS THE OLAY                                                
*        INIT28WX WRITES THE OLAY                                               
*                                                                               
*        BAL,R8   INIT28-X                                                      
*                                                                               
INIT28RX PUSH     0,R0              SAVE REGS                                   
         LI,R4    FCRRAD            READ FUNCTION                               
         B        INIT28XX                                                      
INIT28WX PUSH     0,R0              SAVE REGS                                   
         LI,R4    FCWRAD            WRITE FUNCTION                              
INIT28XX RES      0                                                             
         LI,R6    6                 RETRY SIX TIMES                             
         LI,R7    SPINDEX           FIND SP AREA'S DCT INDEX                    
         LB,R7    MDDCTI,R7                                                     
         LD,R8    INITEA            END ACTION                                  
         LW,R10   INIT99            BUFFER ADDRESS                              
         SLS,R10  2                 BYTE ADDRESS                                
         LW,R2    INITOLAY          OVERLAY ID                                  
         LH,R11   OVILG,R2          GET BYTE LENGTH                             
         LW,R12   OVISK,R2          GET SEEK ADDRESS                            
         LI,R13   1                 READ AT OMAN PRIOIRITY                      
         LI,R0    0                                                             
         STW,R0   INITYC            CLEAR TYPE COMPLETION                       
         BAL,R5   QUEUE                                                         
         B        INIT28CR          ERROR-CRASH                                 
         LB,R0    INITYC            DONE YET                                    
         BEZ      %-1               NO                                          
         PULL     0,R0              RESTORE REGS                                
         B        *R8               RETURN                                      
INIT28CR CRASH    'INIT Q ERROR'                                                
         BOUND    8                                                             
INITEA   GEN,8,24 1,INITYC                                                      
         DATA     0                                                             
INITYC   DATA     0                                                             
INITOLAY DATA     0                                                             
         TITLE    '** INIT - SIMULATOR SETUP **'                                
***** SHOULD BE DONE IN SYSGEN.....                                             
INIT29   ENABLE                                                                 
INIT29A  RES      0                                                             
         FIN                                                                    
         LI,R1    -4                EXCHANGE                                    
         LW,R0    K:XITSIM+4,R1                                                 
         DO       #INSTSIM                                                      
         XW,R0    K:FPSIM+4,R1      AT K:FPSIM                                  
         ELSE                                                                   
         LW,R0    BCRASH0           BRANCH INST. TO CRASH                       
         FIN                                                                    
         STW,R0   K:XITSIM+4,R1     WITH 4 WORDS                                
         BIR,R1   %-3               AT K:XITSIM                                 
         TITLE    '** INIT - RESIDENT FOREGROUND PROGRAMS **'                   
*                                                                               
*                                   LOAD IN ANY RESIDENT FGD. PROGRAMS          
*                                                                               
         RD,R0    0                 IF SENSE SWITCH 4 IS ON, DON'T              
         BCS,1    INIT37X           LOAD RESIDENT FOREGROUND PROGRAMS           
         LI,R1    FPINDEX           FIND OUT IF AN 'FP' AREA IS                 
         LB,R15   MDFLAG,R1         ALLOCATED                                   
         CI,R15   ALLOC             IS IT ?                                     
         BAZ      INIT37X             NO, NO PROGRAMS TO LOAD, SO EXIT          
*                                                                               
         LB,R1    MDDISCI,R1        GET SECTOR SIZE                             
         LH,R15   DISCNWPS,R1       FROM DISC TABLE                             
         SLS,R15  2                 CONVERT TO BYTES AND                        
         STW,R15  INITRD+4          STORE BYTE COUNT IN FPT                     
         LW,R1    INIT94                                                        
         STS,R1   K:JCP1            SET JCP XEQ,BCKG. ACTIVE,INIT ACTIVE        
         LI,R5    INITBUF           POINT AT DIRECTORY BUFFER START             
*                                                                               
INIT30   RES      0         READ AND VALIDATE A DIRECTORY SECTOR                
         CAL1,1   INITRD            READ THE FIRST (NEXT) SECTOR                
         LW,R4    R5                RESET DIRE SCAN INDEX TO BEGINNING          
         LCI      2                 TEST FOR A VALID DIRECTORY                  
         LM,R8    DIREIDW1,R4       IE., ARE THE DIRE ID CODEWORDS THERE        
         CD,R8    DIRECODE           THERE ?                                    
         BNE      INIT37              NO, INVALID DIRE; NO PROGS TO LOAD        
*                                                                               
         LW,R15   DIREINFO,R4       GET NUMBER OF WORDS OF INFO IN SECTOR       
         AND,R15  M17                                                           
         BEZ      INIT37            EMPTY: NO INFO AT ALL; SKIP OUT             
*                                                                               
         AW,R15   R5                AND COMPUTE LAST+1 TO LOOK AT               
         LI,R1    DIRELHDR          SET LEN OF HEADER TO SKIP OVER              
*                                                                               
INIT31   RES      0         PROCESS EACH FILE ENTRY                             
         AW,R4    R1                STEP TO NEXT ENTRY                          
         CW,R4    R15               AND END OF DATA IN SECTOR ?                 
         BGE      INIT36              YES, TEST IF ANOTHER SECTOR               
*                                                                               
         LW,R8    DIRENAM1,R4       GET 1ST WORD OF NAME                        
         BEZ      INIT35              DELETED: SKIP IT                          
*                                                                               
         CI,R8    -1                IS IT A BADTRACK ENTRY ?                    
         BE       INIT35              YES, SKIP IT TOO                          
*                                                                               
         LW,R0    DIREFLGS,R4       GET FLAGS, THEN RF FLAG                     
         CI,R0    X'10000'          IS THE 'RF' FLAG SET ?                      
         BAZ      INIT35              NO, DO NOT LOAD IT                        
*                                                                               
         LW,R9    DIRENAM2,R4       GET REST OF NAME                            
         STD,R8   INITRUN+2         STORE NAME IN RUN CAL                       
         CAL1,5   INITRUN           GO TO LOAD FGD. PROG.                       
*                                                                               
INIT35   RES      0         ENTRY PROCESSED: SET UP TO STEP OVER IT             
         LW,R1    DIRELEN,R4        GET LENGTH OF THE ENTRY                     
         AND,R1   M8                                                            
         B        INIT31            TEST IF DONE AND PROCESS NEXT               
*                                                                               
*                                                                               
INIT36   RES      0         END OF DIRE SECTOR; TEST IF ANOTHER                 
         LW,R14   DIREINFO,R5       IS THIS SECTOR LINKED TO ANOTHER ?          
         BGEZ     INIT37              NO, ALL DONE                              
*                                                                               
         LW,R14   DIRENEXT,R5       GET ADDRESS OF NEXT DIRE SECTOR             
         STW,R14  INITRD+5          AND SET AS KEY FOR RANDOM READ              
         B        INIT30            READ THE SECTOR AND PROCESS                 
*                                                                               
INIT37   LW,R0    F:DCB                                                         
         CW,R0    Y002              WAS DCB OPENED                              
         BAZ      INIT37X           NO, DO NOT TRY TO CLOSE IT                  
         CAL1,1   INITCLS           YES, CLOSE IT NOW                           
*                                                                               
INIT37X  EQU      %         END OF LOADING FOREGROUND PROGRAMS                  
         TITLE    '** INIT - ODDS AND ENDS **'                                  
         SPACE    2                                                             
INIT40   RES      0                                                             
         LI,R0    0                                                             
         STW,R0   K:JCP1            RESET INIT BIT                              
*                                                                               
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG                                                       
         BNEZ     INIT41            REQUIRE KEYIN IF ERROR LOGGING              
         FIN      #ERRORLOG                                                     
         DO       #JOBACCT                                                      
         MTW,0    K:ACCNT                                                       
         BNEZ     INIT41            REQUIRE KEYIN IF JOB ACCOUNTING             
         FIN      #JOBACCT                                                      
         B        INIT42                                                        
*                                                                               
         PAGE                                                                   
INIT41   RES      0                                                             
         LCI      0                                                             
         LM,R0    X'10'             LOAD UP DATE/TIME DATA                      
*                                                                               
         CW,R0    K:MONTH           IS DATE/TIME/OPLBS SAVED                    
         BNE      INIT41A           NO                                          
*                                   YES                                         
         STW,R1   K:MONTH+1         RESTORE FEBUARY COUNT                       
*                                                                               
         LCI      3                                                             
         STM,R12  K:DATE1           RESTORE DATE AND TIME                       
         STM,R12  X'10'             FIX LO CORE SO COMPARE WONT WORK AGAIN      
*                                                                               
         DO1      #ERRORLOG                                                     
         BAL,R15  INITLOG                                                       
*                                                                               
         LI,R2    3200                                                          
UPNOTE   RES      0                                                             
         WD,0     X'42'                                                         
         LW,R1    R2                                                            
         BDR,R1   %                                                             
         AI,R2    -1                                                            
         BDR,R2   UPNOTE                                                        
         RD,0     0                 GET SENSE SWITCHES                          
         BCS,1    %+3               SKIP IF RSDFGD SKIP                         
         LI,R1    BIT16             RUN PERIODIC SCHEDULAR                      
         STS,R1   K:CTST                                                        
         CAL1,2   TYPE8             TYPE RESTART MESSAGE                        
         B        INIT42            AND DONT REQUIRE THE DT KEYIN               
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
INIT41A  RES      0                                                             
         LI,R0    X'10'             SET INIT BIT                                
         STW,R0   K:JCP1                                                        
         LI,R0    4                 KEY IN BIT ONLY (NO IDLE)                   
         STB,R0   K:CTST            SET BITS FOR KEYIN AND IDLE                 
         LW,R0    K:VRSION          PUT NON-ZERO VERSION IN MESSAGE             
         BEZ      %+2                                                           
         STW,R0   INITMSG1+6                                                    
         CAL1,2   TYPE1             TYPE 'TELEFILE G00 '                        
         LW,R0    SITE              PRINT NON-ZERO SITE MESSAGE                 
         BEZ      %+2                                                           
         CAL1,1   SITEFPT                                                       
         DO       #550                                                          
         LI,R1    OC                OC OPLABLE INDEX                            
         LB,R1    OPLBS2,R1         DCT INDEX                                   
         LW,R0    DCTMOD,R1         GET MODEL NUMBER                            
         CW,R0    TXT4592           IS IT A HYTYPE                              
         BNE      %+2               NO                                          
         CAL1,2   TYPETAB           YES, SET UP TABS                            
         FIN      #550                                                          
         CAL1,2   TYPE9A            LICENSE MESSAGE PART 1                      
         CAL1,2   TYPE7              OUTPUT MESSAGE FOR DT KEYIN                
INIT42   RES      0                                                             
         PAGE                                                                   
*                                                                               
* DEBUG CONNECTIONS                                                             
*                                                                               
         DO       #DEBUG                                                        
DBUGDVS  RES      0                 DEBUG DEVICE SEARCH                         
         LI,R0    DCTDEBUG                                                      
         BEZ      DBDVS4            B IF DEBUG NOT IN THIS SYSGEN               
         LD,R10   PSDMASK                                                       
         LW,R14   XPSDLNK                                                       
         LH,R1    DCT1              DCT INDEX COUNT                             
         LI,R2    16                MAX. NR. OF DEBUG INTERUPTS                 
DBDVS1   RES      0                                                             
         LB,R0    DCTDEBUG,R1       TEST FOR INTERRUPT ADDR                     
         BEZ      DBDVS3            SKIP IF NULL                                
         AI,R0    X'4F'             ADJUST TO MEMORY ADDRESS                    
         LW,R6    *R0               GET INTERRUPT CONTENTS                      
         CW,R6    SPRXPSD           IS IT FOR SPURIOUS HANDLER ?                
         BE       DBDVS2            YUP, COVER IT                               
         CRASH    'DEBUG DEVICE OVER EXISTING INTERRUPT'                        
DBDVS2   RES      0                                                             
         STW,R14  *R0               STORE XPSD INSTRUCTION                      
         AI,R14   2                 ADJUST REFERENCE ADDRESS                    
         STD,R10  *R14              TO STORE PSD LINKAGE                        
         AI,R14   2                 ADJUST FOR NEXT BLOCK ENTRY                 
         AW,R10   XBIT3             BUMP DEVICE FOUND INDEX                     
         LB,R6    DCTDEBUG,R1       ARM AND ENABLE THE INTERRUPT                
         BAL,R8   ARMENBL                                                       
         BDR,R2   DBDVS3                                                        
         CRASH    'MORE THAN 16 DEBUG DEVICES'                                  
DBDVS3   RES      0                                                             
         BDR,R1   DBDVS1            CONTINUE SEARCH FOR DEBUG DEVICES           
         B        DBDVS4                                                        
         PAGE                                                                   
*                                                                               
* INTERRUPT ARM AND ENABLE LOGIC                                                
*                                                                               
*                                                                               
ARMENBL  RES      0                 ARM & ENABLE INTERRUPT (R6)                 
         BDR,R6   %+1               LET FIRST BE X'50'=0                        
         LI,R7    0                                                             
         SLD,R6   -4                SEPARATE GROUP AND INDEX                    
         SCS,R7   4                                                             
         LCW,R7   R7                SET INDEX NEGATIVE FOR SHIFT                
         LW,R6    R6                TEST FOR GROUP ZERO                         
         BEZ      %+3               YES -                                       
         AI,R6    1                 NO - ADJUST FOR NO GROUP 1                  
         B        %+2                                                           
         AI,R7    2                 ADJUST GROUP 0 OFFSET                       
         LW,R3    XBIT16                                                        
         SLS,R3   0,R7              CONVERT INDEX TO BIT POSITION               
         OR,R6    WDMASK            ESTABLISH WD FUNCTION                       
         WD,R3    *R6               EXECUTE ARM AND ENABLE                      
         B        *R8               RETURN                                      
*                                                                               
WDMASK   DATA     X'00001200'                                                   
XPSDLNK  XPSD     S:DEBUG                                                       
         BOUND    8                                                             
PSDMASK  DATA     DBGBREAK                                                      
         DATA     X'07000000'                                                   
         FIN      #DEBUG                                                        
         PAGE                                                                   
*                                                                               
* CLOCK AND CONTROL PANEL INTERRUPT TRIGGER                                     
*                                                                               
DBDVS4   RES      0                                                             
         LI,R1    500                                      /SIG7-4289/*C5732    
         STW,R1   COUNTER4          INITIALIZE CLOCK VALUE /SIG7-4289/*C5732    
         LI,R1    X'10'                                                         
         WD,R1    X'1200'           ARM/ENABLE CPANEL INTERRUPT                 
         B        IPLMM             GO TO MAPPED SYSTEM INIT                    
*                                   INITIALIZATION IS NOW DONE                  
INITABN  RES      0                                                             
         LB,R10   R10                                                           
         CI,R10   X'30'                                                         
         BNE      INITERR                                                       
         LW,R1    XBIT8                                                         
         BDR,R1   %                 WAIT A BIT                                  
         B        INIT27L           AND TRY AGAIN                               
*                                                                               
INITERR  CRASH    'INITIALIZATION ERROR'                                        
         PAGE                                                                   
*                                                                               
* CONTINUATION CARD READ LOGIC                                                  
*                                                                               
         DO       #PATCH                                                        
INIT50   CAL1,1   RDSI              READ CONTINUATION                           
         B        *R8                                                           
INIT51   LI,R7    INITSCAN          RESTORE R7                                  
INIT52   LI,R1    7                 ITEM NO. TO ERROR MESSAGE                   
         SLS,R11  -8                                                            
         STH,R11  INITMSG4,R1                                                   
         LI,R0    INITMSG4                                                      
INIT55   STW,R0   TYPE3+2                                                       
         CAL1,2   TYPE3                                                         
         CI,R0    INITMSG3                                                      
         BE       INIT56            BRANCH IF INVALID SSW SETTING               
         LI,R0    INIT27K           RETURN FOR NEXT COMMAND                     
         MTW,0    INIT59            CHECK FOR OC                                
         BEZ      INIT57             BRANCH IF NOT                              
         B        *0                GET NEXT COMMAND                            
INIT56   LI,R0    INIT26C           RETURN FOR INVALID SSW SETTINGS             
INIT57   B        %                 HANG                                        
         B        *0                CONTINUE                                    
INIT59   DATA     0                 SET TO 1 FOR OC                             
*                                                                               
         TITLE    '** INIT - SCAN SUBROUTINE **'                                
*                                                                               
*                                   SCANS ONE SUBFIELD AT A TIME                
*                                                                               
*                                   CALL IS   BAL,R8   SCAN                     
*                                     WHERE  R7=ADD. OF INPUT PARAM.            
*                                     WHICH ARE                                 
*                                                                               
*                                       WORD 1= ADD. OF INPUT BUFFER            
*                                               (MUST START ON WORD BND)        
*                                       WORD 2=1, LEAVE FIELD IN EBCDIC         
*                                             =2, CONVERT TO HEX                
*                                             =4, CONVERT TO DECIMAL            
*                                             =3, CONVERT TO HEX OR BCD         
*                                             =5, CONVERT TO DEC OR BCD         
*                                                                               
*                                       WORD 3=0, FIRST TIME FOR CARD           
*                                             =1, CONTINUE ON CARD              
*                                                                               
*                                       WORD 4=0, NO DEVICE TYPE INPUT          
*                                             =1, DEV. TYPE INPUT NEXT          
*                                                 (EITHER YYNDD,OP.             
*                                                  LABEL, OR ZERO)              
*                                                 F1 MUST=1                     
*                                               YYNDD GETS CHANGED TO           
*                                               BITS 0-15 ; YY IN BCD           
*                                               BITS 21-23; N IN BINARY         
*                                               BITS 24-31; DD IN BINARY        
*                                       WORD 5=ADD. OF ROUTINE TO               
*                                              PROCESS  ;                       
*                                                                               
*                                   EXITS WITH FOLLOWING:                       
*                                                                               
*                                     R7- UNCHANGED                             
*                                     R8,R9- CONTAIN VALUE                      
*                                       IF R9=0, R8 CONTAINS DEC OR HEX         
*                                            =NONZERO, R8 AND R9 CONTAIN        
*                                               EBCDIC(UNUSED CHAR. HAVE        
*                                               BLANKS)                         
*                                                                               
*                                     R6=0, END OF SUBFIELD                     
*                                       =1, END OF FIELD                        
*                                       =2, END OF CARD                         
*                                       =-1,ERROR IN SUBFIELD OR FIELD          
*                                         ERRORS ARE:                           
*                                           ILLEGAL CHAR.                       
*                                           MORE THAN 8 CHARS.                  
*                                           COL. 80 SCANNED                     
*                                           ILLEGAL PARENTHSES                  
*                                           NO : IN COL. ONE                    
*                                           EMPTY FIELD OR SUBFIELD             
*                                     R10= NO. CHARS. IN FIELD OR SUBF.         
*                                     R11= SUBFIELD NO. IN EBCDIC FOR           
*                                          ERROR FIELD XX ALARM; CHARS.         
*                                          ARE IN BITS 8-23, OTHER CHARS        
*                                          ARE BLANKS                           
*                                                                               
*                                     R12= MODIFIER VALUE                       
*                                                                               
*                                          REGISTERS USED: R0,R5-R12            
*                                          R7 IS UNCHANGED                      
*                                   AFTER AN ERROR RETURN, WORD 3 OF            
*                                     INPUT PARAM. MUST BE ZERO                 
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
SCANIPL  STW,R8   SCAN99            SAVE RETURN ADDRESS                         
         LW,R0    *R7                                                           
         STW,R0   SCAN96            SAVE ADD. OF BUFFER                         
         LW,R0    SCAN92            IS IT A CONT. CARD                          
         BNEZ     SCAN0             NO                                          
         STW,R7   SCAN88            YES, SAVE R7                                
         AI,R7    4                                                             
         LW,R0    *R7                                                           
         BAL,R8   *R0               ENTER ROUTINE TO READ NEXT CARD             
         LW,R7    SCAN88            RESTORE R7                                  
SCAN0    LW,R8    SCAN89A           HOUSEKEEP R8,R9 TO ALL BLANKS               
         STW,R8   R9                                                            
         LI,R12   0                                                             
         LI,R0    -9                                                            
         STW,R0   SCAN93            HOUSEKEEP CHAR. COUNT                       
         LI,R0    0                                                             
         STW,R0   SCAN95            CLEAR COUNT OF HEX CHARS.                   
         LI,R6    -1                HOUSEKEEP                                   
         STW,R6   SCAN93A           FIRST BYTE OF FIELD FLA                     
         LW,R0    2,R7              IS THIS A CONTINUATION                      
         BNEZ     SCAN4             YES                                         
         STW,R0   SCAN90            HOUSEKEEP FIELD FLAG AND                    
         STW,R6   SCAN91            PARENTHESIS FLAG                            
SCAN1    LI,R0    X'F0F0'                                                       
         STW,R0   SCAN94            HOUSEKEEP FIELD COUNT                       
         LB,R0    *SCAN96           IS COLUMN ONE AN EXCLAM.                    
         CI,R0    X'5A'                                                         
         BNE      SCAN8             NO, ERROR                                   
         LI,R6    1                 SET TO COL. 2                               
         LI,R0    X'40'                                                         
SCAN2    CB,R0    *SCAN96,R6        SCAN OFF LEADING BLANKS                     
         BNE      SCAN6             NOT BLANK                                   
         AI,R6    1                 STEP INDEX                                  
         CI,R6    80                                                            
         BL       SCAN2             NOT COL. 80 YET                             
         LI,R10   0                 BLANK CARD, SET NO. CHARS=0                 
         LI,R6    2                 SET TO END OF CARD                          
         B        SCAN33            EXIT                                        
*                                                                               
SCAN4    LW,R0    SCAN92            IS THIS A CONT. CARD                        
         BEZ      SCAN1             YES                                         
         LW,R6    SCAN98            GET COL. INDEX                              
         AI,R6    1                 STEP TO NEXT COL.                           
SCAN6    LW,R11   1,R7              GET INPUT CONVERSION TYPE IN R11            
         LI,R0    0                                                             
         STW,R0   SCAN98            HOUSEKEEP                                   
         MTW,1    SCAN94            STEP FIELD COUNTER IN EBCDIC                
         LI,R5    3                 CHECK FOR OVERFLOW AND RESET IF             
         LI,R0    X'FA'             OVERFLOW                                    
         CB,R0    SCAN94,R5                                                     
         BG       SCAN7             NO OVERFLOW                                 
         LI,R0    X'F0'             RESET FOR OVERFLOW                          
         STB,R0   SCAN94,R5                                                     
         LI,R5    2                                                             
         MTB,1    SCAN94,R5                                                     
SCAN7    LB,R10   *SCAN96,R6        GET NEXT BYTE                               
         CI,R10   X'C1'                                                         
         BL       SCAN25            SPECIAL CHAR.                               
         MTW,1    SCAN93A           IS THIS FIRST BYTE                          
         BNEZ     SCAN7A            NO                                          
         CI,R11   2                 YES CHECK FOR R PRECEDING STRING  RXXXXXXXX 
         BNE      SCAN7A                                                        
         STW,R7   SCAN88            SAVE R7                                     
         LB,R7    RELOC1            GET NO. MOD. TYPES                          
SCAN7B   CB,R10   RELOC1,R7         TEST FOR MOD. CHAR.                         
         BE       SCAN7C            FOUND A MOD. CHAR.                          
         BDR,R7   SCAN7B            LOOP                                        
         LW,R7    SCAN88            RESTORE R7                                  
         B        SCAN7A                                                        
SCAN7C   LW,R12   RELOC2,R7         GET MOD. WORD                               
         BGZ      %+2               B IF NOT INDIRECT                           
         LW,R12   *R12              GET MOD. VALUE                              
         LW,R7    SCAN88            RESTORE R7                                  
         B        SCAN12                                                        
SCAN7A   RES      0                                                             
         MTW,1    SCAN93            STEP CHAR. COUNT                            
         BNEZ     SCAN9             NOT TOO MANY CHARS.                         
SCAN8    LI,R6    -1                SET TO ERROR EXIT                           
         B        SCAN33            GO TO EXIT                                  
SCAN9    CI,R10   X'C7'                                                         
         BL       SCAN19            HEX CHAR.                                   
         CI,R10   X'F0'                                                         
         BL       SCAN14            EBCDIC CHAR.                                
         CI,R10   X'FA'                                                         
         BGE      SCAN8             ERROR, ILLEGAL CHAR.                        
         CI,R11   4                 IS FIELD DECIMAL                            
         BL       SCAN19            NO DECIMAL CONVERSION                       
         LI,R11   4                 SET FLAG SO ONLY DECIMAL CONVERSION         
         CW,R8    SCAN89A           IS THIS FIRST CHAR.                         
         BNE      %+2               NO                                          
         LI,R8    0                 YES, CLEAR R8                               
         LW,R9    R8                                                            
         MI,R9    10                CHANGE TO DECIMAL                           
         AI,R10   -X'F0'                                                        
         AW,R9    R10               ADD INTO ACC. SUM                           
         LW,R8    R9                MOVE VALUD TO R8                            
SCAN10   LI,R9    0                 SET EXIT VALUE TO DEC OR HEX                
SCAN11   LW,R0    SCAN91            WAS ) PREVIOUS CHAR.                        
         BEZ      SCAN8             YES, ERROR IN FIELD                         
SCAN12   AI,R6    1                 STEP COL. COUNT                             
         CI,R6    80                COL. 80                                     
         BL       SCAN7             NO                                          
         B        SCAN8             YES, ERROR                                  
SCAN14   LW,R0    R10               CHECK FOR LEGAL EBCDIC CHAR.                
         AND,R0   KXF                                                           
         BEZ      SCAN8             ILLEGAL CHAR.                               
         CI,R0    'A'                                                           
         BGE      SCAN8             ILLEGAL CHAR.                               
         CI,R10   X'E1'                                                         
         BE       SCAN8             ILLEGAL CHAR.                               
SCAN14A  LI,R0    1                                                             
         AND,R11  R0                EBCDIC CONV. REQUESTED                      
         BEZ      SCAN8             NO, ERROR                                   
         LW,R5    SCAN93            GET CHAR. COUNT                             
         AI,R5    8                 GET PROPER BYTE FOR CHAR.                   
         STB,R10  R8,R5             STORE CHAR. IN PROPER BYTE                  
         B        SCAN11                                                        
SCAN19   LW,R0    3,R7              IS THIS DEVICE TYPE INPUT                   
         BEZ      SCAN20            NO                                          
         LW,R0    SCAN93            YES                                         
         AI,R0    5                 IS IT CHAR. 4 OR 5                          
         BLZ      SCAN14A           NO, KEEP IN EBCDIC                          
         BGZ      SCAN22            YES, CHAR. 5                                
         LI,R5    2                                                             
         LB,R0    R8,R5             GET IOP NO.                                 
         AI,R0    -X'C1'            CHANGE TO BINARY                            
         BLZ      SCAN8             NOT A-H, ERROR                              
         CI,R0    7                                                             
         BG       SCAN8             ERROR                                       
         LH,R8    R8                                                            
         SLS,R8   8                 POSITION FIRST 2 CHARS.                     
         AW,R8    R0                                                            
         B        SCAN22                                                        
SCAN20   LI,R0    2                                                             
         AND,R0   R11                                                           
         BEZ      SCAN14A           NOT HEX CONV.                               
         LI,R11   2                 SET TO HEX ONLY                             
         CW,R8    SCAN89A           IS THIS FIRST CHAR.                         
         BNE      SCAN22            NO                                          
         LI,R8    0                 YES, CLEAR R8                               
SCAN22   SLS,R8   4                                                             
         CI,R10   X'F0'                                                         
         BGE      %+2                                                           
         AI,R10   X'39'             CHANGE TO HEX                               
         AI,R10   -X'F0'                                                        
         AW,R8    R10                                                           
         MTW,1    SCAN95            STEP COUNT OF HEX                           
         B        SCAN10            GET NEXT CHAR.                              
SCAN25   CI,R10   X'6B'             COMMA                                       
         BNE      SCAN35            NO                                          
         LW,R0    SCAN91            YES,GET PARENTHESES FLAG                    
         BGZ      SCAN29            NOT END OF FIELD                            
         LI,R0    -1                                                            
         STW,R0   SCAN91            RESET PARENTHESES FLAG                      
SCAN28   MTW,1    SCAN98            SET EXIT PARAM. FOR END OF FIELD            
SCAN29   MTW,1    SCAN90            STEP FIELD FLAG                             
         LW,R10   SCAN93            GET CHAR. COUNT ON EXIT                     
         AI,R10   9                 CHANGE TO POSITIVE                          
         BEZ      SCAN8             ERROR IF BLANK FIELD                        
         LW,R0    3,R7              SPECIAL CONVERSION                          
         BEZ      SCAN32            NO                                          
         CI,R10   1                 YES                                         
         BEZ      SCAN34            1 CHAR, MUST BE '0' OR 'C'                  
         CI,R10   2                                                             
         BEZ      SCAN32            2 CHARS. , OP. LABEL                        
         CI,R10   5                                                             
         BNE      SCAN8             ERROR, IF NOT 5 CHARS.,(YYNDD)              
         MTW,-2   SCAN95                                                        
         BNEZ     SCAN8             ERROR, IF NOT 2 HEX CHARS.                  
SCAN32   XW,R6    SCAN98            SAVE CHAR COUNT AND SET EXIT PM.            
SCAN33   MTW,1    SCAN92            STEP CONT. CARD FLAG                        
         LW,R11   SCAN94            SET R11 TO FIELD NO.                        
         SLS,R11  8                 POSITION TO PROPER BITS                     
         AW,R11   SCAN89            ADD IN BLANKS                               
         B        *SCAN99           EXIT                                        
SCAN34   LB,R0    R8                                                            
         CI,R0    '0'               IS IT ZERO                                  
         BNE      %+3               NO                                          
         LI,R8    0                 SET R8 TO ZERO                              
         B        SCAN32                                                        
         CI,R0    'C'               IS IT C OP LABEL                            
         BNE      SCAN8             NO, ERROR                                   
         B        SCAN32            YES                                         
SCAN35   CI,R10   X'5D'             RIGHT PARENTH.                              
         BNE      SCAN36            NO                                          
         LW,R0    SCAN91            YES, CHECK LEGALITY                         
         BLEZ     SCAN8             ERROR, RT.PARENTH., BUT NO LEFT             
         MTW,-1   SCAN91            SET PARENTH. FLAG TO RT. PARENTH.           
         B        SCAN12            GET NEXT CHAR.                              
SCAN36   CI,R10   X'4D'             LEFT PARENTHSES                             
         BNE      SCAN37            NO                                          
         MTW,0    SCAN91            YES                                         
         BGZ      SCAN8             ERROR, 2 LFT. PARENTH. IN A ROW             
         LI,R0    1                                                             
         STW,R0   SCAN91            SET TO LEFT PARENTH.                        
         B        SCAN12            GET NEXT CHAR.                              
SCAN37   CI,R10   X'40'             BLANK                                       
         BNE      SCAN38            NO                                          
         LW,R0    SCAN91            GET PARENTH. FLAG                           
         BGZ      SCAN8             ERROR, LFT. BUT NO RIGHT                    
         LW,R0    SCAN90            YES, CHECK FIELD                            
         BNEZ     SCAN37C           SPEC. FIELD, SO EXIT                        
         LI,R0    '.'                                                           
SCAN37A  AI,R6    1                                                             
         CI,R6    80                STRIP OFF BLANKS AFTER MNE. FIELD           
         BE       SCAN37C           END OF CARD, NO SPEC. FIELD                 
         CB,R10   *SCAN96,R6                                                    
         BE       SCAN37A           A BLANK                                     
         CB,R0    *SCAN96,R6        IS IT A PERIOD                              
         BE       SCAN37C           YES TREAT AS END OF CARD                    
         AI,R6    -1                RESET TO LAST BLANK                         
         B        SCAN28            GO TO EXIT WITH END OF FIELD                
SCAN37C  MTW,2    SCAN98                                                        
         B        SCAN29                                                        
SCAN38   CI,R10   X'5E'             ;                                           
         BNE      SCAN39            NO                                          
         LW,R0    SCAN90                                                        
         BEZ      SCAN8             NOT ALLOWED IN MNEMONIC FIELD               
         LW,R0    SCAN91                                                        
         BGZ      SCAN8             ERROR, LFT. PARENTH., BUT NO RIGHT          
         LW,R10   SCAN93                                                        
         AI,R10   9                 IS FIELD EMPTY                              
         BEZ      SCAN8             YES, ERROR                                  
         LI,R0    -1                                                            
         STW,R0   SCAN92            SET CONT. CARD FLAG                         
         B        SCAN28                                                        
SCAN39   CI,R10   '%'               CHECK FOR LEGAL EBCDIC CHAR.                
         BE       SCAN41            OK                                          
         CI,R10   ':'                                                           
         BL       SCAN8             ILLEGAL CHAR.                               
         CI,R10   X'7C'                                                         
         BG       SCAN8             ILLEGAL CHAR.                               
SCAN41   MTW,1    SCAN93            OK, STEP CHAR. COUNT                        
         BNEZ     SCAN14A                                                       
         B        SCAN8             ERROR,TOO MANY CHARS.                       
*                                                                               
SCAN88   DATA     0                 SAVE R7 HERE                                
SCAN89   DATA     X'40000040'       BLANKS                                      
SCAN89A  DATA     X'40404040'       EBCDIC BLANKS                               
SCAN90   DATA     0                 FIELD FLAG                                  
SCAN91   DATA     0                 PARENTHESES FLAG                            
SCAN92   DATA     1                 CONT. CARD FLAG                             
SCAN93   DATA     0                 CHAR. COUNT                                 
SCAN93A  DATA     0                 FIRST BYTE OF FIELD FLAG                    
SCAN94   DATA     0                 FIELD COUNT                                 
SCAN95   DATA     0                 COUNT OF HEX CHARS.                         
SCAN96   DATA     0                 ADD. OF CARD BUFFER                         
SCAN98   DATA     0                 COL. INDEX AND EXIT PM. R6                  
SCAN99   DATA     0                 RETURN ADDRESS                              
KXF      DATA      X'F'                                                         
         TITLE    '** INIT - DATA **'                                           
*                                                                               
* FPT'S AND DCB'S                                                               
*                                                                               
WTLL     GEN,8,24 X'11',F:LL                                                    
         DATA     BIT2+BIT3+BIT31       BA,BC,IGNERR                            
         DATA     INITBUF1                                                      
         DATA     80                                                            
*                                                                               
CKLL     GEN,8,24 X'29',F:LL                                                    
         DATA     BIT31             IGNERR                                      
*                                                                               
F:LL     GEN,8,24 5,3               LENGTH 5, ASSIGN 3                          
         GEN,8,24 10,4              NRT 10, OPLB LL                             
         DATA     0                                                             
         DATA     INITERR           ERROR                                       
         DATA     INITERR           ABNORMAL                                    
*                                                                               
WTLL2    GEN,8,24 X'11',F:LL                                                    
         DATA     BIT2+BIT3+BIT31                                               
         DATA     BUF2                                                          
         DATA     56                                                            
*                                                                               
CKLL2    GEN,8,24 X'29',F:LL                                                    
         DATA     BIT31                                                         
RDSI     GEN,8,24 X'10',F:SI        FPT TO READ !MODIFY,!END                    
         DATA     BIT0+BIT1+BIT2+BIT3+BIT6+BIT27                                
         DATA     INITERR                                                       
         DATA     INITABN                                                       
         DATA     INITBUF1                                                      
         DATA     80                                                            
         DATA     'P'               PROMPT CHARACTER                            
F:SI     GEN,8,24 7,X'103'                                                      
         GEN,8,24  10,0                                                         
         GEN,32       0                                                         
         GEN,15,17     80,INITERR                                               
         GEN,15,17     0,INITERR                                                
         DATA         0,0                                                       
SITEFPT  GEN,8,24 X'11',F:OC                                                    
         DATA     BIT2+BIT3+BIT23+BIT31                                         
         DATA     *SITE                                                         
         DATA     50                                                            
*                                                                               
F:OC     GEN,8,24 5,3                                                           
         GEN,8,24 10,2              OPLABEL OC                                  
         DATA     0                                                             
         DATA     INITERR                                                       
         DATA     INITERR                                                       
F:LLCLS  GEN,8,24 X'15',F:LL                                                    
         GEN,2,30 3,0               ERROR AND ABNORMAL                          
         DATA     INITERR           ERROR                                       
         DATA     INITERR           ABNORMAL                                    
*                                                                               
F:SICLS  GEN,8,24 X'15',F:SI                                                    
         GEN,2,30 3,0                                                           
         DATA     INITERR                                                       
         DATA     INITERR                                                       
*                                                                               
TYPE3    GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                                       
         DATA     INITMSG3                                                      
         PAGE                                                                   
INITMSG3 TEXTC    '!!INVALID SSW SETTING (1=C,2=OC,3=SI) - CLEAR B %'           
INITMSG4 TEXTC    '!!ERROR ITEM XX - CORRECT AND CLEAR B %'                     
INITMSG5 TEXTC    '!!PATCH LOC ERR - CORRECT AND CLEAR B %'                     
INITMSG6 TEXTC    '!!NO PATCH AREA - CLEAR B % IGNORES MODIFY COMMAND'          
         PAGE                                                                   
*                                                                               
* KEYWORDS                                                                      
*                                                                               
JCPKW    TEXT     'JCP'                                                         
MOD      TEXT     'MOD'                                                         
END      TEXT     'END'                                                         
CLRTEXT  TEXT     'CLEA'                                                        
*                                                                               
ALTKWDS  TEXT     'CPR'                                                         
         TEXT     'ABS'                                                         
         TEXT     'OLAY'                                                        
         TEXT     'SROU'                                                        
         TEXT     'PATC'                                                        
         TEXT     'SETR'                                                        
         TEXT     'TRAC'                                                        
*                                                                               
         BOUND    8                                                             
SIMROU   EQU      %-2                                                           
         TEXT     'DELTA'                                                       
           DO       #INSTSIM                                                    
         TEXT     'FPSIM'                                                       
         TEXT     'DECSIM'                                                      
         TEXT     'BYTSIM'                                                      
         TEXT     'CVSIM'                                                       
         FIN                                                                    
RBOOT    TEXT     'RADBOOT'                                                     
         PAGE                                                                   
*                                                                               
* VARIOUS                                                                       
*                                                                               
REGSAVE  DATA     0,0               TEMP REG. SAVE                              
REGSAVE1 DATA     0                                                             
*        SIZES OF SIMULATION ROUTINES  FPSIM,DECSIM,BYTSIM,CVSIM                
SROUSIZE EQU      %-1                                                           
         DATA     DELSIZE,FPSIZE,DECSIZE,BYTSIZE,CVSIZE                         
INITBUF1 RES      20                                                            
INIT99   DATA     0                 ADDRESS OF OLAYS,SROU,RBM IN CORE           
INIT100  DATA     0                 INITIAL ADDRESS TO ALTER                    
INIT101  DATA     0                 !END FLAG                                   
INIT102  DATA     0                 END ADDR. OF OLAYS,SROU,RBM IN CORE         
INIT105  DATA     0                 INSTRUCTION MOD. CELL                       
INIT105T DATA     0                                                             
INIT105Z DATA     0                 LAST PATCHED MODULE                         
INITNAME TEXT     'INIT'                                                        
         BOUND    8                                                             
INITSCAN GEN,16,16  0,INITBUF1      SCAN ROUTINE PARAMETER TABLE                
         DATA       0               F1                                          
         DATA       0               F2                                          
         DATA       0               F3                                          
         GEN,16,16  0,INIT50        PROCESS SEMICOLON                           
BUF2     TEXT     ' ADDR = '                                                    
         TEXT     '    '                                                        
         DATA     0                                                             
         TEXT     ', OLD VAL = '                                                
         DATA     0,0                                                           
         TEXT     ', NEW VAL = '                                                
         DATA     0,0                                                           
         PAGE                                                                   
*                                                                               
* KEYWORD BRANCH TABLE                                                          
*                                                                               
BTABLE   RES      0                                                             
         B        INIT28                                                        
         B        INIT28B                                                       
         B        INIT27P                                                       
         B        INIT27T                                                       
         B        INIT27Z                                                       
         B        INITSETR                                                      
         B        INITRACE                                                      
         PAGE                                                                   
*                                                                               
* RELOCATION CHARACTERS AND THEIR MODIFY VALUES                                 
*                                                                               
*   MODIFY CHARCTERS MAY NOT BE A,B,C,D,E, OR F.                                
RELOC1   EQU      %                                                             
         DO       #INSTSIM                                                      
         TEXTC    'ZRMOJPTLIYV'                                                 
         ELSE                                                                   
         TEXTC    'ZRMOJPT'                                                     
         FIN                                                                    
         BOUND    4                                                             
RELOC2   EQU      %-1               MODIFY VALUES                               
         GEN,1,31 1,INIT105Z                                                    
         GEN,1,31 1,INIT105                                                     
         GEN,1,31 0,RBM                                                         
         GEN,1,31 0,OLAYFWA                                                     
         GEN,1,31 1,K:BACKBG                                                    
         GEN,1,31 1,K:PTCH                                                      
RELOC3   EQU      %-1                                                           
         GEN,1,31 1,K:DELTA                                                     
         DO       #INSTSIM                                                      
         GEN,1,31 1,K:FPSIM                                                     
         GEN,1,31 1,K:DECSIM                                                    
         GEN,1,31 1,K:BYTSIM                                                    
         GEN,1,31 1,K:CVSIM                                                     
         FIN                                                                    
RELOC4   EQU      %-1                                                           
         FIN                                                                    
         PAGE                                                                   
*                                                                               
* VARIOUS                                                                       
*                                                                               
         BOUND    8                                                             
INIT91   TEXT     'CPR     '                                                    
INIT92   DATA     X'7FC'                                                        
INIT93   DATA     X'C0000000'       MASK FOR WRITE LOCKS                        
INIT94   DATA     X'C0000010'                                                   
INIT95   EQU      0                 RUN STATUS CODE IN R0 (IGNORE)              
         PAGE                                                                   
*                                                                               
* FPT'S AND DCB'S USED TO READ FP DICTIONARY                                    
*                                                                               
F:DCB    GEN,8,24   7,1             DCB TO READ FP DICTIONARY                   
         GEN,8,16,8 3,1,0                                                       
         DATA       INITBUF                                                     
         GEN,15,17  X'7FFF',INITERR                                             
         DATA       INITERR                                                     
         DATA       0,0                                                         
INITCLS  GEN,8,24 X'15',F:DCB                                                   
         GEN,2,30 3,0                                                           
         DATA     INITERR                                                       
         DATA     INITERR                                                       
INITRD   GEN,8,24   X'10',F:DCB     FPT TO READ FP DICTIONARY                   
         GEN,8,24   X'D1',X'10'                                                 
         DATA       INITERR                                                     
         DATA       INITERR                                                     
         DATA       0               BYTE COUNT STORED IN                        
         DATA       0               KEY ADDRESS STORED IN                       
         BOUND    8                                                             
INITRUN  GEN,8,24 X'0C',INIT95                                                  
         DATA     0                                                             
         DATA     0,0               FILE NAME STORED IN                         
         PAGE                                                                   
*                                                                               
* INIT MESSAGE TYPE CALS                                                        
*                                                                               
         DO       #550                                                          
TXT4592  TEXT     '4592'                                                        
TYPETAB  GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                                       
         DATA     TABMSG                                                        
TABMSG   DATA,1   90                                                            
         DATA,1   X'1B','2',X'0D',X'15'                                         
I        DO       7                                                             
         DATA,9   ' SET TAB '                                                   
         DATA,1   '0'+I                                                         
         DATA,1   X'1B','1'         SET TAB                                     
         FIN                                                                    
         DATA,1   X'0D',X'15'                                                   
         BOUND    4                                                             
         FIN      #550                                                          
         PAGE                                                                   
*                                                                               
* VARIOUS MESSAGES AND FPTS WHICH TYPE THEM                                     
*                                                                               
TYPE1    GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                  /SIG7-2121/*C5732    
         DATA     INITMSG1                                                      
TYPE2    GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                                       
         DATA     INITMSG2                                                      
TYPE8    GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                                       
         DATA     INITMSG8                                                      
TYPE7    GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                                       
         DATA     INITMSG7                                                      
TYPE9A   GEN,8,24 2,0                                                           
         GEN,1,31 1,X'10'                                                       
         DATA     LICENSE1                                                      
         PAGE                                                                   
INITMSG1 TEXTC    '   TELEFILE CPR (H02)          '                             
ORGHERE  SET      %                                                             
         ORG      INITMSG1          GO BACK AND PUT IN                          
         RES,1    1                                                             
         DATA,1   X'0D',X'15',X'05' CR, LF, TAB                                 
         ORG      ORGHERE           AND BACK AGAIN                              
         PAGE                                                                   
*********************************************                                   
*       JCB INITIALIZATION CONSTANTS        *                                   
*********************************************                                   
*                                                                               
RBMJCBA  GEN,8,24   37,JCBRBM                                                   
BKGJCBA  GEN,8,24   37,JCBBKG                                                   
         BOUND    8                                                             
RBMTEXT  TEXT     'CPR     '                                                    
BKGTEXT  TEXT     'BKG     '                                                    
INITMSG2 TEXTC    '!!UNABLE TO TRIGGER CONTROL TASK INT.'                       
INITMSG8 TEXTC    '!! CP-R RESTARTED'                                           
INITMSG7 TEXTC    'PLEASE KEY DATE AND TIME'                                    
LICENSE1 TEXTC    'PROPRIETARY PROGRAM REQUIRING LICENSE AGREEMENT'             
         BOUND    8                                                             
INITPCB  DATA     INITTS-1                                                      
         DATA,2   INITTS1-INITTS,0                                              
         DATA     0,0,0,0,0,0,0,0,0,0,0                                         
INITTS   RES      100                                                           
INITTS1  RES      0                                                             
INITBUF  RES      256               FP DICT. READ IN HERE                       
RBMLOCK  DATA     X'FFFFFFFF'       WRITE LOCK CODES FOR RBM,FGD,BCK            
BCKLOCK  DATA     X'55555555'                                                   
FGDLOCK  DATA     X'AAAAAAAA'                                                   
         DO       #SIGMA9                                                       
PFIXPSD  XPSD,8   PFIPSD                                                        
MFIXPSD  XPSD,8   MFIPSD                                                        
         FIN      #SIGMA9                                                       
POFFXPSD XPSD,0   POFFPSD                                                       
PONXPSD  XPSD,0   PONPSD                                                        
SPRXPSD  XPSD,8   SPRPSD            UNUSED (SPURIOUS)                           
IOXPSD   XPSD,8   IOPSD                                                         
DIOXPSD  XPSD,8   DIOPSD                                                        
CPXPSD   XPSD,8   CPPSD                                                         
CLKXPSD  XPSD,8   CLOCKPSD                                                      
TRAPPSD  XPSD,0   TRAP40                                                        
         XPSD,0   TRAP41                                                        
         XPSD,0   TRAP42                                                        
         XPSD,0   TRAP43                                                        
         XPSD,0   TRAP44                                                        
         XPSD,0   TRAP45                                                        
         XPSD,0   TRAP46                                                        
         MTW,0    0                 TRAP 47  UNASSIGNED                         
         XPSD,0   CAL1PSD           TRAP 48  CAL1                               
         XPSD,0   TRAP41            CAL2**TREATED AS UNIMPL/SIG7-5346/*C5732 "01
         XPSD,0   TRAP41            CAL3**INSTR UNTIL      /SIG7-5346/*C5732 "01
         XPSD,0   TRAP41            CAL4**USER'S CONNECT   /SIG7-5346/*C5732 "01
         DO       #SIGMA9                                                       
         XPSD,0   TRAP4C            TRAP 4C  MEMORY PARITY ERROR                
         XPSD,0   TRAP4D            TRAP 4D INSTRUCTION EXCEPTION               
         ELSE                                                                   
         MTW,0    0                 TRAP 4C                                     
         MTW,0    0                 TRAP 4D NOT IN SIGMA 5/7                    
         FIN                                                                    
TRAPEND  EQU      %                                                             
         PAGE                                                                   
*                                                                               
*        TABLES TO CONTROL TASK INITIATION                                      
*                                                                               
INITTM   DATA     CTTBL             CONTROL TASK INIT TABLE                     
****************************                                                    
**                                                                              
**                                                                              
**                THIS TABLE MUST BE IN THE SAME ORDER AS THE ID'S AND          
**                LMID'S ARE DEFINED IN CPREQU.                                 
**            ==> THE MM TASK'S TABLE MUST BE LAST  <==                         
**                                                                 JBM          
**                                                                              
****************************                                                    
*                                                                               
         DO       #ROLL                                                         
*                                                                               
        DO       #MEDIA                                                         
         DATA     MEDATBL           MEDIA TABLE                                 
        FIN      #MEDIA                                                         
*                                                                               
         DO1      #TJE                                                          
         DATA     TEXTBL            TJE TABLE                                   
*                                                                               
        DO1       #SYMB                                                         
         DATA     SYMBTBL           SYMBIONTS TABLE                             
*                                                                               
         DATA     MMEXTBL           MEM MGMT EXEC TABLE                         
         FIN      #ROLL                                                         
         DATA     0                                                             
         PAGE                                                                   
         SPACE    2                                                             
*                          INITIALIZATION TABLES                                
*                                                                               
*                                                                               
CTTBL    DATA     CTLMID            LMI INDEX FOR CONTROL TASK                  
*                                                                               
         DATA     X'0404'           LMISTAT                                     
         TEXT     'CTRLTASK'        CONTROL TASK NAME                           
         GEN,8,24 X'A0',0           RBM TASK, SEC, NO PCB                       
         GEN,8,24 RBMJID,RBMEND     JID, LWA                                    
         GEN,8,24 CTID,0                                                        
         GEN,32,16,16  CTRTS,200+(16*#ERRORLOG),0 RTS CONTROL DOUBLEWORD        
         DATA     255               MAX S-ECB                                   
         DATA     255               MAX R-ECB                                   
         DATA     0                 NO AET                                      
*                                                                               
         DATA     CTID              CONTROL TASK STI ENTRY                      
         DATA     CTSTCB+STIUSED    CONTROL TASK STCB                           
         GEN,16,16  X'FEFE',0       PRIORITY WORD                               
         DATA     0                 STI STAT BYTE                               
         GEN,8,24 X'A0',LMIRTS+(CTLMID*2)  PCBPOINT                             
         GEN,8,24 CTID,CTSTCB              TCBPOINT                             
         DATA     LMIRTS+(2*CTLMID) STIXRTS                                     
         PAGE                                                                   
         SPACE    2                                                             
        DO       #MEDIA                                                         
*                                                                               
MEDATBL  DATA     MEDALMID          LMI INDEX                                   
         DATA     X'0404'           LMISTAT                                     
         TEXT     'MEDIA   '        LMINAME                                     
         GEN,8,24 X'B0',0           PCBPOINT - CPR,SEC,MAP,NO PCB               
         GEN,8,24 RBMJID,0          JID, LWA                                    
         GEN,8,24 MEDATID,0         LMISDT                                      
         DATA     MEDRSTAK-1        TOP OF STACK  LMIRTS                        
         DATA,2   MEDRSSZ,0         STACK SIZE   LMIRTS                         
         DATA     255               MAX S-ECB                                   
         DATA     255               MAX R-ECB                                   
         DATA     0                 NO AET                                      
*                                                                               
*                           START STI TABLES                                    
         DATA     MEDATID           TASK ID                                     
         DATA     MEDRSTCB+STIUSED  STITCB                                      
         DATA,2   X'FEFE',0         STIPRIO,  PRIORITY                          
         DATA     X'20'             STISTAT  - STOPPED                          
         GEN,8,24 X'B0',LMIRTS+(MEDALMID*2)   PCBPOINT (STCB)                   
         GEN,8,24 MEDATID,MEDRSTCB            TCBPOINT (STCB)                   
         DATA     LMIRTS+(MEDALMID*2)         STIXRTS                           
*                                                                               
        FIN      #MEDIA                                                         
         PAGE                                                                   
         SPACE    2                                                             
        DO       #TJE                                                           
*                                                                               
TEXTBL   DATA     TEXLMID           LMI INDEX                                   
         DATA     X'0404'           LMISTAT                                     
         TEXT     'TEX     '        LMINAME                                     
         GEN,8,24 X'B0',0           PCBPOINT - CPR,SEC,MAP,NO PCB               
         GEN,8,24 RBMJID,0          JID, LWA                                    
         GEN,8,24 TEXTID,0          LMISDT                                      
         DATA     TEXSTACK-1        TOP OF STACK  LMIRTS                        
         DATA,2   TEXSSZ,0          STACK SIZE   LMIRTS                         
         DATA     255               MAX S-ECB                                   
         DATA     255               MAX R-ECB                                   
         DATA     0                 NO AET                                      
*                                                                               
*                           START STI TABLES                                    
         DATA     TEXTID            TASK ID                                     
         DATA     TEXSTCB+STIUSED   STITCB                                      
         DATA,2   X'FEFE',0         STIPRIO,  PRIORITY                          
         DATA     X'20'             STISTAT  - STOPPED                          
         GEN,8,24 X'B0',LMIRTS+(TEXLMID*2)    PCBPOINT (STCB)                   
         GEN,8,24 TEXTID,TEXSTCB              TCBPOINT (STCB)                   
         DATA     LMIRTS+(TEXLMID*2)          STIXRTS                           
*                                                                               
        FIN      #TJE                                                           
         PAGE                                                                   
         SPACE    2                                                             
        DO       #SYMB                                                          
*                                                                               
SYMBTBL  DATA     SYMBLMID          LMI INDEX                                   
         DATA     X'0404'           LMISTAT                                     
         TEXT     'SYMBIONT'        LMINAME                                     
         GEN,8,24 X'B0',0           PCBPOINT - CPR,SEC,MAP,NO PCB               
         GEN,8,24 RBMJID,0          JID, LWA                                    
         GEN,8,24 SYMBTID,0         LMISDT                                      
         DATA     SYMBSTAK-1        TOP OF STACK  LMIRTS                        
         DATA,2   SYMBSSZ,0         STACK SIZE   LMIRTS                         
         DATA     255               MAX S-ECB                                   
         DATA     255               MAX R-ECB                                   
         DATA     0                 NO AET                                      
*                                                                               
*                           START STI TABLES                                    
         DATA     SYMBTID           TASK ID                                     
         DATA     SYMBSTCB+STIUSED  STITCB                                      
         DATA,2   X'FEFE',0         STIPRIO,  PRIORITY                          
         DATA     X'20'             STISTAT  - STOPPED                          
         GEN,8,24 X'B0',LMIRTS+(SYMBLMID*2)   PCBPOINT (STCB)                   
         GEN,8,24 SYMBTID,SYMBSTCB            TCBPOINT (STCB)                   
         DATA     LMIRTS+(SYMBLMID*2)         STIXRTS                           
*                                                                               
        FIN      #SYMB                                                          
*                                                                               
         PAGE                                                                   
         SPACE    2                                                             
         DO       #ROLL                                                         
MMEXTBL  DATA     MMLMID            LMI INDEX FOR MEM EXEC                      
*                                                                               
         DATA     X'0404'           LMISTAT                                     
         TEXT     'MMEXEC  '        MEM MGMT EXEC TASK NAME                     
         GEN,8,24 X'B0',0           RBM,SEC,MAPPED, NO PCB                      
         GEN,8,24 RBMJID,0          JID,LWA                                     
         GEN,8,24 MMTID,0                                                       
         GEN,32,16,16  MMRTS-1,MMRTSSZ,0 RTS CONTROL DOUBLEWORD                 
         DATA     255               MAX S-ECB                                   
         DATA     255               MAX R-ECB                                   
         DATA     0                 NO AET                                      
*                                                                               
         DATA     MMTID             MEM MGMT EXEC STI ENTRY                     
         DATA     MMSTCB+STIUSED    MEM MGMT STCB                               
         GEN,16,16  X'FFFF',0       PRIORITY                                    
         DATA     X'20'             STOPPED                                     
         GEN,8,24 X'B0',LMIRTS+(MMLMID*2)  PCBPOINT (STCB)                      
         GEN,8,24 MMTID,MMSTCB             TCBPOINT (STCB)                      
         DATA     LMIRTS+(2*MMLMID) STIXRTS                                     
         FIN      #ROLL                                                         
         PAGE                                                                   
         SPACE    2                                                             
STLXPSD  XPSD,8   TDSTL             XPSD FOR STL INT LEVELS                     
UTIMESI  DATA     S:UTIME           2MS INTERPTS/USER INTERVAL                  
         SPACE    2                                                             
* VALUE FOR K: SYSTEM                                                           
RBMIDENT RES      0                 SYSTEM I.D. WORD TO STORE IN X'2B'          
         DATA,1   X'80'             CP-R TYPE= 8                                
         DATA,1   X'82'                  VERSION H02                            
         DATA,2   BIT29+;                                                       
                  BIT24*#SIGMA9+;                                               
                  BIT25*(1-#SIGMA9)+BIT25*#550+;                                
                  BIT31*#SYMB       SYMBIONTS ON/OFF                            
CLKMTW   MTW,-1   COUNTER4                                                      
*                                                                               
*                                                                               
*                                                                               
****                                                                            
*                                                                               
OPRCRASH CRASH    'BY OPERATOR'                                                 
         TITLE    '** INIT - TRACE MECHANISM **'                                
         DO       #PATCH                                                        
         BOUND    8                                                             
TRACEB   LW,R1    S:TRACEN          GET BASE                                    
         LCI      0                                                             
         STM,R0   TRACESTR-TRACEB,R1 SAVE REGS                                  
         LW,R7     *CAL1PSD         TRAP ADR                                    
         CW,R7    XBIT8             IS TRACE ON FOR THIS ONE                    
         BAZ      TRACENO-TRACEB,R1 NO                                          
         LD,R2    TEMP              GET R0 AND R1                               
         STW,R2   TRACESTR-TRACEB,R1                                            
         STW,R3   TRACESTR+1-TRACEB,R1                                          
         LW,R7    CAL1PSD           GET TRAP CAL ADDR                           
         AND,R7   M16               STRIP OFF ADDRESS                           
         AI,R7    -EPIEP            GET EP OFFSET                               
         LD,R2    CAL1PSD           GET ENTRY                                   
         LW,R6    EPIEP,R7          GOOD INST.                                  
         AND,R6   M16               MASK OFF ADR                                
         CI,R6    OLAYFWA+OLAYSIZE  OMAN ENTRY                                  
         BGE      %+3-TRACEB,R1     NO                                          
         LD,R2    OMANTPSD          GET THE PSD                                 
         B        %+3-TRACEB,R1                                                 
         AND,R2   YFFFE             MASK IN ADDRESS                             
         AW,R2    R6                                                            
TRACEB3  STW,R2   TRACEPSD-TRACEB,R1 SAVE PSD WORD 0                            
         STW,R3   TRACEPSD-TRACEB+1,R1 SAVE PSD WORD 1                          
         LW,R0    S:TRACES          GET SWITCH                                  
         BEZ      TRACEX-TRACEB,R1  DON'T TRACE                                 
         LW,R0    S:TRACET          RIGHT TASK                                  
         BEZ      TRACEB1-TRACEB,R1 ALL OF THEM                                 
         CB,R0    TCBPOINT          ONE RUNNINT                                 
         BNE      TRACEX-TRACEB,R1  NO                                          
TRACEB1  LD,R2    *S:TRACE,R7       GET NAME OF EP                              
         LCI      2                 SAVE NAME                                   
         PSM,R2   *S:TRACE                                                      
         BCR,X'A' TRACEB2-TRACEB,R1 OK NO OVERFLOW                              
         LD,R2    *S:TRACE          GET STACK P D                               
         AND,R3   M15               CLEAT TRAP BITS                             
         LCW,R3   R3                                                            
         MSP,R3   *S:TRACE          RESET                                       
         B        TRACEB1-TRACEB,R1 TRY AGAIN                                   
TRACEB2  LW,R2    EPIEP,R7          GET EP                                      
         AND,R2   Y007F             MASK OUT OVID                               
         SLS,R2   -16               POSITION                                    
         CI,R2    0                 RESIDENT                                    
         BNE      TRACEB4-TRACEB,R1 RESIDENT                                    
         LW,R2    TRACERES-TRACEB,R1                                            
         LW,R3    TRACERES-TRACEB+1,R1                                          
         B        %+2-TRACEB,R1                                                 
TRACEB4  LD,R2    *S:TRACE,R2       GET OVERLAY                                 
         LCI      2                 SAVE IT                                     
         PSM,R2   *S:TRACE                                                      
         LD,R2    CAL1PSD           GET PSD                                     
         AND,R2   YFFFE             CLEAR ADR                                   
         LW,R4    EPIEP,R7          IS IT RES                                   
         AND,R4   M16                                                           
         AW,R2    R4                COLLECT                                     
         LCI      2                                                             
         PSM,R2   *S:TRACE                                                      
         LD,R2    X'4E'             GET PCB,TCBPOINT                            
         LCI      2                                                             
         PSM,R2   *S:TRACE                                                      
         LCI      8                 GET HALF REGS                               
         LM,R8    TRACESTR-TRACEB,R1                                            
         LCI      8                                                             
         PSM,R8   *S:TRACE                                                      
         LCI      8                 GET OTHER HALF                              
         LM,R8    TRACESTR-TRACEB+8,R1                                          
         LCI      8                                                             
         PSM,R8   *S:TRACE                                                      
         LW,R0    TRACEAST-TRACEB,R1                                            
         LW,R2    *S:TRACE          GET ADT OF STK                              
         STW,R0   1,R2              MARK STACK                                  
         STW,R0   2,R2                                                          
         STW,R0   3,R2                                                          
         STW,R0   4,R2                                                          
TRACEX   LW,R0    TRACEOL-TRACEB,R1 GET LPSD FOR EXIT                           
         AW,R0    R1                ADD IN OFFSET                               
         STW,R0   TRACELP-TRACEB,R1                                             
         LCI      0                 RESTORE REGS                                
         LM,R0    TRACESTR-TRACEB,R1                                            
TRACELP  DATA     0                 FILLED WITH LPSD,0 TRACEPSD                 
TRACENO  LCI      0                                                             
         LM,R0    TRACESTR-TRACEB,R1                                            
         LPSD,0   OMANTPSD          RETURN TO TRAP                              
TRACEAST TEXT     'XXXX'                                                        
TRACEOL  LPSD,0   TRACEPSD-TRACEB                                               
         BOUND    8                                                             
TRACERES TEXT     'RESIDENT'                                                    
TRACEPSD DATA     0,0               EXIT PSD                                    
TRACESTR DO1      16                                                            
         DATA     0                                                             
TRACEND  RES      0                                                             
TRACESTK EQU      %                                                             
*NOTE SYSGEN WILL ADD ENTRY POINT NAMES                                         
*TO INIT BEGINNING HERE THUS TRACEB                                             
*SHOULD REMAIN ALWAYS AS END OF INIT                                            
         FIN      #PATCH                                                        
INITEND  EQU      BA(%-1)                                                       
         END      RBMEND+1                                               3467000
