Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

SUBTTL	B. SCHREIBER

SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC	.XTABM
.DIRECT .OKOVL		;MACRO %50A WILL GET NUMBER ERROR
			;ON <ASCII/     /> OTHERWISE
SALL

;BIORTH VERSION

BIOVER==2	;MAJOR VERSION
BIOEDT==7	;EDIT LEVEL
BIOMIN==0	;MINOR VERSION
BIOWHO==0	;WHO?

DEFINE CTITLE (WORD1,TEXT,MAJVER,VEREDT)
<WORD1 'TEXT'MAJVER(VEREDT)>

CTITLE	(TITLE,<BIORTH -- PROGRAM TO CHART BIORHYTHMS %>,\BIOVER,\BIOEDT)

LOC	.JBVER
%%BIOV==:VRSN.	(BIO)
EXP	%%BIOV

;SHOW UNIVERSAL VERSION NUMBERS

%%JOBD==%%JOBD		;JOBDAT
%%UUOS==:%%UUOS		;UUOSYM
%%MACT==:%%MACT		;MACTEN
%%SCNM==:%%SCNM		;SCNMAC

;REQUEST REST OF LOADING

.TEXT	&/SEGMENT:LOW/SEARCH REL:ALCOR,REL:SCN7B,REL:HELPER,SYS:FORLIB&

SUBTTL	ASSEMBLY / ACCUMULATOR DEFINITIONS

ND LN$PDL,^D200		;PDL SIZE
ND MY$NAM,'BIORTH'	;MY NAME
ND MY$PFX,'BIO'		;MY MESSAGE PREFIX
ND MX$CRT,4		;NEARNESS TO MIDDLE TO BE CONSIDERED CRITICAL
ND PLTWID,^D60		;WIDTH OF PLOT
	PLTZER==PLTWID/2;MIDDLE OF PLOT
ND PLTBSZ,PLTWID/5+1	;# WORDS REQUIRED TO STORE ONE LINE
ND ICYCLE,^D33		;DAYS/INTELLECTUAL CYCLE
ND ECYCLE,^D28		;DAYS/EMOTIONAL CYCLE
ND PCYCLE,^D23		;DAYS/PHYSICAL CYCLE
ND FT$OPT,0		;NON-ZERO TO SCAN SWITCH.INI
ND FT$DDT,0		;NON-ZERO FOR DEBUGGING

;DEFINE THE ACCUMULATORS

DEFINE	AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>

ZZ==0

AC$ (X)		;ARGUMENTS FROM FORTRAN SUBRS (SOMETIMES)
AC$ (T1)	;T1-4 ARE TEMPORARY
AC$ (T2)
AC$ (T3)
AC$ (T4)
AC$ (P1)	;P1-4 ARE PERMANENT--MUST BE PRESERVED
AC$ (P2)
AC$ (P3)
AC$ (P4)
AC$ (F)		;FLAGS
AC$ (D)		;DATE
	N==P3	;NUMBER/WORD FROM SCAN
	C==P4	;CHARACTER FROM SCAN
	P=17	;PUSHDOWN LIST PTR

SUBTTL	FLAG DEFINITIONS

;FLAGS IN LH OF F

DEFINE FLAG$ (FLG)
<FL$'FLG==ZZ
ZZ==ZZ_-1
FL$'FLG==FL$'FLG>

ZZ==(1B0)

FLAG$ (FIL)		;ON IF PLOTTING TO A FILE
FLAG$ (HVB)		;ON WHEN HAVE A BIRTHDAY
FLAG$ (BKW)		;ON IF PLOTTING BACKWARDS IN TIME
FLAG$ (CRT)		;ON IF FOUND TO BE A CRITICAL DAY

;I/O CHANNELS

;0	;NEVER USED BY ME
OUTC==1	;FOR OUTPUT

;OPDEFINES

OPDEF	CALL	[PUSHJ	P,]	;SUBROUTINE CALL
OPDEF	FLOAT.	[FSC	233]	;FLOAT # IN AC

;OTHER STUFF

ATSIGN==(1B13)		;THE INDIRECT BIT

SUBTTL	ERROR MACRO DEFINITIONS

;ERROR.	($FLGS,$PFX,$MSG)
;
;$FLGS 	IS THE COMBINITATION OF THE FOLLOWING BITS:

	EF$ERR==0	;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
	EF$FTL==400	;FATAL ERROR--ABORT AND RESTART
	EF$WRN==200	;WARNING MESSAGE--CONTINUE
	EF$INF==100	;INFORMATIVE MESSAGE--CONTINUE
	EF$NCR==40	;NO FREE CRLF AFTER MESSAGE

DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>

ZZ==0		;TYPE CODES ARE FROM 1-37

ETYP (DEC)	;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP (OCT)	;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP (SIX)	;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP (PPN)	;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP (STR)	;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP (FIL)	;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
ETYP (DAT)	;TYPE T1 AS A DATE AT END OF MESSAGE
	EF$MAX==ZZ	;MAX ERROR TYPE

IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>

;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF

NOOP==	(CAI)		;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP

DEFINE	ERROR.	($FLGS,$PFX,$MSG)
<CALL	EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
>

;WARN.	FLGS,PFX,MSG

DEFINE	WARN.	($FLGS,$PFX,$MSG)
<ERROR.	(EF$WRN!$FLGS,$PFX,$MSG)>

;INFO.	FLGS,PFX,MSG

DEFINE	INFO.	($FLGS,$PFX,$MSG)
<ERROR.	(EF$INF!$FLGS,$PFX,$MSG)>

DEFINE	M$FAIL	($PFX,$MSG)
<E$$'$PFX: ERROR.	(EF$FTL,$PFX,$MSG)>

SUBTTL	OTHER MACRO DEFINITIONS
;SAVE$ SAVES DATA ON THE STACK

DEFINE	SAVE$	(X)
<XLIST
IRP X,<PUSH P,X>
LIST>

;RESTR$ RESTORES DATA FROM THE STACK

DEFINE	RESTR$	(X)
<XLIST
IRP X,<POP P,X>
LIST>

;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE

DEFINE	U ($NAME,$WORDS<1>)
<$NAME:	BLOCK	$WORDS>

;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG

DEFINE STRNG$ (S)
<MOVEI	T1,[ASCIZ \S\]
CALL	.TSTRG##>

;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY

DEFINE ASCIZ$ (S)
<XLIST
ASCIZ \S\
LIST>

SUBTTL	MAIN-LINE PROGRAM

RELOC	0

BIORTH:	TDZA	T1,T1		;FLAG NORMAL START
	MOVEI	T1,1		;FLAG CCL START
	MOVEM	T1,OFFSET	;SAVE FOR SCAN

	STORE	17,0,16,0	;CLEAR ACS
	STORE	17,FW$ZER,LW$ZER,0 ;AND CORE WHICH SHOULD BE CLEARED
	RESET			;STOP EXTERNAL I/O WHICH MAY BE IN PROGRESS
	SKIPA	P,.+1		;SETUP PDL
INIPDP:	IOWD	LN$PDL,PDLIST
	CALL	.RECOR##	;RESET CORE ALLOCATION
	MOVE	T1,ISCNBL	;GET ISCAN BLOCK
	CALL	.ISCAN##	;INITIALIZE THE COMMAND SCANNER
	MOVEM	T1,ISCNVL	;REMEMBER WHAT ISCAN RETURNS
	SKIPN	OFFSET		;CCL ENTRY?
	 SKIPE	TLDVER		;OR ALREADY TOLD VERSION?
	 JRST	BIOR.0		;ONE OR THE OTHER
	STRNG$	<BIORTH %>	;NO--DO IT NOW
	MOVE	T1,.JBVER
	CALL	.TVERW##
	CALL	.TCRLF##
BIOR.0:	HRROI	T1,.GTJLT	;GET LOGIN TIME
	GETTAB	T1,		;FOR DATE-TIME STUFF
	 SETZ	T1,		;(OLD MON)
	MOVEM	T1,LOGTIM	;...
	SETOM	TLDVER		;SO WE ONLY TELL VERSION ONE TIME
RESTRT:	MOVE	T1,VSCNBL	;GET ARG BLOCK FOR .VSCAN
	CALL	.VSCAN##	;DO THE WORK
	CALL	.MONRT##	;EXIT TO MONITOR
	JRST	RESTRT		;GO RESTART
TWOPI:	EXP	6.28318		;PI*2

SUBTTL	ARGUMENT BLOCKS FOR ISCAN AND VSCAN

ISCNBL:	XWD 5,	.+1
	IOWD	N$CMDS,CMDLST
	XWD	OFFSET,MY$PFX
	EXP	0
	EXP	0
	XWD	DOPRMP,0

;ARG BLOCK FOR .VSCAN

VSCNBL:	XWD 7,	.+1
	IOWD	VSWTL,VSWTN
	XWD	VSWTD,VSWTM
	XWD	0,VSWTP
	EXP	-1		;USE MY NAME FOR HELP
	XWD	2,BEGNDT	;SO PLOT/BEGIN:XX/END:XX WILL WORK
	XWD	0,PBEGND	;DUMMY
	EXP	0

;SCAN CALLS HERE TO PROMPT -- T1 NEGATIVE IF CONTINUATION

DOPRMP:	SKIPL	T1		;FIRST?
	 SKIPA	T1,PRMPTM	;YES--LOAD UP MESSAGE
	MOVSI	T1,'#  '	;NO--LOAD UP CONTINUATION
	PJRST	.TSIXN##	;GO TYPE IT

