%CONTROL X'0FFFFFFF'
!****************************************************
!*
!*  LPUT
!*
!*  EXTRACTED FROM EDINBURGH'S IMP MODULE FCSM10
!*  FOR USE IN BSV53/KSV17 PASCAL SYSTEM (PASCAL 20)
!*
!*  T.MOORE  FEB '80
!*
!****************************************************
!*
!*
%OWNINTEGER WRKAREA,TMPAREA                                             
%OWNINTEGER NULLOBJ;! 0  OBJECT FILE REQUIRED                                   
                   ! !  NO OBJECT FILE REQUIRED - DUMMY LPUT ACTIVITY           
%OWNINTEGER MAINEPSET                                                           
%OWNINTEGER LPUTERROR                                                           
%OWNSTRING(32) MAINEPNAME                                                       
!*                                                                              
!*                                                                              
%SYSTEMROUTINESPEC INITSERVICES
!*EMAS  %SYSTEMROUTINESPEC DUMP(%INTEGER A, B)                                  
!*EMAS  %SYSTEMROUTINESPEC SSERR(%INTEGER N)                                    
!*EMAS  %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I)                                
!*EMAS  %SYSTEMROUTINESPEC OUTFILE(%STRING (15) S,  %C                          
              %INTEGER LENGTH, MAXBYTES, PROTECTION,  %C                        
              %INTEGERNAME CONAD, FLAG)                                         
!*                                                                              
!*                                                                              
%ROUTINE MOVE(%INTEGER LENGTH, FROM, TO)                                        
%INTEGER I                                                                      
         %RETURNIF LENGTH <= 0                                                  
         I = X'18000000'!LENGTH                                                 
         *LSS_FROM                                                              
         *LUH_I                                                                 
         *LDTB_I                                                                
         *LDA_TO                                                                
         *MV_%L=%DR                                                             
%END;                                   !OF MOVE                                
!*                                                                              
%ROUTINE FILL(%INTEGER LENGTH, FROM,FILLER)                                     
%INTEGER I                                                                      
         %RETURNIF LENGTH <= 0                                                  
         I = X'18000000'!LENGTH                                                 
         *LDTB_I                                                                
         *LDA_FROM                                                              
         *LB_FILLER                                                             
         *MVL_%L=%DR                                                            
%END                                                                            
!*                                                                              
!*                                                                              
%SYSTEMROUTINE INITLPUT (%INTEGER WRK,TEMP)
!*
      WRKAREA = WRK
      TMPAREA = TEMP
      NULLOBJ = 0
      MAINEPSET = 0
      MAINEPNAME = ""
      LPUTERROR = 0
       INITSERVICES
%END;                          ! INITLPUT
!*
!*
%SYSTEMROUTINE GIVELPUTITEMS (%INTEGERNAME ERRORFLAG,  %C
                              %STRINGNAME MAINENTRYNAME)
!*
      ERRORFLAG = LPUTERROR
      MAINENTRYNAME = MAINEPNAME
%END;                                    ! GIVELPUTITEMS
!*
!*
%SYSTEMROUTINE LPUT(%INTEGER TYPE, P1, P2, P3)                                  
%RECORDFORMAT RF0(%INTEGER TYPE, LA, DATALEN, FILLER)                           
%RECORDFORMAT RF1(%INTEGER TYPE, LINK, LOC, %STRING (31) NAME)                  
%RECORDFORMAT RF4(%INTEGER TYPE, LINK, DISP, L, AREA,  %C                       
         %STRING (31) NAME)                                                     
%RECORDFORMAT RF6(%INTEGER TYPE,  %C                                            
         %INTEGERARRAY AREALEN(1 : 7), %INTEGER TOTLEN)                         
%RECORDFORMAT RF7(%INTEGER TYPE, LINK, AREALOC, BASELOC)                        
%RECORDFORMAT RF8(%INTEGER TYPE, LINK, CODEADDR, ADDRFIELD)                     
%RECORDFORMAT RF9(%INTEGER TYPE, LINK, L, REFLINK, COUNT,  %C                   
         %STRING (31) NAME)                                                     
