	.TITLE *** COPYRIGHT ***

/

/COPYRIGHT (C) 1976

/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

/

/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY

/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH

/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS

/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-

/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON

/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO

/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE

/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.

/

/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE

/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-

/MITMENT BY DIGITAL EQUIPMENT CORPORATION.

/

/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY

/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.

	.TITLE *** EXECUTE COMMAND PROCESSOR PART 1 ***

 

/ THIS CODE AND IT'S COMPANION MODULE (XQT2) PROCESS THE TDV

/ XQT COMMAND. THIS COMMAND IS OF THE FORM:

/

/	XQT TSKNAM (LUN)

/

/ IF NO LUN FIELD IS ASSIGNED THEN VIRTUAL LUN 14 (10) IS ASSUMED.

/ THIS CODE CONSTRUCTS A DEFERED ALIAS EXECUTE DIRECTIVE AND ISSUES

/ IT. XQT2 WILL PERFORM THE REMAINING PROCESSING.

/

/ UPON EXIT THE U.CPB FIELD OF THE UCA WILL CONTAIN THE FOLLOWING

/ INFORMATION FOR USE BY XQT2:

/
/ U.CPB		34		CAL REQUEST CODE.

/ U.CPB+1	EVA		MARK TIME EVENT VARIABLE ADDRESS.
/ U.CPB+2	TSK NAME	FIRST HALF OF THE INPUT FILE NAME.

/ U.CPB+3	TSK NAME	SECOND HALF OF THE INPUT FILE NAME.

/ U.CPB+4	280 (10)	MULTIACCESS USER TASK PRIORITY

/ U.CPB+5	FLAGS+LUN

/ U.CPB+6	MULTI ACCESS EVENT VARIABLE ADDRESS

/ U.CPB+7	UNUSED

/ U.CPB+10	.SIXBT "USR"

/ U.CPB+11	.SIXBT ".NN"	WHERE NN IS THE TERMINAL NUMBER.

/

/ U.CTSK AND U.CTSK+1 WILL CONTAIN THE TSK NAME PORTION OF THE XQT

/ COMMAND.
	.TITLE *** EDIT LEGEND AND ASSEMBLY PARAMETERS ***
 
/ 001	05-MAY-76 (RCHM)	MAKE THE CORRECT LUN TEST.	/(001)
/
/ 002	12-AUG-76 (EAG)		IGNORE TRAILING SPACES.		/(002)
/ 003	16-AUG-76 (RCHM)	FIX PROBLEM WITH THE FACT THAT	/(003)
/				THE XQT DIRECTIVE DOESN'T REMOVE/(003)
/				IT'S NODE ON A REQUEST ERROR.	/(003)
/
/ 004	24 OCT 77 (PDH)		CHANGE DEFAULT INPUT LUN TO 17	/(004)
/
 
	.IFUND MA.NLU
MA.NLU=31		/ 25 LUNS BY DEFAULT.
	.ENDC
ILUN=17			/ DEFAULT 'IMG' INPUT LUN		(004)
	.TITLE *** MACROS FOR EXECUTE COMMAND PROCESSOR ***

 

/ MACRO TO RETURN INCREMENTAL RETURN CODE. IF THE RETURN IS AN ERROR

/ THEN THE ARGUMENT TO THE MACRO MUST BE A "-" OTHERWISE IT MUST
/ BE A "+". THIS MACRO MUST BE READ AT BOTH PASS1 AND PASS2 TO WORK

/ PROPERLY.

 

	.DEFIN POSTEV,A

RT.CTR=0

	.DEFIN POSTEV,AA

RT.CTR=RT.CTR+1		/ INCREMENT RETURN COUNTER.

	LAC (AA@RT.CTR)	/ FETCH + OR - RETURN CODE.

	DAC U.OEV,X	/ POST OVERLAY EVENT VARIABLE.

	.ENDM

	POSTEV A

	.ENDM

/
/ MACRO TO DEFINE OFFSETS INTO THE USER CONTEXT AREA.

/

	.DEFIN UCAOFF

U.JSW=0				/OFFSET TO JOB STATUS WORD.

U.MAEV=1			/OFFSET TO EVENT VARIABLE

U.MAMTE=2			/OFFSET TO MARK TIME EVENT VARIABLE.