PRMPTM:	XWD	MY$PFX,'>  '

CMDLST:	EXP	MY$NAM
	N$CMDS==.-CMDLST

SUBTTL	SWITCH TABLE

DEFINE SWTCHS,<
SP BEGIN,BEGNDT,.DATIM,,FS.NUE!FS.VRQ
SP *BIRTHD,,$BIRTHDAY,,
SP *CHART,,$CHART,,
SP COMPAT,,$COMPAT,,
IFN FT$DDT,<
SP DDT,,$DDT,,
>;END IFN FT$DDT
SP END,ENDATE,.DATIM,,FS.NUE!FS.VRQ
SP *PLOT,,$PLOT,,
>

DOSCAN (VSWT)

SUBTTL	MISC. COMMANDS

$BIRTHDAY:
	TLZ	F,FL$HVB	;HAVE NO BIRTHDAY
	JUMPLE	C,E$$NBG	;GUARD AGAINST HALT IN SCAN
	CALL	.DATIM		;READ IT
	HLLZM	N,BIRTHD	;SAVE BIRTHDAY
	TLO	F,FL$HVB	;HAVE A BIRTHDAY
	JRST	.POPJ1##	;SKIP BACK TO AVOID STORE

IFN FT$DDT,<
$DDT:	STRNG$	<DDT
>
	AOS	(P)		;SO CAN POPJ FROM DDT
	SKIPE	T1,.JBDDT	;GET DDT ADDR
	 JRST	(T1)		;AND GO TO IT
	WARN.	0,DNL,<DDT NOT LOADED>
	POPJ	P,
>;END IFN FT$DDT

SUBTTL	COMPUTE COMPATIBILITIES

$COMPAT:CALL	.SAVE2##	;PRESERVE
	AOS	(P)		;SO SCAN DOESN'T STORE
	CALL	.CLRBF##	;EAT REST
	SETZ	T1,		;DUMMY ARG BLOK FOR QSCAN
	CALL	.QSCAN##	;INIT A LINE
	 JFCL			;WILL PROMPT ANYWHAY
	STRNG$	<BIRTHDATE 1: >
	CALL	.DATIM
	HLRZ	P1,N		;ONLY WANT THE DATE
	CALL	.CLRBF##	;EAT WHAT MAY BE LEFT
	SETZ	T1,
	CALL	.QSCAN##
	 JFCL
	STRNG$	<BIRTHDATE 2: >
	CALL	.DATIM
	HLRZ	P2,N		;AND DITTO HERE
	CALL	.CLRBF##	;CLEAR ANY LEFT
	MOVEI	T1,ICYCLE	;COMPUTE THE PERCENTAGES
	CALL	CMPTFN		;...
	MOVEM	T1,IPOS
	MOVEI	T1,ECYCLE
	CALL	CMPTFN
	MOVEM	T1,EPOS
	MOVEI	T1,PCYCLE
	CALL	CMPTFN
	MOVEM	T1,PPOS
	STRNG$	<INTELLECTUAL COMPATIBILITY = >
	MOVE	T1,IPOS
	CALL	.TPCNT		;TYPE DECIMAL AND PERCENT AND CRLF
	STRNG$	<EMOTIONAL COMPATIBILITY    = >
	MOVE	T1,EPOS
	CALL	.TPCNT
	STRNG$	<PHYSICAL COMPATIBILITY     = >
	MOVE	T1,PPOS
	CALL	.TPCNT
	STRNG$	<TOTAL COMPATIBILITY        = >
	MOVE	T1,IPOS
	ADD	T1,EPOS
	ADD	T1,PPOS
	IDIVI	T1,3		;AVERAGE
	CALL	.TPCNT
	POPJ	P,

SUBTTL	COMPUTE THE COMPATIBILITY FUNCTION

;CALL HERE WITH P1=BIRTHDATE IN RH
;	        P2=BIRTHDATE IN RH
;		T1=CYCLE LENGTH
;
;RETURN WITH T1=COMPATIBILITY PERCENTAGE

CMPTFN:	HLRZ	T2,NOW		;USE NOW TO COMPUTE DIFF
	SUB	T2,P1		;# DAYS ALIVE
	MOVM	T2,T2		;ALLOW WHATEVER
	IDIVI	T2,(T1)		;GET DAYS INTO CYCLE
	MOVE	T2,T3		;SAVE REMAINDER
	HLRZ	T3,NOW
	SUB	T3,P2
	MOVM	T3,T3
	IDIVI	T3,(T1)		;DAYS INTO CYCLE
	SUB	T2,T4		;DIFF
	MOVM	T2,T2		;GET THE MAGNITUDE
	IMULI	T2,^D200	;* 200
	FLOAT.	T2,		;MAKE IT REAL
	FLOAT.	T1,		;CYCLE ALSO
	FDVR	T2,T1		;200*DIFF/CYCLE LENGTH
	MOVSI	T1,(100.0)	;GET ONE HUNDRED
	FSBR	T1,T2		;100-ABOVE
	SKIPGE	T1		;IF NEGATIVE
	 MOVNS	T1		;MAKE IT POSITIVE
	FADRI	T1,(0.5)	;ROUND IT UP
	PJRST	IFX.1##		;FIX AND RETURN

;.TPCNT -- TYPE DECIMAL # , "%", AND CRLF

.TPCNT:	CALL	.TDECW##	;TYPE DECIMAL
	MOVEI	T1,"%"		;GET A PERCENT
	CALL	.TCHAR##	;BOOT IT
	PJRST	.TCRLF##	;NEW LINE AND EXIT

SUBTTL	PLOT THE CYCLES

$PLOT:
$CHART:
	CALL	.SAVE2##	;SAVE REGISTERS
	AOS	(P)		;SKIP SCAN STORE ON WAY BACK
	TLNN	F,FL$HVB	;MUST HAVE A BIRTHDAY
E$$NBG:	 ERROR.	EF$FTL,NBG,<NO BIRTHDAY GIVEN>
	TLZ	F,FL$FIL!FL$BKW!FL$CRT ;NOT TO FILE,NOT BACKWARDS,AND NOT CRIT.
	JUMPLE	C,PLOT.0	;JUMP IF NO FILE SPEC
	CALL	.FILIN##	;YES--READ IT
	 SKIPN	F.NAM##-1	;NULL DEVICE/
	  SKIPE	F.NAM##		;OR NULL FILENAME?
	   SKIPA		;NO--THERE IS REALLY A SPEC
	  JRST	PLOT.0		;MUST HAVE JUST BEEN SWITCHES
	MOVEI	T1,FILSPC	;GET THE SPEC
	MOVEI	T2,.FXLEN	;AND LENGTH
	CALL	.GTSPC##	;COPY IT OVER
	MOVSI	T1,'LPT'	;FILL IN DEFAULTS
	SKIPN	FILSPC+.FXDEV	;FOR DEVICE
	MOVEM	T1,FILSPC+.FXDEV
	MOVE	T1,[SIXBIT/BIORTH/] ;FOR FILENAME
	SKIPN	FILSPC+.FXNAM
	 SETOM	FILSPC+.FXNMM
	SKIPN	FILSPC+.FXNAM
	 MOVEM	T1,FILSPC+.FXNAM
	HRLOI	T1,'LPT'	;AND EXTENSION
	SKIPN	FILSPC+.FXEXT
	 MOVEM	T1,FILSPC+.FXEXT
	MOVEI	T1,FILSPC	;POINT AT IT
	CALL	OPENIO		;OPEN CHANNEL
	CAI	OUTC,@OBHR(.IOASC) ;
	SETZ	T1,		;DEFAULT # BUFFERS
	MOVE	T2,[XWD OPNBLK,OBHR] 
	CALL	.ALCBF##	;ALLOCATE BUFFERS
	TLO	F,FL$FIL	;FLAG TO A FILE
	MOVEI	T1,CHROUT	;SETUP ROUTINE
	CALL	.TYOCH##	;WITH SCAN
	SAVE$	T1		;REMEMBER OLD ONE
PLOT.0:	HLLZS	ENDATE		;CLEAR SO WE ONLY LOOK AT DAYS, NOT HOURS
	CALL	.GTNOW		;USE TODAY
	SKIPN	D,BEGNDT	;UNLESS /BEGIN WAS GIVEN
	MOVE	D,T1		;POSITION DATE
	HLLZS	D		;ONLY LOOK AT DATE
	MOVSI	T1,377776	;A VERY LARGE DATE
	TLNN	F,FL$FIL	;UNLESS OUTPUTTING TO A FILE
	 JRST	PLOT0B		;NO--GO FOREVER
	HLLZ	T1,D		;THEN START WITH BEGINNING DATE
	ADD	T1,[XWD ^D31,0]	;AND GO FOR A MONTH
PLOT0B:	SKIPN	ENDATE		;MAKE SURE END SPECIFIED
	 MOVEM	T1,ENDATE	;NO--MAKE IT VERY LARGE
	CAMLE	D,ENDATE	;BEGINNING MUST BE BEFORE END
	 TLO	F,FL$BKW	;OR ELSE WE ARE GOING BACKWARDS IN TIME
	STRNG$	<
BIORHYTHM CHART FOR BIRTHDATE: >
	MOVE	T1,BIRTHD	;GET THE BIRTHDAY
	CALL	.TDATX		;TYPE DAY OF WEEK AND DATE
	STRNG$	<