%RECORDFORMAT RF13(%INTEGER LINK,A,DISP,LEN,REP,ADDR)                           
%RECORDNAME R0(RF0)                                                             
%RECORDNAME R1(RF1)                                                             
%RECORDNAME R4(RF4)                                                             
%RECORDNAME R6(RF6)                                                             
%RECORDNAME R7(RF7)                                                             
%RECORDNAME R8(RF8)                                                             
%RECORDNAME R9(RF9)                                                             
%RECORDNAME R13(RF13)                                                           
%INTEGER I, J, K, L, FLAG                                                       
%OWNINTEGER TBASE, TON, TMAX, TYPE6, WORKAD, LMAX, WORKMAX                      
%OWNINTEGER FBASE, CODEBASE, CODEMAX, RECLEN                                    
%OWNINTEGER NULLFLAG                                                            
%OWNINTEGERARRAY HEAD(11 : 25)                                                  
%OWNINTEGERARRAY H(0 : 14)                                                      
%OWNINTEGERARRAY BASE(1 : 7)                                                    
%OWNINTEGERARRAY AREALENGTH(1 : 7)                                              
%OWNINTEGERARRAY AREASTART(1 : 7)                                               
%OWNINTEGER RCOUNT                                                              
%OWNINTEGER TYPE19NUM                                                           
%OWNSTRING (15) FILE                                                            
%OWNINTEGER STACKMODE                                                           
%OWNINTEGER LANGUAGE                                                            
%OWNINTEGER COMREG57                                                            
%OWNINTEGER NAMESET                                                             
%OWNINTEGER NUMEXT                                                              
%OWNINTEGER NUMFIXUPS                                                           
%OWNINTEGER PACK5                                                               
%INTEGER OBJLEN                                                                 
%INTEGER LDSTART,LDDISP,LAST13                                                  
%STRING (31) CHANGEDNAME, EPNAME                                                
%CONSTBYTEINTEGERARRAY CHANGE(0 : 47) =   %C                                    
0(10),1(6),0(8),1,0(23)                                                         
%SWITCH EP(0 : 47)                                                              
%SWITCH LSW(0 : 47)                                                             
      %IF TYPE = 0 %THEN %START                                                 
         LANGUAGE = P1                                                          
         STACKMODE = 0                                                          
!*                                                                              
!*EMAS   FILE <- STRING(COMREG(52))                                             
!*EMAS   %IF FILE = '.NULL' %THEN %START                                        
!*EMAS      NULLFLAG = 1                                                        
!*EMAS      %RETURN                                                             
!*EMAS   %FINISH %ELSE NULLFLAG = 0                                             
!*EMAS   CODEBASE = COMREG(15)+32                                               
!*                                                                              
!*VME;   NULLFLAG=NULLOBJ                                                       
!*VME;   FBASE=TMPAREA                                                          
!*VME;   CODEBASE=FBASE+32                                                      
!*                                                                              
!*                                                                              
         CODEMAX = CODEBASE+X'40000'                                            
!*VME;   WORKAD=WRKAREA                                                         
!*EMAS   WORKAD = COMREG(14)                                                    
         TBASE = WORKAD+32                                                      
         TYPE6 = TBASE                                                          
         TON = TBASE+40;! RESERVE SPACE FOR TYPE6 RECORD RELATING TO 1ST RTN    
         WORKMAX = INTEGER(WORKAD+8);      !SIZE OF WORK FILE                   
         TMAX = WORKMAX                                                         
         %IF TMAX > X'40000' %THEN TMAX = X'40000'                              
         TMAX = WORKAD+TMAX-64                                                  
         RCOUNT = 0;                       ! NO OF RELOCATION VALUES            
         TYPE19NUM = 0;! NO OF GENERALISED RELOCATION RECORDS                   
         LMAX = 144;! SIZE OF LDATA+HEAD(16) RECORD                             
         LMAX = LMAX+2048;!TEMPORARY - FAULT IN CALCULATION OF LMAX             
         %CYCLE I = 11,1,25                                                     
            HEAD(I) = 0                                                         
         %REPEAT                                                                
         %CYCLE I = 1,1,7                                                       
            BASE(I) = 0                                                         
         %REPEAT                                                                
         NAMESET = 0                                                            
         NUMEXT = 0                                                             
         NUMFIXUPS = 0                                                          
         PACK5=1;! NON-ZERO ONLY IN CE MODE                          
         %RETURN                                                                
      %FINISH                                                                   
      %RETURN %UNLESS NULLFLAG = 0                                              
!*                                                                              
        %IF CHANGE(TYPE) = 1 %START                                             
!*                                                                              
!*EMAS     %IF STRING(P3) -> ("ICL9CM").EPNAME %THENSTART                       
!*EMAS        CHANGEDNAME = "M#".EPNAME                                         
!*EMAS     %FINISHELSESTART                                                     
!*                                                                              
              CHANGEDNAME = STRING(P3)                                          
!*                                                                              
!*EMAS     %FINISH                                                              
!*                                                                              
        %FINISH                                                                 
!*                                                                              
      -> EP(TYPE)                                                               
