Google
 

Trailing-Edge - PDP-10 Archives - BB-Y390U-BM - t20src/setspd.mac
There are 33 other files named setspd.mac in the archive. Click here to see a list.
; *** Edit 63 to SETSPD.MAC by RASPUZZI on 11-Jun-86, for SPR #20381
; Rework edit 62 so that the monitor's entry vector is different at system
; startup.
;Edit 61 to SETSPD.MAC by DUSSEAULT on Tue 30-Apr-85, for SPR #19422
;		Added range checking on the PRINTER command.  Additional
;;		error messages will be printed out if an invalid unit 
;;		number is specified.
;Edit 34 by LOMARTIRE on Tue 3-May-83, for SPR #18779
;		Reinstall patch to SPR 20-13859.  Allow SETSPD to timeout 
;;		if a command takes more than 30 seconds and continue.
; UPD ID= 47, FARK:<4-1-WORKING-SOURCES.UTILITIES>SETSPD.MAC.6,   4-Oct-82 16:08:00 by DONAHUE
;Edit 33 - Echo command line if we get an error
; UPD ID= 73, FARK:<4-1-WORKING-SOURCES.UTILITIES>SETSPD.MAC.6,   4-Oct-82 13:35:12 by DONAHUE
;Edit 32 - Set up TU45 as default tape type
; UPD ID= 72, FARK:<4-1-WORKING-SOURCES.UTILITIES>SETSPD.MAC.5,  23-Sep-82 16:10:10 by MOSER
;EDIT 31 - CORRECTLY SETUP SBK FOR OUTPUT SPEED
; UPD ID= 71, FARK:<4-1-WORKING-SOURCES.UTILITIES>SETSPD.MAC.4,  26-Jul-82 13:32:26 by MOSER
;EDIT 29 - TRACKING EDIT FOR VERSION 4.
; UPD ID= 63, FARK:<4-1-WORKING-SOURCES.UTILITIES>SETSPD.MAC.3,   3-May-82 16:40:59 by ZIMA
;Edit 28 - set version number to 4.1
; UPD ID= 70, SNARK:<5.UTILITIES>SETSPD.MAC.11,  17-Jan-82 19:12:15 by PAETZOLD
;TCO 5.1681 - fix the change command
; UPD ID= 26, SNARK:<5.UTILITIES>SETSPD.MAC.10,  31-Aug-81 09:33:07 by PAETZOLD
;TCO 5.1461 - read and interpret MMAP when getting queued SYSERR blocks
; UPD ID= 18, SNARK:<5.UTILITIES>SETSPD.MAC.9,   3-Aug-81 12:51:24 by ZIMA
;TCO 5.1438 - Include Friday in "ALL" entry in day-of-week table.
; UPD ID= 8, SNARK:<5.UTILITIES>SETSPD.MAC.8,  20-Jul-81 15:54:57 by MOSER
;TCO 5.1424 CHANGE BACKGROUND COMMAND TO BATCH-BACKGROUND.
; UPD ID= 2311, SNARK:<5.UTILITIES>SETSPD.MAC.7,   8-Jul-81 15:23:12 by DONAHUE
;TCO 5.1401 - Add TU77 entry to SLAVT table
; UPD ID= 2100, SNARK:<5.UTILITIES>SETSPD.MAC.6,  28-May-81 11:55:31 by PAETZOLD
;TCO 5.1352 - Change error handler to not complain about invalid
;keywords when started at start4.  This will prevent J0NRUN BUGHLT's
; UPD ID= 2070, SNARK:<5.UTILITIES>SETSPD.MAC.5,  24-May-81 15:35:52 by ZIMA
;TCO 5.1346 - EDIT 21 - pass proper MO%LCP setting on all subsequent LPINI
; calls for a unit.
; UPD ID= 1769, SNARK:<5.UTILITIES>SETSPD.MAC.4,  25-Mar-81 17:49:49 by GRANT
;Update Copyright
; UPD ID= 1367, SNARK:<5.UTILITIES>SETSPD.MAC.3,  18-Dec-80 10:25:34 by WACHS
;TCO 5.16 - ADD TM78 DEFINITION
; UPD ID= 524, SNARK:<5.UTILITIES>SETSPD.MAC.2,  15-May-80 13:33:16 by LYONS
;tco 5.1040 - Make release 5 look for 5-CONFIG.CMD
; UPD ID= 325, SNARK:<4.1.UTILITIES>SETSPD.MAC.5,  12-Mar-80 14:16:04 by OSMAN
;tco 4.1.1107 - Make release 4.1 look for 4-1-CONFIG.CMD
; UPD ID= 299, SNARK:<4.1.UTILITIES>SETSPD.MAC.3,  29-Feb-80 13:22:36 by OSMAN
;tco 4.1.1096 - Use COMND instead of TEXTI so as to allow "POLICY-PROGRAM"
; UPD ID= 102, SNARK:<4.1.UTILITIES>SETSPD.MAC.2,   6-Dec-79 11:05:53 by BLOUNT
;<4.1.UTILITIES>SETSPD.MAC.2,  6-Dec-79 10:55:56, EDIT BY BLOUNT
;TCO #4.2590 -CHANGE AT QUEDN1+7 TO FIX KS HALT STATUS BLOCK BUG
;<4.UTILITIES>SETSPD.MAC.44,  9-Oct-79 15:26:55, EDIT BY GRANT
;<4.UTILITIES>SETSPD.MAC.43, 25-May-79 13:02:47, EDIT BY MILLER
;FIX QUEBLK. IT WAS COMPUTING # OF PAGES TO DUMP OFF-BY-ONE
;<4.UTILITIES>SETSPD.MAC.42, 11-Apr-79 15:57:49, Edit by LCAMPBELL
; Fix up addressing of SYERR block at QUEDN1
;<4.UTILITIES>SETSPD.MAC.41, 13-Mar-79 08:50:11, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>SETSPD.MAC.40, 13-Mar-79 06:50:04, EDIT BY R.ACE
;TAKE OUT TAPE-MOUNT-DEFAULT COMMAND
;ADD TAPE-RECOGNITION-ERRORS COMMAND
;<4.UTILITIES>SETSPD.MAC.39, 21-Feb-79 11:36:40, EDIT BY MURPHY
;ENABLE/DISABLE WORKING SET PRELOADING - DLM
;<4.UTILITIES>SETSPD.MAC.38, 20-Feb-79 17:43:04, EDIT BY BLOUNT
;CHANGE CLASS-SCHEDULER TO CLASS-SCHEDULING
;<4.UTILITIES>SETSPD.MAC.37, 19-Feb-79 14:22:43, Edit by MCLEAN
;FIX IT SO ECSKED WITH ARGUMENTS GIVES ERROR
;<4.UTILITIES>SETSPD.MAC.36, 19-Feb-79 13:24:27, Edit by MCLEAN
;CORRECT SPELLING OF WITHHELD
;<4.UTILITIES>SETSPD.MAC.35, 24-Jan-79 10:51:08, EDIT BY R.ACE
;MOVE TAPE-RECYCLE-PERIOD TO RIGHT PLACE, UPDATE EDIT#
;<4.UTILITIES>SETSPD.MAC.34, 11-Dec-78 06:52:19, EDIT BY R.ACE
;PUT ERJMP'S AFTER SYERR CALLS
;<4.UTILITIES>SETSPD.MAC.33, 28-Nov-78 08:04:16, EDIT BY R.ACE
;TCO 4.2098 - ADD TAPE-MOUNT-DEFAULT COMMAND
;ADD COMND JSYS ROUTINES FOR PARSING NEW SETSPD COMMANDS
;<ARC-DEC>SETSPD.MAC.3,  3-Oct-78 09:50:04, EDIT BY CALVIN
; Cause GTKEY to eat all of hypenated command name
;<ARC-DEC>SETSPD.MAC.1, 29-Sep-78 15:58:56, EDIT BY CALVIN
; Add ARCHIVE-TAPE-RECYCLE-PERIOD and TAPE-RECYCLE-PERIOD
;<4.UTILITIES>SETSPD.MAC.31, 20-Oct-78 19:16:54, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.30, 20-Oct-78 19:13:31, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.29, 20-Oct-78 19:12:53, EDIT BY MILLER
;TCO 4.2011. ADD BATCH-CLASS COMMAND
;<4.UTILITIES>SETSPD.MAC.28, 19-Oct-78 17:49:03, Edit by MCLEAN
;MAKE SKED JSYS BE SKED%
;<2MCLEAN>SETSPD.MAC.27, 24-Sep-78 21:56:05, Edit by MCLEAN
;<2MCLEAN>SETSPD.MAC.26, 21-Sep-78 21:22:18, Edit by MCLEAN
;<4.UTILITIES>SETSPD.MAC.25, 20-Sep-78 11:35:08, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.24, 19-Sep-78 12:57:51, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.23, 19-Sep-78 12:56:37, EDIT BY MILLER
;MORE OF TCO 4.2011
;<4.UTILITIES>SETSPD.MAC.22, 19-Sep-78 12:12:05, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.21, 19-Sep-78 12:10:50, EDIT BY MILLER
;TCO 4.2011. ADD ENABLE OPTIONS FOR CLASS SCHEDULER
;<4.UTILITIES>SETSPD.MAC.20, 19-Sep-78 11:27:50, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.19, 19-Sep-78 11:25:05, EDIT BY MILLER
;TCO 4.2011 AGAIN. ADD CREATE COMMAND
;<4.UTILITIES>SETSPD.MAC.18, 17-Sep-78 14:05:21, EDIT BY MILLER
;TCO 4.2011. IMPLEMENT "BATCH-BACKGROUND" COMMAND
;<4.UTILITIES>SETSPD.MAC.17, 24-Aug-78 12:07:17, EDIT BY R.ACE
;TCO 4.1993 - ADD COMMAND: ENABLE TAPE-DRIVE-ALLOCATION
;ADDED COMMENTING TO BEGINNING OF MODULE
;<R.ACE.LT>SETSPD.MAC.4, 23-Aug-78 16:44:38, EDIT BY R.ACE
;<R.ACE.LT>SETSPD.MAC.3, 23-Aug-78 13:19:33, EDIT BY R.ACE
;<R.ACE.LT>SETSPD.MAC.2, 23-Aug-78 12:12:30, EDIT BY R.ACE
;<2MCLEAN>SETSPD.MAC.17, 28-Jul-78 15:36:32, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.16, 26-Jul-78 15:00:29, Edit by MCLEAN
;<4.UTILITIES>SETSPD.MAC.13, 18-Jul-78 14:10:12, EDIT BY MILLER
;CHANGE VERSION NUMBER TO 4
;<4.UTILITIES>SETSPD.MAC.12, 16-May-78 09:23:45, EDIT BY MILLER
;ADD MINOR VERSION TO CONFIG FILE NAME
;<4.UTILITIES>SETSPD.MAC.11,  6-May-78 22:17:11, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.21,  4-Aug-78 13:13:02, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.20,  4-Aug-78 13:11:23, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.19,  3-Aug-78 17:12:20, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.18, 28-Jul-78 15:33:15, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.17, 27-Jul-78 14:41:21, EDIT BY MILLER
;INCREMENT EDIT NUMBER
;<3A.UTILITIES>SETSPD.MAC.16, 26-Jul-78 15:00:29, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.15, 16-May-78 09:21:33, EDIT BY MILLER
;<3A.UTILITIES>SETSPD.MAC.14, 16-May-78 09:19:58, EDIT BY MILLER
;<3A.UTILITIES>SETSPD.MAC.13, 16-May-78 09:17:32, EDIT BY MILLER
;AND CHANGE VERSION TO 3A
;<3A.UTILITIES>SETSPD.MAC.12, 16-May-78 09:16:35, EDIT BY MILLER
;ADD MINOR VERSION TO CONFIG NAME
;<1MCLEAN>SETSPD.MAC.17,  4-May-78 18:31:02, Edit by MCLEAN
;<1MCLEAN>SETSPD.MAC.16,  4-May-78 18:24:33, Edit by MCLEAN
;<1MCLEAN>SETSPD.MAC.15,  4-May-78 17:37:31, Edit by MCLEAN

