File F1120.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/MCR FOR RTS8				LAST EDITED 1/11/74
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/ M. HURLEY / R. LARY

/THE MONITOR CONSOLE ROUTINE ALLOWS THE OPERATOR/PROGRAMMER OF AN
/RTS-8 SYSTEM TO CONTROL AND OBSERVE THE STATE OF THE SYSTEM
/THROUGH THE CONSOLE TELETYPE.

TASK=	MCR
CUR=	10
INIWT=	0

	IFNDEF	MCRSYS	<MCRSYS=1>	/DEFAULT INCLUDES SYSTAT

/PARAMETERS FOR SOMEWHAT FANCIER NULL TASK WHICH COMES WITH MCR

TASK2= NTASKS+1 /LOWEST PRIORITY TASK IN SYSTEM - UNADDRESSABLE
CUR2=	CUR	/SAME FIELD AS MCR
INIWT2= 0	/COMES UP RUNNING

INLENG= 52	/LENGTH OF INPUT BUFFER
NMFIT=	34	/NUMBER OF NAMES WHICH CAN SHARE A PAGE WITH CODE

	FIELD CUR%10

	*100
ERRDLM, DLMER
ERRNUM, NUMER
ERRNAM, NAMER
GET,	GETA
NUMB,	0	/GETN RESULT
ENDSTF, ENDS
BCKUP,	BACKUP
LEGLIM, LEGAL
EOL,	EOLA
ACL,	0	/2 WORD AC
ACH,	0
Q,	0	/ALL USAGE TEMPS
V,	0
P,	0
PUTW=	JMS I	.
	PUTWX
	*MCRSYS 7600+5400
	IFNDEF	CLOCK	<*.+600>	/3 PAGES FOR CLOCK CODE
	IFNZRO	NTASKS-NMFIT&4000	<*.+200>	/SAVE NAME PG

/GET NEXT CHARACTER ROUTINE
/ADVANCE POINTER FOR NEXT GET

GETA,	0
	TAD I	IP
	ISZ	IP
	JMP I	GETA
IP,	0

/DETERMINES IF NEXT CHARACTER IS ALPHABETIC OR NUMERIC
/EXIT IF NOT; EXIT+1 IF ALPHA OR NUM

