DataMuseum.dk

top - metrics - download

    Length: 139000 (0x21ef8)
    Notes: pts_type(SC)
    Names: »SYSLOD.SC«

└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
    └─⟦this⟧ »MONGEN/SYSLOD.SC« 

PTS(SC)

	IDENT SYSLOD 	REL 11.0 81-05-22 870105041100 

			=12,COND. ASSEMBLY EDM INTRODUCED
			=12,REL 11.0 81-05-19
			=11,ERROR IN READ ROUT. FOR 16M,80M
			=11,REL 11.0 81-05-11
			=10,TWO WORDS IN INTERRUPT TABLE ARE 
			=10,DESTROYED
			=10,REL 11.0 81-04-08
			=9,NEW CONTROL UNIT 16M,80M DISC 
			=9,REL 11.0 81-04-06 
			=8,WHEN CFTEST=1 TEST ALSO RWSI CONNECTION 
			=8,REL 11.0 81-03-31 
			=7,WRONG VTOC-SECTOR POINTER 
			=7,REL 11.0 81-03-12 
			=6,DC BLOCK DESTROYED WHEN CFTEST=0
			=6,REL 11.0 81-02-06 
			=5,SUPPORTS LOADING FROM TWO HARDDISC UNITS
			=5,REL 11.0 81-01-29 
			=4,FLOPPY MUX CORRECTED
			=4,REL 11.0 81-01-26 
			=3,IF 256 KBYTE MEMORY OVERFLOW
			=3,WILL OCCUR IN SEGMENT ALLOCATION
			=3,PRR 11.0 80-12-03 
			=2,LOOK IF APPL. TYPE ALLOWED IN MONITOR 
			=2,REDESIGNED SEGMENT ALLOCATION ALGORITM
			=2,PRR 11.0 80-11-20 
			=1,MXSTAB ADDR. NOT REL IF CFTEST=0
			=1,PRR 11.0 80-11-19 
	ENTRY	SYSLOD 
	ENTRY	SYSBAS 
	ENTRY	NUMSEG 
	ENTRY	PRGLG1 
	ENTRY	APLADA 
	ENTRY	APLLAC 
	ENTRY	APLLAP 
	ENTRY	APLLDA 
	ENTRY	APLMMC 
	ENTRY	APLMMP 
	ENTRY	APLNPE 
	ENTRY	APLREL 
	ENTRY	APLSTA 
	ENTRY	APLTYP 
	ENTRY	APLIOE 
	ENTRY	APLSEG 
	ENTRY	APLSWB 
*************************** 
*                         * 
*  ENTRIES AND EXTERNALS  * 
*                         * 
*************************** 
	EXTRN	CONVRT 
	EXTRN	POB	RESTORE REGISTER CONTENTS
	EXTRN PUSH	SAVE REGISTER CONTENTS
	EXTRN	SYSLDM 
	EXTRN	SCTANO 
	EXTRN	SCTBUG 
	EXTRN	SCTEFA 
	EXTRN	SCTMSZ 
	EXTRN	SCTMXS	ADDRESS TO MONITOR EXTENT TABLE 
	EXTRN	SCTNOP 
	EXTRN	SCTOPT 
	EXTRN	SCTIPL 
	EXTRN	SCTPSZ 
	EXTRN	SCTSFA 
	EXTRN	SCTSTB 
	EJECT
	EXTRN	REL
	EXTRN	ERROR
	EXTRN	MMDDIV 
	EXTRN	TABBE
	EXTRN	MMEND
	EXTRN	CMPADR 
	EXTRN	MOVE 
	EXTRN	TTB:MT	DISPLACEMENT TO MMU TABLE IN TTAB 
	EXTRN	TTB:CB 
	EXTRN	STKCOM 
	EXTRN	STKEND 
	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	SAVE05 TERM DEF
TDC	EQU	7	TERMINAL DEVICE CLASS 
TLC	EQU	7	LINE CONNECTION 
TDBREC	EQU	TDC+TLC	TDB-RECORD LENGTH
* 
SDC	EQU	7	SPECIAL DEVICE CLASS-RECORD 
* 
* COMMON DEVICE DEF. BLOCK: 
CDBBT	EQU	0	1A BLOCK TYPE 
CDBNC	EQU	CDBBT+1	2N NUMBER OF SPEC. DEV. CLASSES 
SDCFST	EQU	CDBNC+2	SAVE05 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	SAVE05 UDB-RECORD
NAMUWB	EQU	3	NAME OF UWB
NUMUBL	EQU	3	NUMBER OF BLOCKS 
UDBREC	EQU	NAMUWB+NUMUBL	UDB RECORD-LENGTH
	EJECT
****************
* SOP-HANDLING *
****************
SOP	EQU	/2E	DEVICE ADDRESS

LMP1	EQU	/400	LAMP 1 CODE 
LMP2	EQU	/200 
LMP3	EQU	/100 
LMP4	EQU	/80
LMP5	EQU	/40
LMP6	EQU	/20
LMP7	EQU	/10
LMP8	EQU	8
LMP9	EQU	4
LMP10	EQU	2 
LMP11	EQU	1 
	EJECT


*********************************** 
*  MXSTAB DISPLACEMENTS           * 
*********************************** 


MX:NOX	EQU	6
MX:NOS	EQU	8	NUMBER OF SEGMENT CLUSTERS 


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


APLADA	EQU	22	APPLICATION DISC FILE ADDRESS	=2
APLREL	EQU	18	APPLICATION RELOCATION BASE 
APLIOE	EQU	0	APPLICATION RESTART ADDRESS
APLLAC	EQU	14	APPLICATION LOAD ADDR. (LOGICAL ADDR.)
APLLAP	EQU	12	LOGICAL PAGE ADDRESS
APLLDA	EQU	0	APPLICATION LOAD ADDR. (PHYSICAL ADDR.)
APLMMC	EQU	10	APPLICATION MMU START ENTRY 
APLMMP	EQU	8	SEGMENT START MMU ENTRY
APLSEG	EQU	4	PHYSICAL START OF 1ST SEGMENT
APLNPE	EQU	6	NUMBER OF PAGE ENTRIES IN MMU
APLPSZ	EQU	20	APPLICATION SEGMENT SIZE	=2 
APLSWB	EQU	2	APPLICATION SWB
APLSTA	EQU	16	APPL. PGM START ADDRESS 
APLTYP	EQU	8	APPLICATION TYPE 
	EJECT
******************************
*                            *
*  COMMON DISPLACEMENTS      *
*  AND CONSTANTS             *
*                            *
******************************
			 
			 
ACBLEN	EQU	26	APPLICATION CONTROL BLOCK LENGTH	=2 
APLTAB	EQU	12	ADDRESS TO APPL. CONTROL TABLE
APPLNO	EQU	18	APPLICATION NUMBER
BUFSIZ	EQU	14	TEMPORARY BUFFER SIZE 
CONLEN	EQU	0	LENGTH OF CONFIGURATION DATA 
CONSTA	EQU	2	START OF CONFIGURATION DATA
DATEND	EQU	34	END OF DDIV PROTOTYPE 
FSTADR	EQU	20	1ST FREE ADDRESS WHEN ALLOCATING BUFFER 
FSTPAG	EQU	22	1ST FREE PAGE (PHYSICAL)
FYSPAG	EQU	24	LAST PHYSICAL PAGE NUMBER 
LSTADR	EQU	26	LAST ADDRESS WHEN BUILDING DATA PART
MAPLEN	EQU	30	LENGTH OF AREA TO MAP 
MMFROM	EQU	36	2ND MMU TABLE WORK AREA 
MMTO	EQU	38	1:ST MMU TABLE WORK AREA
M:REL	EQU	16	RELOCATION CONSTANT
SYSBUF	EQU	28	START OF TEMPORARY BUFFER 
SWBFSA	EQU	4	SWB-FILE START ADDRESS (2 WORDS) 
SWBFSE	EQU	8	SWB-FILE END ADDRESS (2 WORDS) 
TTAB	EQU	32	WORK AREA FOR MMU TABLE 
COM01	EQU	40	COMMON SAVE AREA 1 
COM02	EQU	42	COMMON SAVE AREA 2 
COM03	EQU	44	COMMON SAVE AREA 3 
TOTSGM	EQU	46	TOTAL NUMBER OF SEGMENTS
SWBFLG	EQU	48	SWAPPPABLE WORK BLOCK FLAG
COM04	EQU	50	COMMON SAVE AREA 4 
DCBLK	EQU	54	START OF DC CONF. DATA 
	EJECT
******************************
*                            *
*  LOCAL DISPLACEMENTS       *
*  AND CONSTANTS             *
*                            *
******************************
			 
			 
APLCNT	EQU	4	NO OF APPLICATIONS TO LOAD 
BLKLEN	EQU	6	SEGMENT BLOCK LENGTH 
CARFIX	EQU	54	CARTRIDGE OR FIX INDICATOR 16M DISC	=9
CBLEN	EQU	256	CASSETTE BUFFER LENGTH
COMLG	EQU	4	LENGTH OF CORE RESIDENT PART
CONDAD	EQU	44	CONF. FILE DISC ADDRESS 
*	EQU	46
CONDEV	EQU	32	SAVE AREA FOR CONF. DATA DEV. 
CURAPL	EQU	24	CURRENT APPL. CONTR. BLOCK
DEVTYP	EQU	50	DEVICE TYPE 
DISCAD	EQU	28	SAVE AREA FOR DISC ADDRESS (2 WORDS)
ECNFBF	EQU	6	END OF CONF. BUFFER
EINPBF	EQU	2	END OF INPUT BUFFER
ESYSTA	EQU	0	END OF SYSTEM AREA 
EXLEN	EQU	4	MONITOR EXTENT LENGTH 
FILCOD	EQU	36	LOAD DEVICE FILE CODE (NOT CASSETTE)
FSTSEC	EQU	16	FIRST SECTOR INDICATOR
IPLDEV	EQU	34	SAVE AREA FOR PGM LOAD DEVICE 
IPLTYP	EQU	48	PGM LOAD DEVICE TYPE
LLDADR	EQU	12	LOGICAL LOAD ADDRESS
LSTREC	EQU	20	LAST RECORD OF CONF. FILE 
LSTASG	EQU	8	LOGICAL START OF FIRST SEGMENT 
MONNO	EQU	22	MONITOR NUMBER 
NCHAID	EQU	8	NO OF CHAR. IN APPL. NAME
NCHTID	EQU	5	NO OF CHAR IN TID RECORD 
NDEVCL	EQU	18	NO OF DEVICE CLASSES
NUMSEG	EQU	10	DISPL. TO NO OF SEGM. IN S:GTAB 
OPTION	EQU	52	SAVE AREA FOR OPTOIN WORD	=2
PAGLG	EQU	8	PAGE LENGTH IN S:GTAB 
PAGSIZ	EQU	/1000	PHYSICAL PAGE SIZE 
PLDADR	EQU	14	PHYSICAL LOAD ADDRESS 
PRGLG1	EQU	2	PROGRAM LENGTH DISPLACEMENT
PSECNL	EQU	40	PHYSICAL SECTOR NUMBER LEAST SIGNIFICANT
PSECNM	EQU	42	PHYSICAL SECTOR NUMBER MOST SIGNIFICANT 
PSECPA	EQU	38	PHYSICAL SECTOR PART (0-2)
SEGCNT	EQU	10	SEGMENT COUNTER 
SWPFEL	EQU	14	FILE EXTENT LENGTH
TNBRSG	EQU	26	TOTAL NUMBER OF SEGMENTS
	EJECT
*********************** 
*  CASSETTE HANDLING  * 
*********************** 
CHCR	EQU	/E	DEVICE ADDRESS FOR CASSETTE 
LOCK	EQU	/2	LOCK CASSETTE 
SBOT	EQU	8	SEARCH BEGINNING OF TAPE 
STMF	EQU	/C	SEARCH TAPEMARK FORWARD 
* 
*  DISC/FLEXIBLE DISC HANDLING
* 
BUFLEN	EQU	256	LENGTH OF READ BUFFER
DKBA3	EQU	514	BUFFER LENGTH VERSION A3
RECLEN	EQU	9	CONFIGURATION FILE RECORD LENGTH 
FDCU	EQU	/09	FLEXIBLE DISC CU ADDRESS 
FDIOP	EQU	FDCU+FDCU	MUX ADDRESS 
FORDEV	EQU	48	DISC FORMAT 
MUXCC	EQU	/8080	1:ST MUX WORD 
MXCCD3	EQU	/80C1	BYTE2=NUMBER OF WORDS
QBLFAC	EQU	6	BLOCKING FACTOR
CIO	EQU	/41C0	I/O INSTR. CONF. CONSTANT 
	EJECT
			 
***************************************************************** 
*  CALL-FORMAT, PERFORMS:  CFR      A14,A13                     * 
*                          DATA     [REL-ADDRESS]               * 
*                                                               * 
***************************************************************** 
			 
			 
			 
CALL	FORM	16=/F697,16 
	EJECT
**************************
*  CONDITIONAL ASSEMBLY  *
**************************


* 
*  CONSTANTS EDITED BY SYSGEN 
* 


X:A	EQU	1 
X:B	EQU	1 
X:C	EQU	1 
X:D	EQU	0 
X:E	EQU	0 
X:F	EQU	0		=9 
X:G	EQU	1		=9 

MMUPAG	EQU	1	1-MMU HARDWARE PRESENT 
EDM	EQU	0	1-SUPPORTS EXTENDED MONITORS	=12
CASS	EQU	0	1-PROGRAM LOAD DEVICE = CASSETTE 
DISC	EQU	1	1-PROGRAM LOAD DEVICE = DISC 
FLDISC	EQU	1	1= PROGRAM LOAD DEVICE = FLEXIBLE DISC 
MFDISC	EQU	0	1-PROGRAM LOAD DEVICE = MINI FIXED DISC
CDDISC	EQU	0	1-PROGRAM LOAD DEVICE=80M CDC DISC 
CDDI16	EQU	0	1-PROGRAM LOAD DEVICE = 16M CDC DISC	=9
CFTEST	EQU	1	1-TEST OF CONFIGURATION FILE	=9
CFTCAS	EQU	CFTEST+CASS
CFTFLD	EQU	CFTEST+FLDISC
	EJECT
******************************************************
*                                                    *
*          APPLICATION LOAD PART OF SYSLOD           *
*          ===============================           *
*                                                    *
*  ENTRY:  A1 - FORMAT AND DEVICE TYPE             *
*          A2 - PROGRAM LOAD DEVICE                  *
*          A3 - APPLICATION NUMBER                   *
*          A7 - APPLICATION DISC ADDRESS BIT 16-31  * 
*          A8 - APPLICATION DISC ADDRESS BIT  0-15  * 
*          A9 - START OF FREE AREA                   *
*         A13 - MONITOR START ADDRESS                *
*                                                    *
*  EXIT:                                             *
*                                                    *
*  SUBROUTINES:  CASSIN,SOPIN,CHCRIO,LODCOM          *
*                LODSEG,REBUF,MOVBUF,RDBLK,          *
*                CONLOD,CONEX,MOVREV                 *
*                                                    *
******************************************************
SYSLOD	EQU	*
* 
*  SAVE REGISTERS 
* 
	ST	A1,IPLTYP+STKEND	SAVE FORMAT AND DEVICE TYPE
	ST	A2,SCTIPL	SAVE PROGRAM LOAD DEVICE
	ST	A2,IPLDEV+STKEND
	CM	CONDEV+STKEND	RESET CONF. DATA DEV. ADDR. 
	ST	A3,SCTANO	APPLICATION NUMBER
	LDR	A3,P	USE BEGINNING OF SYSLOD 
	SUK	A3,TBLBAS
TBLBAS	EQU	*-2-SYSLOD 
	ST	A3,APLTAB+STKCOM	AS TABLE AREA
	LDK	A1,1	INITIATE NO OF APPL.
	STR	A1,A3	AND SAVE IN TABLE
	ST	A8,APLADA+2,A3	SAVE APPLICATION DISC ADDRESS BIT 0-15 
	ST	A7,APLADA+4,A3	SAVE APPLICATION DISC ADDRESS BIT 16-31
	ST	A9,SCTSFA	SAVE START OF FREE AREA 
	LDKL	A14,SYSLOD
	LDR	A13,P
SYS100	ADKL	A13,SYS110-SYS100	POINTER TO SYS110 
	LD	A1,SCTBUG 
	LDR	A2,A1
	ANK	A2,1	TEST IF DEBUG ADDRESS IS ODD,IF TRUE START
	ABR(NZ)	A1 
* 
SYS110	EQU	*
	LD	A15,SCTSTB	LOAD STACK BASE
	SUKL	A15,4	ADJUST STACK BASE 
* 
*  INDICATE SYSLOD RUNS 
* 
	LDKL	A1,LMP1 
	OTR	A1,0,SOP 
* 
*  INIT POINTER TO SUBROUTINE HANDLER (A13), STACK BASE (A14) 
*  AND ADDRESS TO GETPSW-ROUTINE
* 
	LDR	A8,P	RETURN ADDRESS
	LDKL	A3,REL+2	RELOCATION ROUTINE 
	CFR	A8,A3
	LDKL	A5,/5555	LOAD TEST PATTERN
	LDK	A6,64	INIT PAGE COUNTER
	IFT	MMUPAG=1 
	EJECT
* 
*  EXECUTION PATH FOR SYSTEMS WITH MMU OPTION EXCLUSIVELY 
* 
	SLL	A6,2	UPPER SAVE20=256 KB 
	LDK	A1,0	MMU ENTRY POINTER 
AP:010	EQU	*
	LD	A2,TABBE	GET PAGE ADDRESS 
	SUKL	A2,/400	DECREMENT PHYSICAL PAGE ADDRESS 
	ST	A2,TABBE	STORE IT BACK
	TL	TABBE	LOAD MMU REGISTERS
	EL	A3,PAGSIZ-2,A1	SAVE OLD MEMORY CONTENTS 
	ES	A5,PAGSIZ-2,A1	STORE TEST PATTERN 
	EL	A2,PAGSIZ-2,A1	GET MEMORY CONTENT 
	ES	A3,PAGSIZ-2,A1	RESTORE OLD MEMORY CONTENTS
	CWR	A2,A5	COMPARE WITH TEST PATTERN
	RF(E)	AP:020 
	SUK	A6,4	DECREMENT NUMBER OF PAGES 
	RB	AP:010
* 
*  CHECK IF MMU HARDWARE PRESENT
* 
AP:020	LDKL	A1,/FC00
	ST	A1,MMDDIV,A13	SET 1ST ENTRY IN MMU TABLE AREA 
	TL	MMDDIV,A13	TRY TO LOAD MMU REGISTERS
	TS	MMDDIV,A13	SAVE REGISTERS IN MMU TABLE
	CW	A1,MMDDIV,A13	SUCCESSFUL? 
	RF(E)	AP:030	YES! MMU PRESENT
	LDKL	A1,LMP9 
	CALL	ERROR	INDICATE HARDWARE NOT PRESENT 
AP:030	CM	TABBE	RESET MMU TABLE 
* 
*  END OF EXECUTION PATH FOR SYSTEMS WITH MMU OPTION EXCLUSIVELY
* 
	XIF
	IFT	MMUPAG=0 
	EJECT
AP:100	EQU	*
* 
*  EXECUTION PATH FOR SYSTEMS WITHOUT MMU OPTION EXCLUSIVELY
* 
	LDKL	A1,PAGSIZ-2	START AT /FFFE
AP:110	EQU	*
	SUKL	A1,PAGSIZ	NEXT PHYSICAL PAGE
	LDR*	A2,A1	SAVE OLD MEMORY CONTENT 
	STR	A5,A1	STORE TEST PATTERN 
	CWR*	A5,A1	CHECK IF MEMORY 
	RF(E)	AP:120	MEMORY END FOUND
	SUK	A6,4	DECREMENT NUMBER OF PHYSICAL PAGES
	RB	AP:110
AP:120	EQU	*
	STR	A2,A1	RESTORE OLD MEMORY CONTENT 
* 
*  END OF EXECUTION PATH FOR SYSTEMS WITHOUT MMU OPTION EXCLUSIVELY 
* 
	XIF
	EJECT
* 
*  COMMON EXECUTION PATH
* 
AP:200	EQU	*
	ST	A6,SCTMSZ	SAVE NUMBER OF PHYSICAL PAGES 
	SRL	A6,2	MAKE NO OF 4K FRAMES
	SLL	A6,10	MAKE FRAME ADDRESS 
	ST	A6,SCTEFA	FIRST FRAME TO BE USED
	LDK	A3,0 
	ST	A3,SCTEFA+2	AREA EMPTY IN FIRST FRAME 
	LD	A1,SCTOPT	GET OPTION WORD	=2
	ST	A1,OPTION+STKEND	 	=2 
	ANKL	A1,/FFF	RESET TYPE BITS	=2
	ST	A1,SCTOPT	AND SET AS NEW OPTION	=2
* 
*  INIT POINTER TO READ BUFFER. INIT DEVICE ADDRESS FOR READ-ROUTINE
	LD	A9,SCTSFA	POINTER TO READ BUFFER
	ST	A9,MXBUF	ADDRESS TO READ-BUFFER 
	LD	A1,SCTIPL	GET PROGRAM LOAD DEVICE 
* 
*  INITIALIZE PROGRAM LOAD DEVICE 
* 
	CF	A14,LODDEV
	LDR	A3,A9	SAVE 
	AD	A3,SAVCON	COMPUTE START OF APPL. TABLE
	ST	A3,SCTSFA	STORE IN SYSTAB 
	LDR	A1,A1
	RF(Z)	AP:233	CASSETTE LOADING
* 
	ST	A2,SCTIPL	SET FILE CODE IF RAND. ACC. DEV.
	EJECT
AP:232	EQU	*
	IFT	EDM=1		=12 
* 
*  LOAD MONITOR EXTENTS IF PRESENT
* 
	CF	A14,LODMEX	 LOAD MONITOR EXTENTS
	XIF
* 
*  SCAN CONF. FILE FOR POSSIBLE 
*  APPLICATION DEFINITION BLOCKS
* 
	CF	A14,SCNCON
	LD	A1,APLTAB+STKCOM	GET ADDRESS TO 
	ADK	A1,2	CURRENT APPL. CONTR. BLOCK
	LD	A12,APLADA,A1	MOST SIGN. PART OF DISC ADDRESS 
	LD	A11,APLADA+2,A1	LEAST SIGN. PART OF DISC ADDRESS
	LD	A10,READ	GET SUBROUTINE ADDRESS 
	CFR	A14,A10	READ FIRST SECTOR
AP:233	EQU	*
	LD	A1,APLTAB+STKCOM	GET APPL. TABLE ADDRESS
	LDR*	A6,A1	GET NO OF APPL. TO LOAD 
	NGR	A6,A6	NEGATE AND SAVE
	ST	A6,APLCNT+STKEND	AS COUNTER 
	ADK	A1,2 
	ST	A1,CURAPL+STKEND	CURRENT APPL. CONTROL BLOCK
AP:234	EQU	*
	LD	A7,SCTEFA	GET FIRST FRAME TO USE
	LD	A5,SCTEFA+2	AND AREA EMPTY IN IT
	LD	A1,CURAPL+STKEND	RESTORE APPL. CONTROL BLOCK ADDR.
	EJECT
