⟦43fd7ce48⟧

PTS(SC)

	IDENT SYSLDA 	REL 9.2 79-12-21  870105040920 

			=5,MOVING AREAS>32K DOES NOT WORK
			REL 9.2 79-12-21 ST
			=4, FAULTY STACK BASE & CWB/UWB BLOCKS 
			REL 9.1 79-07-17 
			=3, IMPOSSIBLE TO LOAD NON MMU SYSTEM
			REL 9.1 79-05-23 
				
				
**********************************************************
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   SYSLDA = SYSTEM LOAD - APPLICATION CONFIGURATION PART 
* 
* 
* 
* 
* 
* 
**********************************************************
* 
* 
*   THIS PART OF THE SYSTEM START-UP WILL TAKE CARE OF APPLICATION
*   (CREDIT) CONFIGURATION AND START OF APPLICATION. SYSLDA IS
*   ENTERED AFTER MONITOR CONFIGURATION (PERFORMED BY SYSLDM), AND
*   IS AT THAT TIME LOCATED AT HIGHEST FREE ADDRESS OF SYSTEM AREA. 
* 
*   ASSEMBLER APPLICATION:
*      NO CONFIGURATION WILL TAKE PLACE. FIRST USER TASK IS ACTIVATED 
*      AND A BRANCH IS MADE TO  P F I N I T . ALL USER TASK TTAB'S
*      MM-TABLES ARE FILLED IN. 
* 
*   CREDIT APPLICATION: 
*      SYSLDA READS CONFIGURATION FILE (ALREADY IN CORE) AND BUILD
*      SHADOW-TABLES (TABLES CONTAINING NUMBER OF REAL TASKS &
*      NUMBER OF USER WORK-BLOCK COPIES). 
*      SYSLDA THEN MOVES ITSELF TO FOLLOW MONITOR AND WILL ALSO MOVE
*      DDIV-PROTOTYPE TO FOLLOW SYSLDA. 
* 
*      APPLICATION WORKBLOCKS, DESCRIPTORS, STACK AND TABLES ARE NOW
*      BUILT FROM 'BOTTOM' (HIGHEST FREE ADDRESS) OF MEMORY. BUFFERS
*      ARE, IN CASE OF MMU IN SYSTEM, ALSO ALLOCATED AT 'BOTTOM' OF 
*      MEMORY; ELSE, IF NO MMU, BUFFERS ARE ALLOCATED AFTER MONITOR 
*      'OVER' SYSLDA. 
* 
*      ALL USER TASKS ARE QUEUED    VIA  A C T O T AND ALL MM-TABLES
*      IN USER TASK TTAB'S ARE FILLED. A BRANCH IS FINALLY MADE TO
*      P F I N I T  TO START APPLICATION. 
	EJECT
				
*************************** 
*                         * 
*  ENTRIES AND EXTERNALS  * 
*                         * 
*************************** 
			 
* LABEL ENTRIES 
	ENTRY	JUMP	BYPASS JUMP FOR LOAD-MODULE 
	ENTRY	SYSLDA 
	ENTRY	REL	START OF CODE
	ENTRY	LDALEN	PROGRAM LENGTH

* SUBROUTINE ENTRIES
	ENTRY	MOVE 
	ENTRY	ERROR
	ENTRY	CMPADR	COMPARE ADDRESSES 
	ENTRY	NXTBLK	SKIP TO NEXT CONFIGURATION BLOCK
	ENTRY	NXTCOM	SKIP COMMONDEVICE DEFINITION BLOCK
	ENTRY	CONVRT	CONVERSION ASCII-BINARY 
	ENTRY	GETNUM	CONVERT 3 ASCII-DIGITS TO BINARY

