; -*- Midas -*- 

title DATCHK -- Random daily reminders

;;; Allocate AC's

a=:1					; Temp AC
b=:2					; Temp AC
c=:3					; Temp AC
d=:4					; Temp AC

tt=:5					; Super-Temp for macros

p=:10					; Main stack pointer
options=:11				; Options stack pointer

instream=:14				; File input
tyo=:15					; TTY output  
tyi=:16					; TTY input

;;; Allocate pdls

 ;; PDL will handle program control

 pdlsize==100				; Size 100 pushdown stack enough?
 pdl:	 block pdlsize			; Create the pushdown stack

 ;; OPTPDL will handle user options

 optsize==20				; Define size 20 (more than enough?)
 optpdl: block optsize			; Create the pushdown stack
 optp.n:  0				; Counts number of user-supplied 
					;   options

;;; Allocate JCL buffer

jclsize==40				; This gives 32. * 5. = 160. chars

jclbuf: block jclsize			; Create the buffer
	-1				; Mark its end

jclend:  0				; Random flag saying if JCL buffer
					; has been emptied.

;;; Define nicer names to use instead of these

call=:<pushj p,>			; Just say "call routine"
return=:<popj p,>			; Just say "return"

;; copy x,y  -- copies x into y

define copy x,y

  move y,x

termin

;; pushACs -- saves our temp accumulators (A,B,C,D)

define pushACs

  push p,a
  push p,b
  push p,c
  push p,d

termin

;; popACs -- restores our temp accumulators (A,B,C,D)

define popACs

  pop p,d
  pop p,c
  pop p,b
  pop p,a

termin

;; sixtype <location>
;; 

define sixtype loc

   push p,a				; Save ac A
   move a,loc				; Move value of location into A
   call 6type				; Push to 6type to get number typed
   pop p,a				; Restore A

termin   

;; chkflg <var>,<ac>,<tag>
;;  if <ac>=sixbit('<var>') then read a jcl word and assign <var>
;;  to that word then go to <tag>.

define chkflg var,ac,tag

   camn ac,[sixbit \/var\]
    jrst [call jread
          movem ac,var
	  jrst tag]

termin

;; chkopt <var>,<ac>,<tag>
;;  if <ac>=sixbit('<var>') then set <var> to -1 and go to <tag>

define chkopt var,ac,tag

   camn ac,[sixbit \/var\]
    jrst [setom var
	  jrst tag]

termin


;; syscal <op>,[<arg1> ? <arg2> ? ... ? <argN>]
;;  Does an <op> system call with args of <arg1>,...

define syscal op,args

  .call [setz ? sixbit /op/ ? args ((setz))]

termin

;; trans <m1>,<m2> -- transfers memory at location <m1> to memory at
;;  location <m2> using TT as a temporary.

define trans m1,m2
	
  move tt,m1
  movem tt,m2

termin

;; printf <f1>,<f2> -- print filename [f1,f2,dev,dir]

define printf f1,f2

  trans f1,fn1
  trans f2,fn2
  call probef
   skipa
  call prin

termin

;; type "... string ..." -- types a string on the console

define type &string

  setom typeout
  movei a,<.length string>
  move b,[440700,,[ascii string]]
  syscal SIOT,[%climm,,tyo ? b ? a]
   .lose %lsfil

termin



;;; Other storage

days:   sixbit /SUN/
	sixbit /MON/
	sixbit /TUE/
	sixbit /WED/
	sixbit /THU/
	sixbit /FRI/
	sixbit /SAT/

months: sixbit / JAN/
	sixbit / FEB/
	sixbit / MAR/
	sixbit / APR/
	sixbit / MAY/
	sixbit / JUN/
	sixbit / JUL/
	sixbit / AUG/
	sixbit / SEP/
	sixbit / OCT/
	sixbit / NOV/
	sixbit / DEC/

windy:	0

hsname: 0
user:	0
date:   0
day:	0

pause:	0				; This flag says whether to pause
					;  after we're done if typeout has
					;  occurred

query:  0				; This flag says whether to query
					;  on ONCE files before deletion.