AP:235	EQU	*
* 
*  SAVE INFORMATION ABOUT THE LOAD MODULE 
* 
	CM	APLLAP,A1	RESET NO OF MMU ENTRIES TO UPDATE 
	CM	APLSEG,A1	RESET PHYSICAL ADDRESS TO FIRST 
	CM	APLSEG+2,A1	CORE RESIDENT SEGMENT 
	CM	APLMMC,A1	CLEAR REL. POSITION OF CONF. DATA 
	CM	APLPSZ,A1	CLEAR SEGMENT SIZE ENTRY	=2 
	CM	TNBRSG+STKEND	CLEAR NBR. OF SEGMENTS	=5 
	LDR*	A6,A9	GET PGM. START ADDRESS (UNSEGMENTED APPL.)
	ST	A6,APLSTA,A1	SAVE 
	LD	A2,SCTOPT	GET OPTION WORD 
	LD	A6,PRGLG1+8,A9	GET PROGRAM TYPE 
	LDKL	A4,/1000	INITIALIZE BIT SETTING (BIT 3=1) 
	CWK	A6,'CR'	CREDIT APPLICATION?
	RF(E)	AP2340 
* 
	SLL	A4,1	BIT SETTING FOR COBOL (BIT 2=1) 
	CWK	A6,'CO'	COBOL APPLICATION? 
	RF(E)	AP2340 
* 
	SLL	A4,1	BIT SETTING FOR BASIC (BIT 1=1) 
	CWK	A6,'BA'	BASIC APLICATION?
	RF(E)	AP2340 
* 
	LDKL	A6,'AS'	SET ASSEMBLER TYPE
	SLL	A4,1	BIT SETTING FOR ASSEMBLER (BIT 0=1) 
AP2340	EQU	*
	ST	A6,APLTYP,A1	SAVE APPLICATION TYPE
	CWK	A6,'AS'	ASSEMBLER ALWAYS ALLOWED	=2
	RF(E)	AP2345	 	=2
	AN	A4,OPTION+STKEND	LOOK IF THIS TYPE ALLOWED	=2 
	RF(NZ)	AP2345	YES	=2 
	LDK	A1,LMP9	NO, WRONG MONITOR OPTION	=2
	CALL	ERROR	 	=2
AP2345	EQU	*	 	=2 
	ORR	A2,A4	SET BIT IN OPTION WORD 
	ST	A2,SCTOPT	AND SAVE
	CWK	A6,'AS'
	RF(E)	AP2350	SKIP IF ASSEMBLER APPL. 
* 
	LD	A3,PAGLG+8,A9	GET DEFINED PAGE SIZE 
	CW	A3,SCTPSZ	COMPARE WITH PREVIOUSLY DEFINED SIZE
	RF(NG)	AP2350	IF LESS, DON'T UPDATE SIZE 
* 
	ST	A3,SCTPSZ	SAVE LARGEST DEFINED PAGE SIZE
AP2350	EQU	*
	IFT	MMUPAG=1 
	EJECT
* 
*  EXECUTION PATH FOR SYSTEMS WITH MMU OPTION 
* 
	CWK	A6,'AS'	ASSEMBLER APPLICATION? 
	ABL(E)	AP:330	YES! NO SEGMENTS 
	LDR	A4,A3	SAVE 
	ANKL	A4,/3FF	EVEN 1K MULTIPLE? 
	RF(Z)	AP:237	YES!
* 
	LDK	A1,LMP8
	CALL	ERROR	INDICATE PAGE SIZE ERROR
* 
AP:237	EQU	*
	LD	A2,NUMSEG+8,A9	NUMBER OF SEGMENTS DEFINED 
* 
AP:238	EQU	*
	ABL(Z)	AP:330	NO SEGMENTS! 
* 
	CF	A14,ALOCSG	RESERVE AREA FOR RESIDENT SEGM.
* 
*  A1 - POINTER TO CURRENT APPL. CONTR. BLOCK 
*  A3 - PAGESIZE IN 1K BLOCKS 
*  A5 - OFFSET WITHIN 4K PAGE 
*  A7 - PAGE FRAME ADDR. (PHYS. ADDR.)
*  A4 - AREA LEFT IN LAST 4K PAGE FRAME 
* 
*  STORE ADDRESS(ES) TO PAGE FRAMES 
*  HOLDING THE FIRST LOGICAL PAGE 
* 
	SRL	A3,10	SEGMENT SIZE IN 1K BLOCKS	=2 
	LDKL	A6,MMEND	GET END OF MMU-TABLE 
	LDKL	A8,16	AND NO OF ENTRIES 
	LDR A4,A5	GET AREA LEFT IN LAST FRAME
AP:295	EQU	*
	SUK	A6,2	DECREMENT MMU ENTRY ADDR. 
	SUKL	A8,1	DECREMENT MMU ENTRY POINTER
	SUK	A3,4	DECREMENT PAGE SIZE WITH FRAME SIZE 
	RB(P)	AP:295 
	RF(Z)	AP:300	EVEN 4K BYTES PAGE
* 
*  RESERVE ONE EXTRA MMU ENTRY
*  WHEN PAGE SIZE IS NOT AN 
*  EVEN MULTIPLE OF 4K
* 
	LD	A3,PAGLG+8,A9	GET PAGE SIZE 
	ANKL	A3,/C00	GET LENGTH IN MODULO 4K 
	CWK	A3,/400	PAGE SIZE = 1K?
	RF(E)	AP:300	YES! ONE ENTRY ENOUGH 
* 
	SUK	A6,2	ALLOCATE ONE ENTRY EXTRA
	SUKL	A8,1
* 
AP:300	EQU	*
	LD	A3,SEGCNT+STKEND	ANY CORE RESIDENT SEGMENTS?
	RF(Z)	AP:310	NO! 
* 
	LDR	A2,A7	GET SEGMENT FRAME ADDRESS
	LDR	A3,A6	SAVE MMU ENTRY 
* 
AP:305	EQU	*
	STR	A2,A3	STORE ADDRESS TO PAGE FRAME
	ADK	A3,2	INCREMENT MMU ENTRY ADDRESS 
	CWK	A3,MMEND	END OF MMU TABLE? 
	RF(E)	AP:310	YES!
* 
	ADKL	A2,/400	INCREMENT PAGE FRAME ADDR.
	RB	AP:305
* 
AP:310	EQU	*
* 
*  SAVE LOGICAL ADDRESS 
*  TO SEGMENT 
* 
	LDR	A2,A8	GET MMU ENTRY
	SLL	A2,12	MOVE TO 4 LEFTMOST BITS
	ST	A2,APLLAP,A1	SAVE IN APPLICATION CONTROL BLOCK
	ORR	A2,A4	CONCATENATE DISPLACEMENT 
	ST	A2,LSTASG+STKEND	AND SAVE AS LOGICAL START ADDR.
	RF	AP:335
* 
*  NO SEGMENTS DEFINED
* 
AP:330	EQU	*
	LDK	A3,0	RESET NO OF MMU ENTRIES TO UPDATE 
	LDKL	A6,MMEND	INITIATE MMU POINTER 
	LDKL	A8,16	AND MMU ENTRY POINTER 
	LDR	A4,A5	AREA LEFT IN LAST FRAME
AP:335	EQU	*
* 
* COMPUTE APPLICATION START ADDRESS 
* 
*  A1 - POINTER TO APPLICATION CONTROL BLOCK
*  A4 - AREA LEFT IN CURRENT PAGE FRAME 
*  A7 - PHYSICAL PAGE ADDRESS 
*  A6 - MMU ENTRY ADDRESS 
*  A8 - CURRENT MMU ENTRY 
* 
	LD	A2,COMLG,A9	COMLG OF CORE RESIDENT PART 
	LD	A3,APLTYP,A1	GET APPLICATION TYPE 
	CWK	A3,'AS'	ASSEMBLER? 
	RF(NE)	AP:336	NO!
* 
	ADK	A2,10	YES, ADD 5 WORDS FOR DEBUGGER
AP:336	EQU	*
	ADK	A2,1 
	ANKL	A2,/FFFE	MAKE EVEN LENGTH 
* 
*  IF APPLICATION IS LARGER THAN
*  60 K BYTES, START ON A 4K
*  BOUNDARY, TO MAKE SURE THAT
*  LOGICAL MEMORY WILL BE 
*  MAXIMAL POSSIBLE.
* 
	LDR	A5,A2
	SRL	A5,12	NO OF 4K BLOCKS
	CWK	A5,15	>60 KBYTES?
	RF(L)	AP:337	NO! 
* 
	LDK	A4,0	START ON A 4K BOUNDARY
	RF	AP:341
* 
AP:337	EQU	*
	ADK	A2,0	RESTORE LENGTH CONDITION
	RF(N)	AP:340	LARGER THAN ONE PAGE
* 
* APPLICATION IS SMALLER THAN 32 K
* BUT IS IT SMALLER THAN AREA LEFT
* IN LAST ALLOCATED PAGE? 
* 
	CWR	A2,A4
	RF(G)	AP:340	LARGER
* 
* APPLICATION LENGTH LESS THAN AREA 
* LEFT IN LAST PAGE 
* COPY FRAME ADDRESS IN NEXT
* MMU ENTRY 
* 
* 
	SUKL	A8,1
	RF(N)	TABOVF	TABBE OVERFLOW! 
* 
	SUK	A6,2 
	STR	A7,A6	UPDATE MMU ENTRY 
	LDR	A5,A2	RESTORE LENGTH OF COMMON PART
	RF	AP:351
* 
AP:340	EQU	*
* 
*  RESERVE ENTRIES IN MMU TABLE FOR 
*  COMMON PART OF APPLICATION 
* 
*  A4 - AREA MAPPED BUT NOT USED
*       IN LAST MMU ENTRY 
*  A2 - LENGTH OF COMMON PART 
	LDR	A4,A4	EMPTY FRAME? 
	RF(Z)	AP:341	YES!
* 
	SUKL	A8,1	NO, ANY MMU ENTRIES LEFT?
	RF(N)	TABOVF	NO! 
* 
	SUK	A6,2	ADVANCE TO NEXT MMU ENTRY 
	STR	A7,A6	AND COPY FRAME ADDRESS 
AP:341	EQU	*
	SUR	A2,A4	SUBTRACT AREA LEFT IN CURRENT FRAME
	LDK	A4,0	RESET AREA LEFT IN LAST FRAME 
	LDR	A5,A2	SAVE REMAINING AREA NEEDED 
	RF(Z)	AP:351	NOTHING LEFT
* 
	SRL	A2,12	CONVERT TO NO OF 4K FRAMES 
	ANKL	A5,/0FFF
	RF(Z)	AP:342	NO REMAINDER
* 
	ADK	A2,1	ALLOCATE ONE MORE ENTRY 
* 
*  UPDTE MMU ENTRIES
* 
AP:342	EQU	*
	SUK	A2,1	MORE ENTRIES TO UPDATE? 
	RF(N)	AP:350	NO! 
* 
	SUKL	A8,1	DECREMENT MMU ENTRY POINTER
	RF(N)	TABOVF	TABLE OVERFLOW! 
* 
	SUK	A6,2	DECREMENT MMU ENTRY ADDR. 
	SUKL	A7,/400	DECREMENT FRAME ADDRESS 
	STR	A7,A6	STORE FRAME ADDRESS
	RB	AP:342
* 
TABOVF	EQU	*
	LDK	A1,LMP7
	CALL	ERROR	SIGNAL TABBE OVERFLOW!
MEMOVF	EQU	*
	LDKL	A1,LMP3 
	CALL ERROR	MEMORY OVERFLOW!
* 
AP:350	EQU	*
* 
	LDR	A5,A5	RESTORE AREA TO USE IN LAST FRAME
	RF(Z)	AP:351 
* 
	LDKL	A4,PAGSIZ	GET FRAME SIZE
AP:351	EQU	*
	SUR	A4,A5	ALLOCATE REMAINIG AREA IN LAST FRAME 
	LDR	A2,A8	GET MMU ENTRY
	SLL	A2,12	MOVE TO FOUR LEFTMOST BITS 
	LDR	A8,A2
	ORR	A8,A4	LOGICAL START ADDRESS
	CWK	A3,'AS'	ASSEMBLER APPLICATION? 
	RF(NE)	AP:352	NO!
* 
	ADKL	A8,10	SKIP FIVE PRECEEDING WORDS
AP:352	EQU	*
	ST	A8,LLDADR+STKEND	SAVE 
	ST	A7,SCTEFA	AND SAVE
	ST	A4,SCTEFA+2	SAVE OFFSET WITHIN FRAME
	ST	A7,APLLDA,A1	SAVE APPLICATION LOAD ADDR. (BIT 0-5)
	ST	A4,APLLDA+2,A1	AND BIT 6-17 
	ST	A7,FYSPAG+STKCOM	SAVE LAST PHYSICAL 
	ST	A4,LSTADR+STKCOM	ADDRESS USED 
	LDR*	A1,A6	GET ADDRESS TO PHYSICAL PAGE
	ANKL	A1,/C000	GREATER THAN 64K?
	RF(Z)	AP:353	NO! 
	LDK	A1,0	UPPER LIMIT 64 KB 
	RF	AP:354
AP:353	EQU	*
	LDR*	A1,A6	GET PHYSICAL ADDRESS
	SLL	A1,2 
	ADR	A1,A4	ADD DISPLACEMENT 
	LD	A2,SCTSFA	GET START OF FREE AREA
	TNM	A1,A2	ON SAME SIDE OF 32K-LIMIT
	RF(NN)	AP3532	YES! 
	CWR	A2,A1
	RF	AP3534
AP3532	CWR	A1,A2
AP3534	EQU	*
	RB(L)	MEMOVF	MEMORY OVERFLOW!
AP:354	EQU	*
	ST	A1,ESYSTA+STKEND	SAVE 
	LD	A10,COMLG,A9	LOAD COMLG OF COMMON PART
	TL	TABBE	LOAD MMU REGISTERS
	XIF
	IFT	MMUPAG=0 
	EJECT
AP:240	EQU	*
* 
*  EXECUTION PATH EXCLUSIVELY FOR SYSTEMS WITHOUT MMU OPTION
* 
* 
*  CHECK IF ASSEMBLER APPLICATION 
* 
	CWK	A6,'AS'	ASSEMBLER APPLICATION? 
	RF(E)	AP:275	YES!
	LD	A2,NUMSEG+8,A9	NUMBER OF SEGMENTS 
	RF(Z)	AP:275	NO SEGMENTS!
	CF	A14,ALOCSG	RESERVE AREA FOR SEGMENTS
	LDR	A2,A7	CONFIGURE LOGICAL START ADDR.
	SLL	A2,2	TO FIRST SEGMENT
	ORR	A2,A5
	ST	A2,LSTASG+STKEND
AP:275	EQU	*
	LD	A10,COMLG,A9	GET LENGTH OF COMMON PART
	LD	A3,APLTYP,A1	GET APPLICATION TYPE 
	CWK	A3,'AS'	ASSEMBLER? 
	RF(NE)	AP:276	NO!
* 
	ADKL	A10,10	YES, ADD 5 WORDS FOR DEBUGGER
AP:276	EQU	*
	ADKL	A10,1 
	ANKL	A10,/FFFE	MAKE EVEN LENGTH
	RF(N)	AP:278	APPLICATION IS LARGER THAN FRAME SIZE 
* 
	CWR	A10,A5	APPL. IS SMALLER THAN AREA LEFT IN LAST FRAME 
	RF(NG)	AP:280	YES! 
* 
AP:278	EQU	*
	SUR	A10,A5	SUBTRACT AREA UNUSED IN LAST FRAME
	LDK	A5,0	NO AREA LEFT IN CURRENT FRAME 
	LDR	A2,A10	GET REMAINING LENGTH
	SRL	A2,12	COUNT NO OF 4K BLOCKS
	SRL	A7,10	FRAME ADDRESS AS BLOCK COUNT 
	SUR	A7,A2	SUBTRACT AREA NEEDED 
	RF(N)	MEMOVF	MEMORY OVERFLOW!
* 
	ANKL	A10,/0FFF	ISOLATE POSSIBLE REMAINDER
	RF(Z)	AP:279	NO REMAINDER
* 
	LDKL	A5,PAGSIZ	RESERVE ONE NEW FRAME 
	SUK	A7,1 
	RF(N)	MEMOVF	MEMORY OVERFLOW!
* 
AP:279	EQU	*
	SLL	A7,10	RESTORE FRAME ADDRESS
AP:280	EQU	*
	SUR	A5,A10	ALLOCATE AREA NEEDED IN LAST FRAME
	LDR	A4,A9	SAVE A9
	LDR	A8,A11	SAVE A11
	ST	A7,SCTEFA	AND SAVE
	ST	A5,SCTEFA+2	SAVE DISPLACEMENT WITHIN PAGE 
	ST	A7,APLLDA,A1	SAVE PHYSICAL LOAD ADDR (BIT 0-5)
	ST	A5,APLLDA+2,A1	AND BIT 6-17 OF APPLICATION
	ST	A7,FYSPAG+STKCOM	SAVE LAST PHYSICAL 
	ST	A5,LSTADR+STKCOM	ADDRESS USED 
	SLL	A7,2 
	LDR	A11,A7 
	ORR	A11,A5	MAKE ADDRESS AS A 16 BIT ADDR.
	LD	A9,SCTSFA	GET START OF FREE AREA
	CALL	CMPADR	A11 COMPARED TO A9 
	RF(G)	AP:290 
* 
MEMOVF	EQU	*
	LDKL	A1,LMP3	MEMORY OVERFLOW!
	CALL	ERROR 
* 
AP:290	EQU	*
	CWK	A3,'AS'	ASSEMBLER APPLICATION? 
	RF(NE)	AP:295	NO!
* 
	ADKL	A11,10	SKIP 5 PRECEEDING WORDS
AP:295	EQU	*
	ST	A11,LLDADR+STKEND	SAVE APPL. LOAD ADDRESS 
	LDR	A9,A4	RESTORE A9 
	LDR	A11,A8	RESTORE A11 
	LD	A8,LLDADR+STKEND	A8 - LOGICAL LOAD ADDRESS
	ST	A8,ESYSTA+STKEND	SAVE APPLICATION LOAD-ADDRESS
	LD	A10,COMLG,A9	GET LENGTH OF COMMON PART
	XIF
	EJECT
* 
*  COMMON EXECUTION PATH
* 
*  READ AND RELOCATE CORE RESIDENT PART OF APPLICATION
* 
*  A8 - APPLICATION LOAD ADDRESS
*  A10 - LENGTH OF CORE RESIDENT PART 
* 
AP:355	EQU	*
	LD	A1,CURAPL+STKEND	RESTORE APPL. CONTROL BLOCK POINTER
	ST	A8,APLLAC,A1	SAVE LOGICAL ADDRESS 
	ST	A8,APLREL,A1	SAVE APPLICATION RELOCATION BASE 
	CM	FSTSEC+STKEND	RESET FIRST SECTOR/BLOCK IND. 
	LDKL	A7,240	INITIATE NR OF CODE WORDS/SECT/BLOCK 
	ST	A7,LOD:10	MODIFY INSTRUCTION
	CF	A14,LODCOM	LOAD CORE RESIDENT PART
* 
*  CHECK IF ASSEMBLER APPLICATION 
* 
	LD	A1,CURAPL+STKEND	GET CURRENT APPL. CONTR. BLOCK 
	LD	A2,APLTYP,A1	AND TYPE OF THIS APPL. 
	CWK	A2,'AS'	ASSEMBLER APPLICATION? 
	ABL(E)	AP:400	YES
	LD	A8,LSTASG+STKEND	GET LOGICAL ADDRESS TO FIRST PAGE
	LD	A2,TNBRSG+STKEND	GET NUMBER OF SEGMENTS 
	ABL(Z)	AP:400	NO SEGMENTS IN APPLICATION 
* 
	CM	SEGCNT+STKEND	CLEAR NO OF SEGMENTS PROCESSED
	IFT	MMUPAG=1 
	TS	MMDDIV,A13	SAVE MMU REGISTER CONTENTS 
	XIF
AP:360	EQU	*
* 
*  READ AND RELOCATE THE SEGMENTS 
* 
*  A8 - LOGICAL ADDRESS OF SAVE05 SEGMENT 
*  A10 - SEGMENT LENGTH 
* 
	LD	A3,CURAPL+STKEND	GET APPL. CONTROL BLOCK ADDR.
	LD	A2,APLLAC,A3	GET LOGICAL ADDR. TO APPL. 
	ADKL	A2,BLKLEN+BLKLEN
	LD	A1,SEGCNT+STKEND	GET SEGMENT COUNTER
AP:365	EQU	*
	RF(Z)	AP:370 
	ADK	A2,BLKLEN	NEXT BLOCK 
	SUK	A1,1	DECREMENT BLOCK COUNTER 
	RB	AP:365
AP:370	EQU	*
* 
*  CHECK IF DISC PAGING 
* 
	LD	A1,SCTOPT	GET OPTION WORD 
	ANK	A1,2	DISC PAGING?
	RF(Z)	AP:376	NO! 
* 
*  CHECK IF CORE RESIDENT SEGMENT 
* 
	CALL	GETCON	GET SEGMENT TYPE 
	LDR	A12,A1	GET MOST SIGNIFICANT PART 
	ANKL	A12,/FF	OF DISC ADDRESS 
	SRL	A1,8	SEGMENT TYPE TO RIGHT BYTE	 
	CCK	A1,'RR'	CORE RESIDENT SEGMENT? 
	RF(E)	AP:376	YES: LOAD THIS SEGMENT! 
* 
*  BYPASS THIS SEGMENT AND CHECK NEXT 
* 
	LD	A1,SEGCNT+STKEND	GET SEGMENT COUNTER
	LD	A2,TNBRSG+STKEND	GET TOTAL NUMBER OF SEGMENTS 
	ADK	A1,1	INCREMENT 
	CWR	A1,A2	LAST SEGMENT?
	ABL(E)	AP:400	YES! 
	ST	A1,SEGCNT+STKEND	SAVE CURRENT SEGMENT NUMBER
	RB	AP:360
AP:375	LDKL	A1,LMP2	DISC I/O ERROR
	CALL	ERROR 
	EJECT
AP:376	EQU	*
	ADK	A2,2	DISC SECTOR ADDRESS 
	CALL	GETCON	GET DISC SECTOR ADDRESS
	LDR	A11,A1	SAVE
	AD	A11,APLADA+2,A3	ADD LEAST SIGN. PART OF A.D.A.? 
	RF(O)	AP:377	OVERFLOW
	RF	AP:378	NOT OVERFLOW 
AP:377	ADKL	A12,1	INCR. M. S. P. OF DISC ADDRESS
	ANKL	A11,/7FFF	RESET OVERFLOW
