⟦5bcf644b6⟧

PTS(SC)

	IDENT SYSLCO 	REL 11.0 81-01-26 870105041100 

			=3,CHANGE OF CONDITIONAL ASSEMBLY
			   PRR 11.0 80-12-23 
			=2,A CALLED COBOL PROGRAM CAN CALL AN
			   ASSEMBLER PROGRAM,AND FNDTGC USES 
			   MONITOR BLOCKS AS STACK 
			   PRR 11.0 80-12-03 
			=1,APPLICATION CONTROL BLOCK IS EXTENDED 
			   WITH 1 WORD 
			   PRR 11.0 80-11-19 
				
**********************************************************
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   SYSLCO = SYSTEM LOAD - COBOL APPLICATION CONFIGURATION PART 
* 
*   COBOL APPLICATION CONFIGURATION 
* 
**********************************************************
* 
*   COBOL APPLICATION:
*      SYSLCO READS CONFIGURATION FILE (ALREADY IN CORE) AND BUILD
*      WORK-TABLES (TABLES CONTAINING NUMBER OF REAL TASKS &
*      ITCT ADDRESS & MM-TAB ADDRESS & TID & DYNAMIC-CORE ADDRESSES). 
*      SYSLCO THEN MOVES ITSELF TO 'TOP' (LOVEST FREE ADDRESS) AND
*      WILL ALSO MOVE DDIV-PROTOTYPE. 
* 
*      APPLICATION TABLES ARE NOW 
*      BUILT FROM 'BOTTOM' (HIGHEST FREE ADDRESS) OF MEMORY.
*      DYNAMIC-CORE 
*      IS, IN CASE OF MMU AND/OR PAGING IN SYSTEM, ALSO ALLOCATED AT
*      'BOTTOM' OF MEMORY; ELSE, DYNAMIC-CORE AREAS ARE ALLOCATED 
*      AFTER MONITOR 'OVER' SYSLCO. 
* 
*      ALL USER TASKS ARE QUEUED VIA  A C T O T 
	EJECT
				
*************************** 
*                         * 
*  ENTRIES AND EXTERNALS  * 
*                         * 
*************************** 
			 
* LABEL ENTRIES 
	ENTRY	SYSLCO 

* EXTERNAL SUBROUTINES
	EXTRN	MOVE 
	EXTRN	MOVING 
	EXTRN	XMOVE	MOVE BLOCKS INSIDE MEMORY VIA MMU
	EXTRN	MMENT	FIND LAST USED ENTRY IN MM-TAB 
	EXTRN	MOVMMT	MOVE MM-TABLE 
	EXTRN	MMRST	RESET MM-TAB ENTRIES 
	EXTRN	MULT 
	EXTRN	ERROR
	EXTRN	CMPADR	COMPARE ADDRESSES 
	EXTRN	NXTBLK	SKIP TO NEXT CONFIGURATION BLOCK
	EXTRN	NXTCOM	SKIP COMMONDEVICE DEFINITION BLOCK
	EXTRN	CONVRT	CONVERSION ASCII-BINARY 
	EXTRN	GETNUM	CONVERT 3 ASCII-DIGITS TO BINARY
	EXTRN	GETAPP	FIND APPLICATION AND ITS CONF.DATA
	EXTRN	PUSH	STORE REGISTER ON A15-STACK 
	EXTRN	POB	LOAD REGISTER FROM A15-STACK 