* SAVE AND WORK AREA ENTRIES
	ENTRY	MMTAB	WORK-TABLE 1 (MMU
	ENTRY	TABBE	ABSOLUTE START ADDRESS OF WORK-TAB 1 
	ENTRY	MMEND	ABSOLUTE END ADDRESS OF WORK-TAB 1 
	ENTRY	MMDDIV	WORK-TABLE 2 (MM) RELATIVE 'REL'
	ENTRY	BUFSIZ	TEMPORARY MOVE-BUFFER SIZE
	ENTRY	SYSBUF	TEMPORARY MOVE-BUFFER START 
	ENTRY	M:REL	RELOCATION FOR RELOCATION WORD!!!! 
	ENTRY	SAVE01,SAVE12,SAVE03,SAVE04
	ENTRY	SAVE05,SAVE06,SAVE07,SAVE08
	ENTRY	SAVE09,SAVE10,SAVE11,SAVE02
	ENTRY	SAVE13,SAVE14,SAVE15,SAVE16
	ENTRY	SAVE17,SAVE18,SAVE19,SAVE20
	ENTRY	SAVE21,SAVE22,SAVE23,SAVE24,SAVE25 
	EJECT

* SYSTEM CONTROL TABLE EXTERNALS
	EXTRN	SCTSFA	START OF FREE AREA
	EXTRN	SCTLAC	LOGICALL ADDRESS TO COMMON PART 
	EXTRN	SCTTCT	TC:TAB ADDRESS
	EXTRN	SCTSTB	A15 STACK-BASE
	EXTRN	SCTEFA	END OF FREE AREA
	EXTRN	SCTNOS	NUMBER OF SEGMENTS
	EXTRN	SCTNOP	NUMBER OF PAGES 
	EXTRN	SCTPSZ	PAGE SIZE 
	EXTRN	SCTMMC		=00002 
	EXTRN	SCTOPT	SYSTEM OPTION 
	EXTRN	SCTSEG	SEGMENT TABLE ADDRESS 
	EXTRN	SCTPAG	PAGE TABLE ADDRESS
	EXTRN	SCTSWB	ADDRESS TO SWB CONTROL BLOCK TABLE
	EXTRN	SCTBUG	BUGGER ADDRESS

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

* 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
	EJECT


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

MMUPAG	EQU	0	0 = NO MMU 

SWPBLK	EQU	0	SWAPPABLE WORK BLOCKS

CREDIT	EQU	1	0 = ASSEMBLER

MMUSWB	EQU	MMUPAG+SWPBLK

SWBMMU	EQU	SWPBLK-MMUPAG
	EJECT

	  PROGRAM STRUCTURE: 

*          -------------------------------------------------------
*          !  RELOCATION ROUTINE                                 !<- A13
*          !  A14-STACK AND SUBROUTINE-HANDLER                   !
*          !-----------------------------------------------------!
*          !  SAVE & COMMUNICATION AREA. MMU - WORK TABLES       !
*          !-----------------------------------------------------!
*          !  SUBROUTINES. -COMMON TO ALL PARTS IN PROGRAM.      !
*          !-----------------------------------------------------!
*          !  R E A L T A                                        ! PART 2.B 
*          !  BUILD REAL TASK-LOCAL DATA AREAS                   !
*          !  -QUEUE TASK VIA 'ACTOT'                            !
*          !  -FILL MM-TABLE IN TTAB                             !
*          !  -COPY T:A'S ACCORDING TO SHADOW-TABLE              !
*          !  -BUILD TWB'S AND RESERVE FOR SWB'S                 !
*          !  -ALLOCATE FIXED BUFFERS AND STACK                  !
*          !  -UPDATE TID IN T:A AND SAVE TID IN T:AID TABLE     !
*          !  -START DEBUGGER (IF ANY) AND START APPLICATION     !
*          !-----------------------------------------------------!
*          !  SUBROUTINES                                        ! PART 2.A 
*          !  -MOVE DDIV PROTOTYPE TO FOLLOW SYSLDA              !
*          !                                                     !
*          !  C O M D A T                                        !
*          !  GENERATE COMMON DATA AREA. PROCESS CWB'S & UWB'S.  !
*          !  -MOVE D.T. AND W.B., COPY UWB'S ACCORDING TO       !
*          !   SHADOW-TABLE.                                     !
*          !                                                     !
*          !  C L A D A T                                        !
*          !  BUILD TASK CLASS DATA AREAS. PROCESS CWB'S, UWB'S  !
*          !  AND DWB'S.                                         !
*          !  -BUILD MM-TABLE                                    !
*          !  -MOVE T:D                                          !
*          !  -MOVE D.T. & W.B., COPY UWB'S                      !
*          !  -MOVE D.T.'S OF SWB'S AND TWB'S                    !
*          !  -SEARCH DBLK-TAB FOR DWB'S. MOVE D.T. AND UPDATE   !
*          !   W.B.-ADDRESS                                      !
*          !                                                     !
*          !  P R O D A T                                        !
*          !  BUILD PROTOTYPE TASK-LOCAL DATA AREAS.             !
*          !  -GENERATE TWB'S AND RESERVE FOR SWB'S              !
*          !  -ALLOCATE FIXED BUFFERS AND TERMINAL STACK         !
*          !  -MOVE T:A                                          !
*          !  -INCLUDE DDIV-PROTOTYPE & PART 2.A IN FREE AREA.   !
*          !  -CONTINUE IN PART 2.B                              !
*          !-----------------------------------------------------!
*          !  SUBROUTINES                                        ! PART 1 
*  ENTRY ->!                * SYSLDA ENTRY *                     !
*          !  CREDIT APPLICATION:      !  ASSEMBLER APPLICATION: !
*          !  READ CUNFIGURATION FILE  !  -FILL MM-TABLES IN     !
*          !  AND BUILD SHADOW-TABLES. !   USER TASK TTAB'S.     !
*          !                           !  -QUEUE 1:ST USER TASK  !
*          !  T:ATAB:                  !   AND START APPLICATION !
*          !  -A TABLE OF 'NUMBER OF   !-------------------------!
*          !   REAL TASKS' IS BUILT AT                           !
*          !   THE END OF MONITOR.                               !
*          !  U:BTAB:                                            !
*          !  -A TABLE OF 'NUMBER OF REAL UWB'S' IS BUILT IN     !
*          !   U:BTAB PROTOTYPE.                                 !
*          !                                                     !
*          !  -RELOCATE ALL W.B.-ADDRESSES IN DDIV-PROTOTYPE.    !
*          !  -REMOVE NOT USED ENTRIES IN T:ATAB                 !
*          !  -RELOCATE ADDRESSES IN U:BTAB                      !
*          !  -MOVE SYSLDA (NOT PART 1) TO FOLLOW T:ATAB SHADOW- !
*          !   TABLE                                             !
*          !  -CONTINUE IN PART 2.A                              !
*          !-----------------------------------------------------!
	EJECT
				
		***************** 
		***************** 
		**             ** 
		**  CONSTANTS  ** 
		***************** 
		**             ** 
		***************** 
				
**********
* P:MTAB *
**********
T:ATAB	EQU	0
U:BTAB	EQU	2
P:BAS	EQU	6	SEGMENT BASE
T:AID	EQU	32	ADDRESS TO 'TABLE OF T:A TID'
S:BTAB	EQU	40	DISP TO S:BTAB ADDRESS


**********
* U:BTAB *
**********
UP:REC	EQU	6	RECORD LENGTH IN INITIAL U:BTAB
UPADDR	EQU	2	PROTOTYPE ADDRESS
UPNAME	EQU	4	PROTOTYPE NAME 
UPNUMB	EQU	7	SAVE AREA NUMBER OF COPIES (SHADOW-TBL)
* 
UR:REC	EQU	6	RECORD LENGTH IN REAL U:BTAB 
URADDR	EQU	2	ADDRESS TO FIRST REAL UWB
URNUMB	EQU	4	NUMBER OF UWB'S
URLENG	EQU	6	LENGTH OF UWB
	EJECT
				
				
				
******************************* 
* 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	6	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
				
				
********* 
*  T:A  * 
********* 
T:ASTA	EQU	-14	T:A START
CSE	EQU	-14	CURRENT SEGMENT END (HERE: STACKSIZE) 
CSB	EQU	-12	CURRENT SEGMENT BASE
CSN	EQU	-10	CURRENT SEGMENT NUMBER (HERE LENGTH 
			                        OF ALL DSCB-RECORDS
T:DAD	EQU	-8	ADDRESS TO T:D 
CIA	EQU	-6	CURRENT INSTUCTION ADDRESS 
			(HERE: DISPLACEMENT TO T:A-START)
			 
T:ATID	EQU	-4	TASK ID 
STKE	EQU	-2	STACK END 
PA	EQU	0	STACK POINTER
STKB	EQU	2	STACK BASE 
WATFST	EQU	4	FIRST WAT-ELEMENT
* 
* DSCB-RECORD:
DSCBL	EQU	20	RECORD LENGTH
BA	EQU	2	BUFFER ADDRESS 
RL	EQU	4	REQ. LENGTH
EL	EQU	6	EFF. LENGTH
BL	EQU	14	LENGTH ITEM ADDRESS 
	EJECT
				
				
********* 
*  T:D  * 
********* 
FCD	EQU	0	DISPLACEMENT TO FCB IN T:A
T:DTID	EQU	2	TASK IDENTIFIER (PROTOTYPE)
DATLEN	EQU	4	NUMBER OF DATASETS (DSCB'S)
WATLEN	EQU	6	NUMBER OF WATELEMENTS
TWBMSK	EQU	8	MASK FOR TWB'S (ONE BIT/ENTRY) 
SWBMSK	EQU	10	MASK FOR SWB'S      -"- 
CWBMSK	EQU	12	MASK FOR CWB'S      -"- 
UWBMSK	EQU	14	MASK FOR UWB'S      -"- 
DWBFST	EQU	16	FIRST WORD IN DBLK-TAB

STPREC	EQU	4	RECORD LENGTH OF START-POINTS


****************
* 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 
	EJECT
********************* 
*  OTHER CONSTANTS  * 
********************* 
			 
WBLEN	EQU	-4	LENGTH OF WORK-BLOCK 
DTLEN	EQU	-2	LENGTH OF DESCRIPTOR-TABLE 
SWBLEN	EQU	4	DISP TO LENGTH OF SWB
			 
FCBDD1	EQU	8	DISP TO FIRST DSET 
FCBDD2	EQU	10	DISP TO 2:ND DSET 
			 
STKSZ	EQU	128	DEFAULT STACK-SIZE
			 
CREID	EQU	2	CREDIT IDENTIFICATION 
SEGREC	EQU	6	RECORD LENGTH IN S:GTAB
NUMSEG	EQU	10	DISPL. TO NUMBER OF SEGMENTS IN S:GTAB

TTBTID	EQU	2	TID IN TTAB
T:DSAV	EQU	0	SAVE FOR T:D-ADDRESS 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
			 
***************************************************************** 
*  CALL-FORMAT, PERFORMS:  CFR      A14,A13                     * 
*                          DATA     [REL-ADDRESS]               * 
*                                                               * 
***************************************************************** 
			 
			 
			 
CALL	FORM	16=/F697,16 
	EJECT
				
**************************************************
**************************************************
**                                              **
**  RELOCATION ROUTINE & STACK INITIALLISATION  **
**                                              **
**************************************************
**************************************************
			 
REL	RF	SUBBA	JUMP TO SUBROUTINE HANDLER 
	LDR	A13,P	GET BASE ADDRESS TO A13
	SUKL	A13,4 
* ADJUST FOR PSW-ROUTINE *
**************************
	LDK	A3,GETPSW	RELATIVE ADDRESS TO 'PSWSW-ADDRESS'
	ADR	A3,A13	ABSOLUT DITO
	ST	A3,PSW,A13	STORE ADDRESS TO 'GETPSW'-ROUTINE
* LOAD STACKBASE *
******************

	LDKL	A14,STACKB
	ADR	A14,A13	RELOCATE 
	RTN	A8 
				
				
* STACK * 
********* 
* 
	RES	12 
STACKB	EQU	*-REL-2
	EJECT
			 
				
* ADDRESS TO PSW-ROUTINE *
**************************
* 
PSW	EQU	*-REL 
	DATA	GETPSW
			 
****************************************************************
*                        G E T P S W                           *
* LITTLE SUBROUTINE TO PUT PSW IN STACK FOR CALLING SUBROUTINE *
****************************************************************
			 
GETPSW	EQU	*-REL
	STR	A2,A14	SAVE A2 ON A14-STACK
	LD	A2,2,A14	GET PSW FROM CALLING SUBROUTINE
	ST	A2,6,A14	REPLACE PSW FROM MAIN PROGRAM
	LDR*	A2,A14	RESTORE A2 
	RTN	A14
	EJECT

********************************* 
*                               * 
*  SUBROUTINE-HANDLER           * 
*                               * 
********************************* 

SUBSUB	EQU	*-REL
SUBBA	ST	A10,MUL,A13	SAVE A10 
	LD*	A10,4,A14	GET SUBROUTINE REL ADDRESS 
	IM	4,A14	ADJUST RETURN ADDRESS 
	IM	4,A14 
	AD	A10,M:REL,A13	ADD FOR SYSLDM RELOCATION 
	STR	A10,A14	PUT ON STACK 
	LD	A10,MUL,A13	RESTORE A10 
	ABR*	A14 



******************************************************* 
* JUMP TO SYSLDM (FROM SYSLOD) ALWAYS VIA THIS MODULE * 
******************************************************* 

JUMP	ABL	SYSLDM 
	EJECT
				
************************************
**                                **
**  SAVE, AND COMMUNICATION AREA  **
**                                **
************************************
			 
T:ATOD	EQU	*-REL	T:ATAB 'OLD' ADDRESS 
	DATA	0 
T:ATNW	EQU	*-REL	T:ATAB 'NEW' ADDRESS 
	DATA	0 
U:BTOD	EQU	*-REL	U:BTAB OLD ADDRESS 
	DATA	0 
U:BTNW	EQU	*-REL	U:BTAB NEW ADDRESS 
	DATA	0 
S:BTOD	EQU	*-REL	S:BTAB OLD ADDRESS 
	DATA	0 
S:BTNW	EQU	*-REL	S:BTAB NEW ADDRESS 
	DATA	0 
MOVADD	EQU	*-REL	ADDRESS-CHANGE AFTER MOVE
	DATA	0 
MOVED	EQU	*-REL	INDICATOR IF BLOCK ALREDY MOVED 
	DATA	0 
ENDADD	EQU	*-REL	END-ADDRESS INDICATOR
			FOR TABLE-SCANNING 
	DATA	0 
LSTADR	EQU	*-REL	LAST ADDRESS WHEN BUILDING DATA PART 
	DATA	0 
FSTADR	EQU	*-REL	FIRST FREE ADDRESS WHEN ALLOCATING BUFFERS 
	DATA	0 
NEWAD1	EQU	*-REL	SAVE FOR W.B. ADDRESS
	DATA	0 
NEWAD2	EQU	*-REL	SAVE FORD.T. ADDRESS 
	DATA	0 
SWITCH	EQU	*-REL	D.T. INDICATOR 
	DATA	0 
FLAG	EQU	*-REL	REAL TASK DATA PROCESSING INDICATOR
	DATA	0 
UWB	EQU	*-REL	U.W.B. INDICATOR
	DATA	0 
SAVE01	EQU	*-REL	TEMPORARY SAVE 
	DATA	0 
SAVE02	EQU	*-REL
	DATA	0 
SAVE03	EQU	*-REL
	DATA	0 
SAVE04	EQU	*-REL
	DATA	0 
SAVE05	EQU	*-REL
	DATA	0 
SAVE06	EQU	*-REL
	DATA	0 
SAVE07	EQU	*-REL
	DATA	0 
SAVE08	EQU	*-REL
	DATA	0 
SAVE09	EQU	*-REL	SAVE AREAS 
	DATA	0 
SAVE10	EQU	*-REL
	DATA	0 
SAVE11	EQU	*-REL
	DATA	0 
SAVE12	EQU	*-REL
	DATA	0 
SAVE13	EQU	*-REL
	DATA	0 
SAVE22	EQU	*-REL
	DATA	0 
SAVE25	EQU	*-REL
	DATA	0 
WBADD	EQU	*-REL	W.B.-ADDRESS SAVE 
	DATA	0 
MUL	EQU	*-REL	MULTIPLICATION REGISTER 
	DATA	0 
BIT	EQU	*-REL	SAVE FOR SUPER-LOOP 
	DATA	0 
TADISP	EQU	*-REL	DISPLACEMENT IN T:A TO W.B. ADDRESS
	DATA	0 
DATEND	EQU	*-REL	END OF DDIV PROTOTYPE
	DATA	0 
MMREL1	EQU	*-REL	PHYSICALL PAGE BASE
	DATA	0 
M:REL	EQU	*-REL	RELOCATION FOR SYSLDM 
	DATA	0 
SYSBUF	EQU	*-REL
	DATA	0	TEMPORARY BUFFER START ADDRESS
BUFSIZ	EQU	*-REL	TEMP. BUFFER SIZE
	DATA	0 
MMTO	EQU	*-REL	MMTABLE ADDRESS
	DATA	0 
MMFROM	EQU	*-REL	2:ND MMTABLE ADDRESS 
	DATA	0 
FYSPAG	EQU	*-REL	LAST PHYSICALLY PAGE NUMBER
	DATA	0 
FSTPAG	EQU	*-REL
	DATA	0	FIRST FREE PAGE (PHYSICALL) 
TTAB	EQU	*-REL	CORRENT TTAB ADDRESS 
	DATA	0 
LDALEN	EQU	*-REL
	DATA	LDAEND-REL
XMSAV	EQU	*-REL 
	DATA	0,0 




********************************* 
* EQUATES FOR SYSLDM SAVE-WORDS * 
********************************* 

SAVE14	EQU	U:BTOD 
SAVE15	EQU	U:BTNW 
SAVE16	EQU	MOVADD 
SAVE17	EQU	ENDADD 
SAVE18	EQU	LSTADR 
SAVE19	EQU	FSTADR 
SAVE20	EQU	MOVED
SAVE21	EQU	NEWAD1 
SAVE23	EQU	SWITCH 
SAVE24	EQU	FLAG 
	EJECT

* MMU TABLES *


MMDDIV	EQU	*-REL	DDIV (& SYSLDA) MM-TABLE 
	IFT MMUPAG=1 
	RES	16 
	XIF

MMTAB	EQU	*-REL	WORK AREA MM-TAB
TABBE	EQU	* 
	IFT MMUPAG=1 
	DATA	0,0,0,0,0,0,0,0 
	DATA	0,0,0,0,0,0,0,0 
	XIF
MMEND	EQU	* 
TTPAG	DATA	0	LAST ENTRY (FROM BOTTOM) IN MM-TAB 

MMBEG	EQU	TABBE-* 
LSTPAG	EQU	TTPAG-*	DISPL. TO 'ENTRY-POINTER'
	EJECT
				
***                                           *** 
***      S  U  B  R  O  U  T  I  N  E  S      *** 
***  -COMMON TO ALL PARTS IN PROGRAM          *** 
***                                           *** 
************************************************* 
************************************************* 
				
				
**              E R R O R             **
**                                    **
**                                    **
**  ERROR HANDLING ROUTINE.           **
**                                    **
**  INPUT :A1=SOP-MESSAGE             **
**  OUTPUT:A2=RELATIVE CALLING ADDRESS**
**            (REG-CONTENTS IS SAVED) **
****************************************

ERROR	EQU	* 
	ST	A2,SAVE01,A13	SAVE A2 
	LD	A2,4,A14	GET CALLING ABSOLUTE ADDRESS 
	SUR	A2,A13	RELATIVE DITO 
	OTR	A1,0,SOP 
	HLT
	DATA	/6300	(DEBUGGING PURPOS)
	EJECT

**         M O V E             ** 
**                             ** 
**                             ** 
**  MOVE  BLOCKS INSIDE MEMORY ** 
**                             ** 
**  INPUT:A1=FROM-ADDRESS      ** 
**        A2=TO-ADDRESS        ** 
**        A3=LENGTH            ** 
** OUTPUT:A3=-1                ** 
**  WORK-REG: A4               ** 
********************************* 
			 
MOVE	EQU	*
MOVES	ADR	A1,A3	END OF FROM AREA
	ADR	A2,A3	END OF TO-AREA 
	LD	A4,SCTEFA	GET END OF FREE AREA
	TNM	A2,A4	EQUAL SIGN?
	RF(NN)	MOVNN	YES 
	CWR	A4,A2	COMPARE WHEN UNEQUAL SIGN
	RF	MOVCK 
MOVNN	CWR	A2,A4	COMPARE WHEN EQUAL SIGN 
MOVCK	RF(NG)	MOVE10	END OF TO-AREA<=END OF FREE AREA
	LDKL	A1,LMP3 
	CALL	ERROR	INDICATE MEMORY OVERFLOW
MOVE10	SUK	A3,1	DEC LENGTH
	RF(N)	MOVE20	ALL DONE
	SUK	A1,1 
	SUK	A2,1 
	LCR	A4,A1	GET CHARACTER
	SCR	A4,A2	STORE CHARACTER
	RB	MOVE10
MOVE20	RTN	A14
	IFT CREDIT-MMUPAG=1
	EJECT
				
				
**                M O V I N G                ** 
**                                           ** 
**                                           ** 
**  USES ROUTINE 'MOVE' ABOVE. TO-ADDRESS IS ** 
**  ASSUMED TO BE DATA-PART OF MEMORY        ** 
**  LSTADR POINTS AT LAST (HIGHEST) FREE     ** 
**  ADDRESS. LSTADR IS UPDATED AND CHECKED   ** 
**                                           ** 
**  INPUT:A3 & A1 AS IN 'MOVE'               ** 
**  OUTPUT: A2=TO-ADDRESS (LSTADR UPDATED)   ** 
**  WORK-REG: A4                             ** 
*********************************************** 
			 
MOVING	EQU	*
	LD	A2,LSTADR,A13	GET LAST ADDRESS
	SUR	A2,A3	SUB LENGTH 
	ANKL	A2,/FFFE	MAKE EVEN ADDRESS
	ST	A11,SAVE01,A13	SAVE A11 
	ST	A9,SAVE12,A13	SAVE A9 
	LDR	A11,A2 
	LD	A9,DATEND,A13	END OF PROTOTYP AREA
	CALL	CMPADR	COMPARE ADDRESSES
	RF(NL)	MOV020
MOV010	LDKL	A1,LMP3	MEMORY OVERFLOW 
	CALL	ERROR 
MOV020	LD	A9,FSTADR,A13	CHECK FIRST FREE ADDRESS
	CALL	CMPADR
	RB(L)	MOV010 
	ST	A2,LSTADR,A13	NEW ADDRESS 
	LD	A9,SAVE12,A13	RESTORE REGISTERS 
	LD	A11,SAVE01,A13
	RB	MOVES 
	XIF
	IFT CREDIT+MMUPAG=2
	EJECT

**               X M O V E                    **
**                                            **
**                                            **
**  MOVE BLOCK INSIDE MEMORY VIA MMU          **
**  TWO PHASES:-MOVE TO SYSTEM AREA (BUFBEG)  **
**             -MOVE TO USER AREA             **
**  IF 'BUFSIZ' (TEMPORARY MOVE-BUFFER) IS NOT**
**  BIG ENOUGH THE MOVE IS REPEATED           **
**                                            **
**  INPUT :A1=FROM-ADDR(MMFROM=MM-TABLE ADDR.)**
**         A2=TO-ADDRESS (MMTO=MM-TABLE ADDR.)**
**         A3=LENGTH (IN BYTES)               **
**  WORK.REGS:A4,A10                          **
************************************************

XMOVE	EQU	* 
	ST	A1,SAVE09,A13 
	ST	A1,SAVE07,A13 
	ST	A2,SAVE10,A13 
	ST	A2,SAVE08,A13 
	ST	A3,SAVE11,A13 
	ST	A9,XMSAV,A13	SAVE A9,TEMPORARY
	ST	A11,XMSAV+2,A13	SAVE A11 TEMPORARY
XMOV05	EQU	*
	LDR	A10,A3	SAVE LENGTH 
	LDK	A4,0	RESET 'NUMBER-OF-MOVE' COUNTER
	LDR	A11,A3	GET LENGTH OF AREA TO MOVE
	LD	A9,BUFSIZ,A13	GET TEMPORARY BUFFER SIZE 
	CALL	CMPADR	COMPARE
	RF(G)	SPLIT	NO! SEVERAL MOVE 
XMOV10	LDR	A3,A10	GET LENGTH
	LD	A1,SAVE09,A13	GET FROM ADDRESS
	LD	A2,SYSBUF,A13	GET TEMP. BUFFER START-ADDRESS
	TL*	MMFROM,A13	LOAD FROM-TABLE 
	MVUS	A3	MOVE DATA-BLOCK TO TEMP. BUFFER
	ST	A1,SAVE09,A13	SAVE END OF 'FROM' ADDRESS
	LD	A1,SYSBUF,A13 
	LD	A2,SAVE08,A13	GET START OF 'TO' ADDRESS 
	LDR	A3,A10	GET LENGTH
	TL*	MMTO,A13	LOAD TO-TABLE 
	MVSU	A3	MOVE DATA-BLOCK FROM BUFFER
	SUK	A4,1	MORE PARTS TO MOVE? 
	RF(N)	XMOV30	NO! 
	ADR	A2,A10 
	ST	A2,SAVE08,A13	SAVE START OF 'TO' ADDRESS
	LD	A3,SAVE11,A13	GET REQUESTED LENGTH
	SUR	A3,A10	SUBTRACT MOVED PART 
	ST	A3,SAVE11,A13	SAVE
	CWR	A3,A10 
	RB(NL)	XMOV10
	LDR	A10,A3	LAST LENGTH 
	RB	XMOV10
	EJECT

SPLIT	EQU	* 
	LDK	A1,0	RESET DIVISION REG
	LDR	A2,A3	GET DIVISOR
	DV	BUFSIZ,A13	AND DIVIDE 
	LDR	A4,A2	GET QUOTIENT (=NUMBER OF MOVES - 1)
	LD	A10,BUFSIZ,A13	MOVE MAX LENGTH
	RB	XMOV10

XMOV30	LD	A2,SAVE10,A13	RESTORE 'TO-ADDRESS'
	LD	A1,SAVE07,A13	RESTORE 'FROM-ADDRESS'
	LD	A9,XMSAV,A13	RESTORE A9 
	LD	A11,XMSAV+2,A13	RESTORE A11 
	RTN	A14
	EJECT

**                M O V I N G                ** 
**                                           ** 
**                                           ** 
**  USES SUBROUTINE 'XMOVE' TO MOVE A BLOCK  ** 
**  VIA TWO MM-TABLES.PHYSICALL TO-ADDRESS   ** 
**  IS ALWAYS ASSUMED TO BE DATA PART OF     ** 
**  MEMORY. LSTADR & FYSPAG POINTS AT LAST   ** 
**  (HIGHEST) FREE ADDRESS. LSTADR &FYSPAG   ** 
**  IS UPDATED AND CHECKED.                  ** 
**                                           ** 
**  INPUT :A1 & A3 AS IN 'XMOVE'             ** 
**         TTAB=POINTER TO TTAB (OR LIKELY)  ** 
**  OUTPUT:A2=LOGICALL TO-ADDRESS            ** 
**  WORK-REGS: A4,A10                        ** 
*********************************************** 

MOVING	EQU	*
	ST	A11,SAVE01,A13	SAVE A11 
	ST	A9,SAVE12,A13	SAVE A9 
	LD	A4,FYSPAG,A13	GET ACT. PHYSICALL PAGE 
	LD	A10,TTAB,A13	LOAD TTAB-ADDRESS
	LD	A2,LSTPAG,A10	GET LAST TABLE-ENTRY IN TTAB
	LDR*	A9,A2	GET PAGE IN TABLE 
	ANKL	A9,/FC00
	CWR	A9,A4	CORRECT PAGE IN MMU-TABLE? 
	RF(E)	MOV010	YES!
	ADKL	A4,/400	ADJUST FOR 'SETTAB' 
	CALL	SETTAB	NEW PAGE IN TABLE! 
MOV010	LD	A11,LSTADR,A13	GET LAST LOGICALL ADDRESS
	ANKL	A11,/FFF
	LDR	A9,A3	GET LENGTH OF AREA TO MOVE 
	CALL	CMPADR	ENOUGTH SPACE IN CURRENT PAGE? 
	RF(NL)	MOV020	YES
	SUR	A11,A3	COMPUTE DISPLACEMENT WITHIN PAGE
MOV015	RF(NP)	MOV025	 
	CALL	SETTAB	INITIALIZE NEW PAGE ENTRY
	ADKL	A11,4096	PHYSICAL PAGE INCREMENT
	RB	MOV015
MOV020	SUR	A11,A3	COMPUTE DISPLACEMENT WITHIN PAGE
MOV025	RF(NN)	MOV050
MOV030	CALL	SETTAB	NEW PAGE IN TABLE! 
	ADKL	A11,4096	NEW PAGE INCREMENT 
	RB(N)	MOV030	NOT ENOUGH. NEW PAGE! 

* MM-TABLE CORRECT. SAVE ADDRESSES *

* A4=PHYSICALL PAGE NUMBER
* A11=DISPLACEM. WITHIN PAGE
* A2=CURRENT ENTRY IN MM-TABLE

MOV050	EQU	*
	ST	A2,LSTPAG,A10	SAVE MMU-ENTRY IN TTAB
	ST	A4,FYSPAG,A13	SAVE PHYSICALL PAGE NUMBER
	LDKL	A4,MMBEG	CALCULATE TABLE ENTRY DISPLACEM. 
	ADR	A4,A10	ABSOLUTE ENTRY ADDRESS
	ST	A4,MMTO,A13	SAVE TABLE ADDRESS
	SUR	A2,A4	RELATIVE ADDRESS 
	SLL	A2,11	SHIFT TO FOUR FIRST BITS & DIV BY 2
	ORR	A2,A11	GET DISPLACEM. WITHIN PAGE
	ANKL	A2,/FFFE	EVEN ADDRESS 
	ST	A2,LSTADR,A13	SAVE LOGICALL ADDRESS 
* CHECK ADDRESSES * 

	LD	A9,FSTPAG,A13	GET FIRST FREE PAGE 
	ST	A11,SAVE07,A13	SAVE A11 
	LD	A11,FYSPAG,A13
	CALL	CMPADR	AND COMPARE
	RF(G)	MOV090	OK! 
	RF(L)	MOV070	NOK!
	LD	A11,SAVE07,A13	RESTORE DISPL. 
	LD	A9,FSTADR,A13 
	CALL	CMPADR
	RF(NL)	MOV090	OK!
MOV070	LDKL	A1,LMP3 
	CALL	ERROR 
MOV090	EQU	*
	CALL	XMOVE	MOVE
	LD	A9,SAVE12,A13 
	LD	A11,SAVE01,A13	RESTORE REGISTERS
	TL*	MMFROM,A13	RESTORE MM-TABLE
	RTN	A14
	EJECT

**               S E T T A B                   ** 
**                                             ** 
**                                             ** 
**  SET NEW PAGE IN MM-TABLE & CHECK IF TABLE  ** 
**  OVERFLOW.                                  ** 
**                                             ** 
**  INPUT :A2-ADDRESS TO CURRENT ENTRY         ** 
**         A4=PHYSICALL PAGE                   ** 
**  OUTPUT:A2 & A4 IS UPDATED                  ** 
**   WORK.REG: A9                              ** 
************************************************* 

SETTAB	EQU	*
	SUKL	A4,/400	GET NEXT PAGE 
	SUK	A2,2	GET NEXT ENTRY

* CHECK IF MM-TABLE OVERFLOW *

	LDR	A9,A10	GET END-ADDRESS A10=TTAB
	ADKL	A9,MMBEG
	TNM	A2,A9	32-KB BOARDER CHECK
	RF(NN)	SETT00
	CWR	A9,A2
	RF	SETT05
SETT00	CWR	A2,A9	OVERFLOW?
SETT05	RF(NL)	SETT10	NO 
	LDK	A1,LMP7
	CALL	ERROR 
SETT10	EQU	*
	STR	A4,A2	STORE IN TABLE 
	RTN	A14
	XIF
	IFF CREDIT=0 
	EJECT
			 
**              G E T W B                    ** 
**                                           ** 
**                                           ** 
**  GET WORK BLOCK ADDRESS AND DISPLACE-     ** 
**  MENT IN T:A                              ** 
**                                           ** 
**  INPUT : A8= POINTER TO T:A-ADD IN T:ATAB ** 
**          BIT=BIT NUMBER SAT IN MASK (0-15)** 
**  OUTPUT: A4=W.B. DISPLACEMENT IN T:A      ** 
**          TADISP=A4                        ** 
**          A11=W.B.-ADDRESS                 ** 
**          WBADD=POINTER TO W.B.-ADD IN T:A ** 
*********************************************** 
			 
GETWB	EQU	* 
	LD	A4,BIT,A13	GET BIT NUMBER 
	SLL	A4,2	ADJUST FOR ADDRESSING 
	ADK	A4,WATFST+2
	ST	A4,TADISP,A13	SAVE DISPLACEMENT 
	IFT CREDIT-MMUPAG=1
	LDR*	A11,A8	GET T:A-ADDRESS
	ADR	A11,A4	ADD DISPLACEMENT
	ST	A11,WBADD,A13	SAVE
	LDR*	A11,A11	GET W.B.-ADDRESS
	XIF
	IFT CREDIT+MMUPAG=2
	LD	A11,FLAG,A13	REAL TASK-DATA PROCESSING? 
	RF(Z)	GETW10	NO! 
	TL*	MMTO,A13	LOAD TO-TABLE 
GETW10	ELR	A11,A8	GET T:A-ADDRESS 
	ADR	A11,A4	ADD DISPLACEMENT
	ST	A11,WBADD,A13	SAVE
	ELR	A11,A11	GET W.B.-ADDRESS 
	TL*	MMFROM,A13	RELOAD FROM-TABLE 
	XIF
	IFF CREDIT=0 
	RTN	A14
	EJECT
				
				
**              M O V W B                         **
**                                                **
**                                                **
**  MOVE WORK-BLOCK. W.B.-ADDRESS IS UPDATED      **
**                                                **
**  INPUT: A11=W.B.-ADDRESS                       **
** OUTPUT: 'WBADD'=POINTER TO MOVED W.B.ADDRESS   **
**  WORK-REGS: A1-A4                              **
****************************************************
			 
MOVWB	EQU	* 
	LDR	A1,A11	GET ADDRESS 
	ADKL	A1,WBLEN	FROM-ADDRESS 
	IFT CREDIT-MMUPAG=1
	LDR*	A3,A1	LENGTH
	CALL	MOVING
	SUKL	A2,WBLEN	ADJUST TO-ADDRESS FOR DISPLACEMENT 
	ST*	A2,WBADD,A13	UPDATE W.B.-ADDRESS AFTER MOVE
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A3,A1	LENGTH 
	CALL	MOVING
	SUKL	A2,WBLEN	ADJUST TO-ADDRESS FOR DISPLACEMENT 
	LD	A4,FLAG,A13	REAL DATA-PART PROCESSING?
	RF(Z)	MOVW10	NO! 
	TL*	MMTO,A13	LOAD TO-TABLE 
MOVW10	ES*	A2,WBADD,A13	UPDATE W.B.-ADDRESS AFTER MOVE
	TL*	MMFROM,A13	RELOAD FROM-TABLE 
	XIF
	IFF CREDIT=0 
	RTN	A14
	EJECT
				
				
**               M O V D T                         ** 
**                                                 ** 
**                                                 ** 
**  MOVE DISCRIPTOR TABLE. D.T.-ADDRESS IS UPDATED ** 
**                                                 ** 
**  INPUT :WBADD POINTS TO W.B.-ADDRESS IN T:A     ** 
**  OUTPUT: A3=POINTER TO W.B.-ADDRESS             ** 
**  WORK REGS: A1-A4                               ** 
***************************************************** 
			 
MOVDT	EQU	* 
	LD	A1,WBADD,A13	GET POINTER TO W.B-ADDRESS IN WAT
	SUK	A1,2	POINTER TO D.T.-ADDRESS 
	IFT CREDIT-MMUPAG=1
	LDR*	A1,A1	D.T.-ADDRESS
	ADKL	A1,DTLEN	ADJUST FOR LENGTH WORD 
	AD	A1,MOVADD,A13	RELOCATE
	LDR*	A3,A1	LENGTH
	CALL	MOVING
	LD	A3,WBADD,A13
	SUKL	A2,DTLEN
	SUKL	A1,DTLEN
	ST	A2,-2,A3	UPDATE D.T-ADDRESS. A2=NEW ADDRESS 
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A1,A1	D.T.-ADDRESS 
	ADKL	A1,DTLEN	ADJUST FOR LENGTH WORD 
	AD	A1,MOVADD,A13	RELOCATE
	ELR	A3,A1	LENGTH 
	CALL	MOVING
	LD	A3,WBADD,A13
	SUKL	A2,DTLEN
	SUKL	A1,DTLEN
	ES	A2,-2,A3	UPDATE D.T-ADDRESS. A2=NEW ADDRESS 
	XIF
	IFF CREDIT=0 
	RTN	A14
	EJECT
				
**                    M O V D W B                     **
**                                                    **
**                                                    **
**  SEARCH T:D FOR DUMMY W.B. IF ANY FOUND, MOVE D.T. **
**  AND UPDATE ADDRESSES (W.B. & D.T.)                **
**                                                    **
**  INPUT : A12=T:D-ADDRESS                           **
**          A8= POINTER TO T:A-ADDRESS                **
**          BIT=BIT NUMBER SAT IN DWBMSK ( 0-15 )     **
**  WORK.REGS: A1-A4                                  **
********************************************************
			 
MOVDWB	EQU	*
	ST	A6,SAVE05,A13	SAVE A5 
	LDK	A6,0 
MOVD10	LD	A4,BIT,A13	GET BIT NUMBER 
	ADK	A4,1	FIRST WAT-ELEMENT =1
	IFT CREDIT-MMUPAG=1
	LD	A2,WATLEN,A12 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A2,WATLEN,A12 
	XIF
	IFF CREDIT=0 
	SUR	A2,A6	ACTUAL TABLE LENGTH
	ADR	A6,A12	A6=TABLE POINTER
MOVD20	ADK	A6,1	A6=TABLE INDEX
	SUK	A2,1	ALL?
	RF(N)	MOVD60	YES!
	IFT CREDIT-MMUPAG=1
	CC	A4,DWBFST,A6	SHARED W.B.? 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A10,DWBFST,A6	CHECK IF SHARED W.B.
	SRC	A6,1	RIGHT OR LEFT BYTE? 
	RF(N)	MOVD30	RIGHT!
	ANKL	A10,/FF00 
	ECR	A10,A10
	RF	MOVD40
MOVD30	ANKL	A10,/FF 
MOVD40	SLC	A6,1	ADJUST POINTER
	CWR	A4,A10	SHARED W.B.?
	XIF
	IFF CREDIT=0 
	RB(NE)	MOVD20	NO!
* DWB FOUND * 
	NGR	A4,A2	CALCULATE DISPLACEMENT IN T:A
	IFT CREDIT-MMUPAG=1
	AD	A4,WATLEN,A12 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A10,WATLEN,A12
	ADR	A4,A10 
	XIF
	IFF CREDIT=0 
	LDR	A6,A4	SAVE TABLE INDEX 
	SUK	A4,1 
	SLL	A4,2 
	ADK	A4,WATFST+2
	LD	A3,NEWAD2,A13	GET NEW W.B.-ADDRESS
	IFT CREDIT-MMUPAG=1
	ADR*	A4,A8	A4=POINTER TO W.B.-ADDRESS IN T:A 
	STR	A3,A4	CHANGE W.B.-ADDRESS
	XIF
	IFT CREDIT+MMUPAG=2
	LD	A2,FLAG,A13	REAL DATA-PART PROCESSING?
	RF(Z)	MOVD50	NO! 
	TL*	MMTO,A13	LOAD TO-TABLE 
MOVD50	EQU	*
	ELR	A10,A8	A4=POINTER TO W.B.-ADDR IN T:A
	ADR	A4,A10 
	ESR	A3,A4	CHANGE W.B.-ADDRESS
	TL*	MMFROM,A13	RELOAD FROM-TABLE 
	XIF
	IFF CREDIT=0 
	ST	A4,WBADD,A13
	LD	A2,SWITCH,A13	WB-ADDRESS CHANGE ONLY? 
	RB(NZ)	MOVD10	YES! 
	CALL	MOVDT	MOVE D.T. 
	RB	MOVD10
MOVD60	EQU	*
	LD	A6,SAVE05,A13	RESTORE A6
	RTN	A14
	EJECT


**              T W B S W B                   **
**                                            **
**  COPY TWB'S AND RESERVE SPACE FOR SWB'S    **
**                                            **
**  INPUT : A8=ACTUAL T:A-ADDRESS             **
**          A12=T:D-ADDRESS                   **
**  WORK-REGS: A1-A4,   A11                   **
************************************************

TWBSWB	EQU	*
	ST	A7,SAVE04,A13	SAVE A7 
	LD	A7,TWBMSK,A12	GET TWB MASK
	IFT CREDIT+MMUPAG=2
	EL	A7,TWBMSK,A12	GET TWB MASK
	XIF
	IFF CREDIT=0 
	CALL	SHIFT 
TWSW10	RF(Z)	TWSW20	ALL DONE! 
	CALL	GETWB 
	CALL	MOVWB 
	ST	A2,NEWAD2,A13	SAVE NEW WB-ADDRESS 
	CALL	MOVDWB	CHANGE DWB-ADDRESSES 
	CALL	SKIFTA
	RB	TWSW10
TWSW20	EQU	*
	IFT	CREDIT+SWPBLK=2
	EJECT
				
				
* RESERVE SPACE FOR SWB'S * 
*************************** 
	XIF
	IFT	CREDIT+SWBMMU=2
	LD	A7,SWBMSK,A12 
	XIF
	IFT	CREDIT+MMUSWB=3
	EL	A7,SWBMSK,A12 
	XIF
	IFT	CREDIT+SWPBLK=2
	CALL	SHIFT 
TWSW30	RF(Z)	TARZAN	ALL DONE
	CALL	GETWB 
	CALL	MOVWB	RESERVE SPACE 
	ST	A2,NEWAD2,A13	SAVE W.B.-ADDRESS 
	CALL	MOVDWB	CHANGE DWB- ADDRESSES
	CALL	SKIFTA
	RB	TWSW30
TARZAN	EQU	*
	XIF
	IFT	CREDIT=1 
	LD	A7,SAVE04,A13	RESTORE A7
	RTN	A14
	EJECT


**                A L L B U F                 **
**                                            **
**  ALLOCATE FIXED DATA SET BUFFERS AND       **
**  TERMINAL STACK                            **
**                                            **
**  INPUT : A8=ACTUAL T:A-ADDRESS IN T:ATAB   **
**          A12=T:D-ADDRESS                   **
**          CSN (IN T:A)=LENGTH OF DSCB'S     **
**          CIA (IN T:A)=DISPL. TO T:A-START  **
**          CSE (IN T:A)=STACKSIZE            **
**  WORK-REGS. :A1-A4,A9,A11                  **
************************************************

ALLBUF	EQU	*
	IFT CREDIT-MMUPAG=1
	LD	A9,FSTADR,A13	GET BUFFER START ADDRESS
	LDR*	A1,A8	GET T:A-ADDRESS 
	LD	A3,CSN,A1	GET DSCB TOTAL LENGTH 
	RF(Z)	ALLB70	NO DSCB'S 
	ADKL	A1,T:ASTA	CALC START OF DSCB RECORDS
	LDR	A10,A1	SAVE START ADDRESS
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A1,A8	GET T:A-ADDRESS
	EL	A3,CSN,A1	GET DSCB TOTAL LENGTH 
	RF(Z)	ALLB70	NO DSCB 
	ADKL	A1,T:ASTA	CALCULATE START OF DSCB'S 
	LDR	A10,A1	SAVE START ADDRESS
	XIF
	IFF CREDIT=0 
	SUR	A3,A1
	NGR	A3,A3
	SUK	A3,DSCBL	END CONDITION 
	ST	A3,SAVE04,A13	SAVE ADDRESS TO END OF DSCB-RECORDS 
ALLB10	SUK	A1,DSCBL	A1=FIRST WORD IN FIRST DSCB-RECORD
	CW	A1,SAVE04,A13	ALL?
	RF(E)	ALLB70	YES!
	IFT CREDIT-MMUPAG=1
	LDR*	A3,A1	GET FIRST WORD IN ECB 
	SLL	A3,1	STATIC BUFFER?
	RB(NN)	ALLB10	NO!
	ST	A9,BA,A1	BUFFER START 
	LD	A3,RL,A1	BUFFER LENGTH
	ST	A3,BL,A1
	LD	A2,EL,A1	SHARED BUFFER? 
	RF(Z)	NOTSH	NO!
	LDR	A4,A1	RESTORE START OF DSCB'S
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A3,A1	GET FIRST WORD IN ECB
	SLL	A3,1	STATIC BUFFER?
	RB(NN)	ALLB10	NO!
	EL	A3,RL,A1	BUFFER LENGTH
	ES	A3,BL,A1
	EL	A2,EL,A1	SHARED BUFFER? 
	RF(Z)	NOTSH	NO!
	LDR	A4,A1	RESTORE START OF DSCB'S
	XIF
	IFF CREDIT=0 
	ADK	A4,DSCBL	FIRST WORD
ALLB20	SUK	A2,1	A2=INDEX
	RF(NN)	ALLB30
	LDK	A1,LMP4	FORMAT ERROR 
	CALL	ERROR 
ALLB30	EQU	*
	RF(Z)	ALLB40	ECB FOUND 
	ADK	A4,DSCBL	A4=ADDRESS TO DSCB TO EXAMINE 
	CWR	A4,A10 
	RB(NE)	ALLB20
	LDK	A1,LMP4	BUFFER NOT FOUND 
	CALL	ERROR 
	IFT CREDIT-MMUPAG=1
ALLB40	LD	A4,BA,A4	BUFFER ALLOCATED?
	RF(NZ)	ALLB50	YES! 
	LDK	A1,LMP4	FORMAT ERROR 
	CALL	ERROR 
ALLB50	EQU	*
	ST	A4,BA,A1	AND STORE IN CURRENT ECB 
	XIF
	IFT CREDIT+MMUPAG=2
ALLB40	EL	A4,BA,A4	BUFFER ALLOCATED?
	RF(NZ)	ALLB50	YES! 
	LDK	A1,LMP4	FORMAT ERROR 
	CALL	ERROR 
ALLB50	EQU	*
	ES	A4,BA,A1	AND ESORE IN CURRENT ECB 
	XIF
	IFF CREDIT=0 
	RB	ALLB10

	IFT CREDIT-MMUPAG=1
NOTSH	LDR	A9,A9	PAGING? 
	RF(NZ)	NOTS10	NO!
	CALL	MOVING	ALLOCATE BUFFER FROM BOTTOM
	ST	A2,BA,A1	STORE BUFFER ADDRESS 
	RB	ALLB10
NOTS10	ADR	A9,A3	ALLOCATE BUFFER FROM TOP 
	ADKL	A9,1
	ANKL	A9,/FFFE	EVEN ADDRESS 
* CHECK ADDRESS:
			 
	LD	A11,LSTADR,A13	DATA START 
	CALL	CMPADR
	RF(NL)	ALLB60	OK!
	LDKL	A1,LMP3 
	CALL	ERROR 
ALLB60	EQU	*
	ST	A9,FSTADR,A13	SAVE BUFFER END ADDRESS 
	XIF
	IFT CREDIT+MMUPAG=2
NOTSH	CALL	MOVING	ALLOCATE BUFFER FROM 'BOTTOM' 
	ES	A2,BA,A1	STORE BUFFER ADDRESS 
	XIF
	IFF CREDIT=0 
	RB	ALLB10
				
* RESERVE STACK AND SET STACKPOINTERS * 

ALLB70	EQU	*
	IFT CREDIT-MMUPAG=1
	LDR*	A1,A8	GET T:A-ADDRESS 
	LD	A4,LSTADR,A13 
	SUK	A4,2 
	LD	A3,CSE,A1	GET STACK SIZE
	RF(NZ)	ALLB80
	LDK	A3,STKSZ	DEFAULT STACKSIZE 
ALLB80	EQU	*
	ST	A4,STKB,A1	SET STACKBASE
	STR	A4,A1	STACK POINTER
	CALL	MOVING	ALLOCATE STACK 
	ST	A2,STKE,A1	SET STACK-END
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A1,A8	GET T:A-ADDRESS
	EL	A3,CSE,A1	GET STACK SIZE
	RF(NZ)	ALLB80	USER DEFINED STACK SIZE
	LDK	A3,STKSZ	DEFAULT STACK SIZE
ALLB80	ES	A3,STKB,A1	SAVE STACK SIZE
	CALL	MOVING	ALLOCATE STACK 
	ES	A2,STKE,A1	STORE STACK END
	EL	A3,STKB,A1	GET STACK SIZE 
	ADR	A2,A3	COMPUTE STACK BASE 
	ES	A2,STKB,A1	STORE STACK BASE 
	ESR	A2,A1	STORE CURRENT STACK POINTER
	XIF
	IFF CREDIT=0 
	RTN	A14
	EJECT

**              M O V T : A                   **
**                                            **
**  MOVE T:A AND UPDATE DATA SET ADDRESSES IN **
**  FORMAT CONTROL BLOCK                      **
**                                            **
**  INPUT : A8=T:A-ADDRESS                    **
**          A12=T:D-ADDRESS                   **
**          CIA (IN T:A)=DISL. TO T:A-START   **
**  OUTPUT: A2=NEW T:A-ADDRESS                **
**  WORKREGS: A1-A4                           **
************************************************

MOVT:A	EQU	*
	IFT CREDIT-MMUPAG=1
	LDR*	A1,A8	GET T:A-ADDRESS 
	LD	A3,WATLEN,A12	GET LENGTH OF WAT 
	SLL	A3,2	BYTES 
	SU	A3,CIA,A1	ADD DISPLACEMENT TO START 
	ADK	A3,WATFST	A3=LENGTH
	AD	A1,CIA,A1	FROM-ADDRESS
	CALL	MOVING
	LDR*	A4,A8 
	SU	A2,CIA,A4	NEW T:A-ADDRESS 
	SU	A1,CIA,A4	'OLD' T:A-ADDRESS 

* COMPUTE AND STORE ADDRESSES TO DATA-SETS IN FCB * 

	LD	A3,FCD,A12	ANY FCD? 
	RF(Z)	MOVT10	NO! 
	ADR	A3,A2	START OF FCB 
	LDR	A4,A2	SAVE T:A-ADDRESS 
	LD	A10,FLAG,A13	REAL TASK DATA PROCESSING? 
	RF(Z)	MOVT05	NO! 
	SUR	A4,A1	ADJUST FOR OLD RELOCATION (OLD T:A-ADDRESS)
MOVT05	EQU	*
	ADS	A4,FCBDD1,A3 
	ADS	A4,FCBDD2,A3 
MOVT10	RTN	A14
	XIF
	IFT CREDIT+MMUPAG=2

	ELR	A1,A8	GET T:A-ADDRESS
	EL	A3,WATLEN,A12	GET LENGTH OF WAT 
	SLL	A3,2	BYTES 
	EL	A10,CIA,A1
	SUR	A3,A10	ADD DISPL. TO START 
	ADK	A3,WATFST	A3=LENGTH
	ADR	A1,A10	FROM-ADDRESS
	CALL	MOVING
	ELR	A4,A8
	EL	A10,CIA,A4
	SUR	A2,A10	NEW T:A-ADDRESS 
	SUR	A1,A10	'OLD' T:A-ADDRESS 
* COMPUTE AND STORE ADDRESSES TO DATA-SETS IN FCB * 

	EL	A3,FCD,A12	ANY FCD? 
	RF(Z)	MOVT10	NO! 
	LDR	A4,A2	GET T:A-ADDRESS
	LD	A10,FLAG,A13	REAL TASK DATA PROCESSING? 
	RF(Z)	MOVT05	NO! 
	SUR	A4,A1	ADJUST FOR OLD RELOCATION (OLD T:A-ADDR.)
MOVT05	EQU	*
	ADR	A3,A2	START OF FCB 
	TL*	MMTO,13	LOAD TO-TABLE
	EL	A10,FCBDD1,A3 
	ADR	A10,A4 
	ES	A10,FCBDD1,A3 
	EL	A10,FCBDD2,A3 
	ADR	A10,A4 
	ES	A10,FCBDD2,A3 
	TL*	MMFROM,A13	RELOAD FROM-TABLE 
MOVT10	RTN	A14
	XIF
	EJECT



**                 C M P A D R                  **
**                                              **
**                                              **
**  COMPARE ADDRESSES. RESULT IN PSW ON RETURN  **
**                                              **
**  INPUT : A11 COMPARED TO..                   **
**          A9                                  **
**  OUTPUT: RESULT IN A14-STACK                 **
**************************************************
			 
CMPADR	EQU	*
	TNM	A11,A9 
	RF(NN)	CMPA10
	CWR	A9,A11 
	RF	CMPA20
CMPA10	CWR	A11,A9 
CMPA20	CFI	A14,PSW,A13	PUT RESULT ON STACK
	RTN	A14
	IFF CREDIT=0 
	EJECT
*************************************************************** 
*                                                             * 
*  ICBMVD - INDICATE CURRENT BLOCK MOVED                      * 
*  =====================================                      * 
*                                                             * 
*  REFERENCED IN:  MOVCOM                                     * 
*                                                             * 
*  ENTRY:  A8 - FIRST T:A POINTER                             * 
*          A6 - SECOND T:A POINTER                            * 
*         BIT - BIT NUMBER SET IN CWB- OR UWB-MASK            * 
*                                                             * 
*  EXIT:  CORRESPONDING BIT IN CURRENT STATCK POINTER         * 
*         IN T:A IS SET                                       * 
*                                                             * 
*  WORK REGISTERS:  A1,A2                                     * 
*                                                             * 
*  SUBROUTINES:                                               * 
*                                                             * 
*************************************************************** 
	EJECT
ICBMVD	EQU	*
	LDKL	A1,/8000	SET BIT 0
	LD	A2,BIT,A13	GET BIT NUMBER IN CWB- OR UWB-MASK 
IBAM10	RF(Z)	IBAM20	BIT FOUND 
	SRL	A1,1	SHIFT BIT RIGHT ONE STEP
	SUK	A2,1	DECREMENT BIT COUNTER 
	RB	IBAM10
* 
*  UPDATE MOVED MASK IN FIRST T:A 
* 
	XIF
	IFT	CREDIT-MMUPAG=1
IBAM20	LDR*	A2,A8	GET T:A POINTER 
	LDR*	A3,A2	GET MOVED BLOCK MASK
	ORR	A3,A1	INDICATE CURRENT BLOCK MOVED 
	STR	A3,A2	STORE NEW MOVED BLOCK MASK 
* 
*  UPDATE MOVED MASK IN SECOND T:A
* 
	LDR*	A2,A6	GET T:A POINTER 
	LDR*	A3,A2	GET MOVED BLOCK MASK
	ORR	A3,A1	INDICATE CURRENT BLOCK MOVED 
	STR	A3,A2	STORE NEW MOVED BLOCK MASK 
	XIF
	IFT	CREDIT+MMUPAG=2
IBAM20	ELR	A2,A8	GET T:A POINTER
	ELR	A3,A2	GET MOVED BLOCK MASK 
	ORR	A3,A1	INDICATE CURRENT BLOCK MOVED 
	ESR	A3,A2	STORE NEW MOVED BLOCK MASK 
* 
*  UPDATE MOVED MASK IN SECOND T:A
* 
	ELR	A2,A6	GET T:A POINTER
	ELR	A3,A2	GET MOVED BLOCK MASK 
	ORR	A3,A1	INDICATE CURRENT BLOCK MOVED 
	ESR	A3,A2	STORE NEW MOVED BLOCK MASK 
	XIF
	IFF	CREDIT=0 
	RTN	A14
	EJECT
********************************************************************* 
*                                                                   * 
*               CHKMVD - CHECK IF BLOCK ALREADY MOVED               * 
*               =====================================               * 
*                                                                   * 
*  REFERENCED IN:  MOVCOM,MOVCLA                                    * 
*                                                                   * 
*  ENTRY:  A8 - POINTER TO T:A                                      * 
*         BIT - BIT NUMBER IN CWB- OR UWB-MASK                      * 
*                                                                   * 
*  EXIT:  IF BLOCK ALREADY MOVED THEN CR=2 ELSE CR<>2               * 
*                                                                   * 
*  WORK REGISTER:  A1,A2                                            * 
*                                                                   * 
*  SUBROUTINES:                                                     * 
*                                                                   * 
********************************************************************* 
	EJECT
CHKMVD	EQU	*
	IFT	CREDIT-MMUPAG=1
	LDR*	A1,A8	GET T:A POINTER 
	LDR*	A1,A1	GET MOVED BLOCK MASK
	XIF
	IFT	CREDIT+MMUPAG=2
	ELR	A1,A8	GET T:A POINTER
	ELR	A1,A1	GET MOVED BLOCK MASK 
	XIF
	IFF	CREDIT=0 
	LD	A2,BIT,A13	GET BIT SET IN CWB- OR UWB-MASK
CHKM10	RF(Z)	CHKM20	BIT IN MOVED BLOCK MASK FOUND 
	SLL	A1,1	NEXT BIT IN MOVED BLOCK MASK
	SUK	A2,1	DECREMENT BIT COUNTER 
	RB	CHKM10
CHKM20	ADK	A1,0	SET CR
	CFI	A14,PSW,A13	PUT CONDITION IN PSW 
	RTN	A14
	EJECT
				
				
*****     S * U * P * E * R * L * O * O * P       ****
**                                                  **
**           S H I F T        &       SKIFTA        **
**                                                  **
**  CALCULATES BIT NUMBER SAT IN MASK-WORD          **
**  INPUT : A7=MASK WORD                            **
**  OUTPUT: BIT=BIT NUMBER                          **
**          CONDITION CODE IN PSW ON RETURN         **
******************************************************
			 
SHIFT	EQU	* 
	CM	BIT,A13	RESET BIT COUNTER 
	LDR	A7,A7
	RF	SHIF20
SKIFTA	EQU	*	ENTRY: CONTINUE SHIFT
SHIF10	IM	BIT,A13 
	SLL	A7,1 
SHIF20	EQU	*
	RF(Z)	SHIF30	NO MOORE BITS SAT 
	RB(NN)	SHIF10
SHIF30	CFI	A14,PSW,A13	PUT COND IN PSW
	RTN	A14
	XIF
	EJECT
				
				
**                M U L T                     **
**                                            **
**                                            **
**  MULTIPLICATION  (A2) X A3(), A2#0         **
**                                            **
**  INPUT : A3,A2                             **
**  OUTPUT:A3=RESULT                          **
************************************************
MULT	EQU	*
	ST	A3,MUL,A13
	STR	A2,A14	SAVE A2 TEMPORARY 
	LDK	A3,0 
ADD	AD	A3,MUL,A13 
	SUK	A2,1 
	RB(NZ)	ADD 
	LDR*	A2,A14
	RTN	A14

	IFT MMUPAG=1 
	EJECT

**               M M E N T                   ** 
**                                           ** 
**                                           ** 
**  FIND LAST USED ENTRY IN MM-TAB. SCAN     ** 
**  FROM LOW ADDRESS. NOT USED ENTRY=0.      ** 
**                                           ** 
**  INPUT :A3=MM-TABLE ADDRESS               ** 
**  OUTPUT:A3=ENTRY ADDRESS                  ** 
**         A9=TTAB-ADDRESS                   ** 
**         LSTPAG IN TTAB=A3                 ** 
**         A1=CONTENTS OF 1:ST USED ENTRY    ** 
*********************************************** 

MMENT	EQU	* 
	LDR	A9,A3	GET TABLE ADDRESS
	SUKL	A9,MMBEG	ADJUST A9 (LOOKS LIKE TTAB POINTER)
	SUK	A3,2 
MMEN10	ADK	A3,2	INCREMENT ADDRESS 
	LDR*	A1,A3	GET CONTENTS OF MM-TABLE
	ANKL	A1,/FC00
	CWK	A1,/FC00 
	RB(Z)	MMEN10 
	ST	A3,LSTPAG,A9	SAVE FIRST FREE PAGE-ADDRESS 
	RTN	A14
	XIF
	IFF	CREDIT=0 
	EJECT

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

GETTAB	EQU	*
	XIF
	IFT MMUPAG=0 
	LDR*	A10,A8	T:A ADDRESS
	LD	A1,T:ATID,A10	GET TID TO MATCH
	LD	A12,T:DAD,A10	T:D-ADDRESS 
	XIF
	IFT MMUPAG=1 
	ELR	A10,A8	T:A-ADDRESS 
	EL	A1,T:ATID,A10	GET TID 
	EL	A12,T:DAD,A10 
	XIF
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,TTB:PP,A2	TCL EQUAL? 
	RB(NE)	GETT10	NO!
	ST	A2,TTAB,A13	SAVE
	RTN	A14
	IFF CREDIT=0 
	EJECT


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

QUEJOB	EQU	*
* QUEUE THIS TASK (THIS TID)

	LDKL	A3,RETUR	GET RETURN (FROM A15) ADDRESS
	ADR	A3,A13	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 
	LD	A8,SCTLAC	GET P:MTAB-ADDRESS
	LDR	A5,A2	GET TTAB-ADDRESS 
	IFT CREDIT-MMUPAG=1
	LD	A4,WATLEN,A12	NUMBER OF WAT-ELEMENTS
	ADK	A4,2 
	ANKL	A4,/FFFE
	ADK	A4,DWBFST+4
	ADR	A4,A12	ADD T:A-ADDRESS => START OF START-POINTS
	LDR*	A6,A4	NUMBER OF START POINTS
GETT30	SUK	A6,1	DEC. NUMBER OF STARTPOINTS
	RF(N)	GETT40	ALL!
	LD	A1,4,A4	DISP ADDRESS
	LD	A3,2,A4	SEGMENT NUMBER
	LD	A2,NTPA,A8	INTERPRETER START ADDRESS
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A4,WATLEN,A12	NUMBER OF WAT-ELEMENTS
	ADK	A4,2 
	ANKL	A4,/FFFE
	ADK	A4,DWBFST+4
	ADR	A4,A12	ADD T:A-ADDRESS => START OF START-POINTS
	ELR	A6,A4	NUMBER OF START-POINTS 
GETT30	SUK	A6,1	DEC. NUMBER OF STARTPOINTS
	RF(N)	GETT40	ALL!
	EL	A1,4,A4	DISP ADDRESS
	EL	A3,2,A4	SEGMENT NUMBER
	EL	A2,NTPA,A8	INTERPRETER START ADDRESS
	XIF
	IFF CREDIT=0 
	CF	A15,ACTOT 
	ADK	A4,STPREC	NEXT START-POINT 
	RB	GETT30
GETT40	ABL	RETUR8	RELOAD 8 REGS 
RETUR	EQU	*-REL 
	RTN	A14
	XIF
	IFT MMUPAG=1 
	EJECT

**              M O V M M T                  ** 
**                                           ** 
**                                           ** 
**  MOVE MM-TABLE                            ** 
**                                           ** 
**  INPUT :A2=TTAB-ADDRESS                   ** 
**         MMTAB HOLDS TABLE TO MOVE         ** 
**  OUTPUT:A2=START OF MM-TABLE IN TTAB      ** 
**          A9=TTAB ADDRESS                  ** 
**  WORKREGS:A1,A3                           ** 
*********************************************** 

MOVMMT	EQU	*
	ADKL	A2,MMBEG	GET TO-TABLE ADDRESS 
	TL	MMTAB,A13	LOAD FROM-TABLE 
	TSR	A2	MOVE
	LDR	A3,A2
	CALL	MMENT	FILL LAST ENTRY ADDRESS 
	TL*	MMFROM,A13	RELOAD TABLE
	RTN	A14
	XIF
	IFF CREDIT=0 
	EJECT
************************************************************
*                                                          *
*  CHTAID - CHANGE T:A-ID AND CLEAR TCL SAVE AREA IN TTAB  *
*           SAVE REAL TID IN AUXILARY TABLE FOR DEBUGGER   *
*  ======================================================  *
*                                                          *
*                                                          *
*  REFERENCED IN:  SYSLDA  PART 2 B.                       *
*                                                          *
*  ENTRY:  A5 - POINTER TO NUMBER OF COPIES                *
*          A7 - POINTER TO NEXT FREE ENTRY IN REAL T:ATAB  *
*                                                          *
*  EXIT:                                                   *
*                                                          *
*  WORK REGISTERS: A1,A3,A6,A8                             *
*                                                          *
*  SUBROUTINES:  GETTTB                                    *
*                                                          *
************************************************************
CHTAID	EQU	*
	LDR	A8,A7	GET NEXT FREE ENTRY IN REAL T:ATAB 
	LDR*	A6,A5	GET NUMBER OF COPIES
CHT:10	RF(Z)	CHT:90	NO MOORE! 
	SUKL	A8,2	LAST USED ENTRY IN REAL T:ATAB 
	IFT	CREDIT-MMUPAG=1
	LDR*	A1,A8	GET POINTER TO REAL T:A 
	LD	A1,T:ATID,A1	GET TCL IN T:A 
CHT:20	CALL	GETTTB	GET CORRESPONDING TTAB 
	LD	A4,TTBTID,A2	GET REAL TID IN TTAB	=3
	LD	A3,TTB:SA+26,A2	GET CORRESPONDING T:A-ADDRESS 
	ST	A4,T:ATID,A3	REPLACE TCL IN T:A	=3
	LDR	A3,A8	GET REAL T:ATAB POINTER
	SU*	A3,T:ATNW,A13	COMPUTE ENTRY IN AUX. TID TABLE
	STR	A4,A3	SAVE TID FOR DEBUGGER PURPOSE	=3 
	XIF
	IFT	CREDIT+MMUPAG=2
	ELR	A1,A8	GET POINTER TO REAL T:A
	EL	A1,T:ATID,A1	GET TCL IN T:A 
CHT:20	CALL	GETTTB	GET CORRESPONDING TTAB 
	LDR	A3,A2	GET POINTER TO TTAB ENTRY
	ADKL	A3,MMBEG	START OF MM-TABLE FOR THIS TTAB
	TLR	A3 
	LD	A4,TTBTID,A2	GET REAL TID IN TTAB	=3
	LD	A3,TTB:SA+26,A2	GET CORRESPONDING T:A-ADDRESS 
	ES	A4,T:ATID,A3	REPLACE TCL IN T:A	=3
	EL*	A3,T:ATNW,A13	GET LENGTH OF REAL T:ATAB
	NGR	A3,A3	NEGATIVE DISPLACEMENT
	ADR	A3,A8	COMPUTE ENTRY IN AUX. TID TABLE
	ESR	A4,A3	SAVE TID FOR DEBUGGER PURPOSE	=3 
	XIF
	IFT	CREDIT=1 
	CM	TTB:PP,A2	CLEAR TCL SAVE AREA 
	SUK	A1,1	DECREMENT TCL 
	SUKL	A8,2	DECREMENT
	SUK	A6,1	DECREMENT NUMBER OF COPIES
	RB(P)	CHT:20	NEXT COPY 
CHT:90	RTN	A14
	EJECT


************************************************
***                                          ***
**            SYSLOAD PART 2.B                **
**                                            **
************************************************

*   BUILD REAL T:A'S. COPY T:A'S ACCORDING TO  *
*   SHADOW TABLE                               *
*                                              *
************************************************

PART2B	EQU	*-REL


REALTA	EQU	*
	LD	A5,SCTSFA	MONITOR END ADDRESS 
	LD	A8,T:ATOD,A13	T:ATAB PROTOTYP ADDRESS 
	LD	A7,T:ATNW,A13	REAL T:ATAB ADDRESS 
	ADK	A7,2 
	ST	A8,SAVE03,A13	SAVE A8 
SYA310	LD	A8,SAVE03,A13	RESTORE A8
	ADKL	A8,2
	CW	A8,ENDADD,A13	ALL?
	RF(E)	SYA350	YES!
	ST	A8,SAVE03,A13	SAVE
	ADK	A5,2	A5=SHADOW TAB POINTER 
	IFT CREDIT-MMUPAG=1
	CALL	GETTAB	GET CORRESPONDING TTAB AND QUEUE 
	CALL	QUEJOB
	ST	A10,TTB:SA+26,A2	SAVE T:A ADDR. IN TTAB (SAVE-A13)
	LDR*	A1,A8	GET T:A ADDRESS 
	STR	A1,A7	STORE IN REAL T:ATAB 
	ADK	A7,2 
	LDR*	A6,A5	GET NUMBER OF COPIES
	EJECT
SYA340	SUK	A6,1 
	RF(P)	SYA345	NEXT TASK 
	CALL	CHTAID	REPLACE TCL:S IN THIS TASK-CLASS 
	RB	SYA310	NEXT TASK-CLASS
SYA345	LD	A12,T:DAD,A1	GET T:D-ADDRESS
	CALL	MOVT:A	MOVE T:A 
	IM	T:ATID,A2	UPDATE TID
	STR	A2,A7	STORE IN REAL T:ATAB 
	LDR	A8,A7	CHANGE T:A TO COPY 
	CALL	GETTAB	GET CORRESPONDING TTAB AND QUEUE 
	CALL	QUEJOB	QUEUE THIS TASK
	ST	A10,TTB:SA+26,A2	SAVE T:A-ADDRESS IN TTAB 
	ADK	A7,2	NEXT ENTRY IN REAL T:ATAB 
	CALL	TWBSWB	MOVE TWB'S AND RESERVE FOR SWB'S 
	CALL	ALLBUF	ALLOCATE BUFFERS 
	XIF
	IFT CREDIT+MMUPAG=2
* GET ACTUAL MM-TABLE ADDRESS AND LOAD

	LDR	A1,A5
	AD*	A1,SCTSFA	ADD SHADOW-TABLE LENGTH
	LDR*	A1,A1	GET MM-TABLE ADDRESS
	TLR	A1	LOAD
	ST	A1,MMFROM,A13	SAVE ADDRESS
	CALL	GETTAB	GET CORRESPONDING TTAB 
	ST	A10,TTB:SA+26,A2	SAVE T:A ADDR. IN TTAB (SAVE-A13)
	LD	A1,T:DSAV,A2	GET CLASS-LOCAL LAST ENTRY 
	CALL	QUEJOB	QUEUE THIS TASK
	LDKL	A2,MMTAB	GET WORK TABLE ADDRESS 
	ADR	A2,A13 
	TSR	A2	SAVE CLASS-DATA TABLE 
* REMOVE TASK-LOCAL ENTRIES IN MM-TABLE 

	SUK	A2,2	START OF TABLE
	LDKL	A12,/FC00 
SYA320	SUK	A1,2	NEXT ENTRY
	CWR	A1,A2	ALL? 
	RF(E)	SYA330	YES!
	STR	A12,A1	REMOVE ENTRY
	RB	SYA320
SYA330	EQU	*
	ELR	A1,A8	GET T:A ADDRESS
	ESR	A1,A7	STORE IN REAL T:ATAB 
	EL	A12,T:DAD,A1	GET T:D ADDRESS
	EL	A1,T:ATID,A1	GET TID
	ADK	A7,2	NEXT ENTRY IN REAL T:ATAB 
	LDR*	A6,A5	GET NUMBER OF COPIES
SYA340	SUK	A6,1 
	RF(P)	SYA345	NEXT TASK 
	CALL	CHTAID	REPLACE TCL:S IN THIS TASK-CLASS 
	RB	SYA310	NEXT TASK-CLASS
SYA345	ADK	A1,1	NEXT T:A ID 
	CALL	GETTTB	FIND CORRESPONDING TTAB
	CALL	QUEJOB	QUEUE THIS TASK
	CALL	MOVMMT	MOVE MM-TABLE TO TTAB
	CALL	MOVT:A	MOVE T:A 
	ESR	A2,A7	STORE IN REAL T:ATAB 
	ST	A2,TTB:SA+26,A9	PUT T:A-ADDRESS IN TTAB. A9=TTAB ADDRESS
	LDR	A8,A7	CHANGE T:A TO COPY 
	ADK	A7,2	NEXT FREE WORD IN REAL T:ATAB 
			A2=NEW ADDRESS 
	CALL	TWBSWB	MOVE TWB'S & RESERVE FOR SWB'S 
	LD	A1,MMTO,A13	GET TO-TABLE
	ST	A1,MMFROM,A13	CHANGE T:A ADDRESS-TABLE
	TLR	A1 
	CALL	ALLBUF	ALLOCATE BUFFERS 
	LD	A1,TTAB,A13	GET TTAB-ADDRESS
	CM	LSTPAG,A1	CLEAR SAVE-AREA IN TTAB 
	ELR	A10,A8	GET T:A-ADDRESS (NEW) 
	EL	A1,T:ATID,A10	GET TID 
	ADK	A1,1	UPDATE TID
	ES	A1,T:ATID,A10	RESTORE IN T:A
	XIF
	IFF CREDIT=0 
	RB	SYA340
	XIF
	EJECT
FINISH	EQU	*-REL

* ADJUST START OF FREE AREA 

SYA350	EQU	*
	IFF	CREDIT=0 
	LD	A1,LSTADR,A13	GET END OF FREE AREA
	XIF
	IFT	CREDIT+MMUPAG=2
	ANKL	A1,/FFF 
	LD	A2,FYSPAG,A13 
	SLL	A2,2 
	ORR	A1,A2
	XIF
	IFF	CREDIT=1 
	LD	A1,SCTLAC 
	XIF
	IFT	MMUPAG-CREDIT=1
	ANKL	A1,/03FF
	SLL	A1,2 
	XIF
	ST	A1,SCTEFA+2 
	IFT	CREDIT=1 
	LD	A1,FYSPAG,A13 
	IFT	MMUPAG-CREDIT=1
	LD	A1,SCTLAC 
	XIF
	IFT	MMUPAG+CREDIT=0
	LDK	A1,0 
	XIF
	SRL	A1,14
	ST	A1,SCTEFA 
	IFT	CREDIT-MMUPAG=1
	LD	A1,FSTADR,A13	START OF FREE AREA
	RF(NZ)	SYA355
	XIF
	LD	A1,SCTSFA 
SYA355	ST	A1,SCTSFA+2 
	CM	SCTSFA
	IFT	CREDIT=1 
	EJECT
*************************************************************** 
*                                                             * 
*                 PAGGEN - BUILD PAGE TABLE                   * 
*                 =========================                   * 
*                                                             * 
*  REFERENCED IN:  SYSLDA                                     * 
*                                                             * 
*  ENTRY:  SCTSFA - START OF FREE AREA                        * 
*          SCTEFA - END OF FREE AREA                          * 
*          SCTNOS - NUMBER OF SEGMENTS                        * 
*          SCTNOP - NUMBER OF PAGES                           * 
*          SCTPSZ - PAGE SIZE                                 * 
*          SAVE22 - PHYSICAL ADDRESS TO FIRST PAGE (16 BITS)  * 
*                                                             * 
*  EXIT:  PAGQUE - POINTER TO FIRST FREE PAGE BLOCK           * 
*         PAGQUE+2 - POINTER TO LAST FREE PAGE BLOCK+2        * 
*                                                             * 
*  WORK REGISTERS:  A1-A12                                    * 
*                                                             * 
*  SUBROUTINES:                                               * 
*                                                             * 
*                                                             * 
*************************************************************** 
PAGGEN	EQU	*
	LDKL	A2,PAGEX	EXIT ADDRESS 
	ADR	A2,A13	RELOCATE
	LD	A1,SCTNOS	ANY SEGMENTS IN APPLICATION?
	ABR(Z)	A2	NO!
	LD	A1,SCTOPT	GET OPTION WORD 
	ANK	A1,3	PAGING? 
	ABR(Z)	A2	NO!
* 
*  RESERV SPACE FOR PAGE BLOCKS CORRESPONDING TO CORE RESIDENT SEGMENTS 
* 
	LD	A11,SCTSFA+2	GET START OF FREE AREA 
	ST	A11,SCTPAG	STORE IN SYSTAB
	LDR	A8,A13	GET RELOCATION BASE 
	ADKL	A8,PAG:60-REL	LIMIT FOR PAGE TABLE
	LDK	A7,0	RESET PAGE COUNTER
PAG:10	EQU	*
	CW	A7,SCTNOP	EQUAL TO NUMBER OF PAGES? 
	RF(E)	PAG:30	YES!
	LDK	A1,0	RESET NUMBER OF WORDS 
PAG:20	EQU	*
	ADKL	A11,2	INCLUDE NEXT WORD 
	RF(Z)	MEMOFL	MEMORY OVERFLOW (64 KB LIMIT) 
	ADK	A1,1	INCREMENT WORD COUNTER
	CWK	A1,4	4 WORDS RESERVED? 
	RF(E)	PAG:25	YES!
	CWR	A11,A8	CHECK PROGRAM OVERWRITE 
	RF(E)	MEMOFL	MEMORY OVERFLOW!
	RB	PAG:20
PAG:25	ADK	A7,1	INCREMENT PAGE BLOCK COUNTER
	RB	PAG:10
PAG:30	EQU	*
* 
*  RESERV MEMORY PAGES IN UNUSED PART OF MEMORY 
*  AND EXTEND PAGE TABLE WITH CORRESPONDING NUMBER
*  OF PAGE BLOCKS.
* 
	XIF
	IFT	CREDIT+MMUPAG=2
	LD	A1,SCTEFA	GET TWO MOST SIGN BITS OF 18-BITS ADDRESS 
	SLL	A1,14	TWO MOST SIGN BITS OF 16-BITS ADDRESS
	LD	A2,SCTEFA+2	GET BIT 2-18 OF 18-BITS ADDRESS 
	SRL	A2,2	SKIP TWO RIGHTMOST BITS 
	ORR	A1,A2	16 BITS PHYSICAL PAGE ADDRESS
	LDR	A3,A1	SAVE 
	LD	A2,SCTPSZ	GET PAGE SIZE 
	SRL	A2,2	SKIP TWO RIGHTMOST BITS 
	LDR	A10,A2	SAVE
	ANKL	A1,/FC00	MAKE EVEN 4K-MULTIPLE ADDRESS
	ANKL	A2,/0300	MODIFY FOR PAGE SIZE 
	ANR	A2,A3	EVEN 1-KB LIMIT
	ORR	A1,A2	MODIFY PAGE ADDRESS LIMIT
	XIF
	IFT	CREDIT-MMUPAG=1
	LD	A1,SCTEFA+2	END OF FREE AREA
	LD	A10,SCTPSZ	PAGE SIZE
	XIF
	IFT	CREDIT=1 
	LDR	A9,A1	INIT PAGE ADDRESS
	LDR	A6,A9	SAVE 
PAG:31	EQU	*
	TNM	A6,A10 
	RF(NN)	PAG:32
	CWR	A10,A6 
	RF	PAG:33
PAG:32	CWR	A6,A10 
PAG:33	RF(NG)	PAG:40
	SUR	A6,A10	COMPUTE ADDRESS TO NEXT PAGE
	LDR	A1,A6	GET PAGE ADDRESS 
	IFT	CREDIT+MMUPAG=2
	ANKL	A1,/C000	ADDRESS IN SYSTEM AREA?
	RF(NZ)	PAG:34	 NO! 
	LDR	A1,A6	PHYSICAL ADDRESS IN SYSTEM AREA
	SLL	A1,2	ABSOLUTE ADDRESS IN SYSTEM AREA 
	RF	PAG:36
PAG:34	LDK	A1,0	END OF FREE AREA
	XIF
	IFT	CREDIT=1 
PAG:36	LDK	A2,0	RESET WORD COUNTER
PAG:38	ADKL	A11,2	RESERV ANOTHER WORD 
	RF(Z)	PAG:40	64 KB LIMIT 
	ADK	A2,1	INCREMENT WORD COUNTER
	CWK	A2,4	BLOCK COMPLETE? 
	RF(E)	PAG:45	YES!
	LDR	A1,A1	ADDRESS IN SYSTEM AREA?
	RF(Z)	PAG:39	NO! 
	TNM	A11,A1	32-KB LIMIT CHECK 
	RF(NN)	PAG382
	CWR	A11,A1 
	RF	PAG384
PAG382	CWR	A1,A11 
PAG384	RF(NG)	PAG:40	NO MOORE MEMORY AVALIABLE! 
PAG:39	EQU	*
	CWR	A11,A8	PROGRAM OVERWRITE 
	RB(NE)	PAG:38	NO!
PAG:40	EQU	*
	CW	A7,SCTNOP	ONLY PAGES FOR CORE RESIDENT PAGES? 
	RF(G)	PAG:50	NO! 
	CW	A7,SCTNOS	ONLY CORE RESIDENT SEGMENTS IN APPLICATION? 
	RF(E)	PAG:50	YES!
MEMOFL	LDKL	A1,LMP3 
	OTR	A1,0,SOP	INDICATE MEMORY OVERFLOW
	HLT		HALT PROGRAM
PAG:45	CW	A7,SCTNOS	MOORE PAGES WANTED? 
	RF(E)	PAG:50	YES!
	ADK	A7,1	INCREMENT PAGE COUNTER
	LDR	A9,A6	SAVE PAGE ADDRESS
	RB	PAG:31
PAG:50	EQU	*
	ADKL	A11,2	START OF FREE AREA
	ST	A11,SCTSFA+2	SAVE 
	ST	A7,SCTNOP	SAVE NUMBER OF PAGES
	LDR	A1,A9	GET ADDRESS TO FIRST PAGE
	LDR	A2,A1	SAVE 
	XIF
	IFT	CREDIT+MMUPAG=2
	SRL	A1,14	BIT 0-1 OF 18-BITS ADDRESS 
	ST	A1,SCTEFA	SAVE
	SLL	A2,2	GET BITS 2-15 OF 18-BITS ADDRESS
	XIF
	IFT	CREDIT=1 
	ST	A2,SCTEFA+2	SAVE
* 
*  INITIATE PAGE BLOCK FOR CORE RESIDENT SEGMENTS AND 
*  STORE PAGE BLOCK ADDRESS IN SEGMENT BLOCKS 
* 
	LDK	A1,0 
	LD	A8,SAVE22,A13	PHYSICAL ADDRESS TO FIRST CORE RES. SEGM. 
	LD	A11,SCTSEG	START OF SEGMENT TABLE 
	LDK	A4,0	RESET RESIDENT SEGMENT COUNTER
	LD	A12,SCTPAG	START OF PAGE TABLE
	LD	A6,SCTNOS	NUMBER OF SEGMENTS
PAG:60	EQU	*
	ADKL	A11,8	NEXT SEGMENT BLOCK
	LDR*	A2,A11	GET STATUS 
	RF(NN)	PAG:65	SEGMENT NOT LOADED IN CORE 
	ST	A12,6,A11	STORE PAGE BLOCK ADDRESS
	STR	A1,A12	RESET QUEUE POINTER FORWARD 
	ST	A1,2,A12	RESET QUEUE POINTER BACKWARD 
	ST	A8,4,A12	STORE PAGE ADDRESS 
	ST	A11,6,A12	STORE SEGMENT BLOCK ADDRESS 
	ADK	A4,1	INCREMENT RESIDENT SEGMENT COUNTER
	ADR	A8,A10	 ADDRESS TO NEXT PAGE 
	ADKL	A12,8	NEXT PAGE BLOCK 
PAG:65	SUK	A6,1	DECREMENT SEGMENT BLOCK COUNTER 
	RB(P)	PAG:60 
* 
*  INITIATE PAGE BLOCK FOR FREE PAGES AND LINK TO PAGQUE
* 
	CWR	A4,A7	ANY FREE BLOCKS? 
	RF(E)	PAG:90	NO! 
	ST	A12,PAGQUE	POINTER TO FIRST FREE PAGE BLOCK 
	LDKL	A11,PAGQUE	POINTER TO PAGQUE
	LDR	A1,A12	SAVE ADDRESS TO FIRST PAGE BLOCK
	LDK	A2,0 
PAG:70	ST	A11,2,A12	STORE BACKWARD POINTER
	ST	A9,4,A12	STORE PAGE ADDRESS 
	ST	A2,6,A12	INDICATE PAGE FREE 
	ADK	A4,1	INCREMENT PAGE BLOCK COUNTER
	CWR	A4,A7	LAST PAGE BLOCK? 
	RF(E)	PAG:80	YES!
	LDR	A11,A12	SAVE ADDRESS TO PAGE BLOCK 
	ADK	A1,8	ADDRESS TO NEXT PAGE BLOCK
	STR	A1,A12	STORE FORWARD POINTER 
	LDR	A12,A1	NEXT PAGE BLOCK 
	ADR	A9,A10	NEXT PAGE 
	RB	PAG:70
PAG:80	EQU	*
	LDKL	A1,PAGQUE	POINTER TO PAGQUE 
	STR	A1,A12	STORE IN LAST BLOCK 
	ST	A12,PAGQUE+2	STORE IN PAGQUE+2
PAG:90	EQU	*
PAGEX	EQU	*-REL 
	EJECT
	XIF


* START BUGGER (IF ANY) 


* GET APPLICATION START 
	IFT CREDIT=0 
	LD	A14,SCTLAC	TRUE START OF APPLICATION
	XIF
	IFT CREDIT=1 
	LD	A14,SAVE13,A13	TRUE START OF S:GTAB 
	XIF
	SUKL	A14,8	ADJUST FOR MAP
	ADKL	A13,SYA360	CONTINUATION ADDRESS 
	LDK	A1,0	INDICATE SYSLOAD ENDED
	OTR	A1,0,SOP 
	LD	A1,SCTBUG	GET BUGGER ADDRESS
	ABR(NZ)	A1 

SYA360	EQU	*-REL
	LDR	A13,P
SYA370	EQU	*-REL
	SUKL	A13,SYA370	RESTORE PROGRAM BASE OINTER
* 
*  INIT A15 STACK 
* 
	LD	A15,SCTSTB
	SUKL	A15,4 

* START APPLICATION 

	LD	A1,IHRTC	GET INTERRUPT ADDRESS FOR RTC
	ST	A1,SAVRTC,A13	SAVE
	LDKL	A1,IHRTCO	LOAD TEMPORARY INTERRUPT ADDRESS
	ADR	A1,A13	RELOCATE
	ST	A1,IHRTC	STORE IN INTERRUPT VECTOR
	CF	A15,PFINIT	INITIALIZE DEVICES 
	CF	A15,SAVE8	SAVE REGISTERS
* 
*  WAIT APPROXIMATELY 0.62 SECONDS BEFORE BRANCHING TO DISPATCHER 
* 
	LDKL	A1,/FFFF	SET COUNTER
DELAY	SRC	A2,31 
	SUK	A1,1 
	RB(NZ)	DELAY 
	INH
	LDKL	A1,0	GET RTC INTERRUPT ADDRESS
SAVRTC	EQU	*-REL-2
	ST	A1,IHRTC	RESTORE
	ABL	TDISP	BRANCH TO DISPATCHER 
* 
*  TEMPORARY INTERRUPT ROUTINE FOR RTC
* 
IHRTCO	EQU	*-REL
	RIT	RTCDA
	RTN	A15
	IFF CREDIT=0 
	EJECT
				
************************************************* 
***                                           *** 
**           SYSLOAD PART 2.A                  ** 
**                                             ** 
************************************************* 

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

PART2A	EQU	*-REL

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

				
**                T : D A D D                 **
**                                            **
**                                            **
**  GET T:D - ADDRESS                         **
**                                            **
**  INPUT : A8=POINTER TO T:A (IN T:ATAB)     **
**  OUTPUT: A12=T:D ADDRESS                   **
************************************************
T:DADD	EQU	*
	IFT CREDIT-MMUPAG=1
	LDR*	A12,A8	T:A ADDRESS
	LD	A12,T:DAD,A12 
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A12,A8	T:A ADDRESS 
	EL	A12,T:DAD,A12 
	XIF
	IFF CREDIT=0 
	AD	A12,MOVADD,A13	RELOCATE 
	RTN	A14
	EJECT
				
				
**                  M O V C O M                ** 
**                                             ** 
**                                             ** 
**  SEARCH T:A'S FOR COMMON WORK BLOCKS THAT   ** 
**  ARE COMMON TO AT LEAST TWO T:A'S, AND MOVE ** 
**  TO COMMON AREA                             ** 
**                                             ** 
**  INPUT : A8=POINTER IN T:ATAB               ** 
**          BIT=BIT NUMBER, SAT IN MASK        ** 
**          ENDADD=ENDADDRESS OF T:ATAB        ** 
**          TADISP=W.B.-ADDR DISPLACEM. IN T:A ** 
**  WORK.REGS: A1-A6,A9,A11,A12                ** 
************************************************* 
			 
MOVCOM	EQU	*
	CALL	CHKMVD	BLOCK ALREADY MOVED? 
	RF(N)	MOVC20	YES!
	CALL	GETWB	POINTER TO WB ADD TO 'WBADD',A5=T:A-DISPL 
	ST	A11,SAVE06,A13	SAVE W.B.-ADDRESS
	CM	MOVED,A13	CLEAR MOVED INDICATOR 
	LDR	A6,A8
MOVC10	ADK	A6,2	NEXT T:A
	CW	A6,ENDADD,A13	ALL DONE? 
	RF(NE)	MOVC30	NO 
MOVC20	RTN	A14	YES! 
	IFT CREDIT-MMUPAG=1
MOVC30	LDR*	A11,A6
	LD	A2,T:DAD,A11	T:D-ADDRESS
	AD	A2,MOVADD,A13	RELOCATE
	ST	A2,SAVE03,A13	SAVE
	LD	A2,WATLEN,A2	NUMBER OF WAT-ELEMENTS 
	CW	A2,BIT,A13	ENOUGHT? 
	RB(NG)	MOVC10	TO FEW WAT ELEMENTS. TAKE NEXT T:A 
	AD	A11,TADISP,A13	W.B.-ADDRESS TO EXAMINE
	LDR*	A11,A11 
	CW	A11,SAVE06,A13	COMPARE W.B.-ADDRESSES 
	XIF
	IFT CREDIT+MMUPAG=2
MOVC30	ELR	A11,A6 
	EL	A2,T:DAD,A11	T:D-ADDRESS
	AD	A2,MOVADD,A13	RELOCATE
	ST	A2,SAVE03,A13	SAVE T:D-ADDRESS TEMPORARY
	EL	A2,WATLEN,A2	NUMBER OF WAT-ELEMENTS 
	CW	A2,BIT,A13	ENOUGHT? 
	RB(NG)	MOVC10	TO FEW WAT ELEMENTS. TAKE NEXT T:A 
	AD	A11,TADISP,A13	W.B.-ADDRESS TO EXAMINE
	ELR	A11,A11
	CW	A11,SAVE06,A13	COMPARE W.B.-ADDRESSES 
	XIF
	IFF CREDIT=0 
	RB(NE)	MOVC10	.NEQ.
	LD	A9,MOVED,A13	W.B. ALREADY MOVED?
	RF(NZ)	MOVC50	YES! CHANGE ADDRESSES ONLY 
	CALL	MOVDT	MOVE DESCRIPTOR-TABLE 
	ST	A2,NEWAD1,A13	SAVE D.T.-ADRESS
	CALL	MOVWB	MOV WORK BLOCK
	IM	MOVED,A13	INDICATE MOVED
	LD	A4,UWB,A13	UWB-BLOCKS?
	RF(Z)	MOVC40	NO! 
	CALL	GETPRO	CREATE REAL UWB'S
MOVC40	ST	A2,NEWAD2,A13	SAVE NEW ADDRESS TO W.B.
	CALL	MOVDWB
MOVC50	CALL	CHADR	CHANGE ADDRESSES
	CALL	ICBMVD	INDICATE CURRENT BLOCK MOVED 
	LDR	A11,A8	SAVE T:A-POINTER
	ST	A12,SAVE25,A13	SAVE T:A-ADDRESS 
	LDR	A8,A6	REPLACE POINTER TO T:A 
	LD	A12,SAVE03,A13	REPLACE T:D-ADDRESS
	CALL	MOVDWB
	LDR	A8,A11 
	LD	A12,SAVE25,A13	RELOAD T:D-ADDRESS 
	RB	MOVC10
	EJECT
				
				
**               G E T P R O                  **
**                                            **
**                                            **
**  SEARCH U:BTAB PROTOTYPE AND GET NUMBER OF **
**  COPIES. FILL REAL U:BTAB                  **
**                                            **
**  INPUT : A11=PROTOTYPE ADDRESS             **
**          A2=LAST W.B. - ADDRESS            **
**  OUTPUT: A2=NEW ADDRESS                    **
**  WORK-REGS: A1-A5,A9                       **
************************************************
			 
GETPRO	EQU	*
	LD	A3,U:BTOD,A13	GET U:BTAB ADDRESS
	IFT CREDIT-MMUPAG=1
	LDR*	A4,A3	LENGTH
GETP10	EQU	*
	SUK	A4,UP:REC	SUB RECORD LENGTH FRM TABLE LENGTH 
	RF(NN)	GETP20
	LDK	A1,LMP6	W.B. NOT FOUND!
	CALL	ERROR 
GETP20	EQU	*
	CW	A11,UPADDR,A3	SAME W.B.?
	RF(E)	GETP30	YES! GET NUMBER OF COPIES 
	ADK	A3,UP:REC	NEXT 
	RB	GETP10
				
* GET NUMBER OF COPIES                     *
* A3 POINTS AT PROTOTYPE ADDRESS IN U:BTAB *

GETP30	EQU	*
	LD	A4,WBLEN,A11	W.B.-LENGTH
	LC	A5,UPNUMB,A3	GET NUMBER OF COPIES 
	ANK	A5,/FF 
	SU	A3,U:BTOD,A13	GET TABLE DISPLACEMENT
	AD	A3,U:BTNW,A13	ADD TO NEW TABLE ADDRESS
	LDR	A9,A3
	ST	A4,URLENG,A9	STORE LENGTH 
	ST	A5,URNUMB,A9	STORE IN REAL U:BTAB 
* COPY NUMBER OF WORKBLOCKS TO COMMON AREA *
********************************************
	SUK	A5,1	ONE ALREADY MOVED (IN 'MOVCOM') 
	RF(NP)	GETP50
GETP40	CALL	MOVWB 
	SUK	A5,1 
	RB(NZ)	GETP40
				
* UPDATE POINTER IN REAL U:BTAB * 
********************************* 
GETP50	EQU	*
	ST	A2,URADDR,A9	STORE ADDRESS TO FIRST IN U:BTAB 
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A4,A3	LENGTH 
GETP10	EQU	*
	SUK	A4,UP:REC	SUB RECORD LENGTH FRM TABLE LENGTH 
	RF(NN)	GETP20
	LDK	A1,LMP6	W.B. NOT FOUND!
	CALL	ERROR 
GETP20	EQU	*
	EL	A10,UPADDR,A3	CHECK IF SAME W.B.
	CWR	A11,A10
	RF(E)	GETP30	YES! GET NUMBER OF COPIES 
	ADK	A3,UP:REC	NEXT 
	RB	GETP10
				
* GET NUMBER OF COPIES                     *
* A3 POINTS AT PROTOTYPE ADDRESS IN U:BTAB *
********************************************

GETP30	EQU	*
	EL	A4,WBLEN,A11	W.B.-LENGTH
	EL	A5,UPNUMB-1,A3	GET NUMBER OF COPIES 
	ANK	A5,/FF 
	SU	A3,U:BTOD,A13	GET TABLE DISPLACEMENT
	AD	A3,U:BTNW,A13	ADD TO NEW TABLE ADDRESS
	LDR	A9,A3
	TL*	MMTO,A13	LOAD TO-TABLE 
	ES	A5,URNUMB,A9	ESORE IN REAL U:BTAB 
	ES	A4,URLENG,A9	STORE LENGTH 
	TL*	MMFROM,A13	RELOAD FROM TABLE 
* COPY NUMBER OF WORKBLOCKS TO COMMON AREA *
********************************************
	SUK	A5,1	ONE ALREADY MOVED (IN 'MOVCOM') 
	RF(NP)	GETP50
GETP40	CALL	MOVWB 
	SUK	A5,1 
	RB(NZ)	GETP40
				
* UPDATE POINTER IN REAL U:BTAB * 
********************************* 
GETP50	EQU	*
	TL*	MMTO,A13 
	ES	A2,URADDR,A9	ESORE ADDRESS TO FIRES IN U:BTAB 
	TL*	MMFROM,A13 
	XIF
	IFF CREDIT=0 
	RTN	A14
	EJECT
				
**                M O V C L A              ** 
**                                         ** 
**                                         ** 
**  CHECKS IF W.B. ALREADY MOVED TO COMMON ** 
**  AREA. IF NOT MOVE W.B. & D.T. AND      ** 
**  CHECK IF ANY DWB'S                     ** 
**                                         ** 
**  A LOT OF WORKREGS.                     ** 
********************************************* 

MOVCLA	EQU	*
	CALL	SHIFT 
	RF(Z)	MVCL30 
MVCL10	CALL	GETWB	W.B.-ADDRESS TO A11 
	CALL	CHKMVD	BLOCK ALREADY MOVED? 
	RF(NN)	MVCL40	NO!
MVCL20	CALL	SKIFTA	GET NEXT BIT IN MASK 
	RB(NZ)	MVCL10
MVCL30	RTN	A14
MVCL40	CALL	MOVDT 
	CALL	MOVWB 
	LD	A4,UWB,A13	UWB-SCANNING 
	RF(Z)	MVCL50	NO! 
	CALL	GETPRO	DUPLICATE WB'S 
MVCL50	ST	A2,NEWAD2,A13	SAVE W.B.-ADDRESS 
	CALL	MOVDWB	PROCESS DWB'S
	RB	MVCL20
	EJECT
				
				
**                  C H A D R                  ** 
**                                             ** 
**                                             ** 
**  CHANGE ADDRESS TO W.B. & D.T. IN T:A,      ** 
**  BLOCKS ALREDY MOVED                        ** 
**                                             ** 
**  INPUT : A6=POINTER IN T:ATAB TO T:A        ** 
**          NEWADR1=NEW D.T.-ADDRESS           ** 
**          NEWAD2= NEW W.B.-ADDRESS           ** 
**          TADISP=DISPLACEMENT TO WB-ADDR     ** 
**  WORK.REGS: A1,A2                           ** 
************************************************* 
			 
CHADR	EQU	* 
	IFT CREDIT-MMUPAG=1
	LDR*	A1,A6	T:A-ADDRESS 
	AD	A1,TADISP,A13	ADDRESS  TO W.B.-ADDRESS
	LD	A2,NEWAD2,A13 
	STR	A2,A1
	SUK	A1,2	ADDRESS TO D.T.-ADDRESS 
	LD	A2,NEWAD1,A13 
	STR	A2,A1
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A1,A6	T:A-ADDRESS
	AD	A1,TADISP,A13	ADDRESS  TO W.B.-ADDRESS
	LD	A2,NEWAD2,A13 
	ESR	A2,A1
	SUK	A1,2	ADDRESS TO D.T.-ADDRESS 
	LD	A2,NEWAD1,A13 
	ESR	A2,A1
	XIF
	IFF CREDIT=0 
	RTN	A14
	XIF
	IFT	CREDIT+SWPBLK=2
	EJECT
**************************************************************
*                                                            *
*                                                            *
*  B:RSWT - BUILD REAL SWB CONTROL TABLE                     *
*  =====================================                     *
*                                                            *
*  REFERENCED IN:  SYSLDA                                    *
*                                                            *
*  ENTRY:  A2 - POINTER TO FIRST RECORD IN REAL S:BTAB       *
*          A5 - LENGTH OF REAL S:BTAB                        *
*                                                            *
*  EXIT:                                                     *
*                                                            *
*  WORK REGISTERS:  A1-A7                                    *
*                                                            *
*  SUBROUTINES:                                              *
*                                                            *
**************************************************************
	EJECT
B:RSWT	EQU	*
	LDR	A8,A2	SAVE POINTER TO FIRST BLOCK
	LD	A1,SCTSWB	POINTER TO SWB BLOCK TABLE
	RF(Z)	RSWBEX	NO SWB:S IN APPLICATION 
	LDR*	A3,A1	NUMBER OF TYPES 
	RF(Z)	RSWBEX	NO MOORE
	SUK	A5,2	SKIP LENGTH WORD
RSWB10	ADK	A1,2	NEXT TYPE 
	LDR*	A4,A1	POINTER TO BLOCK
	LDR*	A6,A4	NUMBER OF COPIES
	LD	A7,SWBLEN,A4	LENGTH IN BYTES
	XIF
	IFT	CREDIT+MMUSWB=3
	ES	A6,2,A2	STORE NUMBER OF COPIES
	ES	A7,4,A2	STORE LENGTH OF SWB IN BYTES
	XIF
	IFT	CREDIT+SWBMMU=2
	ST	A6,2,A2	STORE NUMBER OF COPIES
	ST	A7,4,A2	STORE LENGTH OF SWB IN BYTES
	XIF
	IFT	CREDIT+SWPBLK=2
	SUK	A5,6	DECREMENTS S:BTAB LENGTH
	ADK	A2,6	INCREMENT POINTER IN BLOCK
	SUK	A3,1	DECREMENT NUMBER OF TYPES 
	RB(P)	RSWB10 
	LDR	A4,A2
* 
*  INIT POINTERS TO TID BLOCKS FOR EACH SWB TYPE
*  AND RESET ALL WORDS IN TID BLOCKS
* 
RSWB20	EQU	*
	LDR	A6,A2	GET ADDRESS TO TID BLOCK 
	SUR	A6,A8	COMPUTE DISPLACEMENT 
	IFT	CREDIT+SWBMMU=2
	LD	A1,2,A8	NUMBER OF COPIES
	RF(Z)	RSWB50	NO COPIES!
	STR	A6,A8	STORE POINTER TO TID BLOCK 
RSWB30	STR	A3,A2	RESET TID
	ADK	A2,2	INCREMENT POINTER IN TID BLOCK
	SUK	A5,2	DECREMENT LENGTH OF REAL S:BTAB 
	SUK	A1,1	DECR. NUMBER OF COPIES
	RB(P)	RSWB30	NEXT COPY 
	XIF
	IFT	CREDIT+MMUSWB=3
	EL	A1,2,A8	GET NUMBER OF COPIES
	RF(Z)	RSWB50	NO COPIES!
	ESR	A6,A8	STORE POINTER TO TID BLOCK 
RSWB40	ESR	A3,A2	RESET TID
	ADK	A2,2	INCREMENT POINTER IN TID BLOCK
	SUK	A5,2	DECREMENT LENGTH OF REAL S:BTAB 
	SUK	A1,1	DECREMENT NUMBER OF COPIES
	RB(P)	RSWB40	NEXT COPY 
	XIF
	IFT	CREDIT+SWPBLK=2
RSWB50	ADKL	A8,6
	CWR	A8,A4
	RB(NE)	RSWB20
	LDR	A5,A5	S:BTAB CONSISTENT? 
	RF(Z)	RSWBEX	YES 
	LDKL	A1,LMP6	SWB ERROR!
	CALL	ERROR 
RSWBEX	RTN	A14
	XIF
	IFF	CREDIT=0 
	EJECT

* **************************
* START OF PROGRAM PART 2.A * 
***************************** 

* LOAD BASE ADDRESS * 
********************* 
* A5=START-ADDRESS
* A9=P:MTAB ADDRESS 
* SAVE03=DDIV TO-ADDRESS
* SAVE04=DDIV FROM ADDRESS
* SAVE05=LENGTH OF REAL T:ATAB
* SAVE06=LENGTH OF REAL U:BTAB
				
START2	EQU	*-REL
	LDR	A8,P	LOAD TEMP. STACKBASE
	ADK	A5,2	ADD FOR RELOCATION ROUTINE
	CFR	A8,A5
* MOVE DDIV * 

	LD	A1,SAVE04,A13	GET FROM-ADDRESS
	LD	A2,SAVE03,A13	GET TO ADDRESS
	LDR	A3,A9	GET P:MTAB START (=END OF DDIV 
	SUR	A3,A1	=> LENGTH
	XIF
	IFT CREDIT-MMUPAG=1
	LD	A8,SCTNOS	ANY SEGMENTS IN APPLICATION?
	RF(Z)	NOSGMT	NO! 
	LDKL	A8,0	RESET FSTADR IF SEGMENTS!
	RF	SEGMTS
NOSGMT	LD	A8,SCTSFA	ALLOCATE BUFFERS FROM TOP 
SEGMTS	ST	A8,FSTADR,A13	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
	XIF
	IFT CREDIT+MMUPAG=2
	CALL	XMOVE 
* REMOVE DDIV ENTRIES IN MM-TABLE 

	LDR	A1,A9	GET P:MTAB ADDRESS 
	SRL	A1,11	ADJUST FOR ADDRESSING
	ANK	A1,/1E 
	LDK	A2,MMTAB-2	GET TABLE ADDRESS 
	ADR	A2,A13	RELOCATE
	ADR	A1,A2	P:MTAB 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,A13 
	LD	A5,MMTO,A13 
	ST	A4,MMTO,A13 
	ST	A5,MMFROM,A13 
	XIF
	IFF CREDIT=0 
	ANKL	A9,/FFFE	EVEN ADDRESS 
	ST	A9,LSTADR,A13	SAVE END OF FREE AREA 


				
* RESERVE SPACE FOR REAL T:A- AND U:BTAB *

	IFT CREDIT+MMUPAG=2
	LDKL	A3,MMTAB	GET CURRENT MM-TABLE 
	ADR	A3,A13 
* FIND LAST USED ENTRY IN REAL MMUTAB * 

	CALL	MMENT 
	ST	A9,TTAB,A13 
	ST	A1,FYSPAG,A13	SAVE PHYSICALL PAGE 
	LD	A3,SAVE05,A13	GET LENGTH OF T:ATAB
	LDR	A5,A3	SAVE 
	CALL	MOVING RESERVE SPACE FOR T:ATAB 
	TL*	MMTO,A13	SET CORRECT TABLE 
	ESR	A5,A2	STORE T:ATAB LENGTH
	ST	A2,T:ATNW,A13	SAVE NEW T:ATAB ADDRESS 
	ADK	A2,2	SKIP LENGTH WORD
	LD	A9,SCTLAC	GET P:MTAB ADDRESS
	ES	A2,T:ATAB,A9	STORE IN P:MTAB
* RESERVE PLACE FOR T:AID TABLE 

	LDR	A3,A5	GET LENGTH 
	CALL	MOVING
	TL*	MMTO,A13 
	LDR	A3,A9	GET P:MTAB 
	ADK	A3,T:AID	ADD TO ADDRESS WORD 
	ESR	A5,A2	STORE TABLE LENGTH IN T:TID-TABLE
	ADK	A2,2	ADJUST TABLE ADDRESS
	ESR	A2,A3	STORE IN P:MTAB
	XIF
	IFF CREDIT=0 
	LD	A3,SAVE06,A13	GET U:BTAB LENGTH 
	LDR	A5,A3	SAVE 
	CALL	MOVING	RESERVE SPACE
	ST	A2,U:BTNW,A13	SAVE NEW (REAL) U:BTAB ADDRESS
	IFT CREDIT-MMUPAG=1
	STR	A5,A2	STORE LENGTH 
	ADK	A2,2 
	ST	A2,U:BTAB,A9	SAVE 'REAL' U:BTAB-ADDRESS IN P:MTAB 
	LD	A3,SAVE05,A13	GET LENGTH OF T:ATAB
	LDR	A5,A3	SAVE 
	CALL	MOVING RESERVE SPACE FOR T:ATAB 
	STR	A5,A2	STORE T:ATAB LENGTH
	ST	A2,T:ATNW,A13	SAVE NEW T:ATAB ADDRESS 
	ADK	A2,2 
	ST	A2,T:ATAB,A9	SAVE REAL ADDRESS
* RESERVE FOR T:AID TABLE 

	LDR	A3,A5	LENGTH 
	CALL	MOVING
	STR	A5,A2	STORE LENGTH 
	ADK	A2,2	ADJUST FOR LENGTH-WORD
	ST	A2,T:AID,A9	STORE ADDRESS IN P:MTAB 
	XIF
	IFT CREDIT+MMUPAG=2
	TL*	MMTO,A13	SET CORRECT TABLE 
	ESR	A5,A2	STORE LENGTH 
	ADK	A2,2	SKIP LENGTH WORD
	ES	A2,U:BTAB,A9	STORE IN P:MTAB
	XIF
	IFT	SWPBLK+CREDIT=2
* 
*  RESERV SPACE FOR REAL S:BTAB TABLE 
* 
	LD	A3,SAVE25,A13	LENGTH OF REAL S:BTAB 
	LDR	A5,A3	SAVE 
	CALL	MOVING
	ST	A2,S:BTNW,A13 
	XIF
	IFT	CREDIT+MMUSWB=3
	TL*	MMTO,A13 
	ESR	A5,A2
	ADK	A2,2 
	ES	A2,S:BTAB,A9
	CALL	B:RSWT
	XIF
	IFT	CREDIT+SWBMMU=2
	STR	A5,A2
	ADK	A2,2 
	ST	A2,S:BTAB,A9
	CALL	B:RSWT
	XIF
	IFT	CREDIT+MMUPAG=2
	TL*	MMFROM,A13	RELOAD  TABLE 
	XIF
	IFF CREDIT=0 
	EJECT
				
* BUILD COMMON DATA AREA *
**************************
* SEARCH CWB'S: 
			 
	LD	A8,T:ATOD,A13	GET T:ATAB ADDRESS
	IFT CREDIT-MMUPAG=1
	LDR*	A3,A8	GET LENGTH
	XIF
	IFT CREDIT+MMUPAG=2
	ELR	A3,A8	GET LENGTH 
	XIF
	IFF CREDIT=0 
	ADR	A3,A8
	ST	A3,ENDADD,A13	SAVE END OF T:ATAB ADDRESS
SYA210	EQU	*
	CM	UWB,A13	INDICATE CWB-SCANNING 
	ADKL	A8,2
	CW	A8,ENDADD,A13	ALL DONE? 
	RF(E)	CLADAT	YES!
	CALL	T:DADD	T:D-ADDRESS TO A12 
	IFT CREDIT-MMUPAG=1
	LD	A7,CWBMSK,A12	GET CWB-MASK
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A7,CWBMSK,A12 
	XIF
	IFF CREDIT=0 
	CALL	SHIFT	SUPER-LOOPA 
SYA220	RF(Z)	UWBCOM	ALL!
	CALL	MOVCOM
	CALL	SKIFTA
	RB	SYA220
	EJECT
				
				
UWBCOM	EQU	*
* SEARCH UWB'S: 
* 
	IM	UWB,A13	INDICATE UWB-SCANNING 
	IFT CREDIT-MMUPAG=1
	LD	A7,UWBMSK,A12 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A7,UWBMSK,A12 
	XIF
	IFF CREDIT=0 
	CALL	SHIFT 
SYA230	RB(Z)	SYA210	ALL DONE! 
SYA235	CALL	MOVCOM
SYA240	CALL	SKIFTA
	RB	SYA230
	EJECT
				
* TASK CLASS DATA CONFIGURATION PART *
**************************************

CLADAT	EQU	*
	LD	A8,T:ATOD,A13	SET POINTER TO LENGTH INT:ATAB
	IFT CREDIT-MMUPAG=1
SYA250	CM	UWB,A13	INDICATE CWB
	ADKL	A8,2	STEP TO NEXT T:A ADDRESS 
	CW	A8,ENDADD,A13 
	RF(E)	SYA270	ALL	T:A'S DONE
	CALL	T:DADD	GET T:D ADDRESS TO A12 

* CALCULATE LENGTH OF T:D 

	LD	A1,WATLEN,A12	NUMBER OF BYTES-1 IN DBLKTAB
	ADK	A1,2 
	ANKL	A1,/FFFE	EVEN ADDRESS 
	ADK	A1,DWBFST+4	ADD DISPL. TO FIRST
	LDR	A3,A1	GET NUMBER OF START-POINTS 
	ADR	A3,A12	ADD T:D-ADDRESS 
	LDR*	A3,A3	. 
	LDK	A2,STPREC	GET STARTPOINTS RECORD LENGTH
	CALL	MULT	AND MULTIPLY 
	ADK	A3,2	'NUMBER-WORD' 
	ADR	A3,A1	=>LENGTH 
	LDR	A1,A12	FROM-ADDRESS
	CALL	MOVING	MOVE T:D 
	LDR*	A1,A8	GET T:A ADDRESS 
	ST	A2,T:DAD,A1	STORE NEW T:D ADDRESS 
	LD	A7,CWBMSK,A12	GET CWBMASK 
	XIF
	IFT CREDIT+MMUPAG=2
* INITIATE MM-ADDRESS TABLE POINTER 

	LD	A1,SCTSFA	SHADOW TABLE START
	AD*	A1,SCTSFA	ADDRESS TABLE START
	ST	A1,SAVE06,A13	SAVE
SYA250	CM	UWB,A13	INDICATE CWB
	ADKL	A8,2	STEP TO NEXT T:A ADDRESS 
	CW	A8,ENDADD,A13 
	RF(E)	SYA270	ALL T:A'S DONE! 
	CALL	GETTAB	GET TTAB-ADDRESS 
	CALL	MOVMMT	MOVE MM-TABLE
* FILL MM-TABLE ADDRESS TABLE 

	LD	A1,SAVE06,A13 
	ADK	A1,2	INCREMENT TABLE POINTER 
	ST	A1,SAVE06,A13	RESTORE 
	STR	A2,A1	FILL TABLE 
	CALL	T:DADD	GET T:D ADDRESS TO A12 
	ST	A12,T:DSAV,A9	SAVE 'OLD' T:D-ADDRESS IN TTAB

* CALCULATE LENGTH OF T:D 

	EL	A1,WATLEN,A12	NUMBER OF BYTES-1 IN DBLKTAB
	ADK	A1,2 
	ANKL	A1,/FFFE	EVEN ADDRESS 
	ADK	A1,DWBFST+4	ADD DISPL. TO FIRST
	LDR	A3,A1	GET NUMB. OF START-POINTS... 
	ADR	A3,A12	. 
	ELR	A3,A3	.
	LDK	A2,STPREC	GET STARTPOINTS RECORD LENGTH
	CALL	MULT	AND MULTIPLY 
	ADK	A3,2	'NUMBER-WORD' 
	ADR	A3,A1	=>LENGTH 
	LDR	A1,A12	FROM-ADDRESS
	CALL	MOVING	MOVE T:D 
	ELR	A1,A8	GET T:A ADDRESS
	ES	A2,T:DAD,A1	ESORE NEW T:D ADDRESS 
	EL	A7,CWBMSK,A12	GET CWBMASK 
	XIF
	IFF CREDIT=0 
	CALL	MOVCLA
	EJECT
				
				
* TASK CLASS DATA UWB'S * 
************************* 
	IM	UWB,A13	INDICATE UWB SCANNING 
	IFT CREDIT-MMUPAG=1
	LD	A7,UWBMSK,A12	GET UWBMASK 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A7,UWBMSK,A12 
	XIF
	IFF CREDIT=0 
	CALL	MOVCLA
	EJECT
				
				
* MOVE DT:S OF SWB'S & TWB'S *
******************************

SYA260	EQU	*
	IFT CREDIT-MMUPAG=1
	LD	A7,SWBMSK,A12 
	RF(Z)	SYA265	NONE
	CALL	SKRITT
SYA265	LD	A7,TWBMSK,A12 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A7,SWBMSK,A12 
	RF(Z)	SYA265	NONE
	CALL	SKRITT
SYA265	EL	A7,TWBMSK,A12 
	XIF
	IFF CREDIT=0 
	RB(Z)	SYA250 
	CALL	SKRITT
	RB	SYA250
				
SYA270	RF	PRODAT
	EJECT
				
				
**              S K R I T T                  ** 
**                                           ** 
**  MOVE D.T                                 ** 
**                                           ** 
*********************************************** 
SKRITT	EQU	*
	CALL	SHIFT 
NO	RF(NZ)	NES 
	RTN	A14
NES	CALL	GETWB
	CALL	MOVDT 
	CM	NEWAD2,A13	NO NEW W.B.-ADDRESS (YET!) 
	CALL	MOVDWB
	CALL	SKIFTA
	RB	NO
	EJECT
				
* BUILD TASKDATA PROTOTYPE AREA * 
********************************* 
PRODAT	EQU	*
				=00001
	LD	A1,SAVE02,A13	BUGGER TASK INCLUDED? 
	RF(Z)	SYA275	NO! 
	CALL	GETTTB	GET TTAB ADDRESS. TID 'TB' IN A1 
	CM	TTB:PP,A2	CLEAR TCL SAVE AREA 
	IFT	CREDIT+MMUPAG=2		=00001
	CALL	MOVMMT	MOVE MM-TABLE
	XIF			=00001 
	IFF	CREDIT=0		=00001 
SYA275	EQU	*
				=00001
				=00001
	IM	SWITCH,A13	INDICATE: -NO MORE D.T. MOVE!
	LD	A8,T:ATOD,A13	T:ATAB ADDRESS
SYA280	ADKL	A8,2
	CW	A8,ENDADD,A13 
	RF(E)	SYA290	ALL DONE
	IFT CREDIT-MMUPAG=1
	LDR*	A12,A8	GET T:D ADDRESS..
	LD	A12,T:DAD,A12	. 
	CALL	TWBSWB	MOVE TWB'S & RESERVE FOR SWB'S 
				
* CALCULATE LENGTH OF DSCB'S *
***                        ***
				
	LDR*	A1,A8	GET T:A-ADDRESS 
	LD	A3,DATLEN,A12	A12=T:D-ADDRESS 
	LDK	A2,DSCBL	DSCB-LENGTH 
	CALL	MULT	A3() X (A2) RESULT IN A3 
	ST	A3,CSN,A1	SAVE LENG OF DSCB'S 
	LD	A2,FCD,A12	GET FCB-DISPLACEMENT 
	RF(NZ)	SYA285	FCB PRESENT
	SUR	A2,A3	MOVD30E A3(DSCB-LENGTH)
	ADKL	A2,T:ASTA	INCREMENT TO FIRST WORD 
SYA285	ST	A2,CIA,A1	SAVE DISPLACEMENT TO T:A-START
	LD	A2,STKB,A1	GET STACK SIZE 
	ST	A2,CSE,A1	AND SAVE TEMPORARY
	LD	A2,SCTLAC	GET START OF COMMON PART
	LD	A2,P:BAS,A2	GET P:BAS 
	ST	A2,CSB,A1	AND SAVE
	CALL	ALLBUF	ALLOCATE BUFFERS 
	CALL	MOVT:A	MOVE T:A 
	STR	A2,A8	STORE NEW ADDRESS IN T:ATAB
	XIF
	IFT CREDIT+MMUPAG=2
	CALL	GETTAB	SET CORRECT TTAB-ADDRESS 
	LD	A12,T:DSAV,A2	GET 'OLD' T:D-ADDRESS 

* GET LAST USED ENTRY IN CLASS-LOCAL MM-TABLE 

	TL	MMBEG,A2	LOAD CLASS LOCAL TABLE 
	LDKL	A3,MMTAB	GET WORK TABLE ADDRESS 
	ADR	A3,A13 
	TSR	A3	STORE TABLE IN WORK-AREA
	TL	MMDDIV,A13	RELOAD DDIV TABLE
	CALL	MMENT	GET ENTRY 
	ST	A3,T:DSAV,A2	SAVE IN TTAB 
	CALL	TWBSWB	MOVE TWB'S & RESERVE FOR SWB'S 
* CALCULATE LENGTH OF DSCB'S *
***                        ***
				
	ELR	A1,A8	GET T:A-ADDRESS
	EL	A3,DATLEN,A12	A12=T:D-ADDRESS 
	LDK	A2,DSCBL	DSCB-LENGTH 
	CALL	MULT	A3() X (A2) RESULT IN A3 
	ES	A3,CSN,A1	SAVE LENG OF DSCB'S 
	EL	A2,FCD,A12	GET FCB-DISPLACEMENT 
	RF(NZ)	SYA285	FCB PRESENT
	SUR	A2,A3	MOVD30E A3(DSCB-LENGTH)
	ADKL	A2,T:ASTA	INCREMENT TO FIRST WORD 
SYA285	ES	A2,CIA,A1	SAVE DISPLACEMENT TO T:A-ESART
	EL	A2,STKB,A1	GET STACK SIZE 
	ES	A2,CSE,A1	AND SAVE (TEMPORARY)
	LD	A2,SCTLAC	GET START OF P:MTAB 
	TL*	MMTO,A13	LOAD CORRECT TABLE
	EL	A2,P:BAS,A2	GET P:BAS 
	TL*	MMFROM,A13	RELOAD DDIV TABLE 
	ES	A2,CSB,A1	AND SAVE
	CALL	ALLBUF	ALLOCATE BUFFERS 
	CALL	MOVT:A	MOVE T:A 
	ESR	A2,A8	STORE NEW ADDRESS IN T:ATAB
	XIF
	IFF CREDIT=0 
	RB	SYA280	NEXT 
	EJECT
SYA290	EQU	*
	IM	FLAG,A13	INDICATE REAL DATA-PART PROCESSING 
* INCLUDE DDIV AND PART 2.A IN FREE AREA

	LDKL	A2,PART2A	NEW (RELATIVE) END ADDRESS
	ADR	A2,A13	ABSOLUT DITO
	IFT CREDIT+MMUPAG=2
	LDR	A3,A2
	ANKL	A3,/F000
	SRL	A3,2	GET NEW PHYSICALL PAGE
	ST	A3,FSTPAG,A13	SAVE
	ANKL	A2,/FFF	GET NEW PAGE INCREMENT
	ST	A2,FSTADR,A13	SAVE
* MOVE T:ATAB 

	LD	A2,T:ATNW,A13	GET REAL T:A-ADDRESS
	XIF
	IFT CREDIT-MMUPAG=1
	ST	A2,DATEND,A13	SAVE NEW END ADDRESS
* MOVE T:ATAB 

	LD	A2,T:ATNW,A13	GET REAL T:A-TAB ADDRESS
	LDR*	A1,A2	REAL LENGTH 
	ADR	A2,A1	END OF TABLE ADDRESS 
	ST	A2,ENDADD,A13	SAVE
	LD	A1,T:ATOD,A13	GET FROM-ADDRESS
	LDR*	A3,A1	MOVE-LENGTH 
	SUR	A2,A3	TO-ADDRESS 
	ST	A2,T:ATOD,A13	SAVE
	CALL	MOVE
	XIF
	IFT CREDIT+MMUPAG=2
	TL*	MMTO,A13	LOAD CORRECT TABLE
	ELR	A1,A2	GET REAL T:ATAB LENGTH 
	TL*	MMFROM,A13	RELOAD TABLE
	ADR	A2,A1	END ADDRESS
	ST	A2,ENDADD,A13	SAVE 'END-OF-T:ATAB-CONDITION'
	LD	A1,T:ATOD,A13	GET PROTOTYP T:ATAB 
	ELR	A3,A1	GET LENGTH 
	SUR	A2,A3	TO-ADDRESS 
	ST	A2,T:ATOD,A13	SAVE
	CALL	XMOVE 
	XIF
	IFF CREDIT=0 

* CONTINUE IN PART 2.B *

	LDKL	A5,PART2B	RELATIVE START ADDRESS
	ADR	A5,A13	ADD BASE ADDRESS
	ABR	A5 
LENGT2	EQU	*-REL	LENGTH OF PART 2 
	EJECT
			 
			 
********************************************* 
*******                               ******* 
**                                         ** 
*            SYSLOAD PART 1                 * 
**                                         ** 
*****                                   ***** 
********************************************* 
			 
*   READ CONFIGURATION FILE & BUILD         * 
*   SHADOW-TABLES                           * 
*                                           * 
********************************************* 
			 
	XIF
			 
			 
************************************* 
***                               *** 
**     S U B R O U T I N E S       ** 
**  -USED IN THIS PART ONLY        *
************************************* 
	EJECT
				
				
**                  C O N V R T                 **
**                                              **
**                                              **
**  CONVERSION OF TWO ASCII-DIGITS TO BINARY    **
**                                              **
**  INPUT : A5=ASCII DIGITS                     **
**  OUTPUT: A1=BINARY RESULT                    **
**  WORK.REGS: A3,A2                            **
**************************************************
			 
CONVRT	EQU	*
	LDK	A1,0	CLEAR RESULT REG
	LDR	A3,A5
	SRL	A3,8	GET TEN'S 
	SUK	A3,/30 
	ADR	A1,A3
	LDR	A2,A1	MULT BY 10 
	ADR	A1,A1	.
	SLL	A2,3	. 
	ADR	A1,A2	.... 
	LDR	A3,A5
	ANK	A3,/F	GET ONE'S
	ADR	A1,A3
	RTN	A14
	EJECT

**                  N X T B L K                 **
**                                              **
**                                              **
**  SKIP TO NEXT BLOCK IN CONFIGURATION FILE    **
**                                              **
**  INPUT: A11=ADDRESS TO CURRENT BLOCK-START   **
**  OUTPUT:A11=ADDRESS TO NEXT BLOCK            **
**         A2=BLOCK TYPE (T,C,U) IN RIGTH BYTE  **
**  WORKREGS: A1,A3-A5                          **
**************************************************

NXTBLK	EQU	*
	ADKL	A11,TDBNC	NUMBER OF TERMINAL DEVICE CLASSES 
NXTCOM	EQU	*	ENTRY: SKIP TO NEXT COMMON-BLOCK 
	LCR	A5,A11 
	SLL	A5,8 
	LC	A5,1,A11
	CALL	CONVRT
	LDK	A2,TDBREC
	LDR	A3,A1
	CALL	MULT
	ADR	A11,A3 
	ADKL	A11,2 
	LCR	A5,A11	GET NUMBER OF SPEC, DEV. CLASSES
	SLL	A5,8 
	LC	A5,1,A11
	CALL	CONVRT
	LDK	A2,SDC	SPEC. DEV. CL. RECORD LENGTH
	LDR	A3,A1
	CALL	MULT
	ADR	A11,A3	A11=NEXT BLOCK
	ADKL	A11,2 
	LC	A2,TDBBT,A11	GET BLOCK TYPE 
	RTN	A14
				
				
**                     G E T N U M                **
**                                                **
**                                                **
**  CONVERT 3 ASCII-DIGITS TO BINARY              **
**                                                **
**  INPUT : A6=ADDRESS TO FIRST ASCII-CHARACTER   **
**  OUTPUT: A5=BINARY VALUE                       **
**  WORK.REGS: A2,A4                              **
****************************************************
			 
GETNUM	EQU	*
	LDK	A4,100	FIRST INCREMENT 
	LDK	A5,0	CLEAR RESULT REG
	SUK	A6,1	INIT POINTER
GET030	ADK	A6,1	NEXT DIGIT
	LCR	A2,A6	GET CHAR 
	ANK	A2,/F
GET050	SUK	A2,1 
	RF(N)	GET100	THIS DIGIT READY
	ADR	A5,A4	ACCUMULATE 
	RB	GET050
GET100	SUK	A4,90	NEXT INCREMENT (TEN'S) 
	RB(P)	GET030 
	ADK	A4,81	NEXT INCREMENT (ONE'S) 
	RB(P)	GET030	THIRD DIGIT 
	RTN	A14
	EJECT

* START OF PROGRAM PART 1 * 

* SAVE02=POINTER TO 1:ST USER TASK TTAB-ADDRESS 
* SAVE09=EXECUTION START ADDRESS
			 
SYSLDA	EQU	*-REL	PROGRAM START
* 
*  INIT A15 STACK 
* 
	LD	A15,SCTSTB
	SUKL	A15,4 

	LD	A2,SCTLAC	GET S:GTAB (IF ANY) 
	IFT MMUPAG=0 
	LD	A2,CREID,A2	GET CREDIT IDENTIFICATION 
	XIF
	IFT MMUPAG=1 
	TL	MMTAB,A13	%%##
	EL	A2,CREID,A2 
	XIF
	CM	SWITCH,A13	RESET SAVE-AREAS USED IN SYSLDM
	CM	FLAG,A13
	CWK	A2,'CR'	CREDIT APPLICATION?
	RF(E)	SYA100	YES! START CONFIGURATE
	IFF	CREDIT=1 

* ASSEMBLER APPLICATION 

* SWITCH TO LEVEL 0 ENB 

	LDKL	A4,SYA103	CONTINUATION ADDRESS
	ADR	A4,A13	RELOCATE
	STR	A4,A15	PUT ON STACK
	LDKL	A4,/00C0
	STR	A4,A15	PUT PSW ON STACK
	RTN	A15
SYA103	EQU	*-REL
	XIF
	IFT	MMUPAG-CREDIT=1
	LDKL	A4,MMTAB	GET MM-TABLE ADDRESS 
	ADR	A4,A13	RELOCATE
	ST	A4,MMFROM,A13	SAVE
* FILL MM-TABLES IN USER TASK TTAB'S

	LD*	A5,SCTTCT	GET LENGTH OF TC:TAB 
	LD	A6,SAVE02,A13	1:ST USER TASK
	LDR	A3,A6	SAVE 
	SU	A3,SCTTCT	GET DISPLACEMENT TO 1:ST USER 
	SUR	A5,A3	=> LENGTH OF TC:TAB TO SCAN
* 
*  INIT UNUSED MMU ENTRIES
* 
	LDKL	A1,/FC00
	LDKL	A2,MMTAB
	ADR	A2,A13 
	LDR	A4,A2		=00002
	SUKL	A4,MMBEG
	AD	A4,SCTMMC 
SYA:10	CWR	A4,A2
	RF(E)	SYA105 
	SUK	A4,2 
	STR	A1,A4
	RB	SYA:10
SYA105	SUK	A5,2	ALL?
	RF(N)	SYA107	YES!
	LDR*	A2,A6	TTAB-ADDRESS
	CALL	MOVMMT	MOVE MM-TABLE
	ADK	A6,2	NEXT TTAB 
	RB	SYA105
SYA107	EQU	*
	XIF
	IFF	CREDIT=1 
	LD*	A5,SAVE02,A13	1:ST USER TASK TTAB ADDRESS
	LD	A2,SAVE09,A13	EXECUTION START ADDRESS 
	AD	A2,SCTLAC	ADD RELOCATION ADDRESS
	LDK	A3,0	SEGMENT NUMBER
	CF	A15,ACTOT	QUEUE TASK
	LDKL	A1,FINISH	END OF SYSLDA 
	ADR	A1,A13 
	ABR	A1 
	XIF
SYA100	EQU	*
	IFF CREDIT=0 
	EJECT
			 
* READ CONFIG FILE AND BUILD SHADOWTABLE
			 
	CM	SAVE02,A13	CLEAR 'BUGGER TASK INDICATOR'
	IFT CREDIT-MMUPAG=1
	LD*	A2,SCTLAC	GET START OF P:MTAB
	LD	A12,T:ATAB,A2	T:ATAB ADDRESS
	SUKL	A12,2	ADJUST FOR LENGTH-WORD
	ST	A12,T:ATOD,A13	SAVE 
	LD	A4,U:BTAB,A2	GET U:BTAB FROM P:MTAB 
	SUK	A4,2	INCLUDE LENGTH-WORD 
	ST	A4,U:BTOD,A13	SAVE IN SYSLDA
	XIF
	IFT	CREDIT+SWBMMU=2
	LD	A4,S:BTAB,A2	GET S:BTAB ADDRESS 
	SUK	A4,2	ADJUST FOR LENGTH WORD
	ST	A4,S:BTOD,A13	SAVE
	XIF
	IFT	CREDIT-MMUPAG=1
* T:ATAB PROCESSING:
			 
	LDR*	A4,A12	T:ATAB-LENGTH
	LDR	A3,A4	SAVE 
	AD	A3,SCTSFA	ADD MONITOR END ADDRESS 
* CHECK ADDRESSES 

	LDR	A11,A3	END OF SHADOW-TAB 
	LDR	A9,A13	START OF SYSLDA 
	CALL	CMPADR
	RF(L)	SYA110	OK! 
	LDKL	A1,LMP3	MEMORY OVERFLOW 
	CALL	ERROR 
SYA110	LDR	A9,A2	GET P:MTAB ADDRESS 
	LDK	A2,0 
* CLEAR T:ATAB SHADOW-TABLE:
			 
ZERO	SUK	A3,2	NEXT
	STR	A2,A3	CLEAR
	CW	A3,SCTSFA	ALL?
	RB(NE)	ZERO	NO!
	STR	A4,A3	STORE TABLE LENGTH 
	LD	A11,SAVE01,A13	GET CONFIG START 
	LC	A2,TDBBT,A11	GET BLOCKTYPE
	CCK	A2,'TT'	TASK DEF?
	RF(E)	SYA120	OK! 
	LDK	A1,LMP4	NO TASK PRESENT
	CALL	ERROR 
SYA120	LC	A2,TDBMC+4,A11	GET TASK ID
	SLL	A2,8	. 
	LC	A2,TDBMC+5,A11	...
	CWK	A2,'TB'	BUGGER TASK? 
	RF(NE)	SYA125	NO!
	ST	A2,SAVE02,A13	INDICATE BUGGER TASK PRESENT	=00001 
	RF	SYA136	SKIP TO NEXT BLOCK 
SYA125	LDR	A8,A12	SAVE
	LDR*	A4,A12	T:ATAB LENGTH
SYA130	ADKL	A8,2	NEXT T:A 
	LDR*	A6,A8	GET T:A ADDRESS 
	SUK	A4,2 
	RF(NZ)	SYA135
	LDK	A1,LMP5	NO PROTOTYPE FOUND (TID ERROR) 
	CALL	ERROR 
SYA135	EQU	*
	CW	A2,T:ATID,A6	TID EQUAL? 
	RB(NE)	SYA130	NO!
	SUR*	A4,A12	T:ATAB LENGTH
	XIF
	IFT CREDIT+MMUPAG=2
	EL*	A2,SCTLAC	GET START OF P:MTAB
	EL	A12,T:ATAB,A2	T:ATAB ADDRESS
	SUKL	A12,2	INCLUDE LENGTH WORD 
	ST	A12,T:ATOD,A13	SAVE IN SYSLDA 
	EL	A4,U:BTAB,A2	U:BTAB ADDRESS 
	SUK	A4,2	ADJUST FOR LENGTH WORD
	ST	A4,U:BTOD,A13	SAVE IN SYSLDA
	XIF
	IFT	CREDIT+MMUSWB=3
	EL	A4,S:BTAB,A2	GET S:BTAB ADDRESS 
	SUK	A4,2	ADJUST FOR LENGTH WORD
	ST	A4,S:BTOD,A13	SAVE
	XIF
	IFT	CREDIT+MMUPAG=2
* T:ATAB PROCESSING:
			 
	ELR	A4,A12	T:ATAB-LENGTH 
	LDR	A3,A4	SAVE 
	SLL	A3,1	RESERVE FOR MM-TABLE ADDRESS TABLE
	AD	A3,SCTSFA	ADD MONITOR END ADDRESS 
* CHECK ADDRESSES 

	LDR	A11,A3	END OF SHADOW-TABLE 
	LDR	A9,A13	START OF SYSLDA 
	CALL	CMPADR
	RF(L)	SYA110	OK! 
	LDKL	A1,LMP3	MEMORY OVERFLOW 
	CALL	ERROR 
SYA110	LDR	A9,A2	GET P:MTAB ADDRESS 
* CLEAR T:ATAB SHADOW-TABLE:
			 
SYA115	SUK	A3,2	NEXT
	CMR	A3	CLEAR 
	CW	A3,SCTSFA	ALL?
	RB(NE)	SYA115	NO!
	STR	A4,A3	STORE TABLE LENGTH 
	LD	A11,SAVE01,A13	GET CONFIG START 
	LC	A2,TDBBT,A11	GET BLOCKTYPE
	CCK	A2,'TT'	TASK DEF?
	RF(E)	SYA120	OK! 
	LDK	A1,LMP4	NO TASK PRESENT
	CALL	ERROR 
SYA120	LC	A2,TDBMC+4,A11	GET TASK ID
	SLL	A2,8	. 
	LC	A2,TDBMC+5,A11	...
	CWK	A2,'TB'	BUGGER TASK? 
	RF(NE)	SYA125	NO!
	ST	A2,SAVE02,A13	INDICATE 'BUGGER TASK PRESENT'
	RF	SYA136	SKIP THIS BLOCK
SYA125	LDR	A8,A12	SAVE
	ELR	A4,A12	T:ATAB LENGTH 
SYA130	ADKL	A8,2	NEXT T:A 
	ELR	A6,A8	GET T:A ADDRESS
	SUK	A4,2 
	RF(NZ)	SYA135
	LDK	A1,LMP5	NO PROT. FOUND (TID ERROR) 
	CALL	ERROR 
SYA135	EQU	*
	EL	A10,T:ATID,A6	GET TID 
	CWR	A2,A10	TID EQUAL?
	RB(NE)	SYA130	NO!
	ELR	A10,A12
	SUR	A4,A10	T:ATAB LENGTH 
	XIF
	IFF CREDIT=0 
	NGR	A4,A4	=> A4=DISPLACEM. IN SHADOW-TAB 
	LC	A5,TDBNT,A11	GET NUMBER OF TASKS
	SLL	A5,8 
	LC	A5,TDBNT+1,A11
	CALL	CONVRT
	LD	A2,SCTSFA	START OF SHADOW TABLE 
	ADR	A2,A4
	ADRS	A1,A2	STORE NUMBER OF TASKS IN SHADOW TABLE 
			 
* SKIP TO NEXT BLOCK
			 
SYA136	CALL	NXTBLK
SYA137	EQU	*
	CCK	A2,'TT'
	RB(E)	SYA120	NEXT TASK DEF BLOCK 
	CCK	A2,'CC'
	RF(NE)	SYA140
	ADKL	A11,1	STEP TO NUMBER OF COM.DEV.
	CALL	NXTCOM	SKIP COMMON DEF
SYA140	CCK	A2,'UU'
	RF(NE)	SYA141	NO UWB'S 
	LD	A8,U:BTOD,A13	GET MODIFIED U:BTAB ADDRESS 
	CALL	USWBTP	INSERT NUMBER OF COPIES IN PROTOTYPE 
SYA141	EQU	*
	XIF
	IFT	CREDIT+SWPBLK=2
	LCR	A2,A11 
	CCK	A2,'SS'
	RF(NE)	SYA152
	LD	A8,S:BTOD,A13 
	CALL	USWBTP
	XIF
	IFT	CREDIT=1 
	RF	SYA152
	EJECT
*********************************************************************** 
*                                                                     * 
*  USWBTP - INSERT NUMBER OF COPIES IN U:BTAB/S:BTAB PROTOTYPE TABLE  * 
*  =================================================================  * 
*                                                                     * 
*  REFERENCED IN:  SYSLDA                                             * 
*                                                                     * 
*  ENTRY:  A8 - MODIFIED ADDRESS TO U:BTAB/S:BTAB PROTOTYPE TABLE     * 
*          A11- POINTER IN CONFIGURATION TABLE TO 'U' OR 'S' BLOCK    * 
*                                                                     * 
*  EXIT:                                                              * 
*                                                                     * 
*  WORK REGISTERS:                                                    * 
*                                                                     * 
*  SUBROUTINES:  GETNUM,ERROR                                         * 
*                                                                     * 
*********************************************************************** 

USWBTP	EQU	*

	XIF
	IFT CREDIT-MMUPAG=1
	ADKL	A11,1 
	LDR	A6,A11 
	CALL	GETNUM	PACK 3 DIG. RESULT IN A5 
	LDR	A1,A5	SAVE NUMBER OF UWB'S 
SYA142	EQU	*
	LDR	A12,A8 
	LDR*	A3,A12	LENGTH OF U:BTAB 
	ADKL	A11,UDBFST-1	FIRST UDB RECORD 
SYA145	EQU	*
	LCR	A2,A11	GET FIRST CHARACTER FROM CONFIG 
	SLL	A2,8 
	LC	A2,1,A11	GET 2:ND CHAR
	CW	A2,UPNAME,A12	COMPARE W. 1:ST WORD IN PROTOTYP
	RF(E)	FRSTOK	FIRST TWO CHARACTERS OK!
SYA147	SUK	A3,UP:REC	DEC. NUMBER OF PROT.'S 
	RF(NN)	SYA150
	LDK	A1,LMP6	UWB NOT FOUND
	CALL	ERROR 
SYA150	EQU	*
	ADKL	A12,UP:REC	ADD TO NEXT RECORD 
	RB	SYA145
FRSTOK	LC	A2,2,A11	GET 3:RD CHAR
	CC	A2,UPNAME+2,A12 
	RB(NE)	SYA147	.NEQ.
	EJECT
			 
* PROTOTYPE FOUND * 
			 
	ADKL	A11,NAMUWB	SKIP TO 'NUMBER OF BOCKS' IN CONFIG
	LDR	A6,A11 
	CALL	GETNUM	CONVERT
	SC	A5,UPNUMB,A12	SAVE IN U:BTAB (SHADOWTABLE)
	SUK	A1,1	DEC. NO OF TYPES IN CONFIG FILE 
	RB(P)	SYA142 
	ADKL	A11,UDBFST-1
	RTN	A14
	XIF
	IFT CREDIT+MMUPAG=2
	ADKL	A11,1 
	LDR	A6,A11 
	CALL	GETNUM	PACK 3 DIG. RESULT IN A5 
	LDR	A1,A5	SAVE NUMBER OF UWB'S 
SYA142	EQU	*
	LDR	A12,A8	START OF TABLE
	ELR	A3,A12	LENGTH OF U:BTAB
	ADKL	A11,UDBFST-1	FIRST UDB RECORD 
SYA145	EQU	*
	LCR	A2,A11	GET FIRST CHARACTER FROM CONFIG 
	SLL	A2,8 
	LC	A2,1,A11	GET 2:ND CHAR
	EL	A10,UPNAME,A12	GET FIRST WORD IN PROTOTYPE
	CWR	A2,A10 
	RF(E)	FRSTOK	FIRST WORD OK!
SYA147	SUK	A3,UP:REC	DEC. NUMBER OF PROT.'S 
	RF(NN)	SYA150
	LDK	A1,LMP6	UWB NOT FOUND
	CALL	ERROR 
SYA150	EQU	*
	ADKL	A12,UP:REC	ADD TO NEXT RECORD 
	RB	SYA145
FRSTOK	LC	A10,2,A11	GET 3:RD CHAR FROM CONFIG 
	EL	A2,UPNAME+2,A12	GET 3:RD CHAR FROM PROY 
	SRL	A2,8 
	ANKL	A10,/FF 
	CWR	A10,A2 
	RB(NE)	SYA147	.NEQ.
	EJECT
			 
* PROTOTYPE FOUND * 
******************* 
			 
	ADKL	A11,NAMUWB	SKIP TO 'NUMBER OF BOCKS' IN CONFIG
	LDR	A6,A11 
	CALL	GETNUM	CONVERT
	EL	A10,UPNUMB-1,A12	SAVE IN U:BTAB SHADOW-TABLE
	ANKL	A10,/FF00 
	ORR	A10,A5 
	ES	A10,UPNUMB-1,A12
	SUK	A1,1	DEC. NO OF TYPES IN CONFIG FILE 
	RB(P)	SYA142 
	ADKL	A11,UDBFST-1
	RTN	A14
	XIF
	IFT	CREDIT=1 
	EJECT
SYA152	EQU	*

* GET START OF SYSLOAD AFTER MOVE 
			 
	XIF
	IFT	CREDIT-MMUPAG=1
	LD*	A7,T:ATOD,A13	GET LENGTH OF T:ATAB 
	XIF
	IFT	CREDIT+MMUPAG=2
	EL*	A7,T:ATOD,A13	GET T:ATAB LENGTH
	SLL	A7,1	RESERVE FOR MM-ADDRESS-TABLE
	XIF
	IFF CREDIT=0 
	AD	A7,SCTSFA	TO-ADDRESS (AFTER SHADOW-TABLE
	ADK	A7,1 
	ANKL	A7,/FFFE	EVEN ADDRESS 

* CALCULATE RELOCATION

	LDR	A2,A13 
	SUR	A2,A7	MOVE-LENGTH (SYSLDA) 
	NGR	A2,A2
	ST	A2,SAVE04,A13	SAVE NEW RELOCATION TEMPORARY 
	IFT CREDIT+MMUPAG=2
* CREATE SYSLDA & DDIV MM-TABLE * 

	LDR	A2,A7	TO-ADDRESS (SYSLDA)
	ANKL	A2,/F000	FIRST PAGE 
	ST	A2,MMREL1,A13	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
SYA157	STR	A2,A11	STORE PAGE-POINTER
	ADKL	A11,2	NEXT ENTRY
	ADKL	A2,/400	PAGE INCREMENT
	SUK	A3,1	ALL?
	RB(NZ)	SYA157	NO!
	ANKL	A7,/FFF	GET DISPLACEM. IN PAGE
	XIF
	IFF CREDIT=0 
	ST	A7,SAVE12,A13	SAVE (LOGICAL) TO-ADDRESS 
	ADKL	A7,LENGT2	ADD LEN. OF SYSLDA TO MOVE
	ST	A7,SAVE03,A13	SAVE NEW DDIV ADDRESS 
	LDR	A6,A7	 
* CALCULATE DDIV FROM-ADDRESS * 

	LD	A1,SCTLAC	GET S:GTAB
	ST	A1,SAVE13,A13	SAVE S:GTAB ADDRESS 
	ST	A9,SCTLAC	SAVE START OF P:MTAB
	IFT CREDIT-MMUPAG=1
	LD	A3,NUMSEG,A1	NUMBER OF SEGMENTS 
	XIF
	IFT CREDIT+MMUPAG=2
	EL	A3,NUMSEG,A1	NUMBER OF SEGMENTS 
	XIF
	IFF CREDIT=0 
	LDK	A2,SEGREC	SEGMENT BLOCK RECORD LENGTH
	CALL	MULT
	ADR	A1,A3
	ADK	A1,NUMSEG+2	=> START OF DDIV 
	LD	A2,SAVE04,A13	GET NEW RELOCATION INCREMENT
	ADS	A2,M:REL,A13	AND ADJUST RELOCATION BASE
	IFT CREDIT+MMUPAG=2

	ST	A1,SAVE04,A13	SAVE DDIV 'FROM'-ADDRESS
	XIF
	IFT CREDIT-MMUPAG=1
	ST	A1,SAVE04,A13	SAVE DDIV FROM-ADDRESS
	XIF
	IFF CREDIT=0 
	SUR	A6,A1	RELOCATION FOR DDIV
	EJECT

				
				
* RELOCATE ADDRESSES IN T:ATAB AFTER MOVE * 
* CALCULATE TOTAL (=REAL) LENGTH        * 
* REMOVE NOT USED ENTRIES IN T:ATAB     * 
* A9=P:MTAB   A6=MOVE-RELOC             * 
***************************************** 
	IFT CREDIT-MMUPAG=1

* INITIATE POINTERS 

	LD	A8,T:ATOD,A13	GET T:ATAB ADDRESS
	LDR*	A3,A8	GET LENGTH
	ADR	A3,A8	END OF T:ATAB
	ST	A3,ENDADD,A13	SAVE
	LD	A5,SCTSFA	GET START OF T:ATAB SHADOW-TAB
	LDR	A4,A5	2:ND POINTER 
	LDR	A2,A8	2:ND POINTER IN T:ATAB 
	LDK	A3,2	SET 'NEW' T:ATAB COUNTER
	SUR	A11,A11	CLEAR REAL LENGTH ACCUMULATOR

* SCAN T:ATAB:

SYA160	ADKL	A8,2	TAKE NEXT T:A
	ADK	A5,2	NEXT T:A IN SHADOW-TAB
	CW	A8,ENDADD,A13 
	RF(E)	SYA170	ALL DONE
	LDR*	A1,A8	GET T:A 
	LDR*	A7,A5	GET CONTENTS OF SHADOW-TAB
	RB(Z)	SYA160	THIS T:A IS NOT USED!!!!! 
	ADR	A11,A7	ACCUMULATE LENGTH 
	ADK	A3,2	INCREMENT 'NEW' T:ATAB LENGTH 
	ADK	A4,2	UPDATE 2:ND SHADOW-TAB ADDRESS
	ADK	A2,2	UPDATE 2:ND T:ATAB ADDRESS
	STR	A7,A4	STORE NUMBER OF T:A'S (EV. ON NEW PLACE) 
	LDR*	A10,A8	GET T:A-ADDRESS
	ADR	A10,A6	RELOCATE
	STR	A10,A2	STORE ADDR. (EV. ON NEW PLACE)
* RELOCATE W.B.-ADDRESSES 

	LD	A12,T:DAD,A1	GET T:D-ADDRESS
	LD	A7,WATLEN,A12	LENGTH OF WAT 
	ADK	A1,WATFST+2	ADD TO FIRST W.B.-ADDRESS
SYA165	SUK	A7,1	DEC. COUNTER
	RB(N)	SYA160	TAKE NEXT T:A 
	ADRS	A6,A1	RELOCATE
	XIF
	IFT CREDIT+MMUPAG=2

* INITIATE POINTERS 

	LD	A8,T:ATOD,A13	T:ATAB
	ELR	A3,A8	GET LENGTH 
	ADR	A3,A8	END OF T:ATAB
	ST	A3,ENDADD,A13	SAVE
	LD	A5,SCTSFA	GET START OF T:ATAB SHADOW-TAB
	LDR	A4,A5	2:ND POINTER 
	LDR	A2,A8	2:ND POINTER IN T:ATAB 
	LDK	A3,2	SET 'NEW' T:ATAB COUNTER
	SUR	A11,A11	CLEAR REAL LENGTH ACCUMULATOR

* SCAN T:ATAB:

SYA160	ADKL	A8,2	TAKE NEXT T:A
	ADK	A5,2	NEXT T:A IN SHADOW-TAB
	CW	A8,ENDADD,A13 
	RF(E)	SYA170	ALL DONE
	ELR	A1,A8	GET T:A
	LDR*	A7,A5	GET CONTENTS OF SHADOW-TAB
	RB(Z)	SYA160	THIS T:A IS NOT USED!!!!! 
	ADR	A11,A7	ACCUMULATE LENGTH 
	ADK	A3,2	INCREMENT 'NEW' T:ATAB LENGTH 
	ADK	A4,2	UPDATE 2:ND SHADOW-TAB ADDRESS
	ADK	A2,2	UPDATE 2:ND T:ATAB ADDRESS
	STR	A7,A4	STORE NUMBER OF T:A'S (EV. ON NEW PLACE) 
	ELR	A10,A8	GET T:A-ADDRESS 
	ADR	A10,A6	RELOCATE
	ESR	A10,A2	STORE ADDR. (EV. ON NEW PLACE)
* RELOCATE W.B.-ADDRESSES 

	EL	A12,T:DAD,A1	GET T:D-ADDRESS
	EL	A7,WATLEN,A12	LENGTH OF WAT 
	ADK	A1,WATFST+2	ADD TO FIRST W.B.-ADDRESS
SYA165	SUK	A7,1	DEC. COUNTER
	RB(N)	SYA160	TAKE NEXT T:A 
	ELR	A10,A1	GET ADDRESS 
	ADR	A10,A6	RELOCATE
	ESR	A10,A1 
	XIF
	IFF CREDIT=0 
	ADK	A1,4	NEXT W.B. 
	RB	SYA165

SYA170	EQU	*
	ST	A6,MOVADD,A13	SAVE
	ST*	A3,SCTSFA	STORE NEW TABLE LENGTH IN SHADOW-TAB 
	IFT CREDIT+MMUPAG=2
	ES*	A3,T:ATOD,A13	AND IN T:ATAB
	XIF
	IFT CREDIT-MMUPAG=1
	ST*	A3,T:ATOD,A13	AND IN T:ATAB
	XIF
	IFF CREDIT=0 
	LDR	A2,A11	GET NUMBER OF T:A'S ACCUMULATOR 
	SLL	A2,1	CALC. REAL LENGTH (BYTES) 
	ADK	A2,2 
	ST	A2,SAVE05,A13	SAVE TOT. NUMBER OF T:A'S 
				
	EJECT
******************************
* RELOCATE ADDRESSES IN U:BTAB *
* (REAL LENGTH=PROTOTYPE LEN.) *
********************************

	IFT CREDIT-MMUPAG=1
	LD	A5,U:BTOD,A13	U:BTAB ADDRESS
	LDR*	A3,A5	LENGTH
	ST	A3,SAVE06,A13 
	ADK	A5,2	SKIP LENGTH WORD
	SUK	A3,2	  -"- 
SYA180	RF(Z)	SYA185	ALL DONE! 
	ADRS	A6,A5	RELOCATE
	XIF
	IFT CREDIT+MMUPAG=2
	LD	A5,U:BTOD,A13	U:BTAB ADDRESS
	ELR	A3,A5	TABLE LENGTH 
	ST	A3,SAVE06,A13	SAVE LENGTH OF U:BTAB 
	ADK	A5,2 
	SUK	A3,2	SUB LENGTH-WORD 
SYA180	RF(Z)	SYA185 
	ELR	A10,A5	GET ADDRESS 
	ADR	A10,A6	RELOCATE
	ESR	A10,A5 
	XIF
	IFF CREDIT=0 
	ADK	A5,UP:REC	ADD TO NEXT RECORD IN U:BTAB PROTOTYP
	SUK	A3,UP:REC
	RB	SYA180
	EJECT
SYA185	EQU	*
	IFT	CREDIT+MMUSWB=3
* 
*  COMPUTE REAL LENGTH OF S:BTAB
* 
	LD	A5,S:BTOD,A13	S:BTAB ADDRESS
	ELR	A3,A5	LENGTH OF PROTOTYPE
	LDR	A2,A3	SAVE 
	SUK	A3,2	EXCLUDE LENGTH WORD 
SYA190	RF(Z)	SYA199	ALL RECORDS SCANNED!
	EL	A4,2,A5	GET PROT. W.B.-ADDR.
	ADR	A4,A6	RELOCATE 
	ES	A4,2,A5	STORE IT BACK 
	EL	A4,UPNUMB-1,A5	GET NUMBER OF COPIES 
	ANK	A4,/FF	GET RIGHT BYTE
SYA192	RF(Z)	SYA194	NO MOORE OF THIS TYPE!
	ADK	A2,2	INCREMENT LENGTH
	SUK	A4,1	DECREMENT NUMBER OF COPIES
	RB	SYA192
SYA194	ADK	A5,UP:REC	NEXT RECORD IN S:BTAB PROTOTYPE
	SUK	A3,UP:REC	DECREMENT LENGTH 
	RB	SYA190
	XIF
	IFT	CREDIT+SWBMMU=2
	LD	A5,S:BTOD,A13	S:BTAB ADDRESS
	LDR*	A3,A5	LENGTH OF S:BTAB PROTOTYPE
	LDR	A2,A3	SAVE 
	SUK	A3,2	EXCLUDE LENGTH WORD 
SYA195	RF(Z)	SYA199	ALL RECORDS SCANNED!
	LD	A4,2,A5	GET PROT. W.B.-ADDR.
	ADR	A4,A6	RELOCATE 
	ST	A4,2,A5	STORE IT BACK 
	LD	A4,UPNUMB-1,A5	GET NUMBER OF COPIES 
	ANK	A4,/FF 
SYA196	RF(Z)	SYA198	NO MOORE OF THIS TYPE!
	ADK	A2,2	INCREMENT LENGTH
	SUK	A4,1	DECREMENT NUMBER OF COPIES
	RB	SYA196
SYA198	ADK	A5,UP:REC	NEXT RECORD IN S:BTAB PROTOTYPE
	SUK	A3,UP:REC	DECREMENT LENGTH 
	RB	SYA195
	XIF
	IFT	CREDIT+SWPBLK=2
SYA199	ST	A2,SAVE25,A13	SAVE COMPUTED LENGTH
	XIF
	IFT	CREDIT=1 
	EJECT

* RELOCATE T:ATAB- AND U:BTAB-ADDRESSES IN P:MTAB 
			 
	ADS	A6,T:ATOD,A13
	ADS	A6,U:BTOD,A13
	IFT	CREDIT+SWPBLK=2
	ADS	A6,S:BTOD,A13
	XIF
	IFT CREDIT-MMUPAG=1
* CALCULATE NEW DDIV END

	LDR	A5,A9
	SU	A5,SAVE04,A13	END-START 
	AD	A5,SAVE12,A13	ADD NEW START 
	ST	A5,DATEND,A13	SAVE
	XIF
	IFT CREDIT+MMUPAG=2


* STORE MMTABLE ADDRESSES 

	LDK	A4,MMDDIV
	ADR	A4,A13	GET TABLE ADDRESS 
	LDR	A5,A13	CALC. REAL RELOCATION 
	SU	A5,SAVE12,A13 
	SU	A5,MMREL1,A13 
	SUR	A4,A5	RELOCATE 
	ST	A4,MMTO,A13	AND SAVE
	LDK	A4,MMTAB 
	ADR	A4,A13	'WORK-TABLE' ADDRESS
	SUR	A4,A5	RELOCATE 
	ST	A4,MMFROM,A13 
* CALCULATE DDIV END

	LDR	A5,A9	DDIV END 
	SU	A5,SAVE04,A13	ENT-START 
	AD	A5,SAVE12,A13	ADD NEW START 
	LDR	A6,A5
	ANKL	A6,/F000	GET LOGICALL PAGE (MM-ENTRY) 
	SRL	A6,11	ADJUST FOR ADDRESSING
	ADK	A6,MMDDIV	ADD RELATIVE START ADDRESS 
	ADR	A6,A13	RELOCATE
	LDR*	A6,A6	GET MM-TABLE CONTENTS 
	ST	A6,FSTPAG,A13	SAVE
	ANKL	A5,/FFF	GET DISPLACEMENT
	ST	A5,FSTADR,A13	AND SAVE
	XIF
	IFF CREDIT=0 
* CONTINUE IN PART 2 *
			 
	LD	A2,SAVE12,A13	GET TO-ADDRESS (SYSLDA) 
	OR	A2,MMREL1,A13	PHYSICALL ADDRESS 
	LDR	A5,A2	SAVE 
	LDKL	A7,START2	GET EXECUTION START ADDRESS 
	ADR	A7,A2
	LDKL	A3,LENGT2	SYSLDA LENGTH 
	LDR	A1,A13	FROM-ADDRESS

* MOVE SYSLDA * 

	IFT CREDIT-MMUPAG=1
NXTMOV	LDR*	A4,A1	GET WORD
	STR	A4,A2	STORE WORD 
	ADK	A1,2 
	ADK	A2,2 
	SUK	A3,2	DEC. LENGTH 
	RB(NN)	NXTMOV
	XIF
	IFT CREDIT+MMUPAG=2
	MVB	A3 
	XIF
	IFF CREDIT=0 

	ABR	A7	HEJ SVEJS! VI SES I PART 2... 
	XIF
	IFT	CREDIT=0 
	LDKL	A1,LMP9 
	CALL	ERROR	INCONSISTENT MONITOR
	XIF
LDAEND	EQU	*
	END
DataMuseum.dk

Philips Data Systems

⟦43fd7ce48⟧

Derivation

PTS(SC)

Full view