AP:378	AD	A12,APLADA,A3	ADD M. S. P. OF A. D. A.
	CWK	A12,255	OVERFLOW?
	RB(G)	AP:375	YES: ILLEGAL DISC ADDRESS!
	ADK	A2,2	SEGMENT LENGTH
	CALL	GETCON	GET SEGMENT LENGTH 
	LDR	A10,A1	SAVE
	ADKL	A10,1 
	ANKL	A10,/FFFE	MAKE EVEN LENGTH
	ST	A8,LLDADR+STKEND
	CF	A14,LODSEG	LOAD SEGMENT 
	LD	A1,SEGCNT+STKEND	GET SEGMENT COUNTER
	LD	A2,TNBRSG+STKEND	GET TOTAL NUMBER OF SEGMENTS 
	ADK	A1,1	INCREMENT SEGMENT COUNTER 
	CWR	A1,A2	ALL SEGMENTS LOADED? 
	ABL(E)	AP:400	YES! 
	ST	A1,SEGCNT+STKEND	STORE SEGMENT COUNTER
	LD	A3,CURAPL+STKEND	GET CURRENT APPL. CONTROL BLOCK	=2 
	LD	A4,APLPSZ,A3	AND SEGMENT SIZE DEFINED	=2
	IFT	MMUPAG=0 
	ADR	A8,A4	COMPUTE ADDRESS TO NEXT PAGE 
	RB	AP:360
	XIF
	IFT	MMUPAG=1 
	EJECT
AP:379	EQU	*
	LDR	A1,A4	SAVE 
	ANKL	A4,/0C00	GET MODULO 4K DISCRIMINANT 
	RF(Z)	AP:380	NO DISCRIMINANT!
	ADR	A1,A8	COMPUTE LOGICAL ADDRESS TO NEXT PAGE 
	LDR	A4,A1	SAVE 
	ANKL	A4,/0C00	GET MODULO 4K DISCRIMINANT 
	ANKL	A1,/F000	LOGICAL ADDRESS TO NEXT PAGE 
	ANKL	A8,/F000	LOGICAL ADDRESS TO CURRENT PAGE
	SUR	A1,A8	COMPUTE PHYSICAL INCREMENT 
AP:380	EQU	*
	LD	A8,APLLAP,A3	LOGICAL PAGE ADDRESS 
	LDR	A2,A8	SAVE 
	ADR	A8,A4	COMPUTE LOGICAL ADDRESS TO NEXT PAGE 
	SRL	A2,12	MOVE TO 4 RIGHTMOST BITS 
	ADR	A2,A2	2*MMU ENTRY
	ADR	A2,A13 
	ADKL	A2,MMDDIV	MMU ENTRY ADDRESS 
	LDR	A3,A13 
	ADKL	A3,MMDDIV+32
	SRL	A1,2	MAP PHYSICAL ADDRESS ON MMU 
AP:385	EQU	*
	ADRS	A1,A2	LOGICAL ADDRESS TO NEXT PAGE
	ADK	A2,2	NEXT MMU ENTRY
	CWR	A2,A3
	RB(NE)	AP:385
	TL	MMDDIV,A13	LOAD MMU REGISTERS 
	RB	AP:360
* 
	XIF
	EJECT
AP:400	EQU	*
	LD	A1,CURAPL+STKEND	GET CURRENT APPL.CONTROL BLOCK 
	IM	APLCNT+STKEND 
	ABL(Z)	CONLOD	ALL APPLICATIONS LOADED
* 
	ADK	A1,ACBLEN	ADVANCE TO NEXT APPLICATION
	ST	A1,CURAPL+STKEND	APPLICATION CONTROL BLOCK
	LD	A12,APLADA,A1	MOST SIGN. PART OF DISC ADDR. 
	LD	A11,APLADA+2,A1	LEAST SIGN. PART OF DISC ADDR.
	LD	A10,READ	GET SUBROUTINE ADDRESS 
	CFR	A14,A10	READ FIRST SECTOR
	ABL	AP:234 
	EJECT
********************************************* 
*                                           * 
*                                           * 
*                ALOCSG                     * 
*                ======                     * 
*                                           * 
*   RESERVE PAGES FOR RESIDENT SEGMENTS     * 
*                                           * 
*                                           * 
********************************************* 
* 
* 
ALOCSG	EQU	*
	ST	A2,TNBRSG+STKEND	SAVE NUMBER OF SEGMENTS
	CM	SEGCNT+STKEND	RESET NO OF CORE RESIDENT SEGMENTS
	ST	A3,APLPSZ,A1	SAVE SEGMENT SIZE	=2 
	LD	A4,SCTOPT	GET OPTION WORD 
	SRC	A4,2	DISC PAGING?
	RF(NN)	ALSG04	NO!
* 
	LD	A4,SCTIPL	GET PROGRAM LOAD DEVICE 
	SUK	A4,/F0	CHECK IF CASSETTE 
	RF(N)	ALSG04	CASSETTE - LOAD ALL SEGMENTS! 
* 
*  COMPUTE NUMBER OF CORE RESIDENT PAGES
* 
	LDR	A6,A9	START OF APPLICATION 
	ADK	A6,14	START OF SEGMENT BLOCKS
ALSG00	EQU	*
	ADK	A6,6	NEXT SEGMENT BLOCK
*  LOOK IF OUTSIDE BUFFER 
*  IF SO READ NEXT
*  SECTOR BLOCK 
* 
	LDR	A4,A6	SAVE BUFFER POSITION 
	SUR	A4,A9	RELATIVE POSITION
	CWK	A4,BUFLEN-16	OUTSIDE BUFFER?	=5
	RF(NG)	ALSG01	NO!
* 
	CF	A14,NXTSEC	READ NEXT SECTOR 
	SUK	A6,BUFLEN-16	COMPENSATE FOR RELOCATION BITS	=5 
			AND RESET BUFFER POSITION	=5 
* 
ALSG01	EQU	*
	LCR	A4,A6	GET SEGMENT TYPE 
	CCK	A4,'RR'	CORE RESIDENT SEGMENT? 
	RF(NE)	ALSG02	NO!
	IM	SEGCNT+STKEND	INCREMENT RESIDENT SEGMENT COUNTER
ALSG02	EQU	*
	SUK	A2,1	MOORE SEGMENTS? 
	RB(NZ)	ALSG00	YES! 
	LD	A2,SEGCNT+STKEND	NUMBER OF RESIDENT SEGMENTS
	RF(Z)	ALSG12	NO RESIDENT SEGMENTS! 
ALSG04	EQU	*
	ST	A2,SEGCNT+STKEND	SAVE NBR OF RESIDENT SEGMENTS
	ADS	A2,SCTNOP	ACKUMULATE NO OF CORE RES. SEGM. 
	LD	A6,SCTOPT	GET OPTION WORD 
	SRC	A6,1 
	RF(NN)	ALSG08	NO MMU IN SYSTEM 
* 
	LDR	A6,A3	GET SEGMENT SIZE 
	ANKL	A6,/FFF 
	RF(NZ)	ALSG08	NOT A MULTIPLE OF 4K BYTES 
* 
	LDR	A5,A5	LOOK IF ALREADY ON A 4K BOUNDARY 
	RF(Z)	ALSG08	YES 
* 
	LDK	A5,0	START ON A 4K BOUNDARY
ALSG08	EQU	*
	LDR	A7,A7	LOOK IF 256 KBYTE MEMORY	=3
	RF(NZ)	ALSG8B	NO!	=3 
	LDKL	A5,PAGSIZ	YES LAST FRAME EMPTY	=3 
	SUKL	A7,/400	BEGINNING OF LAST FRAME	=3
ALSG8B	EQU	*
	ANKL	A5,/1C00	ALWAYS START ON 1K BOUNDARY
	SRL	A3,1	MAKE SEGMENT LENGTH IN WORDS	=2 
	SRL	A5,1	AND REMAINING AREA TOO	=2 
	SRL	A7,10	CONVERT TO NO OF FRAMES	=2 
	LDR	A4,A3	GET SEGMENT SIZE	=2
	NGR	A4,A4	AND CORRESPONDING NEG. VALUE	=2
ALSG09	EQU	*	=2 
	CWR	A5,A3	ENOUGH SPACE LEFT?	=2
	RF(NL)	ALSG10	YES	=2 
	SUK	A7,1	DECREMENT FRAME COUNT	=2
	ADKL	A5,/800	ALLOCATE ANOTHER FRAME	=2 
	RB(P)	ALSG09	LOOK IF ENOUGH	=2 
ALSG10	EQU	*	=2 
	TNM	A5,A3	FREE AREA GREATER THAN 32K WORDS?	=2 
	RF(N)	ALS11A	YES	=2
	SUR	A5,A3	ALLOCATE AREA TO ONE SEGMENT	=2
	RF	ALS11B	=2 
ALS11A	EQU	*	=2 
	ADR	A5,A4	ALLOCATE AREA TO ONE SEGMENT	=2
ALS11B	EQU	*	=2 
	SUK	A2,1	DECREMENT SEGMENT COUNTS	=2 
	RB(NZ)	ALSG09	MORE SEGMENTS	=2 
	LDR	A7,A7	=2 
	ABL(N)	MEMOVF	MEMORY OVERFLOW! 
* 
	SLL	A7,10	RESTORE FRAME ADDRESS
	ST	A7,APLSEG,A1	SAVE PHYSICAL ADDRESS TO 
	SLL	A5,1	RESTORE AREA LEFT IN BYTES	=2 
	SLL	A3,1	RESTORE SEGMENT SIZE IN BYTES	=2
	ST	A5,APLSEG+2,A1	FIRST RESIDENT SEGMENT 
ALSG12	EQU	*
* 
*  REREAD FIRST SECTOR OF APPLICATION 
*  IF S:GTAB IS LARGER THAN ONE SECTOR
* 
	LD	A12,APLADA,A1	GET MOST SIGN. PART OF DISC ADDR. 
	LD	A11,APLADA+2,A1	AND LEAST SIGNIFICANT PART
	CF	A14,NXTSEC	REREAD FIRST SECTOR
	RTN	A14
			 
			 
NXTSEC	EQU	*
	CALL	PUSH	SAVE REGISTER CONTENTS 
	LD	A10,READ	READ NEXT SECTOR 
	CFR	A14,A10
	ST	A11,DISCAD+STKEND	SAVE CURRENT SECTOR/BLOCK	=10 
	ST	A12,DISCAD+2+STKEND	ADDRESS	=10 
	CALL	POB	RESTORE FORMER REGISTER CONTENTS
	LD	A11,DISCAD+STKEND	RESTORE CURRENT SECTOR/BLOCK	=10
	LD	A12,DISCAD+2+STKEND	ADDRESS	=10 
	RTN	A14
	IFT	EDM=1		=12 
	EJECT
*********************************************** 
*                                             * 
*  LODMEX - LOAD MONITOR EXTENT(S)            * 
*  ===============================            * 
*                                             * 
*  REFERENCED IN:  SYSLOD                     * 
*                                             * 
*  ENTRY:                                     * 
*                                             * 
*  EXIT:                                      * 
*                                             * 
*  WORK REGISTERS:  A1-A12                    * 
*                                             * 
*  SUBROUTINES:  LODCOM                       * 
*                                             * 
*********************************************** 
LODMEX	EQU	*
	LD	A1,SCTMXS	MONITOR EXTENT TABLE
MSX10	EQU	* 
	RF(Z)	MSX99
* 
	LD	A1,SCTOPT	GET MONITOR OPTION	=12
	SRC	A1,1	LOOK IF MMU OPTION ON	=12 
	RF(N)	MSX15	YES	=12
	LDKL	A1,LMP9	NO, SET ILLEGAL MONITOR OPTION	=12
	CALL	ERROR	.	=12 
MSX15	EQU	*	.	=12 
	CF	A14,GETMON	GET MONITOR DISC ADDRESS 
	LD	A3,MX:NOX,A1	GET NUMBER OF EXTENTS
	LD	A6,MX:NOS,A1	GET NUMBER OF SEGMENT CLUSTERS 
	SLL	A6,1	MAKE BYTE DISPLACEMENT
	ADK	A6,4 
	ADR	A6,A1	FIRST EXTENT BLOCK 
MSX20	EQU	* 
	SUK	A3,1	DECREMENT EXTENT COUNTER
	RF(N)	MSX99	NO MORE EXTENTS
* 
	STR	A3,A15	SAVE NO OF EXTENTS
	ADK	A6,6	NEXT EXTENT BLOCK 
	LD	A7,SCTEFA	RESTORE ADDRESS TO
	LD	A5,SCTEFA+2	END OF FREE AREA
	RF(NZ)	MSX25 
* 
	LDKL	A5,PAGSIZ	EMPTY FRAME, START ON NEXT ONE
	SUKL	A7,/400 
MSX25	EQU	* 
	LD	A2,EXLEN,A6	GET LENGTH OF EXTENT
	ADK	A2,11	RESERV FIVE EXTRA WORDS
	ANKL	A2,/FFFE	MAKE EVEN LENGTH 
	SRL	A7,10	FRAME ADDRESS AS FRAME COUNT 
	ADK	A2,0	EXTENT LENGTH LESS THAN 32K BYTES?
	RF(N)	MSX30	NO 
* 
	CWR	A2,A5	EXTENT LESS THAN AREA LEFT IN FRAME
	RF(L)	MSX40	YES! 
* 
MSX30	EQU	* 
	LDR	A1,A2
	SRL	A1,12	CONVERT LENGTH TO NO OF FRAMES 
	CWK	A1,14	<60K BYTES?
	RF(L)	MSX35	YES! 
* 
	CWK	A5,PAGSIZ	ALREADY ON A 4K BOUNDARY 
	RF(E)	MSX35	YES! 
* 
	LDKL	A5,PAGSIZ	START ON 4K BOUNDARY
	SUK	A7,1 
MSX35	EQU	* 
	SUR	A2,A5	SUBTRACT AREA LEFT IN LAST FRAME 
	LDK	A5,0	AND SET EMPTY FRAME 
	LDR	A1,A2
	SRL	A1,12	CONVERT LENGTH TO NO OF FRAMES 
	SUR	A7,A1	AND SUBTRACT FROM FRAME COUNT
	ABL(N)	MEMOVF	MEMORY OVERFLOW! 
* 
	ANKL	A2,/FFF	ISOLATE AREA LEFT 
	RF(Z)	MSX45
* 
	LDKL	A5,PAGSIZ	TAKE NEXT EMPTY FRAME 
	SUK	A7,1 
MSX40	EQU	* 
	SUR	A5,A2	SUBTACT FROM AREA LEFT IN LAST FRAME 
MSX45	EQU	* 
	CWK	A7,15	LOOK IF FIRST PARTITION
	ABL(NG)	MEMOVF	YES, MEMORY OVERFNGOW!
* 
	ANKL	A5,/FFFC	START ON A 4 BYTE BOUNDARY 
	SLL	A7,10	RESTORE FRAME ADDRESS
	ST	A5,SCTEFA+2	SAVE PHYSICAL ADDRESS 
	ST	A7,SCTEFA	TO END OF FREE AREA 
* 
	LD	A4,SCTMXS	GET MXSTAB ADDRESS
	ADK	A4,2	MONITOR DISC ADDRESS
	XRR	A1,A1	RESET REG. A1
	LDR*	A2,A6	GET MONITOR EXTENT ADDRESS
	DAR*	A4	AND RELOCATE EXTENT ADDRESS
	LDR	A11,A2	GET LEAST SIGNIFICANT PART
	LDR	A12,A1	AND MOST SIGNIFICANT PART 
	LDR	A1,A5
	SRL	A1,2	CONVERT PHYSICAL LOAD ADDRESS 
	ORR	A1,A7	TO A 16 BITS ADDRESS 
	STR	A1,A6	AND SAVE IN MXSTAB 
* 
	ADK	A5,10	SKIP PRECCEDING FIVE WORDS 
	ST	A5,LLDADR+STKEND	SAVE AS PGM LOAD ADDR. (LOGICAL) 
	LDR	A8,A5	SAVE RELOCATION BASE 
	ADS	A5,2,A6	RELOCATE PROGRAM START ADDRESS 
* 
	LD	A10,EXLEN,A6	GET LENGTH OF EXTENT 
	LDK	A3,0	RESET MMU ENTRY COUNTER 
	LDKL	A2,TABBE	GET ADDRESS TO MMU TABLE 
	ST	A3,FSTSEC+STKEND	RESET FIRST SECTOR INDICATOR 
MSX50	EQU	* 
	STR	A7,A2	STORE PAGE ADDRESS 
	ADKL	A7,/400	NEXT PAGE ADDRESS 
	ADK	A2,2	NEXT MMU ENTRY
	ADK	A3,1	INCREMENT ENTRY COUNTER 
	CWK	A3,16	ALL ENTRIES INITIALIZED? 
	RB(NE)	MSX50	NO
* 
	TL	TABBE	LOAD MMU REGISTERS
	CALL	LOD:70	LOAD EXTENT
	LDR*	A3,A15	RESTORE NO OF EXTENTS
	RB	MSX20 
* 
MSX99	EQU	* 
	RTN	A14
	EJECT
*********************************************** 
* 
*               GETMON
*               ======
* 
*   SEARCH FOR MONITOR TO BE USED 
*   AND UPDATE IT'S DISC ADDRESS
*   IN MXSTAB ENTRIES.
* 
************************************************
* 
* 
GETMON	EQU	*
	LD	A1,SCTANO	GET APPLICATION NUMBER
	ST	A1,MONNO+STKEND	SAVE
	CF	A14,GETNBR	GET CORRESPONDING ENTRY IN VTOC
	LC	A1,8,A4	GET CORRESPONDING MONITOR NUMBER
	SLL	A1,8	FORM MONITOR NBR. AND APPL. NBR. '0'
	ST	A1,MONNO+STKEND	AND SAVE
	CF	A14,GETNBR	SEARCH FOR APPL. NBR. 0 (MONITOR)
* 
GTMON2	EQU	*
	LD	A1,MONNO+STKEND	GET MONITOR NO (BIT 0-7)
	CW	A1,8,A4	IS IT THE RIGHT MONITOR?
	RF(E)	GTMON4	YES!
* 
	CF	A14,GTNBR4	NO, CONTINUE TO NEXT MONITOR IN VTOC 
	RB	GTMON2
* 
GTMON4	EQU	*
	LD	A1,SCTMXS	GET MXSTAB ADDRESS
	LD	A2,16,A4	GET MONITOR DISC ADDRESS (BIT 0-15)
	ST	A2,2,A1	AND SAVE IN MXSTAB
	LD	A2,18,A4	AND MONITOR DISC ADDRESS (BIT 16-31) 
	ST	A2,4,A1	AND SAVE IN MXSTAB
	RTN	A14	RETURN 
	EJECT
GETNBR	EQU	*
	CF	A14,GETVLB	READ VOLUME LABEL
GTNBR0	EQU	*
	CF	A14,RDSEC	READ SECTOR 
	LDK	A7,QBLFAC	VTOC BLOCKING FACTOR 
	LDR	A4,A9	START OF RECORD
	LD	A1,MONNO+STKEND	GET APPLICATION NUMBER
GTNBR2	EQU	*
	LCR	A2,A4	GET 1ST CHARACTER IN FILE NAME 
	CCK	A2,/2020	UNUSED? 
	RF(E)	GTNBR4	YES!
* 
	CC	A1,9,A4	SAME APPLICATION NUMBER?
	RF(E)	GTNBR6	YES, RETURN 
* 
GTNBR4	EQU	*
	ADR	A4,A8	GET NEXT RECORD
	ADK	A4,1	BYPASS STATUS CHARACTER 
	SUK	A7,1	MORE RECORDS IN THIS SECTOR?
	RB(P)	GTNBR2	YES!
* 
	RB	GTNBR0	NO, READ NEXT SECTOR 
* 
GTNBR6	EQU	*
	RTN	A14
	XIF
	EJECT
**********************************************************
*                                                        *
*           LOAD CONFIGURATION PART OF SYSLOD            *
*           =================================            *
*                                                        *
*  ENTRY:  A9 - BUFFER ADDRESS                           *
*                                                        *
*  EXIT:                                                 *
*                                                        *
*  SUBROUTINES:  CASSIN,RDBLK,MOVBUF                     *
*                                                        *
**********************************************************
CONLOD	EQU	*
	LD	A1,SCTEFA	GET END OF FREE AREA
	LDR	A2,A1	SAVE 
	ANKL	A1,/3C00	ISOLATE BIT 2-5
	SLL	A1,2	ROTATE TO BIT 0-3 
	ORS	A1,SCTEFA+2	CONCATENATE WITH DISPLACEMENT
	SLC	A2,2	PARTITION NR TO BIT 14,15 
	ANK	A2,3	ISOLATE IT
	ST	A2,SCTEFA	AND SAVE
	LD	A1,CURAPL+STKEND	START OF LAST APPL. CTRL. BLOCK
	ADK	A1,ACBLEN	END OF LAST APPL. CTRL. BLOCK
	ST	A1,SCTSFA	UPDATE START OF FREE AREA 
	LD	A1,APLTAB+STKCOM	GET START OF APPL. CONTR. TABLE
	ADK	A1,2	ADVANCE TO FIRST CONTROL BLOCK
	CM	APLMMC,A1	SET REL. START OF APPL. CONF. DATA
	ADK	A1,ACBLEN	ADVANCE TO NEXT APPLICATION
	ST	A1,CURAPL+STKEND	CONTROL BLOCK
	LD	A1,SCTIPL	GET PROGRAM LOAD DEVICE 
	SUK	A1,/F0	CHECK DEVICE TYPE 
	RF(NN)	CONRAD	NOT CASSETTE 
	IFT	CFTEST+CASS=2
* 
*  PROGRAM LOAD DEVICE = CASSETTE 
* 
CON:30	EQU	*
	LDKL	A1,CON:40-2 
	SUKL	A1,COR:48 
	ADKL	A1,/5700
	ST	A1,COR:48	MODIFY INSTRUCTION
	LDKL	A1,/0100
	ST A1,COR:38	MODIFY
	LDR	A1,A9	START OF BUFFER
	ADKL	A1,BUFLEN	END OF BUFFER 
	ST	A1,PLDADR+STKEND	SAVE END OF BUFFER 
	ST	A1,EINPBF+STKEND	SAVE 
	ST	A1,CONSTA+STKCOM	START OF CONF. DATA
	CF	A14,RDBLK	READ ONE BLOCK
	CF	A14,RDBLK	READ NEXT BLOCK 
	LDR	A8,A9
	LDR	A4,A8	GET START OF BUFFER
	LDR	A1,A1	TAPEMARK?
	RF(Z)	TST:10	NO! 
	CF	A14,CASSIN	INIT CONFIGURATION CASSETTE
	CALL	CON:40
	RF	TST:10
CONEX	EQU	* 
* 
*  UNLOAD CASSETTE IF NO APPLICATION DATA ON SAME CASSETTE
* 
	CF	A14,RDBLK	READ NEXT BLOCK 
	LDR	A1,A1	APPLICATION DATA?
	RF(NZ)	CON:80	NO!
	LDK	A1,/D
	CF	A14,CHCRIO	SEARCH TAPEMARK REVERSE
	CF	A14,RDBLK	BYPASS TAPEMARK 
	RF	CON:90
CON:80	EQU	*
	LDK	A1,/F
	CF	A14,CHCRIO	UNLOAD CASSETTE
CON:90	EQU	*
	ABL	CONMOV 
	XIF
	IFT	CFTEST=1 
	EJECT
CONRAD	EQU	*
* 
*  LOAD CONFIGURATION DATA FROM DISC/FLEXIBLE DISC
* 
	LD	A1,CONDEV+STKEND	GET LOAD DEVICE FOR CONF. DATA 
	RF(Z)	CONRA0	SAME AS PGM LOAD DEVICE 