* SAVE AND WORK AREA EXTERNALS
	EXTRN	MMTAB	WORK-TABLE 1 (MMU
	EXTRN	TABBE	ABSOLUTE START ADDRESS OF WORK-TAB 1 
	EXTRN	MMEND	ABSOLUTE END ADDRESS OF WORK-TAB 1 
	EXTRN	MMDDIV	WORK-TABLE 2 (MM) RELATIVE 'REL'
	EXTRN	LDALEN	LENGTH OF SYSLCO MODULE 
	EXTRN	APPTYP	APPLICATION TYPE
	EXTRN	PSW
	EXTRN	INILEN	LENGTH OF SYSINI
	EXTRN	LSTPAG	DISPL. TO 'ENTRY-POINTER' 
	EXTRN	MMBEG
	EJECT

* SYSTEM CONTROL TABLE EXTERNALS
	EXTRN	SCTSFA	START OF FREE AREA
	EXTRN	SCTTCT	TC:TAB ADDRESS
	EXTRN	SCTSTB	A15 STACK-BASE
	EXTRN	SCTEFA	END OF FREE AREA
	EXTRN	SCTNOP	NUMBER OF PAGES 
	EXTRN	SCTPSZ	PAGE SIZE 
	EXTRN	SCTMMC		=00002 
	EXTRN	SCTOPT	SYSTEM OPTION 
	EXTRN	SCTPAG	PAGE TABLE ADDRESS
	EXTRN	SCTSWB	ADDRESS TO SWB CONTROL BLOCK TABLE
	EXTRN	SCTBUG	BUGGER ADDRESS
	EXTRN	STKEND	START OF SCRATCH-PAD AREA 
	EXTRN	STKMOV	START OF MOVE-ROUTINE IN STACK
	EXTRN	STKCOM	START OF COMMON-PAD AREA

* EXTERNAL LABELS 
	EXTRN	SYSLDM	START OF MONITOR CONFIGURATION PART 
	EXTRN	PAGQUE	PAGE QUEUE POINTER
	EXTRN	FREQUE	START OF MONITOR BLOCKS 
	EXTRN	REL

* EXTERNAL SUBROUTINES
	EXTRN	ACTOT	QUEUE TASK 
	EXTRN	PFINIT 
	EXTRN	SAVE8	SAVE 8 REGS
	EXTRN	RETUR8	RELOAD 8 REGS 
	EXTRN	TDISP	DISPATCHER ENTRY 

* 
	EXTRN	TTB:SA	START OF SAVE AREA IN TTAB
	EXTRN	TTB:CB	POINTER TO CSEG BASE ADDRESS
	EXTRN	TTB:MT	START OF MMU-TABLE IN TTAB
	EJECT


*************************************** 
* CONDITIONAL ASSEMBLY                * 
*************************************** 

MMUPAG	EQU	0	0 = NO MMU 
DSKPAG	EQU	0	0=NO DISC PAGING 
TEST	EQU	0	1=TEST (DEBUG STARTS AT SYSLDX ENTRY)
TESTMM	EQU	MMUPAG+TEST

********************************************* 
*                                           * 
*    APCTAB DISPLACEMENTS                   * 
*    ====================                   * 
*                                           * 
********************************************* 


APLADA	EQU	22	APPL.REL.BASE (2 WORDS)	=1
APLREL	EQU	18	NUMBER OF RESIDENT SEGMENTS 
APLIOE	EQU	0	APPLICATION RESTART ADDRESS
APLDAD	EQU	0	APPLICATION FILE DISC ADDR. (BIT 0-15) 
APLLAC	EQU	14	APPLICATION LOAD ADDR. (LOGICAL ADDR.)
APLLAP	EQU	12	LOGICAL PAGE ADDRESS
APLLDA	EQU	0	APPLICATION LOAD ADDR. (PHYSICAL ADDR.)
APLMMC	EQU	10	APPLICATION MMU START ENTRY 
APLMMP	EQU	8	SEGMENT START MMU ENTRY
APLSEG	EQU	4	PHYSICAL START OF 1ST SEGMENT
APLNPE	EQU	6	NUMBER OF PAGE ENTRIES IN MMU
APLSWB	EQU	2	APPLICATION SWB
APLSTA	EQU	16	APPL. PGM START ADDRESS 
APLTYP	EQU	8	APPLICATION TYPE 
APLPSZ	EQU	20	APPLICATION SEGMENT SIZE	=1 
	EJECT
	  PROGRAM STRUCTURE: 
*          !-----------------------------------------------------!
*          !  SUBROUTINES                                        ! PART 1 
*  ENTRY ->!                * SYSLCO ENTRY *                     !
*          !  READ CONFIGURATION DATA AND GENERATE:              !
*          !  SHTAB1, SHTAB2, SHTAB3, TIDTAB AND DYNTAB          !
*          !                                                     !
*          !  SHTAB1:                                            !
*          !  -A TABLE OF "NUMBER OF COPIES OF THIS TCL"         !
*          !   IS BUILT AT THE END OF MONITOR                    !
*          !                                                     !
*          !  SHTAB2:                                            !
*          !  -A TABLE OF "ITCT PROTOTYPE ADDRESSES"             !
*          !   IS BUILT AT THE END OF SHTAB1                     !
*          !                                                     !
*          !   SHTAB3:                                           !
*          !   -A TABLE OF "MM-TABLE ADDRESSES"                  !
*          !    IS BUILT AT THE END OF SHTAB2                    !
*          !                                                     !
*          !   TIDTAB:                                           !
*          !   -A TABLE OF "TASK-ID'S IN RUNTIME SYSTEM"         !
*          !    IS BUILT AT THE END OF SHTAB3                    !
*          !                                                     !
*          !   DYNTAB:                                           !
*          !   -A TABLE OF "DYNAMIC-CORE ADDRESSES"              !
*          !    IS BUILT AT THE END OF TIDTAB                    !
*          !                                                     !
*          !   -RELOCATE ITCT     ADDRESSES                      !
*          !   -RELOCATE TCLBLK   ADDRESSES                      !
*          !   -RELOCATE TCLTAB   ADDRESS                        !
*          !   -RELOCATE APPTAB   ADDRESS                        !
*          !   -RELOCATE SHTAB2   ADDRESSES                      !
*          !   -MOVE SYSLCO (NOT PART 1) AND SYSINI              !
*          !    TO FOLLOW DYNTAB                                 !
*          !   -CONTINUE IN PART 2                               !
*          !-----------------------------------------------------!
*          !  SUBROUTINES                                        ! PART 2 
*          !  -MOVE DDIV PROTOTYPE TO FOLLOW SYSLCO              !
*          !                                                     !
*          !  BUILD COMMON DATA AREA                             !
*          !  -PGTG-DATA                                         !
*          !                                                     !
*          !  BUILD CLASS DATA AREAS                             !
*          !  -ICB-PLTGC'S                                       !
*          !                                                     !
*          !  BUILD TASK LOCAL DATA AREAS, ONE PER TCL           !
*          !  -UPDATE ITCT                                       !
*          !   -STACK-SIZE                                       !
*          !   -PGTL-DATA-LENGTH-USED                            !
*          !  -MOVE ITCT                                         !
*          !  -MOVE PGTL-DATA AREA                               !
*          !  -MOVE STATIC-ZERO AREA                             !
*          !  -ALLOCATE DYNAMIC-CORE (INITIATE IF MMU-CASE)      !
*          !  -INCLUDE DDIV PROTOTYPE IN FREE AREA              ! 
*          !  -CONTINUE IN PART 3                                !
*          !-----------------------------------------------------!
*          !  SUBROUTINES                                        ! PART 3 
*          !  R E A L T A                                        !
*          !  BUILD REAL TASK-LOCAL DATA AREAS                   !
*          !  -FILL MM-TABLE IN TTAB                             !
*          !  -COPY ITCT'S ACCORDING TO SHADOW-TABLE             !
*          !  -UPDATE TID IN ITCT                                !
*          !  -COPY PGTL-DATA                                    !
*          !  -COPY STATIC-ZERO                                  !
*          !  -ALLOCATE DYNAMIC-CORE (INITIATE IF MMU-CASE)      !
*          !  -CONTINUE IN SYSINI                                !
*          !-----------------------------------------------------!
	EJECT
****************************
*  COMMON DISPLACEMENTS    *
****************************
APLTAB	EQU	12	ADDRESS TO APPL.CONTROL TABLE 
APPLNO	EQU	18	APPLICATION NUMBER
BUFSIZ	EQU	14	TEMPORARY BUFFER SIZE 
CONLEN	EQU	0	LENGTH OF CONFIGURATION DATA 
CONSTA	EQU	2	START OF CONFIGURATION DATA
DATEND	EQU	34	END OF DDIV PROTOTYPE 
DYNSTA	EQU	52	START OF DYNTAB:S 
FSTADR	EQU	20	1:ST FREE ADDRESS WHEN ALLOCATING BUFFER
FSTPAG	EQU	22	1:ST FREE PAGE (PHYSICAL) 
FYSPAG	EQU	24	LAST PHYSICAL PAGE NUMBER 
LSTADR	EQU	26	LAST ADDRESS WHEN BUILDING DATA PART
MAPLEN	EQU	30	LENGTH OF AREA TO MAP 
MMFROM	EQU	36	2:ND MMU TABLE WORK AREA
MMTO	EQU	38	1:ST MMU TABLE WORK AREA
M:REL	EQU	16	RELOCATIN CONSTANT 
SYSBUF	EQU	28	START OF TEMPORARY BUFFER 
SWBFSA	EQU	4	SWB-FILE START ADDRESS 
SWBFSE	EQU	8	SWB-FILE END ADDRESS 
TTAB	EQU	32	WORK AREA FOR MMU-TABLE 
TOTSGM	EQU	46	NUMBER OF SEGMENTS
SWBFLG	EQU	48	SWAPPABLE WORK BLOCK FLAG 
COM01	EQU	40	COMMON WORK AREA 1 
COM02	EQU	42	COMMON WORK AREA 2 
COM03	EQU	44	COMMON WORK AREA 3 
COM04	EQU	50	COMMON WORK AREA 4 
	EJECT
**************************
*  TABLEN DISPLACEMENTS  *
**************************
SEGTAD	EQU	0	SEGTAB ADDRESS 
ITCTAD	EQU	2	ITCT ADDRESS 
SHADOW	EQU	4	SHADOW TABLE START ADDRESS 
DDIVFR	EQU	6	PROT.DDIV FROM ADDRESS 
PLTGCE	EQU	8	END OF ICB-PLTGC 
PLTGCL	EQU	10	LENGTH OF ICB-PLTGC 
PLTGCS	EQU	12	START OF ICB-PLTGC
DYNTAD	EQU	14	DYNTAB ADDRESS
APCTAB	EQU	16	APLTAB BLOCK ADDRESS
PDDIVL	EQU	18	LENGTH LEFT OF PROT.DDIV
	EJECT
******************************* 
*  SCRATCH-PAD DISPLACEMENTS  * 
******************************* 
ACOSTA	EQU	120	CONF.START FOR AN APPLICATION
ALICOU	EQU	112	SAVE AREA FOR APPLICATION COUNTER
APLTAD	EQU	122	APLTAB BLOCK ADDRESS 
BASADR	EQU	80	BASE ADDRESS FOR DEBUG PURPOSE
DDIVTO	EQU	124	PROT.DDIV TO ADDRESS 
DYNDIS	EQU	60	DYN.CORE DISPLACEMENT 
PDDIV	EQU	114	FLAG : 1=BUILD DDIV TO NEXT APPL. 
			       0=BUILD DDIV TO START OF FREE AREA
INTENT	EQU	62	INTERPRETER ENTRY 
LCOTO	EQU	64	ADR. WHERE TO MOVE SYSLCO TO 
MMREL1	EQU	66 
MONEND	EQU	84	MONITOR END ADDRESS 
MOVLE1	EQU	86	LENGTH TO MOVE
MOVLEN	EQU	68	LENGTTH TO MOVE 
NOCOPS	EQU	70	NUMBER OF RUNNING COBOL TASKS IN
			RUNTIME FOR AN APPLICATION 
RELOCA	EQU	72	TEMPORARY SAVE AREA FOR RELOCATION VALUE
SAEFA1	EQU	116	SCTEFA BIT 0-5 PAGE
SAEFA2	EQU	118	SCTEFA BIT 4-15 DISP. IN PAGE
SAVE01	EQU	88	TEMP. SAVE AREA 
SAVE02	EQU	96	TEMP. SAVE AREA OUTSIDE SUBRUTINES
SAVE03	EQU	126	TEMP. SAVE AREA OUTSIDE SUBRUTINES 
SAVE05	EQU	106	TEMP. SAVE AREA INSIDE LOKAL SUBRUTINES
SAVE06	EQU	108	TEMP. SAVE AREA INSIDE LOKAL SUBRUTINES
SAVE07	EQU	110	TEMP. SAVE AREA INSIDE LOKAL SUBRUTINES
SAVITC	EQU	94	SAVE AREA FOR ITCT ADDRESS
SAVTID	EQU	104	SAVE AREA FOR TASK ID
SHADST	EQU	74	START OF SHADOW TABLES FOR CURRENT APPL.
SHTLEN	EQU	76	SHTAB1-3 LENGTH 
STASK	EQU	82	NZ=ONLY ONE TASK IN THE SYSTEM 
TCLPNT	EQU	78	ADR. TO TCLBLK POINTER
TCLCOU	EQU	100	SAVE AREA FOR TCL COUNTER
TCLITC	EQU	102	SAVE AREA FOR TCL ITCT ADDRESS 
TGCREL	EQU	90	ICB-PLTGC RELOCATION
PGTGAD	EQU	92	PGTG DATA ADDRESS 
LSTENT	EQU	98	LAST USED ENTRY IN MMTAB,UPTO COMMON DAT
	EJECT
		***************** 
		***************** 
		**             ** 
		**  CONSTANTS  ** 
		***************** 
		***************** 
				
******************************* 
* CONFIGURATION FILE (CONFIG) * 
******************************* 
			 
* TASK DEFINITION BLOCK:
TDBBT	EQU	0	1A BLOCK TYPE 
TDBNT	EQU	TDBBT+1	2N NUMBER OF TASKS
TDBID	EQU	TDBNT+2	6A TASK ID START VALUE
TDBMC	EQU	TDBID+6	6A MATCHING TASK CLASS
TDBTL	EQU	TDBMC+6	6A TASK LEVEL 
TDBNC	EQU	TDBTL+6	2N NUMBER OF TERMINAL DEVICE CLASSES
* 
TDBFST	EQU	TDBNC+2	FIRST TERM DEF 
TDC	EQU	7	TERMINAL DEVICE CLASS 
TLC	EQU	7	LINE CONNECTION 
TDBREC	EQU	TDC+TLC	TDB-RECORD LENGTH
* 
SDC	EQU	7	SPECIAL DEVICE CLASS-RECORD 
* 
* COMMON DEVICE DEF. BLOCK: 
CDBBT	EQU	0	1A BLOCK TYPE 
CDBNC	EQU	CDBBT+1	2N NUMBER OF SPEC. DEV. CLASSES 
SDCFST	EQU	CDBNC+2	FIRST SDC-RECORD 
* 
* 
* USER WORK BLOCK TYPE DEF. BLOCK 
UDBBT	EQU	0	1A BLOCK TYPE 
UDBNU	EQU	UDBBT+1	3A NUMBER OF UWB TYPES
* 
UDBFST	EQU	UDBNU+3	FIRST UDB-RECORD 
NAMUWB	EQU	3	NAME OF UWB
NUMUBL	EQU	3	NUMBER OF BLOCKS 
UDBREC	EQU	NAMUWB+NUMUBL	UDB RECORD-LENGTH
	EJECT
				
				
*************************************** 
**                                   ** 
** THE FOLLOWING EQUATES ARE         ** 
** DISPLACEMENTS WITHIN EACH         ** 
** TABLE                             ** 
**                                   ** 
*************************************** 

*************** 
**           ** 
** SEGTAB    ** 
**           ** 
*************** 

SGAPPT	EQU	0	APPTAB POINTER 
SGPGMT	EQU	2	PROGRAM TYPE 'CO'
SGCOML	EQU	6	COMMON LENGTH
SGPAGL	EQU	8	PAGE LENGTH
SGNOSG	EQU	10	NUMBER OF SEGMENTS

*************** 
**           ** 
** APPTAB    ** 
**           ** 
*************** 

APPTCL	EQU	0	TCLTAB POINTER 
APPINT	EQU	2	INTERPRETER ENTRY
APPTGL	EQU	4	PGTG-DATA-AREA LENGTH
APPCOM	EQU	6	COMMON PSEG PNTR 
I:RSTE	EQU	8	DISPL IN APPTAB, INT REENTER ADR 

*************** 
**           ** 
** TCLTAB    ** 
**           ** 
*************** 

TCLCNT	EQU	0	NUMBER OF TCLBLK'S 
TCLTAB	EQU	2	TABLE OF TCLBLK POINTERS 
TCLNAM	EQU	0	TCL NAME 
TCLBLK	EQU	4	TCLBLK POINTER 

*************** 
**           ** 
** TCLBLK    ** 
**           ** 
*************** 

TCLSTK	EQU	0	STACK-SIZE 
TCLTGC	EQU	2	ICB-PLTGC-MAIN POINTER 
TCLTCT	EQU	4	ITCT POINTER 
TCLTLD	EQU	6	PGTL-DATA-LENGTH-USED

*************** 
**           ** 
** ICB-PLTGC ** 
**           ** 
*************** 

TGCSZD	EQU	4	STATIC-ZERO DISP IN TLTAB
TGCSZL	EQU	6	STATIC-ZERO LENGTH 
TGCCAL	EQU	8	CALL-BASE-ADR TAB
TGCCTS	EQU	0	NBR OF ENTRIES IN CALL TABLE 
TGCCTE	EQU	2	CALL TABLE ENTRY 

*************** 
**           ** 
** ITCT      ** 
**           ** 
*************** 

ITCCOM	EQU	0	PGTG-DATA-ADR
ITCTGC	EQU	2	ICB-PLTGC-PNTR 
ITCGLL	EQU	4	PGTL-DATA-LENGTH 
ITCGLA	EQU	6	PGTL-DATA-ADR
ITCCSB	EQU	10	CURRENT SEGMENT BASE
ITCTID	EQU	12	TASK-ID 
ITCDCB	EQU	14	DYNAMIC-CORE,BASE-PNTR
ITCDCC	EQU	16	      "     ,CURRENT-EXTENT 
ITCNEP	EQU	18	      "     ,NEXT PARAMETER 
ITCDCD	EQU	22	      "     ,DDI-POOL-BASE
ITCSPL	EQU	26	SPL-PBS-PNTR
ITCTLT	EQU	34	TLTAB 
ITCTLS	EQU	0	NBR OF ENTRIES IN TLTAB
ITCTLE	EQU	2	TLTAB ENTRY

*************** 
**           ** 
** SPL-PBS   ** 
**           ** 
*************** 

SPLTCD	EQU	0	DIAGNOSTIC,TERM-CODE 
SPLSTU	EQU	2	    "     ,STACK-USED
SPLSTS	EQU	4	    "     ,STACK-SIZE
SPLPRN	EQU	6	    "     ,PROCEDURE-NAME
SPLCPB	EQU	12	CURRENT-PROCEDURE-BLOCK 
SPLDIS	EQU	14	DISPLAY(16 POINTERS)
SPLG1S	EQU	46	GLOBAL1-SAVE
SPLG2S	EQU	48	GLOBAL2-SAVE
SPLG3S	EQU	50	GLOBAL3-SAVE
SPLSTB	EQU	52	STACK-BASE
SPLENT	EQU	54	ENTRY-FINI
SPLLTS	EQU	56	LAST-TS 
SPLRWA	EQU	58	RUNTIME-WORK-AREA(30 BYTES) 
SPLSTA	EQU	88	STACK-AREA
	EJECT
****************
* SOP-HANDLING *
****************
SOP	EQU	/2E	DEVICE ADDRESS

		  LAMP CODE	MEANING 
		  ---------	------- 
LMP1	EQU	/400	SYSLOAD RUNS
LMP2	EQU	/200	READ ERROR
LMP3	EQU	/100	MEMORY OVERFLOW 
LMP4	EQU	/80	FORMAT ERROR (CONFIG)
LMP5	EQU	/40	TID ERROR
LMP6	EQU	/20	UWB OR SWB ERROR 
LMP7	EQU	/10	MM-TABLE OVERFLOW
LMP8	EQU	8
LMP9	EQU	4
LMP10	EQU	2 
LMP11	EQU	1 
NOBLK	EQU	/B	NO BLOCKS	=2 


********************* 
*  OTHER CONSTANTS  * 
********************* 
			 
STKMAX	EQU	500	DEFAULT SPL STACK-SIZE IN BYTES
ENTFIN	EQU	/FFFF	PROGRAMMER DEFINED ENTRY POINT 
SPLSIZ	EQU	SPLSTA+STKMAX	DEFAULT SPL STACK-SIZE + PBS-BLOCK SIZE
COBID	EQU	2	COBOL IDENTIFICATION
SEGREC	EQU	6	RECORD LENGTH IN SEGTAB
NUMSEG	EQU	10	DISPL. TO NUMBER OF SEGMENTS IN SEGTAB
TTBTID	EQU	2	TID IN TTAB
TTB:PP	EQU	6	SAVE AREA FOR TCL IN TTAB
NTPA	EQU	4	INTERPRETER START ADDRESS
IHRTC	EQU	4	RTC INTERRUPT ADDRESS 
RTCDA	EQU	/1B	RTC DEVICE ADDRESS
TABLEN	EQU	20	LENGTH OF EACH APL.TABLE IN SCRATCH-PAD 
ACBLEN	EQU	26	APPL.CONTROL BLOCK LENGTH	=1
	EJECT
***************************************************************** 
*  CALL-FORMAT, PERFORMS:  CFR      A14,A13                     * 
*                          DATA     [REL-ADDRESS]               * 
*                                                               * 
***************************************************************** 
			 
			 
			 
CALL	FORM	16=/F697,16 
	IFT	MMUPAG=1 
	EJECT
			 
			 
********************************************* 
*******                               ******* 
**                                         ** 
*            SYSLOAD PART 1                 * 
**                                         ** 
*****                                   ***** 
********************************************* 
			 
*   READ CONFIGURATION FILE & BUILD         * 
*   SHADOW-TABLES                           * 
*                                           * 
********************************************* 
			 
LCOSTA	EQU	*
	LDKL	A1,START1	GET START OF SYSLCO 
	AD	A1,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A1	GO TO START OF SYSLCO 
			 
************************************* 
***                               *** 
**     S U B R O U T I N E S       ** 
**  -USED IN THIS PART ONLY        ** 
************************************* 
	EJECT
*                 B U I L D T                *
*                                            *
* BUILD ONE PART OF TIDTAB FOR CURRENT       *
* TASK DEFINITION BLOCK IN CONF.FILE         *
*                                            *
* INPUT : A1=ITCT ADDRESS                    *
*         A3=TID                             *
*         A4=NUMBER OF COPIES                *
*         A6=POINTER IN SHTAB1               *
*         A8=LENGTH OF SHTAB1                *
*         SHADST=START OF SHADOW TABLES FOR  *
*                CURRENT APPLICATION         *
*                                            *
* OUTPUT: A7=FIRST FREE ENTRY AFTER TIDTAB   *
*         SHADST=START OF SHADOW TABLES FOR  *
*                CURRENT APPLICATION         *
*                                            *
* WORK REGISTERS : A1-A8                     *
*                                            *
* SUBRUTINS : ERROR                          *
*                                            *
**********************************************
BUILDT	EQU	*
	LDR*	A2,A6	HAVE TASKS ALREADY BEEN CONF FOR THIS 
			TCL
	RF(NZ)	BUI100	YES! 
	ES	A3,ITCTID,A1	SAVE TID IN ITCT 
* COUNT NUMBER OF TASKS IN TIDTAB WHICH ARE GOING TO
* LIE BEFORE CURRENT TASKS
BUI100	EQU	*
	SUR	A2,A2	CLEAR TASK COUNTER 
	LDR	A5,A6	GET POINTER TO CURRENT ENTRY IN SHATB1 
BUI200	EQU	*
	ADR*	A2,A5	ADD NUMBER OF TASKS 
	SUK	A5,2	DECREASE SHTAB1 POINTER 
	CW	A5,SHADST+STKEND	ALL TASKS COUNTED? 
	RB(NE)	BUI200	NO!
* LOAD REGISTER A5 WITH POINTER TO START-ENTRY OF 
* CURRENT TASKS IN TIDTAB AND ADD NUMBER OF CURRENT 
* TASKS IN FIRST ENTRY OF TIDTAB
	ADR	A5,A8	ADD SHTAB1 LENGTH
	ADR	A5,A8	ADD SHTAB2 LENGTH
	ADR	A5,A8	ADD SHTAB3 LENGTH
	ADRS	A4,A5	UPDATE NUMBER OF TASKS IN TIDTAB
	ADK	A5,2	POINT AT FIRST TID IN TIDTAB
	SLL	A2,1	2*(NUMBER OF TASKS) 
	ADR	A5,A2	ADD DISPLACEMENT IN TIDTAB 
* COUNT NUMBER OF TASKS IN TIDTAB WHICH ARE GOING 
* TO LIE AFTER CURRENT TASKS
	LDR	A1,A6	GET POINTER TO SHTAB1 ENTRY OF CURRENT 
			TCL
	ADK	A1,2	ENTRY IN SHTAB1 AFTER CURRENT TCL 
	SUR	A2,A2	CLEAR TASK COUNTER 
	LDR	A7,A8	GET SHTAB1 LENGTH
	SUR	A7,A1
	AD	A7,SHADST+STKEND	LENGTH OF SHTAB1 IN BYTES AFTER CURRENT
			TCL
	RF(Z)	BUI350 
BUI300	EQU	*
	ADR*	A2,A1	ADD NUMBER OF TASKS 
	ADK	A1,2	INCREASE SHTAB1 POINTER 
	SUK	A7,2	ALL TASKS COUNTED?
	RB(NZ)	BUI300	NO!
* MAKE SPACE IN TIDTAB FOR CURRENT TASKS
BUI350	EQU	*
	LDR	A7,A5	LOAD START-ENTRY OF CURRENT TASKS IN 
			TIDTAB 
	ADR	A7,A2	ADD 2*(NUMBER OF TASKS AFTER 
	ADR	A7,A2	CURRENT TASKS) 
	SUK	A7,2	POINTER TO LAST TASK ID IN TIDTAB 
	SLL	A4,1	2*(NUMBER OF CURRENT TASKS) 
	CWR	A7,A5	ARE CURRENT TASKS LAST IN TIDTAB 
	RF(L)	BUI500	YES!
BUI400	EQU	*
	LDR*	A1,A7	GET TASK ID IN TIDTAB 
	ADR	A7,A4	NEW ENTRY IN TIDTAB FOR TASK ID
	STR	A1,A7	STORE TASK ID IN NEW ENTRY 
	SUR	A7,A4	GET OLD ENTRY IN TIDTAB
	SUK	A7,2	NEXT ENTRY IN TIDTAB
	CWR	A7,A5	ALL TASK ID MOVED? 
	RB(NL)	BUI400	NO!
* LOAD REGISTER A7 WITH FIRST FREE ENTRY AFTER TIDTAB 
* AND ADD NUMBER OF CURRENT TASKS IN CURRENT ENTRY OF SHTAB1
BUI500	EQU	*
	LDR	A7,A5	LOAD START ENTRY OF CURRENT TASKS IN 
			TIDTAB 
	ADR	A7,A2	ADD NUMBER OF BYTES AFTER CURRENT
	ADR	A7,A2	TASKNAMES IN TIDTAB
	ADR	A7,A4	FIRST FREE ENTRY AFTER TIDTAB
	SRL	A4,1	(2*(NUMBER OF TASKS))/2 
	ADRS	A4,A6	ADD NUMBER OF CURRENT TASKS,FOR	
			CURRENT TCL IN SHTAB1
* PUT CURRENT TASK ID:S IN TIDTAB 
	LD	A1,SHADST+STKEND	GET MONITOR END ADDRESS
	ADR	A1,A8	ADD SHTAB1 LENGTH
	ADR	A1,A8	ADD SHTAB2 LENGTH
	ADR	A1,A8	TIDTAB START ADDRESS 
	ADK	A1,2	FIRST TID IN TIDTAB 
BUI600	EQU	*
	LDR	A6,A1	GET TIDTAB START ADDRESS 
BUI700	EQU	*
	CWR	A6,A5	ALL TID:S OF UPPER PART IN TIDTAB
			SHECKED? 
	RF(NE)	BUI800	NO!
	ADR	A6,A4	FIRST TIDTAB ENTRY OF
	ADR	A6,A4	LOWER PART 
BUI800	EQU	*
	CWR	A6,A7	ALL TID:S OF LOWER PART IN TIDTAB
			SHECKED? 
	RF(E)	BUI950	YES!
	CWR*	A3,A6	TID ALREADY CONFIGURATED? 
	RF(NE)	BUI900	NO!
	LDKL	A1,LMP4	YES! FORMAT ERROR 
	CALL	ERROR 
BUI900	EQU	*
	ADK	A6,2	NEXT ENTRY IN TIDTAB
	RB	BUI700
BUI950	EQU	*
	STR	A3,A5	PUT TID IN TIDTAB
	ADK	A5,2	ADJUST UPPER PART END ADDRESS 
	ADK	A3,1	GENERATE NEXT TID 
	SUK	A4,1	HAVE ALL CURRENT TID:S BEEN CONF. 
	RB(NZ)	BUI600	NO!
	RTN	A14
	EJECT
*      L  I  M  T  G  C                 * 
*                                       * 
* FIND START-ADR, END-ADR, LENGTH OF    * 
* ICB-PLTGC BLOCK                       * 
*                                       * 
* INPUT:A10=POINTER TO CURRENT APPL     * 
*           SAVE AREA IN SCHRATCH-PAD   * 
*       SHADOW=START OF SHADOW TABLES   * 
*              FOR CURRENT APPL.        * 
* OUTPUT:PLTGCS= START ADR OF ICB-PLTGC * 
*        PLTGCE= END   ADR OF ICB-PLTGC * 
*        PLTGCL= LENGTH    OF ICB-PLTGC * 
* WORKREGS: A1-A7,A9,A11                * 
* WORKAREA:USES MONITOR BLOCKS AS STACK * 
*                                       * 
***************************************** 

LIMTGC	EQU	*
	LD	A1,SHADOW,A10	SHTAB1 ADDRESS
	LD	A7,FREQUE	GET MONITOR BLOCK ADDR. 
	LDR*	A2,A1	SHTAB1 LENGTH 
	ADR	A1,A2	SHTAB2 ADDRESS 
LIMTG0	EQU	*
	SUK	A2,2 
	RF(Z)	LIMTG5	ALL DONE
	ADK	A1,2	STEP SHTAB2 
	LDR*	A3,A1	ADR TO ITCT 
	EL	A3,ITCTGC,A3	ADR TO ICB-PLTGC OF MAIN PROGRAM 
LIMTG1	EQU	*
	LDK	A5,0	SET LEVEL TO 0(ZERO)
	CALL	LIMTG2	UPDATE LIMITS FOR ICB-PLTGC'S RELATED
			TO THIS CLASS
	RB	LIMTG0	NEXT TCL 
	EJECT
* 
* UPDATE LIMITS FOR ICB-PLTGC'S 
* RELATED TO ONE TERMINAL-CLASS 
* 
LIMTG2	EQU	*
	CALL	LIMUPD	UPDATE LIMITS
	ELR	A4,A3	GET FIRST WORD IN ICB-PLTGC
	ADKL	A4,/100	INDICATE LIMIT-CONTROL-INIT 
	ESR	A4,A3	SET INDICATION 
	EL	A4,TGCCAL,A3	GET NBR OF CALL-TABLE ENTRIES
LIMTG3	EQU	*
	RF(Z)	LIMTG4	NO ENTRIES (LEFT) 
	ST	A4,2,A7	SAVE NBR.OF ENTRIES ON STACK
	ST	A3,4,A7	SAVE ENTRY ADDRESS ON STACK 
	LDR*	A7,A7	ADJUST STACK POINTER	=2 
	RF(NZ)	LIMT35	MORE BLOCKS AVILABLE	=2
	LDKL	A1,NOBLK	NO BLOCKS AVILABLE	=2
	CALL	ERROR		=2 
LIMT35	EQU	*		=2
	ADK	A5,1	ADJUST LEVEL
	SLL	A4,1	*2 TABLE LENGTH 
	ADR	A4,A3	ADD BASE 
	ADK	A4,TGCCAL	ADD CALL-TABLE DISPLACEMENT
	ELR	A3,A4	GET ICB-PLTGC ADDRESS CALLED 
	ELR	A4,A3	GET THAT FIRST WORD CONTENT
	SRL	A4,8	ONLY FIRST BYTE VALID 
	SUK	A4,/60	FIRST TIME ?
	RB(Z)	LIMTG2	YES 
	LD	A4,-4,A7	GET NBR OF ENTRIES LEFT
LIMTG4	EQU	*
	SUK	A4,1	COUNT NBR OF ENTRIES LEFT 
	RB(P)	LIMTG3	ENTRIES LEFT
	SUK	A5,1	ADJUST LEVEL
	RF(N)	LIMTGX	END OF THIS TERMINAL CLASS
	SUK	A7,6	ADJUST STACK-POINTER
	LD	A4,2,A7	NBR.OF ENTRIES LEFT 
	LD	A3,4,A7	ENTRY ADDRESS 
	RB	LIMTG4	CONTINUE 
LIMTG5	EQU	*
	LD	A3,PLTGCE,A10	PNTR TO LAST ICB-PLTGC
	EL	A4,8,A3	NBR OF CALL-TAB ENTRIES 
	SLL	A4,1	NBR OF BYTES
	ADR	A4,A3	ADD BASE 
	ADK	A4,10	ADD TABLE DISPL
	ST	A4,PLTGCE,A10	SAVE END ADR
	SU	A4,PLTGCS,A10	-(MINUS) START ADR
	ST	A4,PLTGCL,A10	SAVE LENGTH 
LIMTGX	EQU	*
	RTN	A14
	EJECT
* 
* UPDATE ICB-PLTGC LIMITS 
* 
* INPUT: A3=ICB-PLTGC ADR 
* 
LIMUPD	EQU	*
	LDR	A11,A3	ICB-PLTGC ADR 
	LD	A9,PLTGCS,A10	GET CURRENT START ADR 
	CALL	CMPADR	CHECK ADDRESSES
	RF(NL)	LIMUP1	OLD START ADR VALID
	ST	A3,PLTGCS,A10	SET NEW START ADR 
LIMUP1	EQU	*
	LD	A9,PLTGCE,A10	GET CURRENT END ADR 
	CALL	CMPADR	CHECK ADDRESSES
	RF(L)	LIMUP2	OLD END ADR VALID 
	ST	A3,PLTGCE,A10	SET NEW END ADR 
LIMUP2	EQU	*
	RTN	A14
	EJECT
*         R  E  L  O  C           * 
*                                 * 
* RELOCATE AN ADDRESS             * 
*                                 * 
* INPUT: A3  ADDRESS POINTER      * 
*        A6  RELOCATION INCREMENT * 
* WORK:  A10                      * 
*********************************** 

RELOC	EQU	* 
	ST	A10,SAVE05+STKEND	SAVE REGISTER 
	ELR	A10,A3	GET ADDRESS 
	ADR	A10,A6	RELOCATE IT 
	ESR	A10,A3	RESTORE NEW ADDRESS 
	LD	A10,SAVE05+STKEND	RELOAD REGISTER 
	RTN	A14
	EJECT
*                 L E N C O U                *
*                                            *
* COUNT LENGTH OF SHTAB1,AND COUNT NUMBER OF *
* TASKS                                      *
*                                            *
* INPUT : A11=CONFIGURATION START            *
*         SHADST=START OF SHADOW TABLES FOR  *
*                CURRENT APPLICATION         *
*                                            *
* OUTPUT: A6=TOTAL NUMBER OF TASKS           *
*         A7=SHTAB1 LENGTH IN BYTES          *
*         SHADST=START OF SHADOW TABLES FOR  *
*                CURRENT APPLICATION         *
*                                            *
* WORK REGISTERS: A1,A3-A5                   *
*                                            *
* WORK TABLE: TEMPORARY TABLE WITH TCL       *
*             NAMES AFTER START OF FREE      *
*             AREA                           *
*                                            *
* SUBRUTINES: NXTBLK                         *
*                                            *
**********************************************
LENCOU	EQU	*
	LDK	A7,2	TABLE LENGTH-WORD LENGTH
	LDK	A6,0	TOTAL NBR OF TASKS
	CM*	SHADST+STKEND	CLEAR FIRST ENTRY OF TEMPORARY 
			TABLE
* SHECK IF CURRENT TCL NAME ALREADY HAS APEARED IN
* CONFIGURATION FILE , AND IF SO DON'T INCREMENT
* SHTAB1 LENGTH AND PUT CURRENT TCL NAME IN TEMPO-
* RARY TABLE
LEN100	EQU	*
	LC	A3,TDBMC+4,A11
	SLL	A3,8 
	LC	A3,TDBMC+5,A11	TCL NAME OF CURRENT TASK 
			TASK DEF. BLOCK
	LD	A1,SHADST+STKEND	ADDRESS TO FIRST ENTRY IN
			TEMPORARY TABLE
	LDR*	A4,A1	FIRST ENTRY=0?
	RF(Z)	LEN300	YES!
LEN200	EQU	*
	CWR	A4,A3	TCL NAME IN TEMPORARY TABLE
	RF(E)	LEN400	YES!
	ADK	A1,2	NEXT ENTRY IN TEMPORARY TABLE 
	LDR*	A4,A1	ENTRY=0?
	RB(NZ)	LEN200	NO!
LEN300	EQU	*
	ADK	A7,2	COUNT NUMBER OF BYTES IN SHTAB1 
	STR	A3,A1	PUT CURRENT TCL NAME IN
			TEMPORARY TABLE
	ADK	A1,2	NEXT ENTRY IN TEMPORARY TABLE 
	CMR	A1	CLEAR IT
* COUNT TOTAL NUMBER OF TASKS AND GET START OF NEXT 
* TASK DEF. BLOCK 
LEN400	EQU	*
	LC	A4,TDBNT+1,A11	NBR OF COPIES /2 
	SRC	A4,4 
	LC	A4,TDBNT,A11	NBR OF COPIES /1 
	SLC	A4,12
	SRL	A4,8	BINARY VALUE (NBR OF COPIES)
	LDR	A4,A4	NBR OF COPIES
	RF(Z)	LEN500	NO COPY , TRY NEXT BLOCK
	ADR	A6,A4	COUNT TOTAL NBR OF TASKS 
LEN500	EQU	*
	CALL	NXTBLK	NEXT CONFIG.-BLOCK 
	CCK	A2,'TT'	TASK DEF. BLOCK? 
	RB(E)	LEN100	NEXT TASK DEF. BLOCK
	RTN	A14
	EJECT

*            S Y S L C O                 *
*                                        *
* ENTRY FOR COBOL APPLICATION CONFIG     *
*                                        *
******************************************

				
			 
START1	EQU	*
SYSLCO	EQU	*
* 
*  INIT A15 STACK 
* 
	LD	A15,SCTSTB
	SUKL	A15,4 

	XIF
	IFT TESTMM=2 
******************************
* 
* TEST VERSION (DEBUG)
* 

	LD	A2,SCTBUG	DEBUGGER ADDRESS
	LD	A13,M:REL+STKCOM
	ADKL	A13,TEST1	SET RETURN ADDRESS
	ABR(NZ)	A2	JUMP IF DEBUG IN SYSTEM 

TEST1	EQU	* 
	LDR	A8,P	GET PROGRAM-POINTER 
	LDKL	A5,REL+2	GET START OF RELOCATION
			ROUTINE
	AD	A5,M:REL+STKCOM	ADD RELOCATION BASE 
	CFR	A8,A5

* 
* 
******************************

	XIF
	IFT MMUPAG=1 

* 
*        CLEAR SCRATCH-PAD AREA 
* 
	LDKL	A1,STKEND	A1=START OF SCRATCH-PAD AREA
	LDKL	A2,STKMOV 
	SUK	A2,2	A2=END OF SCRATCH-PAD AREA
SYA10	EQU	* 
	CMR	A1	CLEAR MEMORY WORD 
	CWR	A1,A2	ALL WORDS CLEARED? 
	RF(E)	SYA20	YES! 
	ADK	A1,2	NO! NEXT WORD 
	RB	SYA10 
* 
*        INITIATE REGISTERS AND VARIABLES 
* 
SYA20	EQU	* 
	LD	A1,FYSPAG+STKCOM	GET END OF FREE AREA PAGE
	ST	A1,SAEFA1+STKEND	INIT SAEFA1
	LD	A1,LSTADR+STKCOM	GET END OF FREE AREA DISP. 
	ST	A1,SAEFA2+STKEND	INIT SAEFA2
	CM	APPLNO+STKCOM	CLEAR APPL.NUMBER COUNTER 
	LDKL	A10,STKEND	START OF 1:ST APPL. SAVE AREA
			IN SCRATCH-PAD 
	LD	A1,SCTSFA	START ADR.TO SHTAB'S OF 1:ST APPL.
	ST	A1,SHADST+STKEND	SAVE START OF 1:ST SHADOW-TABLE
	CM	PDDIV+STKEND	CLEAR FLAG 
* 
*        GET APPLICATION
* 
SYA100	EQU	*
	LDKL	A1,'CO'	LOAD INPUT TO GETAPP,CO=COBOL APPL. 
	CALL	GETAPP	FIND APPL AND ITS CONF DATA
	RF(NZ)	SYA105	MORE APPL OF THIS TYPE 
	LD	A2,APPLNO+STKCOM	ANY COBOL APPL. TO CONFIG.?
	RF(NZ)	SYA102	YES! 
	LDKL	A1,LCOEND	SYSLCO END ADDR.
	AD	A1,M:REL+STKCOM	RELOCATE
	ABR	A1	LEAVE SYSLCO
SYA102	EQU	*
	LDKL	A2,SYA178	NO MORE APPL OF THIS TYPE 
	AD	A2,M:REL+STKCOM 
	ABR	A2 
SYA105	EQU	*
	ST	A11,ACOSTA+STKEND	SAVE CONF.START FOR THIS APPL 
	ST	A1,APCTAB,A10	SAVE APLTAB BLOCK ADDRESS 
	LD	A2,APLLAC,A1	GET SEGTAB ADDRESS 
	ST	A2,SEGTAD,A10	SAVE
	EJECT
			 
* READ CONFIG FILE AND BUILD SHADOWTABLE
			 
	EL*	A3,APLLAC,A1	APPTAB ADR
	EL	A2,I:RSTE,A3	GET INTERPRETER RESTART ADDRESS
	ST	A2,APLIOE,A1	STORE IT IN APLTAB 
	ELR	A2,A3	TCLTAB ADR 
	ELR	A12,A2	NBR OF TCL'S
	LDR	A4,A2
	ADKL	A4,4	ADR TO TCLBLK PNTR 
	ST	A4,TCLPNT+STKEND	SAVE 
	LC	A2,TDBBT,A11	BLOCK TYPE 
	CCK	A2,'TT'	TASK DEFINITION BLOCK
	RF(NE)	SYA120	NO 
	CALL	LENCOU
	LDR	A5,A7	SHTAB1 LENGTH * 1
	ADR	A5,A7	* 2
	ADR	A5,A7	* 3  SHTAB1-3 TOTAL LENGTH 
	ST	A5,SHTLEN+STKEND	SHTAB1-3 LENGTH
	LDR	A6,A6
	RF(Z)	SYA120	NOTHING TO CONFIGURATE
	ST	A6,NOCOPS+STKEND	SAVE NBR OF RUNNING TASKS/RUNTIME
* 
	LD	A11,SHADST+STKEND	MONITOR END ADR 
	ADR	A11,A5 
	ADR	A11,A6 
	ADR	A11,A6 
	ADKL	A11,2	NEW START OF FREE AREA
	LDKL	A9,LCOSTA	SYSLCO START
	AD	A9,M:REL+STKCOM	SYSLCO START
* CHECK ADDRESSES 
	CALL	CMPADR
	RF(L)	SYA115	OK !
	LDKL	A1,LMP3	MEMORY OVERFLOW 
	CALL	ERROR 
SYA115	EQU	*
	SUR	A8,A8
ZERO	EQU	*
	SUKL	A11,2	NEXT
	STR	A8,A11	CLEAR WORD
	CW	A11,SHADST+STKEND	ALL DONE ?
	RB(NE)	ZERO	NO 
	ST*	A7,SHADST+STKEND	STORE LENGTH IN TABLE LENGTH WORD 
	LDR	A8,A7	SHTAB1 LENGTH
	LD	A11,ACOSTA+STKEND	CONFIG START
	LC	A3,TDBBT,A11	GET BLOCK TYPE FROM CONF.
	CCK	A3,'TT'	TASK DEFINITION BLOCK ?
	RF(E)	SYA125	YES 
SYA120	EQU	*
	LDK	A1,LMP4	NO 
	CALL	ERROR 
SYA125	EQU	*
	LD	A2,TCLPNT+STKEND	ADR. TO TCLBLK POINTER 
	LC	A3,TDBMC+4,A11	TCL-ID 
	SLL	A3,8 
	LC	A3,TDBMC+5,A11	TCL-ID 
	LDR	A7,A12	NBR OF TCL'S
* 
*        CHECK IF TCL-ID FROM CONF. IS IN APPL
* 
SYA130	EQU	*
	SUK	A7,1	COUNT NBR OF TCL'S
	RF(NN)	SYA135	N=END OF TCLBLK'S
	LDK	A1,LMP5	TID IN CONF NOT IN APPL
	CALL	ERROR 
SYA135	EQU	*
	EL	A6,-2,A2	TCL-ID IN TCLBLK 
	CWR	A3,A6	FOUND ?
	RF(E)	SYA140	YES 
	ADK	A2,4	POINT AT NEXT TCLBLK
	RB	SYA130	TRY IN NEXT TCLBLK 
SYA140	EQU	*
	LD	A6,SHADST+STKEND
	ADR	A6,A8	START OF SHTAB2
	ADR	A6,A8	START OF SHTAB3
SYA145	EQU	*
	SUK	A6,2	STEP SHTAB2 
	LD	A3,SHADST+STKEND
	ADR	A3,A8
	CWR	A6,A3	END OF SHTAB2 ?
	RF(E)	SYA150	YES 
	LDR*	A1,A6	ITCT ADR IN SHTAB2
	ELR	A3,A2	GET TCLBLK-ADR 
	EL	A3,TCLTCT,A3	ITCT ADR IN TCLBLK 
	CWR	A1,A3	FOUND ?
	RB(NE)	SYA145	NO 
	RF	SYA155	YES
SYA150	EQU	*
	ADK	A6,2	NEXT ENTRY IN SHTAB2
	LDR*	A3,A6 
	RB(NZ)	SYA150	ENTRY NOT FREE 
	ELR	A3,A2	GET TCLBLK-ADR 
	EL	A1,TCLTCT,A3	ITCT ADR IN TCLBLK 
	STR	A1,A6	STORE ITCT ADR IN SHTAB2 
SYA155	EQU	*
	SUR	A6,A8	POINT AT ENTRY IN SHTAB1 
	LC	A4,TDBNT+1,A11	NBR OF COPIES / 2
	SRC	A4,4 
	LC	A4,TDBNT,A11	NBR OF COPIES / 1
	SLC	A4,12
	SRL	A4,8	BINARY VALUE (NBR OF COPIES)
	LDR	A4,A4	NBR OF COPIES
	RF(Z)	SYA170 
SYA160	EQU	*
	LC	A3,TDBID+4,A11	TID
	SLL	A3,8 
	LC	A3,TDBID+5,A11	TID
	CALL	BUILDT	BUILD TIDTAB PART FOR ONE TCL
SYA170	EQU	*
	CALL	NXTBLK	NEXT CONFIG-BLOCK
	CCK	A2,'TT'	TASK DEF BLOCK ? 
	RB(E)	SYA125	YES 
	LD	A1,NOCOPS+STKEND	TOTAL NBR OF RUNNING TASKS 
	SLL	A1,1	NBR OF BYTES USED 
	ADK	A1,2	ADD LENGTH WORD 
	STR	A1,A7	STORE LENGTH IN TABLE
	ST	A7,DYNTAD,A10	SAVE TABLE START
	ADR	A7,A1	UPDATE "FIRST FREE WORD" 
	SUK	A1,4 
	RF(NZ)	SYA175	MORE THAN ONE TASK IN THE SYSTEM 
	IM	STASK+STKEND	INDICATE SINGLE TASK APPLICATION 
* 
*        PREPARE FOR NEXT APPLICATION 
* 
SYA175	EQU	*
	LD	A2,SHADST+STKEND	GET START OF SHADOW TABLES 
	ST	A2,SHADOW,A10	SAVE IN APPL.SAVE AREA
	ADKL	A10,TABLEN	UPDATE SAVE AREA POINTER 
	ST	A7,SHADST+STKEND	SAVE START OF SHTAB1 
	LDKL	A2,SYA100 
	AD	A2,M:REL+STKCOM	ABSOLUTE BRANCH ADDRESS 
	ABR	A2	CHECK IF MORE APPLICATIONS
SYA178	EQU	*
	EJECT

* GET START OF SYSLCO AFTER MOVE
			 
	ADK	A7,1	TO-ADDRESS (AFTER SHADOW-TABLES)
	ANKL	A7,/FFFE	EVEN ADDRESS 

* CALCULATE RELOCATION

	LDKL	A2,PART2	GET START OF PART2 
	AD	A2,M:REL+STKCOM	ADD RELOCATION BASE 
	SUR	A2,A7	MOVE-LENGTH (SYSLCO) 
	NGR	A2,A2
	ST	A2,RELOCA+STKEND	SAVE NEW RELOCATION TEMPORARY
* CREATE SYSLCO,SYSINI & DDIV MM-TABLE *

	LDR	A2,A7	TO-ADDRESS (SYSLCO)
	ANKL	A2,/F000	FIRST PAGE 
	ST	A2,MMREL1+STKEND	SAVE PHYSICAL PAGE 
	SRL	A2,2	SHIFT FOR MM-PAGING 
	LDKL	A11,MMDDIV
	ADR	A11,A13	GET MM-TABLE START ADDRESSS= 
	LDK	A3,16	SET COUNTER
SYA179	STR	A2,A11	STORE PAGE-POINTER
	ADKL	A11,2	NEXT ENTRY
	ADKL	A2,/400	PAGE INCREMENT
	SUK	A3,1	ALL?
	RB(NZ)	SYA179	NO!
	ANKL	A7,/FFF	GET DISPLACEM. IN PAGE
	ST	A7,LCOTO+STKEND	SAVE (LOGICAL) TO-ADDRESS 
	LDKL	A3,PART2	GET START OF PART2 
	AD	A3,M:REL+STKCOM	ADD RELOCATION BASE 
	LDR	A2,A13	A13=START OF SYSINI 
	SUR	A2,A3	LENGTH 
	ADKL	A2,INILEN	ADKLD LENGTH OF SYSINI
	ST	A2,MOVLE1+STKEND	SAVE LENGTH TO MOVE
	ADR	A7,A2	START OF DDIV AFTER MOVE 
	ST	A7,DDIVTO+STKEND	SAVE NEW DDIV ADDRESS
* CALCULATE DDIV FROM-ADDRESS * 
	CM	APPLNO+STKCOM	RESET NBR OF APPL.
	LDKL	A10,STKEND	START OF 1:ST APPL.SAVE AREA 
SYA180	EQU	*
	LDKL	A1,'CO'	COBOL APPL. 
	CALL	GETAPP	ANY APPLICATION LEFT?
	RF(Z)	OUT01	NO!

	LD	A2,APLLAC,A1	GET SEGTAB 
	ELR	A9,A2	APPTAB ADR 
	EL	A9,APPCOM,A9	COMMON-PSEG-PNTR 
	EL	A3,SGNOSG,A2	NUMBER OF SEGMENTS 
	LDR	A1,A2	SAVE SEGTAB ADDR.
	LDK	A2,SEGREC	SEGMENT BLOCK RECORD LENGTH
	CALL	MULT
	ADR	A1,A3
	ADK	A1,SGNOSG+2	=> START OF DDIV 

	ST	A1,DDIVFR,A10	SAVE DDIV 'FROM'-ADDRESS
	LD	A6,DDIVTO+STKEND	GET DDIV TO ADDR.
	SUR	A6,A1	RELOCATION FOR DDIV
	ST	A6,SAVE01+STKEND	SAVE RELOCATION INCREMENT
	LDKL	A6,/FFFF
	ST	A6,PLTGCS,A10	INIT. START OF PLTGC'S
	CALL	LIMTGC	FIND ICB-PLTGC LIMITS
	LD	A6,SAVE01+STKEND	GET RELOCATION INCREMENT 
	EJECT
* 
* RELOCATE ITCT'S 
* 
RELITC	EQU	*
	LD	A1,DDIVFR,A10	ADR TO APPTAB 
	ELR	A1,A1	ADR TO TCLTAB
	ELR	A2,A1	NBR OF TCL'S 
RELIT1	EQU	*
	SUK	A2,1	ADJUST NBR OF TCL'S 
	RF(N)	RELITX	ALL ITCT'S RELOCATED
	ADK	A1,4	TCLBLK ADR POINTER
	ELR	A3,A1	TCLBLK ADR 
	ADK	A3,TCLTCT	ADR TO ITCT POINTER
	ELR	A3,A3	ITCT ADR 
	CALL	RELOC	RELOCATE PGTG-DATA ADDRESS
	ADK	A3,ITCGLA
	CALL	RELOC	RELOCATE PGTL-DATA-ADR
	ADK	A3,ITCTLT-ITCGLA	TLTAB ADR 
	ELR	A4,A3	NBR OF ENTRIES IN TLTAB
RELIT2	EQU	*
	SUK	A4,1	ADJUST LOOP-COUNTER 
	RB(N)	RELIT1	ALL ENTRIES RELOCATED 
	ADK	A3,ITCTLE	POINT AT NEXT ENTRY
	ELR	A5,A3	ENTRY CONTENT
	RB(Z)	RELIT2	FREE ENTRY
	CALL	RELOC	RELOCATE ENTRY
	RB	RELIT2	NEXT ITCT
RELITX	EQU	*
* 
* RELOCATE TCLBLK'S 
* 
RELTCB	EQU	*
	LD	A1,DDIVFR,A10	APPTAB ADR
	ELR	A1,A1	TCLTAB ADR 
	ELR	A2,A1	NBR OF TCL'S 
RELTB1	EQU	*
	SUK	A2,1	ADJUST NBR OF TCL'S 
	RF(N)	RELTBX	RELOCATION OF TCLBLK'S DONE 
	ADK	A1,4	TCLBLK ADR POINTER
	ELR	A3,A1	TCLBLK ADR 
	ADK	A3,TCLTGC
	CALL	RELOC	RELOCATE ICB-PLTGC-MAIN POINTER 
	ADK	A3,TCLTCT-TCLTGC 
	CALL	RELOC	RELOCATE ITCT POINTER 
	RB	RELTB1	NEXT TCLBLK
RELTBX	EQU	*
* 
* RELOCATE TCLTAB 
* 
RELTCT	EQU	*
	LD	A1,DDIVFR,A10	APPTAB ADR
	ELR	A3,A1	TCLTAB ADR 
	ELR	A2,A3	NBR OF TCL'S 
RELTC1	EQU	*
	SUK	A2,1	COUNT NBR OF TCL'S
	RF(N)	RELTCX	RELOCATION OF TCLTAB DONE 
	ADK	A3,4	TCLBLK ADR POINTER
	CALL	RELOC	RELOCATE TCLBLK POINTER 
	RB	RELTC1	NEXT TCLBLK POINTER
RELTCX	EQU	*
* 
* RELOCATE APPTAB 
* 
RELAPP	EQU	*
	LD	A3,DDIVFR,A10	APPTAB ADR
	CALL	RELOC	RELOCATE TCLTAB-PNTR
RELAPX	EQU	*
* 
* RELOCATE SHADOW-TABLE2 (ITCT ADDRESSES) 
* 
RELSHT	EQU	*
	LD*	A1,SHADOW,A10	SHTAB LENGTH 
	LDR	A2,A1	SAVE SHTAB2 LENGTH 
	AD	A1,SHADOW,A10	SHTAB2 ADR
RELSH1	EQU	*
	SUK	A2,2	ADJUST SHTAB2 LENGTH
	RF(Z)	RELSHX	RELOCATION OF SHTAB2 DONE 
	ADK	A1,2	POINT AT ITCT ADR 
	ADRS	A6,A1	RELOCATE ITCT ADR 
	RB	RELSH1	NEXT 
RELSHX	EQU	*
	ADKL	A10,TABLEN	NEXT APPL. SAVE AREA 
	RB	SYA180	CHECK IF MORE APPL.
OUT01	EQU	* 

	LD	A5,RELOCA+STKEND	GET NEW RELOCATION INCREMENT 
	ADS	A5,M:REL+STKCOM	AND ADJUST RELOCATION BASE 

* CONTINUE IN PART 2 *
			 
	LD	A2,LCOTO+STKEND	GET TO-ADDRESS (SYSLCO) 
	OR	A2,MMREL1+STKEND	PHYSICALL ADDRESS
	LDR	A5,A2	SAVE 
	AD	A5,MOVLE1+STKEND
	SUKL	A5,INILEN	A5=SYSINI START 
	LDKL	A7,START2	GET EXECUTION START ADDRESS 
	AD	A7,M:REL+STKCOM	ADD RELOCATION BASE 
	LD	A3,MOVLE1+STKEND	SYSLCO+SYSINI LENGTH 
	LDKL	A1,PART2	GET START OF PART2 
	AD	A1,M:REL+STKCOM	ADD RELOCATION BASE 
	SU	A1,RELOCA+STKEND	FROM ADDRESS 
* 
* JUMP TO ROUTINE IN SYSTEM-STACK WHICH 
* MOVES SYSLCO, AND THEN CONTINUE IN PART2
* INPUT TO ROUTINE IN STACK IS
*	A1 = FROM ADDR. 
*	A2 = TO ADDR. 
*	A3 = LENGTH 
*	A7 = RESTART ADDR.
* 
	ABL	STKMOV	JUMP TO MOVE-ROUTINE
	EJECT
				
************************************************* 
***                                           *** 
**           SYSLOAD PART 2                    ** 
**                                             ** 
************************************************* 

*   BUILD COMMON AND TASKCLASS DATA AREAS.      * 
*   BUILD TASKDATA PROTOTYPE AREA               * 
*                                               * 
************************************************* 

PART2 	EQU	*

********************************************
***                                      ***
**         S U B R O U T I N E S          **
********************************************

				
	EJECT
*           M O V C O M               * 
*                                     * 
* MOVE ICB-PGTG AND PGTG-DATA         * 
*                                     * 
*************************************** 

MOVCOM	EQU	*
	CALL	FNDCOM	ICB-PGTG ADR 
	LD	A3,DDIVTO+STKEND	APPTAB ADR 
	EL	A3,APPTGL,A3	PGTG-DATA LENGTH 
	CALL	CALLMO	ALLOCATE AND MOVE PGTG-DATA
	ST	A2,PGTGAD+STKEND	SAVE PGTG-DATA NEW ADDRESS 
	LD	A1,DDIVTO+STKEND
	LD	A3,DDIVFR,A10 
	RTN	A14
	EJECT
*         F N D C O M          *
*                              *
* FIND PGTG-DATA               *
*                              *
* EXIT  : A1 PGTG-DATA ADR     *
********************************

FNDCOM	EQU	*
	EL*	A1,DDIVTO+STKEND	ADR TO TCLTAB 
	EL	A1,4,A1	ADR TO TCLBLK 
	EL	A1,TCLTCT,A1	ADR TO ITCT
	ELR	A1,A1	ADR TO PGTG-DATA 
	RTN	A14
	EJECT
*                                       * 
*        R  E  L  T  G  C               * 
*                                       * 
*  RELOCATE ICB-PLTGC CALL-TAB          * 
*                                       * 
*  INPUT: PLTGCS= ICB-PLTGC BLOCK       * 
*                 START ADDRESS         * 
*         PLTGCL= ICB-PLTGC BLOCK       * 
*                 LENGTH                * 
*         A6    = RELOCATION INCREMENT  * 
*         A10   = APPL.SAVE AREA POINTER* 
*                                       * 
***************************************** 

RELTGC	EQU	*
	LD	A3,PLTGCS,A10	ICB-PLTGC START ADR 
	LD	A2,PLTGCL,A10	ICB-PLTGC LENGTH
	ADR	A2,A3	ICB-PLTGC END ADR
RELTG1	EQU	*
	LDR	A1,A3
	LDR	A11,A1	GET ADR FOR COMPARE 
	LDR	A9,A2	GET ADR FOR COMPARE
	CALL	CMPADR	ALL ICB-PLTGC'S RELOCATED ?
	RF(NL)	RELTGX	YES
	ELR	A3,A1	GET FIRST WORD IN ICB-PLTGC
	SRC	A3,8	GET FIRST BYTE
	CCK	A3,/6161	HANDLED BY LIMTGC ? 
	RF(NE)	RELTG2	NO 
	XRK	A3,1	CLEAR BIT 15
	SLC	A3,8	NEW FIRST WORD VALUE
	ESR	A3,A1	RESTORE IT 
RELTG2	EQU	*
	EL	A3,TGCCAL,A1	NBR OF ENTRIES 
	SLL	A3,1	*2 NBR OF BYTES 
	ADR	A3,A1	ADD BASE 
	ADK	A3,10	POINTER TO 1:ST WORD AFTER LAST ENTRY
	LDR	A4,A1	GET BASE 
	ADK	A4,10	1:ST ENTRY 
	LDR	A9,A3
RELTG3	EQU	*
	LDR	A11,A4 
	CALL	CMPADR	END OF THIS ICB-PLTGC ?
	RB(NL)	RELTG1	YES,CONTINUE WITH NEXT ICB-PLTGC 
	ELR	A11,A4	GET ADR TO RELOCATE 
	ADR	A11,A6	RELOCATE
	ELR	A1,A11 
	SRL	A1,8 
	SUK	A1,/60	ICB-PLTGC ? 
	RF(N)	RELTG4	NO, ASM-SUBROUTINE
	SUK	A1,1 
	RF(P)	RELTG4	NO, ASM-SUBROUTINE
	ESR	A11,A4	RESTORE RELOCATED ADR 
RELTG4	EQU	*
	ADK	A4,2	STEP CALL-TAB POINTER 
	RB	RELTG3	NEXT CALL-TAB-ENTRY
RELTGX	EQU	*
	RTN	A14
	EJECT
*             F N D B L K        *
*                                *
* FIND A TCLBLK CORRESPONDING    *
* TO AN ITCT ADDRESS             *
*                                *
* INPUT : A7     ITCT ADR        *
*         DDIVTO APPTAB ADR      *
* EXIT  : A1     TCLBLK-PNTR ADR *
*                IN TLCTAB       *
*         A3     TCLBLK ADR      *
* WORK  : A2,A5                  *
**********************************

FNDBLK	EQU	*
	LD	A1,DDIVTO+STKEND	TCLTAB ADR 
	ELR	A1,A1
	ELR	A2,A1	NBR OF TCLBLK'S
FNDBL0	EQU	*
	SUK	A2,1	COUNT NBR OF TCLBLK'S 
	RF(NN)	FNDBL1	BLOCKS LEFT
	LDK	A1,LMP4
	CALL	ERROR 
FNDBL1	EQU	*
	ADK	A1,4	TCLBLK-PNTR ADR 
	ELR	A3,A1	TCLBLK-PNTR
	EL	A5,TCLTCT,A3	ITCT FOUND ? 
	CWR	A7,A5
	RB(NE)	FNDBL0	NO,TRY NEXT TCLBLK 
	RTN	A14	YES,RETURN 
	EJECT

***************************** 
* START OF PROGRAM PART 2   * 
***************************** 

* LOAD BASE ADDRESS * 
********************* 
* A5=START-ADDRESS
* SAVE01=RELOCATION INCREMENT 
* SAVE03=DDIV TO-ADDRESS
* SAVE04=DDIV FROM ADDRESS
* SAVE05=LENGTH OF REAL ITCTTAB 
				
START2	EQU	*
	LDR	A8,P	LOAD TEMP. STACKBASE
	ADK	A5,2	ADD FOR RELOCATION ROUTINE
	CFR	A8,A5
* 
*        INITIATE REGISTERS AND VARIABLES 
* 
	LDKL	A10,STKEND	START OF 1:ST APPL. SAVE AREA
	LD	A1,APCTAB,A10	FIRST APLTAB BLOCK ADDR.
	LD	A2,APPLNO+STKCOM	GET NUMBER OF APPLICATIONS 
	ST	A2,ALICOU+STKEND	INIT. ALICOU 
	RF	PRT200
* 
*        UPDATE VALUES FOR NEXT APPLICATION 
* 
NXTAPP	EQU	*
	ADKL	A10,TABLEN	NEXT APPL. SAVE AREA 
	LD	A1,APCTAB,A10	NEXT APLTAB BLOCK 
	LD	A2,ALICOU+STKEND	GET APPL.COUNTER 
	SUK	A2,1	DECREMENT APPL.COUNTER
	ST	A2,ALICOU+STKEND	SAVE APPL.COUNTER
	RF(NZ)	PRT200	IF ANY APPL IS LEFT
			DON'T LEAVE SYSLCO YET 
	LD	A2,SAEFA1+STKEND	GET END OF FREE AREA PAGE
	ST	A2,FYSPAG+STKCOM	SET FYSPAG TO THAT PAGE
	LD	A2,SAEFA2+STKEND	GET END OF FREE AREA DISPL.
	ST	A2,LSTADR+STKCOM	SET LSTADR TO THAT DISPL.
	LDKL	A2,LCOEND	GET SYSLCO END ADDRESS
	AD	A2,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A2	LEAVE SYSLCO

PRT200	EQU	*
* 
*	GET MMU-TABLE FROM TTAB OF CURRENT TASK 
* 
	LD*	A2,APLMMC,A1	GET TCTAB ENTRY FOR CURRENT TASK
	ADKL	A2,TTB:MT	ADDR. TO 1:ST MMU-TABLE ENTRY 
	TLR	A2	LOAD MMU-TABLE
	TS	MMTAB,A13	STORE MMU-TABLE IN MMTAB
* 
*        CHECK IF END OF FREE AREA STARTS WHERE 
*        PROT. DDIV FOR THIS APPLICATION STARTS 
*        AND IF SO RESET FLAG 
* 
	LD	A2,APLLAC,A1	GET SEGTAB ADDR. 
	ELR	A9,A2	APPTAB ADDR. 
	EL	A3,APPINT,A9	INTERPRETER ACTIV ADDR.
	ST	A3,INTENT+STKEND	SAVE IT
	EL	A9,APPCOM,A9	START OF APPL. 
	ST	A9,APLLAC,A1	STORE NEW APLLAC 
	LDR	A3,A2	SEGTAB ADDR. 
	SRL	A3,11	MMU-ENTRY NUMBER 
	ADKL	A3,MMTAB	MMU-ENTRY ADDR.
	ADR	A3,A13	RELOCATE
	LDR*	A3,A3	GET CONTENTS IN MMU-ENTRY 
	ANKL	A3,/FC00
	CW	A3,SAEFA1+STKEND	SAME PAGE? 
	RF(NE)	PRT205	NO!
	LDR	A3,A2	SEGTAB ADDR. 
	ANKL	A3,/FFF	DISPLACEMENT
	CM	PDDIV+STKEND	RESET FLAG 
	CW	A3,SAEFA2+STKEND	SAME DISPLACEMENT IN PAGE? 
	RF(E)	PRT220	YES!
* 
*        CALCULATE LENGTH OF PROT. DDIV+SEGTAB
* 
PRT205	EQU	*
	LDR	A3,A2	SEGTAB ADDR. 
	ANKL	A3,/FFF	DISPLACEMENT IN PAGE
	SUKL	A3,/800	MORE THAN 2K BYTE TO BUILD IN 
	RF(NP)	PRT210	YES! 
	LDR	A3,A2	SEGTAB ADDR. 
	ADKL	A2,/1000	NEW PAGE 
	ANKL	A2,/F000	DISPLACEMENT IN PAGE = 0 
	CWR	A2,A9	HIGHER ADDR.THEN START OF APPL.? 
	RF(NG)	PRT210	NO!
	LDR	A2,A3	SEGTAB ADDR. 
PRT210	EQU	*
	LDR	A3,A9	APPLICATION START ADDR.
	SUR	A3,A2	LENGTH OF SEGTAB+PROT.DDIV 
	ST	A3,PDDIVL,A10	SAVE
	IM	PDDIV+STKEND	SET FLAG 
PRT220	EQU	*
* 
*	STORE MMTABLE ADDRESSES 
* 
	LDKL	A1,MMDDIV	GET MMU-TABLE ADDR. 
	ADR	A1,A13	RELOCATE
	ST	A1,MMTO+STKCOM	SAVE 
	LDKL	A1,MMTAB	GET MMU-TABLE ADDR.
	ADR	A1,A13	RELOCATE
	ST	A1,MMFROM+STKCOM	SAVE 
* 
*	MOVE DDIV 
* 
	LD	A1,DDIVFR,A10	GET FROM-ADDRESS
	LD	A2,DDIVTO+STKEND	GET TO ADDRESS 
	LDR	A3,A9	GET APPLICATION START (=END OF DDIV
	SUR	A3,A1	=> LENGTH
	CALL	XMOVE 
* UPDATE FSTPAG AND FSTADR
	LD	A1,APCTAB,A10	GET APLTAB BLOCK ADDR.
	LD	A5,APLLAC,A1	DDIV END ADDR. 
	SU	A5,DDIVFR,A10	END-START=DDIV LENGTH 
	AD	A5,DDIVTO+STKEND	NEW DDIV END 
	LDR	A6,A5
	ANKL	A6,/F000	GET LOGICAL PAGE (MM-ENTRY)
	SRL	A6,11	ADJUST FOR ADDRESSING
	ADKL	A6,MMDDIV	ADD RELATIVE START ADDRESS
	ADR	A6,A13	RELOCATE
	LDR*	A6,A6	GET MM-TABLE CONTENTS 
	ST	A6,FSTPAG+STKCOM	SAVE 
	ANKL	A5,/FFF	GET DISPLACEMENT
	ST	A5,FSTADR+STKCOM	AND SAVE 
	SUKL	A9,10	RESERVE 5 WORDS FOR DEBUGGER
* CHECK IF MEMORY OVERFLOW
	LDR	A1,A9	SAVE 
	LDR	A9,A6
	LD	A11,SAEFA1+STKEND 
	CALL	CMPADR
	RF(G)	SYA202	OK! 
	RF(L)	SYA201	NOT OK! 
	LDR	A9,A5
	LD	A11,SAEFA2+STKEND 
	CALL	CMPADR	MEMORY OVERFLOW? 
	RF(NL)	SYA202	NO!
SYA201	EQU	*
	LDKL	A1,LMP3 
	CALL	ERROR 
SYA202	EQU	*
	LDR	A9,A1	RELOAD 
* REMOVE DDIV ENTRIES IN MM-TABLE 

	SRL	A1,11	ADJUST FOR ADDRESSING
	ANK	A1,/1E 
	LDKL	A2,MMTAB-2	GET TABLE ADDRESS
	ADR	A2,A13	RELOCATE
	ADR	A1,A2	APPTAB START ENTRY 
	LDKL	A4,/FC00
SYA205	CWR	A1,A2	ALL? 
	RF(E)	SYA207	YES!
	STR	A4,A1	REPLACE ENTRY WITH PAGE ERROR
	SUK	A1,2 
	RB	SYA205
SYA207	EQU	*
* CHANGE TABLE-ADDRESSES
	LD	A4,MMFROM+STKCOM
	LD	A5,MMTO+STKCOM
	ST	A4,MMTO+STKCOM
	ST	A5,MMFROM+STKCOM
	ANKL	A9,/FFFE	EVEN ADDRESS 
	ST	A9,LSTADR+STKCOM	SAVE END OF FREE AREA
	LDKL	A3,MMTAB	CURRENT MM-TAB 
	ADR	A3,A13 
	CALL	MMENT 
	ST	A9,TTAB+STKCOM
	ST	A1,FYSPAG+STKCOM	SAVE PHYSICAL PAGE 
	CALL	MOVCOM	ALLOC/MOVE PGTG-DATA 
	AD	A1,PLTGCS,A10 
	SUR	A1,A3	ICB-PLTGCS NEW START ADDRESS 
	LD	A3,PLTGCL,A10	ICB-PLTGC LENGTH
	LD	A6,LSTADR+STKCOM	LAST FREE ADR
	SU	A6,PLTGCE,A10	GET DISPL FOR RELOCATION
	CALL	CALLMO	MOVE 
	TL*	MMTO+STKCOM
	ST	A2,PLTGCS,A10	ICB-PLTGCS NEW (FINAL) START ADR
	CALL	RELTGC	RELOCATE ICB-PLTGC CALL TABLE
	ST	A6,TGCREL+STKEND	ICB-PLTGC RELOCATION 
	LD	A4,SHADOW,A10	SHTAB1 ADR
	LDR*	A5,A4	SHTAB1 LENGTH 
	LDR	A6,A4	SHTAB1 ADR 
	ADR	A4,A5	SHTAB2 ADR 
	SUK	A5,2	ADJUST FOR TABLE LENGTH WORD
	LDKL	A3,MMTAB	CURRENT MM-TAB 
	ADR	A3,A13 
	CALL	MMENT	FIND LAST USED ENTRY
	ST	A3,LSTENT+STKEND	SAVE LAST USED ENTRY 
* 
*  GENERATE TASK CLASS DATA 
* 
TCLLOP	EQU	*
	LDKL	A8,MMTAB
	SUKL	A8,MMBEG
	ADR	A8,A13 
	ST	A8,TTAB+STKCOM
	LD	A7,LSTENT+STKEND	LAST USED MM-ENTRY FOR COMMON DATA 
	ST	A7,LSTPAG,A8	SAVE FOR MOVING
	ST	A5,TCLCOU+STKEND
	ADK	A4,2	SHTAB2 ENTRY
	LDR	A8,A4	GET SHTAB2 POINTER 
	TL*	MMFROM+STKCOM
	LDR*	A7,A8	ITCT ADR
	CALL	FNDBLK	FIND TCLBLK
	EL	A5,TCLTLD,A3	PGTL-DATA-LENGTH-USED
	ELR	A1,A3	STACK-SIZE 
	ES	A1,ITCNEP,A7	SAVE IN ITCT 
	ES	A5,ITCGLL,A7	SAVE IN ITCT 
	LD	A5,TCLCOU+STKEND	NBR OF ITCT'S LEFT 
	RF(Z)	TCLEXT	NONE
	LD	A1,TGCREL+STKEND
	EL	A3,ITCTGC,A7
	ADR	A3,A1
	LDR	A1,A7
	ES	A3,ITCTGC,A1	RELOCATE ICB-PLTGC-MAIN IN ITCT
	LD	A3,PGTGAD+STKEND	PGTG-DATA ADDRESS
	ES	A3,ITCCOM,A1	UPDATE POINTER IN ITCT 
	LD	A3,DDIVTO+STKEND	APPTAB ADDRESS 
	EL	A3,APPCOM,A3	COMMON PROGRAM SEGM
	ES	A3,ITCCSB,A1	SAVE IN CURRENT SEGMENT BASE 
	EL	A3,ITCTLT,A7	NBR OF ENTRIES IN TLTAB
	SLL	A3,1	NBR OF BYTES   IN TLTAB 
	ADK	A3,2	ADJUST FOR TLTAB LENGTH WORD
	ADK	A3,ITCTLT	ITCT LENGTH
	CALL	CALLMO	ALLOCATE AND MOVE ITCT 
	STR	A2,A4	NEW ITCT ADR IN SHTAB2 
	ST	A2,SAVITC+STKEND	SAVE NEW ITCT ADR
	CALL	MVPGTL	ALLOCATE AND MOVE PGTL-DATA
	ST	A10,SAVE01+STKEND	SAVE APPL SAVE AREA POINTER 
	CALL	MVSTAT	ALLOCATE AND MOVE STATIC-ZERO
	LD	A10,SAVE01+STKEND	GET APPL SAVE AREA POINTER
	LDK	A2,2 
	ST	A2,DYNDIS+STKEND	INIT.DYN.CORE TABLE DISPL. 
	CALL	ALLDYN	ALLOCATE DYNAMIC-CORE
	LDR	A8,A4	GET ITCT ADDRESS POINTER 
	CALL	INIDYN	INITIATE DYNAMIC CORE
	ST	A10,SAVE01+STKEND	SAVE APPL SAVE AREA POINTER 
	CALL	GETTAB	GET TTAB ADDRESS 
	CALL	MOVMMT	MOVE MMTAB TO TTAB 
	LD	A10,SAVE01+STKEND	GET APPL SAVE AREA POINTER
	CM	LSTPAG,A9	CLEAR SEGMENT BLOCK POINTER 
	LD*	A1,SHADOW,A10	SHTAB1 LENGTH
	LDR	A4,A8	GET SHTAB2 POINTER 
	ADR	A1,A4	SHTAB3 ENTRY 
	STR	A2,A1	MM-TAB ADDRESS 
	LD	A1,LSTENT+STKEND	GET LAST USED ENTRY,UPTO COMMON DATA 
	CALL	MMRST	RESET UNUSED MM-ENTRIES 
	LD	A5,TCLCOU+STKEND
	SUK	A5,2	COUNT NBR OF ITCT'S 
	RB(P)	TCLLOP	ITCT'S LEFT 
TCLEXT	EQU	*
	EJECT
SYA200	EQU	*

* INCLUDE MOVED PROT.DDIV IN FREE AREA
	LD	A5,DDIVTO+STKEND	GET START OF MOVED PROT.DDIV 
	LDR	A8,A5	SAVE 
	ANKL	A5,/F000
	SRL	A5,11
	ADKL	A5,MMDDIV	MMU-TABLE ADDRESS 
	ADR	A5,A13	RELOCATE
	LDR*	A5,A5	GET PAGE FROM MMU-TABLE 
	ST	A5,FSTPAG+STKCOM	SET FSTPAG TO THAT PAGE
	ANKL	A8,/FFF	GET DISPL. IN PAGE
	ST	A8,FSTADR+STKCOM	SET FSTADR TO THAT DISPL.
* CONTINUE IN PART 3 *

	LDKL	A5,START3	RELATIVE START ADDRESS
	AD	A5,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A5 
	EJECT


************************************************
***                                          ***
**            SYSLCO  PART 3                  **
**                                            **
************************************************

*   BUILD REAL ITCT'S. COPY ITCT'S ACCORDING TO*
*   SHADOW TABLE                               *
*                                              *
************************************************

PART3	EQU	* 

	EJECT
***************************** 
* START OF PROGRAM PART 3   * 
***************************** 

**              G E T T A B                 **
**                                          **
**                                          **
**  FIND TTAB ADDRESS                       **
**                                          **
**  INPUT :A8=POINTER TO ITCT ADR           **
**  OUTPUT:A2=TTAB-ADDRESS                  **
**         A1=TID                           **
**  WORKREGS:A3,A4,A10                      **
**********************************************

GETTAB	EQU	*
	LDR*	A10,A8	ITCT-ADDRESS 
	EL	A1,ITCTID,A10	GET TID 
GETTTB	EQU	*	ENTRY. INPUT: A1=TID 
	LD	A4,SCTTCT	GET TC:TAB ADDRESS
	LDR*	A3,A4	TCTAB LENGTH
GETT10	ADK	A4,2 
	SUK	A3,2	ALL?
	RF(NN)	GETT20	NO!
	LDR	A3,A1	SAVE A1 (DEBUGGING PURPOS) 
	LDK	A1,LMP5	TID ERROR
	CALL	ERROR 
GETT20	LDR*	A2,A4	TTAB-ADDRESS
	CW	A1,TTBTID,A2	TID EQUAL ?
	RB(NE)	GETT10	NO!
	CM	TTB:PP,A2	RESET PENDING POINTER IN TTAB 
	ST	A2,TTAB+STKCOM	SAVE 
	EL	A3,ITCSPL,A10	GET SPL-PBS.PROGRAM-DATA ADDRESS
	ST	A3,TTB:SA+20,A2	SAVE IN TTAB
	ADKL	A3,SPLSIZ-SPLCPB-2	POINT AT SPL-PBS STACK-BASE
	ST	A3,TTB:SA+28,A2	SAVE IN TTAB
	RTN	A14
	EJECT


**                    Q U E J O B                ** 
**                                               ** 
**                                               ** 
**  QUEUE TASK VIA 'ACTOT' AND SWITCH TO LEVEL   ** 
**  0, ENB.                                      ** 
**                                               ** 
**  INPUT: A10=ITCT-ADDRESS                      ** 
**         A2=TTAB-ADDRESS                       ** 
*************************************************** 

QUEJOB	EQU	*
* QUEUE THIS TASK (THIS TID)

	LDKL	A3,RETUR	GET RETURN (FROM A15) ADDRESS
	AD	A3,M:REL+STKCOM	RELOCATE
	STR	A3,A15	PUT ON STACK
	LDKL	A3,/00C0	SET LEVEL 0 AND ENABLE 
	STR	A3,A15	PSW 
	CF	A15,SAVE8	SAVE 8 REGS 
	LDK	A7,0	CLEAR ABORT INDICATOR 
	LDR	A5,A2	GET TTAB-ADDRESS 
	LD	A2,INTENT+STKEND	INTERPRETER ENTRY
	CF	A15,ACTOT 
GETT40	ABL	RETUR8	RELOAD 8 REGS 
RETUR	EQU	* 
	RTN	A14
	EJECT
*      G E N C O P        * 
*                         * 
*************************** 
GENCOP	EQU	*
	LDR	A3,A1	SAVE A1
	LD	A1,LSTENT+STKEND	LAST USED MM-ENTRY FOR COMMON DATA 
	LDKL	A2,MMTAB
	SUKL	A2,MMBEG
	ADR	A2,A13 
	ST	A2,TTAB+STKCOM
	ST	A1,LSTPAG,A2	SAVE LAST USED ENTRY FOR MOVING
	CALL	MMRST	RESET MMTAB UNUSED ENTRIES
	LDR	A1,A3	RESTORE A1 
	ST	A5,SAVE05+STKEND	SAVE A5
	ST	A6,SAVE06+STKEND	SAVE A6
	CALL	FNDTID	FIND TID 
	LD	A1,TCLITC+STKEND	TCL  ITCT ADDRESS
	LDK	A3,ITCTLT	TLTAB START DISPL
	EL	A2,ITCTLT,A1	NBR OF ENTRIES IN TLTAB
	SLL	A2,1	NBR OF BYTES   IN TLTAB 
	ADK	A2,2	ADJUST FOR TLTAB COUNTER
	ADR	A3,A2	ITCT LENGTH
	CALL	CALLMO	COPY ITCT
	TL*	MMTO+STKCOM
	ST	A2,SAVITC+STKEND	SAVE ITCT ADR
	LD	A3,SAVTID+STKEND	GET NEW TID
	ES	A3,ITCTID,A2	STORE IN ITCT
	LDR	A3,A2	ITCT ADR 
	CALL	MVPGTL	ALLOCATE AND MOVE PGTL-DATA
	LD	A3,SAVITC+STKEND	ITCT ADR 
	CALL	MVSTAT	ALLOCATE AND MOVE STATIC-ZERO
	LD	A3,SAVITC+STKEND	ITCT ADR 
	LD	A10,SAVE01+STKEND	GET APPL.SAVE AREA POINTER
	CALL	ALLDYN	ALLOCATE DYNAMIC CORE
	CALL	INIDYN	INITIATE DYNAMIC CORE
	LD	A1,SAVTID+STKEND	TID
	LDR	A10,A7	ITCT ADDRESS
	CALL	GETTTB	FIND TTAB ADR
	CALL	QUEJOB	QUEUE THIS TASK
	LD	A10,SAVITC+STKEND	ITCT ADR
	LDR	A5,A10	ITCT ADDRESS
	ADK	A5,22
	ST	A5,TTB:SA+26,A2	SAVE ITCT ADR IN TTAB(SAVE-A13) 
	ADKL	A5,ITCCSB-ITCDCD	POINT AT CSB IN ITCT 
	ST	A5,TTB:CB,A2	SAVE IN TTAB 
	LD	A5,SAVE05+STKEND	RESTORE A5 
	LD	A6,SAVE06+STKEND	RESTORE A6 
	CALL	MOVMMT	MOVE MM-TABLE TO TTAB
	CM	LSTPAG,A9	CLEAR SEGMENT BLOCK POINTER 
	LD	A1,SAVTID+STKEND	NEXT TID 
	RTN	A14
	EJECT
*        F N D T I D        * 
*                           * 
* FIND TID FOLLOWING "A1"   * 
* IN SHTAB4                 * 
*                           * 
* INPUT : A1=TID            * 
* EXIT  : A1=NEW TID        * 
* WORK  : A2,A3             * 
***************************** 

FNDTID	EQU	*
	LD	A2,SHADOW,A10	SHTAB1 ADR
	LD*	A3,SHADOW,A10	SHTAB1 LEN 
	ADR	A2,A3	SHTAB2 ADR 
	ADR	A2,A3	SHTAB3 ADR 
	ADR	A2,A3	SHTAB4 ADR 
	LDR*	A3,A2	SHTAB4 LEN
FNDTI0	EQU	*
	SUK	A3,1	FINISHED ?
	RF(NN)	FNDTI1	NO 
	LDK	A1,LMP5	YES,TID ERROR
	CALL	ERROR 
FNDTI1	EQU	*
	ADK	A2,2	ADJUST POINTER
	CWR*	A1,A2	TID FOUND ? 
	RB(NE)	FNDTI0	NO,TRY NEXT
	LD	A1,2,A2	YES,LOAD NEXT TID 
	ST	A1,SAVTID+STKEND	SAVE IT
	RTN	A14
	EJECT

*          I N I D Y N                 *
*                                      *
*  INPUT : A3 = SPL-PBS ADDRESS        *
*                                      *
*  WORK  : A1 - A5                     *
*                                      *
****************************************

INIDYN	EQU	*
	LDR	A1,A3	SPL-PBS ADDRESS
	LDKL	A2,PBSTAB	CONSTANT-TABLE ADDRESS
	AD	A2,M:REL+STKCOM 
INID10	EQU	*
	LDR*	A5,A2	NBR OF COPIES OF THIS WORD
	CWK	A5,/FFFF	END OF CONSTANT-TABLE ? 
	RF(E)	INID30	YES 
	LD	A4,2,A2	WORD TO COPY
	ADK	A2,4	STEP CONSTANT-TABLE POINTER 
INID20	EQU	*
	SUK	A5,1	STEP NBR OF COPIES
	RB(N)	INID10	NEXT WORD 
	ESR	A4,A1	STORE WORD IN SPL-PBS
	ADK	A1,2	STEP SPL-PBS POINTER
	RB	INID20	NEXT COPY
INID30	EQU	*
	LDKL	A5,STKMAX	STACK-SIZE
	ES	A5,SPLSTS,A3	STORE IN SPL-PBS.STACK-SIZE
	LDKL	A1,ENTFIN	ENTRY FINI (ADDRESS)
	ES	A1,SPLENT,A3	STORE IN SPL-PBS.ENTRY FINI
	LDR	A2,A3	SPL-PBS ADDRESS
	ADK	A2,SPLSTA	START OF SPL-STACK AREA
	ADR	A5,A2	+ STACK-AREA ADDRESS 
	ES	A5,SPLSTB,A3	STORE IN SPL-PBS.STACK-BASE
	RTN	A14
	EJECT

*********************************************** 
**                                           ** 
**  EACH WORD IN THIS TABLE CONSISTS OF :    ** 
** WORD1=COUNTER, NBR OF COPIES OF NEXT WORD ** 
** WORD1=WORD                                ** 
**                                           ** 
**  BYTE1 (COUNTER) = /FF MEANS END OF TABLE ** 
**                                           ** 
*********************************************** 

PBSTAB	EQU	*
	DATA	1	TERMINATION-CODE
	DATA	0 
	DATA	1	STACK-USED
	DATA	/6
	DATA	1	STACK-SIZE
	DATA	0 
	DATA	3	PROCEDURE-NAME
	DATA	/2020 
	DATA	20	PGM-DATA UNTIL STACK-BASE
	DATA	0 
	DATA	1	STACK-BASE
	DATA	0 
	DATA	1	ENTRY-FINI
	DATA	0 
	DATA	16	LAST-TS,RUNTIME-WORK-AREA
	DATA	0 
	DATA	/FFFF	E N D   O F   T A B L E 

	EJECT
*        A L L D Y N           *
*                              *
* ALLOCATE DYNAMIC-CORE        *
*                              *
* INPUT : A3 ITCT ADDRESS      *
*        A10 APPL.SAVE AREA   * 
*            POINTER          * 
* EXIT  : ITCT IS UPDATED      *
*         WITH DYNAMIC-CORE    *
*         POINTERS             *
* WORK  : A1-A3,A7             *
********************************

ALLDYN	EQU	*
	TL*	MMTO+STKCOM
	LDR	A7,A3	ITCT ADR 
	EL	A3,ITCNEP,A3	STACK-SIZE REQUIRED
	CALL	CALLMO	ALLOCATE FROM BOTTOM 
	TL*	MMTO+STKCOM
	EL	A3,ITCNEP,A7	STACK-SIZE MOVED 
	ES	A2,ITCDCB,A7	SAVE BASE PNTR 
	ES	A2,ITCDCC,A7	SAVE CURRENT EXTENT
	ADR	A3,A2	+ BASE-PNTR
	SUKL	A3,SPLSIZ	- SPL-STACK-SIZE
	ES	A3,ITCDCD,A7	SAVE DDI-POOL-BASE 
	ADK	A3,SPLCPB	POINT AT SPL-PBS-PNTR
	ES	A3,ITCSPL,A7	SAVE SPL-PBS-PNTR
	LD	A1,DYNTAD,A10	TABLE ADR 
	LD	A2,DYNDIS+STKEND	GET DYN.CORE TABLE DISPL 
	ADR	A1,A2	NEXT TABLE ENTRY TO USE
	ADK	A2,2	COUNT DISPL 
	ST*	A2,DYNTAD,A10	COUNT LENGTH WORD IN TABLE 
	ST	A2,DYNDIS+STKEND	STEP DISPL 
	SUK	A3,SPLCPB	POINT AT SPL-PBS START 
	STR	A3,A1	STORE SPL-PBS ADR IN TABLE 
	RTN	A14
	EJECT
*          M V S T A T         *
*                              *
* ALLOCATE AND MOVE STATIC-    *
* CORE                         *
*                              *
* INPUT : A3 ITCT ADDRESS      *
* EXIT  : A6 -1                *
*         A3 ITCT ADDRESS      *
* WORK  : A1-A2,A7-A8,A10      *
********************************

MVSTAT	EQU	*
	STR	A4,A14	SAVE SHTAB2 POINTER ON STACK
	SUKL	A14,2	ADJUST STACK-POINTER
	LDR	A7,A3	ITCT ADR 
	ADK	A3,ITCTGC	POINT AT ICB-PLTGC-MAIN ADDRESS
	ST	A3,SAVE07+STKEND	SAVE POINTER 
	ADK	A7,ITCTLT	TLTAB ADR
	LDR	A12,A7	SAVE TLTAB-BASE 
	ELR	A6,A7	NBR OF ENTRIES IN TLTAB
MVSTA1	EQU	*
	SUK	A6,1	COUNT 
	RF(NN)	MVSTA2	STATIC-ZERO AREAS LEFT 
	LD	A3,SAVE07+STKEND	LOAD ICB-PLTGC-MAIN ADR POINTER
	SUK	A3,ITCTGC	MAKE IT ITCT POINTER 
	ADKL	A14,2	ADJUST STACK-POINTER
	LDR*	A4,A14	GET SHTAB2 POINTER FROM STACK
	RTN	A14
MVSTA2	EQU	*
	ADK	A7,2	POINT AT STATIC-ZERO ADR
	ELR	A8,A7	STATIC-ZERO ADR
	RB(Z)	MVSTA1	EMPTY ENTRY 
	EL*	A3,SAVE07+STKEND	LOAD ICB-PLTGC-MAIN ADDRESS 
	SUR	A10,A10	LEVEL
	LDK	A1,0	RESET INDICATOR 
	LD	A2,FREQUE	GET MONITOR BLOCK ADR.	=2 
	CALL	FNDTGC	FIND STATIC-ZERO ADR+LENGTH
	LD	A10,SAVE01+STKEND	GET APPL.SAVE AREA POINTER
	CALL	CALLMO	ALLOCATE AND MOVE STATIC-ZERO
	TL*	MMTO+STKCOM
	ESR	A2,A7	UPDATE TLTAB ENTRY 
	RB	MVSTA1
	EJECT
*         F N D T G C            *
*                                *
* FIND STATIC-ZERO ADR+LENGTH    *
* FOR ONE PROGRAM                *
*                                *
* INPUT : A3  ICB-PLTGC ADR      *
*         A8  STATIC-ZERO ADR    *
*             WANTED             *
*         A10 0 (ZERO)           *
*         A12 TLTAB BASE         *
*         A2  MONITIR BLOCK ADR  *		=2
* EXIT  : A1  STATIC-ZERO ADR    *
*         A2  MONITOR BLOCK ADR  *		=2
*         A3  STATIC-ZERO LENGTH *
* WORK  : A2,A4,A5,A9,A11        *
* WORKAREA: USES MONITOR BLOCKS  *		=2
*           AS STACK             *		=2
**********************************

FNDTGC	EQU	*
	ELR	A1,A3		=2
	SRL	A1,8		=2 
	SUK	A1,/60	COBOL PROGRAM?	=2 
	RF(Z)	FNDT00	YES!	=2 
	LDK	A1,0	INDICATE NOT FOUND	=2 
	RF	FNDTG0	RETURN	=2
FNDT00	EQU	*		=2
	EL	A1,TGCSZD,A3	GET DISPL IN TLTAB 
	ADR	A1,A12	POINT AT TLTAB-ENTRY
	ADK	A1,2	ADJUST FOR TLTAB LENGTH-WORD
	ELR	A1,A1	STATIC-ZERO-ADR
	CWR	A1,A8	WANTED ? 
	RF(NE)	FNDTG1	NO 
	ADK	A3,TGCSZL	YES,POINT AT LENGTH WORD 
	ELR	A3,A3	STATIC-ZERO-LENGTH 
FNDTG0	EQU	*
	RTN	A14
FNDTG1	EQU	*
	LDK	A1,0	INDICATE NOT FOUND
	EL	A5,8,A3	NBR OF ENTRIES IN PLTGC CALL TAB
	SLL	A5,1	*2 = TABLE LENGTH 
	ADR	A5,A3	BASE 
	ADK	A5,10	DISPL TO TABLE START 
	LDR	A4,A3	ICB-PLTGC ADR
	ADK	A4,TGCCAL+TGCCTE	ADR TO FIRST ENTRY IN CALL TAB
FNDTG2	EQU	*
	LDR	A9,A4	TABLE START ADR
	LDR	A11,A5	TABLE END ADR 
	CALL	CMPADR	END OF CALL-TABLE ?
	RB(NG)	FNDTG0	YES!	=2
FNDTG3	EQU	*
	ST	A4,2,A2	SAVE ON STACK	=2
	ST	A5,4,A2	SAVE ON STACK	=2
	LDR*	A2,A2	ADJUST STACK POINTER	=2 
	RF(NZ)	FNDTG4	MORE BLOCKS AVILABLE	=2
	LDKL	A1,NOBLK	NO BLOCKS AVILABLE	=2
	CALL	ERROR		=2 
FNDTG4	EQU	*		=2
	ELR	A3,A4	NEXT LINK
	ADKL	A10,1	ADJUST LEVEL
	CALL	FNDTGC	NEXT LEVEL 
	SUK	A2,6	ADJUST STACK POINTER	=2 
	LDR	A1,A1	STATIC-ZERO FOUND
	RB(NZ)	FNDTG0	YES
	SUKL	A10,1	ADJUST LEVEL
	LD	A4,2,A2	TABLE POINTER FROM STACK	=2 
	LD	A5,4,A2	TABLE END POINTER FROM STACK	=2 
	ADK	A4,TGCCTE	POINT TO NEXT TABLE-ENTRY
	RB	FNDTG2
	EJECT
*         M V P G T L             * 
*                                 * 
* ALLOCATE AND MOVE PGTL-DATA     * 
*                                 * 
* INPUT : A2 ITCT ADR             * 
* EXIT  : A1 OLD PGTL-DATA ADR    * 
*         A2 NEW PGTL-DATA ADR    * 
*         A3 ITCT ADR             * 
*********************************** 

MVPGTL	EQU	*
	TL*	MMTO+STKCOM
	EL	A1,ITCGLA,A2	PGTL-DATA ADR
	EL	A3,ITCGLL,A2	PGTL-DATA LENGTH 
	CALL	CALLMO	ALLOCATE AND MOVE PGTL-DATA
	TL*	MMTO+STKCOM
	LD	A3,SAVITC+STKEND	ITCT ADR 
	ES	A2,ITCGLA,A3	NEW PGTL-DATA ADR
	RTN	A14
	EJECT
************************************************
*                                              *
*                 C A L L M O                  *
*                                              *
* CALLMO CHECKS WHERE TO BUILD DATA BEFORE     *
* CALLING MOVING                               *
*                                              *
* INPUT: A3=LENGTH TO MOVE                     *
*        A10=APPL.SAVE AREA POINTER            *
*        PDDIV=FLAG THAT INDICATES IF DDIV IS  *
*              GOING TO BEE BUILT IN PROT.DDIV *
*        PDDIVL=LENGTH LEFT IN PROT.DDIV       *
*        SCTEFA=END OF FREE AREA               *
*                                              *
* OUTPUT: A3=-1                                *
*         PDDIV=1 IF DDIV IS BUILT IN PROT.    *
*               DDIV ELSE PDDIV=0              *
*         PDDIVL=NEW PDDIVL                    *
*         LSTADR=NEW LAST FREE ADDR.           *
*         FYSPAG=NEW LAST FREE PAGE            *
*                                              *
* WORK REG:A2                                  *
*                                              *
************************************************
CALLMO	EQU	*
	LD	A2,PDDIV+STKEND	BUILD DDIV IN PROT.DDIV?
	RF(Z)	CAL200	NO! 
	LD	A2,PDDIVL,A10	GET LENGTH LEFT IN PROT.DDIV
	SUR	A2,A3	ENOUGH SPACE LEFT IN PROT.DDIV 
	RF(NN)	CAL100	YES! 
* 
*	RESET FLAG AND CHANGE FYSPAG AND LSTADR 
*	TO POINT AT END OF FREE AREA
* 
	CM	PDDIV+STKEND	RESET FLAG 
	LD	A2,SAEFA1+STKEND	GET END OF FREE AREA PAGE
	ST	A2,FYSPAG+STKCOM	SET FYSPAG TO THAT PAGE
	LD	A2,SAEFA2+STKEND	END OF FREE AREA (LOGICAL ADDR.) 
	ST	A2,LSTADR+STKCOM	STORE NEW LSTADR 
CAL100	EQU	*
	ST	A2,PDDIVL,A10	LENGTH LEFT IN PROT.DDIV
CAL200	EQU	*
	CALL	MOVING
	RTN	A14
	EJECT


START3	EQU	*


REALTA	EQU	*
	LD*	A8,SHADOW,A10	SHTAB LENGTH 
	LD	A5,SHADOW,A10	SHTAB1 ADR
	ADR	A8,A5	SHTAB2 ADR 
	ST	A8,SAVE03+STKEND	SAVE SHTAB2 ADR
	AD*	A8,SHADOW,A10	SHTAB3 ADR 
	ST	A8,SAVE02+STKEND	SHTAB3 ADR 
SYA300	EQU	*
	LD	A8,SAVE03+STKEND	SHTAB2 POINTER 
	ADKL	A8,2	NEXT 
	CW	A8,SAVE02+STKEND	ALL TCL'S DONE ? 
	RF(E)	SYA310	YES 
	ST	A8,SAVE03+STKEND	SAVE SHTAB2 POINTER
	ADK	A5,2	SHTAB1 POINTER
	LDR*	A4,A5	NBR OF COPIES 
	RB(Z)	SYA300	NONE
	LDR	A4,A8	GET SHTAB2 POINTER 
	AD*	A4,SHADOW,A10	MAKE IT SHTAB3 POINTER 
	LDR*	A4,A4 
	TLR	A4	LOAD MM-TABLE INDICATED IN SHTAB3 
	ST	A4,MMFROM+STKCOM	SAVE MM-TABLE ADDRESS
	ST	A10,SAVE01+STKEND	SAVE APPL.SAVE AREA POINTER 
	CALL	GETTAB	FIND TTAB ADR
	ST	A10,SAVITC+STKEND	SAVE ITCT ADR 
	ST	A10,TCLITC+STKEND	SAVE TCL  ITCT ADDRESS
	CALL	QUEJOB	QUEUE TASK 
	LDR	A6,A10	ITCT ADR
	ADK	A6,22	MAKE IT INT-USABLE 
	ST	A6,TTB:SA+26,A2	SAVE ITCT ADR IN TTAB(SAVE-A13) 
	ADKL	A6,ITCCSB-ITCDCD	POINT AT CSB IN ITCT 
	ST	A6,TTB:CB,A2	SAVE IN TTAB 
	LD	A1,TTAB+STKCOM	TTAB ADDRESS 
	LD	A1,TTBTID,A1	GET TASK-ID
	LDR*	A6,A5	NBR OF COPIES 
SYA305	EQU	*
	LD	A10,SAVE01+STKEND	GET APPL.SAVE AREA POINTER
	SUK	A6,1	COUNT NBR OF COPIES 
	RB(NP)	SYA300	NEXT TCL 
	CALL	GENCOP	GENERATE ONE COPY
	RB	SYA305	NEXT 
	EJECT

* ADJUST END OF FREE AREA 

SYA310	EQU	*
	LD	A1,PDDIV+STKEND	UPDATE END OF FREE AREA?
	RF(NZ)	SYA315	NO!
	LD	A1,LSTADR+STKCOM	GET END OF FREE AREA 
	ANKL	A1,/FFF 
	LD	A2,FYSPAG+STKCOM
	SLL	A2,2 
	ORR	A1,A2
	ST	A1,SCTEFA+2 
	LD	A1,FYSPAG+STKCOM
	SRL	A1,14
	ST	A1,SCTEFA 
	LD	A1,LSTADR+STKCOM	GET END OF FREE AREA 
	ANKL	A1,/FFF 
	ST	A1,SAEFA2+STKEND	UPDATE SAEFA2
	LD	A1,FYSPAG+STKCOM	GET PAGE 
	ST	A1,SAEFA1+STKEND	UPDATE SAEFA1
SYA315	EQU	*
* 
*        JUMP TO LABEL NXTAPP IN PART2 TO SEE IF
*        THERE ARE MORE APPLICATIONS LEFT 
* 
	LD	A10,SAVE01+STKEND	GET APPL.SAVE AREA POINTER
	LDKL	A1,NXTAPP	GET JUMP ADDRESS
	AD	A1,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A1	CHECK IF MORE APPLICATIONS


	XIF
	IFT	MMUPAG=0 
	EJECT
			 
			 
********************************************* 
*******                               ******* 
**                                         ** 
*            SYSLOAD PART 1                 * 
**                                         ** 
*****                                   ***** 
********************************************* 
			 
*   READ CONFIGURATION FILE & BUILD         * 
*   SHADOW-TABLES                           * 
*                                           * 
********************************************* 
			 
LCOSTA	EQU	*
	LDKL	A1,START1	GET START OF SYSLCO 
	AD	A1,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A1	GO TO START OF SYSLCO 
			 
			 
************************************* 
***                               *** 
**     S U B R O U T I N E S       ** 
**  -USED IN THIS PART ONLY        ** 
************************************* 
	EJECT
*                 B U I L D T                *
*                                            *
* BUILD ONE PART OF TIDTAB FOR CURRENT       *
* TASK DEFINITION BLOCK IN CONF.FILE         *
*                                            *
* INPUT : A1=ITCT ADDRESS                    *
*         A3=TID                             *
*         A4=NUMBER OF COPIES                *
*         A6=POINTER IN SHTAB1               *
*         A8=LENGTH OF SHTAB1                *
*         SHADST=START OFSHADOW TABLES FOR   *
*                CURRENT APPLICATION          * 
*                                            *
* OUTPUT: A7=FIRST FREE ENTRY AFTER TIDTAB   *
*         SHADST=START OFSHADOW TABLES FOR   *
*                CURRENT APPLICATION          * 
*                                            *
* WORK REGISTERS : A1-A8                     *
*                                            *
* SUBRUTINS : ERROR                          *
*                                            *
**********************************************
BUILDT	EQU	*
	LDR*	A2,A6	HAVE TASKS ALREADY BEEN CONF FOR THIS 
			TCL
	RF(NZ)	BUI100	YES! 
	ST	A3,ITCTID,A1	SAVE TID IN ITCT 
* COUNT NUMBER OF TASKS IN TIDTAB WHICH ARE GOING TO
* LIE BEFORE CURRENT TASKS
BUI100	EQU	*
	SUR	A2,A2	CLEAR TASK COUNTER 
	LDR	A5,A6	GET POINTER TO CURRENT ENTRY IN SHATB1 
BUI200	EQU	*
	ADR*	A2,A5	ADD NUMBER OF TASKS 
	SUK	A5,2	DECREASE SHTAB1 POINTER 
	CW	A5,SHADST+STKEND	ALL TASKS COUNTED? 
	RB(NE)	BUI200	NO!
* LOAD REGISTER A5 WITH POINTER TO START-ENTRY OF 
* CURRENT TASKS IN TIDTAB AND ADD NUMBER OF CURRENT 
* TASKS IN FIRST ENTRY OF TIDTAB
	ADR	A5,A8	ADD SHTAB1 LENGTH
	ADR	A5,A8	ADD SHTAB2 LENGTH
	ADR	A5,A8	ADD SHTAB3 LENGTH
	ADRS	A4,A5	UPDATE NUMBER OF TASKS IN TIDTAB
	ADK	A5,2	NEXT TIDTAB ENTRY 
	SLL	A2,1	2*(NUMBER OF TASKS) 
	ADR	A5,A2	ADD DISPLACEMENT IN TIDTAB 
* COUNT NUMBER OF TASKS IN TIDTAB WHICH ARE GOING 
* TO LIE AFTER CURRENT TASKS
	LDR	A1,A6	GET POINTER TO SHTAB1 ENTRY OF CURRENT 
			TCL
	ADK	A1,2	ENTRY IN SHTAB1 AFTER CURRENT TCL 
	SUR	A2,A2	CLEAR TASK COUNTER 
	LDR	A7,A8	GET SHTAB1 LENGTH
	SUR	A7,A1
	AD	A7,SHADST+STKEND	LENGTH OF SHTAB1 IN BYTES AFTER CURRENT
			TCL
	RF(Z)	BUI350	JUMP IF NO TASKS TO COUNT 
BUI300	EQU	*
	ADR*	A2,A1	ADD NUMBER OF TASKS 
	ADK	A1,2	INCREASE SHTAB1 POINTER 
	SUK	A7,2	ALL TASKS COUNTED?
	RB(Z)	BUI300	NO! 
* MAKE SPACE IN TIDTAB FOR CURRENT TASKS
BUI350	EQU	*
	LDR	A7,A5	LOAD START-ENTRY OF CURRENT TASKS IN 
			TIDTAB 
	ADR	A7,A2	ADD 2*(NUMBER OF TASKS AFTER 
	ADR	A7,A2	CURRENT TASKS) 
	SUK	A7,2	POINTER TO LAST TASK ID IN TIDTAB 
	SLL	A4,1	2*(NUMBER OF CURRENT TASKS) 
	CWR	A7,A5	ARE CURRENT TASKS LAST IN TIDTAB 
	RF(L)	BUI500	YES!
BUI400	EQU	*
	LDR*	A1,A7	GET TASK ID IN TIDTAB 
	ADR	A7,A4	NEW ENTRY IN TIDTAB FOR TASK ID
	STR	A1,A7	STORE TASK ID IN NEW ENTRY 
	SUR	A7,A4	GET OLD ENTRY IN TIDTAB
	SUK	A7,2	NEXT ENTRY IN TIDTAB
	CWR	A7,A5	ALL TASK ID MOVED? 
	RB(NL)	BUI400	NO!
* LOAD REGISTER A7 WITH FIRST FREE ENTRY AFTER TIDTAB 
* AND ADD NUMBER OF CURRENT TASKS IN CURRENT ENTRY OF SHTAB1
BUI500	EQU	*
	LDR	A7,A5	LOAD START ENTRY OF CURRENT TASKS IN 
			TIDTAB 
	ADR	A7,A2	ADD NUMBER OF
	ADR	A7,A2	BYTES IN TIDTAB AFTER CURRENT TASKS
	ADR	A7,A4	FIRST FREE ENTRY AFTER TIDTAB
	SRL	A4,1	(2*(NUMBER OF TASKS))/2 
	ADRS	A4,A6	ADD NUMBER OF CURRENT TASKS,FOR	
			CURRENT TCL IN SHTAB1
* PUT CURRENT TASK ID:S IN TIDTAB 
	LD	A1,SHADST+STKEND	GET SHTAB1 START ADDRESS 
	ADR	A1,A8	ADD SHTAB1 LENGTH
	ADR	A1,A8	ADD SHTAB2 LENGTH
	ADR	A1,A8	TIDTAB START ADDRESS 
	ADK	A1,2	FIRST TID IN TIDTAB 
BUI600	EQU	*
	LDR	A6,A1	GET TIDTAB START ADDRESS 
BUI700	EQU	*
	CWR	A6,A5	ALL TID:S IN UPPER PART IN TIDTAB
			SHECKED? 
	RF(NE)	BUI800	NO!
	ADR	A6,A4	FIRST TIDTAB ENTRY OF
	ADR	A6,A4	LOWER PART 
BUI800	EQU	*
	CWR	A6,A7	ALL TID:S OF LOWER PART IN TIDTAB
			SHECKED? 
	RF(E)	BUI950	YES!
	CWR*	A3,A6	TID ALREADY CONFIGURATED? 
	RF(NE)	BUI900	NO!
	LDKL	A1,LMP4	YES! FORMAT ERROR 
	CALL	ERROR 
BUI900	EQU	*
	ADK	A6,2	NEXT ENTRY IN TIDTAB
	RB	BUI700
BUI950	EQU	*
	STR	A3,A5	PUT TID IN TIDTAB
	ADK	A5,2	ADJUST UPPER PART END ADDRESS 
	ADK	A3,1	GENERATE NEXT TID 
	SUK	A4,1	HAVE ALL CURRENT TID:S BEEN CONF. 
	RB(NZ)	BUI600	NO!
	RTN	A14
	EJECT
*      L  I  M  T  G  C                 * 
*                                       * 
* FIND START-ADR, END-ADR, LENGTH OF    * 
* ICB-PLTGC BLOCK                       * 
*                                       * 
* INPUT:A10=POINTER TO CURRENT APPL.    * 
*           SAVE AREA IN SCRATCH-PAD    * 
*       SHADOW=START OF SHADOW TABLES   * 
*              FOR CURRENT APPLICATION  * 
* OUTPUT:PLTGCS= START ADR OF ICB-PLTGC * 
*        PLTGCE= END   ADR OF ICB-PLTGC * 
*        PLTGCL= LENGTH    OF ICB-PLTGC * 
* WORKREGS: A1-A7,A9,A11                * 
* WORKAREA:USES MONITOR BLOCKS AS STACK * 
*                                       * 
***************************************** 

LIMTGC	EQU	*
	LD	A1,SHADOW,A10	SHTAB1 ADDRESS
	LD	A7,FREQUE	GET MONITOR BLOCK ADDR. 
	LDR*	A2,A1	SHTAB1 LENGTH 
	ADR	A1,A2	SHTAB2 ADDRESS 
LIMTG0	EQU	*
	SUK	A2,2 
	RF(Z)	LIMTG5	ALL DONE
	ADK	A1,2	STEP SHTAB2 
	LDR*	A3,A1	ADR TO TCLBLK 
	LD	A3,ITCTGC,A3	ADR TO ICB-PLTGC OF MAIN PROGRAM 
LIMTG1	EQU	*
	LDK	A5,0	SET LEVEL TO 0(ZERO)
	CALL	LIMTG2	UPDATE LIMITS FOR ICB-PLTGC'S RELATED
			TO THIS CLASS
	RB	LIMTG0	NEXT TCL 
	EJECT
* 
* UPDATE LIMITS FOR ICB-PLTGC'S 
* RELATED TO ONE TERMINAL-CLASS 
* 
LIMTG2	EQU	*
	CALL	LIMUPD	UPDATE LIMITS
	LDR*	A4,A3	GET FIRST WORD IN ICB-PLTGC 
	ADKL	A4,/100	INDICATE LIMIT-CONTROL-INIT 
	STR	A4,A3	SET INDICATION 
	LD	A4,TGCCAL,A3	GET NBR OF CALL-TABLE ENTRIES
LIMTG3	EQU	*
	RF(Z)	LIMTG4	NO ENTRIES (LEFT) 
	ST	A4,2,A7	SAVE NBR.OF ENTRIES ON STACK
	ST	A3,4,A7	SAVE ENTRY ADDRES ON STACK
	LDR*	A7,A7	ADJUST STACK-POINTER	=2 
	RF(NZ)	LIMT35	MORE BLOCKS AVILABLE	=2
	LDKL	A1,NOBLK	NO BLOCKS AVILABLE	=2
	CALL	ERROR		=2 
LIMT35	EQU	*		=2
	ADK	A5,1	ADJUST LEVEL
	SLL	A4,1	*2 TABLE LENGTH 
	ADR	A4,A3	ADD BASE 
	ADK	A4,TGCCAL	ADD CALL-TABLE DISPLACEMENT
	LDR*	A3,A4	GET ICB-PLTGC ADDRESS CALLED
	LDR*	A4,A3	GET THAT FIRST WORD CONTENT 
	SRL	A4,8	ONLY FIRST BYTE VALID 
	SUK	A4,/60	FIRST TIME ?
	RB(Z)	LIMTG2	YES 
	LD	A4,-4,A7	GET NBR OF ENTRIES LEFT
LIMTG4	EQU	*
	SUK	A4,1	COUNT NBR OF ENTRIES LEFT 
	RB(P)	LIMTG3	ENTRIES LEFT
	SUK	A5,1	ADJUST LEVEL
	RF(N)	LIMTGX	END OF THIS TERMINAL CLASS
	SUK	A7,6	ADJUST STACK-POINTER
	LD	A4,2,A7	NBR.OF ENTRIES LEFT 
	LD	A3,4,A7	ENTRY ADDRESS 
	RB	LIMTG4	CONTINUE 
LIMTG5	EQU	*
	LD	A3,PLTGCE,A10	PNTR TO LAST ICB-PLTGC
	LD	A4,8,A3	NBR OF CALL-TAB ENTRIES 
	SLL	A4,1	NBR OF BYTES
	ADR	A4,A3	ADD BASE 
	ADK	A4,10	ADD TABLE DISPL
	ST	A4,PLTGCE,A10	SAVE END ADR
	SU	A4,PLTGCS,A10	-(MINUS) START ADR
	ST	A4,PLTGCL,A10	SAVE LENGTH 
LIMTGX	EQU	*
	RTN	A14
	EJECT
* 
* UPDATE ICB-PLTGC LIMITS 
* 
* INPUT: A3=ICB-PLTGC ADR 
* 
LIMUPD	EQU	*
	LDR	A11,A3	ICB-PLTGC ADR 
	LD	A9,PLTGCS,A10	GET CURRENT START ADR 
	CALL	CMPADR	CHECK ADDRESSES
	RF(NL)	LIMUP1	OLD START ADR VALID
	ST	A3,PLTGCS,A10	SET NEW START ADR 
LIMUP1	EQU	*
	LD	A9,PLTGCE,A10	GET CURRENT END ADR 
	CALL	CMPADR	CHECK ADDRESSES
	RF(L)	LIMUP2	OLD END ADR VALID 
	ST	A3,PLTGCE,A10	SET NEW END ADR 
LIMUP2	EQU	*
	RTN	A14
	EJECT
*                 L E N C O U                *
*                                            *
* COUNT LENGTH OF SHTAB1,AND COUNT NUMBER OF *
* TASKS                                      *
*                                            *
* INPUT : A11=CONFIGURATION START            *
*         A10=POINTER TO CURRENT APLTAB BLK. *
*                                            *
* OUTPUT: A6=TOTAL NUMBER OF TASKS           *
*         A7=SHTAB1 LENGTH IN BYTES          *
*         A10=POINTER TO CURRENT APLTAB BLK. *
*                                            *
* WORK REGISTERS: A1,A3-A5                   *
*                                            *
* WORK TABLE: TEMPORARY TABLE WITH TCL       *
*             NAMES AFTER START OF FREE      *
*             AREA                           *
*                                            *
* SUBRUTINES: NXTBLK                         *
*                                            *
**********************************************
LENCOU	EQU	*
	LDK	A7,2	TABLE LENGTH-WORD LENGTH
	LDK	A6,0	TOTAL NBR OF TASKS
	CM*	SHADST+STKEND	CLEAR FIRST ENTRY OF TEMPORARY 
			TABLE
* SHECK IF CURRENT TCL NAME ALREADY HAS APEARED IN
* CONFIGURATION FILE , AND IF SO DON'T INCREMENT
* SHTAB1 LENGTH AND PUT CURRENT TCL NAME IN TEMPO-
* RARY TABLE
LEN100	EQU	*
	LC	A3,TDBMC+4,A11
	SLL	A3,8 
	LC	A3,TDBMC+5,A11	TCL NAME OF CURRENT TASK 
			TASK DEF. BLOCK
	LD	A1,SHADST+STKEND	ADDRESS TO FIRST ENTRY IN
			TEMPORARY TABLE
	LDR*	A4,A1	FIRST ENTRY=0?
	RF(Z)	LEN300	YES!
LEN200	EQU	*
	CWR	A4,A3	TCL NAME IN TEMPORARY TABLE
	RF(E)	LEN400	YES!
	ADK	A1,2	NEXT ENTRY IN TEMPORARY TABLE 
	LDR*	A4,A1	ENTRY=0?
	RB(NZ)	LEN200	NO!
LEN300	EQU	*
	ADK	A7,2	COUNT NUMBER OF BYTES IN SHTAB1 
	STR	A3,A1	PUT CURRENT TCL NAME IN
			TEMPORARY TABLE
	ADK	A1,2	NEXT ENTRY IN TEMPORARY TABLE 
	CMR	A1	CLEAR IT
* COUNT TOTAL NUMBER OF TASKS AND GET START OF NEXT 
* TASK DEF. BLOCK 
LEN400	EQU	*
	LC	A4,TDBNT+1,A11	NBR OF COPIES /2 
	SRC	A4,4 
	LC	A4,TDBNT,A11	NBR OF COPIES /1 
	SLC	A4,12
	SRL	A4,8	BINARY VALUE (NBR OF COPIES)
	LDR	A4,A4	NBR OF COPIES
	RF(Z)	LEN500	NO COPY , TRY NEXT BLOCK
	ADR	A6,A4	COUNT TOTAL NBR OF TASKS 
LEN500	EQU	*
	CALL	NXTBLK	NEXT CONFIG.-BLOCK 
	CCK	A2,'TT'	TASK DEF. BLOCK? 
	RB(E)	LEN100	NEXT TASK DEF. BLOCK
	RTN	A14
	EJECT

*            S Y S L C O                 *
*                                        *
* ENTRY FOR COBOL APPLICATION CONFIG     *
*                                        *
******************************************

				
			 
START1	EQU	*
SYSLCO	EQU	*
* 
*  INIT A15 STACK 
* 
	LD	A15,SCTSTB
	SUKL	A15,4 

	XIF
	IFT TEST-MMUPAG=1		=3
******************************
* 
* TEST VERSION (DEBUG)
* 

	LD	A2,SCTBUG	DEBUGGER ADDRESS
	LD	A13,M:REL+STKCOM
	ADKL	A13,TEST1	SET RETURN ADDRESS
	ABR(NZ)	A2	JUMP IF DEBUG IN SYSTEM 

TEST1	EQU	* 
	LDR	A8,P	GET PROGRAM-POINTER 
	LDKL	A5,REL+2	GET START OF RELOCATION
			ROUTINE
	AD	A5,M:REL+STKCOM	ADD RELOCATION BASE 
	CFR	A8,A5

* 
* 
******************************

	XIF
	IFT MMUPAG=0 

* 
*        CLEAR SCRATCH-PAD AREA 
* 
	LDKL	A1,STKEND	A1=START OF SCRATCH-PAD AREA
	LDKL	A2,STKMOV 
	SUK	A2,2	A2=END OF SCRATCH-PAD AREA
SYA10	EQU	* 
	CMR	A1	CLEAR MEMORY WORD 
	CWR	A1,A2	ALL WORDS CLEARED? 
	RF(E)	SYA20	YES! 
	ADK	A1,2	NO! NEXT WORD 
	RB	SYA10 
* 
*        INITIATE REGISTERS AND VARIABLES 
* 
SYA20	EQU	* 
	CM	APPLNO+STKCOM	CLEAR APPL.NUMBER COUNTER 
	LDKL	A10,STKEND	START OF 1:ST APPL. SAVE AREA
			IN SCRATCH-PAD 
	LD	A1,SCTSFA	START ADR.TO SHTAB'S OF 1:ST APPL.
	ST	A1,SHADST+STKEND	SAVE START OF 1:ST SHADOW-TABLE
	CM	PDDIV+STKEND	CLEAR FLAG 
* 
*        GET APPLICATION
* 
SYA100	EQU	*
	LDKL	A1,'CO'	LOAD INPUT TO GETAPP,CO=COBOL APPL. 
	CALL	GETAPP	FIND APPL AND ITS CONF DATA
	RF(NZ)	SYA105	MORE APPL OF THIS TYPE 
	LD	A2,APPLNO+STKCOM	ANY COBOL APPL. TO CONFIG.?
	RF(NZ)	SYA102	YES! 
	LDKL	A1,LCOEND	SYSLCO START ADDR.
	AD	A1,M:REL+STKCOM	RELOCATE
	ABR	A1	LEAVE SYSLCO
SYA102	EQU	*
	LDKL	A2,SYA178	NO MORE APPL OF THIS TYPE 
	AD	A2,M:REL+STKCOM 
	ABR	A2 
SYA105	EQU	*
	ST	A11,ACOSTA+STKEND	SAVE CONF.START FOR THIS APPL 
	ST	A1,APCTAB,A10	SAVE APLTAB BLOCK ADDRESS 
	LD	A2,APLLAC,A1	GET SEGTAB ADDRESS 
	ST	A2,SEGTAD,A10	SAVE
	EJECT
			 
* READ CONFIG FILE AND BUILD SHADOWTABLE
			 
	LD*	A3,APLLAC,A1	APPTAB ADR
	LD	A2,I:RSTE,A3	GET INTERPRETER RESTART ADDRESS
	ST	A2,APLIOE,A1	STORE IT IN APLTAB 
	LDR*	A2,A3	TCLTAB ADR
	LDR*	A12,A2	NBR OF TCL'S 
	LDR	A4,A2
	ADKL	A4,4	ADR TO TCLBLK PNTR 
	ST	A4,TCLPNT+STKEND	SAVE 
	LC	A2,TDBBT,A11	BLOCK TYPE 
	CCK	A2,'TT'	TASK DEFINITION BLOCK
	RF(NE)	SYA120	NO 
	CALL	LENCOU
	LDR	A5,A7	SHTAB1 LENGTH * 1
	ADR	A5,A7	* 2
	ADR	A5,A7	* 3  SHTAB1-3 TOTAL LENGTH 
	ST	A5,SHTLEN+STKCOM	SHTAB1-3 LENGTH
	LDR	A6,A6
	RF(Z)	SYA120	NOTHING TO CONFIGURATE
	ST	A6,NOCOPS+STKEND	SAVE NBR OF RUNNING TASKS/RUNTIME
* 
	LD	A11,SHADST+STKEND	START OF SHTAB1 
	ADR	A11,A5 
	ADR	A11,A6 
	ADR	A11,A6 
	ADKL	A11,2	NEW START OF FREE AREA
	LDKL	A9,LCOSTA 
	AD	A9,M:REL+STKCOM	SYSLCO START
* CHECK ADDRESSES 
	CALL	CMPADR
	RF(L)	SYA115	OK !
	LDKL	A1,LMP3	MEMORY OVERFLOW 
	CALL	ERROR 
SYA115	EQU	*
	SUR	A8,A8
ZERO	EQU	*
	SUKL	A11,2	NEXT
	STR	A8,A11	CLEAR WORD
	CW	A11,SHADST+STKEND	ALL DONE ?
	RB(NE)	ZERO	NO 
	ST*	A7,SHADST+STKEND	STORE LENGTH IN TABLE LENGTH WORD 
	LDR	A8,A7	SHTAB1 LENGTH
	LD	A11,ACOSTA+STKEND	CONFIG START
	LC	A3,TDBBT,A11	GET BLOCK TYPE FROM CONF 
	CCK	A3,'TT'	TASK DEFINITION BLOCK ?
	RF(E)	SYA125	YES 
SYA120	EQU	*
	LDK	A1,LMP4	NO 
	CALL	ERROR 
SYA125	EQU	*
	LD	A2,TCLPNT+STKEND	ADDR TO TCLBLK POINTER 
	LC	A3,TDBMC+4,A11	TCL-ID 
	SLL	A3,8 
	LC	A3,TDBMC+5,A11	TCL-ID 
	LDR	A7,A12	NBR OF TCL'S
* 
*        CHECK IF TCL-ID FROM CONF IS IN APPLICATON 
* 
SYA130	EQU	*
	SUK	A7,1	COUNT NBR OF TCL'S
	RF(NN)	SYA135	N=END OF TCLBLK'S
	LDK	A1,LMP5	TID IN CONF NOT IN APPL
	CALL	ERROR 
SYA135	EQU	*
	CW	A3,-2,A2	TCL-ID FOUND ? 
	RF(E)	SYA140	YES 
	ADK	A2,4	POINT AT NEXT TCLBLK
	RB	SYA130	TRY IN NEXT TCLBLK 
SYA140	EQU	*
	LD	A6,SHADST+STKEND
	ADR	A6,A8	START OF SHTAB2
	ADR	A6,A8	START OF SHTAB3
SYA145	EQU	*
	SUK	A6,2	STEP SHTAB2 
	LD	A3,SHADST+STKEND
	ADR	A3,A8
	CWR	A6,A3	END OF SHTAB2 ?
	RF(E)	SYA150	YES 
	LDR*	A1,A6	ITCT ADR IN SHTAB2
	LDR*	A3,A2	GET TCLBLK-ADR
	CW	A1,TCLTCT,A3	FOUND ITCT ADR ? 
	RB(NE)	SYA145	NO 
	RF	SYA155	YES
SYA150	EQU	*
	ADK	A6,2	NEXT ENTRY IN SHTAB2
	LDR*	A3,A6 
	RB(NZ)	SYA150	ENTRY NOT FREE 
	LDR*	A3,A2	GET TCLBLK-ADR
	LD	A1,TCLTCT,A3	ITCT ADR IN TCLBLK 
	STR	A1,A6	STORE ITCT ADR IN SHTAB2 
SYA155	EQU	*
	SUR	A6,A8	POINT AT ENTRY IN SHTAB1 
	LC	A4,TDBNT+1,A11	NBR OF COPIES / 2
	SRC	A4,4 
	LC	A4,TDBNT,A11	NBR OF COPIES / 1
	SLC	A4,12
	SRL	A4,8	BINARY VALUE (NBR OF COPIES)
	LDR	A4,A4	NBR OF COPIES
	RF(Z)	SYA170 
SYA160	EQU	*
	LC	A3,TDBID+4,A11	TID
	SLL	A3,8 
	LC	A3,TDBID+5,A11	TID
	CALL	BUILDT	BUILD TIDTAB PART FOR ONE TCL
SYA170	EQU	*
	CALL	NXTBLK	NEXT CONFIG-BLOCK
	CCK	A2,'TT'	TASK DEF BLOCK ? 
	RB(E)	SYA125	YES 
	LD	A1,NOCOPS+STKEND	TOTAL NBR OF RUNNING TASKS 
	SLL	A1,1	NBR OF BYTES USED 
	ADK	A1,2	ADD LENGTH WORD 
	STR	A1,A7	STORE LENGTH IN TABLE
	ST	A7,DYNTAD,A10	SAVE TABLE START
	ADR	A7,A1	UPDATE "FIRST FREE WORD" 
	SUK	A1,4 
	RF(NZ)	SYA175	MORE THAN ONE TASK IN THE SYSTEM 
	IM	STASK+STKEND	INDICATE SINGLE TASK APPLICATION 
* 
*        PREPARE FOR NEXT APPLICATION 
* 
SYA175	EQU	*
	LD	A2,SHADST+STKEND	GET START OF SHADOW TABLES 
	ST	A2,SHADOW,A10	SAVE IN APPL.SAVE AREA
	ADKL	A10,TABLEN	UPDATE SAVE AREA POINTER 
	ST	A7,SHADST+STKEND	SAVE START OF SHTAB1 
	LDKL	A2,SYA100 
	AD	A2,M:REL+STKCOM	ABSOLUTE BRANCH ADDRESS 
	ABR	A2	CHECK IF MORE APPLICATIONS
SYA178	EQU	*
	EJECT
* SAVE MONITOR END ADDRESS
	LD	A2,SCTSFA 
	ST	A2,MONEND+STKEND

* GET START OF SYSLCO AFTER MOVE
			 
	ADK	A7,1	TO-ADDRESS (AFTER SHADOW-TABLES)
	ANKL	A7,/FFFE	EVEN ADDRESS 

* CALCULATE RELOCATION
	LDKL	A2,PART2	GET START OF PART2 
	AD	A2,M:REL+STKCOM	ADD RELOCATION BASE 
	LDR	A3,A2		
	SUR	A2,A7	LENGTH TO MOVE (SYSLCO+SYSINI) 
	NGR	A2,A2
	ST	A2,RELOCA+STKEND	SAVE NEW RELOCATION TEMPORARY
	ST	A7,LCOTO+STKEND	SAVE (LOGICAL) TO-ADDRESS 
	LDR	A2,A13	A13=START OF SYSINI 
	SUR	A2,A3	SYSLCO LENGTH
	ADKL	A2,INILEN	ADD LENGTH OF SYSINI
	ST	A2,MOVLE1+STKEND	SAVE LENGTH TO MOVE
	ADR	A7,A2	NEW DDIV ADDRESS 
	ST	A7,DDIVTO+STKEND	SAVE NEW DDIV ADDRESS
* CALCULATE DDIV FROM-ADDRESS * 
	CM	APPLNO+STKCOM	RESET NBR OF APPL.
	LDKL	A10,STKEND	START OF 1:ST APPL SAVE AREA 
SYA180	EQU	*
	LDKL	A1,'CO'	COBOL APPLICATION 
	CALL	GETAPP	ANY COBOL APPL LEFT? 
	RF(Z)	OUT01	NO!

	LD	A2,APLLAC,A1	GET SEGTAB 
	LD*	A9,APLLAC,A1	APPTAB ADR
	LD	A9,APPCOM,A9	COMMON-PSEG-PNTR 
	LD	A3,SGNOSG,A2	NUMBER OF SEGMENTS 
	LDR	A1,A2	SAVE SEGTAB ADDRESS
	LDK	A2,SEGREC	SEGMENT BLOCK RECORD LENGTH
	CALL	MULT
	ADR	A1,A3
	ADK	A1,SGNOSG+2	=> START OF DDIV 
	ST	A1,DDIVFR,A10	SAVE DDIV FROM-ADDRESS
	LD	A6,DDIVTO+STKEND	GET DDIV TO ADDR.
	SUR	A6,A1	RELOCATION FOR DDIV
	ST	A6,SAVE01+STKEND	SAVE RELOCATION INCREMENT
	LDKL	A6,/FFFF
	ST	A6,PLTGCS,A10	INIT. START OF PLTGC'S
	CALL	LIMTGC	RELOCATE ICB-PLTGC 
	LD	A6,SAVE01+STKEND	GET RELOCATION INCREMENT 
	EJECT
* 
* RELOCATE ITCT'S 
* 
RELITC	EQU	*
	LD	A1,DDIVFR,A10	ADR TO APPTAB 
	LDR*	A1,A1	ADR TO TCLTAB 
	LDR*	A2,A1	NBR OF TCL'S
RELIT1	EQU	*
	SUK	A2,1	ADJUST NBR OF TCL'S 
	RF(N)	RELITX	ALL ITCT'S RELOCATED
	ADK	A1,4	TCLBLK ADR POINTER
	LDR*	A3,A1	TCLBLK ADR
	ADK	A3,TCLTCT	ADR TO ITCT POINTER
	LDR*	A3,A3	ITCT ADR
	ADS	A6,ITCGLA,A3	RELOCATE PGTL-DATA-ADR
	ADS	A6,ITCCOM,A3	RELOCATE PGTG-DATA-ADR
	ADK	A3,ITCTLT	TLTAB ADR
	LDR*	A4,A3	NBR OF ENTRIES IN TLTAB 
RELIT2	EQU	*
	SUK	A4,1	ADJUST LOOP-COUNTER 
	RB(N)	RELIT1	ALL ENTRIES RELOCATED 
	ADK	A3,ITCTLE	POINT AT NEXT ENTRY
	LDR*	A5,A3	ENTRY CONTENT 
	RB(Z)	RELIT2	FREE ENTRY
	ADRS	A6,A3	RELOCATE ENTRY
	RB	RELIT2	NEXT ITCT
RELITX	EQU	*
* 
* RELOCATE TCLBLK'S 
* 
RELTCB	EQU	*
	LD	A1,DDIVFR,A10	APPTAB ADR
	LDR*	A1,A1	TCLTAB ADR
	LDR*	A2,A1	NBR OF TCL'S
RELTB1	EQU	*
	SUK	A2,1	ADJUST NBR OF TCL'S 
	RF(N)	RELTBX	RELOCATION OF TCLBLK'S DONE 
	ADK	A1,4	TCLBLK ADR POINTER
	LDR*	A3,A1	TCLBLK ADR
	ADS	A6,TCLTGC,A3	RELOCATE ICB-PLTGC-MAIN POINTER 
	ADS	A6,TCLTCT,A3	RELOCATE ITCT POINTER 
	RB	RELTB1	NEXT TCLBLK
RELTBX	EQU	*
* 
* RELOCATE TCLTAB 
* 
RELTCT	EQU	*
	LD	A1,DDIVFR,A10	APPTAB ADR
	LDR*	A1,A1	TCLTAB ADR
	LDR*	A2,A1	NBR OF TCL'S
RELTC1	EQU	*
	SUK	A2,1	COUNT NBR OF TCL'S
	RF(N)	RELTCX	RELOCATION OF TCLTAB DONE 
	ADK	A1,4	TCLBLK ADR POINTER
	ADRS	A6,A1	RELOCATE TCLBLK POINTER 
	RB	RELTC1	NEXT TCLBLK POINTER
RELTCX	EQU	*
* 
* RELOCATE APPTAB 
* 
RELAPP	EQU	*
	LD	A1,DDIVFR,A10	APPTAB ADR
	ADRS	A6,A1	RELOCATE TCLTAB-PNTR
RELAPX	EQU	*
* 
* RELOCATE SHADOW-TABLE2 (ITCT ADDRESSES) 
* 
RELSHT	EQU	*
	LD*	A1,SHADOW,A10	SHTAB LENGTH 
	LDR	A2,A1	SAVE SHTAB2 LENGTH 
	AD	A1,SHADOW,A10	SHTAB2 ADR
RELSH1	EQU	*
	SUK	A2,2	ADJUST SHTAB2 LENGTH
	RF(Z)	RELSHX	RELOCATION OF SHTAB2 DONE 
	ADK	A1,2	POINT AT ITCT ADR 
	ADRS	A6,A1	RELOCATE ITCT ADR 
	RB	RELSH1	NEXT 
RELSHX	EQU	*
	ADKL	A10,TABLEN	NEXT APPL.SAVE AREA
	RB	SYA180	CHECK IF MORE APPL.
OUT01	EQU	* 
	LD	A5,RELOCA+STKEND	GET NEW RELOCATION INCREMENT 
	ADS	A5,M:REL+STKCOM	AND ADJUST RELOCATION BASE 
* CONTINUE IN PART 2 *
			 
	LD	A2,LCOTO+STKEND	GET TO-ADDRESS (SYSLCO) 
	LDR	A5,A2
	AD	A5,MOVLE1+STKEND
	SUKL	A5,INILEN	A5=SYSINI START 
	LDKL	A7,START2	GET EXECUTION START ADDRESS 
	AD	A7,M:REL+STKCOM	ADD RELOCATION BASE 
	LD	A3,MOVLE1+STKEND	SYSLCO+SYSINI LENGTH 
	LDKL	A1,PART2
	AD	A1,M:REL+STKCOM 
	SU	A1,RELOCA+STKEND	FROM ADR.
* 
* JUMP TO ROUTINE IN SYSTEM-STACK WHICH 
* MOVES SYSLCO, AND THEN CONTINUE IN PART2
* INPUT TO ROUTINE IN STACK IS
*	A1 = FROM ADDR. 
*	A2 = TO ADDR. 
*	A3 = LENGTH 
*	A7 = RESTART ADDR.
* 
	ABL	STKMOV	JUMP TO MOVE-ROUTINE IN STACK 
	EJECT
				
************************************************* 
***                                           *** 
**           SYSLOAD PART 2                    ** 
**                                             ** 
************************************************* 

*   BUILD COMMON AND TASKCLASS DATA AREAS.      * 
*   BUILD TASKDATA PROTOTYPE AREA               * 
*                                               * 
************************************************* 

PART2 	EQU	*

********************************************
***                                      ***
**         S U B R O U T I N E S          **
********************************************

				
	EJECT
*           M O V C O M               * 
*                                     * 
* MOVE ICB-PGTG AND PGTG-DATA         * 
*                                     * 
*************************************** 

MOVCOM	EQU	*
	CALL	FNDCOM	ICB-PGTG ADR 
	LD	A3,DDIVTO+STKEND	APPTAB ADDRESS 
	LD	A3,APPTGL,A3	PGTG-DATA ADR
	LD	A6,LSTADR+STKCOM	LAST FREE ADDRESS
	SUR	A6,A3	PGTG START ADR 
	CALL	CALLMO	ALLOCATE AND MOVE PGTG-DATA
	ST	A6,PGTGAD+STKEND	SAVE ICB-PGTG NEW ADDRESS
	RTN	A14
	EJECT
*         F N D C O M          *
*                              *
* FIND PGTG-DATA               *
*                              *
* EXIT  : A1 PGTG-DATA ADR     *
********************************

FNDCOM	EQU	*
	LD*	A1,DDIVTO+STKEND	ADR TO TCLTAB 
	LD	A1,4,A1	ADR TO TCLBLK 
	LD*	A1,TCLTCT,A1	ADR TO PGTG-DATA
	RTN	A14
	EJECT
*                                       * 
*        R  E  L  T  G  C               * 
*                                       * 
*  RELOCATE ICB-PLTGC CALL-TAB          * 
*                                       * 
*  INPUT: PLTGCS= ICB-PLTGC BLOCK       * 
*                 START ADDRESS         * 
*         PLTGCL= ICB-PLTGC BLOCK       * 
*                 LENGTH                * 
*         A6    = RELOCATION INCREMENT  * 
*                                       * 
***************************************** 

RELTGC	EQU	*
	LD	A3,PLTGCS,A10	ICB-PLTGC START ADR 
	LD	A2,PLTGCL,A10	ICB-PLTGC LENGTH
	ADR	A2,A3	ICB-PLTGC END ADR
RELTG1	EQU	*
	LDR	A1,A3
	LDR	A11,A1	GET ADR FOR COMPARE 
	LDR	A9,A2	GET ADR FOR COMPARE
	CALL	CMPADR	ALL ICB-PLTGC'S RELOCATED ?
	RF(NL)	RELTGX	YES
	LCR	A3,A1	GET ICB-PLTGC CONTROL-BYTE 
	CCK	A3,/6161	HANDLED BY LIMTGC ? 
	RF(NE)	RELTG2	NO 
	ANK	A3,/F0	NEW CONTROL-BYTE VALUE
	SCR	A3,A1	RESTORE IT 
RELTG2	EQU	*
	LD	A3,TGCCAL,A1	NBR OF ENTRIES 
	SLL	A3,1	*2 NBR OF BYTES 
	ADR	A3,A1	ADD BASE 
	ADK	A3,10	POINTER TO 1:ST WORD AFTER LAST ENTRY
	LDR	A4,A1	GET BASE 
	ADK	A4,10	1:ST ENTRY 
	LDR	A9,A3
RELTG3	EQU	*
	LDR	A11,A4 
	CALL	CMPADR	END OF THIS ICB-PLTGC ?
	RB(NL)	RELTG1	YES,CONTINUE WITH NEXT ICB-PLTGC 
	LDR*	A11,A4	GET ADDRESS TO RELOCATE
	ADR	A11,A6	RELOCATE ADDRESS
	LDR*	A1,A11
	SRL	A1,8 
	SUK	A1,/60	ICB-PLTGC ? 
	RF(N)	RELTG4	NO, ASM-SUBROUTINE
	SUK	A1,1 
	RF(P)	RELTG4	NO, ASM-SUBROUTINE
	ADRS	A6,A4	RELOCATE CALL ADDRESS 
RELTG4	EQU	*
	ADK	A4,2	STEP CALL-TAB POINTER 
	RB	RELTG3	NEXT CALL-TAB-ENTRY
RELTGX	EQU	*
	RTN	A14
	EJECT
*             F N D B L K        *
*                                *
* FIND A TCLBLK CORRESPONDING    *
* TO AN ITCT ADDRESS             *
*                                *
* INPUT : A7     ITCT ADR        *
*         DDIVTO APPTAB ADR      *
* EXIT  : A1     TCLBLK-PNTR ADR *
*                IN TLCTAB       *
*         A3     TCLBLK ADR      *
* WORK  : A2                     *
**********************************

FNDBLK	EQU	*
	LD*	A1,DDIVTO+STKEND	TCLTAB ADR
	LDR*	A2,A1	NBR OF TCLBLK'S 
FNDBL0	EQU	*
	SUK	A2,1	COUNT NBR OF TCLBLK'S 
	RF(NN)	FNDBL1	BLOCKS LEFT
	LDK	A1,LMP4
	CALL	ERROR 
FNDBL1	EQU	*
	ADK	A1,4	TCLBLK-PNTR ADR 
	LDR*	A3,A1	TCLBLK-PNTR 
	CW	A7,TCLTCT,A3	ITCT FOUND ? 
	RB(NE)	FNDBL0	NO,TRY NEXT TCLBLK 
	RTN	A14	YES,RETURN 
	EJECT

***************************** 
* START OF PROGRAM PART 2   * 
***************************** 

* LOAD BASE ADDRESS * 
********************* 
* A5=START-ADDRESS
* SAVE01=RELOCATION INCREMENT 
* SAVE03=DDIV TO-ADDRESS
* SAVE04=DDIV FROM ADDRESS
* SAVE05=LENGTH OF REAL ITCTTAB 
				
START2	EQU	*
	LDR	A8,P	LOAD TEMP. STACKBASE
	ADK	A5,2	ADD FOR RELOCATION ROUTINE
	CFR	A8,A5
* 
*        INITIATE REGISTERS AND VARIABLES 
* 
	LDKL	A10,STKEND	START OF 1:ST APPL. SAVE AREA
	LD	A1,APCTAB,A10	FIRST APLTAB BLOCK ADDR.
	LD	A2,APPLNO+STKCOM	GET NUMBER OF APPLICATIONS 
	ST	A2,ALICOU+STKEND	SAVE 
	RF	PRT200
* 
*        UPDATE VALUES FOR NEXT APPLICATION 
* 
NXTAPP	EQU	*
	ADKL	A10,TABLEN	NEXT APPL. SAVE AREA 
	LD	A1,APCTAB,A10	NEXT APLTAB BLOCK 
	LD	A2,ALICOU+STKEND	GET APPL.COUNTER 
	SUK	A2,1	DECREMENT APPL.COUNTER
	ST	A2,ALICOU+STKEND	SAVE APPL.COUNTER
	RF(NZ)	PRT200	IF ANY APPL IS LEFT
			DON'T LEAVE SYSLCO YET 
	LD	A2,SCTEFA+2	GET END OF FREE AREA
	ST	A2,LSTADR+STKCOM	LAST ADDR.:=END OF FREE AREA 
	LDKL	A2,SYA320	GET SYSLCO END ADDRESS
	AD	A2,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A2	START TO MOVE DYNTAB:S

PRT200	EQU	*
	LD*	A9,APLLAC,A1	APPTAB START ADDR.
	LD	A2,APPINT,A9	INTERPRETER ACTIV ADDR.
	ST	A2,INTENT+STKEND	SAVE IT
	LD	A9,APPCOM,A9	GET APPL. START ADDR.
	LDR	A2,A9	APPL. START ADDR.
* 
*        CALCULATE DDIV+SEGTAB LENGTH 
* 
	LD	A4,APLLAC,A1	SEGTAB ADDR. 
	ST	A9,APLLAC,A1	STORE START OF APPL. 
	SUR	A2,A4	DDIV+SEGTAB LENGTH 
* 
*        SET FLAG BIT15=1 => BUILD DDIV IN PROT. DDIV 
* 
	IM	PDDIV+STKEND	SET FLAG 
* 
*        INITIATE PROT. DDIV LENGTH 
* 
	LD	A3,SCTEFA+2	GET END OF FREE AREA
	CWR	A3,A4	START OF SEGTAB=SCTEFA?
	RF(NE)	SAVLEN	NO!
	CM	PDDIV+STKEND	RESET FLAG 
SAVLEN	EQU	*
	ST	A2,PDDIVL,A10	INIT.PROT.DDIV LENGTH 
* 
* MOVE DDIV 
* 
	LD	A1,DDIVFR,A10	GET FROM-ADDRESS
	LD	A2,DDIVTO+STKEND	GET TO ADDRESS 
	LDR	A3,A9	GET APPLICATION START (=END OF DDIV
	SUR	A3,A1	=> LENGTH OF DDIV
	ST	A2,DATEND+STKCOM
	ADS	A3,DATEND+STKCOM 
	LD	A8,TOTSGM+STKCOM	ANY SEGMENTS IN APPLICATION? 
	RF(Z)	NOSGMT	NO! 
	SUR	A8,A8	RESET FSTADR IF SEGMENTS 
	RF	SEGMTS
NOSGMT	LD	A8,SCTSFA	ALLOCATE BUFFERS FROM TOP 
SEGMTS	ST	A8,FSTADR+STKCOM	STORE
MOVNXT	LDR*	A4,A1	GET WORD
	STR	A4,A2	STORE
	ADK	A1,2 
	ADK	A2,2 
	SUK	A3,2	DEC LENGTH
	RB(NN)	MOVNXT
* CHECK IF MEMORY OVERFLOW
	LDR	A1,A9	SAVE 
	LDR	A11,A2 
	LD	A9,SCTEFA+2 
	CALL	CMPADR	MEMORY OVERFLOW? 
	RF(NG)	SYA202	NO!
	LDKL	A1,LMP3 
	CALL	ERROR 
SYA202	EQU	*
	LDR	A9,A1	RELOAD 
	SUKL	A9,10	RESERVE 5 WORDS FOR DEBUGGER
	ANKL	A9,/FFFE	EVEN ADDRESS 
	ST	A9,LSTADR+STKCOM	SAVE END OF FREE AREA
	CALL	MOVCOM	ALLOC/MOVE PGTG-DATA 

				
	LD	A1,DDIVTO+STKEND	PROT. NEW START ADR
	AD	A1,PLTGCS,A10 
	SU	A1,DDIVFR,A10	ICB-PLTGCS NEW START ADR
	LD	A3,PLTGCL,A10	ICB-PLTGC LENGTH
	LD	A6,LSTADR+STKCOM	LAST FREE ADR
	SU	A6,PLTGCE,A10	GET DISPL FOR RELOCATION
	CALL	CALLMO	MOVE 
	ST	A2,PLTGCS,A10	ICB-PLTGCS NEW (FINAL) START ADR
	CALL	RELTGC	RELOCATE ICB-PLTGC CALL TABLE
	ST	A6,TGCREL+STKEND	ICB-PLTGC RELOCATION 
	LD	A4,SHADOW,A10	SHTAB1 ADR
	LDR*	A5,A4	SHTAB1 LENGTH 
	LDR	A6,A4	SHTAB1 ADR 
	ADR	A4,A5	SHTAB2 ADR 
	SUK	A5,2	ADJUST FOR TABLE LENGTH WORD
TCLLOP	EQU	*
	ADK	A4,2	SHTAB2 ENTRY
	LDR*	A7,A4	ITCT ADR
	CALL	FNDBLK	FIND TCLBLK
	LDR*	A1,A3	STACK-SIZE
	ST	A1,ITCNEP,A7	SAVE IN ITCT 
	LD	A1,TCLTLD,A3	PGTL-DATA-LENGTH-USED
	ST	A1,ITCGLL,A7	SAVE IN ITCT 
	LDR	A3,A5	NBR OF ITCT'S LEFT 
	RF(Z)	TCLEXT	NONE
	LDR	A1,A7	ITCT ADR 
	LD	A3,TGCREL+STKEND	GET ICB-PLTGC RELOCATION 
	ADS	A3,ITCTGC,A1	RELOCATE ICB-PLTGC-MAIN IN ITCT 
	LD	A3,PGTGAD+STKEND	PGTG-DATA ADDRESS
	ST	A3,ITCCOM,A1	UPDATE POINTER IN ITCT 
	LD	A3,DDIVFR,A10	APPTAB ADDRESS
	LD	A3,APPCOM,A3	COMMON PROGRAM SEGM
	ST	A3,ITCCSB,A1	SAVE IN CURRENT SEGMENT BASE 
	LD	A3,ITCTLT,A7	NBR OF ENTRIES IN TLTAB
	SLL	A3,1	NBR OF BYTES   IN TLTAB 
	ADK	A3,2	ADJUST FOR TLTAB LENGTH WORD
	ADK	A3,ITCTLT	ITCT LENGTH
	ST	A4,SAVE01+STKEND	SAVE SHTAB2 POINTER
	CALL	CALLMO	ALLOCATE AND MOVE ITCT 
	LD	A4,SAVE01+STKEND	GET SHTAB2 POINTER 
	STR	A2,A4	NEW ITCT ADR IN SHTAB2 
	ST	A2,SAVITC+STKEND	SAVE NEW ITCT ADR
	CALL	MVPGTL	ALLOCATE AND MOVE PGTL-DATA
	CALL	MVSTAT	ALLOCATE AND MOVE STATIC-ZERO
	LDK	A2,2 
	ST	A2,DYNDIS+STKEND	INIT.DYN.CORE TABLE DISPL. 
	CALL	ALLDYN	ALLOCATE DYNAMIC-CORE
	LDR*	A3,A4	ITCT ADR
	SUK	A5,2	COUNT NBR OF ITCT'S 
	RB(P)	TCLLOP	ITCT'S LEFT 
TCLEXT	EQU	*
	EJECT
SYA200	EQU	*
* INCLUDE MOVED PROT.DDIV IN FREE AREA
	LD	A5,DDIVTO+STKEND
	ST	A5,DATEND+STKCOM

* CONTINUE IN PART 3 *

	LDKL	A5,START3	RELATIVE START ADDRESS
	AD	A5,M:REL+STKCOM	ADD RELOCATION BASE 
	ABR	A5 
	EJECT


************************************************
***                                          ***
**            SYSLCO  PART 3                  **
**                                            **
************************************************

*   BUILD REAL ITCT'S. COPY ITCT'S ACCORDING TO*
*   SHADOW TABLE                               *
*                                              *
************************************************

PART3	EQU	* 

	EJECT
***************************** 
* START OF PROGRAM PART 3   * 
***************************** 

**              G E T T A B                 **
**                                          **
**  FIND TTAB ADDRESS                       **
**                                          **
**  INPUT :A8=POINTER TO ITCT ADR           **
**  OUTPUT:A2=TTAB-ADDRESS                  **
**         A1=TID                           **
**  WORKREGS:A3,A4,A10                      **
**********************************************

GETTAB	EQU	*
	LDR*	A10,A8	ITCT ADDRESS 
	LD	A1,ITCTID,A10	GET TID TO MATCH
GETTTB	EQU	*	ENTRY. INPUT: A1=TID 
	LD	A4,SCTTCT	GET TC:TAB ADDRESS
	LDR*	A3,A4	TCTAB LENGTH
GETT10	ADK	A4,2 
	SUK	A3,2	ALL?
	RF(NN)	GETT20	NO!
	LDR	A3,A1	SAVE A1 (DEBUGGING PURPOS) 
	LDK	A1,LMP5	TID ERROR
	CALL	ERROR 
GETT20	LDR*	A2,A4	TTAB-ADDRESS
	CW	A1,TTBTID,A2	TID EQUAL ?
	RB(NE)	GETT10	NO!
	CM	TTB:PP,A2	RESET PENDING POINTER IN TTAB 
	ST	A2,TTAB+STKCOM	SAVE 
	LD	A3,ITCSPL,A10	GET SPL-PBS.PROGRAM-DATA ADDRESS
	ST	A3,TTB:SA+20,A2	SAVE IN TTAB
	ADKL	A3,SPLSIZ-SPLCPB-2	POINT AT SPL-PBS STACK-BASE
	ST	A3,TTB:SA+28,A2	SAVE IN TTAB
	RTN	A14
	EJECT


**                    Q U E J O B                ** 
**                                               ** 
**  QUEUE TASK VIA 'ACTOT' AND SWITCH TO LEVEL   ** 
**  0, ENB.                                      ** 
**                                               ** 
**  INPUT: A10=ITCT-ADDRESS                      ** 
**         A2=TTAB-ADDRESS                       ** 
*************************************************** 

QUEJOB	EQU	*
* QUEUE THIS TASK (THIS TID)

	LDKL	A3,RETUR	GET RETURN (FROM A15) ADDRESS
	AD	A3,M:REL+STKCOM 
	STR	A3,A15	PUT ON STACK
	LDKL	A3,/00C0	SET LEVEL 0 AND ENABLE 
	STR	A3,A15	PSW 
	CF	A15,SAVE8	SAVE 8 REGS 
	LDK	A7,0	CLEAR ABORT INDICATOR 
	LDR	A5,A2	GET TTAB-ADDRESS 
	LD	A1,SAVITC+STKEND	ITCT ADR 
	LDR*	A3,A1 
	ANK	A3,/FF	SEGMENT NBR TO ACTIVATE 
	LD	A1,2,A1	DISPL IN SEGMENT
	LD	A2,INTENT+STKEND	INTERPRETER ENTRY
	CF	A15,ACTOT 
GETT40	ABL	RETUR8	RELOAD 8 REGS 
RETUR	EQU	* 
	RTN	A14
	EJECT
*      G E N C O P        * 
*                         * 
*************************** 
GENCOP	EQU	*
	ST	A5,SAVE05+STKEND	SAVE A5
	ST	A6,SAVE06+STKEND	SAVE A6
	CALL	FNDTID	FIND TID 
	LD	A10,SAVITC+STKEND	GET ITCT ADDRESS
	LDR	A1,A10	ITCT ADR
	LDK	A3,ITCTLT	TLTAB START DISPL
	LD	A2,ITCTLT,A1	NBR OF ENTRIES IN TLTAB
	SLL	A2,1	NBR OF BYTES   IN TLTAB 
	ADK	A2,2	ADJUST FOR TLTAB COUNTER
	ADR	A3,A2	ITCT LENGTH
	CALL	CALLMO	COPY ITCT
	ST	A2,SAVITC+STKEND	SAVE ITCT ADR
	LD	A3,SAVTID+STKEND	GET NEW TID
	ST	A3,ITCTID,A2	STORE IN ITCT
	LDR	A3,A2	ITCT ADR 
	CALL	MVPGTL	ALLOCATE AND MOVE PGTL-DATA
	LD	A3,SAVITC+STKEND	ITCT ADR 
	CALL	MVSTAT	ALLOCATE AND MOVE STATIC-ZERO
	LD	A3,SAVITC+STKEND	ITCT ADR 
	LD	A10,SAVE01+STKEND	GET APPL.SAVE AREA
	CALL	ALLDYN	ALLOCATE DYNAMIC CORE
	LD	A1,SAVTID+STKEND	TID
	LDR	A10,A7	ITCT ADDRESS
	CALL	GETTTB	FIND TTAB ADR
	CALL	QUEJOB	QUEUE THIS TASK
	LD	A10,SAVITC+STKEND	ITCT ADR
	LDR	A5,A10	ITCT ADDRESS
	ADK	A5,22
	ST	A5,TTB:SA+26,A2	SAVE ITCT ADR IN TTAB(SAVE-A13) 
	IFT	DSKPAG=1 
	ADKL	A5,ITCCSB-ITCDCD	POINT AT CSB IN ITCT 
	ST	A5,TTB:CB,A2	SAVE POINTER IN TTAB 
	XIF
	IFT MMUPAG=0 
	LD	A5,SAVE05+STKEND	RESTORE A5 
	LD	A6,SAVE06+STKEND	RESTORE A6 
	RTN	A14
	EJECT
*        F N D T I D        * 
*                           * 
* FIND TID FOLLOWING "A1"   * 
* IN SHTAB4                 * 
*                           * 
* INPUT : A1=TID            * 
* EXIT  : A1=NEW TID        * 
* WORK  : A2,A3             * 
***************************** 

FNDTID	EQU	*
	LD	A2,SHADOW,A10	SHTAB1 ADR
	LD*	A3,SHADOW,A10	SHTAB1 LEN 
	ADR	A2,A3	SHTAB2 ADR 
	ADR	A2,A3	SHTAB3 ADR 
	ADR	A2,A3	SHTAB4 ADR 
	LDR*	A3,A2	SHTAB4 LEN
FNDTI0	EQU	*
	SUK	A3,1	FINISHED ?
	RF(NN)	FNDTI1	NO 
	LDK	A1,LMP5	YES,TID ERROR
	CALL	ERROR 
FNDTI1	EQU	*
	ADK	A2,2	ADJUST POINTER
	CWR*	A1,A2	TID FOUND ? 
	RB(NE)	FNDTI0	NO,TRY NEXT
	LD	A1,2,A2	YES,LOAD NEXT TID 
	ST	A1,SAVTID+STKEND	SAVE IT
	RTN	A14
	EJECT
*        A L L D Y N           *
*                              *
* ALLOCATE DYNAMIC-CORE        *
*                              *
* INPUT : A3 ITCT ADDRESS      *
* EXIT  : ITCT IS UPDATED      *
*         WITH DYNAMIC-CORE    *
*         POINTERS             *
* WORK  : A1-A3,A9,A11         *
********************************

ALLDYN	EQU	*
	LDR	A7,A3	ITCT ADR 
	LD	A3,ITCNEP,A3	STACK-SIZE REQUIRED
	LD	A9,FSTADR+STKCOM	SEGMENTED APPLICATION? 
	RF(NZ)	ALLDY1	NO!! 
	CALL	CALLMO	ALLOCATE FROM BOTTOM 
	LD	A3,ITCNEP,A7	DYN. CORE SIZE 
ALLDY0	EQU	*
	ST	A2,ITCDCB,A7	SAVE BASE PNTR 
	ST	A2,ITCDCC,A7	SAVE CURRENT EXTENT
	ADR	A3,A2	+ BASE-PNTR
	SUKL	A3,SPLSIZ	- SPL-STACK-SIZE
	ST	A3,ITCDCD,A7	SAVE DDI-POOL-BASE 
	ADK	A3,SPLCPB	POINT AT SPL-PBS-PNTR
	ST	A3,ITCSPL,A7	SAVE SPL-PBS-PNTR
	LD	A1,DYNTAD,A10	TABLE ADR 
	LD	A2,DYNDIS+STKEND	GET DYN.CORE TABLE DISPL 
	ADR	A1,A2	NEXT TABLE ENTRY TO USE
	ADK	A2,2	COUNT DISPL 
	ST*	A2,DYNTAD,A10	COUNT LENGTH WORD IN TABLE 
	ST	A2,DYNDIS+STKEND	STEP DISPL 
	SUK	A3,SPLCPB	POINT AT SPL-PBS START 
	STR	A3,A1	STORE SPL-PBS ADR IN TABLE 
	RTN	A14
ALLDY1	EQU	*
	LDR	A2,A9	SAVE START-ADR 
	ADR	A9,A3	ADD LENGTH 
	ADKL	A9,1
	ANKL	A9,/FFFE	EVEN ADR 

* CHECK ADDRESS 

	LD	A11,LSTADR+STKCOM	END OF FREE AREA
	CALL	CMPADR
	RF(NL)	ALLDY2	OK ! 
	LDKL	A1,LMP3	MEMORY OVERFLOW 
	CALL	ERROR 
ALLDY2	EQU	*
	ST	A9,FSTADR+STKCOM	NEW START OF FREE AREA 
	RB	ALLDY0	UPDATE ITCT
	EJECT
*          M V S T A T         *
*                              *
* ALLOCATE AND MOVE STATIC-    *
* CORE                         *
*                              *
* INPUT : A3 ITCT ADDRESS      *
* EXIT  : A6 -1                *
*         A3 ITCT ADDRESS      *
* WORK  : A1-A2,A7-A8,A10      *
********************************

MVSTAT	EQU	*
	CALL	PUSH	SAVE REGISTERS 
	LDR	A7,A3	ITCT ADR 
	ADK	A3,ITCTGC	POINT AT ICB-PLTGC-MAIN ADDRESS
	ST	A3,SAVE07+STKEND	SAVE POINTER 
	ADK	A7,ITCTLT	TLTAB ADR
	LDR	A12,A7	SAVE TLTAB-BASE 
	LDR*	A6,A7	NBR OF ENTRIES IN TLTAB 
MVSTA1	EQU	*
	SUK	A6,1	COUNT 
	RF(NN)	MVSTA2	STATIC-ZERO AREAS LEFT 
	CALL	POB	RELOAD REGISTERS
	LD	A3,SAVE07+STKEND	LOAD ICB-PLTGC-MAIN ADR POINTER
	SUK	A3,ITCTGC	MAKE IT ITCT POINTER 
	LDKL	A6,-1	GIVE A6 ITS OUTPUT VALUE
	RTN	A14
MVSTA2	EQU	*
	ADK	A7,2	POINT AT STATIC-ZERO ADR
	LDR*	A8,A7	STATIC-ZERO ADR 
	RB(Z)	MVSTA1	EMPTY ENTRY 
	LD*	A3,SAVE07+STKEND	LOAD ICB-PLTGC-MAIN ADDRESS 
	SUR	A10,A10	LEVEL
	LDK	A1,0	RESET INDICATOR 
	LD	A2,FREQUE	GET MONITOR BLOCK ADR	=2
	CALL	FNDTGC	FIND STATIC-ZERO ADR+LENGTH
	CALL	CALLMO	ALLOCATE AND MOVE STATIC-ZERO
	STR	A2,A7	UPDATE TLTAB ENTRY 
	RB	MVSTA1
	EJECT
*         F N D T G C            *
*                                *
* FIND STATIC-ZERO ADR+LENGTH    *
* FOR ONE PROGRAM                *
*                                *
* INPUT : A3  ICB-PLTGC ADR      *
*         A8  STATIC-ZERO ADR    *
*             WANTED             *
*         A10 0 (ZERO)           *
*         A12 TLTAB BASE         *
*         A2  MONITOR BLOCK ADR  *		=2
* EXIT  : A1  STATIC-ZERO ADR    *
*         A2  MONITOR BLOCK ADR  *		=2
*         A3  STATIC-ZERO LENGTH *
* WORK  : A2,A4,A5,A9,A11        *
* WORKAREA: USES MONITOR BLOCKS  *		=2
*           AS STACK AREA        *		=2
**********************************

FNDTGC	EQU	*
	LDR*	A1,A3		=2 
	SRL	A1,8		=2 
	SUK	A1,/60	COBOL PROGRAM?	=2 
	RF(Z)	FNDT00	YES!	=2 
	LDK	A1,0	INDICATE NOT FOUND	=2 
	RF	FNDTG0	RETURN	=2
FNDT00	EQU	*		=2
	LD	A1,TGCSZD,A3	GET DISPL IN TLTAB 
	ADR	A1,A12	POINT AT TLTAB-ENTRY
	ADK	A1,2	ADJUST FOR TLTAB LENGTH-WORD
	LDR*	A1,A1	STATIC-ZERO-ADR 
	CWR	A1,A8	WANTED ? 
	RF(NE)	FNDTG1	NO 
	ADK	A3,TGCSZL	YES,POINT AT LENGTH WORD 
	LDR*	A3,A3	STATIC-ZERO-LENGTH
FNDTG0	EQU	*
	RTN	A14
FNDTG1	EQU	*
	LDK	A1,0	INDICATE NOT FOUND
	LD	A5,8,A3	NBR OF ENTRIES IN PLTGC CALL TAB
	SLL	A5,1	*2 = TABLE LENGTH 
	ADR	A5,A3	BASE 
	ADK	A5,10	DISPL TO TABLE START 
	LDR	A4,A3	ICB-PLTGC ADR
	ADK	A4,TGCCAL+TGCCTE	ADR TO FIRST ENTRY IN CALL TAB
FNDTG2	EQU	*
	LDR	A9,A4	TABLE START ADR
	LDR	A11,A5	TABLE END ADR 
	CALL	CMPADR	END OF CALL-TABLE?	=2
	RB(NG)	FNDTG0	YES!	=2
FNDTG3	EQU	*
	ST	A4,2,A2	SAVE ON STACK	=2
	ST	A5,4,A2	SAVE ON STACK	=2
	LDR*	A2,A2	ADJUST STACK POINTER	=2 
	RF(NZ)	FNDTG4	MORE BLOCKS AVILABLE	=2
	LDKL	A1,NOBLK	NO BLOCKS AVILABLE	=2
	CALL	ERROR		=2 
FNDTG4	EQU	*		=2
	LDR*	A3,A4	NEXT LINK 
	ADKL	A10,1	ADJUST LEVEL
	CALL	FNDTGC	NEXT LEVEL 
	SUK	A2,6	ADJUST STACK POINTER	=2 
	LDR	A1,A1	STATIC-ZERO FOUND
	RB(NZ)	FNDTG0	YES
	SUKL	A10,1	ADJUST LEVEL
	LD	A4,2,A2	TABLE POINTER FROM STACK	=2 
	LD	A5,4,A2	TABLE END POINTER FROM STACK	=2 
	ADK	A4,TGCCTE	POINT TO NEXT TABLE-ENTRY
	RB	FNDTG2
	EJECT
*         M V P G T L             * 
*                                 * 
* ALLOCATE AND MOVE PGTL-DATA     * 
*                                 * 
* INPUT : A2 ITCT ADR             * 
* EXIT  : A1 OLD PGTL-DATA ADR    * 
*         A2 NEW PGTL-DATA ADR    * 
*         A3 ITCT ADR             * 
*********************************** 

MVPGTL	EQU	*
	LD	A1,ITCGLA,A2	PGTL-DATA ADR
	LD	A3,ITCGLL,A2	PGTL-DATA LENGTH 
	CALL	CALLMO	ALLOCATE AND MOVE PGTL-DATA
	LD	A3,SAVITC+STKEND	ITCT ADR 
	ST	A2,ITCGLA,A3	NEW PGTL-DATA ADR
	RTN	A14
	EJECT
************************************************
*                                              *
*                 C A L L M O                  *
*                                              *
*                                              *
* INPUT: A3=LENGTH TO MOVE                     *
*        PDDIV=FLAG THAT INDICATES IF DDIV IS  *
*              GOING TO BEE BUILT IN PROT.DDIV *
*        PDDIVL=LENGTH LEFT IN PROT.DDIV       *
*        SCTEFA=END OF FREE AREA               *
*                                              *
* OUTPUT: A3=-1                                *
*         PDDIV=1 IF DDIV IS BUILT IN PROT.    *
*               DDIV ELSE PDDIV=0              *
*         PDDIVL=NEW PDDIVL                    *
*         LSTADR=NEW LAST FREE ADDR.           *
*                                              *
* WORK REG:A2                                  *
*                                              *
************************************************
CALLMO	EQU	*
	LD	A2,PDDIV+STKEND	BUILD DDIV IN PROT.DDIV?
	RF(Z)	CAL200	NO! 
	LD	A2,PDDIVL,A10	GET LENGTH LEFT IN PROT.DDIV
	SUR	A2,A3	ENOUGH SPACE LEFT IN PROT.DDIV 
	RF(NN)	CAL100	YES! 
* 
*        RESET FLAG AND CHANGE LSTADR TO POINT AT 
*        END OF FREE AREA 
* 
	CM	PDDIV+STKEND	RESET FLAG 
	LD	A2,SCTEFA+2	GET END OF FREE AREA
	ST	A2,LSTADR+STKCOM	STORE NEW LSTADR 
CAL100	EQU	*
	ST	A2,PDDIVL,A10	LENGTH LEFT IN PROT.DDIV
CAL200	EQU	*
	CALL	MOVING
	RTN	A14
	EJECT


START3	EQU	*


REALTA	EQU	*
	LD*	A8,SHADOW,A10	SHTAB LENGTH 
	LD	A5,SHADOW,A10	SHTAB1 ADR
	ST	A10,SAVE01+STKEND	SAVE APPL.SAVE AREA POINTER 
	ADR	A8,A5	SHTAB2 ADR 
	ST	A8,SAVE03+STKEND	SAVE SHTAB2 ADR
	AD*	A8,SCTSFA	SHTAB3 ADR 
	ST	A8,SAVE02+STKEND	SHTAB3 ADR 
SYA300	EQU	*
	LD	A8,SAVE03+STKEND	SHTAB2 POINTER 
	ADKL	A8,2	NEXT 
	CW	A8,SAVE02+STKEND	ALL TCL'S DONE ? 
	RF(E)	SYA310	YES 
	ST	A8,SAVE03+STKEND	SAVE SHTAB2 POINTER
	ADK	A5,2	SHTAB1 POINTER
	LDR*	A10,A5	NBR OF COPIES
	RB(Z)	SYA300	NONE
	CALL	GETTAB	FIND TTAB ADR
	ST	A10,SAVITC+STKEND	SAVE ITCT ADR 
	CALL	QUEJOB	QUEUE TASK 
	LDR	A6,A10	ITCT ADR
	ADK	A6,22	MAKE IT INT-USABLE 
	ST	A6,TTB:SA+26,A2	SAVE ITCT ADR IN TTAB(SAVE-A13) 
	IFT DSKPAG=1 
	ADKL	A6,ITCCSB-ITCDCD	POINT AT CSB IN ITCT 
	ST	A6,TTB:CB,A2	SAVE IN TTAB 
	XIF
	IFT MMUPAG=0 
	LDR*	A6,A5	NBR OF COPIES 
SYA305	EQU	*
	LD	A10,SAVE01+STKEND	GET APPL.SAVE AREA POINTER
	SUK	A6,1	COUNT NBR OF COPIES 
	RB(NP)	SYA300	NEXT TCL 
	CALL	GENCOP	GENERATE ONE COPY
	RB	SYA305	NEXT 
	EJECT

* ADJUST START OF FREE AREA 

SYA310	EQU	*
	LD	A1,PDDIV+STKEND	UPDATE SCTEFA?
	RF(NZ)	SYA312	NO!
	LD	A1,LSTADR+STKCOM	GET END OF FREE AREA 
	ST	A1,SCTEFA+2 
SYA312	EQU	*
	LD	A1,FSTADR+STKCOM	START OF FREE AREA 
	RF(Z)	SYA315 
	ST	A1,SCTSFA	STORE START OF FREE AREA
SYA315	EQU	*
	LDKL	A1,NXTAPP 
	AD	A1,M:REL+STKCOM 
	ABR	A1	CHECK IF MORE APPLICATIONS


* 
* MOVE DYNTAB:S AND SAVE IN ONE WORD
* NUMBER OF DYNTAB:S
* 
SYA320	EQU	*
	LDKL	A10,STKEND	START OF 1:ST APPL.SAVE AREA 
	LD	A1,APPLNO+STKCOM	GET NUMBER OF DYNTAB:S 
	LD	A4,SHADOW,A10	GET START OF AREA WHERE TO PUT
			DYNTAB:S AND NUMBER OF DYNTAB:S
	ST	A4,DYNSTA+STKCOM	SAVE START OF DYNTAB:S 
	STR	A1,A4	SAVE NUMBER OF DYNTAB:S
	ADK	A4,2	INCREMENT TO-ADDR 
SYA330	EQU	*
	LD	A2,DYNTAD,A10	GET DYNTAB FROM ADDR
	LDR*	A3,A2	GET LENGTH OF DYNTAB
SYA340	EQU	*
	LDR*	A5,A2	GET DYNTAB WORD 
	STR	A5,A4	STORE
	ADK	A4,2	INCREMENT TO-ADDR 
	ADK	A2,2	INCREMENT FROM-ADDR 
	SUK	A3,2	ALL WORDS MOVED ? 
	RB(NZ)	SYA340	NO!
	ADKL	A10,TABLEN	NEXT APPL.SAVE AREA
	SUK	A1,1	ALL DYNTAB:S MOVED? 
	RB(NZ)	SYA330	NO!
	XIF
LCOEND	EQU	*	SYSLCO END 
	END
DataMuseum.dk

Philips Data Systems

⟦5bcf644b6⟧

Derivation

PTS(SC)

Full view