!*                                                                              
%ROUTINE CHECKWORK(%INTEGER N)                                                  
%INTEGER J, F                                                                   
L1:   %IF TON+N > TMAX %THEN %START                                             
         %IF WORKMAX > X'40000' %THEN %START                                    
            INTEGER(TON) = (WORKAD+X'40000'-TON)!X'19000000'                    
                                           ! TYPE/SIZE OF FILLER RECORD         
                     !THIS MAKES A PSEUDO RECORD TYPE 25 TO  BE SKIPPED         
            TMAX = WORKAD+WORKMAX-64                                            
            TON = WORKAD+X'40000'                                               
            WORKMAX = 0                                                         
         %FINISH %ELSE %START                                                   
!*                                                                              
!*EMAS      SELECTOUTPUT(0)                                                     
!*EMAS      COMREG(24)=1;       !TO GIVE COMILATION FAULTY MESSAGE              
!*EMAS      PRINTSTRING("WORK FILE TOO SMALL")                                  
!*EMAS      %MONITOR                                                            
!*EMAS      %STOP                                                               
!*                                                                              
!*VME;      LPUTERROR=228                                                       
!*                                                                              
            NULLFLAG = -1;              ! WILL GENERATE FAILURE LATER           
            TON = TBASE+40;             ! AVOID ERROR MEANTIME                  
         %FINISH                                                                
      %FINISH                                                                   
%END;                                ! CHECKWORK                                
!*                                                                              
EP(37):                                                                         
                                                                                
      STACKMODE = 1                                                             
EP(31):                                                                         
                                                                                
                                                                                
EP(32):                                                                         
                                                                                
                                                                                
EP(33):                                                                         
                                                                                
                                                                                
EP(34):                                                                         
                                                                                
                                                                                
EP(35):                                                                         
                                                                                
                                                                                
EP(36):                                                                         
                                                                                
                                                                                
EP(1):                                  ! CODE                                  
EP(2):                                  ! GLA                                   
EP(3):                                  ! PLT                                   
EP(4):                                  ! SST                                   
EP(5):                                  ! UST                                   
      CHECKWORK(P1+12)                                                          
      R0 == RECORD(TON)                                                         
      R0_LA = P2                                                                
      %IF 0 <= P3 < 256 %THEN %START                                            
         I = 20                                                                 
         R0_DATALEN = -P1                                                       
         R0_FILLER = P3                                                         
      %FINISH %ELSE %START                                                      
         I = (P1+15)&X'FFFFFFFC'                                                
         R0_DATALEN = P1                                                        
         MOVE(P1,P3,TON+12)                                                     
      %FINISH                                                                   
      R0_TYPE = TYPE<<24!I;                ! TYPE,RECLEN                        
      TON = TON+I                                                               
      %RETURN                                                                   
EP(41):                                                                         
                                                                                
                                                                                
EP(42):                                                                         
                                                                                
                                                                                
EP(43):                                                                         
                                                                                
                                                                                
EP(44):                                                                         
                                                                                
                                                                                
EP(45):                                                                         
                                                                                
                                                                                
EP(46):                                                                         
                                                                                
                                                                                
EP(47):                                                                         
                                                                                
      CHECKWORK(P1>>24+16)                                                      
      R0 == RECORD(TON)                                                         
      R0_LA = P2                                                                
      I = (P1>>24+19)&X'FFFFFFFC'                                               
      R0_TYPE = TYPE<<24!I;                ! TYPE,RECLEN                        
      R0_DATALEN = P1>>24                                                       
      R0_FILLER = (P1<<8)>>8;              ! NO. OF COPIES                      
      MOVE(P1>>24,P3,TON+16)                                                    
      TON = TON+I                                                               
      %RETURN                                                                   
EP(24):                                 ! OLD STYLE ENTRY DEFN USED BY LINK     
      TYPE = 11                                                                 
      P2 = INTEGER(P2+8)                                                        
EP(11):                                 ! ENTRY POINT DEFN                      
      %IF CHANGEDNAME = 'S#GO' %THEN EPNAME = 'ICL9CEMAIN' %C                   
         %ELSE EPNAME = CHANGEDNAME                                             
!*                                                                              
!*EMAS  %IF COMREG57 # 0 %THEN %START                                           
!*                                                                              
         %IF EPNAME = 'ICL9CEMAIN' %OR P1>>31 # 0 %THEN %START                  
!*                                                                              
!*EMAS      COMREG(60) = COMREG(60)!2;     ! EXISTENCE OF MAIN EP               
!*                                                                              
!*VME;      MAINEPSET=1                                                         
!*                                                                              
SETEPNAME:                                                                      
!*                                                                              
!*EMAS      STRING(COMREG57) = EPNAME                                           
!*                                                                              
!*VME;      MAINEPNAME=EPNAME                                                   
!*                                                                              
         %FINISHELSESTART                                                       
            %IF NAMESET = 0 %THEN -> SETEPNAME                                  
         %FINISH                                                                
         NAMESET = 1                                                            