* 
	CF	A14,CONFLD	INITIATE CONF. DATA LOAD DEV.
CONRA0	EQU	*
	LD	A11,CONDAD+STKEND	GET START SECTOR
	LD	A12,CONDAD+2+STKEND	MOST SIGNIFICANT PART 
	LDR	A1,A9	GET START OF BUFFER
	ADKL	A1,BUFLEN-6	END OF BUFFER 
	ST	A1,PLDADR+STKEND	SAVE END OF BUFFER 
	LDR	A1,A9	GET START OF BUFFER
	AD	A1,SAVCON	START OF SAVE BUFFER
	ST	A1,EINPBF+STKEND	SAVE	=2
	ST	A1,CONSTA+STKCOM	START OF CONF. DATA
	LDKL	A10,0	RESET RECORD COUNTER
* 
*  READ ONE SECTOR FROM RANDOM ACCESS DEVICE
* 
	CALL	READC	READ SECTOR 
* 
*	TEST THE SYNTAX OF THE CONFIGURATION FILE 
* 
TST:10	CALL	T 
	CALL	CONRD 
	CALL	NN
	CALL	CONRD 
	CALL	TID 
	CALL	TEST
	CALL	AA
	CALL	CONRD 
	CALL	TCL 
	CALL	TEST
	CALL	AA
	CALL	CONRD 
	CALL	LEV 
	CALL	TEST
	CALL	NN1 
TST:20	CALL	CONRD 
	CALL	NN1 
	CALL	CONRD 
TST:30	LD	A5,NDEVCL+STKEND	GET NUMBER OF TERMINAL DEV. CLASSES
	CWK	A5,/3030	ZERO? 
	RF(E)	TST:40	YES!
	CALL	SUKASC
	CALL	TDCT
	CALL	TEST
	CALL	NN
	CALL	CONRD 
	CALL	LC
	CALL	TEST
	CALL	NNL 
	CALL	CONRD 
	RB	TST:30
TST:40	EQU	*
	CALL	NN1 
	CALL	CONRD 
TST:50	EQU	*
	LD	A5,NDEVCL+STKEND	GET NUMBER OF SPECIAL DEV. CLASSES 
	CWK	A5,/3030	ZERO? 
	RF(E)	TST:60	YES!
	CALL	SUKASC
	CALL	SDCS
	CALL	TEST
	CALL	NN
	CALL	CONRD 
	RB	TST:50
TST:60	EQU	*
	LCR	A5,A4	GET CHARACTER
	CCK	A5,'TT'	BLOCK TYPE T? (MOD. INSTR.)
TST:70	EQU	*-2
	RB(E)	TST:10	YES!
	LDKL	A3,/FFFF
	ST	A3,TST:70	MODIFY INSTRUCTION TO RF
	CCK	A5,'CC'	BLOCK TYPE C ? 
	RF(NE)	TST:80	NO!
	LDKL	A3,'CC' 
	ST	A3,T:10	MODIFY INSTRUCTION
	CALL	T 
	RB	TST:20
TST:80	EQU	*
	LDR	A1,A5	SAVE FIRST CHARACTER IN RECORD 
	ADK	A4,1	INCREMENT BUFFER POINTER
	LCR	A5,A4	GET CHARACTER
	CCK	A5,';;'	END OF RECORD
	ABL(NE)	CONERR	NO! 
TST:85	EQU	*
	CCK	A1,'AA'	START OF APPL. CONTR. BLOCK? 
	RF(E)	TST:90	YES 
* 
	CCK	A1,'DD'	DATA COMMUNICATION BLOCK?
	RF(NE)	TST:87	NO!
* 
	LD	A1,EINPBF+STKEND	CURRENT POSITION IN CONF. DATA 
	SU	A1,CONSTA+STKCOM	CALCULATE RELATIVE POSITION
	ST	A1,DCBLK+STKCOM	SAVE
TST:87	EQU	*
	CALL	CONRD	MOVE AND GET NEXT RECORD
	LCR	A1,A4	AND FIRST CHAR. IN IT
	RB	TST:85
* 
TST:90	EQU	*
* 
*  APPLICATION CONTROL BLOCK
*  SKIP NAME RECORD AND 
*  SCAN CONFIGURATION DATA
* 
	LDKL	A1,/FF3B	SUBSTITUTE 'A;' WITH 'HEX. FF' AND ';' 
	STR	A1,A8
	LD	A2,CURAPL+STKEND	CURRENT APPL. CONTR. BLOCK 
	LD	A1,EINPBF+STKEND	CURRENT POSITION IN CONF. DATA 
	ADK	A1,1	SKIP BLOCK MARKER 
	SU	A1,CONSTA+STKCOM	CALCULATE RELATIVE POSITION
	ST	A1,APLMMC,A2	AND SAVE AS START OF APPL. CONF. DATA
	ADK	A2,ACBLEN
	ST	A2,CURAPL+STKEND	ADVANCE TO NEXT APPL. CONTR. BLOCK 
	CALL	CONRD	MOVE AND PACK RECORD
	ADKL	A10,1	INCREMENT RECORD COUNTER
	CW	A10,LSTREC+STKEND	LAST RECORD 
	RF(E)	COR:50	YES!
	ADKL	A8,RECLEN+1	INCREMENT RECORD POINTER
	CW	A8,PLDADR+STKEND	END OF BUFFER
	RF(NE)	TST:95
* 
	CALL	READC	READ SECTOR 
TST:95	EQU	*
	LDKL	A1,'TT'	LOOK FOR TASK DEF. BLOCK
	ST	A1,TST:70	MODIFY INSTR. 
	ST	A1,T:10 
	LDR	A4,A8
	ABL	TST:10	SCAN CONF. DATA 
* 
COR:50	EQU	*
	LD	A1,SCTOPT	GET OPTION WORD 
	ANK	A1,8	SWB:S?
	RF(Z)	COR:55	NO
	LDK	A3,'S' 
	SC	A3,GET:25+1	MODIFY INSTRUCTION
	SC	A3,GET:60+1	MODIFY INSTRUCTION
	LD	A1,IPLDEV+STKEND
	CF	A14,LODDEV	INITIALIZE PGM LOAD DEVICE 
	CF	A14,GETFIL
* 
*  UNLOCK FLEXIBLE DISC 
* 
COR:55	EQU	*
	LD	A1,CONDEV+STKEND	GET CONF. DATA LOAD DEVICE 
	RF(Z)	COR:58	SAME AS APPL. LOAD DEVICE 
* 
	LDR	A2,A1
	ANK	A2,/F
	SUK	A2,9 
	RF(NZ)	COR:58	NOT FLEXIBLE DISC
* 
	XIF
	IFT	CFTEST+FLDISC=2
	CF	A14,UNLOCK	UNLOCK FLEXIBLE DISC 
	XIF
	IFT	CFTEST=1 
COR:58	EQU	*
	LD	A1,SCTIPL	GET PROGRAM LOAD DEVICE 
	SUK	A1,/F8	CHECK TYPE
	RF(N)	COR:60	NOT FLEXIBLE DISC 
* 
	XIF
	SUK	A1,/FC-/F8	FLEXIBLE DISC?
	ABL(NN)	COR:60	NO! 
* 
	IFT	CFTEST+FLDISC=2
	LD	A2,SCTOPT	GET OPTION WORD 
	ANK	A1,2	DISC PAGING?
	RF(NZ)	COR:60	YES! DON'T UNLOCK
* 
	LD	A1,IPLDEV+STKEND
	CF	A14,UNLOCK	UNLOCK FLEXIBLE DISC 
	XIF
	IFT	CFTEST=1 
COR:60	EQU	*
	EJECT
CONMOV	EQU	*
* 
*  MOVE CONFIGURATION DATA TO END OF SYSTEM AREA
* 
	CIO	A1,0,SOP	INHIBIT SOP SWITCHES
	LD	A1,CONSTA+STKCOM	GET START OF CONF. DATA
CMOV10	LD	A3,EINPBF+STKEND	GET END OF CONFIGURATION DATA
	LD	A2,ESYSTA+STKEND	GET END OF SYSTEM AREA 
	CM	-2,A2	MAKE SURE CONFIGURATION FILE
	SUK	A2,1	IS FOLLOWED BY X'00'
	SUR	A3,A1	LENGTH OF CONFIGURATION DATA 
	ST	A3,CONLEN+STKCOM	SAVE LENGTH OF CONF. DATA

	SUR	A2,A3	TO-ADDRESS 
* 
	ANKL	A2,/FFFE	MAKE EVEN ADDRESS
	CALL	MOVE
	ST	A2,CONSTA+STKCOM	SAVE START OF CONFIGURATION DATA 
	LD	A1,CONLEN+STKCOM	GET LENGTH OF CONF. DATA 
	ADK	A1,2	INCLUDE TRAILING ZEROES IN LENGTH 
	ANKL	A1,/FFFE	AND MAKE EVEN
	ST	A1,CONLEN+STKCOM
	LDR	A1,A9	GET START OF FREE AREA 
	LDR	A12,A2	END OF FREE AREA
	SUR	A12,A1	SUBTRACT MONITOR END
	ST	A12,M:REL+STKCOM	SAVE RELOCATION CONSTANT 
	LD	A2,SCTMXS	GET MXSTAB ADDRESS
	RF(Z)	CMOV20	NO MXSTAB PRESENT 
* 
	AD	A2,M:REL+STKCOM	RELOCATE MXSTAB ADDRESS 
	ST	A2,SCTMXS	AND SAVE AS NEW ADDRESS 
CMOV20	EQU	*
	LD	A2,CONSTA+STKCOM	GET START OF CONFF 
* 
*  MOVE SYSLDA+SYSLDM+DWT-PROTOTYPES TO END OF FREE AREA
* 
MOPRO	EQU	* 
	LDKL	A13,SYSLDM
	SUK	A1,2 
	SUK	A2,2 
	LDR*	A4,A1 
	STR	A4,A2
	CWR	A1,A13 
	RB(NE)	MOPRO 
	ABR	A2	CONTINUE EXECUTION IN SYSLDM
	EJECT
*************************************************************** 
*  SUROUTINES USED TO TEST THE SYNTAX OF THE CONFIGURATION FILE 
*************************************************************** 
	EJECT
CONRD	EQU	* 
* 
*  COMPUTE NUMBER OF CHARACTERS IN THIS RECORD
* 
	LD	A1,EINPBF+STKEND	GET CURRENT POINTER IN BUFFER
	LDR	A2,A1	SAVE 
	LDK	A3,0	RESET CHARACTER COUNTER 
	LDR	A4,A8	START OF RECORD
COR:30	EQU	*
	LCR	A5,A4	GET CHARACTER
	CCK	A5,';;'	END OF RECORD? 
	RF(E)	COR:40	YES!
COR:35	EQU	*
	CWK	A3,RECLEN	MAXIMUM SIZE ACHIEVED? 
COR:38	EQU	*-2
	RF(E)	COR:40	YES!
	CW	A1,ESYSTA+STKEND	MEMORY OVERFLOW? 
	RF(E)	MEMOFL	YES!
	ADK	A1,1	INCREMENT BUFFER POINTER
	ADK	A3,1	INCREMENT CHARACTER COUNTER 
	ADK	A4,1	INCREMENT RECORD POINTER
	RB	COR:30	LOOP 
COR:40	EQU	*
	LC	A5,1,A4	GET NEXT CHARACTER
	CCK	A5,';;'	TWO SEMICOLONS?
	RF(NE)	COR:45	NO!
	CWK	A3,NCHTID	CHECK IF END OF RECORD 
	RB(E)	COR:35	NO: SEMICOLON CHARACTER IN RECORD 
COR:45	EQU	*
	ST	A1,EINPBF+STKEND	SAVE CURRENT DESTINATION 
	LDR	A1,A8	START OF RECORD
	CALL	MOVE
COR:48	EQU	*
	ADKL	A10,1	INCREMENT RECORD COUNTER
	CW	A10,LSTREC+STKEND	LAST RECORD 
	ABL(E)	COR:50	YES! 
	ADKL	A8,RECLEN+1	INCREMENT RECORD POINTER
	CW	A8,PLDADR+STKEND	END OF BUFFER
	RF(NE)	COR:10	NO!
	CALL	READC	READ SECTOR 
COR:10	LDR	A4,A8	START OF RECORD
	RTN	A14
	XIF
	IFT	CFTEST+CASS=2
CON:40	EQU	*
	CF	A14,RDBLK	READ NEXT BLOCK 
	LDR	A1,A1	TAPEMARK?
	ABL(NZ)	CONEX	YES! 
	LDR	A8,A9
	LDR	A4,A8	GET START OF BUFFER
	RTN	A14
	XIF
	IFT	CFTEST=1 
MEMOFL	EQU	*
	LDKL	A1,LMP3	INDICATE MEMORY OVERFLOW
	CALL	ERROR 
	EJECT
READC	EQU	* 
	CF	A14,RDSEC	READ SECTOR 
	LDR	A8,A9
	LDR	A4,A8	GET START OF BUFFER
	RTN	A14
T	EQU	* 
	LCR	A5,A4	GET CHARACTER
	CCK	A5,'TT'	BLOCK TYPE T?
T:10	EQU	*-2
	ABL(NE)	CONERR 
	ADK	A4,1	INCREMENT BUFFER POINTER
	LCR A5,A4	GET NEXT CHARACTER 
	CCK	A5,';;'	END OF RECORD? 
	ABL(NE)	CONERR	NO! 
	RTN	A14
	EJECT
NNL	EQU	* 
	LDK	A3,3	NO OF DIGITS IN LINE NUMBER 
	CF	A14,NUMB	LOOK IF LEGAL DIGITS 
	LDR	A1,A1	SET RETURN CONDITION 
	ABL(Z)	CONERR	LINE NUMBER '000' NOT ALLOWED
* 
	LCR	A5,A4	GET NEXT CHARACTER 
	CCK	A5,'LL'	LINE L?
	RF(E)	NN:40	YES! 
	CCK	A5,'RR'	LINE R?
	RF(E)	NN:40	YES! 
	CCK	A5,'AA'	LINE A?
	RF(E)	NN:40	YES! 
	CCK	A5,'SS'	LINE S?
	RF(E)	NN:40	YES! 
	CCK	A5,'PP'	LINE P?
	RF(E)	NN:40	YES! 
	CCK	A5,'VV'	LINE V?
	RF(E)	NN:40
	CCK	A5,'QQ'	LINE Q?
	RF(E)	NN:40	YES! 
	RF	CONERR
NN:40	EQU	* 
	ADK	A4,1	INCREMENT BUFFER POINTER
	RF	NN:50 
* 
NN	EQU	*
	LDK	A3,2	NO OF DIGITS IN NUMBER
	CF	A14,NUMB	LOOK IF LEGAL DIGITS 
	LDR	A1,A1	SET RETURN CONDITION 
	RF(Z)	CONERR	'00' NOT ALLOWED
* 
	RF	NN:50	LOOK IF END IF RECORD 
* 
NN1	EQU	* 
	LDK	A3,2	NO OF DIGITS IN NUMBER
	CF	A14,NUMB	LOOK IF LEGAL DIGITS 
	ST	A5,NDEVCL+STKEND	SAVE NUMBER
NN:50	LCR	A5,A4	GET CHARACTER 
	CCK	A5,';;'	END OF RECORD? 
	RF(NE)	CONERR	NO!
	RTN	A14
	EJECT
AA	EQU	*
	LDK	A3,2 
AA:10	EQU	* 
	LCR	A5,A4	GET CHARACTER
	CCK	A5,/3030	ALPHA-NUMERIC CHARACTER <30?
	RF(L)	CONERR	YES!
	CCK	A5,/3939	ALPHA-NUMERIC CHARACTER > 39? 
	RF(NG)	AA:20	NO! 
	CCK	A5,/4141	ALPHA-NUMERIC CHARACTER < 41? 
	RF(L)	CONERR 
	CCK	A5,/5A5A	ALPHA-NUMERIC CHARACTER > 5A? 
	RF(G)	CONERR 
AA:20	EQU	* 
	ADK	A4,1	INCREMENT BUFFER POINTER
	SUK	A3,1 
	RB(NZ)	AA:10 
	LCR	A5,A4	GET NEXT CHARACTER 
	CCK	A5,';;'	END OF RECORD? 
	RF(NE)	CONERR	NO!
	RTN	A14
	EJECT
TID	EQU	* 
	LDKL	A2,SEQ1	SELECT SEQUENCE 
	LDK	A3,4	GET NUMBER OF CHARACTERS
	RTN	A14
TCL	EQU	* 
	LDKL	A2,SEQ2	SELECT SEQUENCE 
	LDK	A3,4	GET NUMBER OF CHARACTERS
	RTN	A14
LEV	EQU	* 
	LDKL	A2,SEQ3	SELECT SEQUENCE 
	LDK	A3,4	GET NUMBER OF CHARACTERS
	RTN	A14
	EJECT
TDCT	EQU	*
	LDKL	A2,SEQ4	SELECT SEQUENCE 
	LDK	A3,5	GET NUMBER OF CHARACTERS
	RTN	A14
LC	EQU	*
	LDKL	A2,SEQ5	SELECT SEQUENCE 
	LDK	A3,3	GET NUMBER OF CHARACTERS
	RTN	A14
SDCS	EQU	*
	LDKL	A2,SEQ6	SELECT SEQUENCE 
	LDK	A3,5	GET NUMBER OF CHARACTERS
	RTN	A14
	EJECT
TEST	EQU	*
	LCR	A5,A4	GET CHARACTER
	CCR	A5,A2
	RF(NE)	CONERR
	ADK	A4,1	INCREMENT BUFFER POINTER
	ADK	A2,1	INCREMENT SEQUENCE POINTER
	SUK	A3,1	MORE CHARACTERS IN THE SEQUENCE?
	RB(NZ)	TEST	YES! 
	RTN	A14
	EJECT
SUKASC	EQU	*
	CCK	A5,/3030	NUMBER OF NUMERIC CHARACTERS<10?
	RF(NE)	SUK:10	YES! 
	SUK	A5,/F6	N0! 
SUK:10	SUK	A5,1 
	ST	A5,NDEVCL+STKEND	STORE NUMBER OF CLASSES
	RTN	A14
	EJECT
NUMB	EQU	*
	LDK	A1,0	RESET NO OF NON ZERO DIGITS 
NUMB00	EQU	*
	LCR	A5,A4	GET DIGIT IN NUMBER
	ADK	A4,1	INCREMENT BUFFER POINTER
	CCK	A5,/3939	NUMERIC CHARACTER >9? 
	RF(G)	CONERR	YES!
* 
	CCK	A5,/3030	NUMERIC CHARACTER <0? 
	RF(L)	CONERR	YES!
	RF(Z)	NUMB10	NUMERIC CHARACTER =0
* 
	ADK	A1,1	INCREMENT NO OF NON ZERO DIGITS 
NUMB10	EQU	*
	SUK	A3,1	DECREMENT DIGIT COUNTER 
	RF(Z)	NUMB20	ALL DIGITS PROCESSED
* 
	SLL	A5,8	LAST DIGIT TO LEAST SIGN. BYTE
	RB	NUMB00	PROCESS NEXT DIGIT 
* 
NUMB20	EQU	*
	RTN	A14	RETURN 
	EJECT
* 
* 
**************************************************
*                                                *
*     SEQUENCES                                  *
*                                                *
**************************************************
* 
* 
* 
* 
SEQ1	EQU	*	TID= 
	DATA	'TI'
	DATA	'D='
SEQ2	EQU	*	TCL= 
	DATA	'TC'
	DATA	'L='
SEQ3	EQU	*	LEV= 
	DATA	'LE'
	DATA	'V='
SEQ4	EQU	*	TDC=T
	DATA	'TD'
	DATA	'C='
	DATA	'T0'
SEQ5	EQU	*	LC=
	DATA	'LC'
	DATA	'=0'
SEQ6	EQU	*	SDC=S
	DATA	'SD'
	DATA	'C='
	DATA	'S0'
	XIF
	IFT	CFTCAS+CASS=2
* 
*  PROGRAM LOAD DEVICE = CASSETTE 
* 
CON:30	EQU	*
	LDR	A1,A9	START OF BUFFER
	ADKL	A1,BUFLEN	END OF BUFFER 
	ST	A1,PLDADR+STKEND	SAVE END OF BUFFER 
	ST	A1,EINPBF+STKEND	SAVE 
	ST	A1,CONSTA+STKCOM	START OF CONFIGURATION DATA
	CF	A14,RDBLK	READ ONE BLOCK
	CF	A14,RDBLK	READ NEXT BLOCK 
	LDR	A1,A1	TAPEMARK?
	RF(Z)	CON:50	NO! 
	CF	A14,CASSIN	INIT CONFIGURATION CASSETTE
CON:40	EQU	*
	CF	A14,RDBLK	READ NEXT BLOCK 
	LDR	A1,A1	TAPEMARK?
	RF(NZ)	CONEX	YES!
CON:50	EQU	*
* 
*  COMPUTE NUMBER OF CHARACTERS IN THIS BLOCK 
* 
	LD	A1,EINPBF+STKEND	GET CURRENT POINTER IN BUFFER
	LDR	A2,A1	SAVE 
	LDK	A3,0	RESET CHARACTER COUNTER 
	LDR	A4,A9	GET START OF BUFFER
CON:60	EQU	*
	LCR	A5,A4	GET CHARACTER IN BUFFER
	CCK	A5,';;'	CHECK IF SPACE 
	RF(E)	CON:70	NO MOORE CHARACTERS 
CON:65	EQU	*
	CWK	A3,CBLEN	END OF BUFFER?
	RF(E)	CON:75	YES!
	CW	A1,ESYSTA+STKEND	MEMORY OVERFLOW? 
	RF(E)	MEMOFL	YES!
	ADK	A1,1	INCREMENT DESTINATION POINTER 
	ADK	A3,1	INCREMENT CHARACTER COUNTER 
	ADK	A4,1	INCREMENT BUFFER POINTER
	RB	CON:60
CON:70	EQU	*
	LC	A5,1,A4	GET NEXT CHARACTER
	CCK	A5,';;'	TWO SEMI-COLONS? 
	RF(NE)	CON:75	NO!
	CWK	A3,NCHTID	CHECK IF END OF RECORD 
	RB(E)	CON:65	NO: SEMI-COLON CHARACTER IN RECORD
CON:75	EQU	*
	ST	A1,EINPBF+STKEND	SAVE CURRENT DESTINATION 
	LDR	A1,A9	GET START OF BUFFER
	CALL	MOVE
	RB	CON:40
CONEX	EQU	* 
* 
*  UNLOAD CASSETTE IF NO APPLICATION DATA ON SAME CASSETTE
* 
	CF	A14,RDBLK	READ NEXT BLOCK 
	LDR	A1,A1	APPLICATION DATA?
	RF(NZ)	CON:80	NO!
	LDK	A1,/D
	CF	A14,CHCRIO	SEARCH TAPEMARK REVERSE
	CF	A14,RDBLK	BYPASS TAPEMARK 
	RF	CON:90
CON:80	EQU	*
	LDK	A1,/F
	CF	A14,CHCRIO	UNLOAD CASSETTE
CON:90	EQU	*
	ABL	CONMOV 
	XIF