ALPNUM, 0
	JMS I	GET
	DCA	Q
	TAD	Q
	TAD	(-333
	CLL
	TAD	(32
	SZL CLA 	/TEST FOR ALPHA
	ISZ	ALPNUM	/BUMP RETURN IF ALPHA
	TAD	Q	/NOW TEST FOR NUMERIC
	JMS	ISITNM
	ISZ	ALPNUM
	JMP I	ALPNUM

/SEE IF CHARACTER IN AC IS NUMERAL
/EXIT IF IS; EXIT+1 IF NOT

ISITNM, 0
	TAD	(-"9-1
	CLL
	TAD	(12	/CHECK FOR RANGE 260-271
	SNL
	ISZ	ISITNM	/BUMP RETURN ADDRESS IF NOT IN RANGE
	TAD	(260	/RESTORE CHAR
	JMP I	ISITNM

PUTWX,	0		/ROUTINE TO STORE A WORD IN THE OUTPUT BUFFER
	DCA I	W
	ISZ	W
	JMP I	PUTWX
/CHECK NEXT CHAR FOR TYPE OF DELIMITER
/EXIT=	NOT CR,ALTMODE,SPACE, OR COMMA
/EXIT+1=CR OR ALTMODE
/EXIT+2=SPACE OR COMMA

LEGAL,	0
	JMS I	GET
	DCA	Q
	TAD	Q
	CIA CLL
	SPA		/CR OR ALTMODE?
	JMP	NOCRAL	/NO
	STA CML RAL	/GENERATE -2 IF CR, -1 IF ALTMODE
	DCA	CRALT
	JMP	ITSEOL
NOCRAL, TAD	(240	/BLANK?
	SZA
	TAD	(",-240 /COMMA?
	SZA CLA
	JMP	NOGOOD	/NEITHER
	ISZ	LEGAL	/SPACE OR COMMA
ITSEOL, ISZ	LEGAL	/CR,ALT
NOGOOD, JMP I	LEGAL

BACKUP, 0		/BACK UP INBUF POINTER BY 1 CHAR
	CLA CMA
	TAD	IP
	DCA	IP
	JMP I	BACKUP

EOLA,	0		/SEARCH FOR C.R. OR ALTMODE
	JMS I	LEGLIM
	JMP I	ERRDLM	/CRAP AT END OF LINE
	JMP I	EOLA
	JMP	EOLA+1

CRALT,	0
TTOUT,	0
	PUTW		/TERMINATE LINE
	CAL
	SENDW
	TTY		/SEND MESSAGE TO TTY AND WAIT
	EXMSG
	TAD	(E1MSG	/INITIALIZE POINTER FOR NEXT LINE
	DCA	W
	JMP I	TTOUT

W,	E1MSG

EXMSG,	ZBLOCK	3	/OUTPUT BUFFER SHARES SPACE WITH INPUT BUFFER
	0
	0
E1MSG,
INBUF,	ZBLOCK	INLENG	/INPUT BUFFER
	PAGE
/ROUTINE TO PARSE OFF A TASK NAME OR NUMBER

NAMEA,	XNAME
XNAME,	0	/USED FOR TEMP STORAGE OF ACCUMULATED NAME
XNAME1, 0

GETTSK, 0		/THIS SUBR RETURNS TASK NUMBER IN "TSKWD"
	JMS	NAMGET
	JMP	NUMTSK
	JMS	NAMCOM	/OK SO FAR.
			/NOW CHECK FOR NAME DUPLICATION
	JMP I	ERRNAM
	TAD	V
	TAD	(NTASKS+1	/GET NUMBER ASSOC. WITH THIS NAME
GOTASK, DCA	TSKWD	/AND THAT'S THE TASK NUMBER
	TAD	TSKWD
	CIA
	CLL
	TAD	(NTASKS /MUST BE BETWEEN 1 + NTASKS
	SNL CLA
	JMP I	ERRNUM
	TAD	TSKWD
	JMP I	GETTSK	/RETURN WITH TASK NUMBER IN AC
NUMTSK, JMS I	BCKUP	/IT'S A NUMBER - MUST BACK UP PTR
	JMS I	(OCTNUM /SO GO ACCUMULATE IT
	JMS I	BCKUP
	JMS I	GET	/GET DELIMITING CHAR
	CLA
	TAD	NUMB
	JMP	GOTASK
NAMGET, 0
	TAD	NAMEA
	DCA	G7
	AC7776
	DCA	G3
	TAD	(4040
	DCA	XNAME1
	JMS I	(ALPNUM /ONLY ALPHAS + NUMBERS LEGAL
	JMP I	(CHRER
	TAD	(-300
	SPA CLA 	/NAME OR NUMBER?
	JMP I	NAMGET	/BY NUMBER
	ISZ	NAMGET
	TAD	Q
NXT,	AND	(77
	STL RTL 	/40 IN LOW 6 BITS
	RTL
	RTL
	DCA I	G7
	JMS I	(ALPNUM
	JMP	ENDX	/2ND CHAR IS NOT ALPHANUMERIC
	AND	(77
	TAD	(-40	/REMOVE LOW 40
	TAD I	G7
	DCA I	G7	/SAVE 1ST 2 CHARS
	ISZ	G7
	ISZ	G3	/4 CHARS YET?
	JMS I	(ALPNUM
	JMP	ENDX	/3RD CHAR NON-ALPHANUMERIC
	JMP	NXT	/GO DO 3RD+4TH CHARS
ENDX,	JMS I	BCKUP
END,	JMS I	LEGLIM
	JMP	END
	NOP
	JMP I	NAMGET

G3,	0
G7,	0
TSKWD,	0
/COMPARE NAME IN XNAME WITH NMTBL, LOOKING FOR MATCHES.

NAMCOM, 0
	TAD	(NMTBL-1
	DCA	P
	TAD	(-NTASKS-1
	DCA	V
CHKMOR, ISZ	P	/UPDATE PAST UNNEED INFO
	ISZ	V	/DONE?
	SKP
	JMP I	NAMCOM	/YES
	TAD I	P	/GET 2 CHARACTERS FROM NMTBL
	ISZ	P
	CIA
	TAD	XNAME	/COMPARE TO NAME UNDER INVESTIGATION
	SZA CLA
	JMP	CHKMOR	/N.G. CONTINUE THRU NMTBL
	TAD	XNAME1	/TRY 2ND 2 CHARS FOR MATCH
	CIA
	TAD I	P
	SZA CLA
	JMP	CHKMOR	/NOT CLOSE ENOUGH
	ISZ	NAMCOM	/FOUND IT
	JMP I	NAMCOM
/RUN THE REQUESTED TASK. TO SCHED FIRST

	IFNDEF	CLOCK	<
SCHED,	JMS	GETTSK
	>
REQUST, IFDEF	CLOCK	<TAD	TSKWD>
	CAL
	RUN
	JMP	BKELEN

/STOP THE REQUESTED TASK

STOP,	JMS	GETTSK
	CAL
	SUSPND
BKELEN, JMS I	BCKUP
	JMS I	EOL
	JMP I	ENDSTF

/ENABLE A TASKS EXECUTION

ENABLE, JMS	GETTSK
	CAL
	UNBARG		/UNBLOCK THE TASK ON
	ENABWT		/ENABLE WAIT
	JMP	BKELEN	/CLEAN UP

/DISABLE A TASKS EXECUTION

DISABL, JMS	GETTSK
	CAL
	BLKARG		/BLOCK THE TASK ON
	ENABWT		/ENABLE WAIT
	JMP	BKELEN	/CLEAN UP
	PAGE
/COMMAND CLEANUP AND NEW COMMAND FETCH

ENDS,	ISZ I	(CRALT	/ALT-MODE EXIT?
	JMP	START	/NO-CR EXIT
	IOF		/"WAITM" REQUIRES IOF ON ENTRY
	CDF CIF 0
	TAD	(4000+TASK
	DCA I	(MCREF
	CDF CUR 	/SUSPEND MCR ON  C EVENT FLAG
	WAITM		/WITHOUT LETTING INTERRUPTS GO BACK ON!
	EFWT
START,	CAL
	SENDW
	TTY
	MCRMES
	TAD	PINBUF
	DCA I	(IP
	DCA I	(CRALT
	JMS I	LEGLIM	/LOOK AT FIRST CHAR
	JMP	.+3	/SOMETHING USEFUL
	JMP I	ENDSTF	/CR OR ALT - NULL LINE
	JMP	.-3	/SPACE OR COMMA - KEEP LOOKING FOR MEAT
	JMS I	BCKUP	/FOUND MEAT - BACK UP OVER IT
	JMS I	(NAMGET /GET COMMAND NAME
	JMP I	ERRNAM
	TAD	(CMDLST-1
	DCA	P
CMDLP,	ISZ	P
	TAD I	P	/GET 1ST 2 CHARS OF A COMMAND
	ISZ	P
	SZA		/0 TERMINATES COMMAND LIST
	TAD I	(XNAME
	SZA	CLA	/A MATCH?
	JMP	CMDLP	/NO-TRY AGAIN
	TAD I	P	/YES - GET COMMAND DISPATCH ADDRESS
	DCA	P
	JMP I	P	/WE'RE ON OUR WAY

MCRMES, ZBLOCK 3
	2000+INLENG
PINBUF, INBUF
L7600,	TEXT	/>/

START2, TAD	L7600	/RSX-11D STYLE NULL TASK
BKGLP,	ISZ	BKGCT
	ISZ	BKGCT
	ISZ	BKGCT
	ISZ	BKGCT
	ISZ	BKGCT
	JMP	BKGLP
	RAR
	JMP	BKGLP
BKGCT,	0
ERMSG,	ZBLOCK	3	/STANDARD MESSAGE HEADER
	1000		/SIXBIT MESSAGE, END WITH CRLF, INDIRECT
	0		/NO INPUT
ERRA,	0		/JMS PUTS POINTER TO ERROR MESSAGE HERE
	CAL		/AC RANDOM BUT IRRELEVANT
	SENDW
	TTY
	ERMSG
	JMP	START

CHRER,	JMS	ERRA
	TEXT	/BAD CHAR/
NAMER,	JMS	ERRA
	TEXT	/BAD NAME/
DLMER,	JMS	ERRA
	TEXT	/BAD DELIM/
NUMER,	JMS	ERRA
	TEXT	/BAD NUMBER/
/COMMAND LIST - FORMAT OF LIST IS:
/	NAME
/	OVERLAY NO.
/	ST. ADDR. IN OVERLAY

CMDLST, -2324;	STOP	/STOP
	-0516;	ENABLE	/ENABLE
	-0411;	DISABL	/DISABLE
	-1601;	NAME	/NAME
	IFDEF	CLOCK	<
	-0401;	DATEX	/DATE
	-2411;	TIME	/TIME
	-0301;	CANCEL	/CANCEL
	>
	-2205;	SCHED	/REQUEST
	-1720;	EXAM	/OPEN
	-0405;	DEPSIT	/DEPOSIT
	-2017;	POSTEF	/POST
	IFNZRO	MCRSYS	<
	-2331;	SYSTAT	/SYSTAT
	>
	-0530;	EXIT	/EXIT
	0;	NAMER	/END OF LIST
	PAGE
/FORMAT OF NMTBL IS 2 WORDS OF 4 6-BIT CHARS
/ORDERED BY NUMBER OF TASK AFFILIATED WITH THAT NAME
/NAMES MUST BE PADDED WITH BLANKS!

NMTBL,	ZBLOCK	NTASKS 2
NAMES=	NMTBL-2

	*MCR 2+NAMES
	1503;	2240	/MCR
	IFDEF	TTY	<
	*TTY 2+NAMES
	2424;	3140	/TTY
	>
	IFDEF	CLOCK	<
	*CLOCK 2+NAMES
	DEVICE	CLCK
	>
	IFDEF	RK8	<
	*RK8 2+NAMES
	2213;	7040	/RK8
	>
	IFDEF	DTA	<
	*DTA 2+NAMES
	0424;	0140	/DTA
	>
/NAME TABLE CONTINUED

	IFDEF	RF08	<
	*RF08 2+NAMES
	DEVICE	RF08
	>
	IFDEF	CSA	<
	*CSA 2+NAMES
	0323;0140	/CSA
	>
	IFDEF	CSAF	<
	*CSAF 2+NAMES
	DEVICE	CSAF
	>
	IFDEF	UDC	<
	*UDC 2+NAMES
	2504;0340	/UDC
	>
	IFDEF	OS8F	<
	*OS8F 2+NAMES
	DEVICE	OS8F
	>
	IFDEF	OS8	<
	*OS8 2+NAMES
	1723;	7040	/OS8
	>
	IFDEF	LPT	<
	*LPT 2+NAMES
	1420;2440	/LPT
	>
	IFDEF	PWRF	<
	*PWRF 2+NAMES
	DEVICE	PWRF
	>

	*NTASKS 2+NMTBL /ORIGIN TO END OF TABLE
	IFZERO	NTASKS-NMFIT&4000	<PAGE>	/CAN'T FIT IN WITH CODE
/ASSOCIATE A NAME WITH A TASK NUMBER

NAME,	JMS I	(GETTSK /GET TASK NUMBER TO GIVE THIS NAME TO
	RAL CLL 	/INDEX INTO NMTBL
	TAD	(NAMES
	DCA	ACH
	JMS I	BCKUP
	JMS I	LEGLIM
	JMP I	ERRDLM
	JMP I	ERRDLM	/NO CR BEFORE NUMBER
	JMS I	(NAMGET
	JMP I	ERRNAM
	JMS I	(NAMCOM /CHECK FOR DUPLICATION OF NAMES
	SKP
	JMP I	ERRNAM	/BAD NAME - ALREADY EXISTS
	JMS I	BCKUP
	JMS I	EOL
	TAD I	(XNAME
	DCA I	ACH	/1 WORD
	ISZ	ACH
	TAD I	(XNAME1
	DCA I	ACH	/THEN THE OTHER
	JMP I	ENDSTF

EXIT,	TAD I	(XNAME1
	TAD	(-1124	/VERIFY THAT "EXIT" WAS TYPED
	SZA CLA
	JMP I	(EXAM	/OTHERWISE ASSUME USER MEANT "EXAMINE"
	CDF	0
	DCA I	(TSWFLG /INHIBIT TASK SWITCHING
	ISZ	V
	JMP	.-1	/ALLOW (MOST) I/O TO COMPLETE
	ISZ	EXDLAY
	JMP	.-3
	IOF
	CDF CIF 0
	JMP I	(7600

EXDLAY, -60
PR12BT, 0		/PRINT 2 3-BIT NUMBERS
	DCA	Q
	TAD	Q
	CLL RTR
	RTR
	RTR
	JMS	PRNTNM	/PASS 2 DIGIT NO.
	TAD	Q
	JMS	PRNTNM	/PASS LAST 2 DIGITS
	JMP I	PR12BT

PRNTNM, 0
	AND	(77
	DCA	V
	TAD	V
	CLL RTL
	RAL
	AND	(707	/GET LEFT DIGIT
	TAD	V
	AND	(707	/RIGHT DIGIT
	TAD	(6060
	PUTW
	JMP I	PRNTNM
	PAGE
	IFNZRO	MCRSYS	<
/PRINT A STATUS TABLE
/FORMAT IS: NO. OF TASK
/	AFFILIATED NAME IF ANY
/	STATE OF FLAGS:
/	E=	EVENT		M=	MESSAGE
/	S=	SWAP		R=	RUN
/	U=	USER		D=	DISABLED
/	O=	EVENT OR MESSAGE

SYSTAT, DCA	V
	JMS I	BCKUP
	JMS I	LEGLIM
	JMP I	ERRDLM
	JMP	FULSYS	/NO ARGS - DO FOA ALL TASKS, NO STATE
	JMS I	(GETTSK /DELIMITER - GET TASK ID
	DCA	V
	DCA	P	/SET FOR ONE TASK, WITH STATE
	JMP	ONETSK
FULSYS, TAD	(-NTASKS
	DCA	P	/-MAX. NO. ENTRIES
UPCHCK, ISZ	V
ONETSK, TAD	(TFTABL
	TAD	V
	DCA	ST2	/INDEX INTO FLAG TABLE
	CDF 0
	TAD I	ST2	/GET JFTABL WORD
	CDF CUR
	DCA	ST2
	TAD	ST2	/LO BIT=1 MEANS NOT ACTIVE
	RAR CLL
	SZL CLA
	JMP	NXTTSK	/MOVE ON TO NEXT TASK
	TAD	V	/PRINT TASK NO.
	JMS I	(PRNTNM
	JMS	SYSOUT
	TAD	V
	CLL RAL
	TAD	(NAMES	/INDEX INTO NAME TABLE
	DCA	ST1
	TAD I	ST1
	JMS	SYSOUT	/ADD NAME TO WRITE BUFFER
	ISZ	ST1
	TAD I	ST1
	JMS	SYSOUT
/INSERT TASK WAIT CODES INTO LINE

	TAD	(FLGTBL-1
	DCA	ST1	/DECODE WAIT CODE
FLGLP,	ISZ	ST1
	TAD I	ST1	/GET NEXT TABLE ENTRY
	ISZ	ST1
	SNA
	JMP	NOMOFG	/ZERO ENDS TABLE
	AND	ST2	/IF WE ARE WAITING ON THIS CODE,
	SNA CLA 	/WE WILL PUT THE CORRESPONDING CODE LETTER OUT
	JMP	FLGLP
	TAD I	ST1
	PUTW
	JMP	FLGLP
NOMOFG, TAD	V
	CLL RAL
	TAD	(MSGTBL
	DCA	Q
	CDF	0
	TAD I	Q
	CDF	CUR
	SNA CLA
	JMP	.+3
	TAD	(4052
	PUTW
	TAD	P
	SZA CLA
	JMP	NODTL
	TAD	(-4
	DCA	ST2
	TAD	V	/PRINT 4 WORDS FROM TASK STATE TABLE ENTRY
	CLL RTL 	/FOR THIS TASK
	TAD	(TSTABL
	DCA	ST1
	JMS	SYSOUT
	TAD	ST1
	JMS I	(PR12BT /PRINT LOCATION OF JOB STATE TABLE ENTRY
	TAD	(7240	/FOLLOWED BY COLON, SPACE
PRDTLP, JMS	SYSOUT
	CDF 0
	TAD I	ST1
	CDF CUR
	JMS I	(PR12BT
	ISZ	ST1
	ISZ	ST2
	JMP	PRDTLP
NODTL,	JMS I	(TTOUT	/SEND MESSAGE TO TTY
NXTTSK, ISZ	P	/END OF TABLE?
	TAD	P
	SPA CLA
	JMP	UPCHCK	/NO
	JMP I	ENDSTF	/YES - GO AWAY

SYSOUT, 0
	SNA		/PRINT CONTENTS OF AC
	TAD	(4040	/OR BLANKS.
	PUTW
	JMP I	SYSOUT

ST1,	0
ST2,	0

FLGTBL, MSGWT;	4015	/M
	EFWT;	4005	/E
	RUNWT;	4022	/R
	SWPWT;	4023	/S
	USERWT; 4025	/U
	ENABWT; 4004	/D
	EORMWT; 4017	/O
	0
	PAGE
	>
/GET 2 OCTAL NUMBERS

GET2OC, 0
	JMS	OCTNUM	/GO GET A NUMBER
	JMP	ISITDN	/LESS THAN 4 DIGITS
	TAD	NUMB	/5TH IS FIELD
	CLL RTR
	RTR
	RTR
	AND	(70
	DCA	G2A	/SAVE FIELD POINTER IN CASE 5TH DIGIT SHOWS
	JMS	D07	/TRY FOR 5 DIGITS
	JMP	ISITDN	/BE CONTENT WITH 4
	JMS I	GET
	CLA		/WASTE A CHAR - THE DELIM
	TAD	G2A	/USE THE FIELD WE SAVED
ISITDN, TAD	(CDF 0	/AC MAY NOT BE 0 HERE!
	DCA	GFLD	/SAVE CDF TO FIELD
	TAD	NUMB
	DCA	G2A	/THIS IS 4 DIGIT NUMBER
	JMS I	BCKUP
	JMS I	LEGLIM
	JMP I	ERRDLM
	JMP I	GET2OC	/LEGAL EOL-ONLY 1 NUMBER
	JMS	OCTNUM	/TRY FOR A 2ND
	JMS I	BCKUP
	TAD	NUMB
	ISZ	GET2OC
	JMP I	GET2OC	/UPDATE RETURN + PASS 2ND NUMBER IN AC
OCTNUM, 0
	AC7775
	DCA	V
	DCA	NUMB	/INITIALIZE NUMBER
	JMS	D07	/GET A DIGIT
	JMP I	ERRNUM
TWOMOR, JMS	D07	/CAN HAVE UP TO 4 DIGITS
	JMP I	OCTNUM	/L.T. 4
	ISZ	V
	JMP	TWOMOR
	ISZ	OCTNUM	/4 DIGITS
	JMP I	OCTNUM

/DIGIT MUST BE OCTAL-USE ONLY 3 BITS

D07,	0
	JMS I	GET
	TAD	(-270
	CLL
	TAD	(10
	DCA	BUMP	/SAVE DIGIT VALUE
	SNL
	JMP I	D07	/NOT DIGIT AFTER ALL - NON-SKIP RETURN
	TAD	NUMB
	CLL RAL
	CLL RAL
	CLL RAL 	/NUMB*8
	TAD	BUMP
	DCA	NUMB
	ISZ	D07	/TAKE SKIP RETURN
	JMP I	D07
G2A,	0
/DEPOSIT IN LOCATION SPECIFIED CONTENTS

DEPSIT, JMS	GET2OC
	JMP I	ERRNUM	/MUST HAVE 2 NUMBERS
DEPSLP, JMS	XFLD	/SET FIELD
	DCA I	G2A	/ADD IN NEW CONTENTS
	CDF	CUR
	JMS I	LEGLIM
	JMP I	ERRDLM
	JMP I	ENDSTF
	JMS	OCTNUM	/MAY BE MORE CONTENTS
	JMS I	BCKUP
	JMS	BUMP	/BUMP LOCATION POINTER
	TAD	NUMB
	JMP	DEPSLP

BUMP,	0		/ROUTINE TO BUMP G2A
	ISZ	G2A
	JMP I	BUMP	/AH, NICE AND SIMPLE
	TAD	(10
	TAD	GFLD	/ACROSS FIELD BOUNDARY
	DCA	GFLD
	JMP I	BUMP

/POST EVENT FLAG GIVEN ADDRESS

POSTEF, JMS	GET2OC	/GET 5-DIGIT ADDRESS
	SKP		/SHOULD BE ONLY 1 NUMBER
	JMP I	ERRNUM	/MORE IS ERROR
	TAD	GFLD
	DCA	POSTDF
	TAD	G2A
	CAL
	POST		/PRAY WHAT WE ARE POSTING IS REALLY
POSTDF, HLT		/AN EVENT FLAG
	JMP I	ENDSTF
/EXAMINE LOCATION OR RANGE OF LOCATIONS

EXAM,	JMS	GET2OC	/GET OCTAL VALUES
	JMS I	BCKUP	/NO SECOND NUMBER - EXAMINE ONLY 1 LOC
	SNA		/IF 2D NUM IS ZERO,
	IAC		/EXAMINE ONLY 1 LOC
	CIA
	DCA	LSTCNT	/- NO. OF LOCATIONS TO EXAM
	JMS I	EOL
PRNCON, TAD	GFLD	/GFLD SET BY GET2OC
	AND	(70
	CLL RTR
	RAR
	TAD	(4060	/SPACE , NUMBER
	PUTW
	TAD	G2A
	JMS I	(PR12BT /PRINT THE LOCATION NEXT
	TAD	(5740	/PRINT A SLASH BEFORE CONTENTS
	PUTW
	JMS	XFLD	/SET FIELD
	TAD I	G2A	/GET CONTENTS
	CDF	CUR
	JMS I	(PR12BT /PRINT IT
	JMS	BUMP
	JMS I	(TTOUT	/OUTPUT A LINE
	ISZ	LSTCNT	/DONE?
	JMP	PRNCON	/NO - DO SOME MORE
	JMP I	ENDSTF
LSTCNT, 0

XFLD,	0
GFLD,	HLT
	JMP I	XFLD
	PAGE
	IFDEF	CLOCK	<

TIME,	TAD I	(CRALT
	SZA	CLA
	JMP	PRNTM	/PRINT TIME
DOTIME, JMS I	(HRMIN	/DECODE HOURS + MINS
	TAD I	(CRALT
	SNA CLA
	JMS I	EOL
	TAD	ACL
	CDF CIF 0	/INHIBIT INTERRUPTS BETWEEN HALVES
	DCA I	(TODL
	TAD	ACH
	DCA I	(TODH
	CDF CIF CUR
	JMP I	ENDSTF
PRNTM,	DCA I	(P1
	DCA	HRS
	DCA	MINS	/CONVERT TOD TO HOURS:MINUTES
	IOF		/INHIBIT INTERRUPTS BETWEEN HALVES
	CDF 0
	TAD I	(TODL
	DCA	ACL
	TAD I	(TODH	/GET TIME OF DAY FROM PAGE 0 OF FIELD 0
	DCA	ACH
	ION		/RE-ENABLE INTERRUPTS
	CDF CUR
	TAD	(FUDGEL
	JMS	DBLSUB	/TAKE OFF THE MIDNIGHT FUDGE
HRLOP,	TAD	(HRCON	/SUBTRACT HRS TIL OVERFLO
	JMS	DBLSUB
	ISZ	HRS
	TAD	ACH
	SMA CLA 	/AC GOES NEGATIVE ON OVERFLOW
	JMP	HRLOP
MINLOP, TAD	(MINCON
	JMS	DBLADD
	ISZ	MINS
	TAD	ACH
	SPA CLA 	/THIS TIME AC GOES POSITIVE ON OVERFLOW
	JMP	MINLOP
	STA
	TAD	HRS
	JMS I	(PR4BIT
	ISZ I	(P1	/MINS SPLIT BET WORDS
	TAD	MINS
	CIA
	TAD	(74
	JMS I	(PR4BIT
	JMS I	(TTOUT
	JMP I	ENDSTF
HRS,	0
MINS,	0
DBLADD, 0		/DOUBLE PRECISION ADD ROUTINE
	DCA	Q
	CLL
	TAD I	Q
	TAD	ACL
	DCA	ACL
	ISZ	Q	/PREPARE FOR HI WORD
	RAL		/UPDATE HI WORD
	TAD	ACH
	TAD I	Q
	DCA	ACH
	JMP I	DBLADD

DBLSUB, 0		/** CAN BE CALLED WITH DF=CUR OR DF=0 **
	DCA	Q
	CIF CUR 	/INHIBIT INTERRUPTS BETWEEN HALVES
	TAD I	Q	/GET LO VALUE
	CIA CLL
	TAD	ACL
	DCA	ACL
	ISZ	Q	/UPDATE FOR HI VALUE
	CML RAL
	TAD I	Q
	CIA
	TAD	ACH
	DCA	ACH
	JMP I	DBLSUB

GETN,	0		/GET A NUMBER ROUTINE
	DCA	NUMB	/INITIALIZE NUMBER TO 0
PSTSPC, JMS I	GET
	JMS I	(ISITNM /DIGIT?
	JMP	YSITIS	/YES - GO BUILD NUMBER
	TAD	(-240
	SNA CLA
	JMP	PSTSPC	/PERMIT LEADING SPACES
	JMP I	ERRNUM
GETNXL, JMS I	GET
	JMS I	(ISITNM
	SKP
	JMP I	GETN	/RETURN WITH DELIMITER IN AC
YSITIS, TAD	(-260
	DCA	DIG
	TAD	NUMB
	CLL RTL
	TAD	NUMB
	RAL		/NUMBER SO FAR *10
	TAD	DIG	/+ NEW NUMBER
	DCA	NUMB
	JMP	GETNXL
DIG,	0
/THIS TABLE CONTAINS THE CONVERSION FACTORS FOR HOURS,
/MINUTES & SECONDS TO TICKS. EACH IS A 2 WORD VALUE
/BECAUSE ALL THIS IS DONE BY DOUBLE WORD ARITHMETIC.
/THE HOUR TO TICKS VALUE = 60*60*SHERTZ = 7020(OCT)*SHERTZ
/THE LOW WORD VALUE IS DETERMINED FOR THIS MULTIPLICATION
/BY THE ASSEMBLER.
/THE HIGH WORD IS (7020*SHERTZ)/10000.
/THIS MUST BE REDUCED FOR THE ASSEMBLER
/IT IS = 341*SHERTZ/400 = 340*SHERTZ/400+SHERTZ/400 =
/ 7*SHERTZ/10+SHERTZ/400 = (7*SHERTZ+SHERTZ/40)/10

INTTBL, "H
HRCON,	7020 SHERTZ
HRCTEM= SHERTZ%40
HRCON1, 7 SHERTZ+HRCTEM%10

	"M
MINCON, 74 SHERTZ
MINCN1, 17 SHERTZ%2000

	"S
SECCON, SHERTZ
	0

	"T
TICCON, 1
	0

	0	/EOT
	PAGE
DATEX,	TAD I	(CRALT
	SZA CLA 	/PRINT OR GET?
	JMP	PRNTDT	/PRINT DATE
	DCA	DATEWD	/WHERE WILL THIS BE??
	JMS	GETNXT	/GET MONTH
	AND	(17
	CLL RTR
	RTR
	RAR
	DCA	DATEWD	/IN STANDARD OS/8 FORMAT
	JMS	GETNXT	/HERE COMES DAY
	AND	(37
	CLL RTL
	RAL
	TAD	DATEWD
	DCA	DATEWD
	JMS I	(GETN	/FOLLOWED BY YEAR
	CLA
	TAD I	(DIG	/OF WHICH WE TAKE ONLY LAST DIGIT
	TAD	DATEWD
	CDF	0
	DCA I	(DATE
	CDF	CUR
	JMS I	BCKUP
	JMS I	LEGLIM
	JMP I	ERRDLM
	JMP I	ENDSTF
	JMP I	(DOTIME /MAY BE FOLLOWED BY TIME
GETNXT, 0
	JMS I	(GETN
	TAD	(-257
	SZA	CLA	/USE / AS DELIM FOR DATE
	JMP I	ERRDLM
	TAD	NUMB
	JMP I	GETNXT
DATEWD, 0

PRNTDT, DCA	P1
	CDF	0
	TAD I	(DATE
	CDF	CUR
	DCA	DATEWD	/SAVE CURRENT DATE
	TAD	DATEWD
	AND	(7400	/GET MONTH
	CLL RTL
	RTL
	RAL
	JMS	PR4BIT
	CLA CMA
	DCA	P1	/DAY WILL BE SPLIT BET 2 BUFFER WORDS
	TAD	DATEWD
	AND	(370	/GET MONTH
	CLL RTR
	RAR
	JMS	PR4BIT
	TAD	DATEWD	/AND YEAR
	AND	(7
	TAD	(70	/GOOD TIL 77
	JMS I	(PRNTNM
	JMS I	(TTOUT	/PUT OUT LINE
	JMP I	ENDSTF

TENCNT, 0
P1,	0
SPEC,	5700	/SLASH FOR DATE
	57
	7200	/: FOR TIME
	40
/PRINT ROUTINE FOR 4 BIT NUMBERS

PR4BIT, 0
	DCA	Q
	TAD	(57
	DCA	TENCNT	/TENS INITAILLY=0
	TAD	Q	/GET THE DIGITS
DECMOR, ISZ	TENCNT
	TAD	(-12
	SMA
	JMP	DECMOR	/COUNT TENS
	TAD	(72	/60+12
	DCA	Q
	TAD	P1	/SPLIT ACROSS WORDS?
	SNA
	JMP	REG	/NO
	TAD	(SPEC+1 /P1 IS +1 OR -1
	DCA	P1	/POINT TO CORRECT FILLERS
	TAD I	P1	/YES-GET LEADING CHAR
	TAD	TENCNT
	PUTW		/1ST DIGIT TO RIGHT
	ISZ	P1
	TAD	Q	/2ND DIGIT TO LEFT
	CLL RTL
	RTL
	RTL
	TAD I	P1	/AND 2ND DELIM
SAVIT,	PUTW
	JMP I	PR4BIT
REG,	TAD	TENCNT
	CLL RTL
	RTL
	RTL
	TAD	Q
	JMP	SAVIT
	PAGE
/REQUEST A TASK:

/A)	IMMEDIATELY
/B)	AFTER AN INTERVAL
/C)	AT A TIME OF DAY
/D)	AFTER AN INTERVAL AND PERIODICALLY
/E)	AT A TIME OF DAY AND PERIODICALLY

SCHED,	JMS I	(GETTSK /GET TASK
	JMS I	BCKUP
	JMS I	LEGLIM
	JMP I	ERRDLM	/MUST BE DELIM
	JMP I	(REQUST /JUST A REQUEST
	DCA	ACH
	DCA	ACL	/INITIALIZE INTERVAL
	JMS I	GET
	TAD	(-",	/CHECK FOR NULL INTERVAL
	SNA
	JMP	SAVTIM	/YES - GET PERIOD
	TAD	(",-"@	/CHECK FOR @ TIME-OD-DAY
	SZA CLA
	JMP	INTSCH
	JMS I	(HRMIN	/DECODE TIME SPECIFICATION
	TAD	(TODL
	CDF 0
	JMS I	(DBLSUB /SUBTRACT CURRENT T.O.D. TO GET INTERVAL
	CDF CUR
SAVTIM, TAD	ACH
	DCA	SCHDHI
	TAD	ACL
	DCA	SCHDLO
	TAD I	(CRALT
	SZA CLA 	/END OF LINE SEEN?
	JMP	ZROINT	/YES - NO INTERVAL
	JMS	GETINT
	TAD	ACH
	DCA	RSCHHI	/SAVE RESCHEDULE UNITS IN CLOCK MESSAGE
	TAD	ACL
	DCA	RSCHLO
	AC2000
ZROINT, TAD	(1000
SNDCLK, TAD I	(TSKWD
	DCA	SCHDWD
	CAL
	SEND
	CLOCK
	SCHMES
	JMP I	(BKELEN

/CANCEL ALL CLOCK QUEUE ENTRIES FOR A TASK

CANCEL, JMS I	(GETTSK /GET TASK - RETURNS NUMBER IN AC AND "TSKWD"
	AC4000		/"CANCEL" OPCODE FOR CLOCK HANDLER IS 4000
	JMP	ZROINT	/SEND THE CLOCK THE CANCEL MESSAGE
/ROUTINE TO GET AN INTERVAL -
/INTERVALS ARE A NUMBER FOLLOWED BY H,M,S OR T
/THIS ROUTINE IS JUMPED INTO BY "HRMIN"

GETINT, 0
	JMS I	(GETN
	DCA	S2	/THIS IS THE ALPHA FOR UNIT
	TAD	(INTTBL
	DCA	S1
	DCA	ACH
	DCA	ACL	/CLEAR AC PRIOR TO ADDS
NXTINT, TAD I	S1	/NOW CHECK FOR MATCHING UNITS
	ISZ	S1
	SNA
	JMP I	(CHRER
	CIA
	TAD	S2
	SNA CLA
	JMP	FNDINT	/FOUND THEM
	ISZ	S1
	ISZ	S1
	JMP	NXTINT	/TRY AGAIN
FNDINT, TAD	NUMB	/PREPARE COUNT ** HRMIN ENTERS HERE **
	CIA
	DCA	S2
MORUNT, TAD	S1	/PASS UNITS FOR ADD
	JMS I	(DBLADD
	ISZ	S2
	JMP	MORUNT
	JMS I	LEGLIM
	JMP I	ERRDLM	/ILLEGAL TERMINATING DELIMITER
SC7000, 7000		/EITHER SPACE, COMMA, OR EOL IS OK
	JMP I	GETINT

INTSCH, JMS I	BCKUP
	JMS	GETINT	/GET INTERVAL
	JMP	SAVTIM
S2,	0
S1,	0
SCHMES, ZBLOCK 3
SCHDWD, 0		/2000+TASK NUM
SCHDHI, 0
SCHDLO, 0
RSCHHI, 0
RSCHLO, 0	/RESCHEDULE INTERVAL (IF APPLICABLE)
/COMPUTE THE NUMBER OF TICKS IN A DAY FOR THE TIME-OF-DAY FUDGE

	TEMPH=3 SHERTZ%40
FUDGEL, -600 SHERTZ
FUDGEH, -25 SHERTZ-TEMPH-1

HRMIN,	0		/IF SPEC HRS,MUST HAVE MINS
	JMS I	(GETN
	TAD	(-":	/ONLY : BET HRS + MINS
	SZA CLA
	JMP I	ERRNUM	/NO : - ERROR
	TAD	HRMIN
	DCA	GETINT	/FAKE OUT "GETINT" TO DO SOME WORK FOR US LATER
	TAD	NUMB	/MULTIPLY HRS BY 60 TO GET MINS
	STL CMA RTL
	RTL
	TAD	NUMB
	CLL CMA RTL
	DCA	HRMIN
	JMS I	(GETN	/GET MINS
	JMS I	BCKUP
	TAD	(MINCON
	DCA	S1	/SET UNITS TO MINUTES
	TAD	FUDGEH
	DCA	ACH	/INITIALIZE AC TO MIDNIGHT FUDGE
	TAD	FUDGEL	/BEFORE WE ADD IN TICKS
	DCA	ACL
	TAD	HRMIN
	JMP	FNDINT	/CONVERT MINUTES TO TICKS AND RETURN
	PAGE
	>
	$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search