U.OEV=3				/OFFSET TO OVERLAY EVENT VARIABLE.

U.DSK=4				/OFFSET TO DISK NAME

U.DUN=5				/OFFSET TO DISK UNIT NUMBER

U.UFD=6				/OFFSET TO UFD NAME.

U.CTSK=7			/OFFSET TO CURRENT TASK NAME

U.PSC=11			/OFFSET TO PARTITION SELECTION CRITERIA.

U.ULOF=14			/OFFSET TO USER NUMBER AND LUN OFFSET.

U.TTYN=15			/OFFSET TO USER TERMINAL NUMBER.

U.TB=16				/OFFSET TO USER TERMINAL BUFFER.

U.CPB=62			/OFFSET TO MULTI-ACCESS CPB.

U.SSM=74			/SECONDS SINCE MIDNIGHT INTO STATE 11

				/ OR 12 (HUNG ON PARTITION)

U.TW=75				/TOTAL TIME IN SECONDS SPENT IN STATE 11

				/ OR 12.

U.OVID=76			/OVERLAY IDENTIFIER (LAST OVERLAY CALLED)

U.CKS=77			/CHECKSUM OF INPUT BUFFER FOR TIMED READ.

U.LEN=100			/LENGTH OF UCA.

	.DEFIN UCAOFF

	.ENDM

	.ENDM

/

/ MACRO WHICH DEFINES SYSTEM TASK LIST ENTRIES

/ THIS ALSO DEFINES ALL BITS FOR EACH FLAG WORD.

/

	.DEFIN STLOFF

S.FP=0			/FORWARD LINKAGE.

S.BP=1				/BACKWARD LINKAGE.

S.N1=2				/TASK NAME

S.N2=3				/TASK NAME

S.DP=4				/FLAGS AND DEFAULT PRIORITY.

S.PB=5				/PARTITION BLOCK ADDRESS

S.DA=6				/DISK ADDRESS AND UNIT.

S.DB=7				/RESIDENT CODE LENGTH (DISK TRANSFER)

S.TS=10				/TASK SIZE.

S.EP=11				/TASK ENTRY POINT.

/

/ DEFINE S.DP BIT EXTRACTION MASKS.

/

S.ETA=400000			/EXTRACT TASK ACTIVE

S.EROX=200000			/EXTRACT REMOVE ON EXIT.

S.ETDI=100000			/EXTRACT TASK DISABLED.

S.EFIX=40000			/EXTRACT TASK FIXED IN CORE.

S.EPLC=20000			/EXTRACT PARTITION LOST IN RECONFIG.

S.ERCP=10000			/EXTRACT RECONFIGURATION IN PROGRESS.

S.ETEX=4000			/EXTRACT TASK HAS EXITTED.

S.EDP=1777			/EXTRACT DEFAULT PRIORITY.

/

/ DEFINE S.TS BIT EXTRACTION MASKS.

/

S.ETS=777400			/EXTRACT TASK SIZE.

S.ERD=200			/EXTRACT RELOCATE DISABLE.

S.EXM=140			/EXTRACT XVM MODE.

S.EIOT=20			/EXTRACT IOT PERMISSION.

/

/ DEFINE S.EP BIT EXTRACTION MASKS.

/

S.ELC=400000			/EXTRACT LINK CONTENTS.

S.EPB=200000			/EXTRACT PAGE/BANK INDICATOR.

S.EEN=100000			/EXTRACT EXEC/NORMAL MODE.

S.EEP=77777			/EXTRACT ENTRY POINT ADDRESS.

	.DEFIN STLOFF

	.ENDM

	.ENDM

 

	.DEFINE TEXT,A,?B

	B-./2*1000+2

	0
	.ASCII "A"<15>
B=.

	.ENDM

	.TITLE *** EQUATES FOR EXECUTE COMMAND PROCESSOR ***

OVID=302161

USR=252322

IDX=ISZ
X10=10
CALX=10000

...=565656

	UCAOFF

	STLOFF
	.TITLE *** VARIABLES AND STORATE FOR EXECUTE COMMAND PROC ***
 
	.DBREL

 

/ GLOBALS FOR XQT PART 1.

 

	.GLOBL XQT1

	.GLOBL TDVTYP

 

UCAADR	0		/ ADDRESS OF THE USER CONTEXT AREA.