CONERR	EQU	*
	LDKL	A1,LMP4 
	CALL	ERROR 
	IFF	CFTEST=1 
MEMOFL	EQU	*
	LDKL	A1,LMP3	INDICATE MEMORY OVERFLOW
	CALL	ERROR 
	EJECT
CONRAD	EQU	*
* 
*  LOAD CONFIGURATION DATA FROM DISC/FLEXIBLE DISC
* 
	LD	A1,CONDEV+STKEND	GET LOAD DEVICE FOR CONF. DATA 
	RF(Z)	CONRA0	SAME AS PGM LOAD DEVICE 
* 
	CF	A14,CONFLD	INITIATE CONF. DATA LOAD DEV.
CONRA0	EQU	*
	LD	A11,CONDAD+STKEND	GET START SECTOR
	LD	A12,CONDAD+2+STKEND	MOST SIGNIFICANT PART 
	LDR	A1,A9	GET START OF BUFFER
	ADKL	A1,BUFLEN-6	END OF BUFFER 
	ST	A1,PLDADR+STKEND	SAVE END OF BUFFER 
	LDR	A1,A9	GET START OF BUFFER
	AD	A1,SAVCON	START OF SAVE BUFFER
	ST	A1,EINPBF+STKEND	SAVE	=2
	ST	A1,CONSTA+STKCOM
	LDKL	A10,0	RESET RECORD COUNTER
COR:10	EQU	*
* 
*  READ ONE SECTOR FROM RANDOM ACCESS DEVICE
* 
	CF	A14,RDSEC	READ SECTOR 
	LDR	A8,A9	GET START OF BUFFER
COR:20	EQU	*
* 
*  COMPUTE NUMBER OF CHARACTERS IN THIS RECORD
* 
	LD	A1,EINPBF+STKEND	GET CURRENT POINTER IN BUFFER
	LDR	A2,A1	SAVE 
	LDK	A3,0	RESET CHARACTER COUNTER 
	LDR	A4,A8	START OF RECORD
* 
*  LOOK IF WE HAVE AN 
*  APPLICATION CONTROL BLOCK
* 
	LDR*	A5,A4	GET 1ST WORD IN BUFFER
	CWK	A5,'D;'	DATA COMMUNICATION DEF. BLOCK? 
	RF(E)	COR:25	YES!
* 
	CWK	A5,'A;'	AND LOOK IF IT IS 'A;' 
	RF(NE)	COR:30	NO!
* 
	LDKL	A5,/FF3B	YES, SUBSTITUTE A; WITH
	STR	A5,A4	'HEX FF' AND ';' 
	LD	A5,CURAPL+STKEND	GET CURRENT APPL. CONTR. BLOCK 
	ADK	A1,1	SKIP BLOCK MARKER 
	ST	A1,EINPBF+STKEND	SAVE CURRENT BUFFER POSITION 
	SU	A1,CONSTA+STKCOM	AND CALCULATE RELATIVE POSITION
	ST	A1,APLMMC,A5	SAVE IN APPL. CONTROL BLOCK
	LDR	A1,A8	START OF RECORD
	ADK	A3,1	INCREMENT NO OF CHARACTERS TO MOVE
	CALL	MOVE
	ADKL	A10,2	SKIP NEXT RECORD
* 
	ADKL	A8,RECLEN+1	INCREMENT RECORD POINTER
	CW	A8,PLDADR+STKEND	END OF BUFFER? 
	RF(L)	COR:48	NO! 
* 
	CF	A14,RDSEC	YES, READ NEXT SECTOR 
	LDR	A8,A9	AND GET START OF BUFFER
	RF	COR:48
* 
COR:25	EQU	*
	LD	A5,EINPBF+STKEND	CURRENT POSITION IN CONF. DATA	=6
	SU	A5,CONSTA+STKCOM	CALCULATE RELATIVE POSITION	=6 
	ST	A5,DCBLK+STKCOM	SAVE	=6 
COR:30	EQU	*
	LCR	A5,A4	GET CHARACTER
	CCK	A5,';;'	END OF RECORD? 
	RF(E)	COR:40	YES!
COR:35	EQU	*
	CWK	A3,RECLEN	MAXIMUM SIZE ACHIEVED? 
	RF(E)	COR:40	YES!
	CW	A1,ESYSTA+STKEND	MEMORY OVERFLOW? 
	RB(E)	MEMOFL	YES!
	ADK	A1,1	INCREMENT BUFFER POINTER
	ADK	A3,1	INCREMENT CHARACTER COUNTER 
	ADK	A4,1	INCREMENT RECORD POINTER
	RB	COR:30	LOOP 
COR:40	EQU	*
	LC	A5,1,A4	GET NEXT CHARACTER
	CCK	A5,';;'	TWO SEMICOLONS?
	RF(NE)	COR:45	NO!
	CWK	A3,NCHTID	CHECK IF END OF RECORD 
	RB(E)	COR:35	NO: SEMICOLON CHARACTER IN RECORD 
COR:45	EQU	*
	ST	A1,EINPBF+STKEND	SAVE CURRENT DESTINATION 
	LDR	A1,A8	START OF RECORD
	CALL	MOVE
	ADKL	A10,1	INCREMENT RECORD COUNTER
	CW	A10,LSTREC+STKEND	LAST RECORD 
	RF(E)	COR:50	YES!
COR:48	EQU	*
	ADKL	A8,RECLEN+1	INCREMENT RECORD POINTER
	CW	A8,PLDADR+STKEND	END OF BUFFER
	RB(E)	COR:10	NEXT SECTOR 
	RB	COR:20	NEXT RECORD
COR:50	EQU	*
	LD	A1,SCTOPT	GET OPTION WORD 
	ANK	A1,8	SWB:S?
	RF(Z)	COR:55	NO
	LDK	A3,'S' 
	SC	A3,GET:25+1	MODIFY INSTRUCTION
	SC	A3,GET:60+1	MODIFY INSTRUCTION
	LD	A1,IPLDEV+STKEND
	CF	A14,LODDEV	INITIALIZE PGM LOAD DEVICE 
	CF	A14,GETFIL
* 
*  UNLOCK FLEXIBLE DISC 
* 
COR:55	EQU	*
	LD	A1,CONDEV+STKEND	GET CONF. DATA LOAD DEVICE 
	RF(Z)	COR:58	SAME AS APPL. LOAD DEVICE 
* 
	LDR	A2,A1
	ANK	A2,/F
	SUK	A2,9 
	RF(NZ)	COR:58	NOT FLEXIBLE DISC
	XIF
	IFT	CFTFLD+FLDISC=2
	CF	A14,UNLOCK	UNLOCK FLEXIBLE DISC 
	XIF
	IFF	CFTEST=1 
COR:58	EQU	*
	LD	A1,SCTIPL	GET PROGRAM LOAD DEVICE 
	SUK	A1,/F8	CHECK TYPE
	RF(N)	COR:60	NOT FLEXIBLE DISC 
* 
	SUK	A1,/FC-/F8	FLEXIBLE DISC?
	RF(NN)	COR:60	NO!
* 
	XIF
	IFT	CFTFLD+FLDISC=2
	LD	A2,SCTOPT	GET OPTION WORD 
	ANK	A1,2	DISC PAGING?
	RF(NZ)	COR:60	YES! DON'T UNLOCK
* 
	LD	A1,IPLDEV+STKEND
	CF	A14,UNLOCK	UNLOCK FLEXIBLE DISC 
	XIF
	IFF	CFTEST=1 
	IFF	CFTEST=1 
COR:60	EQU	*
	EJECT
CONMOV	EQU	*
* 
*  MOVE CONFIGURATION DATA TO END OF SYSTEM AREA
* 
	CIO	A1,0,SOP	INHIBIT SOP SWITCHES
	LDR	A1,A9	GET START OF BUFFER
	AD	A1,SAVCON	COMPUTE END OF BUFFER 
CMOV10	LD	A3,EINPBF+STKEND	GET END OF CONFIGURATION DATA
	LD	A2,ESYSTA+STKEND	GET END OF SYSTEM AREA 
	CM	-2,A2	MAKE SURE CONFIGURATION FILE
	SUK	A2,1	IS FOLLOWED BY X'00'
	SUR	A3,A1	LENGTH OF CONFIGURATION DATA 
	ST	A3,CONLEN+STKCOM	SAVE LENGTH OF CONF. DATA
	SUR	A2,A3	TO-ADDRESS 
* 
	ANKL	A2,/FFFE	MAKE EVEN ADDRESS
	CALL	MOVE
	ST	A2,CONSTA+STKCOM	SAVE START OF CONFIGURATION DATA 
	LD	A1,CONLEN+STKCOM	GET LENGTH OF CONF. DATA 
	ADK	A1,2	INCLUDE TRAILING ZEROES IN LENGTH 
	ANKL	A1,/FFFE	AND MAKE EVEN
	ST	A1,CONLEN+STKCOM
	LDR	A1,A9	GET START OF FREE AREA 
	LDR	A12,A2	END OF FREE AREA
	SUR	A12,A1	SUBTRACT MONITOR END
	ST	A12,M:REL+STKCOM	SAVE RELOCATION CONSTANT 
	LD	A2,SCTMXS	GET MXSTAB ADDRESS	=1 
	RF(Z)	CMOV20	NO MXSTAB PRESENT	=1
*		 	=1 
	ADR	A2,A12	RELOCATE MXSTAB ADDRESS	=1
	ST	A2,SCTMXS	AND SAVE AS NEW ADDRESS	=1
CMOV20	EQU	*	 	=1 
	LD	A2,CONSTA+STKCOM	GET START OF CONFF 
* 
*  MOVE SYSLDA+SYSLDM+DWT-PROTOTYPES TO END OF FREE AREA
* 
MOPRO	EQU	* 
	LDKL	A13,SYSLDM
	SUK	A1,2 
	SUK	A2,2 
	LDR*	A4,A1 
	STR	A4,A2
	CWR	A1,A13 
	RB(NE)	MOPRO 
	ABR	A2	CONTINUE EXECUTION IN SYSLDM
	XIF
	EJECT
************************************************************************
*  SUBROUTINES USED IN THE APPLICATION AND CONFIGURATION LOADING PHASE O
************************************************************************
******************************* 
*  SOPIN - READ SOP SWITCHES  * 
*  =========================  * 
*                             * 
*  ENTRY:                     * 
*                             * 
*  EXIT:  A1 - SOP INPUT      * 
*         BIT 6 - SWITCH 1    * 
*         BIT 15 - SWITCH 10  * 
*                             * 
*  WORK REGISTERS:  A1        * 
*                             * 
*  SUBROUTINES:               * 
*                             * 
******************************* 
SOPIN	EQU	* 
	CIO	A1,1,SOP 
	INR	A1,0,SOP 
	RB(NA)	*-2 
	RTN	A14
	EJECT
*********************************** 
*                                 * 
*	LODDEV - INITIAZE LOAD UNIT     * 
*	===========================     * 
*                                 * 
*	USED FOR CONFIGURATION OF       * 
*	PROGRAM LOAD DEVICE AND         * 
*	CONFIGURATION DATA LOAD         * 
*	DEVICE (IF DIFFERENT).          * 
*                                 * 
*	ON ENTRY: A1=DEVICE ADDRESS     * 
*	ON EXIT:  A2=FILE CODE          * 
*                                 * 
*********************************** 


LODDEV	EQU	*
	LDKL	A3,BUFLEN 
	ST	A3,SAVCON	INITIALIZE BUFFER LENGTH
	LDKL	A2,-1 
	ST	A2,CYLNBR	SET SEEK CONDITION
	LDR	A2,A1
	ANK	A2,/80	CHECK IF CASSETTE	=9
	RF(P)	CASS:0	YES!
* 
	LDR	A2,A1	GET PROGRAM LOAD DEVICE
	SRL	A2,4	BIT15 INDICATE UNIT 1 OR 2
	LC	A3,IPLTYP+1+STKEND	GET DEVICE TYPE
	ANK	A3,/FF 
	SUK	A3,3 
	RF(N)	DISC:0	DISC
	RF(Z)	MFD:0	MINI FIXED DISC
	SUK	A3,3		=9 
	RF(N)	CDC:0	80M CDC DISC 
	RF	FLEX:0	FLEXIBLE DISC
	EJECT
CASS:0	EQU	*
	IFT	CASS=1 
* 
*  PROGRAM LOAD DEVICE = CASSETTE 
* 
	LD	A1,APLTAB+STKCOM	GET CURRENT APPLICATION CONTR. BLOCK 
	CM	APLADA+2,A1	CLEAR APPLICATION DISC
	CM	APLADA+4,A1	FILE ADDRESS ENTRIES
	LDKL	A1,RDBLK	GET SUBROUTINE ADDRESS 
	LDR	A10,A1 
	ST	A1,READ	STORE IN PROGRAM LOAD SUBROUTINE
CASS:2	EQU	*
	CF	A14,RDBLK	READ ONE CASSETTE BLOCK 
	LDR	A1,A1	TAPE MARK? 
	RF(Z)	FINIS	RETURN 
* 
	CF	A14,CASSIN	INIT APPLICATION CASSETTE
	RB	CASS:2
	XIF
	IFF	CASS=1 
	LDKL	A1,LMP9 
	CALL	ERROR	ILLEGAL MONITOR OPTION
	XIF
	EJECT
FLEX:0	EQU	*
	IFT	FLDISC=1 
* 
*  PROGRAM LOAD DEVICE = FLEXIBLE DISC
* 
* 
*  MODIFY SCTIPL: /F8 - DRIVE 1, /F9 - DRIVE 2
* 
	ORK 	A2,/F8
	ST	A2,FILCOD+STKEND	SAVE FILE CODE 
* 
*  INIT FLEXIBLE DISC 
* 
	CF	A14,FDINIT
	RF	FINISH
* 
	XIF
	IFF	FLDISC=1 
	LDKL	A1,LMP9 
	CALL	ERROR	ILLEGAL MONITOR OPTION
	XIF
	EJECT
MFD:0	EQU	* 
	IFT	MFDISC=1 
* 
*	PROGRAM LOAD DEVICE = MINI FIXED DISC 
* 
*	MODIFY SCTIPL:/F4-DRIVE 1,/F5-DRIVE 2 
* 
	ORK	A2,/F4 
	ST	A2,FILCOD+STKEND	SAVE FILE CODE 
* 
*	INIT MINI FIXED DISC
* 
	CF	A14,MDINIT
	RF	FINISH	RETURN 
* 
	XIF
	IFF	MFDISC=1 
	LDKL	A1,LMP9 
	CALL	ERROR	ILLEGAL MONITOR OPTION
	XIF
	EJECT
DISC:0	EQU	*
	IFT	DISC=1 
* 
*  PROGRAM LOAD DEVICE = DISC 
* 
* 
*  MODIFY SCTIPL: /F1 - CARTRIDGE DISC /F0 - FIX DISC 
* 
	LC	A2,FCTAB,A2	LOAD FILE CODE	=5 
	ST	A2,FILCOD+STKEND	SAVE FILE CODE 
* 
*  INITIALIZE DISC COMMANDS 
* 
	CF	A14,DUINIT
	XIF
	IFF	DISC=1 
	LDKL	A1,LMP9 
	CALL	ERROR 
	XIF
FINISH	EQU	*
	LDK	A1,1	A1#0 MEANS RANDOM ACCESS DEVICE 
FINIS	EQU	* 
	LD	A2,FILCOD+STKEND	RESTORE FILE CODE
	RTN	A14
	EJECT
CDC:0	EQU	* 
	IFF	CDDISC+CDDI16=0
* 
*	PROGRAM LOAD DEVICE = 16M OR 80M CDC DISC 
* 
* 
*	MODIFY SCTIPL: /FC - /FD
* 
	SRC	A2,2	TEST IF UNIT 1 OR 2	=9
	RF(NN)	CDC:1	UNIT 1	=9 
	ADK	A2,2		=9 
CDC:1	EQU	*		=9 
	ANK	A2,7	MASK BITS NOT USED	=9 
	ORK	A2,/FC	FILE CODE 
	ST	A2,FILCOD+STKEND	SAVE FILE CODE 
* 
*	INITIALISE DISC COMMANDS
* 
	CF	A14,CDINIT	INIT DEVICE
	RB	FINISH	RETURN 
	XIF
	IFT	CDDISC+CDDI16=0		=9
	LDKL	A1,LMP9 
	CALL	ERROR	ILLEGAL MONITOR OPTION
	XIF
	EJECT
******************************************************* 
*                                                     * 
*      CONFLD - SELECT LOAD UNIT FOR CONF. DATA       * 
*      ========================================       * 
*                                                     * 
*      ON ENTRY:  A1 = DEVICE ADDRESS                 * 
*                                                     * 
******************************************************* 


CONFLD	EQU	*
	LDKL	A2,-1 
	ST	A2,CYLNBR	SET SEEK CONDITION
	LDR	A2,A1	SAVE DEVICE ADDRESS
	ANK	A2,/F	ISOLATE LAST DIGIT 
	SUK	A2,7 
	RB(N)	MFD:0	MINI FIXED DISC
* 
	RB(Z)	CDC:0	80M CDC DISC 
* 
	SUK	A2,1 
	RB(Z)	DISC:0	DISC DEVICE 
* 
	RB	FLEX:0	FLEXIBLE DISC DEVICE 
	EJECT
	IFT	CASS=1 
******************************************************* 
*        CASSIN - CASSETTE INITIATING ROUTINE         * 
*        ====================================         * 
*                                                     * 
*  REFERENCED IN:  SYSLOD -LOADING PART-              * 
*                                                     * 
*  ENTRY:                                             * 
*                                                     * 
*  EXIT:                                              * 
*                                                     * 
*  WORK REGISTERS:  A1,A3                             * 
*                                                     * 
*  SUBROUTINES:  SOPIN,CHCRIO                         * 
*                                                     * 
******************************************************* 
CASSIN	EQU	*
	LDK	A1,/F
	CF	A14,CHCRIO	UNLOAD CASSETTE
	LDKL	A3,LMP1+LMP2	INDICATE EXPECTED SWITCHES 
	OTR	A3,0,SOP 
CAS:10	EQU	*
	CF	A14,SOPIN	READ SOP
	ANKL	A1,/0300	ALLOWED SWITCHES?
	RB(Z)	CAS:10	NO! 
	LDKL	A3,LMP1	SWITCH ON LOAD LAMP 
	OTR	A3,0,SOP 
	SRL	A1,8	RIGHT ALIGN 
	ANK	A1,1	SELECT UNIT 
	CF	A14,CHCRIO	SELECT UNIT
	LDK	A1,LOCK
	CF	A14,CHCRIO	LOCK CASSETTE
	ANK	A3,1	CASSETTE OPERABLE?
	RB(NZ)	CAS:10	NO!
	LDK	A1,SBOT		
	CF	A14,CHCRIO	SEARCH BEGINNING OF TAPE 
	LDK	A1,STMF
	CF	A14,CHCRIO	SEARCH TAPEMARK FORWARD
	RTN	A14
	EJECT
********************************************* 
*  CHCRIO - CASSETTE I/O EXECUTING ROUTINE  * 
*  =======================================  * 
*                                           * 
*  REFERENCED IN:  CASSIN,SYSLOD            * 
*                                           * 
*  ENTRY:  A1 - I/O INSTRUCTION COMMAND     * 
*                                           * 
*  EXIT:                                    * 
*                                           * 
*  WORK REGISTERS:  A1,A3                   * 
*                                           * 
*  SUBROUTINES:                             * 
*                                           * 
********************************************* 
CHCRIO	EQU	*
	CIO	A1,1,CHCR
	SST	A3,CHCR
	RB(NA)	CHCRIO
	RTN	A14
	EJECT
**************************************************
*                                                *
*        RDBLK - READ ONE CASSETTE BLOCK         *
*        ===============================         *
*                                                *
*  REFERENCED IN:  SYSLOD                        *
*                                                *
*  ENTRY:  A9 - CASSETTE BUFFER POINTER          *
*                                                *
*  EXIT:  A2 - NUMBER OF CHARACTERS IN BLOCK     *
*                                                *
*  WORK REGISTERS: A1,A2,A3,A4,A5                   * 
*                                                *
*  SUBROUTINES:                                  *
**************************************************
RDBLK	EQU	* 
	LDK	A5,0 
RDB:10	EQU	*
	LDR	A3,A9	START OF BUFFER
	LDK	A2,0	RESET CHARACTER COUNTER 
	LDR	A4,A3	SAVE START OF BUFFER 
	ADKL	A3,CBLEN	END OF BUFFER
	LDK	A1,/A
	CIO	A1,1,CHCR	READ BLOCK 
	RF(NA)	RDERR3
RDB:20	EQU	*
	INR	A1,0,CHCR
	RF(NA)	RDB:30
	CWR	A4,A3	END OF BUFFER? 
	RF(E)	RDERR	YES! 
	SCR	A1,A4	STORE CHARACTER
	ADK	A2,1	INCREMENT CHARACTER COUNTER 
	ADK	A4,1	INCREMENT BUFFER POINTER
RDB:30	EQU	*
	SST	A1,CHCR		
	RB(NA)	RDB:20
	ANKL	A1,/FCFF	CHECK STATUS 
	LDR	A4,A1	SAVE STATUS
	RF(Z)	RDBEX	OK 
	SLC	A4,3	CHECK IF TAPEMARK 
	RF(N)	RDBEX	OK IF TAPEMARK 
RDERR	EQU	* 
* 
*  READ ERROR HAS OCCURRED: MAKE ANOTHER ATTEMPT TO READ
*  THE SAME BLOCK IF NOT 3 ATTEMPTS ALREADY HAS BEEN MADE 
* 
	ADK	A5,1	NEXT ATTEMPT
	CWK	A5,3	THIRD ATTEMPT?
	RF(E)	RDERR3	YES - GIVE UP!
	LDK	A1,/E	REVERSE ONE BLOCK
	CIO	A1,1,CHCR	EXECUTE ORDER
	RB(NA)	*-2	LOOP UNTIL ACCEPTED 
	RB	RDB:10
RDERR3	EQU	*
	LDKL	A1,LMP2 
	CALL	ERROR 
RDBEX	EQU	* 
	RTN	A14
	XIF
	IFT	DISC=1 
	EJECT
*********************************** 
*                                 * 
*  DUINIT - INITIALIZE DISC UNIT  * 
*  =============================  * 
*                                 * 
*  REFERENCED IN: SYSLOD,GETFIL   * 
*                                 * 
*  ENTRY: A1 - DEVICE ADDRESS     * 
*                                 * 
*  EXIT:                          * 
*                                 * 
*  WORK REGISTERS: A2,A3             *
*                                 * 
*  SUBROUTINES:                   * 
*                                 * 
*********************************** 

DUINIT	EQU	*
	LDKL	A2,RDSEC2	GET SUBROUTINE ADDRESS
	LDR	A5,A1	SAVE FILE CODE 
	EJECT