E - EMOTIONAL CYCLE    -- 28 DAYS
I - INTELLECUTAL CYCLE -- 33 DAYS
P - PHYSICAL CYCLE     -- 23 DAYS
# INDICATES CRITICAL DAY

>
	STRNG$	<             LOW                        CRITICAL                        HIGH
>
	CALL	.TCRLF##	;NEW LINES

PLOT.1:	STORE	T1,PLTBUF,PLTBUF+PLTBSZ-1,<ASCII/     /> ;INIT TO BLANKS
	MOVEI	T1,ICYCLE	;DO I CYCLE
	CALL	COMPOS		;COMPOSE POSITION
	MOVEM	T1,IPOS
	CALL	CRTCHK		;SEE IF CRITICAL
	MOVEI	T1,ECYCLE	;DO E CYCLE
	CALL	COMPOS
	MOVEM	T1,EPOS
	CALL	CRTCHK		;SEE IF CRITICAL
	MOVEI	T1,PCYCLE
	CALL	COMPOS
	MOVEM	T1,PPOS
	CALL	CRTCHK		;SEE IF CRITICAL
	MOVEI	T1,"!"		;SETUP THE BORDERS
	MOVEI	T2,0		;...
	CALL	PUTPLC		;LEFT SIDE
	MOVEI	T2,PLTZER	;THE MIDDLE
	CALL	PUTPLC
	MOVEI	T2,PLTWID	;RIGHT SIDE
	CALL	PUTPLC		;...
	MOVEI	T1,"#"		;IN CASE CRITICAL
	MOVEI	T2,PLTWID+1	;...
	TLZE	F,FL$CRT	;CRITICAL?
	 CALL	PUTPLC		;YES--MARK IN CHART
	MOVSI	P1,-LN$PCH	;GET A LOOPER
PLOT.2:	HLRZ	T1,PCHTBL(P1)	;GET CHAR TO PLOT
	HRRZ	T2,PCHTBL(P1)	;AND ADDR OF POS
	MOVE	T2,(T2)		;GET POS
	CALL	PUTPLC		;PLOT IT
	AOBJN	P1,PLOT.2	;DO ALL
PLOT.5:
	MOVE	T1,D		;GET DATE
	CALL	.TDATX		;TYPE DAY AND DATE
	CALL	.TSPAC##	;AND A SPACE
	MOVEI	T1,PLTBUF	;BUFFER ADDR
	CALL	.TSTRG##	;SEND IT
	CALL	.TCRLF##	;NEW LINE
	MOVSI	T1,1		;GET ONE IN LH
	TLNE	F,FL$BKW	;GOING BACKWARDS?
	 JRST	[SUB	D,T1	;YES--DO THAT
		CAML	D,ENDATE;DONE YET?
		JRST	PLOT.1	;NO--CONTINUE
		JRST	PLOT.9]	;YES--GO QUIT
	ADD	D,T1		;NEXT DAY
PLOT.6:	CAMG	D,ENDATE	;REACHED THE END YET?
	JRST	PLOT.1		;..
PLOT.9:	TLZN	F,FL$FIL	;YES--OUTPUTTING TO A FILE?
	POPJ	P,		;NO--DONE
	CLOSE	OUTC,		;YES--CLOSE FILE
	RELEASE	OUTC,		;...
	MOVEI	T1,OBHR		;RELEASE BUFFERS
	CALL	.FREBF##
	RESTR$	T1		;GET SCAN ROUTINE
	PJRST	.TYOCH##	;RESTORE AND RETURN

PCHTBL:	XWD	"I",IPOS	;INTELLECTUAL
	XWD	"E",EPOS	;EMOTIONAL
	XWD	"P",PPOS	;PHYSICAL
	LN$PCH==.-PCHTBL
CRTCHK:	SUBI	T1,PLTZER	;SEE IF NEAR THE MIDDLE
	MOVMS	T1		;GET ONLY THE MAGNITUDE
	CAIG	T1,MX$CRT	;CAN IT BE CRITICAL?
	 TLO	F,FL$CRT	;YES--FLAG FOR PRINTER
	POPJ	P,		;DONE

COMPOS:	FLOAT.	T1,		;FLOAT CYCLE LENGTH
	MOVE	T2,TWOPI	;GET 2*PI
	FDVR	T2,T1		;2*PI/CYCLE LENGTH
	MOVEM	T2,TEMP		;SAVE IT
	HLRZ	T1,D		;GET DAY WE ARE WORKING ON
	HLRZ	T2,BIRTHD	;AND BIRTHDAY
	SUBI	T1,(T2)		;DIFFERENCE 
	PUSHJ	P,FLT.1##	;FLOAT IT
	FMPRM	T1,TEMP		;* ABOVE RESULT AND SAVE IT
	MOVEI	16,1+[EXP <-1,,0>,TEMP] ;ARG BLOCK
	CALL	SIN.##		;GET THE SINE
	MOVEM	X,TEMP		;SAVE IT
	MOVSI	T1,(1.0)	;ADD ONE TO IT
	FADRM	T1,TEMP		;...
	MOVEI	T1,PLTWID	;GET PLOT WIDTH
	FLOAT.	T1,		;MAKE IT REAL
	FMPRM	T1,TEMP
	MOVSI	T1,(2.0)	;GET A TWO
	EXCH	T1,TEMP		;POSITION
	FDVRM	T1,TEMP		;DIVIDE BY TWO
	MOVSI	T1,(0.5)	;GET 1/2
	FADRB	T1,TEMP		;ADD THAT IN ALSO
	PJRST	IFX.1##		;FIX AND RETURN

;PUTPLC -- PUT CHAR IN PLOT BUFFER
;CALL:	MOVEI	T1,CHAR
;	MOVEI	T2,POS
;	CALL	PUTPLC
;USES T1-4

PUTPLC:	IDIVI	T2,5		;T2=WORD, T3=POS IN WORD
	MOVSI	T4,(POINT 7)	;START TO FORM BYTE PTR
	HRRI	T4,PLTBUF(T2)	;FINISH IT
	IBP	T4		;INC ONE
	SOJGE	T3,.-1		;DO ALL
	DPB	T1,T4		;STORE CHAR
	POPJ	P,

SUBTTL	SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

;.DATIF -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN FUTURE
;.DATIG -- DITTO (CHARACTER ALREADY IN C)
;CALL:	PUSHJ	P,.DATIF/.DATIG
;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4	UPDATES C (SEPARATOR)

.DATIF:	PUSHJ	P,.TIAUC##	;PRIME THE PUMP

.DATIG:	SETZM	FLFUTR		;CLEAR FUTURE RELATIVE
	SETZM	FLFUTD		;SET DEFAULT
	AOS	FLFUTD		;  TO FUTURE
	CAIE	C,"+"		;SEE IF FUTURE RELATIVE
	JRST	DATIF1		;NO--JUST GET DATE-TIME
	AOS	FLFUTR		;YES--SET FUTURE REL FLAG
	PUSHJ	P,.TIAUC##	;GET ANOTHER CHARACTER
DATIF1:	PUSHJ	P,DATIM		;GET DATE/TIME
	CAMGE	N,NOW		;SEE IF IN FUTURE
	JRST	E$$NFT		;NO--NOT FUTURE ERROR
	POPJ	P,		;RETURN

;.DATIP -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN THE PAST
;.DATIQ -- DITTO (CHARACTER ALREADY IN C)
;CALL:	PUSHJ	P,.DATIP/.DATIQ
;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4	UPDATES C (SEPARATOR)

.DATIP:	PUSHJ	P,.TIAUC##	;PRIME THE PUMP

.DATIQ:	SETZM	FLFUTR		;CLEAR PAST RELATIVE
	SETOM	FLFUTD		;SET DEFAULT TO PAST
	CAIE	C,"-"		;SEE IF PAST RELATIVE
	JRST	DATIP1		;NO--JUST GET DATE-TIME
	SOS	FLFUTR		;YES--SET PAST REL FLAG
	PUSHJ	P,.TIAUC##	;GET ANOTHER CHARACTER
DATIP1:	PUSHJ	P,DATIM		;GET DATE/TIME
	CAMLE	N,NOW		;SEE IF IN PAST
	JRST	E$$NPS		;NO--NOT PAST ERROR
	POPJ	P,		;RETURN

;.DATIM -- ROUTINE TO SCAN DATE AND TIME ARGUMENT
;.DATIC -- DITTO (CHARACTER ALREADY IN C)
;CALL:	PUSHJ	P,.DATIM/.DATIC
;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4	UPDATES C (SEPARATOR)

.DATIM:	PUSHJ	P,.TIAUC##	;PRIME THE PUMP

.DATIC:	SETZM	FLFUTR		;CLEAR RELATIVE FLAG
	SETZM	FLFUTD		;CLEAR DEFAULT FLAG
	CAIE	C,"+"		;SEE IF FUTURE RELATIVE
	JRST	DATIC1		;NO--PROCEED
	AOS	FLFUTR		;YES--SET FLAG
	JRST	DATIC2		;AND PROCEED
DATIC1:	CAIE	C,"-"		;SEE IF PAST RELATIVE
	PJRST	DATIM		;NO--JUST GET ABS DATE
	SOS	FLFUTR		;YES--SET FLAG