!*                                                                              
!*EMAS  %FINISH                                                                 
!*                                                                              
L3:   NUMEXT = NUMEXT+1                                                         
      CHECKWORK(44)                                                             
      R1 == RECORD(TON)                                                         
      %IF P1&3 = 0 %THEN P1 = P1!2                                              
      %IF P1 < 0 %THEN P1 = P1!128;        ! MAINEP BIT                         
      R1_LOC = P1<<24!(BASE(2)+P2)                                              
      LMAX = LMAX+44                                                            
      R1_NAME <- CHANGEDNAME                                                    
      I = (LENGTH(R1_NAME)+16)&X'FC'                                            
      R1_TYPE = TYPE<<24!I                                                      
      R1_LINK = HEAD(TYPE)                                                      
      HEAD(TYPE) = TON                                                          
      TON = TON+I                                                               
      %RETURN                                                                   
EP(12):                                 ! EXTERNAL ROUTINE REF                  
EP(13):                                 ! DYNAMIC ROUTINE REF                   
      -> L3                                                                     
EP(10):                                 ! COMMON AREA REFERENCE                 
EP(15):                                 ! DATA REF                              
!*  P1 = AREA<<24 ! MIN LENGTH                                                  
!*  P2 = LOC IN AREA OF REF                                                     
!*  P3 = ADDR(DATA NAME)                                                        
!*                                                                              
      CHECKWORK(60);                       ! ALLOW FOR NEW HEAD + VALUE RECORD  
      I = HEAD(15)                                                              
      %WHILE I # 0 %CYCLE                                                       
         R9 == RECORD(I)                                                        
         %IF R9_NAME = STRING(P3) %THEN %START                                  
EP15A:   R9_COUNT = R9_COUNT+1                                                  
            INTEGER(TON) = R9_REFLINK                                           
            INTEGER(TON+4) = (P1>>24)<<24!(P2+BASE(P1>>24))                     
            R9_REFLINK = TON-WORKAD                                             
            TON = TON+8                                                         
            J = (P1<<8)>>8                                                      
            %IF R9_L < J %THEN R9_L = J                                         
            LMAX = LMAX+8                                                       
            %RETURN                                                             
         %FINISH                                                                
         I = R9_LINK                                                            
      %REPEAT                                                                   
      R9 == RECORD(TON)                                                         
      R9_L = 0                                                                  
      R9_REFLINK = 0                                                            
      %IF TYPE = 10 %THEN J = X'80000000' %ELSE J = 0                           
      R9_COUNT = J                                                              
      R9_NAME <- STRING(P3)                                                     
      I = (LENGTH(R9_NAME)+24)&X'FC'                                            
      R9_TYPE = 15<<24!I                                                        
      R9_LINK = HEAD(15)                                                        
      HEAD(15) = TON                                                            
      TON = TON+I                                                               
      LMAX = LMAX+I-12                                                          
      NUMEXT = NUMEXT+1                                                         
      -> EP15A                                                                  
!*                                                                              
EP(14):                                 ! DATA ENTRY IN GLA                     
      K = P1>>24                                                                
      P1 = P1&X'00FFFFFF'                                                       
      -> A                                                                      
EP(17):                                 ! DATA ENTRY IN GLA ST                  
      K = 5                                                                     
      TYPE = 14                                                                 
A: CHECKWORK(52)                                                                
      NUMEXT = NUMEXT+1                                                         
      R4 == RECORD(TON)                                                         
      LMAX = LMAX+52                                                            
      R4_L = P1                                                                 
      R4_AREA = K                                                               
      R4_NAME <- CHANGEDNAME                                                    
      I = (LENGTH(R4_NAME)+28)&X'FC'                                            
      R4_TYPE = TYPE<<24!I                                                      
      R4_LINK = HEAD(TYPE)                                                      
      HEAD(TYPE) = TON                                                          
      R4_DISP = BASE(R4_AREA&255)+P2                                            
      TON = TON+I                                                               
      %RETURN                                                                   
EP(18):   ! MODIFY 18 BIT ADDRESS FIELD                                         
          ! P2  @ IN CODE AREA OF 32 BIT INSTRUCTION                            
          ! P3  18 BIT VALUE TO BE ADDED TO ADDRESS FIELD                       
      CHECKWORK(16)                                                             
      R8 == RECORD(TON)                                                         
      R8_TYPE = (18<<24)!16                                                     
      R8_LINK = HEAD(18)                                                        
      HEAD(18) = TON                                                            
      R8_CODEADDR = P2                                                          
      R8_ADDRFIELD = P3&X'3FFFF'                                                
      TON = TON+16                                                              
      %RETURN                                                                   