* 
*	INIT DISC COMMANDS VERSION A2 
* 
	ORKL	A1,CIO+8	CONF. CIO A1,1,XX INSTR. 
	ST	A1,SEEK20 
	ORKL	A1,/800	FORM SST A1,XX INSTR. 
	ST	A1,SEEK21 
	XRKL	A1,/B00	FORM CIO A2,1,XX INSTR. 
	ST	A1,READ21 
	ORKL	A1,/800	FORM SST A2,XX INSTR
	ST	A1,READ22 
	ST	A2,READ	INIT SUBROUTINE ADDRESSES 
	ST	A2,READS
	LDK	A2,4 
	XRS	A2,CRCCHK	DISCARD CRC CHECK
	CF	A14,GETVLB	GET VOLUME LABEL 
	LDK	A2,4 
	ORS	A2,CRCCHK	SET CRC CHECK
	LC	A2,FORDEV,A9	GET FORMAT 
	ANK	A2,1 
	RF(Z)	DUI:50	FORMAT A2 
* 
	LDR	A1,A5	RESTORE FILE  CODE 
	LDKL	A2,RDSEC3	GET SUBROUTINE ADDRESS
* 
*	INIT DISC COMMANDS VERSION A3 
* 
	LDKL	A3,DKBA3	BUFFER LENGTH VERSION A3 
	ST	A3,SAVCON	BUFFER LENGTH VERSION A3
	ORKL	A1,CIO+8
	XRKL	A1,/500	CONFIG. CIO A4,1,XX INSTR.
	ST	A1,SEEK30 
	ORKL	A1,/800	FORM SST A4,XX INSTR. 
	ST	A1,SEEK31 
	XRKL	A1,/E00	FORM CIO A2,1,XX INSTR. 
	ST	A1,READ30 
	ORKL	A1,/800	FORM SST A2,XX INSTR. 
	ST	A1,READ31 
* 
*  INIT SUBROUTINE ADDRESSES
* 
DUI:40	ST	A2,READ	READ PROGRAM
	ST	A2,READS	READ CONFIGURATION DATA
DUI:50	EQU	*
	RTN	A14
	EJECT
*********************************************** 
*                                             * 
*  RDSEC - READ ONE SECTOR FROM DISC          * 
*  =================================          * 
*                                             * 
*  REFERENCED IN: SYSLOD                      * 
*                                             * 
*  ENTRY:  A9 = BUFFER ADDRESS
*                                             * 
*         A11 - SECTOR NUMBER                 * 
*                                             * 
*  EXIT:                                      * 
*                                             * 
*   WORK REGISTERS:  A1,A2,A3,A4,A7 
*                                             * 
*  SUBROUTINES:  ERROR                        * 
*                                             * 
*********************************************** 
* 
	EJECT
* 
*	READ DISC SECTOR VERSION A2 
* 
RDSEC2	EQU	*
	LDK	A2,0 
	LDR	A1,A11	GET LOGICAL SECTOR NUMBER 
DIV200	EQU	*
	ADR	A2,A1
	SRL	A1,5 
	RB(NZ)	DIV200	MORE IN SERIE TO ADD 
	LDR	A1,A2
	ANKL	A1,/FFE0
	SRL	A2,5 
	SUR	A1,A2
	SUR	A1,A11 
	ADK	A1,31
	RF(P)	DIV210	NO CORRECTION OF RESULT 
	ADK	A2,1 
DIV210	EQU	*
	LDR	A2,A2	A2:=CYL NBR = LOG SEC NBR / 31 
	RF(Z)	DIV220	CYLINDER 0
	ADK	A2,1 
DIV220	EQU	*
	ADR	A2,A11	A2:=PHYS. SEC NBR BEFORE INTERLACING
* 
	LDR	A1,A2
	SRL	A1,5 
	CW	A1,CYLNBR 
	RF(E)	INT200	SAME CYLINDER NUMBER
	ST	A1,CYLNBR 
	SLL	A1,3 
	ORK	A1,2	SET BIT 14
	EJECT
* 
*	SEEK CYLINDER 
* 
SEEK20	CIO	A1,1,0 
	RB(NA)	SEEK20
* 
SEEK21	SST	A1,0 
	RB(NA)	SEEK21
* 
*	INTERLACING 
* 
INT200	EQU	*
	LDR	A1,A2
	ADR	A2,A2
	ADR	A2,A1	INTERLACING FACTOR 3 
	ANK	A2,/1F 
	LD	A1,CYLNBR	GET CYLINDER NUMBER 
	ANK	A1,1 
	RF(Z)	INT210	EVEN CYLINDER 
	ADK	A2,8 
INT210	EQU	*
	ANK	A2,/1F 
	SLL	A2,2	PHYSICAL SECTOR AND ORDER CODE
	ST	A2,SECNBR 
	EJECT
* 
*	READ SECTOR 
* 
	LDR	A1,A9	BUFFER ADDRESS 
READ20	LDKL	A4,MUXCC	NUMBER OF WORDS
WERIO2	WER	A4,/10	WRITE NUMBER OF WORDS 
	WER	A1,/11	WRITE BUFFER ADDRESS
READ21	CIO	A2,1,0	READ SECTOR 
	RB(NA)	READ21	LOOP UNTIL ACCEPTED
READ22	SST	A2,0	STATUS
	RB(NA)	READ22	LOOP UNTIL ACCEPTED
CRCCHK	EQU	*
	ANK	A2,/1F	STATUS
	RF(NZ)	DUERR	READING ERROR 
	ADKL	A11,1	INCREMENT SECTOR COUNTER
	RTN	A14
	EJECT
* 
*	READ DISC SECTOR VERSION A3 
* 
RDSEC3	EQU	*
	LDK	A2,0 
	LDR	A1,A11	GET LOGICAL SECTOR NUMBER 
	LDKL	A7,/1000
	LDKL	A4,/3000
DIV300	EQU	*
	SUR	A1,A4
	RF(N)	DIV310 
	ADR	A2,A7
	RB	DIV300
DIV310	EQU	*
	ADR	A1,A4	ADJUST DIVIDEND
	SRL	A4,4 
	SRL	A7,4 
	RB(NZ)	DIV300
	ADR	A2,A2
* 
	SUK	A1,1 
	ST	A1,SAVMEM 
	RF(NP)	CASE10	,XXXX  ,      , OR ,    XX,XX    , 
	ADK	A2,1	,      ,  XXXX, 
CASE10	EQU	*
	LDR	A4,A2
	SRL	A4,5 
	CW	A4,CYLNBR 
	RF(E)	INT300 
	ST	A4,CYLNBR	STORE NEW CYLINDER NUMBER 
	SLL	A4,3 
	ORK	A4,2	SET BIT 14
	EJECT
* 
*	SEEK CYLINDER 
* 
SEEK30	CIO	A4,1,0 
	RB(NA)	SEEK30
* 
SEEK31	SST	A4,0	GET STATUS
	RB(NA)	SEEK31
* 
*	INTERLACING 
* 
INT300	EQU	*
	LDR	A3,A2
	ADR	A2,A2
	ADR	A2,A3	INTERLACING FACTOR 3 
	ANK	A2,/1F 
	LD	A4,CYLNBR	GET CYLINDER NUMBER 
	ANK	A4,1 
	RF(Z)	INT310	EVEN CYLINDER NUMBER
	ADK	A2,8	SKEW FACTOR 180 DEG.
* 
INT310	EQU	*
	ANK	A2,/1F 
	SLL	A2,2	INTERLACED SECTOR NUMBER
	ST	A2,SECNBR	STORE PHYSICAL SECTOR NUMBER
	EJECT
* 
*	READ SECTOR 
* 
	LDR	A7,A9	BUFFER ADDRESS 
READ34	LDKL	A4,MXCCD3	NUMBER OF WORDS 
WERIO3	WER	A4,/10	WRITE NUMBER OF WORDS 
	WER	A7,/11	WRITE BUFFER ADDRESS
* 
READ30	CIO	A2,1,0	READ SECTOR 
	RB(NA)	READ30	LOOP UNTIL ACCEPTED
* 
READ31	SST	A2,0	GET STATUS
	RB(NA)	READ31	LOOP UNTIL ACCEPTED
	ANK	A2,/1F	STATUS
	RF(NZ)	DUERR	READING ERROR 
	LDR	A2,A9	BUFFER ADDRESS 
	LDR	A1,A1
	RF(N)	RETURN	,XXXX  ,      , 
	RF(P)	READ33	,      ,  XXXX, 
	ADKL	A2,256	SOURCE POINTER 
	LDK	A4,64	NUMBER OF WORDS TO MOVE
READ32	EQU	*	,    XX,XX    ,
	LDR*	A1,A2 
	STR	A1,A7
	ADK	A2,2 
	ADK	A7,2 
	SUK	A4,1 
	RB(NZ)	READ32	CONTINUE MOVING
	LD	A1,SAVMEM 
	RF(P)	RETURN 
	LD	A2,SECNBR	PHYSICAL SECTOR NUMBER
	ADK	A2,/C	NEW SECTOR TO READ 
	ANK	A2,/7C 
	SUK	A1,1 
	RB	READ34
	EJECT
READ33	EQU	*
	ADK	A2,128	SOURCE POINTER
	LDK	A4,128	NUMBER OF WORDS TO MOVE 
	RB	READ32
RETURN	ADKL	A11,1	INCREMENT SECTOR NUMBER 
	RTN	A14

DUERR	EQU	* 
	LDKL	A1,LMP2 
	CALL	ERROR 
	XIF
	IFT	MFDISC=1 
	EJECT
********************************************************
*                                                      *
*  MDINIT - INITIALIZE MINI FIXED DISC UNIT            *
*  =======================================             *
*                                                      *
*  REFERENCED IN: SYSLOD,GETFIL                        *
*                                                      *
*  ENTRY:  A1 = DEVICE ADDRESS                         *
*                                                      *
*  EXIT:                                               *
*                                                      *
*  WORK REGISTERS:                                     *
*                                                      *
*  SUBROUTINES: ERROR                                  *
*                                                      *
********************************************************
MDINIT	EQU	*
* 
*	INIT MINI FIXED DISC COMMANDS 
* 
MDI:00	EQU	*
	ORKL	A1,CIO	CONFIG. CIO A1,1,XX INSTR. 
	ST	A1,READM2 
	ORKL	A1,/800	FORM SST A1,XX INSTR. 
	ST	A1,READM3 
	XRKL	A1,/B00	FORM CIO A2,1,XX INSTR. 
	ST	A1,SEEKM1 
	ORKL	A1,/800	FORM SST A2,XX INSTR. 
	ST	A1,SEEKM2 
	EJECT
* 
	LDKL	A2,MRDSEC	GET SUBROUTINE ADDRESS
	ST	A2,READ 
	ST	A2,READS
	RTN	A14
	EJECT
******************************************************
*                                                    *
*  MRDSEC - READ ONE SECTOR FROM MINI FIXED DISC     *
*  =============================================     *
*                                                    *
*  REFERENCED IN: SYSLOD                             *
*                                                    *
*  ENTRY:  A9 = BUFFER ADDRESS                       *
*          A11 = SECTOR NUMBER                       *
*                                                    *
*  EXIT:                                             *
*                                                    *
*  WORK REGISTERS:                                   *
*                                                    *
*  SUBROUTINES:                                      *
*                                                    *
***************************************************** 
MRDSEC	EQU	*
	LDK	A1,0	PREPARE FOR DIVISION
	LDR	A2,A11	GET LOGICAL SECTOR NUMBER 
	DVK	104	DIVIDE BY 104
	SLL	A2,2 
	ORK	A2,3	SET BIT 14 AND 15 
* 
*	A1=SECTOR NUMBER ON CYLINDER
*	A2=CYLINDER NUMBER
* 
	ST	A1,SECNBR	STORE SECTOR NUMBER 
	CW	A2,CYLNBR 
	RF(E)	INTM10	SAME CYLINDER NUMBER
	ST	A2,CYLNBR	STORE CYLINDER NUMBER 
	EJECT
* 
*	SEEK CYLINDER 
* 
SEEKM1	CIO	A2,1,0	SEEK COMMAND
	RB(NA)	SEEKM1	LOOP UNTIL ACCEPTED
* 
SEEKM2	SST	A2,0	GET STATUS
	RB(NA)	SEEKM2	WAIT UNTIL ACCEPTED
* 
*	INTERLACING 
* 
INTM10	EQU	*
	CWK	A1,52
	RF(L)	INTM20	SECTOR 0-51 
	SUK	A1,52	SECTOR 52-103
INTM20	EQU	*
	LDR	A2,A1
	SLL	A2,2	A2:=4*SECTOR NUMBER 
	LDK	A1,0	PREPARE FOR DIVISION
	DVK	52 
	ADR	A1,A2	A1:=INTERLACED SECTOR NUMBER 
* 
*	A1:=INTERLACED SECTOR NUMBER
* 
	LD	A2,CYLNBR	GET CYLINDER NUMBER 
	SRC	A2,3 
	RF(NN)	INTM30	EVEN CYLINDER NUMBER 
	SUK	A1,26	SKEW FACTOR 26 
	RF(NN)	INTM30
	ADK	A1,52
INTM30	EQU	*
	SLL	A1,2 
	LD	A2,SECNBR	GET SECTOR NUMBER BEFORE INTERLACING
	CWK	A2,52
	RF(L)	INTM40	HEAD NUMBER 0 
	ORKL	A1,/4000	HEAD NUMBER 1
INTM40	EQU	*
* 
*	READ SECTOR 
* 
READM1	EQU	*
	LDKL	A4,MUXCC	NUMBER OF WORDS
	LDR	A7,A9	BUFFER ADDRESS 
* 
WERIOM	WER	A4,8	WRITE NUMBER OF WORDS 
	WER	A7,9	WRITE BUFFER ADDRESS
* 
READM2	CIO	A1,1,0	READ SECTOR 
	RB(NA)	READM2	LOOP UNTIL ACCEPTED
* 
READM3	SST	A1,0	GET STATUS
	RB(NA)	READM3	LOOP UNTIL ACCEPTED
	ANK	A1,/1F	STATUS
	RF(NZ)	MFDERR	READING ERROR
	ADKL	A11,1	INCREMENT SECTOR NUMBER 
	RTN	A14

MFDERR	EQU	*
	LDKL	A1,LMP2 
	CALL	ERROR 
	XIF
	IFT	FLDISC=1 
	EJECT
************************************************
*                                              *
*  FDINIT - INITIALIZE FLEXIBLE DISC           *
*  =================================           *
*                                              *
*  REFERENCED IN: SYSLOD,GETFIL                *
*                                              *
*  ENTRY:  A1 - DEVICE ADDRESS                 *
*                                              *
*  EXIT:                                       *
*                                              *
*  WORK REGISTERS:                             *
*                                              *
*  SUBROUTINES:                                *
*                                              *
************************************************
FDINIT	EQU	*
	ANK	A1,/10 
	ORKL	A1,CIO+9	CONFIG. CIO+9 A1,1,XX INSTR. 
	ST	A1,FRD:10 
	LDKL	A2,FRDS25	ADDRESS TO READ ON 0,25 MEG FLOPPY DRIVE
	LDK	A1,3	SEEK ORDER
	EX	FRD:10	SEEK TO ZERO 
FDI:05	EQU	*
	EX	SEKSST
	RB(NA)	FDI:05
* 
	ANK	A1,/10 
	RF(NZ)	FDI:10	0.25 MEG FLOPPY DRIVE
* 
	LDKL	A1,FRD:B1+/5700	RF FRD:40 INSTR.	=4 
	ST	A1,FRD:20	MODIFY INR INSTRUCTION
	LDKL	A1,/41F 
	ST	A1,FRD:42	MODIFY SST MASK 
	LDKL	A1,/C00 
	ST	A1,RELEAS	MODIFY RELEAS ORDER 
	LDKL	A2,FRDSEC	ADDRESS TO READ ON 1 MEG FLOPPY DRIVE 
FDI:10	EQU	*
	ST	A2,READ 
	ST	A2,READS
	CF	A14,GETVLB	GET VOLUME LABEL 
	LD	A1,FORDEV,A9	GET FORMAT 
	ST	A1,DEVTYP+STKEND
	RTN	A14
	EJECT
********************************************
*                                          *
*                                          *
*     UNLOCK - UNLOCK FLEXIBLE DISC        *
*     =============================        *
*                                          *
*     ON ENTRY: A1 = DEVICE ADDRESS        *
*                                          *
********************************************


UNLOCK	EQU	*
	CF	A14,FDINIT	INIT UNLOCK ORDER
RELEAS	EQU	*+2
	LDKL	A1,/C 
	EX	FRD:10	EXECUTE UNLOCK COMMAND 
	RB(NA)	*-4	LOOP UNTIL ACCEPTED 
* 
	EX	FRD:40	SENSE STATUS 
	RB(NA)	*-4	LOOP UNTIL ACCEPTED 
	RTN	A14
	EJECT
*********************************************************** 
*                                                         * 
*        FRDSEC - READ SECTOR FROM FLEXIBLE DISC          * 
*        =======================================          * 
*                                                         * 
*  REFERENCED IN:  SYSLOD                                 * 
*                                                         * 
*  ENTRY:  A9 - BUFFER ADDRESS                            * 
*         A11 - SECTOR NUMBER                             * 
*                                                         * 
*  EXIT:                                                  * 
*                                                         * 
*  WORK REGISTERS:  A1,A2,A3                              * 
*                                                         * 
*  SUBROUTINES:  ERROR                                    * 
*                                                         * 
*********************************************************** 
FRDSEC	EQU	*
	LDR	A2,A11	GET SECTOR NUMBER 
	LDKL	A4,/340	26 SHIFTED 10 STEPS LEFT
	LD	A1,DEVTYP+STKEND	DEVICE TYPE
	ANK	A1,1 
	RF(Z)	SNHEAD	0,25 MEG FLOPPY DISC
	CWK	A2,13
	RF(NL)	NOTCY0	NOT CYLINDER 0 
SNHEAD	EQU	*
	SLL	A2,1	A2=0-25,PHYSICAL SECTOR NBR 
	RF	DVK26 
NOTCY0	EQU	*
	ADK	A2,13
	EJECT
* 
*	A2=PHYSICAL SECTOR NUMBER 
* 
DVK26	EQU	* 
	LDK	A1,0 
DVK26A	EQU	*
	SLL	A1,5 
DVK26B	EQU	*
	SUR	A2,A4
	RF(N)	DVK26C 
	ADK	A1,1 
	RB	DVK26B
DVK26C	EQU	*
	ADR	A2,A4
	SRL	A4,5 
	RB(NZ)	DVK26A	NEXT FIVE BITS 
	EJECT
* 
*	A2=SECTOR NUMBER
*	A1=CYLINDER NUMBER
* 
	LD	A4,DEVTYP+STKEND	DEVICE TYPE
	ANK	A4,1 
	RF(NZ)	DBHEAD	1 MEG FLOPPY,DOUBLE HEAD 
	SLL	A1,1	ONLY ONE HEAD 
DBHEAD	EQU	*
	LDR	A4,A1
	ANK	A4,1 
	SRC	A4,2	HEAD NUMBER IN CORRECT POSITION 
	SLL	A2,2	SECTOR NUMBER IN CORRECT POSITION 
	ORR	A2,A4	A2=CIO READ REGISTER 
	SLL	A1,1	CYLINDER NUMBER IN CORRECT POSITION 
	ORK	A1,3	A1=CIO SEEK REGISTER
	CW	A1,CYLNBR	COMPARE OLD AN NEW CYLINDER NUMBER
	RF(E)	NOSEEK	NO SEEK NEEDED
	ST	A1,CYLNBR	SAVE CYLINDER NUMBER
FDSEEK	EX	FRD:10	CIO START
	RB(NA)	FDSEEK
SEKSST	SST	A1,FDCU
	RB(NA)	SEKSST
	ANKL	A1,/611 
	RF(NZ)	FRD:50	SEEK ERROR 
NOSEEK	EQU	*
	LDR	A1,A2
	RF	FRD:05
	EJECT
FRDS25	EQU	*
	LDR	A1,A11	SECTOR NO 
	SLL	A1,4 
	ORKL	A1,/4000	NUMBER OF SECTORS=2  (BIT 0 - BIT 1) 
FRD:05	EQU	*
	LDKL	A2,MUXCC
	LD	A3,MXBUF	BUFFER ADDRESS 
	WER	A2,FDIOP	1:ST WER
	WER	A3,FDIOP+1	SECOND WER

	LDR	A2,A3	BUFFER START ADDRESS 
	AD	A2,SAVCON	BUFFER END ADDRESS
* 
FRD:10	CIO	A1,1,FDCU	START READ 
	RB(NA)	FRD:10
* 
	EJECT			CRVOL
* 
* 
FRD:20	INR	A1,0,FDCU
	RF(NA)	FRD:40		=4
	STR	A1,A3
	ADK	A3,2 
	CWR	A3,A2
	RB(NE)	FRD:20
* 
FRD:25	CIO	A1,0,FDCU	STOP READ
	RB	FRD:20
FRD:40	SST	A1,FDCU
	RB(NA)	FRD:20
FRD:42	EQU	*+2
	ANKL	A1,/4E15	FATAL ERROR ?
	RF(NZ)	FRD:50	YES! 
FRD:43	CWR	A3,A2		=4
	RF(E)	FRD:44	PROGRAMMED CHANNEL	=4 
	LDKL	A1,FRD:B1+/5700	RF FRD:40 INSTR.	=4 
	ST	A1,FRD:20	UPDATE INR ISTR.	=4 
FRD:44	EQU	*		=4
	LDKL	A1,FRD:B2+/5700	RF FRD:45 INSTR.	=4 
	ST	A1,FRD:43	UPDATE CWR INSTR.	=4
	ABI	READ	READ AGAIN	=4 
FRD:45	EQU	*
	ADKL	A11,1	INCRMENT SECTOR ADDRESS 
	RF(NN)	FRD:48
	SUR	A11,A11	RESET LEAST SIGN. PART OF D.A. 
	ADKL	A12,1	INCREMENT MOST SIGN. PART OF D.A. 
	RF(O)	FRD:50	DISC ADDRESS ERROR
FRD:48	EQU	*
	RTN	A14
FRD:50	EQU	*
	LDKL	A1,LMP2 
	CALL	ERROR 
FRD:B1	EQU	FRD:40-FRD:20-2		=4
FRD:B2	EQU	FRD:45-FRD:43-2		=4
	XIF
	IFT	CDDISC=1 
	IFT	CDDI16=0		=9 
	EJECT
*********************************** 
*                                 * 
*  CDINIT - INITIALIZE DISC UNIT  * 
*  =============================  * 
*                                 * 
*  REFERENCED IN: SYSLOD,GETFIL   * 
*                                 * 
*  ENTRY: A1 - DEVICE ADDRESS     * 
*                                 * 
*  EXIT:                          * 
*                                 * 
*  WORK REGISTERS:  A1,A2          *
*                                 * 
*  SUBROUTINES:                   * 
*                                 * 
*********************************** 

CDINIT	EQU	*
* 
*	INIT 80M CDC DISC COMMANDS
* 
	ORKL	A1,CIO	CONFIG CIO A1,1,XX  INSTR. 
	ST	A1,READC1 
	ORKL	A1,/800	FORM SST A1,XX  INSTR.
	ST	A1,READC2 
	XRKL	A1,/B00	FORM CIO A2,1,XX  INSTR.
	ST	A1,SEEKC1 
	ORKL	A1,/800	FORM SST A2,XX  INSTR.
	ST	A1,SEEKC2 
	LDKL	A2,-1 
	ST	A2,PSECNL+STKEND	INIT VALUE FOR SECTOR NBR
	LDKL	A2,/300	BUFLEN 80M CDC DISC 
	ST	A2,SAVCON	SAVE LENGTH 
	LDKL	A2,CRDSEC	GET READ SECTOR SUBROUTINE ADDR.
	ST	A2,READ 
	ST	A2,READS
	RTN	A14
	EJECT