DATIC2:	PUSHJ	P,.TIAUC##	;GET NEXT CHAR
				;AND FALL INTO DATE/TIME GETTER

;DATIM -- ROUTINE TO INPUT DATE/TIME
;CALL:	SET FLFUTR TO -1 IF PAST RELATIVE, 0 IF ABSOLUTE, +1 IF FUTURE RELATIVE
;	SIMILARLY FOR FLFUTD TO INDICATE DEFAULT DIRECTION IF FLFUTR=0
;	GET NEXT CHARACTER IN C
;	PUSHJ	P,DATIM
;RETURN WITH TRUE DATE/TIME IN N IN INTERNAL SPECIAL FORMAT
;	SETS NOW TO CURRENT DATE/TIME
;USES T1-4, UPDATES C
;
;TYPE-IN FORMATS:
;	(THE LEADING +- IS HANDLED BY CALLER)
;
;	[ [  DAY IN WEEK	    ]		     ]
;	[ [     NNND		    ]		     ]
;	[ [ [   MM-DD  [-Y   ] ]  : ] [HH[:MM[:SS]]] ]
;	[ [ [  MMM-DD  [-YY  ] ]    ]		     ]
;	[ [ [  DD-MMM  [-YYYY] ]    ]		     ]
;	[	       MNEMONIC			     ]
;WHERE:
;	D	LETTER D
;	DD	DAY IN MONTH (1-31)
;	HH	HOURS (00-23)
;	MM	MONTH IN YEAR (1-12)
;	    OR	MINUTES (00-59)
;	MMM	MNEMONIC MONTH OR ABBREV.
;	SS	SECONDS (0-59)
;	Y	LAST DIGIT OF THIS DECADE
;	YY	LAST TWO DIGITS OF THIS CENTURY
;	YYYY	YEAR
;	DAY IN WEEK IS MNEMONIC OR ABBREVIATION
;	MNEMONIC IS A SET OF PREDEFINED TIMES

				;DESCRIBED ABOVE
				;FALL HERE FROM .DATIC

DATIM:	SKIPE	T1,FLFUTR	;SEE IF FORCED DIRECTION
	MOVEM	T1,FLFUTD	; YES--THAT IMPLIES DEFAULT
	SETOM	VAL1		;CLEAR RESULT WORDS
	MOVE	T1,[VAL1,,VAL2]
	BLT	T1,VAL9		; ..
	PUSHJ	P,.GTNOW	;GET CURRENT DATE/TIME
	MOVEM	T1,NOW		;SAVE FOR LATER TO BE CONSISTENT
	CAIL	C,"0"		;SEE IF DIGIT
	CAILE	C,"9"		; ..
	JRST	.+2		;NO--MNEMONIC FOR SOMETHING
	JRST	DATIMD		;YES--GO GET DECIMAL
;HERE IF STARTING WITH ALPHA, MIGHT BE DAY, MONTH, OR MNEMONIC
	PUSHJ	P,.SIXSC##	;GET SIXBIT WORD
	JUMPE	N,E$$DTM		;ILLEGAL SEPARATOR IF ABSENT
	MOVE	T1,MNDPTR	;POINT TO FULL TABLE
	PUSHJ	P,.NAME##	;LOOKUP IN TABLE
	  JRST	E$$UDN		;ERROR IF NOT KNOWN
	MOVEI	N,(T1)		;GET
	SUBI	N,DAYS		;  DAY INDEX
	CAIL	N,7		;SEE IF DAY OF WEEK
	JRST	DATIMM		;NO--LOOK ON
;HERE WHEN DAY OF WEEK RECOGNIZED
	SKIPN	T1,FLFUTD	;GET DEFAULT DIRECTION
	JRST	E$$NPF		;ERROR IF NONE
	MOVEM	T1,FLFUTR	;SET AS FORCED DIRECTION
	HLRZ	T2,NOW		;GET DAYS
	IDIVI	T2,7		;GET DAY OF WEEK
	SUB	N,T3		;GET FUTURE DAYS FROM NOW
	SKIPGE	N		;IF NEGATIVE,
	ADDI	N,7		;  MAKE LATER THIS WEEK
	HLLZ	T1,NOW		;CLEAR CURRENT
	SKIPL	FLFUTD		;SEE IF FUTURE
	TROA	T1,-1		;YES--SET MIDNIGHT MINUS EPSILON
	SUBI	N,7		;NO--MAKE PAST
	HRLZ	N,N		;POSITION TO LEFT HALF
	ADD	N,T1		;MODIFY CURRENT DATE/TIME
DATIMW:	PUSH	P,N		;SAVE DATE
	PUSHJ	P,DATIC		;GO CHECK TIME
	  HRRZ	N,(P)		;NO--USE VALUE IN DATE
	POP	P,T1		;RESTORE DATE
	HLL	N,T1		;  TO ANSWER
	JRST	DATIMX		;CHECK ANSWER AND RETURN

;HERE IF MONTH OR MNEMONIC
DATIMM:	MOVEI	N,(T1)		;GET MONTH
	SUBI	N,MONTHS-1	;  AS 1-12
	CAILE	N,^D12		;SEE IF MONTH
	JRST	DATIMN		;NO--MUST BE MNEMONIC
	MOVEM	N,VAL6		;YES--STORE MONTH
	CAIE	C,"-"		;MUST BE DAY NEXT
	JRST	E$$MDD		;NO--ERROR
	PUSHJ	P,.DECNW##	;YES--GET IT
	JUMPLE	N,E$$NND	;ERROR IF NEGATIVE
	CAILE	N,^D31		;VERIFY IN RANGE
	JRST	E$$DFL		;ERROR IF TOO LARGE
	MOVEM	N,VAL5		;SAVE AWAY
	JRST	DATIY0		;AND GET YEAR IF PRESENT

;HERE IF MNEMONIC
DATIMN:	HRRZ	T2,T1		;GET COPY
	CAIN	T2,SPLGTM	;SEE IF "LOGIN"
	SKIPG	N,LOGTIM	;AND WE KNOW IT
	SKIPA			;NO--PROCEED
	JRST	DATIMX		;YES--GO GIVE ANSWER
	CAIN	T2,SPNOON	;SEE IF "NOON"
	JRST	[HLLZ N,NOW	;YES--GET TODAY
		 HRRI N,1B18	;SET TO NOON
		 JRST DATIMW]	;GO FINISH UP
	CAIN	T2,SPMIDN	;SEE IF "MIDNIGHT"
	JRST	[HLLZ N,NOW	;GET TODAY
		 JRST DATIMO]	;GO SET TO MIDNIGHT
	SUBI	T2,SPCDAY	;SUBTRACT OFFSET TO SPECIAL DAYS
	CAILE	T2,2		;SEE IF ONE OF THREE
	JRST	E.MDS		;NO--UNSUPPORTED
	HLRZ	N,NOW		;YES--GET TODAY
	ADDI	N,-1(T2)	;OFFSET IT
	HRLZS	N		;POSITION FOR ANSWER
DATIMO:	SKIPL	FLFUTD		;SEE IF FUTURE
	TRO	N,-1		;YES--SET TO MIDNIGHT MINUS EPSILON
	JRST	DATIMW		;AND GO FINISH UP
;HERE IF UNSUPPORTED MNEMONIC
E.MDS:	MOVE	T1,(T1)		;GET NAME OF SWITCH
	ERROR.	EF$FTL!EF$SIX,MDS,<MNEMONIC DATE/TIME SWITCH NOT IMPLEMENTED>

;HERE IF STARTING WITH DECIMAL NUMBER
DATIMD:	PUSHJ	P,.DECNC##	;YES--GO GET FULL NUMBER
	JUMPL	N,E$$NND	;ILLEGAL IF NEGATIVE
	CAIE	C,"D"		;SEE IF DAYS
	JRST	DATIN		;NO--MUST BE -
	MOVE	T1,FLFUTD	;YES--RELATIVE SO GET FORCING FUNCTION
	MOVEM	T1,FLFUTR	; AND FORCE IT
	JUMPE	T1,E$$NPF	;ERROR IF DIRECTION UNCLEAR
	CAIL	N,1B18		;VERIFY NOT HUGE
	JRST	E$$DFL		;ERROR--TOO LARGE
	MOVEM	N,VAL5		;SAVE RELATIVE DATE
	PUSHJ	P,.TIAUC##	;GET NEXT CHARACTER (SKIP D)
	PUSHJ	P,DATIC		;GO CHECK FOR TIME
	  MOVEI	N,0		;0 IF NONE
	HRL	N,VAL5		;INCLUDE DAYS IN LH
	JRST	DATITR		;GO DO RELATIVE RETURN
;HERE WHEN DIGITS SEEN WITHOUT A FOLLOWING D
DATIN:	CAIE	C,"-"		;SEE IF DAY/MONTH COMBO
	JRST	DATIT		;NO--MUST BE INTO TIME
	CAILE	N,^D31		;MUST BE LESS THAN 31
	JRST	E$$DFL		;NO--ERROR
	JUMPE	N,E$$DFZ	;VERIFY NOT ZERO
	MOVEM	N,VAL5		;SAVE VALUE
	PUSHJ	P,.TIAUC##	;SKIP OVER MINUS
	CAIL	C,"0"		;SEE IF DIGIT NEXT
	CAILE	C,"9"		; ..
	JRST	DATMMM		;NO-- MUST BE MNEMONIC MONTH
	PUSHJ	P,.DECNC##	;YES-- MUST BE MM-DD FORMAT
	JUMPLE	N,E$$NND	;BAD IF LE 0
	CAILE	N,^D31		;VERIFY LE 31
	JRST	E$$DFL		;BAD
	EXCH	N,VAL5		;SWITCH VALUES
	CAILE	N,^D12		;VERIFY MONTH OK
	JRST	E$$DFL		;BAD
	JRST	DATMM1		;GO STORE MONTH