EP(20):                                                                         
                                                                                
                                                                                
EP(21):                                                                         
                                                                                
      P1 = 2                                                                    
      P3 = TYPE-19                                                              
EP(19):   ! RELOCATE WORD AT P2 IN AREA P1 BY BASE OF AREA P3                   
      NUMFIXUPS = NUMFIXUPS+1                                                   
      CHECKWORK(16)                                                             
      R7 == RECORD(TON)                                                         
      R7_TYPE = (19<<24)!16                                                     
      R7_LINK = HEAD(19)                                                        
      HEAD(19) = TON                                                            
      R7_AREALOC = P1<<24!P2                                                    
      R7_BASELOC = P3<<24                                                       
      TON = TON+16                                                              
      TYPE19NUM = TYPE19NUM+1                                                   
      LMAX = LMAX+8                                                             
      %RETURN                                                                   
EP(25):   ! OLD STYLE RELOCATION BLOCK(16 BYTES/ENTRY)                          
      P1 = (P1-4)>>1+4                                                          
EP(26):                                 ! GENERALISED RELOCATION BLOCK          
                                           ! P1   NO OF BYTES IN BLOCK          
                                           ! P3     @ OF BLOCK                  
      CHECKWORK(P1+8)                                                           
      LMAX = LMAX+P1                                                            
      R7 == RECORD(TON)                                                         
      R7_TYPE = 25<<24!(P1+8)                                                   
      R7_LINK = HEAD(25)                                                        
      HEAD(25) = TON                                                            
      %IF TYPE = 25 %THEN %START                                                
         I = INTEGER(P3)                                                        
         P3 = P3+4                                                              
         INTEGER(TON+8) = I                                                     
         J = TON+12                                                             
         %WHILE I # 0 %CYCLE                                                    
            INTEGER(J) = INTEGER(P3)<<24!INTEGER(P3+4)                          
            INTEGER(J+4) = INTEGER(P3+8)<<24!INTEGER(P3+12)                     
            J = J+8                                                             
            P3 = P3+16                                                          
            I = I-1                                                             
         %REPEAT                                                                
      %FINISH %ELSE MOVE(P1,P3,TON+8)                                           
      I = INTEGER(TON+8)                                                        
      J = TON+12                                                                
      %WHILE I # 0 %CYCLE                                                       
         K = INTEGER(J)                                                         
         INTEGER(J) = K+BASE(K>>24)                                             
         K = INTEGER(J+4)                                                       
         INTEGER(J+4) = K+BASE(K>>24)                                           
         J = J+8                                                                
         I = I-1                                                                
      %REPEAT                                                                   
      TON = TON+P1+8                                                            
      %RETURN                                                                   
EP(6):                                  ! SUMMARY DATA FOR PREVIOUS ROUTINE     
      R6 == RECORD(TYPE6)                                                       
      R6_TYPE = 6<<24!40                                                        
      MOVE(32,P3,TYPE6+4)                                                       
      %IF STACKMODE = 0 %THEN %START                                            
         R6_TOTLEN = R6_AREALEN(6)                                              
         R6_AREALEN(6) = 0                                                      
         R6_AREALEN(7) = 0                                                      
      %FINISH                                                                   
      RCOUNT = 0                                                                
      %CYCLE I = 1,1,7                                                          
         BASE(I) = (BASE(I)+R6_AREALEN(I)+7)&X'FFFFFFF8'                        
      %REPEAT                                                                   
      CHECKWORK(40)                                                             
      TYPE6 = TON                                                               
      TON = TON+40;                        ! RESERVE SPACE FOR NEXT DESCRIPTOR  
      %RETURN                                                                   
EP(7):                                  ! END OF FILE                           
      %IF P1 = 32 %THEN STACKMODE = 1                                           
      %IF TYPE6 = TBASE %THEN LPUT(6,32,0,P3)                                   
      R6 == RECORD(TYPE6)                                                       
      R6_TYPE = 7<<24;                     ! TO TERMINATE LAYOUT                
      OBJLEN = LMAX+16                                                          
      %CYCLE I = 1,1,7                                                          
         OBJLEN = OBJLEN+BASE(I)                                                
      %REPEAT                                                                   
      %IF PACK5#0 %THEN OBJLEN=OBJLEN-BASE(5)                                   
