;;;-*-Midas-*-

TITLE PDTIME SETTER
.INSRT DSK:SYSENG;JSF MACROS

RDTIM=:702200,,			; KS10 CLOCK INSTRUCTIONS
WRTIM=:702600,,

;AC DEFINITIONS

FF=0
A=1
AA=2
B=3
C=4
D=5
E=6
G=10
R=13
T=14
TT=15
Q=16
P=17

;IO CHANNELS

DISC==6	;DISPLAY CHANNEL FOR DISPLAYING TIME AND DATE

;FLAG DEFINITIONS

GETTY==RHF FF,1		;ONE => GE TTY
DSTF==RHF FF,2		;DAYLIGHT SAVINGS TIME IN EFFECT
ARGF==RHF FF,4		;ARGUMENT TYPED
ARGCF==RHF FF,10	;ARGUMENT COMPLETED
LYRF==RHF FF,20		;1 => NORMAL YEAR AFTER FEB 28
MINUSF==RHF FF,200	;MINUS SIGN TYPED
AMF==RHF FF,400		;"A" TYPED THIS ARG
PMF==RHF FF,1000	;"P" TYPED THIS ARG
RAMF==RHF FF,2000	;FTIME IS AM
RPMF==RHF FF,4000	;FTIME IS PM
SYLTMF==RHF FF,10000	;:JCL SYL IS TIME, NOT DATE

;RANDOM

LPDL==40	;LENGTH OF PDL
LCMBUF==40	;LENGTH OF TYPEIN BUFFER
SPD=60.*60.*24.	;NUMBER OF SECONDS IN A DAY (FITS IN A HALF-WORD)
PDUPS==60.	;# DECORIOLIS CLOCK UNITS PER SECOND

;MACROS
DEFINE CMD CHAR,ROUT,BLURB/
CONCAT EXPUNGE CHR,\<CHAR>-40
DEF CHR,\<CHAR>-40,[
ROUT
]
IFSE [BLURB],CONCAT CHB,\<CHAR>-40,==0
IFSN [BLURB],[CONCAT EXPUNGE CHB,\<CHAR>-40
DEF CHB,\<CHAR>-40,[
[ASCIZ \BLURB\]
]]
TERMIN

IF1,[REPEAT 100,[CONCAT CHR,\.RPCNT,==0
CONCAT CHB,\.RPCNT,==0
]
]

FOO==.

LOC	41
	JSR UUOH
LOC	FOO

DEFINE UUOIRP A
IRP UUO,,[ERR,TYPE]
A
TERMIN
TERMIN

FOO==0
UUOIRP FOO==FOO+1	;COUNT UUOS
NUUOS==FOO	;NUMBER OF UUOS
MINUUO==<100-NUUOS>	;OP CODE OF MINIMUM UUO
FOO==0
UUOIRP [UUO=<MINUUO+FOO>_33
FOO==FOO+1]	;ACTUAL UUO DEFINITIONS

UUOH:	0		;UUO PROCESSOR
	PUSH P,A	;SAVE A
	PUSH P,B	;SAVE B
	HRRZ B,40	;GIVE UUO ROUTINE RH OF LOCATION 40
	LDB A,[331100,,40]	;GET OP CODE
	CAIGE A,MINUUO	;IF TOO SMALL,
ILUUO:	.VALUE		;THEN COMPLAIN
	PUSHJ P,@UUODTB-MINUUO(A)	;CALL ROUTINE FOR INDIVIDUAL UUO
	JRST .+2	;NON-SKIP RETURN POINT
	AOS UUOH	;ROUTINE SKIPPED, INCREMENT RETURN POINT
	POP P,B		;RESTORE B
	POP P,A		;RESTORE A
	JRST 2,@UUOH	;RETURN

UUODTB:	UUOIRP A!UUO	;DISPATCH TABLE

ATYPE:	JUMPE B,CPOPJ	;IGNORE ADDRESS OF 0
	HRLI B,440700	;TURN INTO BYTE POINTER
TYPEL:	ILDB A,B	;GET CHARACTER
	JUMPE A,CPOPJ	;IF ZERO THEN THAT'S ALL
	PUSHJ P,TYO	;NON-ZERO, TYPE IT OUT
	JRST TYPEL

AERR:	PUSHJ P,ATYPE	;TYPE OUT THE TEXT STRING,
	MOVE P,[-LPDL,,PDL]	;RESTORE PDL
	JRST ERRET	;GO TO ERROR RETURN POINT

IF1,[
TYIC==1
TYOC==2
TYIMOD==24	;IMAGE MODE, OLD MODE
TYOMOD==1	;ASCII OUTPUT
]