;<1MCLEAN>SETSPD.MAC.14,  4-May-78 17:22:55, Edit by MCLEAN
;<1MCLEAN>SETSPD.MAC.13,  4-May-78 17:22:03, Edit by MCLEAN
;<1MCLEAN>SETSPD.MAC.12,  4-May-78 16:22:12, Edit by MCLEAN
;<1MCLEAN>SETSPD.MAC.11,  4-May-78 16:16:56, Edit by MCLEAN
;TCO 1880 ADD SLAVE TYPES TO MTALN JSYS
;<4.UTILITIES>SETSPD.MAC.9,  9-Apr-78 13:24:57, EDIT BY MILLER
;MERGE IN CHANGES TO NODE COMMAND FROM 3A SOURCE
;<4.UTILITIES>SETSPD.MAC.8,  7-Apr-78 00:40:43, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.9,  7-Apr-78 00:15:05, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.8,  7-Apr-78 00:13:21, Edit by MCLEAN
;<3A.UTILITIES>SETSPD.MAC.7,  7-Apr-78 00:07:24, Edit by MCLEAN
;ADD HSB (HALT STATUS BLOCK) FOR KS10
;<4.UTILITIES>SETSPD.MAC.5,  2-Mar-78 15:04:19, Edit by PORCHER
;<4.UTILITIES>SETSPD.MAC.4, 28-Feb-78 14:35:36, Edit by PORCHER
;<4.UTILITIES>SETSPD.MAC.3, 28-Feb-78 14:25:25, Edit by PORCHER
;ADD "CHANGE" COMMAND FOR ACCOUNTING SHIFT CHANGES
;<4.UTILITIES>SETSPD.MAC.2, 31-Jan-78 00:41:13, Edit by MCLEAN
;MAGTAPE ONLINE ENTRY VECTOR UPDATES
;<4.UTILITIES>SETSPD.MAC.2, 16-Dec-77 14:01:29, EDIT BY MILLER
;<4.UTILITIES>SETSPD.MAC.1, 16-Dec-77 13:56:02, EDIT BY MILLER
;TCO 1879. ADD NODE COMMAND
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH MONSYM,MACSYM,SERCOD,CMD
	.REQUIRE SYS:MACREL,SYS:CMD
	TITLE SETSPD
	SALL
	.DIRECTIVE FLBLST	;SUPPRESS LENGTHY BINARY EXPANSIONS

; VERSION NUMBER DEFINITIONS

VMAJOR==4		;MAJOR VERSION OF SETSPD
VMINOR==1		;MINOR VERSION NUMBER
VEDIT==^D63		;EDIT NUMBER
VWHO==0			;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)

VSTSPD== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
; THIS PROGRAM IS RUN BY JOB 0 TO PERFORM VARIOUS USER-MODE
; FUNCTIONS THAT AFFECT THE OPERATION OF THE SYSTEM

; DEPENDING UPON THE DESIRED ACTION, THE PROGRAM IS STARTED AT
; ONE OF SEVERAL POSITIONS IN ITS ENTRY VECTOR.

;**;[63] Change documentation to comply with the monitor  MDR	10-JUN-86
; POS	DESCRIPTION
; ---	--------
;
;  0	THIS ENTRY IS FUNCTIONALLY EQUIVALENT TO POSITION 1,
;	BUT IT IS NOT USED BY THE MONITOR.
;
;  1	CALLED ONCE DURING SYSTEM STARTUP BY RUNDD ROUTINE IN MEXEC.
;	READS FILE "SYSTEM:x-CONFIG.CMD" FOR COMMANDS:
;	  CHANGE - set accounting shift change times
;	  DEFINE - define system-wide logical names
;	  ENABLE/DISABLE account validation
;	  ENABLE/DISABLE directory-parameter setting by non-priv users
;	  ENABLE/DISABLE use of hardware disk optimization feature
;	  ENABLE/DISABLE magtape drive assignment by MTCON
;	  HOST - set ARPANET host number of this CPU
;	  MAGTAPE - logical magtape units (e.g. MTA3:) with
;		actual serial numbers
;	  NODE - set DECNET node name and number for this CPU
;	  PRINTER - load VFU and RAM files and set lowercase attribute
;	  TERMINAL - set auto-baud, nobell, remote, and speed
;		attributes of terminals
;	  TIMEZONE - set time zone for this site
;	***This entry vector is used by the monitor at system startup.
;
;  2 	CONTAINS PROGRAM VERSION NUMBER.
;
;  3	CALLED BY RUNDD ROUTINE IN MEXEC DURING SYSTEM
;	INITIALIZATION AFTER A CRASH TO:
;	1. Copy PS:<SYSTEM>DUMP.EXE to PS:<SYSTEM>DUMP.CPY
;	2. Extract unrecorded SYSERR entries from DUMP.EXE and
;	   log them using the SYERR JSYS
;
;  4	CALLED BY CHKR ROUTINE IN MEXEC WHILE SYSTEM IS RUNNING
;	WHENEVER PHYSIO DETECTS THAT A TAPE DRIVE HAS COME ONLINE
;	AND PHYSIO DIDN'T KNOW ABOUT THE DRIVE AT SYSTEM STARTUP.
;	THE CONFIG FILE IS READ AS IF ENTERED AT ENTRY VECTOR
;	POSITION 0, EXCEPT ONLY THE "MAGTAPE" COMMANDS IN THE
;	FILE ARE PROCESSED; ALL OTHER COMMANDS ARE IGNORED.
SUBTTL SETSPD DATA


DICT:	0			;FREE SPACE HEADER
CSBUFP:	0			;SCRATCH STRING POINTER
;**;[63] Add 1 line at CSBUFP:+1L	MDR	10-JUN-86
SYSTUP:	0			;[63] System startup flag
STRSIZ==100			;NUMBER OF SCRATCH STRING WORDS TO ALLOCATE

SPDTBL==560000			;SPEED TABLE
REMTBL==570000			;REMOTE TABLE
FREE==600000			;WHERE FREE SPACE STARTS
FRESIZ==50000			;SIZE OF FREE SPACE

JFN:	0			;JFN OF INPUT COMMAND FILE

DATBLK:	BLOCK 3			;FOR IDTNC STUFF FROM COMND (.CMTAD FUNCTION)

LODLCP:	BLOCK <LPTN==2>		;FLAG NONZERO FOR LOWERCASE PRINTER
CLSBLK:	3			;COUNT
	BLOCK 2			;DATA ARE
MTBLK:	3			;SIZE OF BLOCK
	BLOCK 2			;FOR OTHER ARGS
EOLF:	BLOCK 1
PDLEN=500			;LENGTH OF PUSH-DOWN STACK
PDL:	BLOCK PDLEN		;PUSH-DOWN STACK
PAGMAX:	BLOCK 1			;WORD TO HOLD HIGHEST DUMP PAGE NUMBER
FILNAM:	BLOCK ^D28		;NAME OF RAM OR VFU FILE PUT HERE
LINES:	BLOCK 1			;WORD TO HOLD LINES
STRBLK:	BLOCK .MSSLN		;BLOCK FOR STRUCTURE COMMAND
HSBBUF:	BLOCK HS%LEN		;LENGTH OF HSB AND HEADER
ASCTBL:	BLOCK <ASCTBZ==^D100>+1	;ACCOUNTING SHIFT CHANGE TABLE

	CPYPGS==^D10		;# OF PAGES TO COPY WITH EACH PMAP
	CPYWDS==CPYPGS_PGSFT	;NUMBER OF WORDS TO COPY
	PGSFT==11		;PAGE SHIFT VALUE
PG0PG==30			;PAGE 0 OF DUMP.EXE
	PG0ADR=PG0PG_PGSFT
TMPPG==31			;2 PAGES FOR TEMPORARY MAPPING
	TMPADR=TMPPG_PGSFT
MMPPG==33			;PAGE FOR MAPPING MMAP PAGE
	MMPADR=MMPPG_PGSFT
DMPPG==40			;PAGE FOR MAPPING DUMP FILE
	DMPADR==DMPPG_PGSFT
CPYPG==DMPPG+CPYPGS		;PAGE FOR MAPPING COPY FILE
	CPYADR==CPYPG_PGSFT
MAPPG==CPYPG+CPYPGS		;PAGE FOR BUILDING DUMP FILE MAP
	MAPADR=MAPPG_PGSFT

CMDSTG				;STORAGE FOR COMND JSYS

;PROGRAM ENTRY VECTOR

ENTVEC:	JRST START		;STARTING LOCATION
;**;[63] Change entry vectors	MDR	10-JUN-86
MONVEC:	JRST START0		;[63] The monitor starts SETSPD here
	VSTSPD			;VERSION NUMBER
	JRST START3		;[63] Entry point for making DUMP.CPY
	JRST START4		;[63] MTA/DISK online entry vector

ENVLEN==.-ENTVEC		;ENTRY VECTOR LENGTH
;COMMAND TABLES:

;****************************************************************
;
;	WARNING!!!
;
;	THESE TABLES MUST BE KEPT IN ALPHABETICAL ORDER FOR TBLUK
;
;****************************************************************

ALTLVT:	1,,1			;MAGTAPE ONLY
	T MAGTAPE,MAGTAP

LEV1TB:	ELEVL1-.-1,,ELEVL1-.-1
	T ARCHIVE-TAPE-RECYCLE-PERIOD,ARCHIV
	T BATCH-BACKGROUND,BATBGD
	T BATCH-CLASS,BCHCLS
	T BIAS,BIAS
	T CHANGE,CHANGE
	T CREATE,CREATE
	T DEFINE,DEFINE
	T DISABLE,DISABL
	T ENABLE,ENABLE
	T HOST,HOST
	T MAGTAPE,MAGTAP
	T NODE,NODNAM
	T PRINTER,LPTLOD
	T TAPE-RECOGNITION-ERRORS,TRECER
	T TAPE-RECYCLE-PERIOD,TAPRCY
	T TERMINAL,TERM
	T TIMEZONE,TIMZON
ELEVL1:

;TABLE FOR TERMINAL CHARACTERISTICS

LEV2TB:	ELEVL2-.-1,,ELEVL2-.-1
	T AUTO-BAUD,AUTO
	T NOBELL,NOBELL
	T REMOTE,REMOTE
	T SPEED,SPEED
PMPPAG==CPYPG+CPYPGS		;PAGE MAP PAGES
ELEVL2:

MOREBT==1B0			;THERE'S MORE OF COMMAND

; TABLE OF OPTIONS FOR ENABLE COMMANDS

ENAOPT:	ENASIZ-1,,ENASIZ-1
	T ACCOUNT-VALIDATION,[ENACCT]
	T CLASS-SCHEDULING,[MOREBT!ECSKED]
	T DIRECTORY-PARAMETER-SETTING,[ENADIR]
	T FULL-LATENCY-OPTIMIZATION,[ENAFLO]
	T TAPE-DRIVE-ALLOCATION,[ENATDA]
	T WORKING-SET-PRELOADING,[ENAWSP]

	ENASIZ==.-ENAOPT

; TABLE OF OPTIONS FOR DISBLE COMMANDS

DISOPT:	DISSIZ-1,,DISSIZ-1
	T ACCOUNT-VALIDATION,[DISACT]
	T DIRECTORY-PARAMETER-SETTING,[DISDIR]
	T FULL-LATENCY-OPTIMIZATION,[DISFLO]
	T WORKING-SET-PRELOADING,[DISWSP]

	DISSIZ==.-DISOPT

; TABLE OF OPTIONS FOR LOADING PRINTERS

LPTTAB:	LPTBSZ-1,,LPTBSZ-1
	T LOWERCASE, .MOSTS
	T RAM, .MOLTR
	T VFU, .MOLVF

	LPTBSZ==.-LPTTAB

SLAVT:	SLVBSZ-1,,SLVBSZ-1
	T TU45,.MTT45		;TU45
	T TU70,.MTT70		;TU70
	T TU71,.MTT71
	T TU72,.MTT72		;TU72
	T TU73,.MTT73
	T TU77,.MTT77		;TU77
	T TU78,.MTT78		;TU78
	SLVBSZ==.-SLAVT


;TABLE OF DAYS OF WEEK FOR "CHANGE" COMMAND

DOWTAB:	XWD DOWTBZ-1,DOWTBZ-1
	T ALL,<<1B0!1B1!1B2!1B3!1B4!1B5!1B6>_-^D18>
	T FRIDAY,<<1B4>_-^D18>
	T MONDAY,<<1B0>_-^D18>
	T SATURDAY,<<1B5>_-^D18>
	T SUNDAY,<<1B6>_-^D18>
	T THURSDAY,<<1B3>_-^D18>
	T TUESDAY,<<1B1>_-^D18>
	T WEDNESDAY,<<1B2>_-^D18>
	T WEEKDAYS,<<1B0!1B1!1B2!1B3!1B4>_-^D18>
	T WEEKENDS,<<1B5!1B6>_-^D18>

;TABLE FOR TYPE OF CLASS SCHEDULING DESIRED

SKDOPT:	SKDSIZ-1,,SKDSIZ-1
	T ACCOUNTS,0
	T POLICY-PROGRAM,1
SKDSIZ==.-SKDOPT

;TABLE FOR WINDFALL HANDLING

SKDOP0:	SKDSZ0-1,,SKDSZ0-1
	T ALLOCATED,0
	T WITHHELD,1
SKDSZ0==.-SKDOP0
DOWTBZ=.-DOWTAB
;DEFINE REGISTERS USED

A==1
B==2
C==3
D==4
T1=1
T2=2
T3=3
T4=4
Q1==5
Q2==6
Q3==7
P1==10
P2==11
P3==12
P4==13
P5==14
P==17

;USEFUL DEFINITIONS

DEFSTR SEBSIZ,0,17,12		;POINTER TO SIZE FIELD IN SYSERR BLOCK
DEFSTR SEBERC,HSBBUF,8,9

	SEBQOU=24		;ADDRESS OF POINTER TO SYSERR QUEUE
	MMAPWD=25		;ADDRESS OF POINTER TO MMAP PAGE
	SEBHED==2		;NUMBER OF HEADER WORDS IN SYSERR BLOCK

;DEFINE INTERRUPT SYSTEM TABLES

