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

/*** TSS/8 DAYTIM *** VERSION 1 ***\
/BY JOHN YOUNG		2/18/76
/
*0000
	CLA CLL
	TAD	RESTRT
	SRA
	UND
	JMP I	.+1
	INIT

*0020
PUTNUM=	JMS I	.
	NUMOUT	/NUMBER OUTPUT
PUTDAT=	JMS I	.
	DATER	/UNPACK DATE WORD
PUTIME=	JMS I	.
	TIME	/OUTPUT TIME
PUTMES=	JMS I	.
	MESOUT	/OUTPUT PAL TEXT

DATDAY,	0	/DAY
DATMON,	0	/MONTH
DATYR,	0	/YEAR

NUMPNT,	NUMHO
NUMHO,	0
	0
	0

RESTRT,	.+1
	STA
	CLOS		/CLEAN UP SHOP
	TAD	P15
	TLS
	TAD	N3
	TLS
	CLA HLT

P260,	"0-200
P240,	" -200
P7,	7
N7,	-7
P77,	77
P100,	100
P15,	15
N3,	-3
TMP0,	0
TMP1,	0
DAYPNT,	DAYTBL
MONPNT,	MONTBL
COMMES,	.
TEXT	", "
NINMES,	.
TEXT	"19"

PTABX1,	TAD	.+1
	7650
	7767
	7776
	7777

PTABX,	TAD	.+1
	0700
	1540
	4220
	6650

MESOUT,	0
	DCA	10
	TAD I	10
	DCA	TMP0
	TAD	TMP0
	RTR
	RTR
	RTR
	JMS	MESPUT
	TAD	TMP0
	JMS	MESPUT
	JMP	MESOUT+2
MESPUT,	0
	AND	P77
	SNA
	JMP I	MESOUT
	DCA	TMP1
	TAD	TMP1
	AND	P240
	SNA CLA
	TAD	P100
	TAD	TMP1
	JMS	TYPE
	JMP I	MESPUT

TYPE,	0
	TLS
	CLA
	JMP I	TYPE

*0200
/MAIN FLOW, GET DATA FROM TSS/8, AND CALL SUBROUTINES
INIT,	DATE		/GET DATE!
	DCA	TMP0	/SAVE FOR DAY OF WEEK
	TAD	NUMPNT
	TOD
	PUTIME		/GO PRINT HH:MM OF DAY
	TAD	P240

	JMS	TYPE	/A SPACE
	TAD	TMP0
	PUTDAT		/UNPACK DATE TO MONTH, DAY, YEAR
	TAD	TMP0
	CLL		/CLEAR OVERFLOW
	TAD	N7	/TAKE 7
	SZL		/TAKE TOO MUCH?
	JMP	.-3	/NO KEEP GOING
	TAD	P7	/YES, ADD BACK 7 (WE ONLY CARE ABOUT THE REMAINDER
	TAD	DAYPNT	/GET ADDRESS TO TABLE
	DCA	TMP0	/SAVE IT
	TAD I	TMP0	/SET POINTER TO MESSAGE
	PUTMES		/PRINT DAY OF WEEK
	TAD	COMMES
	PUTMES		/", "
	TAD	DATMON	/GET MONTH
	TAD	MONPNT	/GET ADDRESS INTO TABLE
	DCA	TMP0
	TAD I	TMP0	/GET ADDRESS TO MESSAGE
	PUTMES		/PRINT MONTH
	TAD	P240
	JMS	TYPE	/A SPACE
	TAD	DATDAY
	PUTNUM		/DAY OF MONTH
	S D 2
	TAD	COMMES
	PUTMES		/", "
	TAD	NINMES
	PUTMES		/"19"
	TAD	DATYR
	PUTNUM		/PRINT YEAR
	D 2
	JMP	RESTRT+1	/ALL DONE!!!!!

/ROUTINE TO UNPACK DATE WORD
/DATE WORD MUST BE # OF DAYS
/FROM 1/1/74
DATER,	0
	DCA	DATDAY		/SAVE DATE WORD
	TAD	DAT112
	DCA	DATYR
/CALCULATE # OF YEARS
DATE1,	TAD	DATDAY
	SMA CLA
	JMP	DATE2
	ISZ	DATYR
	TAD	DAT564
	TAD	DATDAY
	DCA	DATDAY
	JMP	DATE1
/NOW CALCULATE DAY OF MONTH
DATE2,	DCA	DATMON
	TAD	DATDAY
	TAD	DAT37
	SPA
	JMP	.+4
	ISZ	DATMON
	DCA	DATDAY
	JMP	DATE2+1
	CLA
	ISZ	DATDAY
/NOW HAVE DAY OF MONTH IN DATDAY
DATE3,	TAD	DATMON
	TAD	DAT14
	SPA
	JMP	.+4
	ISZ	DATYR
	DCA	DATMON
	JMP	DATE3
	CLA
/NOW HAVE DAY IN DATDAY
/YEAR IN DATYR
/AND MONTH IN DATMON
	JMP I	DATER

DAT564,	-564	/-372 DECIMAL
DAT14,	-14	/-12 DECIMAL
DAT37,	-37	/-31 DECIMAL
DAT112,	112	/74 DECIMAL

/ROUTINE TO OUTPUT TIME
/STORED IN NUMHO AND NUMHO+1 TO HH:MM:SS
TIME,	0
	TAD	PTABX
	DCA	PTIMX
	TAD	PTABX1
	DCA	PTIMX1
	TAD	PTFORM
	DCA	PTCONT

PTLOOP,	TAD	P260
	DCA	PTNUM
	CLL
	TAD	NUMHO+1
PTIMX,	NOP
	DCA	NUMHO+2
	RAL
	TAD	NUMHO
PTIMX1,	NOP
	SNL
	JMP	PTIMA
	DCA	NUMHO
	TAD	NUMHO+2
	DCA	NUMHO+1
	ISZ	PTNUM
	JMP	PTLOOP+2

PTIMA,	ISZ	PTIMX
	ISZ	PTIMX1
	CLA
	TAD	PTNUM
	JMS	TYPE
	TAD	PTCONT
	SNA
	JMP I	TIME
	CLL RAL
	DCA	PTCONT
	SZL
	JMP	PTLOOP
	TAD	PTCOLN
	JMS	TYPE
	JMP	PTLOOP

PTFORM,	5000
PTCOLN,	":-200
PTCONT,	0
PTNUM,	0

*0400
/COMBINATION OCTAL-DECIMAL OUTPUT ROUTINE
/ENTER:	TAD	VALUE
/	JMS	NUMOUT
/	S D 3
/	RETURN
/
/
/S	MEANS TO SUPPRESS LEADING ZEROS
/D	MEANS TO OUTPUT IN DECIMAL
/3	DIGITS TO OUTPUT, 1 TO 4 DIGITS
/
/

S=JMS
D=ISZ
AUX=17

NUMOUT,	0
	DCA	NUM
	TAD I	NUMOUT
	CLL RAL		/OCTAL OR DECIMAL OUTPUT?
	SPA CLA
	TAD	DECOCT	/DECIMAL
	TAD	OCTPNT	/OCTAL
	DCA	STKPNT	/PUT IT IN STACK POINTER
	TAD	P260
	DCA	DATA+1
	TAD	P260
	DCA	DATA+2
	TAD	P260
	DCA	DATA+3

	TAD	DATPNT
	DCA	DATA	/SET DATA POINTER
	CMA CLL RTL
	DCA	COUNT	/SET UP ISZ LOOP
	TAD	NUM	/GETETH OUT NUMBER
NUMLOP,	TAD I	STKPNT	/TAKE AWAY VALUE
	SPA
	JMP	.+3	/IF NEG, CHANGE TO POWER-1
	ISZ I	DATA	/TAKEN AWAY VAL, INCRE VALUE
	JMP	NUMLOP	/TAKE AWAY MORE
	DCA	NUM	/WE TOOK TOO MUCH
	TAD I	STKPNT	/ADD THAT VALUE BACK
	CIA
	TAD	NUM
	ISZ	DATA	/INCRE DATA TO NEXT CHAR
	ISZ	STKPNT	/INCRE STKPNT TO NEXT VALUE
	ISZ	COUNT	/ARE WE DONE?
	JMP	NUMLOP	/NOPE, GOWAN BACK!
	TAD	P4260	/THIS IS	A ZERO, BUT IT IS
	DCA	DATA+4	/NEGATIVE, INDICATES END OF STACK

	TAD I	NUMOUT	/ARE WE TO SUPPRESS
	SMA CLA		/LEADING ZEROS?
	JMP	NUMPUT	/NO, GO OUTPUT
	TAD	DATPNT
	DCA	DATA
	CMA CLL RTL
	DCA	COUNT
NUMSUP,	TAD	P260
	CIA
	TAD I	DATA	/IF THIS IS A ZERO
	SZA CLA		/PUT A SPACE HERE
	JMP	NUMPUT	/IF NOT, DON'T SUPPRESS ANYMORE
	TAD	P240
	DCA I	DATA
	ISZ	DATA
	ISZ	COUNT	/IF THIS IS ALL ZERO NUMBER
	JMP	NUMSUP	/DON'T@SUPPRE#S THE LAST ONE

NUMPUT,	TAD I	NUMOUT	/FIGURE NUMBER
	AND	P7	/OF CHARS TO OUTPUT
	CIA
	TAD	OUTPNT
	DCA	AUX
	TAD I	AUX
	TLS
	SMA CLA
	JMP	.-3
	ISZ	NUMOUT
	JMP I	NUMOUT

/HERE IS ALL THE DATA NEEDED FOR THE ROUTINE

P4260,	4260
COUNT,	0
STKPNT,	0
NUM,	0
DECOCT,	DECSTK-OCTSTK
OCTPNT,	OCTSTK
DECIMA
DECSTK,	-1000	/-1000 DECIMAL
	-100	/-100 DECIMAL
	-10	/-10 DECIMAL
OCTAL
OCTSTK,	-1000	/-1000 OCTAL
	-100	/-100 OCTAL
	-10	/-10 OCTAL

DATPNT,	.+2
DATA,	.+1
	0	/THOUSANDS
	0	/HUNDREDS
	0	/TENS
	0	/ONES+4000
OUTPNT,	.-1

MONTBL,	JAN-1
	FEB-1
	MAR-1
	APR-1
	MAY-1
	JUN-1
	JUL-1
	AUG-1
	SEP-1
	OCT-1
	NOV-1
	DEC-1

DAYTBL,	TUE-1
	WED-1
	THU-1
	FRI-1
	SAT-1
	SUN-1
	MON-1

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"

SUN,	TEXT	"SUNDAY"
MON,	TEXT	"MONDAY"
TUE,	TEXT	"TUESDAY"
WED,	TEXT	"WEDNESDAY"
THU,	TEXT	"THURSDAY"
FRI,	TEXT	"FRIDAY"
SAT,	TEXT	"SATURDAY"



$$$