XR.ADJ	0		/ INDEXING FUDGE FACTOR.

TTYN	0		/ USER TERMINAL NUMBER FOR ERROR MESSAGES

SAVAC	0		/ FOR NUMBER

COUNT	0		/ FOR NUMBER

NUMFLG	0		/ FOR NUMBER

NUM	0

NUMT	0

CHAR	0

TABLE	.BLOCK 6

 

MSG1	TEXT <XQT -- SYNTAX ERROR>
MSG2	TEXT <XQT -- ILLEGAL LUN NUMBER>
MSG3	TEXT <XQT -- ATTEMPT TO XQT SYSTEM COMPONENT>

	.TITLE *** CODE FOR EXECUTE COMMAND PROCESSOR ***

 
XQT1	XX		/ ENTRY POINT.

	DAC UCAADR	/ SAVE THE UCA ADDRESS.

 

	LAC (.)		/ SET UP THE INDEXING FUDGE FACTOR.

	AND (70000)

	CMA!IAC

	DAC XR.ADJ

 

	LAC UCAADR	/ FETCH THE UCA ADDRESS.

	JMS SETXR	/ SET UP TO ACCESS THE UCA.

	LAC (OVID)	/ INITIALIZE THE OVERLAY ID NAME.

	DAC U.OVID,X

	LAC U.TTYN,X	/ FETCH TTY NUMBER IN CASE OF ERRORS.

	DAC TTYN
	LRSS 3		/ BUILD ALIAS NAME FOR THIS TASK.

	ALS 3

	LLS 3

	XOR (566060)	/ AC = .NN FOR THIS TASK.

	DAC U.CPB+11,X	/ .NN IN ALIAS FIELD.

	LAC (USR)	/ FETCH "USR"

	DAC U.CPB+10,X	/ "USR" IN ALIAS FIELD.

	LAC UCAADR	/ INITIALIZE CHARACTER FETCHING ROUTINE.

	AAC U.TB+2	/ POINT TO FIRST WORD OF MESSAGE.

	DAC FACLBX

	LAC (FACCB+5)	/ SET UP FIRST ACCESS TO CHARACTER BUFFER.

	DAC FACCBX

	LAC (3)		/ FETCH RETURN CODE FOR NORMAL EXIT.

	DAC U.JSW,X

 
/ SCAN THE BUFFER FOR A BLANK AND EXTRACT THE TASK NAME.

 

	JMS BLSCAN	/ SCAN FOR BLANKS.
	JMP ERR1	/ CR OR AM FOUND.
	CLA		/ SET FLAG IN AC TO EXTRACT TASK NAME.
	JMS NAME	/ FETCH TASK NAME.
	JMP ERR1	/ ERROR RETURN (SYNTAX ERROR)
	SAD (...)	/ IF THIS COULD BE A SYSTEM TASK, REJECT
	JMP ERR3	/ THE COMMAND.

	DAC U.CPB+2,X	/ BUILD XQT REQUEST IN UCA CPB AREA.

	DAC U.CTSK,X	/ TASK NAME IN CURRENT TASK AREA.

	LACQ		/ FETCH SECOND HALF OF NAME.

	SAD (...)	/ AS ABOVE.

	JMP ERR1	/ REJECT THE COMMAND.

	DAC U.CPB+3,X

	DAC U.CTSK+1,X

 