;HERE WHEN TIME SEEN BY ITSELF
DATIT:	PUSHJ	P,DATIG		;GET REST OF TIME
	  HALT	.		;CAN NOT GET HERE
	SKIPN	FLFUTR		;SEE IF RELATIVE
	JRST	DATIRN		;NO--GO HANDLE AS ABS.
;HERE WITH DISTANCE IN N
DATITR:	SKIPGE	FLFUTR		;IF PAST,
	MOVN	N,N		;  COMPLEMENT DISTANCE
	ADD	N,NOW		;ADD TO CURRENT DATE/TIME
	JRST	DATIMX		;CHECK ANSWER AND RETURN

;HERE WHEN DD- SEEN AND MNEMONIC MONTH COMING
DATMMM:	PUSHJ	P,.SIXSC##	;GET MNEMONIC
	MOVE	T1,MONPTR	;GET POINTER TO  MONTH TABLE
	PUSHJ	P,.NAME##	;LOOKUP IN TABLE
	  JRST	E$$UDM		;NO GOOD
	MOVEI	N,(T1)		;GET MONTH
	SUBI	N,MONTHS-1	;  AS 1-12
;HERE WITH MONTH INDEX (1-12) IN T1
DATMM1:	MOVEM	N,VAL6		;SAVE FOR LATER
DATIY0:	CAIE	C,"-"		;SEE IF YEAR NEXT
	JRST	DATIRA		;NO--GO HANDLE TIME
;HERE WHEN YEAR NEXT AS ONE, TWO, OR FOUR DIGITS
	SETZB	N,T1		;CLEAR DIGIT AND RESULT COUNTERS
DATIY:	PUSHJ	P,.TIAUC##	;GET NEXT DIGIT
	CAIL	C,"0"		;SEE IF NUMERIC
	CAILE	C,"9"		; ..
	JRST	DATIY1		;NO--MUST BE DONE
	IMULI	N,^D10		;ADVANCE RESULT
	ADDI	N,-"0"(C)	;INCLUDE THIS DIGIT
	AOJA	T1,DATIY	;LOOP FOR MORE, COUNTING DIGIT
DATIY1:	JUMPE	T1,E$$ILR	;ERROR IF NO DIGITS
	CAIE	T1,3		;ERROR IF 3 DIGITS
	CAILE	T1,4		;OK IF 1,2, OR 4
	JRST	E$$ILR		;ERROR IF GT 4 DIGITS
	MOVE	T2,N		;GET RESULT
	IDIVI	T2,^D100	;SEP. CENTURY
	IDIVI	T3,^D10		;SEP. DECADE
	CAIG	T1,2		;IF ONE OR TWO DIGITS,
	SETOM	T2		;  FLAG NO CENTURY KNOWN
	CAIN	T1,1		;IF ONE DIGIT,
	SETOM	T3		;  FLAG NO DECADE KNOWN
	MOVEM	T4,VAL7		;SAVE UNITS
	MOVEM	T3,VAL8		;SAVE DECADE
	MOVEM	T2,VAL9		;SAVE CENTURY

;HERE WITH VAL5-9 CONTAINING DAY, MONTH, YEAR, DECADE, CENTURY
DATIRA:	SOS	VAL5		;MAKE DAYS 0-30
	SOS	VAL6		;MAKE MONTHS 0-11
	PUSHJ	P,DATIC		;GET TIME IF PRESENT
	  SKIPG	FLFUTD		;IGNORE ABSENCE
	JRST	DATIRN		; UNLESS FUTURE
;HERE IF FUTURE WITHOUT TIME
	MOVEI	T1,^D59		;SET TO
	MOVEM	T1,VAL2		; 23:59:59
	MOVEM	T1,VAL3		; ..
	MOVEI	T1,^D23		; ..
	MOVEM	T1,VAL4		; ..
;HERE WITH VAL2-9 CONTAINING PARSE OR -1 IF TO BE FILLED IN
;	STRATEGY IS TO FILL-IN HOLES LESS SIGNIFICANT THAN
;	MOST SIGN. FIELD WITH 0; AND TO FILL IN MORE SIGNIFICANT
;	HOLES WITH CURRENT VALUE.  THEN IF WRONG DIRECTION FROM
;	NOW, ADD/SUB ONE TO FIELD JUST ABOVE MOST SIGNIFICANT DIFFERENT
;	(FIELD CARRY NOT NEEDED SINCE IT WILL HAPPEN IMPLICITLY).
DATIRN:	PUSHJ	P,.TICAN##	;MAKE SURE NEXT CHAR IS SEPARATOR
	  SKIPA			;YES--OK
	JRST	E.ILSC##	;NO--FLAG ERROR BEFORE DEFAULTING
	MOVE	T1,NOW		;GET CURRENT DATE/TIME
	PUSHJ	P,.CNTDT	;CONVERT TO EASY FORMAT
	MOVE	T3,T1		;SAVE MSTIME
	IDIVI	T3,^D1000	; AS SECONDS
	ADD	T2,[^D1900*^D12*^D31]  ;MAKE REAL
	MOVEI	T4,8		;TRY 8 FIELDS
DATIRB:	MOVE	T1,T2		;POSITION REMAINDER
	IDIV	T1,[1
		    ^D60
		    ^D60*^D60
		    1
		    ^D31
		    ^D31*^D12
		    ^D31*^D12*^D10
		    ^D31*^D12*^D10*^D10]-1(T4)  ;SPLIT THIS FIELD FROM REST 
	SKIPL	VAL1(T4)	;SEE IF DEFAULT
	JRST	[TLNN T3,-1	;NO--FLAG TO ZERO DEFAULTS
		 HRL  T3,T4	; SAVING INDEX OF LAST DEFAULT
		 JRST DATRIC]	;AND CONTINUE LOOP
	SETZM	VAL1(T4)	;DEFAULT TO
	TLNN	T3,-1		;SEE IF NEED CURRENT
	MOVEM	T1,VAL1(T4)	;YES--SET THAT INSTEAD
DATRIC:	CAME	T1,VAL1(T4)	;SEE IF SAME AS CURRENT
	JRST	DATIRD		;NO--REMEMBER FOR LATER
	CAIN	T4,4		;SEE IF TIME FOR TIME
	HRRZ	T2,T3		;YES--GET IT
	SOJG	T4,DATIRB	;LOOP UNTIL ALL DONE

;HERE WHEN FILLED IN CURRENT FOR SIGNIFICANT DEFAULTS
DATIRD:	SKIPGE	VAL1(T4)	;SEE IF DEFAULT
	SETZM	VAL1(T4)	;CLEAR DEFAULT
	SOJG	T4,DATIRD	;LOOP UNTIL DONE
	HLRZ	N,T3		;RECOVER LAST SIGN. DEFAULT-1
	JUMPE	N,DATIRR	;DONE IF NONE
	PUSHJ	P,DATIRM	;MAKE CURRENT DATE, TIME
	MOVE	T4,FLFUTD	;GET DEFAULT DIRECTION
	XCT	[CAMGE	T1,NOW
		 JFCL
		 CAMLE	T1,NOW]+1(T4)  ;SEE IF OK
	JRST	DATIRR		;YES--GO RETURN
	SKIPG	FLFUTD		;NO--SEE WHICH DIRECTION
	SOSA	VAL2(N)		;PAST
	AOS	VAL2(N)		;FUTURE
DATIRR:	PUSHJ	P,DATIRM	;REMAKE ANSWER
	MOVE	N,T1		;MOVE TO ANSWER
;HERE WITH FINAL RESULT, CHECK FOR OK
	RADIX	10
DATIMX:	MOVEI	T1,.TDTTM	;SET DATE-TIME
	MOVEM	T1,.LASWD##	; OUTPUTER
	CAMGE	N,[<1900-1859>*365+<1900-1859>/4+<31-18>+31,,0]
	JRST	E$$DOR		;OUT OF RANGE
	MOVEM	N,.NMUL##	;STORE IN .NMUL
	POPJ	P,		;**RETURN
	RADIX	8
	M$FAIL	(DOR,Date/time out of range)

;SUBROUTINE TO MAKE DATE/TIME
DATIRM:	MOVE	T1,VAL4		;GET HOURS
	IMULI	T1,^D60		;MAKE INTO MINS
	ADD	T1,VAL3		;ADD MINS
	IMULI	T1,^D60		;MAKE INTO SECS
	ADD	T1,VAL2		;ADD SECS
	IMULI	T1,^D1000	;MAKE INTO MILLISECS
	MOVE	T2,VAL9		;GET CENTURIES
	IMULI	T2,^D10		;MAKE INTO DECADES
	ADD	T2,VAL8		;ADD DECADES
	IMULI	T2,^D10		;MAKE INTO YEARS
	ADD	T2,VAL7		;ADD YEARS
	IMULI	T2,^D12		;MAKE INTO MONTHS
	ADD	T2,VAL6		;ADD MONTHS
	IMULI	T2,^D31		;MAKE INTO DAYS
	ADD	T2,VAL5		;ADD DAYS
	SUB	T2,[^D1900*^D12*^D31]  ;REDUCE TO SYSTEM RANGE
	PJRST	.CNVDT		;CONVERT TO INTERNAL FORM AND RETURN