!*                                                                              
!*EMAS  OUTFILE(FILE,OBJLEN,0,0,FBASE,FLAG)                                     
!*EMAS  %IF FLAG # 0 %THEN SSERR(228);       ! PROGRAM TOO LARGE                
!*                                                                              
!*VME;  %IF OBJLEN>INTEGER(FBASE+8) %THENSTART                                  
!*VME;     LPUTERROR=228                                                        
!*VME;     %RETURN                                                              
!*VME;  %FINISH                                                                 
!*                                                                              
      %CYCLE I = 1,1,7                                                          
         AREALENGTH(I) = BASE(I)                                                
      %REPEAT                                                                   
      AREASTART(1) = 32                                                         
      AREASTART(4) = AREASTART(1)+AREALENGTH(1);! CST AFTER CODE                
      AREASTART(2) = AREASTART(4)+AREALENGTH(4);! GLA AFTER CST                 
      %IF PACK5#0 %THENSTART                                                    
         AREASTART(5)=0                                                         
         AREASTART(6)=AREASTART(2)+AREALENGTH(2)                                
      %FINISHELSESTART                                                          
         AREASTART(5) = AREASTART(2)+AREALENGTH(2);! GLAST AFTER GLA            
         AREASTART(6) = AREASTART(5)+AREALENGTH(5)                              
      %FINISH                                                                   
      AREASTART(7) = AREASTART(6)+AREALENGTH(6)                                 
      LDSTART = AREASTART(7)+AREALENGTH(7)                                      
      LDSTART = LDSTART+FBASE                                                   
      INTEGER(FBASE+4) = AREASTART(1);     ! START OF CODE                      
      INTEGER(FBASE+12) = 1;               ! OBJECT FILE CODE                   
      INTEGER(FBASE+24) = LDSTART-FBASE;   ! START OF LDATA                     
      H(0) = 14                                                                 
      %CYCLE I = 1,1,14                                                         
         H(I) = 0                                                               
      %REPEAT                                                                   
      H(12) = LDSTART-FBASE+68;            ! START OF OBJDATA RECORD            
      TON = TBASE                                                               
      %CYCLE I = 1,1,7                                                          
         BASE(I) = FBASE+AREASTART(I)                                           
      %REPEAT                                                                   
      LDDISP=132                                                                
      LAST13=ADDR(H(13))                                                        
      -> LSWITCH                                                                
LSW(41):                                                                        
                                                                                
                                                                                
LSW(42):                                                                        
                                                                                
                                                                                
LSW(43):                                                                        
                                                                                
                                                                                
LSW(44):                                                                        
                                                                                
                                                                                
LSW(45):                                                                        
                                                                                
                                                                                
LSW(46):                                                                        
                                                                                
                                                                                
LSW(47):                                                                        
                                                                                
      R0 == RECORD(TON)                                                         
      J = R0_FILLER;                       ! NO. OF COPIES                      
      L = R0_DATALEN                                                            
      %IF I=45 %AND PACK5#0 %THENSTART                                          
         L=LDSTART+LDDISP                                                       
         INTEGER(LAST13)=L-FBASE;! CHAIN FORWARD                                
         LAST13=L                                                               
         R13==RECORD(L)                                                         
         R13_LINK=0                                                             
         R13_A=5                                                                
         R13_DISP=R0_LA                                                         
         R13_LEN=R0_DATALEN                                                     
         R13_REP=J                                                              
         R13_ADDR=L+24-FBASE                                                    
         MOVE(R13_LEN,TON+16,L+24)                                              
         LDDISP=(LDDISP+R13_LEN+27)&X'FFFFFC'                                   
         ->NEXT                                                                 
      %FINISH                                                                   
      K = BASE(I-40)+R0_LA                                                      
      %WHILE J > 0 %CYCLE                                                       
         MOVE(L,TON+16,K)                                                       
         K = K+L                                                                
         J = J-1                                                                
      %REPEAT                                                                   
      -> NEXT                                                                   
LSW(31):                                                                        
                                                                                
                                                                                
LSW(32):                                                                        
                                                                                
                                                                                
LSW(33):                                                                        
                                                                                
                                                                                
LSW(34):                                                                        
                                                                                
                                                                                
LSW(35):                                                                        
                                                                                
                                                                                
LSW(36):                                                                        
                                                                                
                                                                                
LSW(37):                                                                        
                                                                                
      I = I-30                                                                  