*********************************************** 
*                                             * 
*  CRDSEC- READ ONE SECTOR FROM DISC          * 
*  =================================          * 
*                                             * 
*  REFERENCED IN: SYSLOD                      * 
*                                             * 
*  ENTRY:  A9 = BUFFER ADDRESS                * 
*                                             * 
*         A11 - SECTOR NBR LEAST SIGNIFICANT  * 
*         A12 - SECTOR NBR MOST SIGNIFICANT   * 
*                                             * 
*  EXIT: A12,A11 = A12,A11 + 1                * 
*                                             * 
*   WORK REGISTERS:  A1,A2,A3,A6              * 
*                                             * 
*  SUBROUTINES:  ERROR                        * 
*                                             * 
*********************************************** 
* 
CRDSEC	EQU	*
* 
*	SET BUFFER ADDRESS
* 
	LDR	A1,A9	BUFFER ADDRESS 
	ADKL	A1,256
	ST	A1,CIOAD2	ADDRESS 2 
	ADKL	A1,256
	ST	A1,CIOAD3	ADDRESS 3 
	LDKL	A1,/3FFF
	ANS	A1,CIOTAB	RESET BITS 
	ANS	A1,CIOTOT	RESET BITS 
	LDR	A1,A12	SECTOR NUMBER MOST SIGNIFICANT
	LDR	A2,A11	SECTOR NUMBER LEAST SIGNIFICANT 
	EJECT
* 
*	DIVIDE LOGICAL WITH 3 
* 
	LDK	A3,0 
RED100	EQU	*
	ADK	A3,1 
	SUK	A1,3 
	RB(NN)	RED100
	ADK	A1,3 
	SUK	A3,1 
	DVK	3
	CW	A9,CIOAD1 
	RF(NE)	RED110	NOT SAME BUFFER ADDRESS MEANS NEW READ 
	CW	A2,PSECNL+STKEND
	RF(NE)	RED110	NOT SAME PHYSICAL SEC NBR
	CW	A3,PSECNM+STKEND
	RF(NE)	RED110	NOT SAME PHYSICAL SEC NBR
	CW	A1,PSECPA+STKEND
	RF(E)	TURN	SAME LOG SEC AS BEFORE
	RF(G)	REDMOV	MOVE UP NEXT LOGICAL SECTOR 
RED110	EQU	*
	ST	A9,CIOAD1	ADDRESS 1 
	MS	3,PSECPA+STKEND	SAVE NEW VALUES 
	LDR	A1,A3
	DVK	115
	EJECT
*	A1=HEAD NBR * SECTOR NBR
*	A2=CYLINDER NBR 
	LDR	A3,A2
	LDR	A2,A1
	LDK	A1,0 
	DVK	23 
*	A1=SECTOR NBR 
*	A2=HEAD NBR 
	ORKL	A2,/800	SET INTERRUPT BIT 
	ST	A2,CIOTAB	UPDATE CIO TABLE
	EJECT
* 
*	INTERLACING 
* 
	LDR	A2,A1
	MUK	5	INTERLACING 5
	SLC	A3,1 
	RF(NN)	INT100	EVEN CYLINDER NUMBER 
	ADK	A2,12	SKEW FACTOR
INT100	EQU	*
	DVK	23 
	SLL	A1,5	IN POSITION 
	ORS	A1,CIOTAB	UPDATE CIO TABLE 
	SRC	A3,1	RESTORE A3
	CW	A3,CYLNBR 
	RF(E)	READER	SAME CYLINDER NUMBER
	EJECT
* 
*	SEEK
* 
	ST	A3,CYLNBR	SAVE CYLINDER NBR 
	ADKL	A3,/A800	SEEK COMMAND 
	ST	A3,SEKTAB 
	LDKL	A2,SEKTAB 
SEEKC1	EQU	*
	CIO	A2,1,0	SEEK
	RB(NA)	SEEKC1
SEEKC2	EQU	*
	SST	A2,0 
	RB(NA)	SEEKC2
	EJECT
* 
*    READ 
* 
READER	EQU	*
	LDK	A6,3	NUMBER OF RETRIES 
REA100	EQU	*
	LDKL	A1,CIOTAB	POINTER TO CIO TABLE
READC1	CIO	A1,1,0	READ
	RB(NA)	READC1	LOOP UNTIL ACCEPTED
* 
READC2	SST	A1,0	STATUS
	RB(NA)	READC2	LOOP UNTIL ACCEPTED
	ANKL	A1,/FF0F	STATUS 
	RF(NZ)	RET30	READING ERROR 
	LD	A1,PSECPA+STKEND	GET RELATIV LOG SECT IN PHYSICAL	=11 
	RF(NZ)	REDMOV	NOT FIRST REL LOG SECTOR	=11 

TURN	EQU	*
	ADKL	A11,1	INCREMENT LOGICAL SECTOR NUMBER 
	RF(O)	TURN10	OVERFLOW
	RF	TURN20
TURN10	EQU	*
	SUR	A11,A11	RESET A11
	ADKL	A12,1 
TURN20	EQU	*
	RTN	A14
	EJECT
* 
*	MOVE UP NEXT LOGICAL SECTOR 
* 
REDMOV	EQU	*
	ST	A1,PSECPA+STKEND	SAVE NEW LOGICAL SECTOR PART 
	SLL	A1,2	INDEX TO TABLE
	LD	A1,CIOAD1,A1	SOURCE ADDRESS 
	LDR	A2,A9	DESTINATION ADDRESS
	LDK	A3,128	LENGTH IN WORDS 
RMOV10	EQU	*
	LDR*	A6,A1 
	STR	A6,A2
	ADK	A1,2 
	ADK	A2,2 
	SUK	A3,1 
	RB(P)	RMOV10	NEXT WORD 
	RB	TURN



NOFOND	EQU	*
	LDKL	A1,LMP2 
	CALL	ERROR	INDICATE READING ERROR
	EJECT
* 
*	IO ERROR IN READING 
* 
RET30	EQU	* 
	SUK	A6,1 
	RB(NZ)	REA100	NEW TRY
	LC	A1,CIOTAB 
	ANK	A1,/C0 
	RF(NZ)	RET31	LAST RETRY WITH EARLY OR LATE D.S 
	LDKL	A2,/8000
	ORS	A2,CIOTAB	PREPARE FOR EARLY DATA STROBE
	RB	READER
RET31	EQU	* 
	ANK	A1,/80 
	RF(Z)	RET32	LAST RETRY WITH LATE DATA STROBE 
	LDKL	A2,/C000
	XRS	A2,CIOTAB	CHANGE FROM EARLY TO LATE D.S
	RB	READER
RET32	EQU	* 
	LDKL	A2,/3FFF
	ANS	A2,CIOTAB	RESET LATE DATA STROBE 
	LC	A1,CIOTOT 
	ANK	A1,/C0 
	RF(NZ)	RET33	LAST RETRY CARRIAGE+ OR CARRIAGE- 
	LDKL	A2,/8000
	ORS	A2,CIOTOT	PREPARE FOR CARRIAGE+
	RB	READER
RET33	EQU	* 
	ANK	A1,/80 
	RB(Z)	NOFOND	READING ERROR 
	LDKL	A2,/C000
	XRS	A2,CIOTOT	FROM CARRIAGE+ TO CARRIGE- 
	RB	READER
	EJECT
* 
*	SEEK TABLE
* 
SEKTAB	EQU	*
	DATA	0 
* 
*	CIO TABLE 
* 
CIOTAB	EQU	*
	DATA	0	ORDER,SECTOR NBR,HEAD NBR 
CIOTOT	EQU	*
	DATA	384	TOTAL NUMBER OF WORDS(1 PHYSICAL SECTOR)
CIOPA1	EQU	*
	DATA	/4000+128	DATA CHAINING BIT,NUMBER OF WORDS 
CIOAD1	EQU	*
	DATA	0	ADDRESS 1 
CIOPA2	EQU	*
	DATA	/4000+128 
CIOAD2	EQU	*
	DATA	0	ADDRESS 2 
CIOPA3	EQU	*
	DATA	128 
CIOAD3	EQU	*
	DATA	0	ADDRESS 3 
	XIF
	IFT	CDDI16=1		=9 
	EJECT
*********************************** 
*                                 * 
*  CDINIT - INITIALIZE DISC UNIT  * 
*  =============================  * 
*                                 * 
*  REFERENCED IN: SYSLOD,GETFIL   * 
*                                 * 
*  ENTRY: A1 - DEVICE ADDRESS     * 
*                                 * 
*  EXIT:                          * 
*                                 * 
*  WORK REGISTERS:  A1,A2          *
*                                 * 
*  SUBROUTINES:                   * 
*                                 * 
*********************************** 

CDINIT	EQU	*
* 
*	INIT 16M OR 80M CDC DISC COMMANDS 
* 
	LDR	A2,A1		=9
	ANK	A1,/3F	MASK DEVICE ADDRESS	=9
	SRL	A2,2	FIX OR CARTRIDGE IN POSITION	=9 
	ANK	A2,/10		=9 
	ST	A2,CARFIX+STKEND	SAVE FIX OR CARTRIDGE INDICATOR	=9 
	ORKL	A1,CIO	CONFIG CIO A1,1,XX  INSTR. 
	ST	A1,READC1 
	ORKL	A1,/800	FORM SST A1,XX  INSTR.
	ST	A1,READC2 
	XRKL	A1,/B00	FORM CIO A2,1,XX  INSTR.
	ST	A1,SEEKC1 
	ORKL	A1,/800	FORM SST A2,XX  INSTR.
	ST	A1,SEEKC2 
	LDKL	A2,-1 
	ST	A2,PSECNL+STKEND	INIT VALUE FOR SECTOR NBR
	LDKL	A2,/300	BUFLEN 80M CDC DISC 
	ST	A2,SAVCON	SAVE LENGTH 
	LDKL	A2,CRDSEC	GET READ SECTOR SUBROUTINE ADDR.
	ST	A2,READ 
	ST	A2,READS
	CF	A14,GETVLB	GET VOLUME LABEL	=9
	LC	A2,FORDEV+1,A9	GET FORMAT	=9
	ANK	A2,1	FORMAT 4 OR 5	=9
	LDK	A2,23	CONSTANT FOR 16M DISC	=9 
	RF(NZ)	CDI:10	16M DISC	=9
	LDK	A2,115	CONSTANT FOR 80M DISC	=9
CDI:10	EQU	*		=9
	ST	A2,DIVCON	SET DIVIDE CONSTANT	=9
	RTN	A14
	EJECT
*********************************************** 
*                                             * 
*  CRDSEC- READ ONE SECTOR FROM DISC          * 
*  =================================          * 
*                                             * 
*  REFERENCED IN: SYSLOD                      * 
*                                             * 
*  ENTRY:  A9 = BUFFER ADDRESS                * 
*                                             * 
*         A11 - SECTOR NBR LEAST SIGNIFICANT  * 
*         A12 - SECTOR NBR MOST SIGNIFICANT   * 
*                                             * 
*  EXIT: A12,A11 = A12,A11 + 1                * 
*                                             * 
*   WORK REGISTERS:  A1,A2,A3,A6              * 
*                                             * 
*  SUBROUTINES:  ERROR                        * 
*                                             * 
*********************************************** 
* 
CRDSEC	EQU	*
* 
*	SET BUFFER ADDRESS
* 
	LDR	A1,A9	BUFFER ADDRESS 
	ADKL	A1,256
	ST	A1,CIOAD2	ADDRESS 2 
	ADKL	A1,256
	ST	A1,CIOAD3	ADDRESS 3 
	LDKL	A1,/3FFF
	ANS	A1,CIOTAB	RESET BITS 
	ANS	A1,CIOTOT	RESET BITS 
	LDR	A1,A12	SECTOR NUMBER MOST SIGNIFICANT
	LDR	A2,A11	SECTOR NUMBER LEAST SIGNIFICANT 
	EJECT
* 
*	DIVIDE LOGICAL WITH 3 
* 
	LDK	A3,0 
RED100	EQU	*
	ADK	A3,1 
	SUK	A1,3 
	RB(NN)	RED100
	ADK	A1,3 
	SUK	A3,1 
	DVK	3
	CW	A9,CIOAD1 
	RF(NE)	RED110	NOT SAME BUFFER ADDRESS MEANS NEW READ 
	CW	A2,PSECNL+STKEND
	RF(NE)	RED110	NOT SAME PHYSICAL SEC NBR
	CW	A3,PSECNM+STKEND
	RF(NE)	RED110	NOT SAME PHYSICAL SEC NBR
	CW	A1,PSECPA+STKEND
	RF(E)	TURN	SAME LOG SEC AS BEFORE
	RF(G)	REDMOV	MOVE UP NEXT LOGICAL SECTOR 
RED110	EQU	*
	ST	A9,CIOAD1	ADDRESS 1 
	MS	3,PSECPA+STKEND	SAVE NEW VALUES 
	LDR	A1,A3
DIVCON	EQU	*+2		=9
	DVK	23		=9 
	EJECT
*	A1=HEAD NBR * SECTOR NBR
*	A2=CYLINDER NBR 
	LDR	A3,A2
	LDR	A2,A1
	LDK	A1,0 
	DVK	23 
*	A1=SECTOR NBR 
*	A2=HEAD NBR 
	ORKL	A2,/800	SET INTERRUPT BIT 
	OR	A2,CARFIX+STKEND	FIX OR CARTRIDGE	=9
	ST	A2,CIOTAB	UPDATE CIO TABLE
	EJECT
* 
*	INTERLACING 
* 
	LDR	A2,A1
	MUK	5	INTERLACING 5
	SRC	A3,1		=9 
	RF(NN)	INT100	EVEN CYLINDER NUMBER 
	ADK	A2,12	SKEW FACTOR
INT100	EQU	*
	DVK	23 
	SLL	A1,5	IN POSITION 
	ORS	A1,CIOTAB	UPDATE CIO TABLE 
	SLC	A3,1	RESTORE A3	=9 
	CW	A3,CYLNBR 
	RF(E)	READER	SAME CYLINDER NUMBER
	EJECT
* 
*	SEEK
* 
	ST	A3,CYLNBR	SAVE CYLINDER NBR 
	ADKL	A3,/A800	SEEK COMMAND 
	ST	A3,SEKTAB 
	LDKL	A2,SEKTAB 
SEEKC1	EQU	*
	CIO	A2,1,0	SEEK
	RB(NA)	SEEKC1
SEEKC2	EQU	*
	SST	A2,0 
	RB(NA)	SEEKC2
	EJECT
* 
*    READ 
* 
READER	EQU	*
	LDK	A6,3	NUMBER OF RETRIES 
REA100	EQU	*
	LDKL	A1,CIOTAB	POINTER TO CIO TABLE
READC1	CIO	A1,1,0	READ
	RB(NA)	READC1	LOOP UNTIL ACCEPTED
* 
READC2	SST	A1,0	STATUS
	RB(NA)	READC2	LOOP UNTIL ACCEPTED
	ANKL	A1,/FF0F	STATUS 
	RF(NZ)	RET30	READING ERROR 
	LD	A1,PSECPA+STKEND	GET LOGICAL SECT. IN PHYSICAL	=11
	RF(NZ)	REDMOV	NOT FIRST LOGICAL SECT. IN PHYSICAL	=11

TURN	EQU	*
	ADKL	A11,1	INCREMENT LOGICAL SECTOR NUMBER 
	RF(O)	TURN10	OVERFLOW
	RF	TURN20
TURN10	EQU	*
	SUR	A11,A11	RESET A11
	ADKL	A12,1 
TURN20	EQU	*
	RTN	A14
	EJECT
* 
*	MOVE UP NEXT LOGICAL SECTOR 
* 
REDMOV	EQU	*
	ST	A1,PSECPA+STKEND	SAVE NEW LOGICAL SECTOR PART 
	SLL	A1,1		=9 
	LDR	A2,A1		=9
	ADR	A1,A1		=9
	ADR	A1,A2	A1 MULTIPIED WITH 6	=9 
	LD	A1,CIOAD1,A1	SOURCE ADDRESS 
	LDR	A2,A9	DESTINATION ADDRESS
	LDK	A3,128	LENGTH IN WORDS 
RMOV10	EQU	*
	LDR*	A6,A1 
	STR	A6,A2
	ADK	A1,2 
	ADK	A2,2 
	SUK	A3,1 
	RB(P)	RMOV10	NEXT WORD 
	RB	TURN



NOFOND	EQU	*
	LDKL	A1,LMP2 
	CALL	ERROR	INDICATE READING ERROR
	EJECT
* 
*	IO ERROR IN READING 
* 
RET30	EQU	* 
	SUK	A6,1 
	RB(NZ)	REA100	NEW TRY
	LC	A1,CIOTAB 
	ANK	A1,/C0 
	RF(NZ)	RET31	LAST RETRY WITH EARLY OR LATE D.S 
	LDKL	A2,/8000
	ORS	A2,CIOTAB	PREPARE FOR EARLY DATA STROBE
	RB	READER
RET31	EQU	* 
	ANK	A1,/80 
	RF(Z)	RET32	LAST RETRY WITH LATE DATA STROBE 
	LDKL	A2,/C000
	XRS	A2,CIOTAB	CHANGE FROM EARLY TO LATE D.S
	RB	READER
RET32	EQU	* 
	LDKL	A2,/3FFF
	ANS	A2,CIOTAB	RESET LATE DATA STROBE 
	LC	A1,CIOTOT 
	ANK	A1,/C0 
	RF(NZ)	RET33	LAST RETRY CARRIAGE+ OR CARRIAGE- 
	LDKL	A2,/8000
	ORS	A2,CIOTOT	PREPARE FOR CARRIAGE+
	RB	READER
RET33	EQU	* 
	ANK	A1,/80 
	RB(Z)	NOFOND	READING ERROR 
	LDKL	A2,/C000
	XRS	A2,CIOTOT	FROM CARRIAGE+ TO CARRIGE- 
	RB	READER
	EJECT
* 
*	SEEK TABLE
* 
SEKTAB	EQU	*
	DATA	0 
* 
*	CIO TABLE 
* 
CIOTAB	EQU	*
	DATA	0	ORDER,SECTOR NBR,HEAD NBR 
CIOTOT	EQU	*
	DATA	384	TOTAL NUMBER OF WORDS(1 PHYSICAL SECTOR)
CIOPA1	EQU	*
	DATA	/4000+128	DATA CHAINING BIT,NUMBER OF WORDS 
	DATA	0	ADDRESS1 MOST SIGN.	=9
CIOAD1	EQU	*
	DATA	0	ADDRESS 1 
CIOPA2	EQU	*
	DATA	/4000+128 
	DATA	0	ADDRESS 2 MOST SIGN.	=9 
CIOAD2	EQU	*
	DATA	0	ADDRESS 2 
CIOPA3	EQU	*
	DATA	128 
	DATA	0	ADDRESS 3 MOST SIGN.	=9 
CIOAD3	EQU	*
	DATA	0	ADDRESS 3 
	XIF
	EJECT
*************************************************** 
*                                                 * 
*        GETFIL - GET CONFIGURATION FILE          * 
*        ===============================          * 
*                                                 * 
*  REFERENCED IN:  SYSLOD                         * 
*                                                 * 
*  ENTRY:  A9 - BUFFER ADDRESS                    * 
*                                                 * 
*  EXIT:  A11 - SECTOR ADDRESS TO CONF. FILE      * 
*                                                 * 
*  WORK REGISTERS:  A1,A2,A3,A4,A5,A6,A7,A8,A10  *
*                                                 * 
*  SUBROUTINES:  READVL,READCF                    * 
*                                                 * 
*************************************************** 
GETFIL	EQU	*
	CF	A14,GETVLB
GET:10	EQU	*
	CF	A14,RDSEC	GET VOLUME LABEL
	LDK	A7,QBLFAC	VTOC BLOCKING FACTOR 
	LDR	A6,A9	GET START OF BUFFER
GET:20	EQU	*
	LDK	A5,/20	LOAD SPACE
	CCR	A5,A6	UNUSED FILE? 
	RF(E)	GET:50	YES!
	LDR	A4,A6	START OF RECORD
	LDK	A5,'S'	STANDARD FILE CHARACTER 
	CC	A5,27,A6	STANDARD FILE? 
	RF(NE)	GET:50	NO!
	LDK	A5,'$'	LEADING CHAR IN CONF. FILE
	CCR	A5,A4	CONFIGURATION FILE?
	RF(NE)	GET:50	NO!
GET:25	LDK	A3,'C'	THIS INSTRUCTION IS MODIFIED
	CCK	A3,'CC'	LOOKING FOR CONF. FILE?
	RF(NE)	GET:85	NO!
	ADK	A4,5	SIXTH CHARACTER 
	LDK	A5,':'	CHARACTER TO PRECEED NUMBER 
GET:30	CCR	A5,A4	CONFIGURATION FILE?
	RF(E)	GET:40	YES!
	SUK	A4,1	TRY NEXT CHARACTER
	CWR	A4,A6	FIRST IN NAME? 
	RF(E)	GET:50	YES!
	RB	GET:30
GET:40	EQU	*
* 
*  CHECK APPLICATION NUMBER 
* 
	LC	A5,1,A4	GET LEFT DIGIT
	SLL	A5,8	SHIFT TO LEFT BYTE
	LC	A5,2,A4	GET RIGHT DIGIT 
	CALL	CONVRT	CONVERT TO BINARY
	CW	A1,SCTANO	SAME AS APPLICATION NUMBER
	RF(NE)	GET:50
* 
*  CONFIGURATION FILE FOUND 
* 
	LD	A1,22,A6	LAST RECORD NUMBER 
	ST	A1,LSTREC+STKEND	SAVE 
	LD	A12,16,A6	GET 
	LD	A11,18,A6	SECTOR ADDRESS
	RTN	A14
* 
GET:50	EQU	*
	ADR	A6,A8	NEXT VTOC RECORD 
	ADK	A6,1	BYPASS STATUS CHARACTER 
	SUK	A7,1	MOORE RECORDS IN THIS SECTOR? 
	RB(P)	GET:20	YES!
	CWR	A11,A10	LAST VTOC SECTOR?
	RB(NE)	GET:10	NO!
GET:60	LDK	A3,'C'	THIS INSTRUCTION IS MODIFIED
	CCK	A3,'CC'	LOOKING FOR CONF. FILE?
	RF(NE)	GET:99	NO!
* 
*  CONFIGURATION FILE NOT FOUND - READ SOP AND SELECT 
*  LOAD MEDIUM FOR CONFIGURATION FILE 
* 
* 
	LDKL	A2,/7F8 
	OTR	A2,0,SOP	SWITCH ON SOP LAMPS 
GET:70	EQU	*
	CF	A14,SOPIN 
	ANKL	A1,/7FC	ALLOWED SWITCH? 
	RB(Z)	GET:70	NO! 
	LDKL	A2,LMP1 
	OTR	A2,0,SOP	SWITCH ON LOAD LAMP 
	SRN	A1,A2
	LC	A1,DEVTAB,A2	GET DEVICE ADDRESS 