;SUBROUTINE TO GET TIME IF SPECIFIED
;RETURNS CPOPJ IF NO TIME, SKIP RETURN IF TIME
;  WITH TIME IN RH(N) AS FRACTION OF DAY
;USES T1-4, N

DATIC:	CAIE	C,":"		;SEE IF TIME NEXT
	POPJ	P,		;NO--MISSING TIME
	PUSHJ	P,.DECNW##	;GET DECIMAL NUMBER FOR TIME
;HERE WITH FIRST TIME FIELD IN N
DATIG:	JUMPL	N,E$$NND	;ERROR IF NEGATIVE
	CAIL	N,^D24		; AND GE 24,
	JRST	E$$DFL		;GIVE ERROR--TOO LARGE
	MOVEM	N,VAL4		;SAVE HOURS
	CAIE	C,":"		;SEE IF MINUTES COMING
	JRST	DATID		;NO--DONE
	PUSHJ	P,.DECNW##	;YES--GET IT
	CAIL	N,^D60		;SEE IF IN RANGE
	JRST	E$$DFL		;NO--GIVE ERROR
	JUMPL	N,E$$NND	;ERROR IF NEG
	MOVEM	N,VAL3		;SAVE MINUTES
	CAIE	C,":"		;SEE IF SEC. COMING
	JRST	DATID		;NO--DONE
	PUSHJ	P,.DECNW##	;GET SECONDS
	CAIL	N,^D60		;CHECK RANGE
	JRST	E$$DFL		;NO--GIVE ERROR
	JUMPL	N,E$$NND	;ERROR IF NEG
	MOVEM	N,VAL2		;SAVE SECONDS
;HERE WITH TIME IN VAL2-4
DATID:	SKIPGE	T1,VAL4		;GET HOURS
	MOVEI	T1,0		;  UNLESS ABSENT
	IMULI	T1,^D60		;CONV TO MINS
	SKIPL	VAL3		;IF MINS PRESENT,
	ADD	T1,VAL3		;  ADD MINUTES
	IMULI	T1,^D60		;CONV TO SECS
	SKIPL	VAL2		;IF SECS PRESENT,
	ADD	T1,VAL2		;  ADD SECONDS
	MOVEI	T2,0		;CLEAR OTHER HALF
	ASHC	T1,-^D17	;MULT BY 2**18
	DIVI	T1,^D24*^D3600	;DIVIDE BY SECONDS/DAY
	MOVE	N,T1		;RESULT IS FRACTION OF DAY IN RH
	JRST	.POPJ1##	;RETURN

;DATE/TIME ERRORS

	M$FAIL	(NFT,Date/time must be in the future)
	M$FAIL	(NPS,Date/time must be in the past)
	M$FAIL	(NND,Negative number in date/time)
	M$FAIL	(NPF,Not known whether past or future in date/time)
	M$FAIL	(DFL,Field too large in date/time)
	M$FAIL	(DFZ,Field zero in date/time)
	M$FAIL	(UDM,Unrecognized month in date/time)
	M$FAIL	(ILR,Illegal year format in date/time)
	M$FAIL	(UDN,Unrecognized name in date/time)
	M$FAIL	(MDD,Missing day in date/time)
	M$FAIL	(DTM,Value missing in date/time)


;MNEMONIC WORDS IN DATE/TIME SCAN

	DEFINE	XX($1),<
	EXP	<SIXBIT	/$1/>>

DAYS:	XX	WEDNESDAY
	XX	THURSDAY
	XX	FRIDAY
	XX	SATURDAY
	XX	SUNDAY
	XX	MONDAY
	XX	TUESDAY

MONTHS:	XX	JANUARY
	XX	FEBRUARY
	XX	MARCH
	XX	APRIL 
	XX	MAY
	XX	JUNE
	XX	JULY
	XX	AUGUST
	XX	SEPTEMBER
	XX	OCTOBER
	XX	NOVEMBER
	XX	DECEMBER

SPCDAY:	XX	YESTERDAY
	XX	TODAY
	XX	TOMORROW

SPLGTM:	XX	LOGIN
SPNOON:	XX	NOON
SPMIDN:	XX	MIDNIGHT

SPDATM:	XX	LUNCH
	XX	DINNER
LSPDTM==.-DAYS

;POINTERS

MONPTR:	IOWD	^D12,MONTHS
MNDPTR:	IOWD	LSPDTM,DAYS

SUBTTL	ROUTINES TO COVERT DATE/TIME FORMATS

;.CNTDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL:	MOVE	T1,DATE/TIME
;	PUSHJ	P,.CNTDT
;	RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4

.CNTDT:	PUSH	P,T1		;SAVE TIME FOR LATER
	JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)

	RADIX	10		;**** NOTE WELL ****

	ADDI	T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
				;T1=DAYS SINCE JAN 1, 1501
	IDIVI	T1,400*365+400/4-400/100+400/400
				;SPLIT INTO QUADRACENTURY
	LSH	T2,2		;CONVERT TO NUMBER OF QUARTER DAYS
	IDIVI	T2,<100*365+100/4-100/100>*4+400/400
				;SPLIT INTO CENTURY
	IORI	T3,3		;DISCARD FRACTIONS OF DAY
	IDIVI	T3,4*365+1	;SEPARATE INTO YEARS
	LSH	T4,-2		;T4=NO DAYS THIS YEAR		[311]
	LSH	T1,2		;T1=4*NO QUADRACENTURIES	[311]
	ADD	T1,T2		;T1=NO CENTURIES		[311]
	IMULI	T1,100		;T1=100*NO CENTURIES		[311]
	ADDI	T1,1501(T3)	;T1 HAS YEAR, T4 HAS DAY IN YEAR	[311]

	MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
	TRNE	T2,3		;IS THE YEAR A MULT OF 4?	[311]
	JRST	CNTDT0		;NO--JUST INDICATE NOT A LEAP YEAR  [311]
	IDIVI	T2,100		;SEE IF YEAR IS MULT OF 100	[311]
	SKIPN	T3		;IF NOT, THEN LEAP		[311]
	TRNN	T2,3		;IS YEAR MULT OF 400?		[311]
	TDZA	T3,T3		;YES--LEAP YEAR AFTER ALL	[311]
CNTDT0:	MOVEI	T3,1		;SET LEAP YEAR FLAG		[311]
				;T3 IS 0 IF LEAP YEAR

	;UNDER RADIX 10 **** NOTE WELL ****

CNTDT1:	SUBI	T1,1900		;SET TO SYSTEM ORIGIN
	IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T3,CNTDT2	;IF NOT LEAP YEAR, PROCEED
	CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNTDT5		;NO--JUST INCLUDE IN ANSWER
	SOS	T4		;YES--BACK OFF ONE DAY
CNTDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS

CNTDT3:	CAMGE	T4,MONTAB+1(T2)	;SEE IF BEYOND THIS MONTH
	JRST	CNTDT4		;YES--GO FINISH UP
	ADDI	T1,31		;NO--COUNT SYSTEM MONTH
	AOBJN	T2,CNTDT3	;LOOP THROUGH NOVEMBER

CNTDT4:	SUB	T4,MONTAB(T2)	;GET DAYS IN THIS MONTH
CNTDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT

CNTDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
	TLZ	T1,-1		;CLEAR DATE
	MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
	ASHC	T1,17		;POSITION RESULT
	POP	P,T2		;RECOVER DATE
	POPJ	P,		;RETURN

;.GTNOW -- COMPUTE CURRENT TIME IN SPECIAL FORMAT
;CALL:	PUSHJ	P,.GTNOW
;RETURNS WITH RESULT IN T1
;USES T2, T3, T4
;GETTAB CONVERTED TO JSYS SINCE THE GETTAB WAS FAILING
;BY PAUL ROBINSON, WESLEYAN UNIV. DECUS CONVERSION PROGRAMMER JULY'80
	OPDEF	GTAD	[JSYS	^O227]

.GTNOW:	;MOVX	T1,%CNDTM	;ASK MONITOR			[310]
	;GETTAB	T1,		; FOR ANSWER			[310]
IFE T1-1,<GTAD>			;JSYS USES AC 1
IFN T1-1,<PUSH	P,1		;SAVE AC 1
	GTAD			;GET DATE/TIME
	MOVE	T1,1		;PUT IT WHERE IT'S WANTED
	POP	P,1		;RESTORE AC 1
>; END IFN
	CAMN	T1,[EXP -1]	;JSYS RETURNS -1 IF DOESN'T KNOW TIME
	ERROR.	EF$FTL,CGN,<CAN'T GET 'NOW' FROM MONITOR>
	JRST	GETNWX		;GO GIVE RESULT

	;UNDER RADIX 10 **** NOTE WELL ****

				;FALL HERE FROM .GTNOW

;.CNVDT -- CONVERT ARBITRARY DATE TO SPECIAL FORMAT
;CALL:	MOVE	T1,TIME IN MILLISEC.
;	MOVE	T2,DATE IN SYSTEM FORMAT (Y*12+M)*31+DAY  SINCE 1/1/64
;	PUSHJ	P,.CNVDT
;RETURNS WITH RESULT IN T1 (.GT.0; OR -1 IF BEYOND SEPT. 27,2217)
;	NOTE THAT IN SPECIAL FORMAT, THE LEFT HALF DIVIDED
;	  BY 7 GIVES THE DAY OF THE WEEK (0=WED.)
;USES T2, T3, T4