nodel:  0				; Flag to inhibiit deletion of ONCE
					;  files. Stronger than /QUERY

reap:	0				; Flag to cause deletion of all 
					;  reminders

autod:	0				; Flag to cause query delete of dated 
					;  files

tyibuf:  -1				; Buffered JCL text not yet tyi'd

typeout: 0				; Random boolean flag
					;  nonzero if typeout is done

star:	sixbit /*/
early:	sixbit /EARLY/
once:	sixbit /ONCE/

dev:	sixbit /DSK/
dir:	sixbit /DATCHK/
fn1:	sixbit /*/
fn2:	sixbit /*/



datchk: 

;;; Set up the world

	move c,[-2,,[ .rxuname,,a ? .rhsname,,b ]]
	.suset c
	movem a,user		; Move A to USER
	movem b,hsname		; Move B to HSNAME

	move p,[-pdlsize,,pdl]		; Move a pointer to it into P
	move options,[-optsize,,optpdl] ; Move a pointer to it into OPTIONS

	syscal OPEN,[ %clbit,,.uao\%tjdis	; Open in display output mode
		      %climm,,tyo		; Using channel named TYO
		      [sixbit /TTY/]]		; the TTY of course
	  .lose %lsfil

	syscal OPEN,[ %clbit,,.uai	; Open in unit ascii input
		      %climm,,tyi	; Using channel named TYI
		      [sixbit /TTY/]]   ; the TTY			
	 .lose %lsfil

	call gdate			; Get date as Sixbit in DATE
	call gday			; Get day of week as Sixbit in DAY
        call gjcl			; Read and interpret JCL

displa: printf USER,ONCE
	printf USER,DATE
	printf STAR,DATE
	printf USER,DAY
	printf STAR,DAY
	printf USER,STAR
	printf STAR,STAR

	call dis.opts
	
death:  skipn typeout			; If no typeout has happened, 
	 jrst die1			;  kill program
	.rtime a,			; Get time in sixbit in A
	lsh a,-30			; shift hour into low place
	subi a,2026			; subtract sixbit/    06/
	skipl a				; if after 6am,
	 jrst die1			;  kill program
	printf USER,EARLY		; Print the early file if right time

;; DIE - Come here to really kill program

die1:	skipe typeout			; If no typeout or
	 skipn pause			;  pause not selected
	  jrst die			;    then just die
	type "A--Pause--NA"	; (else) wait for user to type a space

die:	.logout 1,			; Kill the program
	 jrst die			;  Didn't make it? Try again!

;; DIS.OPTS - Display user options

dis.opts: sosge optp.n			; Check stack size
           return			;  Return if done
          pop options,A 		; pop next item from TT

	  printf A,DATE 		; Print
	  printf A,DAY			;  any associated
	  printf A,STAR			;   files ...

	  jrst dis.opts
	  
;;; 6type -- Types out a 6bit string on terminal. Receives arg in A.

6type:	pushACs				; Save environment
	copy a,b			; Copy a into b
6type1: jumpe b,6type2			; exit this loop when b is 0
	copy b,c			; Get a really temp copy of b in c
	lsh c,-36			; Shift back into normalized position
	addi c,40			; Increment C to ascii region
	.iot tyo,c			; Output contents of C
	lsh b,6				; Shift B
	jrst 6type1			; Loop
6type2: popACs				; Restore environ
	return

;; GDATE - Puts the date in location DATE. Uses A,B,C,D as temps
;;	saving and restoring their values

gdate:	pushACs				; Save environment
	.rdate a,			; Get date in A
        move b,a			; Copy date to B
	aoje b,g.loss			; If sys doesn't know time, lose
	move b,a			; Copy date back into B
	move c,b			; Copy date to C
        andi a,7777			; Make A have only the Day-of-Month
	lsh b,-14			; Shift month ones chars
	andi b,77			; Select only the ones-place in B
	subi b,20			; Convert char to integer in B
	lsh c,-22			; Shift month thens chars
	andi c,77			; Select only the tens-place in C
	subi c,20			; Convert char to integer in C
	imuli c,10.			; C <- C*10.
	add b,c				; B <- B+C
	subi b,1			; B=B-1
	move d,months(b)		; Get the Bth month in D
	ior d,a				; Add the day of month into name in D
	lsh d,6				; Move things left 1 char width
	movem d,date			; Store result in DATE
	popACs				; Restore environment
	return				; Return to caller

;; GDAY - Puts the day of week in location DAY. Uses A,B,C,D as temps
;;	saving and restoring their values

gday:	pushACs				; Save environment
	.ryear a,			; get year-info in
	jumpe a,g.loss			; If sys doesn't know time, lose
	lsh a,-32			; decode
        andi a,7			; decode date in A as 0=Sun,1=Mon,...
	move a,days(a)			; get sixbit for A in A
	movem a,day			; put day of week in sixbit to DAY
	popACs				; Restore environment
	return				; Return to caller

g.loss:	type "ADATCHK: The system doesn't know what time it is!A"
	.logout 1,

;; GJCL - Reads and interprets JCL

gjcl:	pushACs				; Save the world

        .break 12,[..RJCL,,JCLBUF]	; Read JCL
        move a,[440700,,JCLBUF]		; Init JCLBUF byte-pointer in a

jclp:	call jread			; Get a word from JCL into b
	camn b,[777777,,777777]		; If negative 1
	 jrst jcldon			; Exit if end of JCL

        chkflg USER,b,jclp		; Look for /USER
	chkflg DATE,b,jclp		; Look for /DATE
	chkflg DAY,b,jclp		; Look for /DAY
	chkflg DEV,b,jclp		; Look for /DEV
	chkflg DIR,b,jclp		; Look for /DIR

	chkopt PAUSE,b,jclp		; Look for /PAUSE switch
	chkopt WINDY,b,jclp		; Look for /WINDY switch
        chkopt QUERY,b,jclp		; Look for /QUERY switch
	chkopt NODEL,b,jclp		; Look for /NODEL switch
	chkopt REAP,b,jclp		; Look for /REAP  switch
	chkopt AUTOD,b,jclp		; Look for /AUTODELETE switch
	
	push options,b			; Put this guy in our options list
	aos optp.n			; Add one to our options pointer

	jrst jclp

jcldon:	popACs				; Restore the world
	return				; Return to caller

jread:  movei d,44			; Set up a counter of chars (d)
	setz c,				; clear token accumulator (c)
	call jcltyi			; Read a char
        jumpn b,jread2			; If not whitespace, exit loop
	jrst jread			; Try again

jread1: call jcltyi			; Get char in b
jread2:	jumpe b,[movem c,b ? return]	; Return current token if whitespace
	skipg b				; If an end of buffer, ...
	 return				;   return it
	jumpe d,jread1			; Loop if we've seen six chars already
	subi d,6			; Decrement char count
        cail b,140			; Maybe upcase
         subi b,40			; Subtract 40
	subi b,40			; subtract off some more
	andi b,77			; Get rid of this bit
	lsh b,(d)			; Make room for it in c
	add c,b				; put new character into word 
	jrst jread1			; loop

jtyipk: skipl tyibuf
         jrst [call jtyi1
	       movem b,tyibuf
	       return]
	move b,tyibuf
	return
	
jcltyi:	skipl tyibuf
	 jrst [move b,tyibuf ? return]

jtyi1:	skipge jclend			; Don't come here if we've hit eob
	 jrst [seto b, ? return]	; Return -1 if we've seen this before

	ildb b,a			; Get a char from JCL into b

        caie b,40			; If Space
	 cain b,^I			;     or Tab
	  jrst jwhite			;    then whitespace
	caie b,",			; If Comma
	 cain b,"=			;     or Equal-Sign
	  jrst jwhite			;    then whitespace

	caie b,^M			; If <CR>
	 cain b,^C			;     or Control-C
	  jrst jend			;    then end of JCL
	caie b,^@			; If Nul
	 cain b,^_			;     or Control-_
	jrst jend			;    then end of JCL

	return				; Normal char, just return it

jwhite: setzm b				; Set b to 0 if whitespace
        return				; Return

jend:	setzm b				; Set b to -1 if end of jcl
	setom jclend			; Set flag saying we have seen eob
	return				; Return

;; PROBEF sees if a file exists. It expects FN1, FN2, DEV, and DIR
;;	to have been set up in advance with right filenames in sixbit
;;	Skips next instruction if file exists.

probef: syscal OPEN,[ %CLBIT,,.UAI		; Open in input mode
		      %CLIMM,,instream		; Using AC named INSTREAM
		      dev ? fn1 ? fn2 ? dir]	; Using preset filenames
	  return				; (We were right - no file)
	syscal CLOSE,[ %climm,,instream ]	; Close input file
	 .lose %lsfil			;  IO Lossage if can't close
	aos (p)				; <Skip> on return
        return				; Return 

;; PRIN prints a file. It expects locations FN1, FN2, DEV, and DIR
;;   to have been set up in advance with the right filenames in sixbit

prin:	syscal OPEN,[ %CLBIT,,.UAI		; Open in input mode
		      %CLIMM,,instream		; Using AC named INSTREAM
		      dev ? fn1 ? fn2 ? dir]	; Using preset filenames
	  return

	type "A"			; Get a fresh line

	pushACs				; Save environment

	move b,windy			; Get windy flag in B
	jumpe b,pr.top			; If not windy, skip this section
	
	type "A##### "
	call prfn			; Print the active filename
	type " #####A"

pr.top:	.iot instream,a			; Read a char into A
	hlrz b,a			; Move left half of A into B
	cain b,777777			; Skip if not EOF
	  jrst pr.end			;  Go close file if EOF
	cain a,3			; Or exit when ^C seen
	  jrst pr.end			;  Go close file if EOF
	.iot tyo,a			; Type char on tty
	jrst pr.top			; Jump to top of prin routine

pr.end: skipe reap			; If /REAP specified,
	 jrst pr.gfr			;  then query delete all reminder files

	skipn autod			; If /AUTOD not specified
	 jrst pr.onc			;  skip to next part
	move a,user			; Get uname in A
	came a,fn1			; Assure uname is the fn1
	 jrst pr.onc
	move a,date			; Get date in A
	came a,fn2			; Assure date is the fn2
	 jrst pr.onc
	jrst pr.gfr			; If both are true, then reap it.

pr.onc:	move a,once			; Get 'ONCE in A
	came a,fn2			; If that's not our fn2,
	 jrst pr.cls			;  then close the file

pr.gfr:	skipe nodel			; If deletion inhibited
	 jrst pr.cls			;  then close the file

	move a,user			; Get uname in A
	came a,fn1			; If fn1 isn't same as uname
	 jrst pr.asj			;  do like /QUERY would

	skipn query			; If /QUERY flag not given,
         jrst pr.del			;  then go delete it.

pr.asj:	type "A>>> Delete this reminder? (Y or N) "
pr.ask:	 .iot tyi,a
	caie a,"Y
	 cain a,"y
	  jrst [type " (Deleting)"
		jrst pr.del ]
	caie a,"N
	 cain a,"n
	  jrst [type " (Saving)A"
		jrst pr.cls ]
	type "AThe file just viewed was "
	call prfn
	type "ADo you want this reminder file deleted? (Y or N) "
	jrst pr.ask

pr.del: syscal DELETE,[ dev ? fn1 ? fn2 ? dir]	; Using preset filenames
	 .lose %lsfil

;;; We were doing DELEWO but that has the misfeature of deleting through links
;;;
;;;	syscall DELEWO,[ %climm,,instream ]	; Delete it
;;;	 .lose %lsfil

pr.cls:	popACs				; Restore environment

	syscal CLOSE,[ %climm,,instream ]	; Close input file
	 .lose %lsfil

	return

prfn:	sixtype dev
	type ":"
	sixtype dir
	type ";"
	sixtype fn1
	type " "
	sixtype fn2
	return

end datchk


;;; Local Modes: ::
;;; Mode:Midas ::
;;; Comment Column:40 ::
;;; Comment Start:; ::
;;; Comment Begin:;  ::
;;; ...N: M.M^R Down Real Line ::
;;; ...P: M.M^R Up Real Line ::
;;; End: ::