GET:75	EQU	*
	SC	A1,CONDEV+1+STKEND	SAVE CONF. DATA LOAD DEVICE
	CF	A14,CONFLD	CONFIGURE LOAD DEVICE
	RB	GETFIL
GET:85	EQU	*
	CCK	A3,'SS'	LOOKING FOR $SWAPP?
	RF(NE)	GET:99	NO!
	LDK	A5,0	RESET CHARACTER COUNTER 
GET:90	LCR	A1,A4	GET CHAR IN FILENAME 
	CC	A1,SWPTAB,A5	CHECK IF PRESCIBED CHAR. 
	RB(NE)	GET:50	NO!
	ADK	A4,1	NEXT CHARACTER
	ADK	A5,1	INCREMENT CHARACTER COUNTER 
	CWK	A5,8	ALL CHARACTERS CHECKED? 
	RB(NE)	GET:90	NO!
* 
*  SWAPPABLE WORK BLOCK FILE FOUND - SAVE DISC ADDRESS
*  TO FILE AND TO NEXT SECTOR AFTER FILE
* 
	LD	A1,18,A6	GET BIT 16-31 OF D.A.
	LD	A2,16,A6	GET BIT 0-15 OF D.A. 
	ST	A1,SWBFSA+STKCOM	SAVE 
	ST	A2,SWBFSA+STKCOM+2	SAVE 
	LD	A3,SWPFEL,A6	GET BIT 16-31 OF LENGTH
	LD	A4,SWPFEL-2,A6	GET BIT 0-15 OF LENGTH 
	ADR	A4,A2	ADD MOST SIGNIFICANT PART
	ADR	A3,A1	ADD LEAST SIGNIFICANT PART 
	RF(O)	GET:92	OVERFLOW - ADD CARRY
	RF	GET:98
GET:92	ADK	A4,1	ADD CARRY 
	ANKL	A3,/7FFF	RESET OVERFLOW 
GET:98	ST	A3,SWBFSE+STKCOM	SAVE BIT 16-31 OF D.A. 
	ST	A4,SWBFSE+STKCOM+2	SAVE BIT 0-15 OF D.A.
	IM	SWBFLG+STKCOM	INDICATE SWB-FILE FOUND 
GET:99	RTN	A14
	EJECT
***************************************************** 
*                                                   * 
*  LODCOM - LOAD CORE RESIDENT PART OF APPLICATION  * 
*  ===============================================  * 
*                                                   * 
*  LODSEG - LOAD ONE SEGMENT                        * 
*  =========================                        * 
*                                                   * 
*  ENTRY:  A8 - RELOCATION BASE                     * 
*         A10 - EFFECTIVE LENGTH                    * 
*                                                   * 
*  EXIT:                                            * 
*                                                   * 
*  WORK REGISTERS:  A1,A2,A3,A4,A7                  * 
*                                                   * 
*  SUBROUTINES:  MOVE,READ                          * 
*                                                   * 
***************************************************** 
LODCOM	EQU	*
	LD	A9,MXBUF	GET ADDRESS TO READ BUFFER 
	LDR	A3,A9	GET START OF BUFFER
	LDR	A2,A3	SAVE 
	LDKL	A7,240	NUMBER OF CODE WORDS 
LOD:10	EQU	*-2
	LDR	A10,A10	APP >32 KB?
	RF(NN)	LOD:20	NO!
	SUR	A10,A7	DEC. LENGTH 
	RF	LOD:50
LOD:20	EQU	*
	SUR	A10,A7	CHECK IF IN END OF OF SEGMENT 
	RF(P)	LOD:50	NO YET! 
	CWK	A7,256	128 WORDS/SECTOR? 
	RF(NE)	LOD:30	NO!
	ADR	A7,A10	COMPUTE NUMBER OF CODE WORDS
	LDKL	A10,0	INDICATE END OF SEGMENT 
	RF	LOD:52
LOD:30	EQU	*
	ADR	A7,A10	JUST MOVE SIGNIFICANT CHARACTERS! 
	LDKL	A10,0	INDICATE END OF SEGMENT 
	LD	A1,FSTSEC+STKEND	LOOK IF FIRST SECTOR/BLOCK 
	RF(NZ)	LOD:50	NO!
* 
	ADK	A7,8	YES, ADD 8 TO COMPENSATE FOR HEADER 
	CWK	A7,240	LOOK IF OUTSIDE CODE PART OF SECTOR/BLOCK 
	RF(L)	LOD:50	NO! 
* 
	SUK	A7,240	YES, GET WORDS REMAINING
	LDR	A10,A7	AND SAVE
	LDK	A7,240	START OF RELOCATION BITS
LOD:50	EQU	*
	CWK	A7,256	128 WORDS/SECTOR? 
	RF(E)	LOD:52	YES!
	ADR	A2,A7	START OF RELOCATION BITS 
	CF	A14,REBUF	RELOCATE
LOD:52	EQU	*
	LDR	A1,A9	START OF CODE PART 
	LD	A4,FSTSEC+STKEND	FIRST SECTOR/BLOCK?
	RF(NZ)	LOD:55	NO!
	IM	FSTSEC+STKEND	INDICATE NOT FIRST SECTOR/BLOCK 
	ADK	A1,8	SKIP 4 WORDS IN FIRST SECTOR/BLOCK
	SUK	A7,8	DECREMENT NUMBER OF CHAR. TO MOVE 
	LD	A3,COMLG,A9	GET LENGTH
	RF(N)	LOD:54	APPL. LARGER THAN ONE SECTOR/BLOCK
* 
	CWK	A3,240	SINGLE SECTOR/BLOCK APPLICATION?
	RF(NG)	LOD:55	YES! 
* 
LOD:54	ADKL	A10,8 
LOD:55	EQU	*
	LDR	A3,A7	NUMBER OF CHARACTERS TO MOVE 
	LD	A2,LLDADR+STKEND	GET TO-ADDRESS 
	ADS	A3,LLDADR+STKEND	UPDATE MEMORY ADDRESS 
	IFT	MMUPAG=1 
	MVSU	A3	MOVE TABLE FROM SYSTEM 
	XIF
	IFT	MMUPAG=0 
	CALL	MOVE
	XIF
	LDR	A10,A10	END OF SEGMENT?
	RF(NZ)	LOD:70
	RTN	A14	EXIT 
LODSEG	EQU	*
	LDKL	A1,256	NUMBER OF WORDS/SECTOR 
	ST	A1,LOD:10	MODIFY INSTRUCTION
LOD:70	EQU	*
	CF	A14,READ
READ	EQU	*-2
	RB	LODCOM
	EJECT
************************************************* 
*                                               * 
*        REBUF - RELOCATE BUFFER ROUTINE        * 
*        ===============================        * 
*                                               * 
*  REFERENCED IN:  LODCOM/LODSEG                * 
*                                               * 
*  ENTRY:  A3 - START OF BUFFER                 * 
*          A2 - START OF RELOCATION TABLE       * 
*                                               * 
*  EXIT:                                        * 
*                                               * 
*  WORK REGISTERS:  A1,A4,A5,A6                 * 
*                                               * 
*  SUBROUTINES:                                 * 
*                                               * 
************************************************* 
REBUF	EQU	* 
	LDR	A4,A2	GET START OPF RELOCATION TABLE 
	SUK	A4,2 
REB:10	EQU	*
	ADK	A4,2	NEXT RELOCATION WORD
	LDK	A6,16	NUMBER OF RELOCATION BITS
	LDR*	A1,A4	GET RELOCATION WORD 
REB:20	EQU	*
	RF(NN)	REB:30	DON'T RELOCATE THIS WORD!
	LDR*	A5,A3	GET CODE WORD 
	ADR	A5,A8	RELOCATE 
	STR	A5,A3	STORE IT BACK
REB:30	EQU	*
	ADK	A3,2	NEXT CODE WORD
	CWR	A3,A2	END OF CODE WORD PART? 
	RF(E)	EXREL	YES! 
	SUK	A6,1	MOORE RELOCATION BITS?
	RB(Z)	REB:10	NO! 
	SLL	A1,1	NEXT RELOCATION BIT 
	RB	REB:20
EXREL	EQU	* 
	RTN	A14
	EJECT
***************************************** 
*  GETCON - GET CONTENT IN MEMORY WORD  * 
***************************************** 
* 
*  REFERENCED IN:  SEGGEN 
* 
*  ENTRY:  A2 - MEMORY ADDRESS
*          MMUOPT - MMU OPTION SWITCH (X) 
* 
*  EXIT:  A1 - CONTENT OF MEMORY ADDRESS
* 
*  WORK REGISTER: 
* 
*  SUBROUTINES: 
* 
GETCON	EQU	*
	LD	A1,SCTOPT	GET OPTION WORD 
	ANK	A1,1	MMU OPTION
	RF(Z)	GCON10	NO MMU
	ELR	A1,A2
	RF	GCON20
GCON10	EQU	*
	LDR*	A1,A2 
GCON20	EQU	*
	RTN	A14	RETURN 
	EJECT
********************************************* 
*                                           * 
*               SCNCON                      * 
*               ======                      * 
*                                           * 
*  SCAN CONFIGURATION FILE FOR POSSIBLE     * 
*  APPLICATION DEFINITION BLOCKS. IF        * 
*  FOUND APLTAB+STKCOM IS UPDATED WITH DISC        *
*  ADDRESSES.                               * 
*                                           * 
*  ENTRY: A9 INPUT BUFFER ADDRESS           * 
*                                           * 
*  WORK REGISTERS  A1-A8,A10                * 
*                                           * 
*  ROUTINES REFERENCED: GETFIL, APLID       * 
*                                           * 
*  REFERENCED IN SYSLOD                     * 
*                                           * 
********************************************* 
* 
* 
SCNCON	EQU	*
	CF	A14,GETFIL	GET CONFIGURATION FILE 
	ST	A11,CONDAD+STKEND	SAVE CONF. DISC FILE ADDRESS
	ST	A12,CONDAD+2+STKEND	MOST SIGN. PART 
	LDR	A8,A9	GET START OF BUFFER
	ADKL	A8,BUFLEN-6	ADD SECTOR LENGTH USED
	ST	A8,ECNFBF+STKEND	AND SAVE BUFFER END
* 
	LDKL	A10,0	RESET RECORD COUNTER
	LD	A6,APLTAB+STKCOM	GET APLTAB+STKCOM ADDRESS
	ADK	A6,ACBLEN+2	SKIP 1ST TABLE BLOCK 
	CF	A14,RDSEC	READ FIRST SECTOR 
	LDR	A4,A9	GET START OF RECORD
	LDR	A8,A9	SAVE RECORD START
* 
SCAN00	EQU	*
	LDR*	A1,A4	GET FIRST WORD IN RECORD
	CWK	A1,'A;'	APPLICATION DEFINITION BLOCK?
	RF(NE)	SCAN10	NO!
* 
	CF	A14,APLID	YES GET APPLICATION NAME
SCAN10	EQU	*
	ADKL	A10,1	INCREMENT RECORD COUNTER
	CW	A10,LSTREC+STKEND	LAST RECORD?
	RF(E)	SCNEND	YES!
* 
	ADKL	A8,RECLEN+1	INCREMENT RECORD POINTER
	CW	A8,ECNFBF+STKEND	OUTSIDE SECTOR?
	RF(NE)	SCAN20	NO!
* 
	CF	A14,RDSEC	READ NEXT SECTOR
	LDR	A8,A9	RESET RECORD ADDRESS 
SCAN20	EQU	*
	LDR	A4,A8	GET RECORD START 
	RB	SCAN00	CONTINUE SCAN PROCESS
* 
*  THE WHOLE CONFIGURATION FILE 
*  IS PROCESSED. SEARCH VTOC FOR
*  GIVEN FILE NAMES AND UPDATE
*  APLTAB+STKCOM WITH CORRESPONDING 
*  DISC ADDRESSES.
* 
SCNEND	EQU	*
	LD	A1,IPLDEV+STKEND	CONFIGURE PGM LOAD DEV.
	CF	A14,LODDEV
	LD	A6,APLTAB+STKCOM	GET APLTAB+STKCOM START ADDRESS
	ADK	A6,ACBLEN+2	SKIP 1ST TABLE BLOCK 
	LD*	A1,APLTAB+STKCOM	GET NO OF APPLICATIONS
	SUK	A1,1	DECREMENT 
	RF(Z)	RTRN	ONLY ONE APPLICATION
	NGR	A1,A1	NEGATE 
	ST	A1,APLCNT+STKEND	AND SAVE AS APPL. COUNTER
	CF	A14,GETAPL	UPDATE APPLIC. DISC ADDR.
* 
RTRN	EQU	*
	RTN	A14	END OF SCNCON
	EJECT
********************************************* 
*                                           * 
*                                           * 
*                 APLID                     * 
*                 =====                     * 
*                                           * 
*  APLID TAKES THE NAME OF APPLICATION      * 
*  AND MOVES IT FROM CONF. FILE TO          * 
*  APLTAB+STKCOM. FOR EACH APPLICATION A ENTRY     *
*  IN APLTAB+STKCOM IS CREATED ACCORDINGLY:        *
*                                           * 
*       LENGTH OF NAME (BYTES)              * 
*       NAME                                * 
*                                           * 
*  THE NAME ENTRY CONSISTS OF 1-4 WORDS     * 
*                                           * 
*  ENTRY: A6 POINTER INTO APLTAB+STKCOM            *
*         A8 RECORD POINTER                 * 
*         A10 RECORD COUNTER                * 
*                                           * 
*  WORK REGISTERS: A1-A5                    * 
*                                           * 
********************************************* 
* 
* 
APLID	EQU	* 
	ADKL	A10,1	INCREMENT RECORD COUNTER
	CW	A10,LSTREC+STKEND	LAST RECORD 
	ABL(E)	CONERR	YES! ERROR IN CONFIGURATION FILE 
* 
	ADKL	A8,RECLEN+1	INCREMENT RECORD POINTER
	CW	A8,ECNFBF+STKEND	OUTSIDE SECTOR?
	RF(NE)	APLID0	NO!
* 
	CF	A14,RDSEC	READ NEXT SECTOR
	LDR	A8,A9	GET RECORD START 
APLID0	EQU	*
	LDR	A4,A8	RECORD START 
	LDK	A5,0	RESET CHARACTER COUNTER 
APLID2	EQU	*
	LCR	A1,A4	GET CHARACTER
	CCK	A1,';;'	DELIMITER CHARACTER? 
	RF(E)	APLID4	YES! END OF NAME
* 
	ADK	A4,1	INCREMENT CHARACTER POINTER 
	ADK	A5,1	INCREMENT CHARACTER COUNT 
	CWK	A5,NCHAID	END OF THIS RECORD?
	RB(NE)	APLID2	NO GET NEXT CHARACTER
* 
*  END OF NAME RECORD, LOOK IF
*  NEXT CHARACTER IS A DELIMITER
* 
	LCR	A1,A4
	CCK	A1,';;'
	ABL(NE)	CONERR	NO DELIMITER, ERROR IN CONF. FILE 
* 
APLID4	EQU	*
	ADK	A5,0 
	ABL(Z)	CONERR	NO LEGAL CHARACTER IN NAME 
* 
	LDR	A3,A6	SAVE BLOCK START 
	STR	A5,A3	SAVE NAME LENGTH IN APLTAB+STKCOM
	IM*	APLTAB+STKCOM	INCREMENT NO OF APPLIC.
	LDR	A4,A8	GET START OF NAME RECORD 
	ADK	A5,1	INCREMENT CHARACTER COUNT 
	SRA	A5,1	AND MAKE WORD COUNT 
* 
APLID6	EQU	*
	ADK	A3,2	ADVANCE TABLE POINTER 
	LDR*	A1,A4	MOVE 2 CHARACTERS OF NAME 
	STR	A1,A3	TO APLTAB+STKCOM 
	ADK	A4,2	ADVANCE CHARACTER POINTER 
	SUK	A5,1	DECREMENT WORD COUNT
	RB(P)	APLID6	MORE CHARACTERS TO MOVE 
* 
	ADK	A6,ACBLEN	PREPARE FOR NEXT TABLE ENTRY 
	RTN	A14	NO, RETURN 
	EJECT
********************************************* 
*                                           * 
*                                           * 
*              GETAPL                       * 
*              ======                       * 
*                                           * 
*  SCANS VTOC FOR FILE NAMES LISTED IN      * 
*  APLTAB+STKCOM. APLTAB+STKCOM IS UPDATED WITH CORRE-    * 
*  SPONDING DISC ADDRESSE AND THE LENGTH    * 
*  OF APLTAB+STKCOM IS THEN USED TO CALCULATE      *
*  START OF FREE AREA.                      * 
*                                           * 
*  ENTRY: A6 - 1ST ENTRY IN APLTAB+STKCOM          *
*         APLCNT+STKEND - NO OF ENTRIES IN APLTAB+STKCOM  * 
*                                           * 
********************************************* 
* 
* 
GETAPL	EQU	*
	CF	A14,GETVLB	READ VOLUME LABEL
GETAP0	EQU	*
	CF	A14,RDSEC	READ SECTOR 
	LDK	A7,QBLFAC	VTOC BLOCKING FACTOR 
	LDR	A4,A9	GET START OF RECORD
GETAP2	EQU	*
	LDR*	A5,A6	GET LENGTH OF APPL. NAME
	LDR	A3,A4	SAVE RECORD START
	LDR	A1,A6	AND TABLE POINTER
	ADK	A1,2	SKIP NO OF CHAR. ENTRY
	LCR	A2,A4	GET 1ST CHARACTER IN FILE NAME 
	CCK	A2,/2020	UNUSED? 
	RF(E)	GETAP4	YES!
* 
	CF	A14,CMPSYM	COMPARE SYMBOLS
	ADK	A5,0 
	RF(Z)	FOUND	EQUAL
* 
*  NO MATCH, TRY NEXT VTOC ENTRY
* 
GETAP4	EQU	*
	ADR	A4,A8	GET NEXT RECORD
	ADK	A4,1	BYPASS STATUS CHARACTER 
	SUK	A7,1	MORE RECORDS IN THIS SECTOR 
	RB(P)	GETAP2	YES!
* 
	CWR	A11,A10	LAST VTOC SECTOR?
	ABL(E)	CONERR	ERROR IN CONF. FILE
* 
	RB	GETAP0
* 
FOUND	EQU	* 
	LDK	A2,'L'	LOAD FILE CHARACTER 
	CC	A2,27,A4	LOAD FILE? 
	ABL(NE)	CONERR	NO ERROR IN CONF. FILE
* 
	LD	A2,16,A4	GET DISC ADDRESS (BITS 0-15) 
	ST	A2,APLADA,A6	SAVE IN APLTAB+STKCOM
	LD	A2,18,A4	GET DISC ADDRESS (BITS 16-31)
	ST	A2,APLADA+2,A6	AND SAVE IN APLTAB+STKCOM
	ADK	A6,ACBLEN	ADVANCE TO NEXT TABLE BLOCK
* 
	IM	APLCNT+STKEND	INCREMENT APPLICATION COUNT 
	RB(NZ)	GETAPL	MORE TO DO!
* 
	RTN	A14	END OF GETAPL
	EJECT
********************************************* 
*                                           * 
*                                           * 
*            CMPSYM                         * 
*            ======                         * 
*                                           * 
*  COMPARE TWO SYMBOLS WITH EACH OTHER      * 
*                                           * 
*  ENTRY: A3 - START OF SYMBOL 1            * 
*         A1 - START OF SYMBOL 2            * 
*         A5 - LENGTH OF SYMBOL 2           * 
*                                           * 
*  EXIT:  A5 = 0 IF SYMBOLS EQUAL           * 
*                                           * 
********************************************* 
* 
* 
CMPSYM	EQU	*
	LCR	A2,A3	GET CHARACTER IN SYMBOL 1
	CCR	A2,A1	COMPARE WITH CHARACTER IN SYMBOL 2 
	RF(NE)	CMPEND	IF NOT EQUAL, RETURN 
* 
	ADK	A3,1	ADVANCE CHARACTER POINTERS
	ADK	A1,1 
	SUK	A5,1	DECREMENT CHARACTER COUNT 
	RB(NZ)	CMPSYM	CONTINUE THE COMPARISION 
* 
	LDR*	A2,A6	RESTORE NAME LENGTH 
	CWK	A2,8	LOOK IF MAX. LENGTH 
	RF(E)	CMPEND	YES! FINISHED 
* 
	LCR	A2,A3	GET NEXT CHARACTER IN FILE NAME
	CCK	A2,/2020	END OF FILE NAME? 
	RF(E)	CMPEND	YES!
* 
	LDK	A5,1	NO, NOT EQUAL!
CMPEND	EQU	*
	RTN	A14	END OF CMPSYM
	EJECT
********************************************* 
*                                           * 
*                                           * 
*               GETVLB                      * 
*               ======                      * 
*                                           * 
*  READ SECTOR CONTAINIG VOLUME LABEL       * 
*                                           * 
*  EXIT: A10 - LAST VTOC SECTOR             * 
*        A11 - FIRST VTOC SECTOR            * 
*        A8  - VTOC RECORD LENGTH           * 
*                                           * 
********************************************* 
* 
* 
GETVLB	EQU	*
	SUR	A11,A11	VOLUME LABEL 
	SUR	A12,A12
	CF	A14,RDSEC	GET VOLUME LABEL
	LD	A10,10,A9	GET VTOC BASE 
	LDR	A11,A10	SAVE 
	AD	A10,6,A9	LAST VTOC SECTOR 
	LD	A8,12,A9	GET VTOC RECORD LENGTH 
	AD	A11,46,A9	FIRST FILE SECTOR IN VTOC	=7
	RTN	A14	END OF GETVLB
* 
	EJECT
********************************************* 
*                                           * 
*                                           * 
*                  RDSEC                    * 
*                  =====                    * 
*                                           * 
*  READS A SECTOR FROM INPUT DISC.          * 
*                                           * 
*  ENTRY: A9 - BUFFER ADDRESS               * 
*         A11- SECTOR ADDRESS               * 
*         A12- SECTOR ADDRESS               * 
*                                           * 
********************************************* 
* 
* 
RDSEC	EQU	* 
	CF	A14,READS	MODIFIED ADDRESS
READS	EQU	*-2 
	RTN	A14
	EJECT
* 
*  DATA AREA DEFINITION 
* 
SYSBAS	EQU	*
SAVCON	DATA	BUFLEN
MXBUF	DATA	0	DISC/FLEXIBLE DISC BUFFER ADDRESS
SAVMEM	DATA	0	SAVE AREA 
CYLNBR	DATA	/FFFF	CYLINDER NUMBER 
SECNBR	DATA	0	PHYSICAL SECTOR NUMBER
	IFT	CDDISC=1		=9 
	IFT	CDDI16=0		=9 
DEVTAB	DATA	0,/1909,/3717,/2808,/1404 
	XIF			=9 
	IFF	CDDISC-CDDI16=1		=9
DEVTAB	DATA	0,/1909,/3717,/2808,/5717	=9
	XIF			=9 
SWPTAB	DATA	'$S','WA','P ','  ' 
FCTAB	EQU	*	=5
	DATA	/F1F3,/F0F2		=5 
* 
	END	SYSLOD