;**;[34]  Replace 3 lines with 13 at ADDR:+0		DML	3-MAY-83
PCLEV1:	BLOCK 1			;[34]
PCLEV2:	BLOCK 1			;[34]
.ICLPO==0			;[34] CHANNEL FOR LINE PRINTER OFFLINE
.ICHNG==1			;[34] CHANNEL FOR TIMER INTERRUPT
HNGTIM==<^D30*^D1000>		;[34] SETSPD IS HUNG IF COMMAND TAKES >30 SEC.
TIMENA:	BLOCK 1			;[34] FLAG WORD TO SPECIFY IF TIMER PSI ENABLED
UMODF==1B5			;[34] USER MODE FLAG
LEVTAB:	PCLEV1			;[34]
	PCLEV2			;[34]
	0			;[34]
CHNTAB:	XWD 1,LPTINT		;[34] .ICLPO CHANNEL
	XWD 2,HUNG		;[34] .ICHNG CHANNEL
	BLOCK ^D34		;[34]

;ERROR macro prints error message and dies

DEFINE ERROR (MESS)
<	CALL [	PUSH P,A
		HRROI A,[ASCIZ /MESS/]
		ESOUT
		POP P,A
		HALTF
		RET]
>

;MACRO FOR CAUSING A COMMAND ERROR THAT WE DETECT, AS OPPOSED TO ONE THAT
;COMND JSYS DETECTS

DEFINE COMERR (TEXT)
<	CALL [	HRROI A,[ASCIZ /SETSPD: TEXT/]
		ESOUT
		TMSG <
>
		JRST CMDER1]
>

DEFINE EMSG (ETXT) <		;;ERROR-MESSAGE MACRO
	HRROI T1,[ASCIZ/
? SETSPD: ETXT
/]
	PSOUT>

	DEFINE BCONFIG (R)  <
	IFE VMINOR,<ASCIZ /SYSTEM:'R'-CONFIG.CMD/>
	IFG VMINOR,<
	 DEFINE BSP (R1,LETT) <
		IRPC LETT,<
		IFE "1"-"'LETT'"+VMINOR-1,<
			ASCIZ /SYSTEM:R1-LETT-CONFIG.CMD/
			STOPI>
		>
		>
	BSP (\VMAJOR,"1234567")>
	>

RCONFG:	BCONFIG (\VMAJOR)
SUBTTL SETSPD PROCEDURE

;ENTRY POINTS FOR READING CONFIG.CMD FILE

;**;[63] Add 2 lines at START0:+0L	MDR	10-JUN-86
START0:	SETOM SYSTUP		;[63] Flag we are system starting up
	SKIPA			;[63] Continue with normal entry
START4:	TDZA P5,P5		;INDICATE MTA ONLINE ENTRY
START:	SETOM P5		;INDICATE NORMAL ENTRY
	MOVE P,[IOWD PDLEN,PDL]	;SET UP PUSH DOWN LIST
	CALL INIT		;SET UP PSI, CAPABILITIES, ETC.
	CALL FREINI		;INITIALIZE FREE SPACE
	CALL CMDINI		;INITIALIZE FOR COMND JSYS

;NOW FIND THE COMMAND FILE

	MOVX A,GJ%SHT!GJ%OLD!GJ%PHY
	HRROI B,RCONFG		;SYSTEM:X-CONFIG.CMD
	GTJFN			;FIND THE FILE
	 JRST FINISH		;NOT THERE. GO DEFAULT EVERYTHING
	MOVEM A,JFN		;REMEMBER THE JFN
	MOVE B,[070000,,200000]	;READ ONLY
	OPENF			;GET IT
	 JRST [	MOVEI A,.PRIOU	;THE CTY NO DOUBT
		HRLOI B,.FHSLF	;THIS FORK
		SETZ C,		;NO FLAGS
		ERSTR		;OUTPUT SOMETHING
		 JFCL
		 JFCL
		JRST FINISH]	;AND GO DEFAULT EVERYTHING
	HRL A,JFN		;GET JFN
	HRRI A,.NULIO		;DON'T LET COMND TRY TO TYPE CARRIAGE RETURN BEFORE PROMPT
	MOVEM A,.CMIOJ+SBK	;TELL COMND TO READ FROM FILE
;**;[34]  Add 4 lines at CMND0:+0			DML	3-MAY-83
CMND0:	MOVEI A,CMND0		;[34] IF HUNG, CONTINUE AT CMND0
	MOVEM A,HNGCON		;[34] SAVE IT
	MOVEM P,HNGSTK		;[34] SAVE THE STACK
	CALL SETTIM		;[34] SET THE TIME AT WHICH WE WILL BE HUNG
	HRROI A,[0]		;NO PROMPT WHEN READING FROM FILE
	CALL DPROMP		;INITIALIZE COMMAND LINE
	SKIPN P5		;CHECK FOR MAGTAPE ENTRY
	SKIPA A,[[FLDDB. .CMKEY,,ALTLVT]]	;ALTERNATE TABLE
	MOVEI A,[FLDDB. .CMKEY,,LEV1TB]	;THE TABLE
	CALL RFLDE		;READ KEYWORD
	 JRST [	CALL GETERR	;FAILED, SEE WHY
		CAIN A,IOX4	;END OF FILE?
		JRST FINISH	;YES, FINISH UP
		CAIN A,NPXNOM	;INVALID SWITCH OR KEYWORD?
		 SKIPE P5	;AND LOOKING FOR MAGTAPE KEYWORD?
;**;[33] Change 1 line at CMND0:+11.L	PED	4-OCT-82
		  JRST OUTBUF	;[33] NO SO COMPLAIN AND CONTINUE
		JRST CMND0]	;YES SO IGNORE AND GET NEXT COMMAND
	MOVE B,(B)		;GET TABLE WORD
;**;[34]  Add 1 line after CMND0:+13			DML	3-MAY-83
	AOS NCMDS		;[34] INCREMENT NUMBER OF COMMANDS SEEN
	CALL (B)		;EXECUTE THE COMMAND
	JRST CMND0		;DO REST OF COMMANDS

;GETERR asks monitor for last jsys error code.
;
;Returns+1:	A/	error code

GETERR:	MOVEI A,.FHSLF		;OURSELF
	GETER			;GET ERROR
	HRRZ A,B		;KEEP ONLY THE CODE
	RET
; INIT - RESET PROCESS, SET UP SOFTWARE INTERRUPT SYSTEM,
;	 ENABLE CAPABILITIES
; RETURNS +1: ALWAYS

INIT:	RESET			;GET TO A KNOWN STATE
	MOVEI A,.FHSLF		;GET OWN ID
	RPCAP			;READ CAPABILITES
	MOVE C,B
	EPCAP			;ENABLE ALL CAPABILITIES
	MOVE B,[LEVTAB,,CHNTAB]
	SIR			;SET INTERRUPT TABLE ADDRESSES
	EIR			;TURN ON INTERRUPT SYSTEM
;**;[34]  Replace 3 lines with 26 at INIT:+8		DML	3-MAY-83
	MOVX B,1B<.ICLPO>!1B<.ICHNG>  ;[34] ACTIVATE LINE PRINTER OFFLINE
	AIC			;[34] AND TIMER EXPIRED CHANNELS
	SETOM TIMENA		;[34] SAY TIMER PSI CHANNEL ENABLED
	SETZM NCMDS		;[34] INITIALIZE COMMAND COUNTER
	RET			;[34]

;[34]  SETTIM - ROUTINE TO SET TIME AT WHICH THE COMMAND IS DETERMINED HUNG
;[34]  Returns +1:  ALWAYS

SETTIM:	SKIPN TIMENA		;[34] IS TIMER PSI CHANNEL ENABLED?
	 RET			;[34] NO, JUST RETURN
	MOVE T1,[.FHSLF,,.TIMAL];[34] REMOVE ALL TIME LIMITS
	TIMER			;[34]
	 ERJMP TIMERR		;[34] ERROR, GIVE MESSAGE AND RETURN
	MOVEI T2,HNGTIM		;[34] GET TIME LIMIT OF COMMAND
	MOVEI T3,.ICHNG		;[34] SPECIFY HUNG PSI CHANNEL
	MOVE T1,[.FHSLF,,.TIMEL];[34] ELAPSED TIME FUNCTION
	TIMER			;[34]
	 ERJMP TIMERR		;[34] ERROR, GIVE MESSAGE AND RETURN
	RET			;[34]
TIMERR:	EMSG <Timer JSYS failed - PSI System for Hung SETSPD disabled>  ;[34]
	MOVEI T1,.FHSLF		;[34] GET PROCESS HANDLE
	MOVE T2,[1B<.ICHNG>]	;[34] CHANNEL FOR TIMER JSYS
	DIC			;[34] DEACTIVATE THIS CHANNEL
	SETZM TIMENA		;[34] SAY PSI DISABLED FOR TIMER JSYS
	RET			;[34] AND RETURN

;**;[33] Add 26. lines at INIT:+11.L	PED	4-OCT-82
RFIELD:	CALL RFLDE		;[33] READ FIELD
	 JRST OUTBUF		;[33] ERROR - OUTPUT COMMAND LINE
	RET			;[33]
OUTBUF:	HRROI A,[ASCIZ/
SETSPD:	/]			;[33] SAY WHO GOT THE ERROR
	PSOUT			;[33] 
	HRROI A,CMDBUF		;[33] OUPUT THE BUFFER
	PSOUT			;[33]
	JRST CMDERR		;[33] AND OUTPUT ERROR STRING

;ROUTINE TO GET CONFIRMATION

CFMRTN:	PUSH P,A		;[33] PRESERVE CALLER'S AC'S
	PUSH P,B		;[33]
	PUSH P,C		;[33]
	MOVEI A,[FLDDB. .CMCFM] ;[33]
	CALL RFIELD		;[33] PARSE CONFIRMATION
XPARX:	POP P,C			;[33]
	POP P,B			;[33]
	POP P,A			;[33]
	RET			;[33]

;READ A FIELD AND REQUIRE CARRIAGE RETURN AFTER IT FOR CONFIRMATION

CFIELD:	CALL RFIELD		;[33] READ THE FIELD
	CONFRM			;[33] GET CONFIRMATION
	RET			;[33] RETURN TO CALLER

;COMMAND LEVEL ACTION ROUTINES.

;FIRST TERMINAL

TERM:	TRVAR <<DEFBLK,1+.CMDEF>,<DEFOUT,3>>
	MOVEI A,[FLDDB. .CMNUX,CM%SDH,8,<terminal line number>]
	CALL RFIELD		;GET LINE NUMBER, CMNUMX ALLOWS HYPHEN AFTER NUMBER
	HRLZM B,LINES		;SAVE LINE NUMBER
	MOVEI A,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /-/]>,<hyphen (-) if specifying range>]
	CALL RFLDE		;SEE IF HYPHEN
	 CAIA			;NO HYPHEN
	JRST GTRNGE		;YES. GET RANGE
	HLRS LINES		;EXTEND LINE NUMBER	
	JRST LINKEY		;GO GET THE KEY

GTRNGE:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,8,<terminal line number>]
	CALL RFIELD		;READ END OF RANGE
	HRRM B,LINES		;STASH LAST LINE NUMBER
	; ..
;NOW READ OUT THE KEY WORD

LINKEY:	SETZB P1,P2		;CLEAR FLAGS
	MOVEI A,[FLDDB. .CMCFM,,,,,[
		 FLDDB. .CMKEY,,LEV2TB]]
	CALL RFIELD		;GET CONFIRMATION OR KEYWORD
	LOAD D,CM%FNC,.CMFNP(C)
	CAIN D,.CMCFM		;END OF LINE YET?
	RET			;YES, DONE
	MOVE B,(B)		;NO, GET TABLE ENTRY
	JRST (B)		;DO FUNCTION, RETURNS TO LINKEY

;IF HERE, LINES ARE REMOTE

AUTO:	TXOA P2,MO%AUT		;SET THE AUTO BUAD BIT
REMOTE:	TXO P2,MO%RMT		;SET THE REMOTE BIT
	HRRZ A,LINES		;GET FIRST LINE
	HLRZ B,LINES		;GET LAST LINE
	SUBI B,1(A)		;GET # TO DO
	HRLI A,0(B)		;AN AOBJN WORD
	HLR A,LINES		;FIRST LINE AGAIN
DOLINE:	SKIPN P1		;SETTING SPEED?
	IORM P2,REMTBL(A)	;SAY IT IS REMOTE
	SKIPE P1		;SETTING REMOTE?
	MOVEM P1,SPDTBL(A)	;NO. SET SPEED
	SKIPN SPDTBL(A)		;HAVE A SPEED YET?
	JRST REMOT1		;NO
	PUSH P,A		;SAVE LINES
	CALL SPDSET		;GO SET THE SPEED
	POP P,A			;RESTORE AOBJN WORD
REMOT1:	AOBJN A,DOLINE		;GO DO ALL OF THEM
	JRST LINKEY		;GO BACK FOR MORE ATTRIBUTES OF THIS SET OF TERMINALS
; HERE TO SET THE "IGNORE INPUT" (NO BELLS) BIT