LSW(1):                                                                         
                                                                                
                                                                                
LSW(2):                                                                         
                                                                                
                                                                                
LSW(3):                                                                         
                                                                                
                                                                                
LSW(4):                                                                         
                                                                                
                                                                                
LSW(5):                                                                         
                                                                                
      J=I                                                                       
      I = BASE(I)                                                               
      R0 == RECORD(TON)                                                         
      %IF J=5 %AND PACK5#0 %THENSTART                                           
         L=LDSTART+LDDISP                                                       
         INTEGER(LAST13)=L-FBASE;! CHAIN FORWARD                                
         LAST13=L                                                               
         R13==RECORD(L)                                                         
         R13_LINK=0                                                             
         R13_A=5                                                                
         R13_DISP=R0_LA                                                         
         %IF R0_DATALEN<0 %THENSTART;! BYTE                                     
            R13_LEN=1                                                           
            R13_REP=-R0_DATALEN                                                 
            R13_ADDR=R0_FILLER                                                  
            LDDISP=LDDISP+24                                                    
         %FINISHELSESTART                                                       
            R13_LEN=R0_DATALEN                                                  
            R13_REP=1                                                           
            R13_ADDR=L+24-FBASE                                                 
            MOVE(R13_LEN,TON+12,L+24)                                           
            LDDISP=(LDDISP+R13_LEN+27)&X'FFFFFC'                                
         %FINISH                                                                
         ->NEXT                                                                 
      %FINISH                                                                   
      %IF R0_DATALEN < 0 %THEN %START;     ! FILL                               
         FILL(-R0_DATALEN,R0_LA+I,R0_FILLER)                                    
      %FINISH %ELSE %START                                                      
         MOVE(R0_DATALEN,ADDR(R0_FILLER),R0_LA+I)                               
      %FINISH                                                                   
LSW(11):                                                                        
                                                                                
                                                                                
LSW(12):                                                                        
                                                                                
                                                                                
LSW(13):                                                                        
                                                                                
                                                                                
LSW(14):                                                                        
                                                                                
                                                                                
LSW(15):                                                                        
                                                                                
                                                                                
LSW(16):                                                                        
                                                                                
                                                                                
LSW(18):                                                                        
                                                                                
                                                                                
LSW(19):                                                                        
                                                                                
                                                                                
LSW(25):                                                                        
                                                                                
                                                                                
NEXT:                                                                           
      TON = TON+RECLEN                                                          
LSWITCH:                                                                        
!*                                                                              
!*EMAS    %IF BYTEINTEGER(TON) = X'81' %START                                   
!*EMAS       %MONITOR                                                           
!*EMAS       DUMP(TON-20000,TON+32)                                             
!*EMAS       %STOP                                                              
!*EMAS    %FINISH                                                               
!*                                                                              
      I = INTEGER(TON)                                                          
      RECLEN = (I<<8)>>8                                                        
      I = I>>24                                                                 
      -> LSW(I)                                                                 
LSW(0):                                                                         
                                                                                
      TON = TON+8;                         ! DATA REF LIST ENTRY                
      -> LSWITCH                                                                
LSW(6):                                                                         
                                                                                
                                                                                
LSW(7):                                                                         
                                                                                
      %UNLESS TON = TBASE %THEN %START;    ! NOTFIRST R6 REFERS TO LAST T6      
         %CYCLE I = 1,1,7                                                       
            BASE(I) = (BASE(I)+R6_AREALEN(I)+7)&X'FFFFFFF8'                     
         %REPEAT                                                                
      %FINISH                                                                   
      R6 == RECORD(TON)                                                         
      -> NEXT %UNLESS R6_TYPE>>24 = 7                                           
      L = LDSTART+LDDISP;                     ! SPACE FOR LISTHEADS+OBJDATA     
      J = HEAD(11)                                                              
      %WHILE J # 0 %CYCLE                                                       
         R1 == RECORD(J)                                                        
         INTEGER(L) = H(1)                                                      
         H(1) = L-FBASE                                                         
         INTEGER(L+4) = R1_LOC                                                  
         STRING(L+8) = R1_NAME                                                  
         L = (L+12+LENGTH(R1_NAME))&X'FFFFFFFC'                                 
         J = R1_LINK                                                            
      %REPEAT                                                                   
      J = HEAD(14)                                                              
      %WHILE J # 0 %CYCLE                                                       
         R4 == RECORD(J)                                                        
         INTEGER(L) = H(4)                                                      
         H(4) = L-FBASE                                                         
         MOVE(12,ADDR(R4_DISP),L+4)                                             
         STRING(L+16) = R4_NAME                                                 
         L = (L+20+LENGTH(R4_NAME))&X'FFFFFFFC'                                 
         J = R4_LINK                                                            
      %REPEAT                                                                   
      %CYCLE I = 7,1,8;                    ! EXREF, DYNAMIC XREF                
         J = HEAD(I+5)                                                          
         %WHILE J # 0 %CYCLE                                                    
            R1 == RECORD(J)                                                     
            INTEGER(L) = H(I)                                                   
            H(I) = L-FBASE                                                      
            INTEGER(L+4) = R1_LOC                                               
            STRING(L+8) = R1_NAME                                               
            L = (L+12+LENGTH(R1_NAME))&X'FFFFFFFC'                              
            J = R1_LINK                                                         
         %REPEAT                                                                
      %REPEAT                                                                   