INITTY:	.OPEN TYIC,[TYIMOD,,'TTY]
	 .LOSE 1000
	.OPEN TYOC,[TYOMOD,,'TTY]
	 .LOSE 1000
	.STATUS TYOC,A
	TRNN A,77#2	;SKIP IF NOT GE (OR CHANNEL CLOSED)
	TMODF OA,GETTY	;GE CONSOLE
	CLEARF GETTY
	POPJ P,

CRCFT:	PUSH P,(A)	;SAVE CHARACTER TO TYPE INSTEAD OF LINE FEED
	MOVEI A,15	;CR
	PUSHJ P,TYO
	POP P,A		;RETRIEVE SECOND CHARACTER
	TESTF N,GETTY	;IF CONSOLE IS TTY,
	MOVEI A,12	;THEN REALLY WANT LINE FEED FOR SECOND CHARACTER
	JRST TYO	;TYPE IT OUT

CRLF:	JSP A,CRCFT
	12

CRFF:	JSP A,CRCFT
	12		;Don't type 14, it's not going to do anything useful

CRRR:	JSP A,CRCFT
	"*

SPACE4:	PUSHJ P,.+1	;TYPE FOUR SPACES
SPACE2:	PUSHJ P,.+1	;TYPE TWO SPACES
SPACE:	MOVEI A,40	;SPACE
	JRST TYO

TAB:	MOVEI A,11	;TYPE A TAB
	JRST TYO

		;GET A TYPED IN CHARACTER, ECHO IT

.SCALAR SYSTIM	;SYSTIM RESULT OF .RTIME WHEN CHARACTER INPUT
.SCALAR PDDTIM	;PDDTIM DATAI FROM PDCLK ON EACH CHARACTER TYPED IN
.SCALAR SYSDUR	;SYSDUR TIME IN THIRTIETHS SINCE SYSTEM BROUGHT UP
.VECTOR KSTIME(2)	;KS10 CLOCK READING ON EACH CHARACTER TYPED IN

TYI:	.IOT TYIC,SYSTIM
	SKIPE KS10P
	 JRST TYIKS
DATAIX:	DATAI 500,PDDTIM
	MOVSI A,600000
	ANDCAM A,PDDTIM
	JRST TYIALL

TYIKS:	RDTIM KSTIME
	HRRZS KSTIME
TYIALL:	.RDTIME A,
	MOVEM A,SYSDUR
	.RTIME A,
	EXCH A,SYSTIM
	CAIL A,"a		;LOWER CASE?
	 CAILE A,"z
	  CAIA
	   SUBI A,40		;CONVERT TO UPPER CASE


		;TYPE OUT THE CHARACTER IN A

TYO:	.IOT TYOC,A
CPOPJ:	POPJ P,

		;TYPE OUT THE SIXBIT WORD IN AA

SIXTYO:	JUMPE AA,CPOPJ	;IF AA CLEAR THEN RETURN
	MOVEI A,0	;CLEAR A
	LSHC A,6	;SHIFT CHARACTER INTO A
	ADDI A,40	;CONVERT TO SIXBIT
	PUSHJ P,TYO	;TYPE IT OUT
	JRST SIXTYO	;GO GET REST

.SCALAR KL10P
.SCALAR KA10P	; One of these will be set.
.SCALAR KS10P

.SCALAR KSFREQ	;KS-ticks per PD-tick

.SCALAR STLCP	;.SETLOCING FROM STLCP SETLOCS PDTIME FROM IPDTIM
.SCALAR STLCY	;.SETLOCING FROM STLCY SETLOCS FYEAR FROM YEAR
.SCALAR STYTIM	;SETLOCS PDYTIM FROM YTIME

BEG:	MOVEI FF,0	;INITIALIZE FLAGS
	MOVE P,[-LPDL,,PDL]
IRPS SYM,,[KA10P KL10P KS10P]
	MOVE A,[SQUOZE 0,SYM ]
	.EVAL A,
	 .LOSE
	MOVEM A,SYM
TERMIN
	MOVE A,[SQUOZE 0,KSFREQ]
	.EVAL A,
	 MOVEI A,<<1000._12.>+30.>/60.	; Pre-KSFREQ value.
	MOVEM A,KSFREQ
	.RDTIME A,
	MOVEM A,SYSDUR	;INITIALIZE FOR :JCL HACK
	.IOTLSR P,	;FOR DATAI, RDTIM, ETC.
	SKIPN KS10P
	 XCT DATAIX	;READ PDCLK
	PUSHJ P,INITTY	;INITIALIZE TTY
	PUSHJ P,CRFF	;TYPE CRLF OR CRFF
	MOVE A,[SQUOZE 0,PDTIME ]
	.EVAL A,
	 .VALUE		;NOT DEFINED?
	HRLI A,IPDTIM	;.SETLOC'ED ONLY FROM IPDTIM
	MOVEM A,STLCP
	MOVE A,[SQUOZE 0,FYEAR ]
	.EVAL A,
	TDZA A,A	;NOT DEFINED THIS SYSTEM
	HRLI A,YEAR
	MOVEM A,STLCY
	MOVE A,[SQUOZE 0,PDYTIM ]	;# HALF-SECONDS SINCE BEGINNING OF YEAR, BACKUP TO DEVICE 500
	.EVAL A,
	TDZA A,A	;OLD SYSTEM
	HRLI A,YTIME
	MOVEM A,STYTIM
;don't really call JCLCHK, it has a habit of fucking up the time totally.
;	PUSHJ P,JCLCHK	;MAYBE CALLED WITH :PDSET YYMMDD HHMMSS
;	JRST GCMD1	;YES, AND GOT PROCEEDED FROM QUIT
	MOVE AA,[SIXBIT /PDSET./]
	PUSHJ P,SIXTYO
	MOVE AA,[.FNAM2]
	PUSHJ P,SIXTYO
	TYPE [ASCIZ/
Please don't use this program unless you know how.
You are certain to break something if you happen to hit the wrong key.
Type Control-Z to exit, or ? for a reminder of the commands./]


GCMD1:	PUSHJ P,CRRR
ERRET:	CLEARF ARGF\ARGCF\MINUS\PMF
	SETZM VALUE
	SETZM LZCNT	;CLEAR LEADING ZEROS COUNT
GCMD:	PUSHJ P,TYI
	CAIL A,40
	CAILE A,140
	JRST N6B	;NOT SIXBIT
	MOVEI T,-40(A)
	IDIVI T,3
	LDB T,DTBP(TT)
	JUMPE T,ERRET	;IF NOT COMMAND THEN CLEAR STATUS OF ARG, BUT OTHERWISE IGNORE
	PUSHJ P,(T)
	JRST GCMD1	;ROUTINE DIDN'T SKIP, REINITIALIZE ARGUMENTS
	JRST GCMD	;ROUTINE SKIPPED, DON'T REINITIALIZE
	JRST ERRET	;ROUTINE SKIPPED TWICE, REINITIALIZE BUT DON'T TYPE CRRR

N6B:	CAIN A,177	;IF RUBOUT,
	ERR HUH		;THEN RESET COMMAND STATUS
	CAIN A,^Z
	 JRST WIPOUT
		;INSERT NON-SIXBIT COMMANDS HERE
	JRST ERRET	;REINITIALIZE ARGUMENT STATUS, OTHERWISE IGNORE

	CMD "?,QUEST,LIST COMMANDS

QUEST:	MOVE B,[441400,,BTB]
	MOVEI T,40
	PUSHJ P,CRFF
QUESTL:	ILDB AA,B
	CAIN AA,7777	;DONE?
	POPJ P,		;YES
	JUMPE AA,QUSTL2	;NO, BUT JUMP IF INACTIVE CHARACTER
	MOVE A,T	;GET CHARACTER THIS COMMAND
	PUSHJ P,TYO	;TYPE OUT THE CHARACTER
	PUSHJ P,SPACE4	;TYPE 4 SPACES
	TYPE (AA)	;TYPE THE BLURB
	PUSHJ P,CRLF	;NEW LINE
QUSTL2:	AOJA T,QUESTL

		;GET THE CURRENT VALUE INTO A AND SKIP, OR DON'T SKIP IF NO VALUE

ARGET:	TESTF N,MINUSF	;IF MINUS NOT TYPED,
	SKIPA A,VALUE	;THEN RETURN VALUE
	MOVN A,VALUE	;RETURN NEGATIVE OF VALUE
	TESTF E,ARGF
POPJ1:	AOS (P)		;ARGUMENT EXISTS
	POPJ P,

		;NUMBERS

	REPEAT 9,CMD "1+.RPCNT,NUM

.SCALAR VALUE	;VALUE OF ARGUMENT TYPED IN

NUM:	TESTF E,ARGCF
	ERR HUH		;ERROR IF CURRENT VALUE COMPLETED (LEFT OVER FROM PROGRAM THIS SWIPED FROM)
	SUBI A,"0	;CONVERT CHARACTER TO DIGIT
	MOVEI AA,10.	;UPDATE VALUE IN DECIMAL
	IMULM AA,VALUE
	ADDM A,VALUE
STRGFJ:	SETF ARGF
	JRST POPJ1	;SKIP-RETURN SO AS NOT TO KILL CURRENT VALUE

	CMD "0,ZERO

.SCALAR LZCNT	;NUMBER OF LEADING ZEROS IN ARGUMENT

ZERO:	SKIPE VALUE	;IF NON-ZERO DIGITS HAVE BEEN TYPED,
	JRST NUM	;THEN DIGIT
	TESTF E,ARGCF	;LEADING ZERO, BUT FIRST CHECK FOR ARGUMENT FINALIZED
	ERR HUH
	AOS LZCNT
	JRST STRGFJ	;SET ARGF AND SKIP-RETURN

	CMD "-,MINUS

MINUS:	TESTF E,ARGF	;IF ARGUMENT,
	ERR HUH		;THEN COMPLAIN
	SETF MINUSF	;SET FLAG,
	JRST POPJ1	;RETURN

	CMD "Q,WIPOUT,WIPE OUT JOB 

WIPOUT:	.BREAK 16,140000	;$^X.
	POPJ P,

	CMD "X,RETTY,RETURN TTY TO DDT

RETTY:	.VALUE [0]
	POPJ P,

		;LOSE IF NEXT CHARACTER TYPED IN IS NOT A PERIOD

LOSSNP:	PUSHJ P,TYI	;GET CHARACTER
	CAIE A,".
	ERR HUH		;NOT PERIOD
	POPJ P,

		;NOW FOR ACTUAL TIME HACKING

	CMD "E,STNDTM

STNDTM:	PUSHJ P,ARGET	;TAKES OPTIONAL ARGUMENT (THE VALUE OF THE FLAG)
	MOVEI A,0	;IF NO ARG THEN 0
	DPB A,[FLGBP DSTF,]	;DEPOSIT IN FLAG
	POPJ P,

	CMD "D,SETDAT,SET DATE (precede by YYMMDD, for example 760704D)

.SCALAR DATE	;SIXBIT DATE TYPED IN (YYMMDD)

SETDAT:	PUSHJ P,NUMGET
	MOVEM C,DATE
	POPJ P,

	CMD "T,SETTIM,SET TIME (precede by HHMMSS, for example 120000T is noon)

.SCALAR FTIME	;STORE TIME (SIXBIT /HHMMSS/)

SETTIM:	PUSHJ P,NUMGET
	MOVEM C,FTIME
	JRST APMCPY	;AM, PM, OR 24 HOUR TIME?

NUMGET:	PUSHJ P,ARGET
	TDZA C,C	;NO ARG => CLEAR SIXBIT (USE REAL 0)
	JRST DECDEP	;ARGUMENT, INTERPRET IT
	POPJ P,		;NO ARG, RETURN 0

DECDEP:	MOVEI C,0	;INITIALIZE SIXBIT
	MOVE B,[440600,,C]	;SET UP BYTE POINTER TO SIXBIT
	PUSHJ P,DECDPR
	IOR C,[SIXBIT /000000/]
	POPJ P,

DECDPR:	IDIVI A,10.
	JUMPE A,DCDPR3
	HRLM AA,(P)
	PUSHJ P,DECDPR
	HLRZ AA,(P)
DCDPR2:	MOVEI A,'0(AA)
DCDDEP:	TLNN B,770000
	ERR [ASCIZ /NUMBER TOO LONG.
/]
	IDPB A,B
	POPJ P,

		;TYPE OUT LEADING ZEROS

DCDPR3:	SKIPG T,LZCNT	;GET LEADING ZEROS COUNT, SKIP IF THERE ARE SOME
	JRST DCDPR2	;NONE, KEEP GOING
	MOVEI A,'0	;INITIALIZE A FOR IDPB
	PUSHJ P,DCDDEP	;DEPOSIT ZERO
	SOJG T,.-1	;DO IT THE RIGHT NUMBER OF TIMES,
	JRST DCDPR2	;THEN CONTINUE

		;NOW FOR THE MAIN COMMAND

	CMD "!,DOIT,Actually store the time into the system (type "!.")

DOIT:	PUSHJ P,LOSSNP	;LOSS IF NEXT CHARACTER TYPED IN NOT A .
JCLCKD:	PUSHJ P,HAKDAT	;GET DATE, SET DSTF AND LYRF
	PUSHJ P,DCPHD	;DECIPHER DATE (CALCULATE DIY (DAY IN YEAR))
	PUSHJ P,CDTIM	;CALCULATE DTIME (MAYBE ALSO UPDATE DIY IS DST)
	PUSHJ P,CPDTIM	;CALCULATE IPDTIM (DESIRED OFFSET FOR PDTIME)
	SKIPN KA10P
	 JRST DOIT1
	SKIPN PDDTIM	;IF CLOCK OFF,
	 JRST SBKUP	;THEN UPDATE BACKUP INSTEAD
DOIT1:	MOVE A,STLCP	;GET SETLOC WORD FOR PDTIME
DOIT2:	.SETLOC A,
	SKIPE A,STLCY	;NOW DO IT FOR YEAR, IF THAT KIND OF SYSTEM
	 .SETLOC A,
	SKIPA		;GIVE SETLOC A CHANCE TO HAPPEN BEFORE STARTING CLOCK
	SKIPA
	.HANG
	SKIPE KL10P
	 CONO 500,400007	;START CLOCK ON KL
	SKIPN KS10P
	 POPJ P,		;THAT'S ALL UNLESS THIS IS A KS
	RDTIM A
	HRLI A,1729.
	WRTIM A
	POPJ P,

SBKUP:	.RDTIME A,	;SEE HOW LONG IT'S BEEN SINCE . TYPED
	SUB A,SYSDUR	;" " "
	IDIVI A,15.	;CONVERT TO HALF-SECONDS
	ADDM A,YTIME	;UPDATE YTIME TO NOW
	SKIPE A,STYTIM	;GET SETLOC WORD FOR PDYTIM (BACKUP)
	JRST DOIT2	;DO THE .SETLOC, THEN SET YEAR
	POPJ P,		;NOT DEFINED, NOTHING ELSE TO DO

	CMD "C,CENSET

CENSET:	PUSHJ P,ARGET	;GET CENTURY (-1)
	MOVEI A,19.	;NO ARG, RESET TO DEFAULT
	IMULI A,100.	;CONVERT TO YEAR
	MOVEM A,CENTURY	;SET CENTURY
	POPJ P,

CENTURY:	1900.	;CENTURY (FOR FIRST TWO DIGITS OF YEAR)

	CMD "A,AM
	CMD "P,PM

AM:	TMODF OA,AMF	;"A" => AM
PM:	TMODF OA,PMF	;"P" => PM
	TMODF ZA,PMF	;AM
	CLEARF AMF	;PM
	JRST POPJ1

APMCPY:	CLEARF RAMF\RPMF	;COPY AMF AND PMF INTO RAMF AND RPMF
	TESTF E,AMF
	SETF RAMF	;AM
	TESTF E,PMF
	SETF RPMF	;PM
	POPJ P,

.SCALAR YEAR	;YEAR HAS YEAR (E.G. 1969.)
.SCALAR TIME	;TIME HAS TIME IN SIXBIT

HAKDAT:	SKIPN A,DATE
	.RDATE A,	;NONE TYPED IN, USE THE SYSTEM'S
	JUMPL A,[ERR [ASCIZ / DATE NOT AVAILABLE.
/]]
	MOVEM A,DATE
	LDB A,[301200,,DATE]	;GET YEAR (LAST TWO DIGITS)
	PUSHJ P,6CVB	;CONVERT TO BINARY
	TRNN A,3	;NOW FOR THE LEAP YEAR FLAG
	TMODF ZA,LYRF	;LEAP YEAR
	SETF LYRF	;NORMAL YEAR
	MOVE A,DATE
	TLZ A,777700	;YEAR NO LONGER NEEDED
	CAMG A,[SIXBIT /  0229/]	;IF BEFORE MARCH FIRST,
	CLEARF LYRF	;THEN NO NEED TO COMPENSATE FOR NOT BEING LEAP YEAR
	CLEARF DSTF	;ASSUME STANDARD TIME FOR THE TIME BEING
	CAML A,[SIXBIT /  0401/]	;IF BEFORE APRIL 1,
	 CAMLE A,[SIXBIT /  1031/]	;OR AFTER OCTOBER 31,
	  JRST HAKDT2			;THEN STANDARD TIME
	CAMLE A,[SIXBIT /  0407/]	;IF BEFORE APRIL 8,
	 CAML A,[SIXBIT /  1025/]	;OR AFTER OCTOBER 24,
	  JRST HAKDT3			;THEN NOT CLEAR
	SETF DSTF		;DAYLIGHT SAVINGS TIME
HAKDT2:	LDB A,[301200,,DATE]	;GET YEAR (LAST TWO DIGITS)
	PUSHJ P,6CVB		;CONVERT TO BINARY
	ADD A,CENTURY	;CONVERT TO REAL YEAR
	MOVEM A,YEAR
	SKIPN A,FTIME	;GET TYPED IN TIME, BUT IF IT DOESN'T EXIST,
	MOVE A,SYSTIM	;THEN GET SYSTEM TIME AT LAST CHARACTER TYPED IN
	MOVEM A,TIME
	POPJ P,		;THAT'S ALL

HAKDT4:	CAIN A,177	;LOOP POINT FOR FINDING OUT FROM TTY WHETHER DAYLIGHT SAVINGS TIME
	ERR HUH		;CHAR. IS RUBOUT, QUIT
	TYPE [ASCIZ /?
/]
HAKDT3:	TYPE [ASCIZ /DAYLIGHT SAVINGS TIME?  /]
	.IOT TYIC,A	;GET CHARACTER, BUT DON'T CLOBBER PDDTIM, SYSTIM
	.IOT TYOC,A	;ECHO THE CHARACTER
	CAIE A,"y	;IF y,
	 CAIN A,"n	;OR IF n,
	  JRST HAKDT9	;THEN OK, USE IT
	CAIE A,"Y	;IF Y,
	 CAIN A,"N	;OR IF N,
	  JRST HAKDT9	;THEN OK, USE IT
	JRST HAKDT4	;NEITHER, COMPLAIN AND LOOP

HAKDT9:	DPB A,[FLGBP DSTF,]	;"N&1=0, "Y&1=1
	JRST HAKDT2

		;TABLE OF NUMBER OF DAYS IN LEAP YEAR GONE BY AT BEGINNING OF MONTH

LMNTBL:	FOO==0
IRPS L,,[31 29 31 30
	31 30 31 31
	30 31 30 31]
	FOO
	FOO==FOO+L!.
TERMIN

IFN FOO-366.,PRINTA LMNTBL LOSES.

		;DECIPHER DATE (CALCULATE DIY)

.SCALAR DIY	;DATE IN YEAR (0 => JAN 1)

DCPHD:	LDB A,[141200,,DATE]	;GET MONTH
	PUSHJ P,6CVB	;CONVERT TO BINARY
	MOVE B,LMNTBL-1(A)	;GET # DAYS IN YEAR SINCE BEGINNING OF MONTH
	LDB A,[1200,,DATE]	;GET DAY IN MONTH
	PUSHJ P,6CVB
	TESTF E,LYRF
	SUBI A,1	;NORMAL YEAR AFTER FEB 28
	ADDI B,-1(A)
	HRRZM B,DIY
	POPJ P,

		;CONVERT A 2 DIGIT RIGHT-ADJUSTED SIXBIT NUMBER MASKED TO 10. BITS TO BINARY

6CVB:	IDIVI A,100
	IMULI A,10.
	ADDI A,-'0(AA)
	POPJ P,

		;CALCULATE DTIME (# SECS. SINCE BEGINNING OF DAY), MAYBE ALSO SOS DIY

.SCALAR DTIME	;# SECONDS SINCE BEGINNING OF DAY

CDTIM:	SKIPGE TIME
	ERR [ASCIZ / TIME NOT AVAILABLE.
/]
	LDB A,[301200,,TIME]	;HOUR
	PUSHJ P,6CVB
	TESTF N,RAMF\RPMF
	JRST CDTIM3	;24 HOUR NOTATION
	IDIVI A,12.	;AM OR PM SPECIFIED
	TESTF N,PMF
	SKIPA A,AA	;AM
	MOVEI A,12.(AA)	;PM
CDTIM3:	TESTF N,DSTF
	JRST CDTIM2
	SOJGE A,CDTIM2	;SKIP FOLLOWING IF NO DATE ERROR
	MOVEI A,23.*60.
	SOSA DIY
CDTIM2:	IMULI A,60.	;CONVERT TO MINUTES
	MOVE B,A
	LDB A,[141200,,TIME]	;MINUTE
	PUSHJ P,6CVB
	ADD B,A
	IMULI B,60.	;CONVERT TO SECONDS
	LDB A,[1200,,TIME]	;SECOND
	PUSHJ P,6CVB
	ADD B,A
	MOVEM B,DTIME
	POPJ P,

RTYIP:	0		;POINTER INTO RTYIBF
IFNDEF RTYIBL,RTYIBL==20.	;LENGTH OF RTYIBF (IN WORDS)
RTYIBF:	BLOCK RTYIBL+1	;:JCL BUFFER

		;GET CHAR FROM :JCL STRING

RTYI:	ILDB A,RTYIP
	JUMPN A,CPOPJ
	ERR [ASCIZ /BAD :JCL STRING.
/]

GTSYL:	MOVEI C,0	;CALLED WITH JSP R,; CLEAR OUT NAME
	MOVE B,[440600,,C]	;SET UP BYTE POINTER TO NAME
	JRST GTSYL1	;FALL IN, GET FIRST CHARACTER

GTSYL2:	SUBI A,40	;HERE TO USE CHAR, CONVERT IT TO SIXBIT
	TLNE B,770000	;SKIP IF NAME FULL
	IDPB A,B	;DEPOSIT CHARACTER IN NAME
GTSYL1:	PUSHJ P,RTYI	;GET NEXT CHAR
	CAIL A,140
	SUBI A,40	;CONVERT LOWER CASE TO UPPER
	JRST (R)

GETSYL:	JSP R,GTSYL	;READ NUMBER FOR :JCL FEATURE
	CAIL A,"0
	CAILE A,"9
	JRST .+2	;NOT DIGIT
	JRST GTSYL2	;USE DIGIT
	CAIN A,"A
	JRST JCLAM	;"A" => AM
	CAIN A,"P
	JRST JCLPM	;"P" => PM
	CAIE A,"M
	CAIN A,":
	JRST JCLTIM	;M AND : IDENTIFY THIS NUMBER AS TIME BUT HAVE NO OTHER EFFECT
	POPJ P,		;SOMETHING ELSE => END OF NUMBER

JCLAM:	TMODF OA,AMF	;"A" => AM
JCLPM:	TMODF OA,SYLTMF\PMF	;"P" => PM
	TMODF ZA,PMF	;AM
	TMODF ZA,AMF	;PM
JCLTIM:	SETF SYLTMF	;"M" OR ":" => TIME, NOT DATE
	JRST GTSYL1

		;HERE FROM BEG, CHECK FOR :JCL STRING, SKIP IF NONE

JCLCHK:	MOVE A,[RTYIBF,,RTYIBF+1]
	SETZM RTYIBF
	BLT A,RTYIBF+RTYIBL	;CLEAR OUT RTYIBF
	AOS RTYIBF+RTYIBL	;MAKE LAST WORD NON-ZERO
	MOVE A,[440700,,RTYIBF]	;SET UP INITIAL BYTE POINTER
	MOVEM A,RTYIP
	.BREAK 12,[5,,RTYIBF]	;MAYBE GET COMMAND STRING
	SKIPN RTYIBF
	JRST POPJ1	;NO :JCL COMMAND
	SETZM DATE	;CLEAR DATE
	SETZM FTIME	;CLEAR TIME
	PUSHJ P,JCLG	;GOBBLE YYMMDD HHMMSS COMMAND LINE
	PUSHJ P,APMCPY	;AM, PM, OR 24 HOUR TIME
	PUSHJ P,JCLCKD	;DO IT
	JRST WIPOUT	;THAT'S ALL, UNLESS HE PROCEEDS IT

		;GOBBLE COMMAND LINE OF THE FORM YYMMDD HHMMSS

JCLG2:	MOVEM C,FTIME
JCLG3:	CAIN A,^M
	POPJ P,		;END OF LINE, STOP RECURSING
JCLG:	PUSHJ P,GETSYL	;ENTRY
	TDON C,[SIXBIT /000000/]
	JRST JCLG3	;NO SYL YET
	TMODF ZE,SYLTMF	;SEE IF DECLARED TO BE TIME
	JRST JCLG2	;YES
	PUSH P,C	;NO
	PUSHJ P,JCLG	;RECURSE
	POP P,C
	SKIPE FTIME
	MOVEM C,DATE
	SKIPN FTIME
	MOVEM C,FTIME
	POPJ P,

		;CALCULATE OFFSET (IPDTIM)

.SCALAR YTIME	;# HALF-SECONDS SINCE BEGINNING OF YEAR
.SCALAR IPDTIM	;CALCULATED OFFSET

CPDTIM:	MOVE A,DIY
	IMULI A,SPD
	ADD A,DTIME
	LSH A,1
	MOVEM A,YTIME
	MULI A,PDUPS/2
	DPB A,[430100,,AA]
	SKIPE KS10P
	 JRST CKSTIM
	MOVE B,PDDTIM
	SUB B,AA
	MOVEM B,IPDTIM
	POPJ P,

CKSTIM:	DMOVE B,KSTIME		; B!C
	DIV B,KSFREQ
	SUB B,AA
	MOVEM B,IPDTIM
	POPJ P,

		;DATA AREA FOR TIME DISPLAY ROUTINE THAT BEGINS ON NEXT PAGE

		;NORMAL CHARACTER

DISTYO:	.VALUE		;SHOULDN'T TRY TO TYPE A CHARACTER ON DISPLAY
	REPEAT 2,.IOT DISC,A
	REPEAT 2,PUSHJ P,TYO

		;CLEAR SCREEN OR ETC.

DISFF:	MOVEI B,DISTIM	;SET POINTER FOR MOVEM
	PUSHJ P,DISCRF
	.IOT DISC,[14]
	PUSHJ P,CRLF
	PUSHJ P,CRFF

		;TAB OR CR AFTER TIME

DISTAB:	MOVEI B,DISDAT	;SET POINTER FOR MOVEM
	.IOT DISC,[11]
	.IOT DISC,[11]
	PUSHJ P,TAB
	PUSHJ P,TAB

		;SLEEP TIME

SLPTIM:	7
	150.
	60.
	150.
	60.

TYDISO:	1,,(SIXBIT /T00/)	;USED FOR .OPEN ON NUMBERED TTY

	CMD "S,DSTIM,SHOW (DISPLAY) TIME AND DATE

	;TAKES OPTIONAL ARGUMENT
		;-2 => USE CONSOLE TTY
		;-1 => USE DIS (LOSE IF CAN'T .OPEN IT)
		;0 - 14. => USE CONSOLE N' (")
		;IF NO ARG THEN:
			;IF CONSOLE IS GE THEN USE IT
			;IF CONSOLE IS A TELETYPE THEN USE DIS IF AVAILABLE
			;ELSE USE CONSOLE TTY

	;D HAS TYPE OF DEVICE
		;0 => DIS
		;1 => NUMBERED TTY
		;2 => NUMBERED GE
		;3 => CONSOLE TTY
		;4 => CONSOLE GE

DSTIM:	PUSHJ P,ARGET	;GET ARGUMENT IF ANY
	JRST DFLTDV	;NO ARGUMENT => DEFAULT
	AOJL A,TTYDIS	;JUMP IF CONSOLE
	SOJL A,DISDIS	;JUMP FOR DISPLAY
	MOVEI D,1
	CAILE A,8
	MOVEI D,2	;NUMBERED GE CONSOLE
	IDIVI A,10.
	DPB A,[60400,,TYDISO]	;DEPOSIT FIRST DIGIT
	DPB AA,[400,,TYDISO]	;DEPOSIT SECOND DIGIT
	.OPEN DISC,TYDISO
DNA:	ERR [ASCIZ /DEVICE NOT AVAILABLE.
/]
		;NOW FOR THE ACTUAL LOOP

DSTIML:	XCT DISFF(D)	;CLEAR SCREEN OR WHATEVER
	.RTIME AA,
	PUSHJ P,SIXDSO	;TYPE OUT TIME
	XCT DISTAB(D)	;TAB OR CR
	.RDATE AA,
	PUSHJ P,SIXDSO	;TYPE OUT THE DATE
	.LISTEN A,	;SEE IF USER HAS TYPED A CHARACTER
	JUMPN A,DISX	;JUMP IF YES
	MOVE A,SLPTIM(D)	;GET .SLEEP TIME FOR RELEVANT DEVICE
	.SLEEP A,
	.LISTEN A,	;AGAIN SEE IF A CHARACTER TYPED
	JUMPE A,DSTIML	;JUMP IF NO
DISX:	JUMPE D,DISX1	;JUMP IF USING DISPLAY
	.CLOSE DISC,	;EXIT FROM LOOP, CLOSE DISPLAY CHANNEL
	POPJ P,

DISX1:	.DCLOSE		;USING DISPLAY, RELEASE IT
	POPJ P,

		;CONSOLE SPECIFIED

TTYDIS:	ILDB D,[FLGBP GETTY,]
	ADDI D,3
	JRST DSTIML

		;DISPLAY SPECIFIED

DISDIS:	.DSTART BLKOPR	;TRY TO START UP DISPLAY
	JRST DNA	;NOT AVAILABLE
DISDS2:	MOVEI D,0	;ENTRY FROM DEFAULT ROUTINE IF DISPLAY SUCCESSFULLY OPENED
	JRST DSTIML	;FALL INTO LOOP

		;DEFAULT (NO ARGUMENT)

DFLTDV:	MOVEI D,4	;IN CASE GE CONSOLE
	.STATUS TYIC,A
	TRNN A,77#2
	JRST DSTIML	;GE CONSOLE
	TRNE A,400000	;SKIP IF FOREIGN
	.DSTART BLKOPR	;TRY TO START DISPLAY
	SOJA D,DSTIML	;LOST, USE CONSOLE TELETYPE
	JRST DISDS2	;.OPEN WON, USE DISPLAY

		;DISPLAY THE SIXBIT WORD IN AA

SIXDSO:	JUMPE D,DIS6	;JUMP IF USING DISPLAY
SIXDS1:	JUMPE AA,CPOPJ
	MOVEI A,0
	LSHC A,6
	ADDI A,40
	XCT DISTYO(D)	;TYPE OUT A CHARACTER
	JRST SIXDS1

DIS6:	XOR AA,[404040,,404040]	;CLOBBER SIXBIT WORD TO 340 FORMAT
	MOVEM AA,(B)	;STORE IT IN THE RIGHT PLACE
	POPJ P,

		;DISPLAY A CRLF

DISCRF:	MOVEI A,15
	XCT DISTYO(D)
	MOVEI A,12
	XCT DISTYO(D)
	POPJ P,

		;DISPLAY (340) BUFFER AREA

DISBUF:	20177		;RANDOM PARAMETER WORD
	221170,,60464	;SET Y AND X
DISTIM:	0		;TIME
	343337,,	;ESCAPE FROM CHARACTER MODE, WASTE A HALF-WORD
	20177,,60464	;PARAMETER WORD AGAIN, SET X AGAIN
DISDAT:	0		;DATE IN 340 FORMAT
	373737,,3000	;ESCAPE, STOP

BLKOPR:	.-2000,,DISBUF-1	;BLKO POINTER FOR .DSTART

HUH:	ASCIZ /?   /	;FREQUENT ERROR "MESSAGE"


		;COMMAND DISPATCH TABLE

DTBP:	POINTS 12.,DTB(T)

DTB:	.BYTE 12.
	REPEAT 100,[CONCAT CHR,\.RPCNT
]
	.WALGN
	.BYTE

		;BLURB TABLE

BTB:	.BYTE 12.
	REPEAT 100,[CONCAT CHB,\.RPCNT
]
	-1		;FOR END OF TABLE DETECTION
	.WALGN
	.BYTE

PAT:
PATCH:	BLOCK 40	;PATCH AREA
PATCHE:

CONST:	CONSTANTS
	VARIABLES


PDL:	BLOCK LPDL+1

PRINTA HIGHEST USED = ,\.-1

END	BEG