.CNVDT:	PUSHJ	P,.SAVE1##	;PRESERVE P1
	PUSH	P,T1		;SAVE TIME FOR LATER
	IDIVI	T2,12*31	;T2=YEARS-1900
	CAILE	T2,2217-1900	;SEE IF BEYOND 2217
	JRST	GETNW2		;YES--RETURN -1
	IDIVI	T3,31		;T3=MONTHS-JAN, T4=DAYS-1
	ADD	T4,MONTAB(T3)	;T4=DAYS-JAN 1
	MOVEI	P1,0		;LEAP YEAR ADDITIVE IF JAN, FEB
	CAIL	T3,2		;CHECK MONTH
	MOVEI	P1,1		;ADDITIVE IF MAR-DEC
	MOVE	T1,T2		;SAVE YEARS FOR REUSE
	ADDI	T2,3		;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
	IDIVI	T2,4		;HANDLE REGULAR LEAP YEARS
	CAIE	T3,3		;SEE IF THIS IS LEAP YEAR
	MOVEI	P1,0		;NO--WIPE OUT ADDITIVE
	ADDI	T4,<1900-1859>*365+<1900-1859>/4+<31-18>+31(T2)
				;T4=DAYS BEFORE JAN 1,1900 +SINCE JAN 1
				; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
	MOVE	T2,T1		;RESTORE YEARS SINCE 1900
	IMULI	T2,365		;DAYS SINCE 1900
	ADD	T4,T2		;T4=DAYS EXCEPT FOR 100 YR. FUDGE
	HRREI	T2,-100-1(T1)	;T2=YEARS SINCE 2001
	JUMPLE	T2,GETNW1	;ALL DONE IF NOT YET 2001
	IDIVI	T2,100		;GET CENTURIES SINCE 2001
	SUB	T4,T2		;ALLOW FOR LOST LEAP YEARS
	CAIE	T3,99		;SEE IF THIS IS A LOST L.Y.
GETNW1:	ADD	T4,P1		;ALLOW FOR LEAP YEAR THIS YEAR
	CAILE	T4,^O377777	;SEE IF TOO BIG
GETNW2:	SETOM	T4		;YES--SET -1

	POP	P,T1		;GET MILLISEC TIME
	MOVEI	T2,0		;CLEAR OTHER HALF
	ASHC	T1,-17		;POSITION
	DIV	T1,[24*60*60*1000]  ;CONVERT TO 1/2**18 DAYS
	HRL	T1,T4		;INCLUDE DATE
GETNWX:	POPJ	P,		;RETURN

	;UNDER RADIX 10 **** NOTE WELL ****

MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365
	RADIX	8

SUBTTL	DATE/TIME OUTPUT

;.TDTTM -- TYPE DATE AND TIME IN UNIVERSAL FORMAT
;CALL:	MOVE	T1,DATE/TIME IN UNIVERSAL FORMAT
;	CALL	.TDTTM
;USES T1-4

.TDTTM:	PUSHJ	P,.CNTDT	;DISASSEMBLE
	SAVE$	T1		;SAVE TIME
	MOVE	T1,T2		;POSITION DATE
	PUSHJ	P,.TDATE	;TYPE DATE
	PUSHJ	P,.TCOLN##	;AND A COLON
	RESTR$	T1		;GET TIME
	PJRST	.TTIME##	;TYPE IT AND RETURN

;.TDATX -- TYPE DAY AND DATE IN UNIVERSAL FORMAT
;CALL:	MOVE	T1,DATE/TIME IN UNIVERSAL FORMAT
;	CALL	.TDATX
;USES T1-4

.TDATX:	PUSH	P,T1		;REMEMBER UNIVERSAL DATE/TIME
	HLRZS	T1		;POSITION DATE TO RIGHT HALF
	IDIVI	T1,7		;FIGURE DAY OF WEEK
	MOVEI	T1,DAYOFW(T2)	;GET STRING ADDRESS
	CALL	.TSTRG##	;SEND DAY STRING
	POP	P,T1		;GET DATE BACK
	CALL	.CNTDT		;DISSASSEMBLE
	MOVE	T1,T2		;POSITION DATE
;	PJRST	.TDATE		;TYPE AND RETURN

;.TDATE -- TYPE DATE IN STANDARD FORMAT OF DD-MMM-YY
;CALL:	MOVEI	T1,DATE IN SYSTEM FORMAT FROM DATE UUO
;	PUSHJ	P,.TDATE
;USES T1-4

.TDATE:	PUSHJ	P,.SAVE1##	;SAVE P1
	IDIVI	T1,^D31		;GET DAYS
	MOVE	T4,T1		;SAVE REST
	MOVEI	T1,1(T2)	;GET DAYS AS 1-31
	MOVEI	T2," "		;FILL WITH SPACE
	PUSHJ	P,.TDEC2##	;TYPE IN DECIMAL
	IDIVI	T4,^D12		;GET MONTHS
	MOVEI	T1,[ASCIZ /-Jan/
		    ASCIZ /-Feb/
		    ASCIZ /-Mar/
		    ASCIZ /-Apr/
		    ASCIZ /-May/
		    ASCIZ /-Jun/
		    ASCIZ /-Jul/
		    ASCIZ /-Aug/
		    ASCIZ /-Sep/
		    ASCIZ /-Oct/
		    ASCIZ /-Nov/
		    ASCIZ /-Dec/](P1)	;GET ASCII
	PUSHJ	P,.TSTRG##	;TYPE IT
	MOVEI	T1,(T4)		;GET YEAR SINCE 1900
	IDIVI	T1,^D100	;GET JUST YEARS IN CENTURY
	MOVEI	T1,"-"		;GET A SIGN
	CALL	.TCHAR##	;SEND IT
	MOVE	T1,T2		;POSITION YEARS
	MOVEI	T2,"0"		;FILL WITH A ZERO
	PJRST	.TDEC2##	;TYPE AND RETURN

DAYOFW:	ASCII	/WED /
	ASCII	/THU /
	ASCII	/FRI /
	ASCII	/SAT /
	ASCII	/SUN /
	ASCII	/MON /
	ASCII	/TUE /

SUBTTL	OPEN I/O CHANNELS
;OPENIO
;CALL:	MOVEI	T1,<FDB ADDR>
;	CALL	OPENIO
;	CAI	CHANNEL,BUFADR	;@ IF OUTPUT, (MODE)
;	*ALL IS WELL*

OPENIO:	HRL	T1,0(P)		;REMEMBER CALLER
	AOS	0(P)		;SKIP ARGS ON RETURN
	CALL	.SAVE3##	;PRESERVE REGISTERS
	MOVS	P1,T1		;COPY ARGUMENTS
	MOVE	P2,(P1)		;GET REST OF THEM
	MOVSI	T1,.FXLEN	;SETUP FOR .STOPB
	HLR	T1,P1		;...
	MOVEI	T2,OPNBLK	;
	MOVE	T3,[XWD .RBTIM+1,LKPBLK] ;
	MOVEI	T4,PTHBLK
	CALL	.STOPB##	;CONVERT TO OPEN/LOOKUP BLOCKS
	 JRST	WLDERR		;NO WILDCARDING!
	MOVEI	T1,.RBTIM	;SETUP COUNT
	MOVEM	T1,LKPBLK+.RBCNT
	LDB	T1,[POINT 4,P2,17] ;GET MODE
	MOVEM	T1,OPNBLK	;STORE IN OPEN BLOCK
	HRRZ	T1,P2		;BUFFER HEADER ADDRESS
	TLNE	P2,ATSIGN	;READ OR WRITE?
	MOVSS	T1		;WRITING, POSITON FOR IT
	MOVEM	T1,OPNBLK+.OPBUF;STORE
	LDB	P3,[POINT 4,P2,12] ;GET I/O CHANNEL
	LSH	P3,5		;POSITION
	MOVSS	P3		;IN CHANNEL POSITION
	MOVE	T1,[OPEN OPNBLK];FORM INSTR
	OR	T1,P3		;FINISH
	XCT	T1		;TRY TO OPEN DEVICE
	 JRST	OPENER		;CAN'T--BOMB OUT
	MOVE	T1,P3		;REGET I/O CHANNEL
	TLNE	P2,ATSIGN	;READ/WRITE?
	 TLOA	T1,(ENTER)	;WRITE
	  TLO	T1,(LOOKUP)	;READ
	HRRI	T1,LKPBLK	;COMPLETE INSTR
	XCT	T1		;FIND/WRITE THE FILE
	 JRST	LKENER		;OOPS
	POPJ	P,		;OK--RETURN
$POPJ2:	AOS	(P)		;SKIP 2
$POPJ1:	AOS	(P)		;SKIP 1
$POPJ:	POPJ	P,		;SKIP 0

;OPENIO ERRORS

OPENER:	HLRZ	T1,P1		;COPY FDB ADDR
	ERROR.	EF$FTL!EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >

WLDERR:	HLRZ	T1,P1		;GET FDB
	ERROR.	EF$FTL!EF$FIL,WFI,<WILDCARD FILESPEC ILLEGAL, FILE >