NOBELL:	HRRZ D,LINES		;GET LAST LINE NUMBER
	HLRZ B,LINES		;GET FIRST LINE NUMBER
	SUBI B,1(D)		;FORM - NUMBER IN RANGE
	HRLI D,(B)		;FORM AN AOBJN POINTER TO LOOP
	HLR D,LINES		; OVER ALL THE LINES IN THE RANGE

NOBEL1:	MOVEI A,.TTDES(D)	;[63] Get line designator
	MOVX B,.MOSIG		;SET "IGNORE INPUT" BIT
	MOVX C,1		;TURN THE BIT ON
	MTOPR			;SET THE LINE TO IGNORE CHARACTERS UNTIL OPENED
	 ERJMP .+1		;IGNORE FAILURE HERE
	AOBJN D,NOBEL1		;LOOP OVER ALL THE LINES IN THE INDICATED RANGE
	JRST LINKEY		;GO GET THE NEXT KEYWORD IN THE COMMAND
;SET LINE SPEEDS

SPEED:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<input speed>]
	CALL RFIELD		;READ THE INPUT SPEED
	HRLI P1,.TTDES(B)	;[63] In case no more
	HRROI A,DEFOUT		;POINT TO BUFFER FOR DEFAULT OUTPUT SPEED
	MOVEM A,.CMDEF+DEFBLK	;STORE POINTER TO DEFAULT OUTPUT SPEED
	MOVEI C,5+5		;CREATE DEFAULT IN DECIMAL
	NOUT			;CREATE IT
	 JSHLT			;SHOULDN'T EVER FAIL
	HRLI A,[FLDDB. .CMNUM,CM%DPP!CM%SDH,5+5,<output speed>]
	HRRI A,DEFBLK		;MAKE BLT POINTER
;**;[31]CHANGE 1 LINE AT SPEED:+10L	TAM	23-SEP-82
	BLT A,.CMDEF-1+DEFBLK	;[31] PUT WRITABLE COMND FUNCTION BLOCK
	MOVEI A,DEFBLK		;POINT AT THE CREATED BLOCK
	CALL RFIELD		;READ OUTPUT SPEED, DEFAULT TO INPUT
	HRRI P1,0(B)		;SAVE OUTPUT SPEED
	JRST REMOTE		;GO SET SPEEDS
;ROUTINE TO SET SPEED OF A LINE.
;INPUT IS :	A/ LINE NUMBER

SPDSET:	MOVEI A,0(A)		;CLEAN UP ARG
	SKIPE REMTBL(A)		;THIS A REMOTE SETTING?
	JRST SPDST1		;YES. ALWAYS USE FILE SETTING
;**;[63] Add 2 lines at SPDSET:+3L	MDR	10-JUN-86
	SKIPGE SYSTUP		;[63] Are we system startup?
	 JRST SPDST1		;[63] Yes, always use file setting.
	MOVEI A,.TTDES(A)	;[63] Get TTY designator
	MOVEI B,.MORSP		;GET SPEED FROM MONITOR
	MTOPR			;GET IT
	ERJMP REMOT2		;?
	TRZ A,.TTDES		;[63]
	SKIPG C			;GET IT?
SPDST1:	MOVE C,SPDTBL(A)	;NO. USE FILE'S VALUE
	TLZ C,(1B0)		;GET RID OF SIGN BIT
	MOVEI B,.MOSPD		;SPEED SETTING
	IOR B,REMTBL(A)		;ADD IN THE REMOTE AND AUTO BITS (IF ANY)
	TRO A,.TTDES		;[63] TTY designator
	MTOPR			;DO IT
	 ERJMP REMOT2		;IGNORE ERROR
	MOVEI B,.MORNT		;REQ MSG SUPPRESS STATUS FROM
	MTOPR			;MONITOR FOR TTY (A/ TTY#)
	 ERJMP REMOT2		;IGNORE ERROR
	MOVEI B,.MOSNT		;SET MSG SUPPRESS BIT FOR TTY
	MTOPR			;SAME AS BEFORE
	 ERJMP REMOT2		;IGNORE ERROR
REMOT2:	RET			;ALL DONE

;ROUTINE TO APPLY DEFAULT SPEEDS AT EOF

FINISH:	JUMPE P5,QUIT		;QUIT IF MTA ONLINE
	MOVE A,[SIXBIT /TTYJOB/] ;FIRST FIND # OF TTY'S
	SYSGT			;GET IT
	HLLZ P3,B		;MAKE AOBJN POINTER
FIN1:	SKIPE SPDTBL(P3)	;THIS ONE SET YET?
	JRST FIN2		;YES. GO ON
	MOVEI A,0(P3)		;NO. GET LINE #
	MOVE B,[^D300,,^D300]	;DEFAULT SPEED
	MOVEM B,SPDTBL(A)	;STORE IT
	CALL SPDSET		;GO SET THE SPEED
FIN2:	AOBJN P3,FIN1		;DO ALL LINES
;;	CALL REFILL		;GO LOAD THE CACHE REFILL ALGORITHM
QUIT:	HALTF			;AND DONE
;THIS CODE PROCESSES THE MAGTAPE CONFIGURATION COMMANDS. FORMAT
;OF A COMMAND LINE IS:
;	MAGTAPE "LUN" "SERIAL#" "SLAVE TYPE"

MAGTAP:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<unit number>]
	CALL RFIELD
	MOVE P1,B		;SAVE LUN
	MOVE D,P1		;RESOTRE LUN
	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<serial number>]
	CALL RFIELD
	HRRZ P2,B		;SAVE SERIAL NUMBER
;**;[32] Change one line at MAGTAP:+7L	PED	4-OCT-82
	MOVEI A,[FLDDB. .CMKEY,,SLAVT,<slave type,>,<TU45>];[32]
	CALL CFIELD		;GET SLAVE TYPE AND CONFIRMATION
	HRL P1,(B)		;SAVE SLAVE TYPE IN LEFT HALF OF P1
	MOVE A,P1		;SET LUN
	MOVE B,P2		;SET SERIAL #
	MTALN			;DO IT
	ERJMP [	JUMPE P5,CMDER1	;NO MESSAGE IF MTA ONLINE
		HRROI A,[ASCIZ /
? SETSPD: Could not set MTA /]
		PSOUT
		MOVEI A,.PRIOU	;TO THE CTY
		EXCH B,D	;GET MTA, SAVE SERIAL #
		MOVEI C,10	;IN OCTAL
		NOUT		;DO IT
		 JFCL
		HRROI A,[ASCIZ / SERIAL # /]
		PSOUT
		MOVEI A,.PRIOU
		MOVE B,D
		MOVEI C,12
		NOUT		;OUPUT THE SERIAL # AS WELL
		 JFCL
		JRST CMDER1]	;AND DONE
	RET

; TAPE-RECOGNITION-ERRORS COMMAND

TRECER:	MOVEI T1,[FLDDB. .CMKEY,,TRETB] ;GET FDB ADDRESS
	CALL CFIELD		;GET KEYWORD AND CONFIRMATION
	HRRZ T4,(T2)		;GET BIT SETTING
	MOVEI T1,.SFTDF		;GET TMON FUNCTION CODE
	TMON			;GET CURRENT MOUNTR CONTROLS
	STOR T4,MT%UUT,T2	;SET OR CLEAR UNLOAD-UNREADABLE-TAPES
	SMON			;RESTORE CONTROL WORD
	RET

; KEYWORD TABLE FOR TAPE-RECOGNITION-ERRORS

TRETB:	TRETBL,,TRETBL
	T REGARD-AS-UNLABELED,0
	T UNLOAD,1
TRETBL==.-TRETB-1
; ENABLE COMMAND

DISABL:	MOVEI A,[FLDDB. .CMKEY,,DISOPT]
	JRST ENA1

ENABLE:	MOVEI A,[FLDDB. .CMKEY,,ENAOPT]
ENA1:	CALL RFIELD		;GET OPTION
	MOVE A,(B)		;TABLE WORD
	MOVE A,(A)		;GET CONTROL BITS AND DISPATCH ADDRESS
	TXZN A,MOREBT		;IS THERE MORE OF THIS COMMAND?
	CONFRM			;NO, SO CONFIRM NOW
	CALLRET (A)		;GO PERFORM INDICATED FUNCTION
; HERE TO PERMIT CHANGING DIRECTORY PARAMETERS

DISDIR:	TDZA B,B		;TURN OFF THE PARAMETER
ENADIR:	MOVEI B,1		;TURN ON THE OPTION
	MOVEI A,.SFCRD		;GET FUNCTION CODE
	SMON			;TELL THE MONITOR
	RET			;RETURN

; HERE TO ENABLE ACCOUNT VALIDATION

DISACT:	TDZA B,B		;TURN OFF ACCOUNT VALIDATION
ENACCT:	MOVEI B,1		;TURN ON ACCOUNT VALIDATION
	MOVEI A,.SFAVR		;GET THE FUNCTION CODE
	SMON			;TELL THE MONITOR
	RET			;RETURN

; HERE TO ENABLE/DISABLE FULL LATENCY OPTIMIZATION

DISFLO:	TDZA B,B		;TURN OFF FULL LATENCY OPTIMIZATION
ENAFLO:	MOVEI B,1		;TURN ON FULL LATENCY OPTIMIZATION
	MOVEI A,.SFFLO		;GET THE SMON FUNCTION CODE
	SMON			;SET THE DESIRED STATE
	RET			;AND RETURN

; HERE TO ENABLE TAPE-DRIVE-ALLOCATION

ENATDA:	MOVEI B,1		;TURN ON TAPE DRIVE ALLOCATION
	MOVEI A,.SFMTA		;GET SMON SUNCTION CODE
	SMON
	RET

; HERE TO ENABLE/DISABLE WORKING SET PRELOADING

DISWSP:	TDZA B,B
ENAWSP:	MOVEI B,1
	MOVEI A,.SFWSP
	SMON
	RET
;DEFINE A LOGICAL NAME

DEFINE:	STKVAR <LNPTR>
	NOISE <SYSTEM LOGICAL NAME>
	MOVEI A,[FLDDB. .CMDEV,CM%PO!CM%SDH,,<global logical name being defined>]
	CALL RFIELD		;READ THE NAME
	CALL BUFFF		;GET POINTER TO NAME
	MOVEM A,LNPTR		;REMEMBER POINTER TO NAME
	NOISE <AS>
	MOVEI A,[FLDDB. .CMTXT,CM%SDH,,<logical name definition>]
	CALL CFIELD
	CALL BUFFF		;GET POINTER TO DEFINITION STRING
	MOVE C,A		;NEW NAME IN C
	MOVEI A,.CLNSY		;SAY GLOBAL
	MOVE B,LNPTR		;GET LOGICAL NAME
	CRLNM
	 JRST [	TMSG <
? SETSPD: Failed to define logical name >
		MOVE A,LNPTR	;GET POINTER TO NAME
		PSOUT		;OUTPUT IT
		JRST CMDERR]	;GO SAY WHY AND GET MORE COMMANDS
	RET

;SET LOCAL TIME ZONE; IT MUST BE A NUMBER FROM -12 TO 12

TIMZON:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<timezone number>]
	CALL CFIELD		;GET NUMBER AND CONFIRMATION
	MOVM D,B		;CHECK IT FOR RANGE
	CAILE D,^D12		;MUST BE FROM -12 TO 12 DECIMAL
	 COMERR <Timezone must be -12 to 12 inclusive>
	MOVEI A,.SFTMZ		;SET TIME ZONE
	SMON			;ARGUMENT IN B
	 ERJMP TZERR
	RET			;DONE

;ATTEMPT TO SET TIME ZONE FAILED

TZERR:	TMSG <
? SETSPD: Unable to set time zone because:
	>
GENERR:	MOVEI A,.PRIOU		;TYPE OUT MONITOR ERROR
	HRLOI B,.FHSLF		; FOR THIS FORK
	ERSTR
	 JFCL
	 JFCL
	JRST CMDER1		;ON TO NEXT LINE

;SET LOCAL HOST NUMBER OF AN ARPANET SITE

HOST:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,8,<local ARPAnet host number>]
	CALL CFIELD		;READ NUMBER AND CONFRIMATION
	MOVEI A,.SFLHN		;SET LOCAL HOST NUMBER
	SMON
	 ERJMP HSTERR		;FAILED?
	RET			;DONE

HSTERR: TMSG <
? SETSPD: Unable to set ARPANET site address because:
	>
	JRST GENERR
ARCHIV:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<number of days for archive tape recycle period>]
	CALL CFIELD
	MOVEI A,.SFACY		; SET ARCHIVE TAPE RECYCLE PERIOD
	SMON
	 ERJMP ARCERR		;FAILED?
	RET

ARCERR:	TMSG <
? SETSPD: Unable to set archive tape recycle period because:
	>
	JRST GENERR

TAPRCY:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<number of days for tape recycle period>]
	CALL CFIELD
	MOVEI A,.SFMCY		; SET TAPE RECYCLE PERIOD
	SMON
	 ERJMP TAPERR		;FAILED?
	RET

TAPERR:	TMSG <
? SETSPD: Unable to set tape recycle period because:
	>
	JRST GENERR