!*                                                                              
      J = HEAD(15);                        ! DATA REFS                          
      %WHILE J # 0 %CYCLE                                                       
         R9 == RECORD(J)                                                        
         INTEGER(L) = H(9)                                                      
         H(9) = L-FBASE                                                         
         I = L+4                                                                
         INTEGER(L+8) = R9_L                                                    
         STRING(L+12) = R9_NAME                                                 
         L = (L+16+LENGTH(R9_NAME))&X'FFFFFFFC'                                 
         K = R9_COUNT                                                           
         INTEGER(I) = (L-FBASE)!(K>>31)<<31                                     
         K = (K<<1)>>1                                                          
         INTEGER(L) = K                                                         
         I = R9_REFLINK                                                         
         %WHILE I # 0 %CYCLE                                                    
            I = I+WORKAD                                                        
            INTEGER(L+K<<2) = INTEGER(I+4)                                      
                      ! STORE FROM END TO GIVE ORDERED ARRAY                    
            I = INTEGER(I)                                                      
            K = K-1                                                             
         %REPEAT                                                                
         L = L+INTEGER(L)<<2+4                                                  
         J = R9_LINK                                                            
      %REPEAT                                                                   
!*                                                                              
      J = HEAD(18);                        ! MODIFY ADDRESSES IN CODE           
      %WHILE J # 0 %CYCLE                                                       
         R8 == RECORD(J)                                                        
         %IF R8_CODEADDR < AREALENGTH(1) %THEN %START                           
            I = FBASE+AREASTART(1)+R8_CODEADDR                                  
            %IF I&2 = 0 %THEN %START;      ! 1 WORD ALLIGNED                    
               K = (INTEGER(I)<<14+R8_ADDRFIELD<<14)>>14                        
               INTEGER(I) = (INTEGER(I)&X'FFFC0000')!K                          
            %FINISH %ELSE %START                                                
               K = ((INTEGER(I-2)&3)<<30)!(INTEGER(I+2)>>2)                     
               K = (K+R8_ADDRFIELD<<14)>>14                                     
               INTEGER(I-2) = (INTEGER(I-2)&X'FFFFFFFC')!(K>>16)                
               INTEGER(I+2) = (INTEGER(I+2)&X'0000FFFF')!(K<<16)                
            %FINISH                                                             
         %FINISH                                                                
         J = R8_LINK                                                            
      %REPEAT                                                                   
!*                                                                              
      J = HEAD(19);                        ! INDIVIDUAL RELOCATION BLOCKS       
      %IF J # 0 %THEN %START                                                    
         H(14) = L-FBASE                                                        
         INTEGER(L) = 0                                                         
         INTEGER(L+4) = TYPE19NUM                                               
         L = L+8                                                                
      %FINISH                                                                   
      %WHILE J # 0 %CYCLE                                                       
         R7 == RECORD(J)                                                        
         INTEGER(L) = R7_AREALOC                                                
         INTEGER(L+4) = R7_BASELOC                                              
         L = L+8                                                                
         J = R7_LINK                                                            
      %REPEAT                                                                   
      J = HEAD(25);                        ! GENERALISED RELOCATION BLOCKS      
      %WHILE J > 0 %CYCLE                                                       
         R7 == RECORD(J)                                                        
         INTEGER(L) = H(14)                                                     
         H(14) = L-FBASE                                                        
         K = INTEGER(J+8)<<3+4                                                  
         MOVE(K,J+8,L+4)                                                        
         L = L+K+4                                                              
         J = R7_LINK                                                            
      %REPEAT                                                                   
!******* AREA SUMMARY                                                           
      INTEGER(FBASE+28) = L-FBASE                                               
      INTEGER(L) = 7;                      ! NO. OF AREAS                       
      L = L+4                                                                   
      %CYCLE I = 1,1,7                                                          
         INTEGER(L) = AREASTART(I)                                              
         INTEGER(L+4) = AREALENGTH(I)                                           
         INTEGER(L+8) = 0                                                       
         L = L+12                                                               
      %REPEAT                                                                   
      L = (L+11)&X'FFFFFFF8'                                                    
      INTEGER(FBASE) = L-FBASE                                                  
      H(2) = NUMEXT                                                             
      H(3) = NUMFIXUPS                                                          
      MOVE(60,ADDR(H(0)),LDSTART)                                               
                                           ! CHANGES ACCESS MODE                
      %RETURN                                                                   
%END;                                   ! LPUT                                  
!*                                                                              
%ENDOFFILE