LKENER:	HRRZ	T1,LKPBLK+.RBEXT;GET FAIL CODE
	ERROR.	EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
	STRNG$	<) FILE >
	HLRZ	T1,P1
	CALL	.TFBLK##	;TYPE SCAN BLOCK
	CALL	.TCRLF##	;NEW LINE
	JRST	ERRFTL		;GO DIE

;CALL HERE WITH CHAR IN T1 TO OUTPUT

CHROUT:	SOSG	OBHR+.BFCTR	;ROOM?
	 JRST	CHRO.1		;NO
CHRO.0:	IDPB	T1,OBHR+.BFPTR	;YES--STORE IT
	POPJ	P,

CHRO.1:	CALL	XCTIO		;DO IT
	 OUT	OUTC,		;XCT'D
	  HALT	.+1		;SNH
	JRST	CHRO.0		;STORE CHAR

SUBTTL	XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING

;XCTIO
;CALL:	CALL	XCTIO
;	<INSTR TO XCT>	;IN/OUT UUO
;	*EOF/EOT RETURN*
;	*NORMAL RETURN*

XCTIO:	XCT	@0(P)		;DO THE INSTR
	 JRST	$POPJ2		;OK--SKIP 2 AND RETURN
	SAVE$	T1		;OOPS--SAVE T1
	MOVE	T1,@-1(P)	;GET INSTR WE FAILED ON
	AOS	-1(P)		;SKIP INSTR ON WAY BACK
	AND	T1,[17B12]	;ERROR--GET THE CHANNEL
	OR	T1,[GETSTS T2]	;GET ERRROR BITS
	XCT	T1
	TRNE	T2,IO.EOF!IO.EOT;END OF SOMETHING?
	JRST	TPOPJ		;YES
	EXCH	T1,T2		;NO--GET BITS IN RIGHT PLACE, SAVE I/O INSTR
	HRR	T2,T1		;PUT BITS IN THE INSTR
	SAVE$	T2		;SAVE I/O INSTR A SEC
	WARN.	EF$NCR!EF$OCT,IOE,<I/O ERROR - STATUS=>
;	STRNG$	<, FILE >
;	LDB	T1,[POINT 4,(P),12]	;GET CHANNEL
;	MOVE	T1,[EXP INPSPC,OUTSPC]-1(T1) ;GET FDB ADDRESS
;	CALL	.TFBLK##	;TYPE FILE
	STRNG$	< - CONTINUING
>
	RESTR$	T1		;GET INSTR BACK
	TRZ	T1,IO.ERR	;CLEAR ERROR BITS
	TLZ	T1,002000	;GETSTS BECOMES SETSTS
	XCT	T1
TPOPJ1:	RESTR$	T1		;GET T1 AGAIN
	AOSA	(P)
TPOPJ:	RESTR$	T1
	POPJ	P,

SUBTTL	ERROR HANDLER

;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERROR. MACRO

EHNDLR:	CALL	SAVACS		;SAVE THE ACS
	MOVE	P1,@0(P)	;GET FLAGS AND ADDRESSES
	SKIPN	@.TYOCH##	;IS SCAN TTCALLING?
	 JRST	[SETZM	ERRTYX	;YES--CLEAR FLAG
		JRST	EHND.0]	;AND SKIP ON
	SETZ	T1,		;NO--SO MAKE IT
	CALL	.TYOCH##	;TELL SCAN
	MOVEM	T1,ERRTYX	;REMEMBER/SET FLAG
EHND.0:	MOVEI	T1,"?"		;ASSUME AN ERROR
	TLNE	P1,EF$WRN	;CHECK WARNING
	MOVEI	T1,"%"		;YES
	TLNE	P1,EF$INF	;IF BOTH OFF NOW THEN INFO
	MOVEI	T1,"["		;GOOD THING WE CHECKED
	CALL	.TCHAR##	;OUTPUT THE START OF MESSAGE
	MOVSI	T1,MY$PFX	;SET UP MY PREFIX
	HLR	T1,(P1)		;GET MESSAGE PREFIX
	CALL	.TSIXN##	;OUTPUT THE PREFIXES
	CALL	.TSPAC##	;AND A SPACE
	HRRZ	T1,(P1)		;GET STRING ADDRESS
	CALL	.TSTRG##	;SEND IT
	MOVE	T1,SAVAC+T1	;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
	LDB	T2,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
	CAILE	T2,EF$MAX	;CHECK LEGAL
	 MOVEI	T2,0		;NOOOP
	CALL	@ERRTAB(T2)	;CALL THE ROUTINE
	TLNE	P1,EF$NCR	;IF NO CRLF THEN DON'T CLOSE INFO
	 JRST	EHND.1		;NO--DON'T CHECK
	MOVEI	T1,"]"		;PREPARE TO CLOSE INFO
	TLNE	P1,EF$INF	;CHECK FOR INFO
	CALL	.TCHAR##	;SEND INFO CLOSE
	TLNN	P1,EF$NCR	;NO CARRIAGE RETURN?
	CALL	.TCRLF##	;YES--SEND ONE
EHND.1:	SKIPN	T1,ERRTYX	;DID WE RESET SCAN?
	 JRST	EHND.2		;NO
	CALL	.TYOCH##	;AND RESTORE IT
	SETZM	ERRTYX		;CLEAR FLAG
EHND.2:	TLNE	P1,EF$FTL	;NOW CHECK FATAL
	 JRST	ERRFTL		;YES--GO DIE
	;FALL INTO RESACS

;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
;	CALL	RESACS
;	*ACS RESTORED FROM SAVAC*

RESACS:	MOVEM	17,SAVAC+17	;SAVE 17 TO RESTORE INTO IT
	MOVSI	17,SAVAC
	BLT	17,17		;REGISTERS ARE RESTORED
	POPJ	P,		;RETURN

ERRTAB:	.POPJ##			;CODE 0 -- NO ACTION
	.TDECW##		;CODE 1 -- TYPE T1 IN DECIMAL
	.TOCTW##		;CODE 2 -- TYPE T1 IN OCTAL
	.TSIXN##		;CODE 3 -- TYPE T1 IN SIXBIT
	.TPPNW##		;CODE 4 -- TYPE T1 AS PPN
	.TSTRG##		;CODE 5 -- T1 POINTS TO ASCIZ STRING
	.TFBLK##		;CODE 6 -- T1 POINTS AT FDB
	.TDATX			;CODE 7 -- TYPE T1 AS DAY/DATE

;HERE TO DIE--

ERRFTL:	SAVE$	.JBFF		;SAVE JBFF OVER RESET
	RESET			;KILL ALL FILES
	RESTR$	.JBFF		;GET JOBFF BACK
	MOVE	P,INIPDP	;RESET PDL
	CALL	.CLRBF##	;CLEAR ANY TYPE AHEAD OR UNEATEN COMMANDS
	SKIPE	OFFSET		;CCL ENTRY
	  CALL	.MONRT##	;YES--EXIT 1,
	JRST	RESTRT		;AND RESTART ON CONTINUE

;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
;	*ACS SAVED IN SAVAC*	BEWARE!!

SAVACS:	MOVEM	17,SAVAC+17	;SAVE ONE
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16
	MOVE	17,SAVAC+17
	POPJ	P,		;ACS ARE SAVED

SUBTTL	STORAGE

;STORAGE THAT REMAINS BETWEEN RUNS

U (ISCNVL)		;VALUE FROM .ISCAN
U (TLDVER)		;-1 WHEN TYPED VERSION TO TTY
U (OFFSET)		;STARTING OFFSET
U (LOGTIM)		;JOB LOGIN TIME

FW$ZER==.	;FIRST WORD ZEROED
U (PDLIST,LN$PDL)	;PUSHDOWN LIST
U (SAVAC,20)		;SAVE ACS HERE
U (PLTBUF,PLTBSZ+1)	;FORM A LINE HERE
U (FLFUTD)		;FLAGS FOR DATE-TIME GETTER
U (FLFUTR)
U (NOW)			;CURRENT DATE/TIME
U (VAL1)		;DON'T SEPARATE VALX
U (VAL2)
U (VAL3)
U (VAL4)
U (VAL5)
U (VAL6)
U (VAL7)
U (VAL8)
U (VAL9)
U (TEMP)		;TEMP
U (IPOS)
U (EPOS)
U (PPOS)
U (FILSPC,.FXLEN)	;SCAN FILE SPEC
U (OPNBLK,3)		;OPEN BLOCK
U (LKPBLK,.RBTIM)	;LOOKUP/ENTER BLOCK
U (PTHBLK,^D9)		;PATH BLOCK
U (ERRTYX)		;FLAG FOR EHNDLR
U (IBHR,3)		;INPUT BUFFER HEADER
U (OBHR,3)		;OUTPUT BUFFER HEADER
SCN$FZ==.	;FIRST WORD ZEROED AT CLRANS
SCN$LZ==.-1	;LAST WORD ZEROED AT CLRANS
SCN$FO==.	;FIRST WORD MINUS ONNED AT CLRANS
U (BIRTHD)		;/BIRTHDAY ARG
U (BEGNDT)		;/BEGIN
U (ENDATE)		;/END
U (PBEGND)		;PXXX SWITCHES (NOT USED)
SCN$LO==.-1	;LAST WORD ONNED AT CLRANS
LW$ZER==.-1	;LAST WORD ZEROED AT STARTUP

	END	BIORTH