;COMMAND TO DECLARE DECNET NODE NAME

NODNAM:	STKVAR <LNNAME>
	MOVEI A,[FLDDB. .CMFLD,CM%SDH,,<local node name>]
	CALL RFIELD		;READ NODE NAME
	CALL BUFFF		;GET POINTER TO ASCIZ STRING
	MOVEM A,LNNAME		;REMEMBER POINTER TO NAME
	MOVEI A,[	FLDDB. .CMCFM,,,,,[
			FLDDB. .CMNUM,CM%SDH,5+5,<node number>]]
	CALL RFIELD		;GET CONFIRMATION OR NODE NUMBER
	MOVEI D,0		;FIRST ASSUME NO NUMBER
	LOAD C,CM%FNC,.CMFNP(C)	;SEE WHAT WAS TYPED
	CAIN C,.CMCFM		;CONFIRMATION ONLY?
	JRST NODNA2		;YES, NO NUMBER
	CONFRM			;THERE IS A NUMBER; CONFIRM IT.
	MOVE D,B		;SAVE NUMBER
NODNA2:	MOVEI A,.NDSLN		;WANT TO SET NODE NAME
	MOVEI B,C		;ARG BLOCK
	MOVE C,LNNAME		;GET POINTER TO NODE NAME
	NODE			;DO IT
	 ERJMP NODNA1		;IF FAILED, GO AWAY
	JUMPE D,R		;IF NO NUMBER, GO ON
	MOVEI A,.NDSNM		;SET NODE NUMBER
	MOVEI B,D		;WHERE THE NUMBER IS
	NODE			;SET IT
	 ERJMP [	TMSG <SETSPD: couldn't set node number - >
			JSERR	;SAY WHY
			RET]
	RET

NODNA1:	COMERR <Invalid name given for NODE command>
; "CHANGE" COMMAND -- SET ACCOUNTING SHIFT TIMES
;
; COMMAND FORMAT:
;	CHANGE (ACCOUNT SHIFT AT) <TIME> (ON) <DAYS-OF-WEEK>

CHANGE:	MOVEI A,[FLDDB. .CMTAD,CM%SDH,CM%ITM!CM%NCI!DATBLK,<time of day at which accounting shift is to occur>]
	CALL RFIELD		;READ TIME
	HRRZ P1,DATBLK+2	;STORE TIME, INIT LEFT HALF TO NO DAYS
	MOVEI A,[FLDDB. .CMCFM,,,<confirm now to assume all days, or enter specific days of week>]
	CALL RFLDE		;END OF LINE NOW?
	 CAIA			;NO
	JRST CHANG7		;YES, ASSUME ALL DAYS
CHANG2:	MOVEI A,[FLDDB. .CMKEY,,DOWTAB,<day of the week on which accounting shift is to occur>]
	CALL RFIELD		;READ DAY OF THE WEEK
	HRLZ A,(B)		;GET DAY-OF-WEEK BITS FROM TABLE TO LH
	TDO P1,A		;SET SELECTED DAYS
	MOVEI A,[FLDDB. .CMCFM,,,,,[
		 FLDDB. .CMCMA]]
	CALL RFIELD		;GET CONFIRMATION OR COMMA
	LOAD D,CM%FNC,.CMFNP(C)	;SEE WHICH
	CAIN D,.CMCMA		;MORE DAYS FOLLOWING?
	JRST CHANG2		;YES, GO READ THEM
	JRST CHANG8		;NO, CONFIRMATION, SO WE'RE DONE

CHANG7:
	TXO P1,1B0!1B1!1B2!1B3!1B4!1B5!1B6 ;ASSUME ALL DAYS OF WEEK
CHANG8:
	MOVEI T1,ASCTBZ		;GET SIZE OF TABLE
	HRRZM T1,ASCTBL		;STORE AS MAX TABLE SIZE
	MOVX T1,.USRAS		;READ ACCOUNTING SHIFTS
	MOVEI T2,ASCTBL		; INTO ASCTBL
	USAGE			; . . .
	 ERCAL [JSERR
		RET]
	HLRZ T1,ASCTBL		;GET CURRENT SIZE OF TABLE
	ADDI T1,1		;BUMP BY ONE
	HRLM T1,ASCTBL		;STORE NEW SIZE
	MOVEM P1,ASCTBL(T1)	;STORE NEW ENTRY
	MOVX T1,.USSAS		;SET ACCOUNTING SHIFTS
	USAGE
	 ERCAL [JSERR
		RET]
	RET
; ROUTINE TO LOAD A RAM OR VFU

LPTLOD:	STKVAR <LODUNI,LODFNC,LODJFN,LPTJFN>
	SETZM LODJFN		;INIT THIS TO ZERO
	MOVEI A,[FLDDB. .CMNUM,CM%SDH,8,<lineprinter unit number>]
	CALL RFIELD		;READ UNIT NUMBER
	MOVEM B,LODUNI		;SAVE LPT UNIT NUMBER

; SEE IF RAM OR VFU IS TO BE LOADED

;**;[61]  Add 1L at LPLD20+5, add 2L at LPLD20+8 	JD	29-Apr-85

LPLD20:	MOVEI A,[FLDDB. .CMKEY,,LPTTAB]
	CALL RFIELD		;SEE WHICH IS BEING LOADED
	HRRZ A,(B)		;GET FUNCTION TO PERFORM
	CAIN A,.MOSTS		;SET STATUS FUNCTION (DECLARE LOWER CASE LPT) ?
	JRST [	MOVE T2,LODUNI	;YES, GET THE UNIT NUMBER
		CAIGE T2,LPTN	;[61] Bad unit number, don't write to table
		SETOM LODLCP(T2) ;FLAG THAT PRINTER SHOULD BE LOWER CASE
		JRST LPLD20 ]	;GO GET NEXT ARGUMENT
	MOVEM A,LODFNC		;SAVE DESIRED FUNCTION (MTOPR CODE)
	CAIGE T2,LPTN		;[61] Bad unit number?
	JRST LODERR		;[61] Yes, don't continue

; READ FILENAME TO BE LOADED AND GET A JFN FOR IT

	MOVEI A,[FLDDB. .CMIFI,CM%SDH,,<name of ram or vfu file>]
	CALL CFIELD		;GET FILENAME AND CONFIRMATION
	MOVEM B,LODJFN		;SAVE JFN

; OPEN THE PRINTER AND VERIFY THAT NO RAM OR VFU IS NOW LOADED

	HRROI A,FILNAM		;GET POINTER TO WHERE DEVICE STRING GOES
	MOVSI B,600007		;GET LPT DEVICE DESIGNATOR
	HRR B,LODUNI		;GET UNIT NUMBER
	DEVST			;GET DEVICE NAME STRING
	 JRST LODERR		;FAILED 
	MOVEI B,":"		;GET TERMINATOR FOR GTJFN
	IDPB B,A		;TERMINATE DEVICE NAME
	SETZ B,
	IDPB B,A		;TIE IT OFF
	MOVX A,GJ%SHT!GJ%FOU	;SHORT CALL, FOR OUTPUT USE
	HRROI B,FILNAM		;GET POINTER TO DEVICE NAME
	GTJFN			;GET A JFN FOR THE PRINTER
	 JRST ENDLPT		;ALREADY ASSIGNED
	MOVEM A,LPTJFN		;SAVE LPT JFN
	MOVX B,<FLD(7,OF%BSZ)+OF%WR> ;OPEN FOR WRITE
	OPENF			;OPEN THE PRINTER
	 JRST [	EXCH A,LPTJFN	;MUST BE OPEN ALREADY, GET BACK JFN
		RLJFN		;RELEASE THE JFN
		 JFCL		;IGNORE ERRORS HERE
		MOVE A,LPTJFN	;GET BACK ERROR CODE
		CAIE A,OPNX9	;ALREADY OPENED BY SOMEONE?
		JRST LODANY	;NO. LOAD ANYWAY
		JRST ENDLPT ]	;GO ON TO NEXT COMMAND
	MOVEI B,.MOPSI		;GET OFF-LINE INTS
	MOVEI C,P1		;SET UP ARGS IN REGISTERS
	MOVEI P1,3		;3 WORDS
;**;[34]  Replace 1 line with 2 at INERR:-9		DML	3-MAY-83
	MOVEI P2,.ICLPO		;[34] LINE PRINTER OFFLINE CHANNEL
	SETZ P3,		;[34] NO FLAGS
	MTOPR			;DO IT
	ERJMP .+1		;IN CASE SOMETHING TERRIBLE HAPPENED
	GDSTS			;GET CURRENT STATUS
	TXZ B,MO%LVU!MO%LCP!MO%EOF ;TURN OFF CONDITION BITS
	JUMPN B,INERR		;IF AN ERROR, PUNT IT
	MOVEI B,14		;IF NO ERROR, ALIGN FORMS
	BOUT			;DO IT
	 ERJMP .+1		;IGNORE FAILURE
INERR:	DMOVE B,[-1,,FILNAM
		5*^D28]		;ARGS
	DMOVEM B,MTBLK+1	;TO ARG BLOCK
	MOVE C,LODFNC		;GET FUNCTION TO PERFORM
	MOVX B,.MORTR		;GET READ-RAM FUNCTION CODE
	CAIE C,.MOLTR		;ARE WE LOADING THE RAM ?
	MOVX B,.MORVF		;NO, GET READ-VFU FUNTION
	MOVEI C,MTBLK		;GET ADDRESS OF BLOCK
	SETZM FILNAM		;MAKE IT LOOK AS IF IT IS NOT LOADED
	MTOPR			;READ FILENAME ALREADY LOADED
	 ERJMP .+1		;UNEXPECTED ERROR. LOAD RAM ANYWAY
	MOVE A,LPTJFN		;GET JFN FOR PRINTER
	CLOSF			;CLOSE THE FILE
FCLOSE:	 JRST [	MOVE A,LPTJFN	;FAILED. GET JFN AGAIN
		TXO A,CZ%ABT	;DO IT NOW WITH ABORT
		CLOSF		;DO IT
		 JFCL		;HAS TO WORK
		JRST .+1]	;ALL DONE
	LDB A,[POINT 7,FILNAM,6] ;GET FIRST BYTE RETURNED
	JUMPN A,ENDLPT		;IF NOT-NULL, GO ON TO NEXT COMMAND

; GET JFN, FUNCTION, AND UNIT # AND LOAD THE RAM OR VFU

LODANY:	MOVE B,LODFNC		;GET FUNCTION TO BE PERFORMED
	MOVE A,LODJFN
	MOVE C,LODUNI		;GET UNIT NUMBER OF PRINTER
	SKIPE LODLCP(C)		;IS THIS PRINTER LOWER CASE ?
	TXO B,MO%LCP		;YES, MARK THAT PRINTER IS LOWER CASE
	LPINI			;LOAD RAM OR VFU
	 ERJMP LODERR		;ERROR - TELL SOMEONE

; HERE TO FINISH UP AND GO DO NEXT COMMAND

ENDLPT:	RET

; HERE ON AN ERROR LOADING THE RAM OR VFU

LODERR:	TMSG <
? SETSPD: Could not load the >
	HRROI A,[ASCIZ/VFU/]	;GET TEXT
	MOVE B,LODFNC		;GET FUNCTION BEING PERFORMED
	CAIE B,.MOLVF		;ARE WE LOADING THE VFU ?
	HRROI A,[ASCIZ/RAM/]	;NO, GET RAM TEXT
	PSOUT			;TELL USER WHAT WE ARE LOADING
	TMSG < for PLPT>	;GET UNIT NAME
	MOVEI A,.PRIOU		;GET PRIMARY OUTPUT JFN
	MOVE B,LODUNI		;GET UNIT NUMBER
	MOVEI C,^D8		;GET OCTAL RADIX
	NOUT			;OUTPUT THE UNIT NUMBER
	 JFCL			;IGNORE ERRORS HERE
	TMSG <
>				;END OF MESSAGE
	SKIPE A,LODJFN		;GET JFN FOR FILE TO HAVE BEEN LOADED
	CLOSF			;MAKE SURE IT IS REALLY CLOSED AND RELEASED
	 JFCL			;PROBABLY CLOSED BY MONITOR ALREADY ANYHOW
;**;[61]  Add 4 lines at LODERR+16	JD	29-Apr-85
	MOVE B,LODUNI		;[61] Get unit number
	CAIGE B,LPTN		;[61] Unit number out of range?
	JRST ENDLPT		;[61] Go finish up
	TMSG <?Unit number out of range
>				;[61] Yes, tell them
	JRST ENDLPT		;GO FINISH UP

;LPT OFF-LINE INTERRUPT ROUTINE

LPTINT:	MOVEI A,@FCLOSE		;REDIRECT CODE TO CLOSE AND ABORT DEVICE
;**;[34]  Replace 2 lines with 24 at LPTINT:+1		DML	3-MAY-83
	MOVEM A,PCLEV1		;[34] ZAP THE OLD PC WORD
	DEBRK			;[34] AND GO FINISH UP

;[34] CHANNEL ONE INTERRUPT ROUTINE.  INVOKED WHEN TIMER HAS EXPIRED.