/ SET UP THE LUN TO BE ACCESSED.
 
	LAC	(ILUN	/ DEFAULT LUN IS LUN 17 (10)		/(004)
	DAC U.CPB+5,X
	PLA		/ FETCH BREAK CHARACTER.
	SKP		/ DON'T FETCH CHARACTER FIRST TIME.	/(002)
X.0005	JMS FAC		/ SCAN OFF BLANKS.			/(002)
	SAD (40)	/ IS CHARACTER A BLANK?			/(002)
	JMP X.0005	/ YES -- SCAN IT OFF.			/(002)

	JMS TERM	/ CHECK FOR CR OR AM.
	SKP		/ SHOULD BE DIGIT.			/(002)

	JMP X.0010	/ FINISH THE CPB AND ISSUE IT.
	JMS NUMBER	/ EXTRACT LUN NUMBER FROM INPUT BUFFER.
	JMP ERR1	/ SYNTAX ERROR.

	LACQ		/ FETCH LUN NUMBER.

	DAC U.CPB+5,X	/ SAVE LUN NUMBER.
	AAC -1		/ CHECK FOR LUN 1 OR 0.

	SPA!SNA		/ AC > 0 IF THE LUN IS OK.
	JMP ERR2	/ ILLEGAL LUN NUMBER.
	AAC 1-MA.NLU	/ CHECK TO SEE IF IT IS TOO BIG.	/(001)

	SMA!SZA		/ AC <= 0 IF THIS IS OK.

	JMP ERR2	/ ILLEGAL LUN NUMBER.

 
/ TASK NAME AND LUN HAVE BEEN ALL SET UP FINISH THE CPB FOR THE XQT

/ CAL.

 
X.0010	LAC U.ULOF,X	/ SET UP ACCESS TO THE RIGHT LUN.
	AND (777000)	/ EXTRACT LUN OFFSET FROM UCA.
	SWHA
	TAD U.CPB+5,X	/ OFFSET LUN NUMBER PROPERLY.
	AAC -2		/ DECREMENT FOR OFF BY 1 PROBLEMS.
			/ (THE EXEC DOES THE SAME THINGS.
	DAC U.CPB+5,X	/ SET UP CORRECT LUN IN CAL.
	LAC (34)	/ CPB REQUEST CODE.

	DAC U.CPB,X

	LAC UCAADR	/ CALCULATE EVENT VARUABLE ADDRESS.

	AAC 1

	DAC U.CPB+6,X	/ EVENT VARIABLE ADDRESS IN CPB.

	DZM U.MAEV,X	/ CLEAR EVENT VARIABLE IN CASE FININS RUNS

			/ FIRST.

	AAC 1		/ POINT TO MARK TIME EVENT VARIABLE.

	DAC U.CPB+1,X	/ SET XQT EVENT VARIABLE.

	.DEC		/ SET PRIORITY FOR BUILT TASK.

	LAC (280)

	.OCT

	DAC U.CPB+4,X

	LAC (600000)	/ SET UP ALIAS FLAGS AND DEFER FLAGS.

	XOR U.CPB+5,X

	DAC U.CPB+5,X
X.0025	CALX U.CPB	/ ISSUE EXECUTE.

 

/ CHECK FOR NORMAL COMPLETION OF XQT DIRECTIVE.

 

	LAC UCAADR	/ CHECK EVENT VARIABLE.

	JMS SETXR

	LAC U.MAMTE,X
	SMA		/ AC < 0 IF ABNORMAL.
	JMP X.0020	/ NORMAL EXIT.
	SAD (-202)	/ TASK ALREADY ACTIVE?			/(003)
	JMP X.0020	/ YES, TAKE NORMAL EXIT.		/(003)
	SAD (-777)	/OUT OF NODES?
	SKP		/ YES.
	JMP X.0030
	CAL (5)		/ WAIT FOR NEXT SIGNIFICANT EVENT.

	LAC UCAADR

	JMS SETXR

	JMP X.0025	/ TRY CAL AGAIN.

 

/ UNDEFINED ERROR HAS OCCURED, FLUSH THE XQT REQUEST.

 

X.0030	LAC (6)

	DAC U.JSW,X	/ REQUEST A NEW READ.

	POSTEV -	/ SET FAILURE ERROR RETURN.

	JMP* XQT1	/ RETURN TO CALLER.
X.0020	POSTEV +	/ JOB STATE SET UP ABOVE.

	JMP* XQT1	/ RETURN TO CALLER.

	.TITLE *** ERROR EXITS ***

 

ERR1	LAC (MSG1)	/ SYNTAX ERROR

	SKP
ERR2	LAC (MSG2)	/ ILLEGAL LUN NUMBER
	SKP
ERR3	LAC (MSG3)	/ XXX... OR ...XXX EXECUTION NAME.
	DAC NUMFLG	/ SAVE MESSAGE ADDRESS.

	JMS* TDVTYP	/ CALL TYPE ROUTINE.

	LAC TTYN	/ FETCH TERMINAL NUMBER.

	LAC NUMFLG	/ FETCH MESSAGE ADDRESS.

	LAC (2)		/ FETCH DATA MODE.

	LAC UCAADR	/ RESTORE INDEXING FOR EXIT.

	JMS SETXR

	JMP X.0030	/ RETURN TO CALLER.

	.TITLE *** MISCELLANEOUS SUBROUTINES ***

 

TERM	XX		/ CHECK FOR CR OR AM AND SKIP IF YES.

	SAD (15)	/ CARRIAGE RETURN?

	SKP		/ YES.

	SAD (175)	/ ALT MODE?

	ISZ TERM	/ YES.

	JMP* TERM	/ RETURN.

 
BLSCAN	XX		/ SCAN FOR FIRST BLANK.

BL.010	JMS FAC		/ FETCH A CHARACTER.
	JMS TERM	/ IS IT A TERMINATOR?
	SKP		/ NO.
	JMP* BLSCAN	/ YES, TAKE FUNNY RETURN.

	SAD (40)	/ BLANK?

	SKP		/ YES.

	JMP BL.010	/ NO.

	ISZ BLSCAN	/ SET UP FOR RETURN.

	JMP* BLSCAN	/ RETURN.

 

SETXR	XX		/ AC = ADDRESS ON ENTRY.

	TAD XR.ADJ	/ ADD IN INDEXING FUDGE FACTOR.

	PAX		/ PUT VALUE IN XR.

	JMP* SETXR	/ RETURN TO CALLER.

	.EJECT

/

/	FAC -- SUBROUTINE TO FETCH A CHARACTER FROM 5/7 ASCII LINE BUFFER 'FACLB'.

/	CHARACTERS ARE NOT FETCHED BEYOND TERMINAL CHARACTERS

/

FAC	0

	LAC*	FACCBX	/FETCH NEXT UNPACKED CHARACTER FROM 'FACCB'

	SMA		/WAS CHARACTER BUFFER (FACCB) EMPTY?

	JMP	FAC2	/NO -- TEST FOR TERMINAL CHARACTER

	LAC	(FACCB-1)	/YES -- REFIL 'FACCB'

	DAC	FACCBX

	LAC*	FACLBX	/(FIRST HALF OF WORD PAIR)

	ISZ	FACLBX

	LMQ

	CLA!CLL

	JMS	FACUPS	/(FIRST CHAR)

	JMS	FACUPS	/(SECOND CHARACTER

	JMS	FACUPS	/(FIRST FOUR BITS OF THIRD CHARACTER)

	LAC*	FACLBX	/(SECOND HALF OF WORD PAIR)

	ISZ	FACLBX

	LRS	17	/(LAST THREE BITS OF THIRD CHAR)

	XOR*	FACCBX

	DAC*	FACCBX

	CLA

	JMS	FACUPS	/(FORTH CHAR)

	JMS	FACUPS	/(FIFTH CHAR)

	LAC	(FACCB)	/RESET CHAR BUF INDEX

	DAC	FACCBX

	LAC*	FACCBX	/FETCH FIRST CHAR FROM BUFFER

FAC2	SAD	(015)	/IF TERMINAL CHARACTER, (CR OR AM)

	JMP*	FAC	/RETURN WITH CHAR IN AC BUT DO NOT

	SAD	(175)	/AUGMENT CHAR BUF INDEX (REPEATED CHAR)

	JMP*	FAC	/OF FAC WILL RETURN THE TERMINAL CHARACTER)

/

	ISZ	FACCBX	/NON-TERMINAL CHARACTER -- AUGMENT CHARACTER

	JMP*	FAC	/BUFFER INDEX AND RETURN WITH CHAR IN AC

/

FACUPS	0		/UNPACKING SUBROUTINE -- AC & LINK MUST BE

	LLS	7	/CLEARED, NEXT CHAR MUST BE IN HIGH ORDER

	ISZ	FACCBX	/MQ, 'FACCBX' MUST POINT TO WORD PRECEEDING

	DAC*	FACCBX	/CHAR TO BE STORED.

	CLA		/CHAR IS SHIFTED INTO AC (LOW ORDER BITS

	JMP*	FACUPS	/OF THIRD CHAR ARE ZERO BECAUSE LINK IS

		/ZERO), STORED, 'FACCBX' IS LEFT POINTING TO 

		/CHAR, AND AC IS CLEARED (LINK IS ALSO LEFT CLEARED

FACLBX	0		/LINE BUFFER INDEX

FACCBX	FACCB+5	/CHARACTER BUFFER INDEX

FACCB	.BLOCK	5	/CHARACTER BUFFER (5 IMAGE ALPHA CHARS)

	-1		/END OF 'FACCB' INDICATOR

/

/ SUBROUTINE NUMBER -- READ A DECIMAL NUMBER OF UP TO 3 DIGITS

/			OFF THE MCR TTY.

/ 

/ ALTERED REGISTERS: AC AND MQ

/ 

/ CALLING SEQUENCE:

/		CLA			/CLA IF 1ST CHAR NOT IN AC

/		JMS	NUMBER

/		JMP	???	/RETURN HERE IF 1ST CHARACTER

/				/AFTER A BUNCH OF SPACES IS NOT

/				/A DECIMAL DIGIT WITH THE CHARACTER

/				/IN THE AC.

/		???	???	/RETURN HERE IF 1ST CHARACTER

/				/AFTER A BUNCH OF SPACES IS A DECIMAL

/				/DIGIT WITH THE BREAK CHARACTER IN THE

/				/AC AND THE NUMBER IN THE MQ.

/ 

NUMBER	0

	DAC	SAVAC		/SAVE AC TEMP

	LAW	-3		/SET DIGIT COUNTER

	DAC	COUNT

	DZM	NUM		/ZERO PREVIOUS RESULTS

	CLC			/SET A FLAG TO INDICATE THAT SPACES

	DAC	NUMFLG		/ARE NOT BREAK CHARACTERS YET.

	LAC	SAVAC		/WAS A CHAR IN THE AC ON ENTRY?

	SNA

NUM1	JMS*	(FAC		/GET A CHARACTER

	SAD	(40		/WAS THE CHARACTER A SPACE?

	JMP	NUMSPC		/YES

	DZM	NUMFLG		/NO -- CLEAR FLAG TO INDICATE THAT ANY

				/SPACES ENCOUNTERED SHOULD BE USED AS

				/BREAK CHARACTERS.

	DAC	NUMT		/SAVE IT TEMPORARILY

	AAC	-60		/IS IT A DIGIT?

	SPA

	JMP	NUM2		/NO -- EITHER A BREAK OR AN ERROR

	DAC	CHAR		/SAVE THE POTENTIAL DIGIT

	AAC	-12

	SMA

	JMP	NUM2		/NO -- EITHER A BREAK OR AN ERROR

	LAC	NUM		/YES -- PICK UP THE REAL NUMBER

				/THAT HAS ALREADY BEEN CONSTRUCTED

	CLL

	MUL			/MULTIPLY IT BY 10 DECIMAL

	12

	LACQ			/GET RESULT INTO AC

	TAD	CHAR		/ADD THE DIGIT JUST READ

	DAC	NUM		/SAVE THE RESULTING DECIMAL NUMBER

	ISZ	COUNT		/HAVE 3 DIGITS BEEN READ?

	JMP	NUM1		/NO -- READ SOME MORE

	JMS*	(FAC		/YES -- READ A BREAK CHARACTER

NUM3	DAC	CHAR		/SAVE THE CHARACTER TEMPORARILY

	IDX	NUMBER		/PREPARE TO RETURN AT JMS+2

	LAC	NUM		/PICK UP THE DECIMAL NUMBER

	LMQ			/STORE IT IN THE MQ

	LAC	CHAR		/GET THE BREAK CHAR INTO THE AC

	JMP*	NUMBER		/RETURN AT JMS+2

NUM2	LAW	-3		/CHARACTER IS EITHER A BREAK OR ERROR

	SAD	COUNT		/IF THIS WAS THE 1ST CHARACTER READ

				/ITS AN ERROR. OTHERWIZE ITS A BREAK.

	JMP	NUMERR		/ERROR

	LAC	NUMT		/BREAK -- GET THE CHARACTER INTO AC

	JMP	NUM3

NUMERR	LAC	NUMT		/ERROR SO GET CHARACTER INTO AC

	JMP*	NUMBER		/AND RETURN AT JMS+1

NUMSPC	LAC	NUMFLG		/CHAR. WAS A SPACE -- IS IT A BREAK CHAR.?

	SZA

	JMP	NUM1		/NO -- THE SPACE SHOULD BE IGNORED

	LAC	(40		/YES -- TREAT THE SPACE AS A BREAK CHAR.

	DAC	NUMT

	JMP	NUM2

	.EJECT

/

/ SUBROUTINE NAME -- READ A NAME OF UP TO 6 CHARACTERS FOR THE TTY

/ 

/ CALLING SEQUENCE:

/		CLA		/OPTIONAL -- IF AC IS NON-ZERO ON

/				/ENTRY TO SUBROUTINE THE FIRST CHAR

/				/OF THE NAME IS ASSUMED TO BE IN AC

/		JMS	NAME

/		JMP	???	/RETURN HERE ON AN ERROR E.G. FIRST

/				/CHAR MUST NOT BE A NUMBER

/		???	???	/RETURN HERE IF OK -- AC HAS 1ST HALF

/				/OF NAME, MQ 2ND HALF AND BREAK CHAR

/				/IS IN THE LR.

/ 

NAME	0

	DAC	SAVAC	/SAVE THE AC

	LAW	-6	/SET UP COUNT OF CHAR

	DAC	COUNT

	CLC		/SET THE SPACE FLAG -- SPACES ARE NOT BREAKS YET

	DAC	NUMFLG

	DZM	TABLE	/CLEAR OUT THE 6 WORD CHAR TABLE

	DZM	TABLE+1

	DZM	TABLE+2

	DZM	TABLE+3

	DZM	TABLE+4

	DZM	TABLE+5

	LAC	(TABLE-1	/SET X10 TO ACCESS TABLE

	DAC*	(X10

	LAC	SAVAC	/PICK UP VALUE OF AC ON ENTRY

	SNA		/IF NON-ZERO DON'T READ 1ST CHAR

NAME1	JMS*	(FAC	/READ A CHAR

	SAD	(40	/SPACE?

	JMP	NAMESP	/YES -- SEE IF ITS A BREAK OR NOT

	DZM	NUMFLG	/CLEAR FLAG -- SPACES ARE NOW BREAKS

	DAC	CHAR	/SAVE THE CHAR

	LAC	COUNT	/IF THIS IS THE 1ST CHAR -- CHECK TO SEE THAT

	SAD	(-6	/ITS NOT A NUMBER

	SKP

	JMP	NAME2	/NOT THE 1ST CHAR

	LAC	CHAR	/1ST CHAR -- IS IT A DIGIT?

	AAC	-60

	SPA

	JMP	NAME2	/NO -- CONTINUE

	AAC	-12	/MAYBE -- LETS DO SOME MORE CHECKING

	SMA

	JMP	NAME2	/NO -- CONTINUE

NAMERR	LAC	CHAR	/YES -- ERROR, RETURN AT JMS+1 WITH CHAR IN AC

	JMP*	NAME

NAME2	LAC	CHAR

	SAD	(15	/IS CHAR A CARRIAGE RETURN?

	JMP	NAME4	/YES -- HANDLE TERMINATORS SPECIALLY

	SAD	(175	/NO -- ALTMODE?

	JMP	NAME4	/YES

	AND	(77

	DAC*	X10	/NO -- SAVE THE CHAR IN THE TABLE

	ISZ	COUNT	/HAVE WE LOOKED AT 6 CHARS?

	JMP	NAME1	/NO -- EXAMINE ANOTHER

	JMS*	(FAC	/YES -- READ A BREAK CHAR

NAME4	PAL		/SAVE THE BREAK CHAR

	CLL

	LAC	TABLE+3	/CONSTRUCT THE NAME IN SIXBIT

	ALS	14

	DAC	SAVAC

	LAC	TABLE+4

	ALS	6

	TAD	SAVAC

	TAD	TABLE+5

	LMQ		/SAVE 2ND HALF OF NAME IN MQ

	LAC	TABLE

	ALS	14

	DAC	SAVAC

	LAC	TABLE+1

	ALS	6

	TAD	SAVAC

	TAD	TABLE+2

	IDX	NAME	/PREPARE TO RETURN AT JMS+2

	JMP*	NAME

NAMESP	LAC	NUMFLG	/ARE SPACES BREAKS?

	SZA

	JMP	NAME1	/NO -- READ ANOTHER CHAR

	LAC	(40	/YES --THE SPACE IS A BREAK

	JMP	NAME4

	.END
