File F1124.PA (PAL assembler source file)

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

/DATE ROUTINE PS/8 -FOR EAE OR NON EAE
	IFNDEF EAE <EAE=0>
/THIS PROGRAM IS TO PRINT THE DATE IN LONG
/FORM ON THE TTY.  THE TTY DEVICE HANDLER IS
/NOT USED FOR OUTPUT.
/ALSO IF IT IS NOT LOGOUT TIME (I.E.
/LOC 7777#0 AND LOC 7745=7777 (SET BY
/LOG ROUTINE) THEN MESSAGE OF THE DAY IS PRINTED.

/**UPDATE**

/4/15/73	JRC
/	CONDITIONAL ASSEMBLY FOR EAE AND NON EAE VERSION
/

/3/23/73	DEW
/	MESSAGE OF THE DAY DOES NOT WORK ON SYSTEMS
/	BUILD WITH "BUILD" AS THIS ROUTINE USED TO
/	ASSUME THAT THE TTY WAS DEVICE #3.  ALSO
/	A SPECIAL VERSION OF PIP WAS REQUIRED THAT
/	WAS FIXED UP TO BE CHAINABLE.  THE MODS
/	MADE ARE TO DIRECTLY OUTPUT MESSAG.DY TO
/	THE TTY, THUS NO LONGER REQUIRING A
/	SPECIAL VESION OF PIP.


/FIRST THE EAE SYMULATOR
/THIS CAN PROBABLY BE SHORTENED AND
/IMPROVED UPON.

FIELD 1
	IFZERO EAE <
*3000

SUDOMQ, 0
SUDOSC, 0
	>
	IFZERO EAE <	/FOR NON EAE ONLY

*3100
PSDNMI, 0		/NMI
	DCA PSDSCA	/SAVE AC
	DCA SUDOSC	/CLEAR STEP COUNTER.
	TAD PSDSCA
	SZA
	JMP .+5
	TAD SUDOMQ
	SNA CLA
	JMP I PSDNMI	/0 AC AND MQ.
NMIBK2, TAD PSDSCA
	RAL
	SZL
	JMP NMIOUT	/AC0=1
	SPA
	JMP NMIOUT+2	/AC0=0 AND AC1=1
	CLA		/AC0=AC1=0
NMIBCK, TAD SUDOMQ
	CLL RAL
	DCA SUDOMQ
	TAD PSDSCA
	RAL
	DCA PSDSCA
	ISZ SUDOSC
	JMP NMIBK2
NMIOUT, SPA
	JMP .+3 	/AC0=AC1=1
	RAR		/AC0 DOES NOT EQUAL AC1
	JMP I PSDNMI	/EXIT
	RAR		/TEST IF NUMBER 6000 0000
	TAD .+11
	SZA CLA
	JMP NMIBCK	/NOT 6000
	TAD SUDOMQ
	SZA
	JMP NMIBCK+1	/NOT 0000
	CML		/RESTORE LINK
	TAD PSDSCA	/RESTORE 6000
	JMP I PSDNMI	/EXIT
	-6000
PSDSCA, 0		/SCA
	DCA PSDMQA	/INCLUSIVE OR
	TAD PSDMQA	/STEP COUNTER
	CMA		/AND AC
	AND SUDOSC
	TAD PSDMQA
	JMP I PSDSCA
PSDMQA, 0		/MQA
	DCA PSDSCA	/INCLUSIVE OR
	TAD PSDSCA	/MQ
	CMA		/AND AC
	AND SUDOMQ
	TAD PSDSCA
	JMP I PSDMQA
	>
	IFZERO EAE <	/NON EAE CODE

*PSDNMI+100
PSDMQL, 0		/MQL
	DCA SUDOMQ
	JMP I PSDMQL
PSDCAM, 0		/CAM (CLA!MQL)
	CLA
	DCA SUDOMQ
	JMP I PSDCAM
MQLMUY, 0		/MQL!MUY
	DCA SUDOMQ
	TAD MQLMUY	/SET UP
	DCA PSDMUY	/FOR MUY SUBROUTINE
	JMP PSDMUY+1
MQLDVI, 0		/MQL!DVI
	DCA SUDOMQ
	TAD MQLDVI	/SET UP
	DCA PSDDVI	/FOR DVI SUBROUTINE
	JMP PSDDVI+1
	37
PSDSHL, 0		/SHL
	DCA PSDCAM	/SAVE AC
	TAD I PSDSHL	/SHIFT COUNT
	ISZ PSDSHL	/EXIT POINT
	AND PSDSHL-1	/5 BIT COUNTER
	CMA
	DCA SUDOSC
	TAD SUDOMQ	/SHIFT COMBINED
	CLL RAL 	/AC AND MQ
	DCA SUDOMQ	/1 BIT TO THE
	TAD PSDCAM	/LEFT
	RAL
	DCA PSDCAM
	ISZ SUDOSC
	JMP .-7 	/MORE SHIFTING
	TAD PSDCAM
	JMP I PSDSHL	/EXIT
PSDLSR, 0		/LSR
	DCA PSDCAM	/SAVE AC
	TAD PSDLSR	/USE ASR
	DCA PSDASR	/ROUTINE
	CLL
	JMP PSDASR+5
	>
	IFZERO EAE <	/MORE EAE SIMULATOR

PSDASR, 0		/ASR
	CLL		/SET LINK=SIGN
	SPA
	CML
	DCA PSDCAM	/SAVE AC
	TAD I PSDASR	/SHIFT COUNT
	ISZ PSDASR	/EXIT POINT
	AND PSDSHL-1	/5 BIT COUNTER
	CMA
	DCA SUDOSC
	TAD PSDCAM	/RESTORE AC
	JMP .+4
	TAD PSDCAM
	SPA
	CML
	RAR
	DCA PSDCAM
	TAD SUDOMQ
	RAR
	DCA SUDOMQ
	CLL
	ISZ SUDOSC
	JMP .-12		/MORE SHIFTING
	TAD PSDCAM
	SPA
	CML		/LINK=AC0
	JMP I PSDASR
	7763
PSDDVI, 0		/DVI
	DCA PSDCAM	/SAVE HIGH ORDER DIVIDEND
	TAD I PSDDVI	/DIVISOR
	ISZ PSDDVI	/EXIT POINT
	CLL CMA IAC
	DCA MQLMUY	/2'S COMPLEMENT OF DIVISOR
	TAD PSDCAM	/HIGH ORDER DIVIDEND
	TAD MQLMUY
	SZL CLA
	JMP I PSDDVI	/DIVIDE OVERFLOW
	TAD PSDDVI-1	/7763
	DCA PSDLSR	/COUNTER
	JMP .+11
	TAD PSDCAM
	RAL
	DCA PSDCAM
	TAD PSDCAM
	TAD MQLMUY
	SZL
	DCA PSDCAM
	CLA
	TAD SUDOMQ
	RAL
	DCA SUDOMQ
	ISZ PSDLSR
	JMP .-14
	TAD PSDCAM	/COUNT EXHAUSTED
	JMP I PSDDVI	/EXIT
	>
	IFZERO EAE <	/STILL MORE SIMUL

PSDMUY, 0		/MUY
	CLA CLL
	DCA MQLDVI	/CLEAR PRODUCT (MOST SIG.) REGISTER
	TAD PSDDVI-1
	DCA PSDLSR	/LOOP COUNTER
	TAD I PSDMUY
	DCA PSDMQL	/OPERAND
	ISZ PSDMUY	/EXIT POINT
	JMP .+10
	TAD MQLDVI
	SNL
	JMP .+3
	CLL
	TAD PSDMQL
	RAR
	DCA MQLDVI
	TAD SUDOMQ
	RAR
	DCA SUDOMQ	/LOW ORDER PRODUCT
	ISZ PSDLSR
	JMP .-13
	TAD MQLDVI	/HIGH ORDER PRODUCT
	JMP I PSDMUY	/EXIT
	>
/DATE ROUTINE - PS/8

	FIELD 1
	*2000

IFZERO EAE <	/DEFINES TO SIMULATOR
MQL=JMS I (PSDMQL
DVI=JMS I (PSDDVI
MQLADVI=JMS I (MQLDVI
MQA=JMS I (PSDMQA
	>
/
IFNZRO EAE <	/DEFINE FOR COMPATIBILITY
MQL=7421
DVI=7407
MQLADVI=MQL DVI
MQA=7501
	>

	CLA CLL
	TAD 7666	/GET DATE FROM MONITOR PAGE
	AND (7
	DCA YR
	TAD 7666
	RTR; RAR
	AND (37
	SNA
	JMP I (BADDAT
	DCA DAY
	TAD 7666
	RTL; RTL; RAL
	AND (17
	SNA
	JMP I (BADDAT
	DCA MONTH
	JMS WKDAY
	TAD MONTH
	JMS PRNMON
	TAD DAY
	JMS OCTDEC
	TAD (CMSPC-1
	JMS PRINT
	TAD YR
	TAD (3662	/ADD 1970 TO YEAR
	JMS OCTDEC
	JMP I (MSGDAY
YR,	0
DAY,	0
MONTH,	0
PRINT,	0
	DCA Z 10
PLOOP,	TAD I Z 10
	SNA
	JMP I PRINT
	JMS PCH
	JMP PLOOP
PCH,	0
	TLS
	TSF
	JMP .-1
	CLA CLL
	JMP I PCH
OCTDEC, 0		/AC CONTAINS OCTAL NUMBER
	MQLADVI 	/DIVIDE BY DECIMAL 1000
	1750
	DCA REM 	/SAVE THE REMAINDER
	MQA
	DCA NPOINT+1	/SAVE THE 1000'S DIGIT
	TAD REM
	MQLADVI 	/DIVIDE REM. BY DEC. 100
	144
	DCA REM 	/SAVE THE REMAINDER
	MQA
	DCA NPOINT+2	/SAVE THE 100'S DIGIT
	TAD REM
	MQLADVI 	/DIVIDE REM. BY DEC. 10
	12
	DCA NPOINT+4	/REMAINDER IS 1'S DIGIT
	MQA
	DCA NPOINT+3	/QUOTIENT IS 10'S DIGIT
	TAD NPOINT
	DCA 10
	TAD (BUFLO
	DCA BUF
DP1,	TAD I 10	/GET NEXT DIGIT
	SZA		/0?
	JMP .+5 	/NO
	TAD 10
	TAD DPMAX
	SZA CLA
	JMP DP1
	JMS DPT
	TAD I 10
	SPA
	JMP DPOUT
	JMP .-4
NPOINT, .
	0
	0
	0
	0
	4000
DPMAX,	-.+2
DPT,	0
	TAD K260
	DCA I BUF
	ISZ BUF
	JMP I DPT
DPOUT,	CLA
	DCA I BUF
	TAD (BUFLO-1
	JMS PRINT
	JMP I OCTDEC
REM,	0
K260,	260
BUF,	0
BUFLO,	ZBLOCK 7
CMSPC,	",;" ;0


	*2200
PRNMON, 0
	TAD (MNTBL-1
	DCA MNIND
	TAD I MNIND
	JMS PRMSG
	TAD (240	/SPACE
	JMS PCH
	JMP I PRNMON
/
PRMSG,	0
	DCA PRMSGT	/ADDRESS OF MESSAGE REQ. ON ENTRY
PRMGLP, TAD I PRMSGT
	JMS PRWD
	TAD I PRMSGT
	AND (77
	SNA CLA
	JMP I PRMSG
	ISZ PRMSGT
	JMP PRMGLP
PRMSGT, 0
PRWD,	0
	DCA PRWDT
	TAD PRWDT
	RTR;RTR;RTR
	JMS PCHAR
	TAD PRWDT
	JMS PCHAR
	JMP I PRWD
PRWDT,	0
PCHAR,	0
	AND (77
	SNA
	JMP I PCHAR
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMS I (PCH
	JMP I PCHAR
MNTBL,	JAN;FEB;MAR;APR;MAY;JUN;JUL;AUG;SEP;OCT;NOV;DEC
MNIND,	0
JAN,	TEXT /JANUARY/
FEB,	TEXT /FEBRUARY/
MAR,	TEXT /MARCH/
APR,	TEXT /APRIL/
MAY,	TEXT /MAY/
JUN,	TEXT /JUNE/
JUL,	TEXT /JULY/
AUG,	TEXT /AUGUST/
SEP,	TEXT /SEPTEMBER/
OCT,	TEXT /OCTOBER/
NOV,	TEXT /NOVEMBER/
DEC,	TEXT /DECEMBER/
MSGDY,	FILENAME MESSAG.DY


	*2400

IFZERO EAE <
MQL=JMS I (PSDMQL
DVI=JMS I (PSDDVI
MQLADVI=JMS I (MQLDVI
MQA=JMS I (PSDMQA
	>

WKDAY,	0
	TAD YR
	DCA DCOUNT
	TAD DCOUNT
	TAD (2
	MQLADVI
	4
	DCA REMAIN
	MQA
	TAD DCOUNT
	DCA DCOUNT
	TAD REMAIN
	SZA CLA
	JMP DISP
	TAD MONTH
	TAD (-3
	SMA CLA
	JMP DISP
	TAD DCOUNT
	TAD (6
	DCA DCOUNT
DISP,	TAD MONTH
	CIA
	TAD (JMP BRAN+15
	DCA BRAN
	TAD DCOUNT
BRAN,	JMP .
	TAD (2
	TAD (3
	TAD (2
	TAD (3
	TAD (3
	TAD (2
	TAD (3
	TAD (2
	TAD (3
	NOP
	TAD (3
	TAD DAY
	MQLADVI
	7
	TAD (WKTBL
	DCA WKIND
	TAD I WKIND
	JMS I (PRMSG
	TAD (CMSPC-1
	JMS PRINT
	JMP I WKDAY
REMAIN, 0
DCOUNT, 0
WKIND,	0
WKTBL,	WED;THU;FRI;SAT;SUN;MON;TUE
SAT,	TEXT /SATURDAY/
	*2600
MON,	TEXT /MONDAY/
TUE,	TEXT /TUESDAY/
WED,	TEXT /WEDNESDAY/
THU,	TEXT /THURSDAY/
FRI,	TEXT /FRIDAY/
SUN,	TEXT /SUNDAY/
BADMG1, TEXT /BAD DATE ON SYSTEM/
BADMG2, TEXT /PLEASE ENTER DATE:/
BADMG3, TEXT '.DATE MM/DD/YY'
BADDAT, TAD (BADMG1
	JMS I (PRMSG
	JMS CRLF
	TAD (BADMG2
	JMS I (PRMSG
	JMS CRLF
	TAD (BADMG3
	JMS I (PRMSG
EXIT,	CIF CDF 0
	JMP I (7605
CRLF,	0
	TAD (215
	JMS I (PCH
	TAD (212
	JMS I (PCH
	JMP I CRLF

/ALL OF THIS STUFF IS NEW TO MAKE
/CHANGES INDICATED IN "UPDATE".
/3/23/73

MSGDAY, CDF 0		/TO SEE IF MSGDAY REQUESTED
	TAD I (7777	/PICK UP USER LOG FLAG
	SNA CLA 	/SKIP IF LOGIN
	JMP EXIT	/NO: DONT PRINT MESSAGE WHEN LOGGING OUT
	ISZ I (7745	/TO SEE IF CALLED FROM LOG(START ADD)
	JMP EXIT	/NO: SO QUIT IT ALL.
	DCA I (7746	/NO RESTART
	CDF 10		/BACK TO THIS FIELD
	JMS I (7700	/USRIN
	  10
	CLA IAC 	/MESSAGE.DY MUST BE ON SYS
	JMS I (200	/SO LOOK IT UP
	  2
MSGFIL,   MSGDY
	  0
	JMP EXIT	/IF NO FILE JUST EXIT.
	TAD MSGFIL	/STARTING BLOCK
	DCA MSGBLK	/STASH FOR HANDLER
	JMS I (200	/NOW WE FETCH THE TTY HANDLER
	  1
	  DEVICE TTY
TTYENT,   .+200&7600	/TTY HANDLER ON NEXT PAGE.
	JMP EXIT	/HUH????
	JMS CRLF	/START WITH A NEW LINE

NXTBLK, CIF 0		/NOW READ IN THE FIRST BLOCK
	JMS I (7607	/USING SYS
	  0210		/INTO FIELD 1
	  .+400&7600	/TWO PAGES AWAY
MSGBLK,   0		/THE BLOCK
	JMP EXIT	/CAN'T HAPPEN
	CIF 0		/NOW WRITE IT OUT
	JMS I TTYENT	/ON THE TTY
	  4210
	  .+400&7600
	  0		/NOT USED
	JMP EXIT	/HUH..
	ISZ MSGBLK	/NEXT BLOCK
	ISZ MSGFIL+1	/ANY MORE?
	JMP NXTBLK	/YEP
	JMP EXIT	/NOPE.....

	PAGE
	STHAND=.
	/THIS CONTAINS TTY HANDLER FOR MESSAG.DY
	STBUFF=.+200
	/AND TWO PAGES OF BUFFER.
	ENDBUFF=.+600

$$$$$$$$$$$$



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