HNGCON:	BLOCK 1			;[34] CONTINUATION ADDRESS WHEN HUNG
HNGSTK:	BLOCK 1			;[34] STACK POINTER WHEN SETSPD HANGS
NCMDS:	BLOCK 1			;[34] NUMBER OF COMMANDS PROCESSED

HUNG:	HRROI T1,[ASCIZ/%SETSPD Hung on command line /]  ;[34]
	PSOUT			;[34]
	MOVEI T1,.PRIOU		;[34] OUTPUT TO PRIMARY DESIGNATOR
	MOVE T2,NCMDS		;[34] GET THE COMMAND LINE NUMBER THAT IS HUNG
	MOVEI T3,^D10		;[34] OUTPUT IN DECIMAL
	NOUT			;[34]
	 JSERR			;[34]
	HRROI T1,[ASCIZ/ - Continuing with next command...
/]				;[34]
	PSOUT			;[34] OUTPUT MORE OF MESSAGE
	MOVE T2,HNGCON		;[34] GET CONTINUATION ADDRESS
	TXO T2,UMODF		;[34] SET USER FLAG OF PC
	MOVEM T2,PCLEV2		;[34] AND CHANGE PROCESS PC TO CONTINUE
	MOVE P,HNGSTK		;[34] GET BACK LAST PRESERVED STACK
	DEBRK			;[34]
;ROUTINES FOR SCHEDULER CONTROLS

;SET BIAS-CONTROL VALUE

BIAS:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<value for bias control knob>]
	CALL CFIELD		;READ VALUE AND CONFIRMATION
	MOVE T4,T2		;COPY NUMBER
	MOVEI T1,.SKSBC		;SET BIAS CONTROL
	MOVEI T2,T3		;ARG BLOCK
	MOVEI T3,2		;LENGTH OF BLOCK
	SKED%			;SET IT
	 ERJMP [EMSG <Invalid value for bias control setting>
		JRST CMDER1]
	RET

;SET BATCH BACKGROUND

BATBGD:	CONFRM			;MAKE SURE HE MEANS IT
	MOVEI T1,.SKBBG		;GET PROPER FUNCTION
	SETZM T2		;NO ARGS
	SKED%			;SET IT
	ERCAL [	EMSG <Could not set BATCH-BACKGROUND>
		RET]
	RET
;SCHEDULER CONTROLS COMMANDS CONTINUED

;CREATE A CLASS. WILL DO NOTHING IF CLASS SCHEDULER NOW ON.

CREATE:	MOVX T1,.SKRCV		;READ CLASS PARAMETERS
	MOVEI T2,T3
	MOVEI T3,2
	SKED%			;READ OUT CLASS PARAMETERS
	ERJMP [	JSERR
		JRST CMDER1]	;ERROR OF SOME SORT
	TXNN T4,SK%STP		;NOW ON?
	JRST CMDER1		;YES. GO AWAY QUIETLY THEN

;CLASS SCHEDULING NOW OFF. SET THE CLASS SHARE

	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<class number>]
	CALL RFIELD
	MOVEM T2,CLSBLK+1	;SAVE CLASS
	MOVEI A,[FLDDB. .CMFLT,CM%SDH,,<percentage of machine to allot to class>]
	CALL CFIELD
	MOVEM T2,CLSBLK+2	;SAVE %
	MOVEI T2,CLSBLK
	MOVEI T1,.SKSCS		;PROPER FUNCTION
	SKED%			;DO IT
	ERJMP [	TMSG <
? SETSPD: Could not CREATE class: >
		JSERR
		RET]
	RET
;MORE SCHEDULER COMMANDS

;ENABLE CLASS-SCHEDULING. GOT TO HERE FROM ENABLE COMMAND

ECSKED:	MOVEI T1,.SKRCV		;READ CLASS VALUES
	MOVEI T2,T3
	MOVEI T3,2
	SKED%			;READ VALUES
	ERJMP CMDERR
	TXNN T4,SK%STP		;NOW ON?
	JRST CMDER1		;YES. SKIP IT THEN

;CLASS SCHEDULER NOW OFF.

	MOVEI A,[FLDDB. .CMKEY,,SKDOPT]
	CALL RFIELD		;GET OPTION
	HRRZ A,0(B)		;GET VALUE
	MOVX T4,SK%ACT		;ASSUME BY ACCOUNT
	SKIPE A			;IS IT?
	TXZ T4,SK%ACT		;NO
	MOVEI A,[FLDDB. .CMKEY,,SKDOP0,,<ALLOCATED>]
	CALL CFIELD		;DEFAULT TO ALLOCATED
	HRRZ A,0(B)		;GET VALUE
	SKIPE A			;WANT TO WITHHOLD?
	TXO T4,SK%WDF		;YES
	MOVEI T1,.SKICS
	MOVEI T2,T3
	MOVEI T3,2		;COUNT
	SKED%			;START UP CLASS SCHEDULER
	ERJMP [JSERR		;ERROR
		RET]
	RET

;SET BATCH CLASS

BCHCLS:	MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<class number for running all batch jobs in>]
	CALL CFIELD
	MOVE T4,T2		;COPY VALUE
	MOVEI T3,2		;ARG BLOCK
	MOVEI T1,.SKBCS		;SET BATCH CLASS
	MOVEI T2,T3		;POINT TO ARG BLOCK
	SKED%			;DO IT
	 ERJMP [EMSG <Could not set BATCH-CLASS>
		JSERR
		RET]
	RET
;ENTRY POINT FOR PROCESSING CRASH DUMPS

START3:	MOVE P,[IOWD PDLEN,PDL]	;SET UP PUSH DOWN LIST
	CALL INIT		;SET UP PSI, CAPABILITIES, ETC.
	CALL QUEBLK
	HALTF


; QUEBLK - COPY DUMP.EXE TO DUMP.CPY AND LOG ANY UNLOGGED SYSERR
;	   BLOCKS THAT WERE FOUND IN THE DUMP FILE
; RETURNS +1: ALWAYS

QUEBLK:	MOVE T1,[SIXBIT /DBUGSW/] ;CHECK ON STATE OF SYSTEM
	SYSGT			;READ DBUGSW
	SKIPE T2		;FOUND IT?
	CAIGE T1,2		;YES. IS IT STAND-ALONE?
	SKIPA			;NO. DO THE DUMP
	RET			;YES. DON'T DO ANYTHING
	TRVAR <QUEJFN,QUEFRK,QUEPGS>
	SETZ T1,		;GET A FORK TO LOAD DUMP.EXE INTO
	CFORK
	 RET			;COULD NOT GET A FORK, SO JUST EXIT
	MOVEM T1,QUEFRK		;SAVE FORK HANDLE
	MOVX T1,GJ%OLD!GJ%SHT	;GET A JFN FOR <SYSTEM>DUMP.EXE
	HRROI T2,[ASCIZ/PS:<SYSTEM>DUMP.EXE/]
	GTJFN
	 JRST QUEKFK		;NO DUMP FILE, NOTHING TO DO
	MOVEM T1,QUEJFN		;SAVE JFN
	MOVE T2,[440000,,OF%RD!OF%WR!OF%THW]
	OPENF			;OPEN THE FILE FOR READ/WRITE THAWED
	 JRST [	MOVE T1,QUEJFN	;FAILED, CLEAN UP
		RLJFN
		 JFCL
		JRST QUEKFK]
	HRLI T1,.FBPRT		;SET THE PROTECTION OF DUMP.EXE TO 770000
	MOVEI T2,-1		;RIGHT HALF PROTECTION BITS
	MOVEI T3,770000		;MUCHO PROTECTION
	CHFDB			;THIS FILE MUST BE PROTECTED FOR SECURITY
	 ERJMP .+1
	HRLZ T1,QUEJFN		;NOW MAP IN DIR PAGE
	MOVE T2,[.FHSLF,,PG0PG]
	MOVX T3,PM%RD!PM%WT	;READ AND WRITE
	PMAP
	HRRZ T1,PG0ADR		;GET LENGTH OF DIRECTORY BLOCK
	HRRZ T2,PG0ADR-2(T1)	;GET STARTING FILE PAGE # OF LAST GROUP
	HLRZ T3,PG0ADR-1(T1)	;GET HALFWORD CONTAINING REPEAT COUNT
	LSH T3,-9		;RIGHT JUSTIFY REPEAT COUNT
	ADDI T2,1(T3)		;COMPUTE # OF FILE PAGES TO MAP
	MOVEM T2,QUEPGS		;SAVE NUMBER FOR CPYDMP
	HRRZ T1,PG0ADR		;GET LENGTH OF HEADER BLOCK OF DIR
	HLRZ T2,PG0ADR(T1)	;GET CODE OF NEXT BLOCK
	CAIE T2,1775		;ENTRY VECTOR?
	JRST QUEDON		;NO, GIVE UP
	HRRZ T2,PG0ADR(T1)	;GET LENGTH
	CAIGE T2,4		;CORRECT LENGTH?
	JRST QUEDON		;NO, GIVE UP
	SKIPE PG0ADR+3(T1)	;ALREADY LOOKED AT THIS DUMP?
	JRST QUEDON		;YES, GIVE UP
	SETOM PG0ADR+3(T1)	;NO, MARK THAT WE HAVE NOW SEEN IT
	SETO T1,		;AND UNMAP THE PAGE
	MOVE T2,[.FHSLF,,PG0PG]
	SETZ T3,
	PMAP
	HRRZ T1,QUEJFN		;GET JFN OF ORIGINAL DUMP FILE
	MOVE T2,QUEPGS		;GET HIGHEST PAGE NUMBER TO COPY
	CALL CPYDMP		;GO COPY THE DUMP FILE
				;FALL THROUGH....
;THE COPY IS EITHER DONE OR HAS BEEN DELETED BECAUSE SYSTEM IS
;STAND-ALONE. PROCEED WITH QUEUEING UP THE SYSERR BLOCKS

DMPDON:				;HERE TO QUEUE UP SYSERR BLOCKS
	CALL DMPMAP		;MAP THE DUMP FILE
	 JRST QUEROR		;HANDLE ERRORS
	SETZ T1,		;WE WANT PAGE ZERO OF THE DUMP
	CALL DMPRED		;READ FROM THE DUMP
	 JRST QUEROR		;HANDLE ERRORS
	SKIPG P1,TMPADR+SEBQOU	;IS THIS ANYTHING IN THE QUEUE
	 JRST QUEDN1		;NO
QUELOP:
	MOVEI P2,0(P1)		;GET ADDRESS OF NEXT BLOCK
	ANDI P2,777		;GET LOW ORDER BITS ONLY
	MOVEI T1,0(P1)		;NOW MAP IN THE PAGE WITH THE BLOCK
	LSH T1,-PGSFT		;CONVERT TO A PAGE NUMBER
	CALL DMPRED		;READ A PAGE FROM THE DUMP
	 JRST QUEROR		;HANDLER ERRORS
	MOVEI T1,TMPADR(P2)	;GET ADDRESS OF START OF BLOCK
	LOAD T2,SEBSIZ,(T1)	;GET SIZE OF BLOCK
	ADDI T1,SEBHED		;DONT STORE HEADER
	SUBI T2,SEBHED
	SYERR			;PUT THIS BLOCK INTO ERROR LOG
	 ERJMP .+1		;IGNORE ERRORS
	HRRZ P1,TMPADR(P2)	;GET ADDRESS OF NEXT BLOCK
	JUMPN P1,QUELOP		;IF ONE THERE, GO PROCESS IT
QUEDN1:
	MOVE T1,[SIXBIT /APRID/] ;GET APRID OF PROCESSOR
	SYSGT			;TO DETERMINE KS10
	CAIG T1,^D4096		;IF GT 4096. THEN KS12
	JRST QUEDON		;NO -- DON'T NEED HSB
	SETZ T1,		;PAGE ZERO 
	CALL DMPRED		;READ IN A DUMP FILE
	 JRST QUEROR		;HANDLE ERRORS
	MOVEI T1,SEC%HS		;SET UP LOGGING CODE
	STOR T1,SEBERC
	DMOVE T1,TMPADR		;GET FIRST TWO WORDS OF DUMP (PHYSICAL 0,1
	DMOVEM T1,HS%COD+4+HSBBUF	;STORE IN BUFFER
	MOVE T1,[-HS%HSZ,,HS%HDZ]	;POINTER TO BUFFER
	MOVEM T1,HS%PTR+4+HSBBUF	;BUFFER 
	MOVE T1,[PG0ADR+HSBADR,,HSBBUF+4+HS%HDZ] ;MOVE TO BUFFER
	BLT T1,HSBBUF+4+HS%HSZ	;BLT LOW CORE DATA
	MOVEI T1,HSBBUF		;SYSERR OUTPUT BUFFER
	MOVEI T2,HS%LEN
	SYERR			;OUTPUT ERROR
	 ERJMP .+1		;IGNORE ERRORS
QUEROR:
QUEDON:	SETO T1,		;FIRST UNMAP PAGES
	MOVE T2,[.FHSLF,,PG0PG]	;DO PAGE 0
	SETZ T3,
	PMAP
	MOVE T2,[.FHSLF,,TMPPG]	;AND TEMP PAGES
	MOVX T3,PM%CNT+2
	PMAP
	MOVX T2,<.FHSLF,,MMPPG>	;AND MMAP PAGE
	SETZ T3,
	PMAP
	HRRZ T1,QUEJFN		;SEE IF THERE IS A JFN STILL AROUND
	JUMPE T1,QUEKFK
	CLOSF			;YES, CLOSE IT
	 JFCL
QUEKFK:	MOVE T1,QUEFRK		;NOW KILL THE FORK
	KFORK
	RET			;ALL DONE
	
;DMPMAP	IS THE ROUTINE TO BUILD DUMP FILE MAP, DETERMINE MMAP PAGE
;	AND READ IN MMAP PAGE

DMPMAP:
	HRRZ T1,QUEJFN		;GET THE DUMP FILE JFN
	SETZ T2,		;POINT TO THE FIRST BYTE IN THE FILE
	SFPTR			;SET FILE POINTER
	 ERJMP DMPMER		;HANDLE ERRORS
	HRRZ T1,QUEJFN		;GET THE JFN
	BIN			;GET A BYTE FROM THE FILE
	 ERJMP DMPMER		;HANDLE ERRORS
	HLRZS T2		;GET THE ENTRY CODE
	CAIE T2,1776		;IS THIS AN EXE FILE?
	 JRST DMPMBD		;NO SO THIS IS BAD
DMPMLP:				;THIS IS THE MAPPING LOOP
	HRRZ T1,QUEJFN		;GET THE JFN
	BIN			;GET THE NEXT WORD
	 ERJMP DMPMER		;HANDLE ERROR
	MOVE P1,T2		;SAVE THE FIRST WORD
	HLRZS T2		;ZERO THE LEFT HALF
	CAIE T2,1775		;ENTRY VECTOR?
	 CAIN T1,1777		;END OF DIRECTORY?
	  JRST DMPMDN		;YES SO MAPPING PROCESS IS DONE
	BIN			;NOT END SO GET SECOND WORD OF GROUP
	 ERJMP DMPMER		;HANDLE ERRORS
	MOVE P2,T2		;SAVE THE SECOND WORD
	LDB T1,[POINT 27,P1,35]	;GET THE FILE PAGE NUMBER
	LDB T2,[POINT 27,P2,35]	;GET THE CORE PAGE NUMBER
	LDB T3,[POINT 9,P2,8]	;GET THE REPEAT COUNT
DMPML2:				;INNER PAGE MAP LOOP
	MOVEM T1,MAPADR(T2)	;SAVE THE PAGE NUMBER IN MAP
	MOVEM T2,PAGMAX		;SAVE THE MAX PAGE NUMBER
	AOJ T1,			;BUMP FILE PAGE
	AOJ T2,			;BUMP CORE PAGE
	SOJGE T3,DMPML2		;LOOP FOR THE REPEAT COUNT
	JRST DMPMLP		;DONE WITH THIS GROUP SO GET NEXT
DMPMDN:				;HERE WHEN MAPPING IS DONE
	HRRZ T1,QUEJFN		;GET THE JFN
	MOVE T3,MAPADR		;GET THE FILE PAGE FOR PAGE 0
	LSH T3,PGSFT		;MAKE IT AN ADDRESS
	ADDI T3,MMAPWD		;WE WANT THE MMAP POINTER WORD
	RIN			;GET THE MMAP POINTER WORD
	 ERJMP DMPMER		;HANDLE ERRORS
	SKIPG T2		;ANYTHING THERE?
	 JRST DMPMBD		;NO SO BAD DUMP
	LSH T2,-PGSFT		;MAKE IT A PAGE NUMBER
	SKIPN T1,MAPADR(T2)	;GET THE FILE PAGE OF MMAP PAGE
	 JRST DMPMBD		;BAD EXE FILE IF NO PAGE
	HRL T1,QUEJFN		;GET THE JFN
	MOVX T2,<.FHSLF,,MMPPG>	;PUT THE PAGE AT THE MMAP PAGE
	MOVX T3,<PM%RD>		;WE ONLY WANT TO READ THIS PAGE
	PMAP			;MAP IN THE PAGE
	 ERJMP DMPMER		;HANDLE ERROR
	AOS (P)			;BUMP THE RETURN ADDRESS
DMPMER:				;HERE ON ERROR DURING MAPPING
DMPMBD:				;HERE ON BAD EXE FILEE DIRECTORY
	RET			;RETURN TO CALLER
;DMPRED	IS THE ROUTINE TO MAP PAGES FROM CRASHED MONITOR VIRTUAL 
;	ADDRESS SPACE

DMPRED:				;ROUTINE TO MAP DUMP PAGES
				;T1/ PAGE NUMBER OF MONITOR
	STKVAR <MPAGE>
	MOVEM T1,MPAGE		;SAVE THE MONITOR PAGE NUMBER
	SETO T1,		;UNMAP FUNCTION
	MOVX T2,<.FHSLF,,TMPPG>	;TEMP PAGE ONE
	MOVX T3,<PM%CNT!<2>B35>	;UNMAP TWO PAGES
	PMAP			;UNMAP IO PAGES
	 ERJMP .+1		;IGNORE ERRROS
	MOVE T1,MPAGE		;GET THE MONITOR PAGE NUMBER
	MOVEI T2,TMPPG		;GET THE PAGE TO TARGET PAGE
	CALL DMPRD2		;CALL THE WORKER ROUTINE
	 JRST DMPRDB		;BAD EXE FILE RETURN
	MOVE T1,MPAGE		;GET THE MONITOR PAGE AGAIN
	ADDI T1,1		;WE WANT THE NEXT PAGE 
	MOVEI T2,TMPPG+1	;MAP THE PAGE TO THE NEXT TARGET PAGE
	CALL DMPRD2		;CALL THE WORKER ROUTINE
	 JFCL			;ERROR IS OK
	AOS (P)			;BUMP THE RETURN PC
DMPRDB:				;BAD EXE FILE RETURN
	RET			;RETURN TO CALLER

DMPRD2:				;WORKER ROUTINE FOR DMPRED
	LDB T3,[POINT 3,MMPADR(T1),2] ;GET THE POINTER TYPE FOR PAGE
	CAIE T3,1		;IMMEDIATE?
	 RET			;NO SO LOSE
	HRRZ T1,MMPADR(T1)	;GET THE PHYSICAL PAGE NUMBER
	CAMLE T1,PAGMAX		;IS IT A LEGAL PAGE?
	 RET			;NO SO ERROR RETURN
	SKIPN T1,MAPADR(T1)	;GET THE FILE PAGE NUMBER
	 RET			;IF ZERO THEN ERROR RETURN
	HRL T1,QUEJFN		;GET THE DUMP FILE JFN
	HRLI T2,.FHSLF		;THIS FORK
	PMAP			;MAP THE PAGE
	 ERJMP [RET]		;HANDLE ERROR
	AOS (P)			;BUMP THE RETURN PC
	RET			;RETURN TO CALLER WITH SUCCESS
;CPYDMP - ROUTINE TO COPY <SYSTEM>DUMP.EXE TO <SYSTEM>DUMP.CPY
;
;ACCEPTS IN T1/	JFN OF ORIGINAL DUMP FILE
;	    T2/	# OF FILE PAGES TO COPY
;		CALL CPYDMP
;RETURNS: +1 ALWAYS



CPYDMP:	STKVAR <DMPJFN,DMPCNT,CPYJFN,CPYSIZ>
	MOVEM T1,DMPJFN		;SAVE JFN OF ORIGINAL DUMP FILE
	MOVEM T2,DMPCNT		;SAVE # OF FILE PAGES TO COPY
	IMULI T2,1000		;COMPUTE # OF WORDS TO BE COPIED
	SUBI T2,1		;COMPUTE # OF LAST WORD IN COPY FILE
	MOVEM T2,CPYSIZ		;SAVE # OF WORDS IN FILE
	MOVX T1,GJ%FOU!GJ%SHT	;GET A JFN TO MAKE THE COPY
	HRROI T2,[ASCIZ /PS:<SYSTEM>DUMP.CPY;P770000/]
	GTJFN			;GET IT
DMPERR:	 JRST [	HRROI T1,[ASCIZ /
? SETSPD: Failed to copy dump file because:
/]
		PSOUT
		MOVEI T1,.PRIOU	;THE DESTINATION
		HRLOI T2,.FHSLF	;US
		ERSTR		;OUTPUT THE ERROR
		 JFCL
		 JFCL
		CALL UMPPGS	;UNMAP DUMP PAGES
		RET]		;RETURN
	MOVEM T1,CPYJFN		;SAVE JFN OF DUMP.CPY
	MOVE T2,[440000,,OF%RD+OF%WR]
	OPENF			;OPEN THE COPY FILE
	 JRST DMPERR		;FAILED
	HRLI T1,.FBBYV		;CHANGE PROPER WORD
	MOVX T2,FB%RET		;SET THE RETENTION COUNT
	SETZ T3,		; TO INFINITY
	CHFDB			;DO IT
	ERJMP .+1		;IGNORE ANY ERRORS
	HRROI T1,[ASCIZ /
COPYING PREVIOUS SYSTEM DUMP TO:
/]
	PSOUT
	MOVEI T1,.PRIOU
	MOVE T2,CPYJFN		;GET JFN OF DUMP.CPY FILE
	SETZ T3,		;USE DEFAULT
	JFNS			;OUTPUT THE THE FILE NAME
	; ..
	; ..

; SET UP TO COPY THE FILE

	SETZM T4		;START WITH FILE PAGE 0
CPYD10:	MOVE T1,DMPCNT		;GET # OF PAGES TO COPY
	JUMPLE T1,CPYD20	;IF DONE, GO UNMAP THE PAGES
	SUBI T1,CPYPGS		;COMPUTE # OF PAGES LEFT TO COPY
	MOVEM T1,DMPCNT		;SAVE NEW # OF PAGES TO COPY
	HRL T1,DMPJFN		;GET JFN OF ORIGINAL DUMP FILE
	HRR T1,T4		;GET FILE PAGE NUMBER
	MOVE T2,[.FHSLF,,DMPPG]	;THIS FORK, FIRST PAGE TO MAP DUMP FILE
	MOVEI T3,CPYPGS		;GET # OF PAGES TO MAP
	SKIPGE DMPCNT		;NEED TO MAP LESS THAN THIS MANY ?
	ADD T3,DMPCNT		;YES, COMPUTE # REMAINING TO BE MAPPED
	TXO T3,PM%RD+PM%WR+PM%PLD+PM%CNT
	PMAP			;MAP THE PAGES FROM THE ORIGINAL FILE
	 ERJMP DMPERR		;JUST IN CASE
	HRL T1,CPYJFN		;GET JFN OF COPY FILE
	HRR T1,T4		;GET FILE PAGE NUMBER
	MOVE T2,[.FHSLF,,CPYPG]	;THIS FORK, FIRST PAGE OF COPY FILE DATA
	TXZ T3,PM%PLD		;NO PRE-LOADING
	PMAP			;MAP THE COPY FILE
	 ERJMP DMPERR		;JUST IN CASE
	MOVE T1,[DMPADR,,CPYADR] ;SET UP TO COPY DATA
	BLT T1,CPYADR+CPYWDS-1	;COPY DATA
	ERJMP DMPERR		;IN CASE DISK IS FULL.
	ADDI T4,CPYPGS		;COMPUTE ADDRESS OF NEXT FILE PAGE
	JRST CPYD10		;LOOP OVER ALL PAGES TO COPY

; HERE WHEN COPY IS COMPLETE

CPYD20:	CALL UMPPGS		;UNMAP DUMP PAGES
	HRRZ T1,CPYJFN		;GET JFN OF NEW FILE
	HRLI T1,.FBSIZ		;GET OFFSET TO EOF POINTER
	SETOM T2		;CHANGE ALL BITS IN THE WORD
	MOVE T3,CPYSIZ		;GET # OF LAST WORD IN FILE
	CHFDB			;SET THE EOF POINTER
	HRRZ T1,CPYJFN		;GET JFN OF COPY FILE
	CLOSF			;CLOSE NEW FILE
	 JRST DMPERR		;FAILED, REPORT ERROR
	RET			;RETURN
;COPY DUMP CONTINUED....

;ROUTINE TO UNMAP DUMP PAGES ON NORMAL COMPLETION OR ERROR

UMPPGS:	SETOM T1		;UNMAP THE PAGES
	MOVE T2,[.FHSLF,,DMPPG]	;PAGES MAPPED TO ORIGINAL FILE
	MOVE T3,[PM%CNT+CPYPGS]	;NUMBER OF PAGES TO UNMAP
	PMAP			;UNMAP THE PAGES
	MOVE T2,[.FHSLF,,CPYPG]	;PAGES MAPPED TO COPY FILE
	PMAP			;UNMAP THE PAGES
	RET			;AND DONE

;ROUTINES TO BUFFER A STRING.  GIVE IT POINTER TO STRING IN A.
;ROUTINE RETURNS POINTER TO BUFFERED STRING IN A.
;THE STRING ALWAYS BEGINS ON A WORD BOUNDARY.  (SOME CALLERS ASSUME SO!)

BUFFS:	MOVEI B,DICT		;SAY WHERE POOL STARTS
	CALL READNM		;COPY STRING INTO FREE SPACE
	 COMERR <String space exhausted>
	RET

;BUFFF buffers the atom buffer
;
;Returns +1:	A/	pointer to buffered atom

BUFFF:	HRROI A,ATMBUF		;POINT TO THE ATOM
	CALLRET BUFFS		;BUFFER IT AND RETURN

;ROUTINE TAKING A STRING POINTER IN A.  IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A.  IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
;GIVE IT FREE POOL HEADER ADDRESS IN B

READNM:	STKVAR <FPA,RPTR,NEWPTR>
	MOVEM A,RPTR		;REMEMBER POINTER
	MOVEM B,FPA		;REMEMBER FREE POOL ADDRESS
	CALL BCOUNT		;HOW MANY WORDS IN THIS STRING?
	MOVE B,FPA		;SAY WHICH FREE POOL TO USE
	CALL GETMEM		;GET THAT MANY
	 JRST NOREAD		;COULDN'T, SO TAKE NON-SKIP RETURN
	HRLI B,440700		;MAKE BYTE POINTER TO SPACE OBTAINED
	MOVEM B,NEWPTR		;REMEMBER NEW POINTER
	MOVE A,B
	MOVE B,RPTR		;GET POINTER TO STRING
	MOVEI C,0		;STORE NULL AT END OF STRING
	SOUT			;COPY THE STRING
	MOVE A,NEWPTR		;GET ADDRESS WHERE STRING GOT PUT
	RETSKP			;SUCCESFUL RETURN
NOREAD:	RET			;NO ROOM FOR STRING

;ROUTINE TO GET MEMORY BLOCK.  RETURNS +1 ALWAYS WITH ADDRESS OF BLOCK
;IN A.  GIVE IT NUMBER OF WORDS DESIRED IN A.

GETBUF:	MOVEI B,DICT	;USE CORRECT POOL
	CALL GETMEM	;GET THE MEMORY
	 ERROR <SETSPD: free space exhausted>
	MOVE A,B		;RETURN ADDRESS IN A
	RET

; /GETMEM/ - ROUTINE TO ASSIGN MEMORY AS REQUESTED
; INPUTS:	A - CONTAINS NUMBER OF WORDS WANTED
;		B - FREE SPACE HEADER ADDRESS
; OUTPUTS:	A - NUMBER OF WORDS OBTAINED
;		B - CONTAINS ADDRESS OF WORDS GOTTEN
; RETURNS:	SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM

GETMEM:	STKVAR <<SAVSTF,2>,DADR>
	MOVEM B,DADR		;REMEMBER HEADER ADDRESS
GETM2:	MOVE C,B			;REMEMBER WHO POINTS TO CURRENT
	HRRZ B,0(C)		;B IS NOW CURRENT BLOCK
	JUMPE B,R			;IF 0, WE HAVE REACHED END OF THE ROAD
	HLRZ D,0(B)		;GET SIZE OF CURRENT BLOCK
	CAMGE D,A			;IS IT SUFFICIENT FOR REQUEST?
	JRST GETM2			;NO, SO TRY NEXT BLOCK
GETM3:	HRL B,0(B)		;GET LINK OF CURRENT BLOCK
	HLRM B,0(C)		;MAKE PREV LINK BE WHAT WAS OUR LINK
	HRRZS B			;ISOLATE CURRENT BLOCKS ADDRESS
	CAMN D,A			;IS THIS AN EXACT MATCH ON SIZE?
	RETSKP				;SUCCESS, SKIP RETURN
	DMOVEM A,SAVSTF		;SAVE NUMBER OF WORDS AND ADDRESS
	ADD B,A			;GET FIRST WORD TO RETURN
	SUBM D,A			;NUMBER OF WORDS TO RETURN
	MOVE C,DADR		;GET ADDRESS OF CONTROL WORD
	CALL RETMEM		;RETURN THE EXTRA WORDS
	DMOVE A,SAVSTF		;RESTORE NUMBER OF WORDS AND ADDRESS
	RETSKP				;SUCCESS, SKIP RETURN

;STREM ROUTINE TAKES POINTER TO STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE.  THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE

STREM:	SAVEAC <A,B,C,D>	; NEED TO BE TRANSPARENT
	STKVAR <SPT000>
	MOVEM A,SPT000		;REMEMBER POINTER
	CALL BCOUNT		;COUNT NUMBER OF WORDS IN THE STRING
	HRRZ B,SPT000		;GET RID OF BYTE POINTER P AND S
	CALLRET RETBUF		;RETURN THE BUFFER

;RETBUF RETURNS A BUFFER TO FREE STORAGE
;	A/	SIZE BEING RETURNED
;	B/	ADDRESS OF BLOCK BEING RETURNED

RETBUF:	MOVEI C,DICT		;SAY WHERE FREE SPACE IS
	CALLRET RETMEM		;RETURN THE SPACE TO THE FREE POOL

; /RETMEM/ - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
; INPUT:	A - CONTAINS SIZE OF BLOCK TO RETURN
;		B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
;		C - FREE SPACE HEADER ADDRESS
; OUTPUT:	NONE
; RETURNS: ALWAYS CPOPJ
;

RETMEM:	HRRZ D,0(C)		;GET PREV'S LINK
	SKIPE	D			;IF CURRENT IS 0 OR
	CAIL D,0(B)		;  ITS ADDRESS IS PAST ADDR OF RETURN BLK
	JRST RETM4			; THEN RETURN BLOCK HERE
	MOVE C,D			;MAKE PREV=CURRENT
	JRST RETMEM			;CONTINUE

RETM4:	HRRM D,0(B)		;FORWARD PTR OF RETURNED BLOCK
	HRRM B,0(C)		;FORWARD PTR OF PREV BLOCK
	HRLM A,0(B)		;STORE SIZE OF THIS BLOCK
	ADD A,B			;ADD ADDR+SIZE
	CAIE A,0(D)		;ARE WE RIGHT UP AGAINST NEXT BLOCK?
	JRST RETM5			;NO, CANT COMBINE
	HRRZ A,0(D)		;GET NEXT GUYS FORWARD LINK
	HRRM A,0(B)		;MAKE IT OURS. IE POINT PAST HIM
	HLRZ A,0(B)		;GET OUR SIZE
	HLRZ D,0(D)		;GET HIS SIZE
	ADD A,D			;GET OUR NEW COMBINED SIZE
	HRLM A,0(B)		;STORE INTO RETURNED BLOCK
	HRRZ D,0(B)		;GET LINK OF CURRENT BLOCK
RETM5:	HLRZ A,0(C)		;GET PREV BLOCKS SIZE
	ADDI A,0(C)		;ADD HIS ADDRESS AND SIZE
	CAIE A,0(B)		;DOES HE BUTT RIGHT UP AGAINST US?
	RET			;NO, RETURN WITH NO COMBINATION
	HRRM D,0(C)		;MAKE PREV POINT TO OUR NEXT
	HLRZ A,0(C)		;GET HIS SIZE
	HLRZ B,0(B)		;AND OUR SIZE
	ADD A,B			;COMBINE THE SIZES
	HRLM A,0(C)		;STORE COMBINED SIZE
	RET			;RETURN

;ROUTINE TO INITIALIZE FREE SPACE STORAGE.

FREINI:	SETZM DICT		;INITIALIZE FREE SPACE SYSTEM
	MOVEI A,FRESIZ		;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
	MOVEI B,FREE		;STARTS AT ADDRESS IN B
	CALL RETBUF		;FREE IT UP IN STANDARD WAY
	MOVEI A,STRSIZ		;ALLOCATE SOME SPACE FOR STRINGS
	CALL GETBUF
	HRLI A,440700		;MAKE POINTER TO STRING STORAGE
	MOVEM A,CSBUFP		;REMEMBER POINTER TO STRING STORAGE
	RET

;FIXPT changes byte pointer with -1 in left half to have 440700 in left half.
;
;Accepts:	A/	pointer
;
;Returns+1:	A/	converted pointer

FIXPT:	TLC A,-1		;CHANGE -1 TO 0
	TLCN A,-1		;RESTORE BITS AND SKIP IF ANY ARE NOW ON
	HRLI A,440700		;THEY WERE ALL OFF SO MUST HAVE BEEN ALL ON
	RET

;BCOUNT MEASURES AN ASCIZ STRING.
;
;ACCEPTS:	A/	POINTER (-1,,FOO O.K.!)
;
;RETURNS+1:	A/	NUMBER OF WORDS NEEDED IN A
;		B/	NUMBER OF CHARACTERS

BCOUNT:	CALL FIXPT		;CHANGE -1 TO 440700
	MOVEI B,0		;B WILL ACCUMULATE COUNT OF BYTES
BC1:	ILDB C,A		;READ NEXT BYTE
	CAIE C,0		;DONE COUNTING IF NULL SEEN
	AOJA B,BC1		;NOT DONE, KEEP COUNTING
	MOVE D,B		;REMEMBER EXACT COUNT IN D
	AOJ B,			;LEAVE ROOM FOR NULL
	IDIVI B,5		;GET NUMBER OF WORDS
	CAIE C,0		;EXTRA CHARACTERS?
	AOJ B,			;YES, THEY TAKE A WHOLE WORD
	MOVE A,B
	MOVE B,D		;RETURN BYTE COUNT IN B
	RET
; CACHE REFILL ALGORITHM RAM LOADING INSTRUCTIONS
; *** CURRENTLY PERFORMS NO FUNCTION ***

	REPEAT 0,<		;DISABLE THIS CODE
REFILL:
	USRIO			;TURN ON USER IOT
	 RET			;FAILED
	BLKO APR,0
	BLKO APR,100004
	BLKO APR,200010
	BLKO APR,300014
	BLKO APR,400020
	BLKO APR,500024
	BLKO APR,600030
	BLKO APR,700034
	BLKO APR,300040
	BLKO APR,100044
	BLKO APR,200050
	BLKO APR,300054
	BLKO APR,200060
	BLKO APR,100064
	BLKO APR,200070
	BLKO APR,300074
	BLKO APR,700100
	BLKO APR,100104
	BLKO APR,200110
	BLKO APR,700114
	BLKO APR,100120
	BLKO APR,100124
	BLKO APR,200130
	BLKO APR,700134
	BLKO APR,600140
	BLKO APR,500144
	BLKO APR,600150
	BLKO APR,700154
	BLKO APR,500160
	BLKO APR,500164
	BLKO APR,600170
	BLKO APR,700174
	BLKO APR,000200
	BLKO APR,300204
	BLKO APR,200210
	BLKO APR,300214
	BLKO APR,000220
	BLKO APR,200224
	BLKO APR,200230
	BLKO APR,300234
	BLKO APR,000240
	BLKO APR,100244
	BLKO APR,200250
	BLKO APR,300254
	BLKO APR,400260
	BLKO APR,500264
	BLKO APR,600270
	BLKO APR,700274
	BLKO APR,000300
	BLKO APR,700304
	BLKO APR,700310
	BLKO APR,700314
	BLKO APR,000320
	BLKO APR,000324
	BLKO APR,000330
	BLKO APR,700334
	BLKO APR,400340
	BLKO APR,600344
	BLKO APR,600350
	BLKO APR,600354
	BLKO APR,400360
	BLKO APR,400364
	BLKO APR,600370
	BLKO APR,400374
	BLKO APR,300400
	BLKO APR,100404
	BLKO APR,300410
	BLKO APR,300414
	BLKO APR,100420
	BLKO APR,100424
	BLKO APR,100430
	BLKO APR,300434
	BLKO APR,000440
	BLKO APR,700444
	BLKO APR,700450
	BLKO APR,700454
	BLKO APR,000460
	BLKO APR,000464
	BLKO APR,000470
	BLKO APR,700474
	BLKO APR,000500
	BLKO APR,100504
	BLKO APR,200510
	BLKO APR,300514
	BLKO APR,400520
	BLKO APR,500524
	BLKO APR,600530
	BLKO APR,700534
	BLKO APR,400540
	BLKO APR,500544
	BLKO APR,500550
	BLKO APR,700554
	BLKO APR,400560
	BLKO APR,500564
	BLKO APR,400570
	BLKO APR,700574
	BLKO APR,000600
	BLKO APR,100604
	BLKO APR,200610
	BLKO APR,200614
	BLKO APR,000620
	BLKO APR,100624
	BLKO APR,200630
	BLKO APR,100634
	BLKO APR,000640
	BLKO APR,500644
	BLKO APR,600650
	BLKO APR,600654
	BLKO APR,000660
	BLKO APR,500664
	BLKO APR,600670
	BLKO APR,000674
	BLKO APR,400700
	BLKO APR,500704
	BLKO APR,600710
	BLKO APR,500714
	BLKO APR,400720
	BLKO APR,500724
	BLKO APR,600730
	BLKO APR,400734
	BLKO APR,000740
	BLKO APR,100744
	BLKO APR,200750
	BLKO APR,300754
	BLKO APR,400760
	BLKO APR,500764
	BLKO APR,600770
	BLKO APR,700774
	RET			;AND DONE
>				;END OF REPEAT ZERO
	END <ENVLEN,,ENTVEC>