Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0133/biorth.lpt
There is 1 other file named biorth.lpt in the archive. Click here to see a list.
BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 1
BIORTH	MAC	 3-FEB-77 13:19		B. SCHREIBER

     1					SUBTTL	B. SCHREIBER
     2
     3					SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
     4					.DIREC	.XTABM
     5					.DIRECT .OKOVL		;MACRO %50A WILL GET NUMBER ERROR
     6								;ON <ASCII/     /> OTHERWISE
     7					SALL
     8
     9					;BIORTH VERSION
    10
    11			000002		BIOVER==2	;MAJOR VERSION
    12			000006		BIOEDT==6	;EDIT LEVEL
    13			000000		BIOMIN==0	;MINOR VERSION
    14			000000		BIOWHO==0	;WHO?
    15
    16					DEFINE CTITLE (WORD1,TEXT,MAJVER,VEREDT)
    17					<WORD1 'TEXT'MAJVER(VEREDT)>
    18
    19					CTITLE	(TITLE,<BIORTH -- PROGRAM TO CHART BIORHYTHMS %>,\BIOVER,\BIOEDT)
    20
    21	000137				LOC	.JBVER
    22		000200	000006		%%BIOV==:VRSN.	(BIO)
    23	000137	000200	000006		EXP	%%BIOV
    24
    25					;SHOW UNIVERSAL VERSION NUMBERS
    26
    27		043000	000443		%%JOBD==%%JOBD		;JOBDAT
    28		101100	000225		%%UUOS==:%%UUOS		;UUOSYM
    29		000100	000024		%%MACT==:%%MACT		;MACTEN
    30		000700	000203		%%SCNM==:%%SCNM		;SCNMAC
    31
    32					;REQUEST REST OF LOADING
    33
    34					.TEXT	&/SEGMENT:LOW/SEARCH REL:ALCOR,REL:SCN7B,REL:HELPER,SYS:FORLIB&

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 2
BIORTH	MAC	 3-FEB-77 13:19		ASSEMBLY / ACCUMULATOR DEFINITIONS

    35					SUBTTL	ASSEMBLY / ACCUMULATOR DEFINITIONS
    36
    37					ND LN$PDL,^D200		;PDL SIZE
    38					ND MY$NAM,'BIORTH'	;MY NAME
    39					ND MY$PFX,'BIO'		;MY MESSAGE PREFIX
    40					ND MX$CRT,4		;NEARNESS TO MIDDLE TO BE CONSIDERED CRITICAL
    41					ND PLTWID,^D60		;WIDTH OF PLOT
    42			000036			PLTZER==PLTWID/2;MIDDLE OF PLOT
    43					ND PLTBSZ,PLTWID/5+1	;# WORDS REQUIRED TO STORE ONE LINE
    44					ND ICYCLE,^D33		;DAYS/INTELLECTUAL CYCLE
    45					ND ECYCLE,^D28		;DAYS/EMOTIONAL CYCLE
    46					ND PCYCLE,^D23		;DAYS/PHYSICAL CYCLE
    47					ND FT$OPT,0		;NON-ZERO TO SCAN SWITCH.INI
    48					ND FT$DDT,0		;NON-ZERO FOR DEBUGGING
    49
    50					;DEFINE THE ACCUMULATORS
    51
    52					DEFINE	AC$ (X)
    53					<X=ZZ
    54					ZZ==ZZ+1
    55					X=X>
    56
    57			000000		ZZ==0
    58
    59			000000		AC$ (X)		;ARGUMENTS FROM FORTRAN SUBRS (SOMETIMES)
    60			000001		AC$ (T1)	;T1-4 ARE TEMPORARY
    61			000002		AC$ (T2)
    62			000003		AC$ (T3)
    63			000004		AC$ (T4)
    64			000005		AC$ (P1)	;P1-4 ARE PERMANENT--MUST BE PRESERVED
    65			000006		AC$ (P2)
    66			000007		AC$ (P3)
    67			000010		AC$ (P4)
    68			000011		AC$ (F)		;FLAGS
    69			000012		AC$ (D)		;DATE
    70			000007			N==P3	;NUMBER/WORD FROM SCAN
    71			000010			C==P4	;CHARACTER FROM SCAN
    72			000017			P=17	;PUSHDOWN LIST PTR

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 3
BIORTH	MAC	 3-FEB-77 13:19		FLAG DEFINITIONS

    73					SUBTTL	FLAG DEFINITIONS
    74
    75					;FLAGS IN LH OF F
    76
    77					DEFINE FLAG$ (FLG)
    78					<FL$'FLG==ZZ
    79					ZZ==ZZ_-1
    80					FL$'FLG==FL$'FLG>
    81
    82			400000		ZZ==(1B0)
    83
    84			400000		FLAG$ (FIL)		;ON IF PLOTTING TO A FILE
    85			200000		FLAG$ (HVB)		;ON WHEN HAVE A BIRTHDAY
    86			100000		FLAG$ (BKW)		;ON IF PLOTTING BACKWARDS IN TIME
    87			040000		FLAG$ (CRT)		;ON IF FOUND TO BE A CRITICAL DAY
    88
    89					;I/O CHANNELS
    90
    91					;0	;NEVER USED BY ME
    92			000001		OUTC==1	;FOR OUTPUT
    93
    94					;OPDEFINES
    95
    96		260740	000000		OPDEF	CALL	[PUSHJ	P,]	;SUBROUTINE CALL
    97		132000	000233		OPDEF	FLOAT.	[FSC	233]	;FLOAT # IN AC
    98
    99					;OTHER STUFF
   100
   101			000020		ATSIGN==(1B13)		;THE INDIRECT BIT

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 5
BIORTH	MAC	 3-FEB-77 13:19		ERROR MACRO DEFINITIONS

   102					SUBTTL	ERROR MACRO DEFINITIONS
   103
   104					;ERROR.	($FLGS,$PFX,$MSG)
   105					;
   106					;$FLGS 	IS THE COMBINITATION OF THE FOLLOWING BITS:
   107
   108			000000			EF$ERR==0	;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
   109			000400			EF$FTL==400	;FATAL ERROR--ABORT AND RESTART
   110			000200			EF$WRN==200	;WARNING MESSAGE--CONTINUE
   111			000100			EF$INF==100	;INFORMATIVE MESSAGE--CONTINUE
   112			000040			EF$NCR==40	;NO FREE CRLF AFTER MESSAGE
   113
   114					DEFINE ETYP ($TYP)
   115					<ZZ==ZZ+1
   116					EF$'$TYP==ZZ>
   117
   118			000000		ZZ==0		;TYPE CODES ARE FROM 1-37
   119
   120			000001		ETYP (DEC)	;TYPE T1 IN DECIMAL AT END OF MESSAGE
   121			000002		ETYP (OCT)	;TYPE T1 IN OCTAL AT END OF MESSAGE
   122			000003		ETYP (SIX)	;TYPE T1 IN SIXBIT AT END OF MESSAGE
   123			000004		ETYP (PPN)	;TYPE T1 AS A PPN AT END OF MESSAGE
   124			000005		ETYP (STR)	;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
   125			000006		ETYP (FIL)	;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
   126			000007		ETYP (DAT)	;TYPE T1 AS A DATE AT END OF MESSAGE
   127			000007			EF$MAX==ZZ	;MAX ERROR TYPE
   128
   129					IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>
   130
   131					;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
   132					;$MSG IS THE MESSAGE ITSELF
   133
   134			300000		NOOP==	(CAI)		;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP
   135
   136					DEFINE	ERROR.	($FLGS,$PFX,$MSG)
   137					<CALL	EHNDLR
   138					XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
   139					>
   140
   141					;WARN.	FLGS,PFX,MSG
   142
   143					DEFINE	WARN.	($FLGS,$PFX,$MSG)
   144					<ERROR.	(EF$WRN!$FLGS,$PFX,$MSG)>
   145
   146					;INFO.	FLGS,PFX,MSG
   147
   148					DEFINE	INFO.	($FLGS,$PFX,$MSG)
   149					<ERROR.	(EF$INF!$FLGS,$PFX,$MSG)>
   150
   151					DEFINE	M$FAIL	($PFX,$MSG)
   152					<E$$'$PFX: ERROR.	(EF$FTL,$PFX,$MSG)>

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 6
BIORTH	MAC	 3-FEB-77 13:19		OTHER MACRO DEFINITIONS

   153					SUBTTL	OTHER MACRO DEFINITIONS
   154					;SAVE$ SAVES DATA ON THE STACK
   155
   156					DEFINE	SAVE$	(X)
   157					<XLIST
   158					IRP X,<PUSH P,X>
   159					LIST>
   160
   161					;RESTR$ RESTORES DATA FROM THE STACK
   162
   163					DEFINE	RESTR$	(X)
   164					<XLIST
   165					IRP X,<POP P,X>
   166					LIST>
   167
   168					;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE
   169
   170					DEFINE	U ($NAME,$WORDS<1>)
   171					<$NAME:	BLOCK	$WORDS>
   172
   173					;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG
   174
   175					DEFINE STRNG$ (S)
   176					<MOVEI	T1,[ASCIZ \S\]
   177					CALL	.TSTRG##>
   178
   179					;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY
   180
   181					DEFINE ASCIZ$ (S)
   182					<XLIST
   183					ASCIZ \S\
   184					LIST>

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 7
BIORTH	MAC	 3-FEB-77 13:19		MAIN-LINE PROGRAM

   185					SUBTTL	MAIN-LINE PROGRAM
   186
   187	000000'				RELOC	0
   188
   189	000000'	634 01 0 00 000001 	BIORTH:	TDZA	T1,T1		;FLAG NORMAL START
   190	000001'	201 01 0 00 000001 		MOVEI	T1,1		;FLAG CCL START
   191	000002'	202 01 0 00 001632'		MOVEM	T1,OFFSET	;SAVE FOR SCAN
   192
   193	000003'	402 00 0 00 000000 		STORE	17,0,16,0	;CLEAR ACS
   194	000004'	200 17 0 00 002340'
   195	000005'	251 17 0 00 000016 
   196	000006'	402 00 0 00 001634'		STORE	17,FW$ZER,LW$ZER,0 ;AND CORE WHICH SHOULD BE CLEARED
   197	000007'	200 17 0 00 002341'
   198	000010'	251 17 0 00 002337'
   199	000011'	047 00 0 00 000000 		RESET			;STOP EXTERNAL I/O WHICH MAY BE IN PROGRESS
   200	000012'	334 17 0 00 000013'		SKIPA	P,.+1		;SETUP PDL
   201	000013'	777470	001633'		INIPDP:	IOWD	LN$PDL,PDLIST
   202	000014'	260 17 0 00 000000*		CALL	.RECOR##	;RESET CORE ALLOCATION
   203	000015'	200 01 0 00 000042'		MOVE	T1,ISCNBL	;GET ISCAN BLOCK
   204	000016'	260 17 0 00 000000*		CALL	.ISCAN##	;INITIALIZE THE COMMAND SCANNER
   205	000017'	202 01 0 00 001630'		MOVEM	T1,ISCNVL	;REMEMBER WHAT ISCAN RETURNS
   206	000020'	336 00 0 00 001632'		SKIPN	OFFSET		;CCL ENTRY?
   207	000021'	332 00 0 00 001631'		 SKIPE	TLDVER		;OR ALREADY TOLD VERSION?
   208	000022'	254 00 0 00 000030'		 JRST	BIOR.0		;ONE OR THE OTHER
   209	000023'	201 01 0 00 002342'		STRNG$	<BIORTH %>	;NO--DO IT NOW
   210	000024'	260 17 0 00 000000*
   211	000025'	200 01 0 00 000137 		MOVE	T1,.JBVER
   212	000026'	260 17 0 00 000000*		CALL	.TVERW##
   213	000027'	260 17 0 00 000000*		CALL	.TCRLF##
   214	000030'	561 01 0 00 000130 	BIOR.0:	HRROI	T1,.GTJLT	;GET LOGIN TIME
   215	000031'	047 01 0 00 000041 		GETTAB	T1,		;FOR DATE-TIME STUFF
   216	000032'	400 01 0 00 000000 		 SETZ	T1,		;(OLD MON)
   217	000033'	202 01 0 00 001633'		MOVEM	T1,LOGTIM	;...
   218	000034'	476 00 0 00 001631'		SETOM	TLDVER		;SO WE ONLY TELL VERSION ONE TIME
   219	000035'	200 01 0 00 000050'	RESTRT:	MOVE	T1,VSCNBL	;GET ARG BLOCK FOR .VSCAN
   220	000036'	260 17 0 00 000000*		CALL	.VSCAN##	;DO THE WORK
   221	000037'	260 17 0 00 000000*		CALL	.MONRT##	;EXIT TO MONITOR
   222	000040'	254 00 0 00 000035'		JRST	RESTRT		;GO RESTART
   223	000041'	203622	077174		TWOPI:	EXP	6.28318		;PI*2

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 8
BIORTH	MAC	 3-FEB-77 13:19		ARGUMENT BLOCKS FOR ISCAN AND VSCAN

   224					SUBTTL	ARGUMENT BLOCKS FOR ISCAN AND VSCAN
   225
   226	000042'	000005	000043'		ISCNBL:	XWD 5,	.+1
   227	000043'	777777	000064'			IOWD	N$CMDS,CMDLST
   228	000044'	001632'	425157			XWD	OFFSET,MY$PFX
   229	000045'	000000	000000			EXP	0
   230	000046'	000000	000000			EXP	0
   231	000047'	000060'	000000			XWD	DOPRMP,0
   232
   233					;ARG BLOCK FOR .VSCAN
   234
   235	000050'	000007	000051'		VSCNBL:	XWD 7,	.+1
   236	000051'	777772	000065'			IOWD	VSWTL,VSWTN
   237	000052'	000110'	000102'			XWD	VSWTD,VSWTM
   238	000053'	000000	000074'			XWD	0,VSWTP
   239	000054'	777777	777777			EXP	-1		;USE MY NAME FOR HELP
   240	000055'	000002	002335'			XWD	2,BEGNDT	;SO PLOT/BEGIN:XX/END:XX WILL WORK
   241	000056'	000000	002337'			XWD	0,PBEGND	;DUMMY
   242	000057'	000000	000000			EXP	0
   243
   244					;SCAN CALLS HERE TO PROMPT -- T1 NEGATIVE IF CONTINUATION
   245
   246	000060'	331 00 0 00 000001 	DOPRMP:	SKIPL	T1		;FIRST?
   247	000061'	334 01 0 00 000064'		 SKIPA	T1,PRMPTM	;YES--LOAD UP MESSAGE
   248	000062'	205 01 0 00 030000 		MOVSI	T1,'#  '	;NO--LOAD UP CONTINUATION
   249	000063'	254 00 0 00 000000*		PJRST	.TSIXN##	;GO TYPE IT
   250
   251	000064'	425157	360000		PRMPTM:	XWD	MY$PFX,'>  '
   252
   253	000065'	425157	626450		CMDLST:	EXP	MY$NAM
   254			000001			N$CMDS==.-CMDLST

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 9
BIORTH	MAC	 3-FEB-77 13:19		SWITCH TABLE

   255					SUBTTL	SWITCH TABLE
   256
   257					DEFINE SWTCHS,<
   258					SP BEGIN,BEGNDT,.DATIM,,FS.NUE!FS.VRQ
   259					SP *BIRTHD,,$BIRTHDAY,,
   260					SP *CHART,,$CHART,,
   261					SP COMPAT,,$COMPAT,,
   262					IFN FT$DDT,<
   263					SP DDT,,$DDT,,
   264					>;END IFN FT$DDT
   265					SP END,ENDATE,.DATIM,,FS.NUE!FS.VRQ
   266					SP *PLOT,,$PLOT,,
   267					>
   268
   269					DOSCAN (VSWT)
   270	000066'	424547	515600			EXP  SIXBIT  /BEGIN/
   271	000067'	124251	626450			EXP  SIXBIT  /*BIRTHD/
   272	000070'	124350	416264			EXP  SIXBIT  /*CHART/
   273	000071'	435755	604164			EXP  SIXBIT  /COMPAT/
   274	000072'	455644	000000			EXP  SIXBIT  /END/
   275	000073'	126054	576400			EXP  SIXBIT  /*PLOT/
   276	000074'	000000	002335'			EXP <BEGNDT>			;BEGIN
   277	000075'	000 00 0 00 000000 		Z			;*BIRTHD
   278	000076'	000 00 0 00 000000 		Z			;*CHART
   279	000077'	000 00 0 00 000000 		Z			;COMPAT
   280	000100'	000000	002336'			EXP <ENDATE>			;END
   281	000101'	000 00 0 00 000000 		Z			;*PLOT
   282	000102'	000000	000512'			XWD	MX.,.DATIM	;BEGIN
   283	000103'	000000	000116'			XWD	MX.,$BIRTHDAY	;*BIRTHD
   284	000104'	000000	000235'			XWD	MX.,$CHART	;*CHART
   285	000105'	000000	000124'			XWD	MX.,$COMPAT	;COMPAT
   286	000106'	000000	000512'			XWD	MX.,.DATIM	;END
   287	000107'	000000	000235'			XWD	MX.,$PLOT	;*PLOT
   288	000110'	140000	000000			XWD	..TEMR,PD.	;BEGIN
   289	000111'	000000	000000			XWD	..TEMR,PD.	;*BIRTHD
   290	000112'	000000	000000			XWD	..TEMR,PD.	;*CHART
   291	000113'	000000	000000			XWD	..TEMR,PD.	;COMPAT
   292	000114'	140000	000000			XWD	..TEMR,PD.	;END
   293	000115'	000000	000000			XWD	..TEMR,PD.	;*PLOT
   294

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 10
BIORTH	MAC	 3-FEB-77 13:19		MISC. COMMANDS

   295					SUBTTL	MISC. COMMANDS
   296
   297	000116'				$BIRTHDAY:
   298	000116'	621 11 0 00 200000 		TLZ	F,FL$HVB	;HAVE NO BIRTHDAY
   299	000117'	323 10 0 00 000240'		JUMPLE	C,E$$NBG	;GUARD AGAINST HALT IN SCAN
   300	000120'	260 17 0 00 000512'		CALL	.DATIM		;READ IT
   301	000121'	512 07 0 00 002334'		HLLZM	N,BIRTHD	;SAVE BIRTHDAY
   302	000122'	661 11 0 00 200000 		TLO	F,FL$HVB	;HAVE A BIRTHDAY
   303	000123'	254 00 0 00 000000*		JRST	.POPJ1##	;SKIP BACK TO AVOID STORE
   304
   305					IFN FT$DDT,<
   306					$DDT:	STRNG$	<DDT
   307					>
   308						AOS	(P)		;SO CAN POPJ FROM DDT
   309						SKIPE	T1,.JBDDT	;GET DDT ADDR
   310						 JRST	(T1)		;AND GO TO IT
   311						WARN.	0,DNL,<DDT NOT LOADED>
   312						POPJ	P,
   313					>;END IFN FT$DDT

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 11
BIORTH	MAC	 3-FEB-77 13:19		COMPUTE COMPATIBILITIES

   314					SUBTTL	COMPUTE COMPATIBILITIES
   315
   316	000124'	260 17 0 00 000000*	$COMPAT:CALL	.SAVE2##	;PRESERVE
   317	000125'	350 00 0 17 000000 		AOS	(P)		;SO SCAN DOESN'T STORE
   318	000126'	260 17 0 00 000000*		CALL	.CLRBF##	;EAT REST
   319	000127'	400 01 0 00 000000 		SETZ	T1,		;DUMMY ARG BLOK FOR QSCAN
   320	000130'	260 17 0 00 000000*		CALL	.QSCAN##	;INIT A LINE
   321	000131'	255 00 0 00 000000 		 JFCL			;WILL PROMPT ANYWHAY
   322	000132'	201 01 0 00 002344'		STRNG$	<BIRTHDATE 1: >
   323	000133'	260 17 0 00 000024*
   324	000134'	260 17 0 00 000512'		CALL	.DATIM
   325	000135'	554 05 0 00 000007 		HLRZ	P1,N		;ONLY WANT THE DATE
   326	000136'	260 17 0 00 000126*		CALL	.CLRBF##	;EAT WHAT MAY BE LEFT
   327	000137'	400 01 0 00 000000 		SETZ	T1,
   328	000140'	260 17 0 00 000130*		CALL	.QSCAN##
   329	000141'	255 00 0 00 000000 		 JFCL
   330	000142'	201 01 0 00 002347'		STRNG$	<BIRTHDATE 2: >
   331	000143'	260 17 0 00 000133*
   332	000144'	260 17 0 00 000512'		CALL	.DATIM
   333	000145'	554 06 0 00 000007 		HLRZ	P2,N		;AND DITTO HERE
   334	000146'	260 17 0 00 000136*		CALL	.CLRBF##	;CLEAR ANY LEFT
   335	000147'	201 01 0 00 000041 		MOVEI	T1,ICYCLE	;COMPUTE THE PERCENTAGES
   336	000150'	260 17 0 00 000204'		CALL	CMPTFN		;...
   337	000151'	202 01 0 00 002217'		MOVEM	T1,IPOS
   338	000152'	201 01 0 00 000034 		MOVEI	T1,ECYCLE
   339	000153'	260 17 0 00 000204'		CALL	CMPTFN
   340	000154'	202 01 0 00 002220'		MOVEM	T1,EPOS
   341	000155'	201 01 0 00 000027 		MOVEI	T1,PCYCLE
   342	000156'	260 17 0 00 000204'		CALL	CMPTFN
   343	000157'	202 01 0 00 002221'		MOVEM	T1,PPOS
   344	000160'	201 01 0 00 002352'		STRNG$	<INTELLECTUAL COMPATIBILITY = >
   345	000161'	260 17 0 00 000143*
   346	000162'	200 01 0 00 002217'		MOVE	T1,IPOS
   347	000163'	260 17 0 00 000231'		CALL	.TPCNT		;TYPE DECIMAL AND PERCENT AND CRLF
   348	000164'	201 01 0 00 002360'		STRNG$	<EMOTIONAL COMPATIBILITY    = >
   349	000165'	260 17 0 00 000161*
   350	000166'	200 01 0 00 002220'		MOVE	T1,EPOS
   351	000167'	260 17 0 00 000231'		CALL	.TPCNT
   352	000170'	201 01 0 00 002366'		STRNG$	<PHYSICAL COMPATIBILITY     = >
   353	000171'	260 17 0 00 000165*
   354	000172'	200 01 0 00 002221'		MOVE	T1,PPOS
   355	000173'	260 17 0 00 000231'		CALL	.TPCNT
   356	000174'	201 01 0 00 002374'		STRNG$	<TOTAL COMPATIBILITY        = >
   357	000175'	260 17 0 00 000171*
   358	000176'	200 01 0 00 002217'		MOVE	T1,IPOS
   359	000177'	270 01 0 00 002220'		ADD	T1,EPOS
   360	000200'	270 01 0 00 002221'		ADD	T1,PPOS
   361	000201'	231 01 0 00 000003 		IDIVI	T1,3		;AVERAGE
   362	000202'	260 17 0 00 000231'		CALL	.TPCNT
   363	000203'	263 17 0 00 000000 		POPJ	P,

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 12
BIORTH	MAC	 3-FEB-77 13:19		COMPUTE THE COMPATIBILITY FUNCTION

   364					SUBTTL	COMPUTE THE COMPATIBILITY FUNCTION
   365
   366					;CALL HERE WITH P1=BIRTHDATE IN RH
   367					;	        P2=BIRTHDATE IN RH
   368					;		T1=CYCLE LENGTH
   369					;
   370					;RETURN WITH T1=COMPATIBILITY PERCENTAGE
   371
   372	000204'	554 02 0 00 002204'	CMPTFN:	HLRZ	T2,NOW		;USE NOW TO COMPUTE DIFF
   373	000205'	274 02 0 00 000005 		SUB	T2,P1		;# DAYS ALIVE
   374	000206'	214 02 0 00 000002 		MOVM	T2,T2		;ALLOW WHATEVER
   375	000207'	231 02 0 01 000000 		IDIVI	T2,(T1)		;GET DAYS INTO CYCLE
   376	000210'	200 02 0 00 000003 		MOVE	T2,T3		;SAVE REMAINDER
   377	000211'	554 03 0 00 002204'		HLRZ	T3,NOW
   378	000212'	274 03 0 00 000006 		SUB	T3,P2
   379	000213'	214 03 0 00 000003 		MOVM	T3,T3
   380	000214'	231 03 0 01 000000 		IDIVI	T3,(T1)		;DAYS INTO CYCLE
   381	000215'	274 02 0 00 000004 		SUB	T2,T4		;DIFF
   382	000216'	214 02 0 00 000002 		MOVM	T2,T2		;GET THE MAGNITUDE
   383	000217'	221 02 0 00 000310 		IMULI	T2,^D200	;* 200
   384	000220'	132 02 0 00 000233 		FLOAT.	T2,		;MAKE IT REAL
   385	000221'	132 01 0 00 000233 		FLOAT.	T1,		;CYCLE ALSO
   386	000222'	174 02 0 00 000001 		FDVR	T2,T1		;200*DIFF/CYCLE LENGTH
   387	000223'	205 01 0 00 207620 		MOVSI	T1,(100.0)	;GET ONE HUNDRED
   388	000224'	154 01 0 00 000002 		FSBR	T1,T2		;100-ABOVE
   389	000225'	335 00 0 00 000001 		SKIPGE	T1		;IF NEGATIVE
   390	000226'	213 00 0 00 000001 		 MOVNS	T1		;MAKE IT POSITIVE
   391	000227'	145 01 0 00 200400 		FADRI	T1,(0.5)	;ROUND IT UP
   392	000230'	254 00 0 00 000000*		PJRST	IFX.1##		;FIX AND RETURN
   393
   394					;.TPCNT -- TYPE DECIMAL # , "%", AND CRLF
   395
   396	000231'	260 17 0 00 000000*	.TPCNT:	CALL	.TDECW##	;TYPE DECIMAL
   397	000232'	201 01 0 00 000045 		MOVEI	T1,"%"		;GET A PERCENT
   398	000233'	260 17 0 00 000000*		CALL	.TCHAR##	;BOOT IT
   399	000234'	254 00 0 00 000027*		PJRST	.TCRLF##	;NEW LINE AND EXIT

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 13
BIORTH	MAC	 3-FEB-77 13:19		PLOT THE CYCLES

   400					SUBTTL	PLOT THE CYCLES
   401
   402	000235'				$PLOT:
   403	000235'				$CHART:
   404	000235'	260 17 0 00 000124*		CALL	.SAVE2##	;SAVE REGISTERS
   405	000236'	350 00 0 17 000000 		AOS	(P)		;SKIP SCAN STORE ON WAY BACK
   406	000237'	607 11 0 00 200000 		TLNN	F,FL$HVB	;MUST HAVE A BIRTHDAY
   407	000240'	260 17 0 00 001532'	E$$NBG:	 ERROR.	EF$FTL,NBG,<NO BIRTHDAY GIVEN>
   408	000241'	300400	002406'
   409	000242'	621 11 0 00 540000 		TLZ	F,FL$FIL!FL$BKW!FL$CRT ;NOT TO FILE,NOT BACKWARDS,AND NOT CRIT.
   410	000243'	323 10 0 00 000301'		JUMPLE	C,PLOT.0	;JUMP IF NO FILE SPEC
   411	000244'	260 17 0 00 000000*		CALL	.FILIN##	;YES--READ IT
   412	000245'	336 00 0 00 777777*		 SKIPN	F.NAM##-1	;NULL DEVICE/
   413	000246'	332 00 0 00 000000*		  SKIPE	F.NAM##		;OR NULL FILENAME?
   414	000247'	334 00 0 00 000000 		   SKIPA		;NO--THERE IS REALLY A SPEC
   415	000250'	254 00 0 00 000301'		  JRST	PLOT.0		;MUST HAVE JUST BEEN SWITCHES
   416	000251'	201 01 0 00 002222'		MOVEI	T1,FILSPC	;GET THE SPEC
   417	000252'	201 02 0 00 000032 		MOVEI	T2,.FXLEN	;AND LENGTH
   418	000253'	260 17 0 00 000000*		CALL	.GTSPC##	;COPY IT OVER
   419	000254'	205 01 0 00 546064 		MOVSI	T1,'LPT'	;FILL IN DEFAULTS
   420	000255'	336 00 0 00 002222'		SKIPN	FILSPC+.FXDEV	;FOR DEVICE
   421	000256'	202 01 0 00 002222'		MOVEM	T1,FILSPC+.FXDEV
   422	000257'	200 01 0 00 002407'		MOVE	T1,[SIXBIT/BIORTH/] ;FOR FILENAME
   423	000260'	336 00 0 00 002223'		SKIPN	FILSPC+.FXNAM
   424	000261'	476 00 0 00 002224'		 SETOM	FILSPC+.FXNMM
   425	000262'	336 00 0 00 002223'		SKIPN	FILSPC+.FXNAM
   426	000263'	202 01 0 00 002223'		 MOVEM	T1,FILSPC+.FXNAM
   427	000264'	525 01 0 00 546064 		HRLOI	T1,'LPT'	;AND EXTENSION
   428	000265'	336 00 0 00 002225'		SKIPN	FILSPC+.FXEXT
   429	000266'	202 01 0 00 002225'		 MOVEM	T1,FILSPC+.FXEXT
   430	000267'	201 01 0 00 002222'		MOVEI	T1,FILSPC	;POINT AT IT
   431	000270'	260 17 0 00 001404'		CALL	OPENIO		;OPEN CHANNEL
   432	000271'	300 01 1 00 002331'		CAI	OUTC,@OBHR(.IOASC) ;
   433	000272'	400 01 0 00 000000 		SETZ	T1,		;DEFAULT # BUFFERS
   434	000273'	200 02 0 00 002410'		MOVE	T2,[XWD OPNBLK,OBHR] 
   435	000274'	260 17 0 00 000000*		CALL	.ALCBF##	;ALLOCATE BUFFERS
   436	000275'	661 11 0 00 400000 		TLO	F,FL$FIL	;FLAG TO A FILE
   437	000276'	201 01 0 00 001471'		MOVEI	T1,CHROUT	;SETUP ROUTINE
   438	000277'	260 17 0 00 000000*		CALL	.TYOCH##	;WITH SCAN
   439						SAVE$	T1		;REMEMBER OLD ONE
   440	000301'	513 00 0 00 002336'	PLOT.0:	HLLZS	ENDATE		;CLEAR SO WE ONLY LOOK AT DAYS, NOT HOURS
   441	000302'	260 17 0 00 001253'		CALL	.GTNOW		;USE TODAY
   442	000303'	336 12 0 00 002335'		SKIPN	D,BEGNDT	;UNLESS /BEGIN WAS GIVEN
   443	000304'	200 12 0 00 000001 		MOVE	D,T1		;POSITION DATE
   444	000305'	513 00 0 00 000012 		HLLZS	D		;ONLY LOOK AT DATE
   445	000306'	205 01 0 00 377776 		MOVSI	T1,377776	;A VERY LARGE DATE
   446	000307'	607 11 0 00 400000 		TLNN	F,FL$FIL	;UNLESS OUTPUTTING TO A FILE
   447	000310'	254 00 0 00 000313'		 JRST	PLOT0B		;NO--GO FOREVER
   448	000311'	510 01 0 00 000012 		HLLZ	T1,D		;THEN START WITH BEGINNING DATE
   449	000312'	270 01 0 00 002411'		ADD	T1,[XWD ^D31,0]	;AND GO FOR A MONTH
   450	000313'	336 00 0 00 002336'	PLOT0B:	SKIPN	ENDATE		;MAKE SURE END SPECIFIED
   451	000314'	202 01 0 00 002336'		 MOVEM	T1,ENDATE	;NO--MAKE IT VERY LARGE
   452	000315'	313 12 0 00 002336'		CAMLE	D,ENDATE	;BEGINNING MUST BE BEFORE END
   453	000316'	661 11 0 00 100000 		 TLO	F,FL$BKW	;OR ELSE WE ARE GOING BACKWARDS IN TIME
   454						STRNG$	<

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 13-1
BIORTH	MAC	 3-FEB-77 13:19		PLOT THE CYCLES

   455	000317'	201 01 0 00 002412'	BIORHYTHM CHART FOR BIRTHDATE: >
   456	000320'	260 17 0 00 000175*
   457	000321'	200 01 0 00 002334'		MOVE	T1,BIRTHD	;GET THE BIRTHDAY
   458	000322'	260 17 0 00 001345'		CALL	.TDATX		;TYPE DAY OF WEEK AND DATE
   459						STRNG$	<
   460					
   461					E - EMOTIONAL CYCLE    -- 28 DAYS
   462					I - INTELLECUTAL CYCLE -- 33 DAYS
   463					P - PHYSICAL CYCLE     -- 23 DAYS
   464					# INDICATES CRITICAL DAY
   465					
   466	000323'	201 01 0 00 002421'	>
   467	000324'	260 17 0 00 000320*
   468						STRNG$	<             LOW                        CRITICAL                        HI
   469					GH
   470	000325'	201 01 0 00 002455'	>
   471	000326'	260 17 0 00 000324*
   472	000327'	260 17 0 00 000234*		CALL	.TCRLF##	;NEW LINES

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 14
BIORTH	MAC	 3-FEB-77 13:19		PLOT THE CYCLES

   473	000330'	200 01 0 00 002400'	PLOT.1:	STORE	T1,PLTBUF,PLTBUF+PLTBSZ-1,<ASCII/     /> ;INIT TO BLANKS
   474	000331'	202 01 0 00 002164'
   475	000332'	200 01 0 00 002475'
   476	000333'	251 01 0 00 002200'
   477	000334'	201 01 0 00 000041 		MOVEI	T1,ICYCLE	;DO I CYCLE
   478	000335'	260 17 0 00 000425'		CALL	COMPOS		;COMPOSE POSITION
   479	000336'	202 01 0 00 002217'		MOVEM	T1,IPOS
   480	000337'	260 17 0 00 000420'		CALL	CRTCHK		;SEE IF CRITICAL
   481	000340'	201 01 0 00 000034 		MOVEI	T1,ECYCLE	;DO E CYCLE
   482	000341'	260 17 0 00 000425'		CALL	COMPOS
   483	000342'	202 01 0 00 002220'		MOVEM	T1,EPOS
   484	000343'	260 17 0 00 000420'		CALL	CRTCHK		;SEE IF CRITICAL
   485	000344'	201 01 0 00 000027 		MOVEI	T1,PCYCLE
   486	000345'	260 17 0 00 000425'		CALL	COMPOS
   487	000346'	202 01 0 00 002221'		MOVEM	T1,PPOS
   488	000347'	260 17 0 00 000420'		CALL	CRTCHK		;SEE IF CRITICAL
   489	000350'	201 01 0 00 000041 		MOVEI	T1,"!"		;SETUP THE BORDERS
   490	000351'	201 02 0 00 000000 		MOVEI	T2,0		;...
   491	000352'	260 17 0 00 000454'		CALL	PUTPLC		;LEFT SIDE
   492	000353'	201 02 0 00 000036 		MOVEI	T2,PLTZER	;THE MIDDLE
   493	000354'	260 17 0 00 000454'		CALL	PUTPLC
   494	000355'	201 02 0 00 000074 		MOVEI	T2,PLTWID	;RIGHT SIDE
   495	000356'	260 17 0 00 000454'		CALL	PUTPLC		;...
   496	000357'	201 01 0 00 000043 		MOVEI	T1,"#"		;IN CASE CRITICAL
   497	000360'	201 02 0 00 000075 		MOVEI	T2,PLTWID+1	;...
   498	000361'	623 11 0 00 040000 		TLZE	F,FL$CRT	;CRITICAL?
   499	000362'	260 17 0 00 000454'		 CALL	PUTPLC		;YES--MARK IN CHART
   500	000363'	205 05 0 00 777775 		MOVSI	P1,-LN$PCH	;GET A LOOPER
   501	000364'	554 01 0 05 000415'	PLOT.2:	HLRZ	T1,PCHTBL(P1)	;GET CHAR TO PLOT
   502	000365'	550 02 0 05 000415'		HRRZ	T2,PCHTBL(P1)	;AND ADDR OF POS
   503	000366'	200 02 0 02 000000 		MOVE	T2,(T2)		;GET POS
   504	000367'	260 17 0 00 000454'		CALL	PUTPLC		;PLOT IT
   505	000370'	253 05 0 00 000364'		AOBJN	P1,PLOT.2	;DO ALL
   506	000371'				PLOT.5:
   507	000371'	200 01 0 00 000012 		MOVE	T1,D		;GET DATE
   508	000372'	260 17 0 00 001345'		CALL	.TDATX		;TYPE DAY AND DATE
   509	000373'	260 17 0 00 000000*		CALL	.TSPAC##	;AND A SPACE
   510	000374'	201 01 0 00 002164'		MOVEI	T1,PLTBUF	;BUFFER ADDR
   511	000375'	260 17 0 00 000326*		CALL	.TSTRG##	;SEND IT
   512	000376'	260 17 0 00 000327*		CALL	.TCRLF##	;NEW LINE
   513	000377'	205 01 0 00 000001 		MOVSI	T1,1		;GET ONE IN LH
   514	000400'	603 11 0 00 100000 		TLNE	F,FL$BKW	;GOING BACKWARDS?
   515						 JRST	[SUB	D,T1	;YES--DO THAT
   516							CAML	D,ENDATE;DONE YET?
   517							JRST	PLOT.1	;NO--CONTINUE
   518	000401'	254 00 0 00 002476'			JRST	PLOT.9]	;YES--GO QUIT
   519	000402'	270 12 0 00 000001 		ADD	D,T1		;NEXT DAY
   520	000403'	317 12 0 00 002336'	PLOT.6:	CAMG	D,ENDATE	;REACHED THE END YET?
   521	000404'	254 00 0 00 000330'		JRST	PLOT.1		;..
   522	000405'	627 11 0 00 400000 	PLOT.9:	TLZN	F,FL$FIL	;YES--OUTPUTTING TO A FILE?
   523	000406'	263 17 0 00 000000 		POPJ	P,		;NO--DONE
   524	000407'	070 01 0 00 000000 		CLOSE	OUTC,		;YES--CLOSE FILE
   525	000410'	071 01 0 00 000000 		RELEASE	OUTC,		;...
   526	000411'	201 01 0 00 002331'		MOVEI	T1,OBHR		;RELEASE BUFFERS
   527	000412'	260 17 0 00 000000*		CALL	.FREBF##

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 14-1
BIORTH	MAC	 3-FEB-77 13:19		PLOT THE CYCLES

   528						RESTR$	T1		;GET SCAN ROUTINE
   529	000414'	254 00 0 00 000277*		PJRST	.TYOCH##	;RESTORE AND RETURN
   530
   531	000415'	000111	002217'		PCHTBL:	XWD	"I",IPOS	;INTELLECTUAL
   532	000416'	000105	002220'			XWD	"E",EPOS	;EMOTIONAL
   533	000417'	000120	002221'			XWD	"P",PPOS	;PHYSICAL
   534			000003			LN$PCH==.-PCHTBL
   535	000420'	275 01 0 00 000036 	CRTCHK:	SUBI	T1,PLTZER	;SEE IF NEAR THE MIDDLE
   536	000421'	217 00 0 00 000001 		MOVMS	T1		;GET ONLY THE MAGNITUDE
   537	000422'	307 01 0 00 000004 		CAIG	T1,MX$CRT	;CAN IT BE CRITICAL?
   538	000423'	661 11 0 00 040000 		 TLO	F,FL$CRT	;YES--FLAG FOR PRINTER
   539	000424'	263 17 0 00 000000 		POPJ	P,		;DONE

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 15
BIORTH	MAC	 3-FEB-77 13:19		PLOT THE CYCLES

   540	000425'	132 01 0 00 000233 	COMPOS:	FLOAT.	T1,		;FLOAT CYCLE LENGTH
   541	000426'	200 02 0 00 000041'		MOVE	T2,TWOPI	;GET 2*PI
   542	000427'	174 02 0 00 000001 		FDVR	T2,T1		;2*PI/CYCLE LENGTH
   543	000430'	202 02 0 00 002216'		MOVEM	T2,TEMP		;SAVE IT
   544	000431'	554 01 0 00 000012 		HLRZ	T1,D		;GET DAY WE ARE WORKING ON
   545	000432'	554 02 0 00 002334'		HLRZ	T2,BIRTHD	;AND BIRTHDAY
   546	000433'	275 01 0 02 000000 		SUBI	T1,(T2)		;DIFFERENCE 
   547	000434'	260 17 0 00 000000*		PUSHJ	P,FLT.1##	;FLOAT IT
   548	000435'	166 01 0 00 002216'		FMPRM	T1,TEMP		;* ABOVE RESULT AND SAVE IT
   549	000436'	201 16 0 00 002503'		MOVEI	16,1+[EXP <-1,,0>,TEMP] ;ARG BLOCK
   550	000437'	260 17 0 00 000000*		CALL	SIN.##		;GET THE SINE
   551	000440'	202 00 0 00 002216'		MOVEM	X,TEMP		;SAVE IT
   552	000441'	205 01 0 00 201400 		MOVSI	T1,(1.0)	;ADD ONE TO IT
   553	000442'	146 01 0 00 002216'		FADRM	T1,TEMP		;...
   554	000443'	201 01 0 00 000074 		MOVEI	T1,PLTWID	;GET PLOT WIDTH
   555	000444'	132 01 0 00 000233 		FLOAT.	T1,		;MAKE IT REAL
   556	000445'	166 01 0 00 002216'		FMPRM	T1,TEMP
   557	000446'	205 01 0 00 202400 		MOVSI	T1,(2.0)	;GET A TWO
   558	000447'	250 01 0 00 002216'		EXCH	T1,TEMP		;POSITION
   559	000450'	176 01 0 00 002216'		FDVRM	T1,TEMP		;DIVIDE BY TWO
   560	000451'	205 01 0 00 200400 		MOVSI	T1,(0.5)	;GET 1/2
   561	000452'	147 01 0 00 002216'		FADRB	T1,TEMP		;ADD THAT IN ALSO
   562	000453'	254 00 0 00 000230*		PJRST	IFX.1##		;FIX AND RETURN
   563
   564					;PUTPLC -- PUT CHAR IN PLOT BUFFER
   565					;CALL:	MOVEI	T1,CHAR
   566					;	MOVEI	T2,POS
   567					;	CALL	PUTPLC
   568					;USES T1-4
   569
   570	000454'	231 02 0 00 000005 	PUTPLC:	IDIVI	T2,5		;T2=WORD, T3=POS IN WORD
   571	000455'	205 04 0 00 440700 		MOVSI	T4,(POINT 7)	;START TO FORM BYTE PTR
   572	000456'	541 04 0 02 002164'		HRRI	T4,PLTBUF(T2)	;FINISH IT
   573	000457'	133 00 0 00 000004 		IBP	T4		;INC ONE
   574	000460'	365 03 0 00 000457'		SOJGE	T3,.-1		;DO ALL
   575	000461'	137 01 0 00 000004 		DPB	T1,T4		;STORE CHAR
   576	000462'	263 17 0 00 000000 		POPJ	P,

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 16
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   577					SUBTTL	SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME
   578
   579					;.DATIF -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN FUTURE
   580					;.DATIG -- DITTO (CHARACTER ALREADY IN C)
   581					;CALL:	PUSHJ	P,.DATIF/.DATIG
   582					;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
   583					;USES T1-4	UPDATES C (SEPARATOR)
   584
   585	000463'	260 17 0 00 000000*	.DATIF:	PUSHJ	P,.TIAUC##	;PRIME THE PUMP
   586
   587	000464'	402 00 0 00 002203'	.DATIG:	SETZM	FLFUTR		;CLEAR FUTURE RELATIVE
   588	000465'	402 00 0 00 002202'		SETZM	FLFUTD		;SET DEFAULT
   589	000466'	350 00 0 00 002202'		AOS	FLFUTD		;  TO FUTURE
   590	000467'	302 10 0 00 000053 		CAIE	C,"+"		;SEE IF FUTURE RELATIVE
   591	000470'	254 00 0 00 000473'		JRST	DATIF1		;NO--JUST GET DATE-TIME
   592	000471'	350 00 0 00 002203'		AOS	FLFUTR		;YES--SET FUTURE REL FLAG
   593	000472'	260 17 0 00 000463*		PUSHJ	P,.TIAUC##	;GET ANOTHER CHARACTER
   594	000473'	260 17 0 00 000525'	DATIF1:	PUSHJ	P,DATIM		;GET DATE/TIME
   595	000474'	315 07 0 00 002204'		CAMGE	N,NOW		;SEE IF IN FUTURE
   596	000475'	254 00 0 00 001117'		JRST	E$$NFT		;NO--NOT FUTURE ERROR
   597	000476'	263 17 0 00 000000 		POPJ	P,		;RETURN
   598
   599					;.DATIP -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN THE PAST
   600					;.DATIQ -- DITTO (CHARACTER ALREADY IN C)
   601					;CALL:	PUSHJ	P,.DATIP/.DATIQ
   602					;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
   603					;USES T1-4	UPDATES C (SEPARATOR)
   604
   605	000477'	260 17 0 00 000472*	.DATIP:	PUSHJ	P,.TIAUC##	;PRIME THE PUMP
   606
   607	000500'	402 00 0 00 002203'	.DATIQ:	SETZM	FLFUTR		;CLEAR PAST RELATIVE
   608	000501'	476 00 0 00 002202'		SETOM	FLFUTD		;SET DEFAULT TO PAST
   609	000502'	302 10 0 00 000055 		CAIE	C,"-"		;SEE IF PAST RELATIVE
   610	000503'	254 00 0 00 000506'		JRST	DATIP1		;NO--JUST GET DATE-TIME
   611	000504'	370 00 0 00 002203'		SOS	FLFUTR		;YES--SET PAST REL FLAG
   612	000505'	260 17 0 00 000477*		PUSHJ	P,.TIAUC##	;GET ANOTHER CHARACTER
   613	000506'	260 17 0 00 000525'	DATIP1:	PUSHJ	P,DATIM		;GET DATE/TIME
   614	000507'	313 07 0 00 002204'		CAMLE	N,NOW		;SEE IF IN PAST
   615	000510'	254 00 0 00 001121'		JRST	E$$NPS		;NO--NOT PAST ERROR
   616	000511'	263 17 0 00 000000 		POPJ	P,		;RETURN

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 17
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   617					;.DATIM -- ROUTINE TO SCAN DATE AND TIME ARGUMENT
   618					;.DATIC -- DITTO (CHARACTER ALREADY IN C)
   619					;CALL:	PUSHJ	P,.DATIM/.DATIC
   620					;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
   621					;USES T1-4	UPDATES C (SEPARATOR)
   622
   623	000512'	260 17 0 00 000505*	.DATIM:	PUSHJ	P,.TIAUC##	;PRIME THE PUMP
   624
   625	000513'	402 00 0 00 002203'	.DATIC:	SETZM	FLFUTR		;CLEAR RELATIVE FLAG
   626	000514'	402 00 0 00 002202'		SETZM	FLFUTD		;CLEAR DEFAULT FLAG
   627	000515'	302 10 0 00 000053 		CAIE	C,"+"		;SEE IF FUTURE RELATIVE
   628	000516'	254 00 0 00 000521'		JRST	DATIC1		;NO--PROCEED
   629	000517'	350 00 0 00 002203'		AOS	FLFUTR		;YES--SET FLAG
   630	000520'	254 00 0 00 000524'		JRST	DATIC2		;AND PROCEED
   631	000521'	302 10 0 00 000055 	DATIC1:	CAIE	C,"-"		;SEE IF PAST RELATIVE
   632	000522'	254 00 0 00 000525'		PJRST	DATIM		;NO--JUST GET ABS DATE
   633	000523'	370 00 0 00 002203'		SOS	FLFUTR		;YES--SET FLAG
   634	000524'	260 17 0 00 000512*	DATIC2:	PUSHJ	P,.TIAUC##	;GET NEXT CHAR
   635									;AND FALL INTO DATE/TIME GETTER
   636
   637					;DATIM -- ROUTINE TO INPUT DATE/TIME
   638					;CALL:	SET FLFUTR TO -1 IF PAST RELATIVE, 0 IF ABSOLUTE, +1 IF FUTURE RELATIVE
   639					;	SIMILARLY FOR FLFUTD TO INDICATE DEFAULT DIRECTION IF FLFUTR=0
   640					;	GET NEXT CHARACTER IN C
   641					;	PUSHJ	P,DATIM
   642					;RETURN WITH TRUE DATE/TIME IN N IN INTERNAL SPECIAL FORMAT
   643					;	SETS NOW TO CURRENT DATE/TIME
   644					;USES T1-4, UPDATES C
   645					;
   646					;TYPE-IN FORMATS:
   647					;	(THE LEADING +- IS HANDLED BY CALLER)
   648					;
   649					;	[ [  DAY IN WEEK	    ]		     ]
   650					;	[ [     NNND		    ]		     ]
   651					;	[ [ [   MM-DD  [-Y   ] ]  : ] [HH[:MM[:SS]]] ]
   652					;	[ [ [  MMM-DD  [-YY  ] ]    ]		     ]
   653					;	[ [ [  DD-MMM  [-YYYY] ]    ]		     ]
   654					;	[	       MNEMONIC			     ]
   655					;WHERE:
   656					;	D	LETTER D
   657					;	DD	DAY IN MONTH (1-31)
   658					;	HH	HOURS (00-23)
   659					;	MM	MONTH IN YEAR (1-12)
   660					;	    OR	MINUTES (00-59)
   661					;	MMM	MNEMONIC MONTH OR ABBREV.
   662					;	SS	SECONDS (0-59)
   663					;	Y	LAST DIGIT OF THIS DECADE
   664					;	YY	LAST TWO DIGITS OF THIS CENTURY
   665					;	YYYY	YEAR
   666					;	DAY IN WEEK IS MNEMONIC OR ABBREVIATION
   667					;	MNEMONIC IS A SET OF PREDEFINED TIMES

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 18
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   668									;DESCRIBED ABOVE
   669									;FALL HERE FROM .DATIC
   670
   671	000525'	332 01 0 00 002203'	DATIM:	SKIPE	T1,FLFUTR	;SEE IF FORCED DIRECTION
   672	000526'	202 01 0 00 002202'		MOVEM	T1,FLFUTD	; YES--THAT IMPLIES DEFAULT
   673	000527'	476 00 0 00 002205'		SETOM	VAL1		;CLEAR RESULT WORDS
   674	000530'	200 01 0 00 002504'		MOVE	T1,[VAL1,,VAL2]
   675	000531'	251 01 0 00 002215'		BLT	T1,VAL9		; ..
   676	000532'	260 17 0 00 001253'		PUSHJ	P,.GTNOW	;GET CURRENT DATE/TIME
   677	000533'	202 01 0 00 002204'		MOVEM	T1,NOW		;SAVE FOR LATER TO BE CONSISTENT
   678	000534'	301 10 0 00 000060 		CAIL	C,"0"		;SEE IF DIGIT
   679	000535'	303 10 0 00 000071 		CAILE	C,"9"		; ..
   680	000536'	254 00 0 00 000540'		JRST	.+2		;NO--MNEMONIC FOR SOMETHING
   681	000537'	254 00 0 00 000637'		JRST	DATIMD		;YES--GO GET DECIMAL
   682					;HERE IF STARTING WITH ALPHA, MIGHT BE DAY, MONTH, OR MNEMONIC
   683	000540'	260 17 0 00 000000*		PUSHJ	P,.SIXSC##	;GET SIXBIT WORD
   684	000541'	322 07 0 00 001143'		JUMPE	N,E$$DTM		;ILLEGAL SEPARATOR IF ABSENT
   685	000542'	200 01 0 00 001201'		MOVE	T1,MNDPTR	;POINT TO FULL TABLE
   686	000543'	260 17 0 00 000000*		PUSHJ	P,.NAME##	;LOOKUP IN TABLE
   687	000544'	254 00 0 00 001137'		  JRST	E$$UDN		;ERROR IF NOT KNOWN
   688	000545'	201 07 0 01 000000 		MOVEI	N,(T1)		;GET
   689	000546'	275 07 0 00 001145'		SUBI	N,DAYS		;  DAY INDEX
   690	000547'	301 07 0 00 000007 		CAIL	N,7		;SEE IF DAY OF WEEK
   691	000550'	254 00 0 00 000575'		JRST	DATIMM		;NO--LOOK ON
   692					;HERE WHEN DAY OF WEEK RECOGNIZED
   693	000551'	336 01 0 00 002202'		SKIPN	T1,FLFUTD	;GET DEFAULT DIRECTION
   694	000552'	254 00 0 00 001125'		JRST	E$$NPF		;ERROR IF NONE
   695	000553'	202 01 0 00 002203'		MOVEM	T1,FLFUTR	;SET AS FORCED DIRECTION
   696	000554'	554 02 0 00 002204'		HLRZ	T2,NOW		;GET DAYS
   697	000555'	231 02 0 00 000007 		IDIVI	T2,7		;GET DAY OF WEEK
   698	000556'	274 07 0 00 000003 		SUB	N,T3		;GET FUTURE DAYS FROM NOW
   699	000557'	335 00 0 00 000007 		SKIPGE	N		;IF NEGATIVE,
   700	000560'	271 07 0 00 000007 		ADDI	N,7		;  MAKE LATER THIS WEEK
   701	000561'	510 01 0 00 002204'		HLLZ	T1,NOW		;CLEAR CURRENT
   702	000562'	331 00 0 00 002202'		SKIPL	FLFUTD		;SEE IF FUTURE
   703	000563'	664 01 0 00 777777 		TROA	T1,-1		;YES--SET MIDNIGHT MINUS EPSILON
   704	000564'	275 07 0 00 000007 		SUBI	N,7		;NO--MAKE PAST
   705	000565'	514 07 0 00 000007 		HRLZ	N,N		;POSITION TO LEFT HALF
   706	000566'	270 07 0 00 000001 		ADD	N,T1		;MODIFY CURRENT DATE/TIME
   707	000567'	261 17 0 00 000007 	DATIMW:	PUSH	P,N		;SAVE DATE
   708	000570'	260 17 0 00 001055'		PUSHJ	P,DATIC		;GO CHECK TIME
   709	000571'	550 07 0 17 000000 		  HRRZ	N,(P)		;NO--USE VALUE IN DATE
   710	000572'	262 17 0 00 000001 		POP	P,T1		;RESTORE DATE
   711	000573'	500 07 0 00 000001 		HLL	N,T1		;  TO ANSWER
   712	000574'	254 00 0 00 001024'		JRST	DATIMX		;CHECK ANSWER AND RETURN

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 19
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   713					;HERE IF MONTH OR MNEMONIC
   714	000575'	201 07 0 01 000000 	DATIMM:	MOVEI	N,(T1)		;GET MONTH
   715	000576'	275 07 0 00 001153'		SUBI	N,MONTHS-1	;  AS 1-12
   716	000577'	303 07 0 00 000014 		CAILE	N,^D12		;SEE IF MONTH
   717	000600'	254 00 0 00 000612'		JRST	DATIMN		;NO--MUST BE MNEMONIC
   718	000601'	202 07 0 00 002212'		MOVEM	N,VAL6		;YES--STORE MONTH
   719	000602'	302 10 0 00 000055 		CAIE	C,"-"		;MUST BE DAY NEXT
   720	000603'	254 00 0 00 001141'		JRST	E$$MDD		;NO--ERROR
   721	000604'	260 17 0 00 000000*		PUSHJ	P,.DECNW##	;YES--GET IT
   722	000605'	323 07 0 00 001123'		JUMPLE	N,E$$NND	;ERROR IF NEGATIVE
   723	000606'	303 07 0 00 000037 		CAILE	N,^D31		;VERIFY IN RANGE
   724	000607'	254 00 0 00 001127'		JRST	E$$DFL		;ERROR IF TOO LARGE
   725	000610'	202 07 0 00 002211'		MOVEM	N,VAL5		;SAVE AWAY
   726	000611'	254 00 0 00 000717'		JRST	DATIY0		;AND GET YEAR IF PRESENT
   727
   728					;HERE IF MNEMONIC
   729	000612'	550 02 0 00 000001 	DATIMN:	HRRZ	T2,T1		;GET COPY
   730	000613'	306 02 0 00 001173'		CAIN	T2,SPLGTM	;SEE IF "LOGIN"
   731	000614'	337 07 0 00 001633'		SKIPG	N,LOGTIM	;AND WE KNOW IT
   732	000615'	334 00 0 00 000000 		SKIPA			;NO--PROCEED
   733	000616'	254 00 0 00 001024'		JRST	DATIMX		;YES--GO GIVE ANSWER
   734	000617'	306 02 0 00 001174'		CAIN	T2,SPNOON	;SEE IF "NOON"
   735						JRST	[HLLZ N,NOW	;YES--GET TODAY
   736							 HRRI N,1B18	;SET TO NOON
   737	000620'	254 00 0 00 002505'			 JRST DATIMW]	;GO FINISH UP
   738	000621'	306 02 0 00 001175'		CAIN	T2,SPMIDN	;SEE IF "MIDNIGHT"
   739						JRST	[HLLZ N,NOW	;GET TODAY
   740	000622'	254 00 0 00 002510'			 JRST DATIMO]	;GO SET TO MIDNIGHT
   741	000623'	275 02 0 00 001170'		SUBI	T2,SPCDAY	;SUBTRACT OFFSET TO SPECIAL DAYS
   742	000624'	303 02 0 00 000002 		CAILE	T2,2		;SEE IF ONE OF THREE
   743	000625'	254 00 0 00 000634'		JRST	E.MDS		;NO--UNSUPPORTED
   744	000626'	554 07 0 00 002204'		HLRZ	N,NOW		;YES--GET TODAY
   745	000627'	271 07 0 02 777777 		ADDI	N,-1(T2)	;OFFSET IT
   746	000630'	517 00 0 00 000007 		HRLZS	N		;POSITION FOR ANSWER
   747	000631'	331 00 0 00 002202'	DATIMO:	SKIPL	FLFUTD		;SEE IF FUTURE
   748	000632'	660 07 0 00 777777 		TRO	N,-1		;YES--SET TO MIDNIGHT MINUS EPSILON
   749	000633'	254 00 0 00 000567'		JRST	DATIMW		;AND GO FINISH UP
   750					;HERE IF UNSUPPORTED MNEMONIC
   751	000634'	200 01 0 01 000000 	E.MDS:	MOVE	T1,(T1)		;GET NAME OF SWITCH
   752	000635'	260 17 0 00 001532'		ERROR.	EF$FTL!EF$SIX,MDS,<MNEMONIC DATE/TIME SWITCH NOT IMPLEMENTED>
   753	000636'	300403	002523'

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 20
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   754					;HERE IF STARTING WITH DECIMAL NUMBER
   755	000637'	260 17 0 00 000000*	DATIMD:	PUSHJ	P,.DECNC##	;YES--GO GET FULL NUMBER
   756	000640'	321 07 0 00 001123'		JUMPL	N,E$$NND	;ILLEGAL IF NEGATIVE
   757	000641'	302 10 0 00 000104 		CAIE	C,"D"		;SEE IF DAYS
   758	000642'	254 00 0 00 000656'		JRST	DATIN		;NO--MUST BE -
   759	000643'	200 01 0 00 002202'		MOVE	T1,FLFUTD	;YES--RELATIVE SO GET FORCING FUNCTION
   760	000644'	202 01 0 00 002203'		MOVEM	T1,FLFUTR	; AND FORCE IT
   761	000645'	322 01 0 00 001125'		JUMPE	T1,E$$NPF	;ERROR IF DIRECTION UNCLEAR
   762	000646'	301 07 0 00 400000 		CAIL	N,1B18		;VERIFY NOT HUGE
   763	000647'	254 00 0 00 001127'		JRST	E$$DFL		;ERROR--TOO LARGE
   764	000650'	202 07 0 00 002211'		MOVEM	N,VAL5		;SAVE RELATIVE DATE
   765	000651'	260 17 0 00 000524*		PUSHJ	P,.TIAUC##	;GET NEXT CHARACTER (SKIP D)
   766	000652'	260 17 0 00 001055'		PUSHJ	P,DATIC		;GO CHECK FOR TIME
   767	000653'	201 07 0 00 000000 		  MOVEI	N,0		;0 IF NONE
   768	000654'	504 07 0 00 002211'		HRL	N,VAL5		;INCLUDE DAYS IN LH
   769	000655'	254 00 0 00 000704'		JRST	DATITR		;GO DO RELATIVE RETURN
   770					;HERE WHEN DIGITS SEEN WITHOUT A FOLLOWING D
   771	000656'	302 10 0 00 000055 	DATIN:	CAIE	C,"-"		;SEE IF DAY/MONTH COMBO
   772	000657'	254 00 0 00 000700'		JRST	DATIT		;NO--MUST BE INTO TIME
   773	000660'	303 07 0 00 000037 		CAILE	N,^D31		;MUST BE LESS THAN 31
   774	000661'	254 00 0 00 001127'		JRST	E$$DFL		;NO--ERROR
   775	000662'	322 07 0 00 001131'		JUMPE	N,E$$DFZ	;VERIFY NOT ZERO
   776	000663'	202 07 0 00 002211'		MOVEM	N,VAL5		;SAVE VALUE
   777	000664'	260 17 0 00 000651*		PUSHJ	P,.TIAUC##	;SKIP OVER MINUS
   778	000665'	301 10 0 00 000060 		CAIL	C,"0"		;SEE IF DIGIT NEXT
   779	000666'	303 10 0 00 000071 		CAILE	C,"9"		; ..
   780	000667'	254 00 0 00 000710'		JRST	DATMMM		;NO-- MUST BE MNEMONIC MONTH
   781	000670'	260 17 0 00 000637*		PUSHJ	P,.DECNC##	;YES-- MUST BE MM-DD FORMAT
   782	000671'	323 07 0 00 001123'		JUMPLE	N,E$$NND	;BAD IF LE 0
   783	000672'	303 07 0 00 000037 		CAILE	N,^D31		;VERIFY LE 31
   784	000673'	254 00 0 00 001127'		JRST	E$$DFL		;BAD
   785	000674'	250 07 0 00 002211'		EXCH	N,VAL5		;SWITCH VALUES
   786	000675'	303 07 0 00 000014 		CAILE	N,^D12		;VERIFY MONTH OK
   787	000676'	254 00 0 00 001127'		JRST	E$$DFL		;BAD
   788	000677'	254 00 0 00 000716'		JRST	DATMM1		;GO STORE MONTH
   789					;HERE WHEN TIME SEEN BY ITSELF
   790	000700'	260 17 0 00 001060'	DATIT:	PUSHJ	P,DATIG		;GET REST OF TIME
   791	000701'	254 04 0 00 000701'		  HALT	.		;CAN NOT GET HERE
   792	000702'	336 00 0 00 002203'		SKIPN	FLFUTR		;SEE IF RELATIVE
   793	000703'	254 00 0 00 000761'		JRST	DATIRN		;NO--GO HANDLE AS ABS.
   794					;HERE WITH DISTANCE IN N
   795	000704'	335 00 0 00 002203'	DATITR:	SKIPGE	FLFUTR		;IF PAST,
   796	000705'	210 07 0 00 000007 		MOVN	N,N		;  COMPLEMENT DISTANCE
   797	000706'	270 07 0 00 002204'		ADD	N,NOW		;ADD TO CURRENT DATE/TIME
   798	000707'	254 00 0 00 001024'		JRST	DATIMX		;CHECK ANSWER AND RETURN

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 21
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   799					;HERE WHEN DD- SEEN AND MNEMONIC MONTH COMING
   800	000710'	260 17 0 00 000540*	DATMMM:	PUSHJ	P,.SIXSC##	;GET MNEMONIC
   801	000711'	200 01 0 00 001200'		MOVE	T1,MONPTR	;GET POINTER TO  MONTH TABLE
   802	000712'	260 17 0 00 000543*		PUSHJ	P,.NAME##	;LOOKUP IN TABLE
   803	000713'	254 00 0 00 001133'		  JRST	E$$UDM		;NO GOOD
   804	000714'	201 07 0 01 000000 		MOVEI	N,(T1)		;GET MONTH
   805	000715'	275 07 0 00 001153'		SUBI	N,MONTHS-1	;  AS 1-12
   806					;HERE WITH MONTH INDEX (1-12) IN T1
   807	000716'	202 07 0 00 002212'	DATMM1:	MOVEM	N,VAL6		;SAVE FOR LATER
   808	000717'	302 10 0 00 000055 	DATIY0:	CAIE	C,"-"		;SEE IF YEAR NEXT
   809	000720'	254 00 0 00 000747'		JRST	DATIRA		;NO--GO HANDLE TIME
   810					;HERE WHEN YEAR NEXT AS ONE, TWO, OR FOUR DIGITS
   811	000721'	403 07 0 00 000001 		SETZB	N,T1		;CLEAR DIGIT AND RESULT COUNTERS
   812	000722'	260 17 0 00 000664*	DATIY:	PUSHJ	P,.TIAUC##	;GET NEXT DIGIT
   813	000723'	301 10 0 00 000060 		CAIL	C,"0"		;SEE IF NUMERIC
   814	000724'	303 10 0 00 000071 		CAILE	C,"9"		; ..
   815	000725'	254 00 0 00 000731'		JRST	DATIY1		;NO--MUST BE DONE
   816	000726'	221 07 0 00 000012 		IMULI	N,^D10		;ADVANCE RESULT
   817	000727'	271 07 0 10 777720 		ADDI	N,-"0"(C)	;INCLUDE THIS DIGIT
   818	000730'	344 01 0 00 000722'		AOJA	T1,DATIY	;LOOP FOR MORE, COUNTING DIGIT
   819	000731'	322 01 0 00 001135'	DATIY1:	JUMPE	T1,E$$ILR	;ERROR IF NO DIGITS
   820	000732'	302 01 0 00 000003 		CAIE	T1,3		;ERROR IF 3 DIGITS
   821	000733'	303 01 0 00 000004 		CAILE	T1,4		;OK IF 1,2, OR 4
   822	000734'	254 00 0 00 001135'		JRST	E$$ILR		;ERROR IF GT 4 DIGITS
   823	000735'	200 02 0 00 000007 		MOVE	T2,N		;GET RESULT
   824	000736'	231 02 0 00 000144 		IDIVI	T2,^D100	;SEP. CENTURY
   825	000737'	231 03 0 00 000012 		IDIVI	T3,^D10		;SEP. DECADE
   826	000740'	307 01 0 00 000002 		CAIG	T1,2		;IF ONE OR TWO DIGITS,
   827	000741'	476 00 0 00 000002 		SETOM	T2		;  FLAG NO CENTURY KNOWN
   828	000742'	306 01 0 00 000001 		CAIN	T1,1		;IF ONE DIGIT,
   829	000743'	476 00 0 00 000003 		SETOM	T3		;  FLAG NO DECADE KNOWN
   830	000744'	202 04 0 00 002213'		MOVEM	T4,VAL7		;SAVE UNITS
   831	000745'	202 03 0 00 002214'		MOVEM	T3,VAL8		;SAVE DECADE
   832	000746'	202 02 0 00 002215'		MOVEM	T2,VAL9		;SAVE CENTURY

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 22
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   833					;HERE WITH VAL5-9 CONTAINING DAY, MONTH, YEAR, DECADE, CENTURY
   834	000747'	370 00 0 00 002211'	DATIRA:	SOS	VAL5		;MAKE DAYS 0-30
   835	000750'	370 00 0 00 002212'		SOS	VAL6		;MAKE MONTHS 0-11
   836	000751'	260 17 0 00 001055'		PUSHJ	P,DATIC		;GET TIME IF PRESENT
   837	000752'	337 00 0 00 002202'		  SKIPG	FLFUTD		;IGNORE ABSENCE
   838	000753'	254 00 0 00 000761'		JRST	DATIRN		; UNLESS FUTURE
   839					;HERE IF FUTURE WITHOUT TIME
   840	000754'	201 01 0 00 000073 		MOVEI	T1,^D59		;SET TO
   841	000755'	202 01 0 00 002206'		MOVEM	T1,VAL2		; 23:59:59
   842	000756'	202 01 0 00 002207'		MOVEM	T1,VAL3		; ..
   843	000757'	201 01 0 00 000027 		MOVEI	T1,^D23		; ..
   844	000760'	202 01 0 00 002210'		MOVEM	T1,VAL4		; ..
   845					;HERE WITH VAL2-9 CONTAINING PARSE OR -1 IF TO BE FILLED IN
   846					;	STRATEGY IS TO FILL-IN HOLES LESS SIGNIFICANT THAN
   847					;	MOST SIGN. FIELD WITH 0; AND TO FILL IN MORE SIGNIFICANT
   848					;	HOLES WITH CURRENT VALUE.  THEN IF WRONG DIRECTION FROM
   849					;	NOW, ADD/SUB ONE TO FIELD JUST ABOVE MOST SIGNIFICANT DIFFERENT
   850					;	(FIELD CARRY NOT NEEDED SINCE IT WILL HAPPEN IMPLICITLY).
   851	000761'	260 17 0 00 000000*	DATIRN:	PUSHJ	P,.TICAN##	;MAKE SURE NEXT CHAR IS SEPARATOR
   852	000762'	334 00 0 00 000000 		  SKIPA			;YES--OK
   853	000763'	254 00 0 00 000000*		JRST	E.ILSC##	;NO--FLAG ERROR BEFORE DEFAULTING
   854	000764'	200 01 0 00 002204'		MOVE	T1,NOW		;GET CURRENT DATE/TIME
   855	000765'	260 17 0 00 001202'		PUSHJ	P,.CNTDT	;CONVERT TO EASY FORMAT
   856	000766'	200 03 0 00 000001 		MOVE	T3,T1		;SAVE MSTIME
   857	000767'	231 03 0 00 001750 		IDIVI	T3,^D1000	; AS SECONDS
   858	000770'	270 02 0 00 002524'		ADD	T2,[^D1900*^D12*^D31]  ;MAKE REAL
   859	000771'	201 04 0 00 000010 		MOVEI	T4,8		;TRY 8 FIELDS
   860	000772'	200 01 0 00 000002 	DATIRB:	MOVE	T1,T2		;POSITION REMAINDER
   861						IDIV	T1,[1
   862							    ^D60
   863							    ^D60*^D60
   864							    1
   865							    ^D31
   866							    ^D31*^D12
   867							    ^D31*^D12*^D10
   868	000773'	230 01 0 04 002524'			    ^D31*^D12*^D10*^D10]-1(T4)  ;SPLIT THIS FIELD FROM REST 
   869	000774'	331 00 0 04 002205'		SKIPL	VAL1(T4)	;SEE IF DEFAULT
   870						JRST	[TLNN T3,-1	;NO--FLAG TO ZERO DEFAULTS
   871							 HRL  T3,T4	; SAVING INDEX OF LAST DEFAULT
   872	000775'	254 00 0 00 002535'			 JRST DATRIC]	;AND CONTINUE LOOP
   873	000776'	402 00 0 04 002205'		SETZM	VAL1(T4)	;DEFAULT TO
   874	000777'	607 03 0 00 777777 		TLNN	T3,-1		;SEE IF NEED CURRENT
   875	001000'	202 01 0 04 002205'		MOVEM	T1,VAL1(T4)	;YES--SET THAT INSTEAD
   876	001001'	312 01 0 04 002205'	DATRIC:	CAME	T1,VAL1(T4)	;SEE IF SAME AS CURRENT
   877	001002'	254 00 0 00 001006'		JRST	DATIRD		;NO--REMEMBER FOR LATER
   878	001003'	306 04 0 00 000004 		CAIN	T4,4		;SEE IF TIME FOR TIME
   879	001004'	550 02 0 00 000003 		HRRZ	T2,T3		;YES--GET IT
   880	001005'	367 04 0 00 000772'		SOJG	T4,DATIRB	;LOOP UNTIL ALL DONE

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 23
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   881					;HERE WHEN FILLED IN CURRENT FOR SIGNIFICANT DEFAULTS
   882	001006'	335 00 0 04 002205'	DATIRD:	SKIPGE	VAL1(T4)	;SEE IF DEFAULT
   883	001007'	402 00 0 04 002205'		SETZM	VAL1(T4)	;CLEAR DEFAULT
   884	001010'	367 04 0 00 001006'		SOJG	T4,DATIRD	;LOOP UNTIL DONE
   885	001011'	554 07 0 00 000003 		HLRZ	N,T3		;RECOVER LAST SIGN. DEFAULT-1
   886	001012'	322 07 0 00 001022'		JUMPE	N,DATIRR	;DONE IF NONE
   887	001013'	260 17 0 00 001034'		PUSHJ	P,DATIRM	;MAKE CURRENT DATE, TIME
   888	001014'	200 04 0 00 002202'		MOVE	T4,FLFUTD	;GET DEFAULT DIRECTION
   889						XCT	[CAMGE	T1,NOW
   890							 JFCL
   891	001015'	256 00 0 04 002541'			 CAMLE	T1,NOW]+1(T4)  ;SEE IF OK
   892	001016'	254 00 0 00 001022'		JRST	DATIRR		;YES--GO RETURN
   893	001017'	337 00 0 00 002202'		SKIPG	FLFUTD		;NO--SEE WHICH DIRECTION
   894	001020'	374 00 0 07 002206'		SOSA	VAL2(N)		;PAST
   895	001021'	350 00 0 07 002206'		AOS	VAL2(N)		;FUTURE
   896	001022'	260 17 0 00 001034'	DATIRR:	PUSHJ	P,DATIRM	;REMAKE ANSWER
   897	001023'	200 07 0 00 000001 		MOVE	N,T1		;MOVE TO ANSWER
   898					;HERE WITH FINAL RESULT, CHECK FOR OK
   899						RADIX	10
   900	001024'	201 01 0 00 001336'	DATIMX:	MOVEI	T1,.TDTTM	;SET DATE-TIME
   901	001025'	202 01 0 00 000000*		MOVEM	T1,.LASWD##	; OUTPUTER
   902	001026'	315 07 0 00 002543'		CAMGE	N,[<1900-1859>*365+<1900-1859>/4+<31-18>+31,,0]
   903	001027'	254 00 0 00 001032'		JRST	E$$DOR		;OUT OF RANGE
   904	001030'	202 07 0 00 000000*		MOVEM	N,.NMUL##	;STORE IN .NMUL
   905	001031'	263 17 0 00 000000 		POPJ	P,		;**RETURN
   906						RADIX	8
   907	001032'	260 17 0 00 001532'		M$FAIL	(DOR,Date/time out of range)
   908	001033'	300400	002551'
   909
   910					;SUBROUTINE TO MAKE DATE/TIME
   911	001034'	200 01 0 00 002210'	DATIRM:	MOVE	T1,VAL4		;GET HOURS
   912	001035'	221 01 0 00 000074 		IMULI	T1,^D60		;MAKE INTO MINS
   913	001036'	270 01 0 00 002207'		ADD	T1,VAL3		;ADD MINS
   914	001037'	221 01 0 00 000074 		IMULI	T1,^D60		;MAKE INTO SECS
   915	001040'	270 01 0 00 002206'		ADD	T1,VAL2		;ADD SECS
   916	001041'	221 01 0 00 001750 		IMULI	T1,^D1000	;MAKE INTO MILLISECS
   917	001042'	200 02 0 00 002215'		MOVE	T2,VAL9		;GET CENTURIES
   918	001043'	221 02 0 00 000012 		IMULI	T2,^D10		;MAKE INTO DECADES
   919	001044'	270 02 0 00 002214'		ADD	T2,VAL8		;ADD DECADES
   920	001045'	221 02 0 00 000012 		IMULI	T2,^D10		;MAKE INTO YEARS
   921	001046'	270 02 0 00 002213'		ADD	T2,VAL7		;ADD YEARS
   922	001047'	221 02 0 00 000014 		IMULI	T2,^D12		;MAKE INTO MONTHS
   923	001050'	270 02 0 00 002212'		ADD	T2,VAL6		;ADD MONTHS
   924	001051'	221 02 0 00 000037 		IMULI	T2,^D31		;MAKE INTO DAYS
   925	001052'	270 02 0 00 002211'		ADD	T2,VAL5		;ADD DAYS
   926	001053'	274 02 0 00 002524'		SUB	T2,[^D1900*^D12*^D31]  ;REDUCE TO SYSTEM RANGE
   927	001054'	254 00 0 00 001260'		PJRST	.CNVDT		;CONVERT TO INTERNAL FORM AND RETURN

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 24
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   928					;SUBROUTINE TO GET TIME IF SPECIFIED
   929					;RETURNS CPOPJ IF NO TIME, SKIP RETURN IF TIME
   930					;  WITH TIME IN RH(N) AS FRACTION OF DAY
   931					;USES T1-4, N
   932
   933	001055'	302 10 0 00 000072 	DATIC:	CAIE	C,":"		;SEE IF TIME NEXT
   934	001056'	263 17 0 00 000000 		POPJ	P,		;NO--MISSING TIME
   935	001057'	260 17 0 00 000604*		PUSHJ	P,.DECNW##	;GET DECIMAL NUMBER FOR TIME
   936					;HERE WITH FIRST TIME FIELD IN N
   937	001060'	321 07 0 00 001123'	DATIG:	JUMPL	N,E$$NND	;ERROR IF NEGATIVE
   938	001061'	301 07 0 00 000030 		CAIL	N,^D24		; AND GE 24,
   939	001062'	254 00 0 00 001127'		JRST	E$$DFL		;GIVE ERROR--TOO LARGE
   940	001063'	202 07 0 00 002210'		MOVEM	N,VAL4		;SAVE HOURS
   941	001064'	302 10 0 00 000072 		CAIE	C,":"		;SEE IF MINUTES COMING
   942	001065'	254 00 0 00 001102'		JRST	DATID		;NO--DONE
   943	001066'	260 17 0 00 001057*		PUSHJ	P,.DECNW##	;YES--GET IT
   944	001067'	301 07 0 00 000074 		CAIL	N,^D60		;SEE IF IN RANGE
   945	001070'	254 00 0 00 001127'		JRST	E$$DFL		;NO--GIVE ERROR
   946	001071'	321 07 0 00 001123'		JUMPL	N,E$$NND	;ERROR IF NEG
   947	001072'	202 07 0 00 002207'		MOVEM	N,VAL3		;SAVE MINUTES
   948	001073'	302 10 0 00 000072 		CAIE	C,":"		;SEE IF SEC. COMING
   949	001074'	254 00 0 00 001102'		JRST	DATID		;NO--DONE
   950	001075'	260 17 0 00 001066*		PUSHJ	P,.DECNW##	;GET SECONDS
   951	001076'	301 07 0 00 000074 		CAIL	N,^D60		;CHECK RANGE
   952	001077'	254 00 0 00 001127'		JRST	E$$DFL		;NO--GIVE ERROR
   953	001100'	321 07 0 00 001123'		JUMPL	N,E$$NND	;ERROR IF NEG
   954	001101'	202 07 0 00 002206'		MOVEM	N,VAL2		;SAVE SECONDS
   955					;HERE WITH TIME IN VAL2-4
   956	001102'	335 01 0 00 002210'	DATID:	SKIPGE	T1,VAL4		;GET HOURS
   957	001103'	201 01 0 00 000000 		MOVEI	T1,0		;  UNLESS ABSENT
   958	001104'	221 01 0 00 000074 		IMULI	T1,^D60		;CONV TO MINS
   959	001105'	331 00 0 00 002207'		SKIPL	VAL3		;IF MINS PRESENT,
   960	001106'	270 01 0 00 002207'		ADD	T1,VAL3		;  ADD MINUTES
   961	001107'	221 01 0 00 000074 		IMULI	T1,^D60		;CONV TO SECS
   962	001110'	331 00 0 00 002206'		SKIPL	VAL2		;IF SECS PRESENT,
   963	001111'	270 01 0 00 002206'		ADD	T1,VAL2		;  ADD SECONDS
   964	001112'	201 02 0 00 000000 		MOVEI	T2,0		;CLEAR OTHER HALF
   965	001113'	244 01 0 00 777757 		ASHC	T1,-^D17	;MULT BY 2**18
   966	001114'	235 01 0 00 250600 		DIVI	T1,^D24*^D3600	;DIVIDE BY SECONDS/DAY
   967	001115'	200 07 0 00 000001 		MOVE	N,T1		;RESULT IS FRACTION OF DAY IN RH
   968	001116'	254 00 0 00 000123*		JRST	.POPJ1##	;RETURN

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 25
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

   969					;DATE/TIME ERRORS
   970
   971	001117'	260 17 0 00 001532'		M$FAIL	(NFT,Date/time must be in the future)
   972	001120'	300400	002561'
   973	001121'	260 17 0 00 001532'		M$FAIL	(NPS,Date/time must be in the past)
   974	001122'	300400	002570'
   975	001123'	260 17 0 00 001532'		M$FAIL	(NND,Negative number in date/time)
   976	001124'	300400	002577'
   977	001125'	260 17 0 00 001532'		M$FAIL	(NPF,Not known whether past or future in date/time)
   978	001126'	300400	002612'
   979	001127'	260 17 0 00 001532'		M$FAIL	(DFL,Field too large in date/time)
   980	001130'	300400	002621'
   981	001131'	260 17 0 00 001532'		M$FAIL	(DFZ,Field zero in date/time)
   982	001132'	300400	002627'
   983	001133'	260 17 0 00 001532'		M$FAIL	(UDM,Unrecognized month in date/time)
   984	001134'	300400	002637'
   985	001135'	260 17 0 00 001532'		M$FAIL	(ILR,Illegal year format in date/time)
   986	001136'	300400	002647'
   987	001137'	260 17 0 00 001532'		M$FAIL	(UDN,Unrecognized name in date/time)
   988	001140'	300400	002657'
   989	001141'	260 17 0 00 001532'		M$FAIL	(MDD,Missing day in date/time)
   990	001142'	300400	002665'
   991	001143'	260 17 0 00 001532'		M$FAIL	(DTM,Value missing in date/time)
   992	001144'	300400	002674'
   993
   994
   995					;MNEMONIC WORDS IN DATE/TIME SCAN
   996
   997						DEFINE	XX($1),<
   998						EXP	<SIXBIT	/$1/>>
   999
  1000	001145'	674544	564563		DAYS:	XX	WEDNESDAY
  1001	001146'	645065	626344			XX	THURSDAY
  1002	001147'	466251	444171			XX	FRIDAY
  1003	001150'	634164	656244			XX	SATURDAY
  1004	001151'	636556	444171			XX	SUNDAY
  1005	001152'	555756	444171			XX	MONDAY
  1006	001153'	646545	634441			XX	TUESDAY
  1007
  1008	001154'	524156	654162		MONTHS:	XX	JANUARY
  1009	001155'	464542	626541			XX	FEBRUARY
  1010	001156'	554162	435000			XX	MARCH
  1011	001157'	416062	515400			XX	APRIL 
  1012	001160'	554171	000000			XX	MAY
  1013	001161'	526556	450000			XX	JUNE
  1014	001162'	526554	710000			XX	JULY
  1015	001163'	416547	656364			XX	AUGUST
  1016	001164'	634560	644555			XX	SEPTEMBER
  1017	001165'	574364	574245			XX	OCTOBER
  1018	001166'	565766	455542			XX	NOVEMBER
  1019	001167'	444543	455542			XX	DECEMBER
  1020
  1021	001170'	714563	644562		SPCDAY:	XX	YESTERDAY
  1022	001171'	645744	417100			XX	TODAY
  1023	001172'	645755	576262			XX	TOMORROW

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 25-1
BIORTH	MAC	 3-FEB-77 13:19		SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

  1024
  1025	001173'	545747	515600		SPLGTM:	XX	LOGIN
  1026	001174'	565757	560000		SPNOON:	XX	NOON
  1027	001175'	555144	565147		SPMIDN:	XX	MIDNIGHT
  1028
  1029	001176'	546556	435000		SPDATM:	XX	LUNCH
  1030	001177'	445156	564562			XX	DINNER
  1031			000033		LSPDTM==.-DAYS
  1032
  1033					;POINTERS
  1034
  1035	001200'	777764	001153'		MONPTR:	IOWD	^D12,MONTHS
  1036	001201'	777745	001144'		MNDPTR:	IOWD	LSPDTM,DAYS

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 26
BIORTH	MAC	 3-FEB-77 13:19		ROUTINES TO COVERT DATE/TIME FORMATS

  1037					SUBTTL	ROUTINES TO COVERT DATE/TIME FORMATS
  1038
  1039					;.CNTDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
  1040					;CALL:	MOVE	T1,DATE/TIME
  1041					;	PUSHJ	P,.CNTDT
  1042					;	RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
  1043					;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
  1044					;USES T1-4
  1045
  1046	001202'	261 17 0 00 000001 	.CNTDT:	PUSH	P,T1		;SAVE TIME FOR LATER
  1047	001203'	321 01 0 00 001245'		JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
  1048	001204'	554 01 0 00 000001 		HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)
  1049
  1050						RADIX	10		;**** NOTE WELL ****
  1051
  1052						ADDI	T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+3
  1053	001205'	271 01 0 00 377230 	0+31+30+31+31+30+31+17
  1054									;T1=DAYS SINCE JAN 1, 1501
  1055	001206'	231 01 0 00 435261 		IDIVI	T1,400*365+400/4-400/100+400/400
  1056									;SPLIT INTO QUADRACENTURY
  1057	001207'	242 02 0 00 000002 		LSH	T2,2		;CONVERT TO NUMBER OF QUARTER DAYS
  1058	001210'	231 02 0 00 435261 		IDIVI	T2,<100*365+100/4-100/100>*4+400/400
  1059									;SPLIT INTO CENTURY
  1060	001211'	435 03 0 00 000003 		IORI	T3,3		;DISCARD FRACTIONS OF DAY
  1061	001212'	231 03 0 00 002665 		IDIVI	T3,4*365+1	;SEPARATE INTO YEARS
  1062	001213'	242 04 0 00 777776 		LSH	T4,-2		;T4=NO DAYS THIS YEAR		[311]
  1063	001214'	242 01 0 00 000002 		LSH	T1,2		;T1=4*NO QUADRACENTURIES	[311]
  1064	001215'	270 01 0 00 000002 		ADD	T1,T2		;T1=NO CENTURIES		[311]
  1065	001216'	221 01 0 00 000144 		IMULI	T1,100		;T1=100*NO CENTURIES		[311]
  1066	001217'	271 01 0 03 002735 		ADDI	T1,1501(T3)	;T1 HAS YEAR, T4 HAS DAY IN YEAR	[311]
  1067
  1068	001220'	200 02 0 00 000001 		MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
  1069	001221'	602 02 0 00 000003 		TRNE	T2,3		;IS THE YEAR A MULT OF 4?	[311]
  1070	001222'	254 00 0 00 001227'		JRST	CNTDT0		;NO--JUST INDICATE NOT A LEAP YEAR  [311]
  1071	001223'	231 02 0 00 000144 		IDIVI	T2,100		;SEE IF YEAR IS MULT OF 100	[311]
  1072	001224'	336 00 0 00 000003 		SKIPN	T3		;IF NOT, THEN LEAP		[311]
  1073	001225'	606 02 0 00 000003 		TRNN	T2,3		;IS YEAR MULT OF 400?		[311]
  1074	001226'	634 03 0 00 000003 		TDZA	T3,T3		;YES--LEAP YEAR AFTER ALL	[311]
  1075	001227'	201 03 0 00 000001 	CNTDT0:	MOVEI	T3,1		;SET LEAP YEAR FLAG		[311]
  1076									;T3 IS 0 IF LEAP YEAR

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 27
BIORTH	MAC	 3-FEB-77 13:19		ROUTINES TO COVERT DATE/TIME FORMATS

  1077						;UNDER RADIX 10 **** NOTE WELL ****
  1078
  1079	001230'	275 01 0 00 003554 	CNTDT1:	SUBI	T1,1900		;SET TO SYSTEM ORIGIN
  1080	001231'	221 01 0 00 000564 		IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
  1081	001232'	326 03 0 00 001236'		JUMPN	T3,CNTDT2	;IF NOT LEAP YEAR, PROCEED
  1082	001233'	305 04 0 00 000074 		CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
  1083	001234'	254 00 0 00 001244'		JRST	CNTDT5		;NO--JUST INCLUDE IN ANSWER
  1084	001235'	370 00 0 00 000004 		SOS	T4		;YES--BACK OFF ONE DAY
  1085	001236'	205 02 0 00 777765 	CNTDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS
  1086
  1087	001237'	315 04 0 02 001322'	CNTDT3:	CAMGE	T4,MONTAB+1(T2)	;SEE IF BEYOND THIS MONTH
  1088	001240'	254 00 0 00 001243'		JRST	CNTDT4		;YES--GO FINISH UP
  1089	001241'	271 01 0 00 000037 		ADDI	T1,31		;NO--COUNT SYSTEM MONTH
  1090	001242'	253 02 0 00 001237'		AOBJN	T2,CNTDT3	;LOOP THROUGH NOVEMBER
  1091
  1092	001243'	274 04 0 02 001321'	CNTDT4:	SUB	T4,MONTAB(T2)	;GET DAYS IN THIS MONTH
  1093	001244'	270 01 0 00 000004 	CNTDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT
  1094
  1095	001245'	250 01 0 17 000000 	CNTDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
  1096	001246'	621 01 0 00 777777 		TLZ	T1,-1		;CLEAR DATE
  1097	001247'	224 01 0 00 002675'		MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
  1098	001250'	244 01 0 00 000021 		ASHC	T1,17		;POSITION RESULT
  1099	001251'	262 17 0 00 000002 		POP	P,T2		;RECOVER DATE
  1100	001252'	263 17 0 00 000000 		POPJ	P,		;RETURN
  1101
  1102					;.GTNOW -- COMPUTE CURRENT TIME IN SPECIAL FORMAT
  1103					;CALL:	PUSHJ	P,.GTNOW
  1104					;RETURNS WITH RESULT IN T1
  1105					;USES T2, T3, T4
  1106
  1107	001253'	200 01 0 00 002676'	.GTNOW:	MOVX	T1,%CNDTM	;ASK MONITOR			[310]
  1108	001254'	047 01 0 00 000041 		GETTAB	T1,		; FOR ANSWER			[310]
  1109	001255'	260 17 0 00 001532'		ERROR.	EF$FTL,CGN,<CAN'T GET 'NOW' FROM MONITOR>
  1110	001256'	300400	002705'
  1111	001257'	254 00 0 00 001320'		JRST	GETNWX		;GO GIVE RESULT

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 28
BIORTH	MAC	 3-FEB-77 13:19		ROUTINES TO COVERT DATE/TIME FORMATS

  1112						;UNDER RADIX 10 **** NOTE WELL ****
  1113
  1114									;FALL HERE FROM .GTNOW
  1115
  1116					;.CNVDT -- CONVERT ARBITRARY DATE TO SPECIAL FORMAT
  1117					;CALL:	MOVE	T1,TIME IN MILLISEC.
  1118					;	MOVE	T2,DATE IN SYSTEM FORMAT (Y*12+M)*31+DAY  SINCE 1/1/64
  1119					;	PUSHJ	P,.CNVDT
  1120					;RETURNS WITH RESULT IN T1 (.GT.0; OR -1 IF BEYOND SEPT. 27,2217)
  1121					;	NOTE THAT IN SPECIAL FORMAT, THE LEFT HALF DIVIDED
  1122					;	  BY 7 GIVES THE DAY OF THE WEEK (0=WED.)
  1123					;USES T2, T3, T4
  1124
  1125	001260'	260 17 0 00 000000*	.CNVDT:	PUSHJ	P,.SAVE1##	;PRESERVE P1
  1126	001261'	261 17 0 00 000001 		PUSH	P,T1		;SAVE TIME FOR LATER
  1127	001262'	231 02 0 00 000564 		IDIVI	T2,12*31	;T2=YEARS-1900
  1128	001263'	303 02 0 00 000475 		CAILE	T2,2217-1900	;SEE IF BEYOND 2217
  1129	001264'	254 00 0 00 001312'		JRST	GETNW2		;YES--RETURN -1
  1130	001265'	231 03 0 00 000037 		IDIVI	T3,31		;T3=MONTHS-JAN, T4=DAYS-1
  1131	001266'	270 04 0 03 001321'		ADD	T4,MONTAB(T3)	;T4=DAYS-JAN 1
  1132	001267'	201 05 0 00 000000 		MOVEI	P1,0		;LEAP YEAR ADDITIVE IF JAN, FEB
  1133	001270'	301 03 0 00 000002 		CAIL	T3,2		;CHECK MONTH
  1134	001271'	201 05 0 00 000001 		MOVEI	P1,1		;ADDITIVE IF MAR-DEC
  1135	001272'	200 01 0 00 000002 		MOVE	T1,T2		;SAVE YEARS FOR REUSE
  1136	001273'	271 02 0 00 000003 		ADDI	T2,3		;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
  1137	001274'	231 02 0 00 000004 		IDIVI	T2,4		;HANDLE REGULAR LEAP YEARS
  1138	001275'	302 03 0 00 000003 		CAIE	T3,3		;SEE IF THIS IS LEAP YEAR
  1139	001276'	201 05 0 00 000000 		MOVEI	P1,0		;NO--WIPE OUT ADDITIVE
  1140	001277'	271 04 0 02 035253 		ADDI	T4,<1900-1859>*365+<1900-1859>/4+<31-18>+31(T2)
  1141									;T4=DAYS BEFORE JAN 1,1900 +SINCE JAN 1
  1142									; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
  1143	001300'	200 02 0 00 000001 		MOVE	T2,T1		;RESTORE YEARS SINCE 1900
  1144	001301'	221 02 0 00 000555 		IMULI	T2,365		;DAYS SINCE 1900
  1145	001302'	270 04 0 00 000002 		ADD	T4,T2		;T4=DAYS EXCEPT FOR 100 YR. FUDGE
  1146	001303'	571 02 0 01 777633 		HRREI	T2,-100-1(T1)	;T2=YEARS SINCE 2001
  1147	001304'	323 02 0 00 001310'		JUMPLE	T2,GETNW1	;ALL DONE IF NOT YET 2001
  1148	001305'	231 02 0 00 000144 		IDIVI	T2,100		;GET CENTURIES SINCE 2001
  1149	001306'	274 04 0 00 000002 		SUB	T4,T2		;ALLOW FOR LOST LEAP YEARS
  1150	001307'	302 03 0 00 000143 		CAIE	T3,99		;SEE IF THIS IS A LOST L.Y.
  1151	001310'	270 04 0 00 000005 	GETNW1:	ADD	T4,P1		;ALLOW FOR LEAP YEAR THIS YEAR
  1152	001311'	303 04 0 00 377777 		CAILE	T4,^O377777	;SEE IF TOO BIG
  1153	001312'	476 00 0 00 000004 	GETNW2:	SETOM	T4		;YES--SET -1
  1154
  1155	001313'	262 17 0 00 000001 		POP	P,T1		;GET MILLISEC TIME
  1156	001314'	201 02 0 00 000000 		MOVEI	T2,0		;CLEAR OTHER HALF
  1157	001315'	244 01 0 00 777757 		ASHC	T1,-17		;POSITION
  1158	001316'	234 01 0 00 002675'		DIV	T1,[24*60*60*1000]  ;CONVERT TO 1/2**18 DAYS
  1159	001317'	504 01 0 00 000004 		HRL	T1,T4		;INCLUDE DATE
  1160	001320'	263 17 0 00 000000 	GETNWX:	POPJ	P,		;RETURN

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 29
BIORTH	MAC	 3-FEB-77 13:19		ROUTINES TO COVERT DATE/TIME FORMATS

  1161						;UNDER RADIX 10 **** NOTE WELL ****
  1162
  1163	001321'	000000	000000		MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365
  1164	001322'	000000	000037
  1165	001323'	000000	000073
  1166	001324'	000000	000132
  1167	001325'	000000	000170
  1168	001326'	000000	000227
  1169	001327'	000000	000265
  1170	001330'	000000	000324
  1171	001331'	000000	000363
  1172	001332'	000000	000421
  1173	001333'	000000	000460
  1174	001334'	000000	000516
  1175	001335'	000000	000555
  1176						RADIX	8

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 30
BIORTH	MAC	 3-FEB-77 13:19		DATE/TIME OUTPUT

  1177					SUBTTL	DATE/TIME OUTPUT
  1178
  1179					;.TDTTM -- TYPE DATE AND TIME IN UNIVERSAL FORMAT
  1180					;CALL:	MOVE	T1,DATE/TIME IN UNIVERSAL FORMAT
  1181					;	CALL	.TDTTM
  1182					;USES T1-4
  1183
  1184	001336'	260 17 0 00 001202'	.TDTTM:	PUSHJ	P,.CNTDT	;DISASSEMBLE
  1185						SAVE$	T1		;SAVE TIME
  1186	001340'	200 01 0 00 000002 		MOVE	T1,T2		;POSITION DATE
  1187	001341'	260 17 0 00 001355'		PUSHJ	P,.TDATE	;TYPE DATE
  1188	001342'	260 17 0 00 000000*		PUSHJ	P,.TCOLN##	;AND A COLON
  1189						RESTR$	T1		;GET TIME
  1190	001344'	254 00 0 00 000000*		PJRST	.TTIME##	;TYPE IT AND RETURN
  1191
  1192					;.TDATX -- TYPE DAY AND DATE IN UNIVERSAL FORMAT
  1193					;CALL:	MOVE	T1,DATE/TIME IN UNIVERSAL FORMAT
  1194					;	CALL	.TDATX
  1195					;USES T1-4
  1196
  1197	001345'	261 17 0 00 000001 	.TDATX:	PUSH	P,T1		;REMEMBER UNIVERSAL DATE/TIME
  1198	001346'	557 00 0 00 000001 		HLRZS	T1		;POSITION DATE TO RIGHT HALF
  1199	001347'	231 01 0 00 000007 		IDIVI	T1,7		;FIGURE DAY OF WEEK
  1200	001350'	201 01 0 02 001375'		MOVEI	T1,DAYOFW(T2)	;GET STRING ADDRESS
  1201	001351'	260 17 0 00 000375*		CALL	.TSTRG##	;SEND DAY STRING
  1202	001352'	262 17 0 00 000001 		POP	P,T1		;GET DATE BACK
  1203	001353'	260 17 0 00 001202'		CALL	.CNTDT		;DISSASSEMBLE
  1204	001354'	200 01 0 00 000002 		MOVE	T1,T2		;POSITION DATE
  1205					;	PJRST	.TDATE		;TYPE AND RETURN
  1206
  1207					;.TDATE -- TYPE DATE IN STANDARD FORMAT OF DD-MMM-YY
  1208					;CALL:	MOVEI	T1,DATE IN SYSTEM FORMAT FROM DATE UUO
  1209					;	PUSHJ	P,.TDATE
  1210					;USES T1-4
  1211
  1212	001355'	260 17 0 00 001260*	.TDATE:	PUSHJ	P,.SAVE1##	;SAVE P1
  1213	001356'	231 01 0 00 000037 		IDIVI	T1,^D31		;GET DAYS
  1214	001357'	200 04 0 00 000001 		MOVE	T4,T1		;SAVE REST
  1215	001360'	201 01 0 02 000001 		MOVEI	T1,1(T2)	;GET DAYS AS 1-31
  1216	001361'	201 02 0 00 000040 		MOVEI	T2," "		;FILL WITH SPACE
  1217	001362'	260 17 0 00 000000*		PUSHJ	P,.TDEC2##	;TYPE IN DECIMAL
  1218	001363'	231 04 0 00 000014 		IDIVI	T4,^D12		;GET MONTHS
  1219						MOVEI	T1,[ASCIZ /-Jan/
  1220							    ASCIZ /-Feb/
  1221							    ASCIZ /-Mar/
  1222							    ASCIZ /-Apr/
  1223							    ASCIZ /-May/
  1224							    ASCIZ /-Jun/
  1225							    ASCIZ /-Jul/
  1226							    ASCIZ /-Aug/
  1227							    ASCIZ /-Sep/
  1228							    ASCIZ /-Oct/
  1229							    ASCIZ /-Nov/
  1230	001364'	201 01 0 05 002706'			    ASCIZ /-Dec/](P1)	;GET ASCII
  1231	001365'	260 17 0 00 001351*		PUSHJ	P,.TSTRG##	;TYPE IT

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 30-1
BIORTH	MAC	 3-FEB-77 13:19		DATE/TIME OUTPUT

  1232	001366'	201 01 0 04 000000 		MOVEI	T1,(T4)		;GET YEAR SINCE 1900
  1233	001367'	231 01 0 00 000144 		IDIVI	T1,^D100	;GET JUST YEARS IN CENTURY
  1234	001370'	201 01 0 00 000055 		MOVEI	T1,"-"		;GET A SIGN
  1235	001371'	260 17 0 00 000233*		CALL	.TCHAR##	;SEND IT
  1236	001372'	200 01 0 00 000002 		MOVE	T1,T2		;POSITION YEARS
  1237	001373'	201 02 0 00 000060 		MOVEI	T2,"0"		;FILL WITH A ZERO
  1238	001374'	254 00 0 00 001362*		PJRST	.TDEC2##	;TYPE AND RETURN
  1239
  1240	001375'	127 105 104 040 000 	DAYOFW:	ASCII	/WED /
  1241	001376'	124 110 125 040 000 		ASCII	/THU /
  1242	001377'	106 122 111 040 000 		ASCII	/FRI /
  1243	001400'	123 101 124 040 000 		ASCII	/SAT /
  1244	001401'	123 125 116 040 000 		ASCII	/SUN /
  1245	001402'	115 117 116 040 000 		ASCII	/MON /
  1246	001403'	124 125 105 040 000 		ASCII	/TUE /

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 31
BIORTH	MAC	 3-FEB-77 13:19		OPEN I/O CHANNELS

  1247					SUBTTL	OPEN I/O CHANNELS
  1248					;OPENIO
  1249					;CALL:	MOVEI	T1,<FDB ADDR>
  1250					;	CALL	OPENIO
  1251					;	CAI	CHANNEL,BUFADR	;@ IF OUTPUT, (MODE)
  1252					;	*ALL IS WELL*
  1253
  1254	001404'	504 01 0 17 000000 	OPENIO:	HRL	T1,0(P)		;REMEMBER CALLER
  1255	001405'	350 00 0 17 000000 		AOS	0(P)		;SKIP ARGS ON RETURN
  1256	001406'	260 17 0 00 000000*		CALL	.SAVE3##	;PRESERVE REGISTERS
  1257	001407'	204 05 0 00 000001 		MOVS	P1,T1		;COPY ARGUMENTS
  1258	001410'	200 06 0 05 000000 		MOVE	P2,(P1)		;GET REST OF THEM
  1259	001411'	205 01 0 00 000032 		MOVSI	T1,.FXLEN	;SETUP FOR .STOPB
  1260	001412'	544 01 0 00 000005 		HLR	T1,P1		;...
  1261	001413'	201 02 0 00 002254'		MOVEI	T2,OPNBLK	;
  1262	001414'	200 03 0 00 002722'		MOVE	T3,[XWD .RBTIM+1,LKPBLK] ;
  1263	001415'	201 04 0 00 002314'		MOVEI	T4,PTHBLK
  1264	001416'	260 17 0 00 000000*		CALL	.STOPB##	;CONVERT TO OPEN/LOOKUP BLOCKS
  1265	001417'	254 00 0 00 001455'		 JRST	WLDERR		;NO WILDCARDING!
  1266	001420'	201 01 0 00 000035 		MOVEI	T1,.RBTIM	;SETUP COUNT
  1267	001421'	202 01 0 00 002257'		MOVEM	T1,LKPBLK+.RBCNT
  1268	001422'	135 01 0 00 002723'		LDB	T1,[POINT 4,P2,17] ;GET MODE
  1269	001423'	202 01 0 00 002254'		MOVEM	T1,OPNBLK	;STORE IN OPEN BLOCK
  1270	001424'	550 01 0 00 000006 		HRRZ	T1,P2		;BUFFER HEADER ADDRESS
  1271	001425'	603 06 0 00 000020 		TLNE	P2,ATSIGN	;READ OR WRITE?
  1272	001426'	207 00 0 00 000001 		MOVSS	T1		;WRITING, POSITON FOR IT
  1273	001427'	202 01 0 00 002256'		MOVEM	T1,OPNBLK+.OPBUF;STORE
  1274	001430'	135 07 0 00 002724'		LDB	P3,[POINT 4,P2,12] ;GET I/O CHANNEL
  1275	001431'	242 07 0 00 000005 		LSH	P3,5		;POSITION
  1276	001432'	207 00 0 00 000007 		MOVSS	P3		;IN CHANNEL POSITION
  1277	001433'	200 01 0 00 002725'		MOVE	T1,[OPEN OPNBLK];FORM INSTR
  1278	001434'	434 01 0 00 000007 		OR	T1,P3		;FINISH
  1279	001435'	256 00 0 00 000001 		XCT	T1		;TRY TO OPEN DEVICE
  1280	001436'	254 00 0 00 001452'		 JRST	OPENER		;CAN'T--BOMB OUT
  1281	001437'	200 01 0 00 000007 		MOVE	T1,P3		;REGET I/O CHANNEL
  1282	001440'	603 06 0 00 000020 		TLNE	P2,ATSIGN	;READ/WRITE?
  1283	001441'	665 01 0 00 077000 		 TLOA	T1,(ENTER)	;WRITE
  1284	001442'	661 01 0 00 076000 		  TLO	T1,(LOOKUP)	;READ
  1285	001443'	541 01 0 00 002257'		HRRI	T1,LKPBLK	;COMPLETE INSTR
  1286	001444'	256 00 0 00 000001 		XCT	T1		;FIND/WRITE THE FILE
  1287	001445'	254 00 0 00 001460'		 JRST	LKENER		;OOPS
  1288	001446'	263 17 0 00 000000 		POPJ	P,		;OK--RETURN
  1289	001447'	350 00 0 17 000000 	$POPJ2:	AOS	(P)		;SKIP 2
  1290	001450'	350 00 0 17 000000 	$POPJ1:	AOS	(P)		;SKIP 1
  1291	001451'	263 17 0 00 000000 	$POPJ:	POPJ	P,		;SKIP 0
  1292

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 32
BIORTH	MAC	 3-FEB-77 13:19		OPEN I/O CHANNELS

  1293					;OPENIO ERRORS
  1294
  1295	001452'	554 01 0 00 000005 	OPENER:	HLRZ	T1,P1		;COPY FDB ADDR
  1296	001453'	260 17 0 00 001532'		ERROR.	EF$FTL!EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >
  1297	001454'	300406	002733'
  1298
  1299	001455'	554 01 0 00 000005 	WLDERR:	HLRZ	T1,P1		;GET FDB
  1300	001456'	260 17 0 00 001532'		ERROR.	EF$FTL!EF$FIL,WFI,<WILDCARD FILESPEC ILLEGAL, FILE >
  1301	001457'	300406	002743'
  1302
  1303	001460'	550 01 0 00 002262'	LKENER:	HRRZ	T1,LKPBLK+.RBEXT;GET FAIL CODE
  1304	001461'	260 17 0 00 001532'		ERROR.	EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
  1305	001462'	300042	002750'
  1306	001463'	201 01 0 00 002751'		STRNG$	<) FILE >
  1307	001464'	260 17 0 00 001365*
  1308	001465'	554 01 0 00 000005 		HLRZ	T1,P1
  1309	001466'	260 17 0 00 000000*		CALL	.TFBLK##	;TYPE SCAN BLOCK
  1310	001467'	260 17 0 00 000376*		CALL	.TCRLF##	;NEW LINE
  1311	001470'	254 00 0 00 001613'		JRST	ERRFTL		;GO DIE
  1312
  1313					;CALL HERE WITH CHAR IN T1 TO OUTPUT
  1314
  1315	001471'	377 00 0 00 002333'	CHROUT:	SOSG	OBHR+.BFCTR	;ROOM?
  1316	001472'	254 00 0 00 001475'		 JRST	CHRO.1		;NO
  1317	001473'	136 01 0 00 002332'	CHRO.0:	IDPB	T1,OBHR+.BFPTR	;YES--STORE IT
  1318	001474'	263 17 0 00 000000 		POPJ	P,
  1319
  1320	001475'	260 17 0 00 001501'	CHRO.1:	CALL	XCTIO		;DO IT
  1321	001476'	057 01 0 00 000000 		 OUT	OUTC,		;XCT'D
  1322	001477'	254 04 0 00 001500'		  HALT	.+1		;SNH
  1323	001500'	254 00 0 00 001473'		JRST	CHRO.0		;STORE CHAR

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 33
BIORTH	MAC	 3-FEB-77 13:19		XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING

  1324					SUBTTL	XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING
  1325
  1326					;XCTIO
  1327					;CALL:	CALL	XCTIO
  1328					;	<INSTR TO XCT>	;IN/OUT UUO
  1329					;	*EOF/EOT RETURN*
  1330					;	*NORMAL RETURN*
  1331
  1332	001501'	256 00 1 17 000000 	XCTIO:	XCT	@0(P)		;DO THE INSTR
  1333	001502'	254 00 0 00 001447'		 JRST	$POPJ2		;OK--SKIP 2 AND RETURN
  1334						SAVE$	T1		;OOPS--SAVE T1
  1335	001504'	200 01 1 17 777777 		MOVE	T1,@-1(P)	;GET INSTR WE FAILED ON
  1336	001505'	350 00 0 17 777777 		AOS	-1(P)		;SKIP INSTR ON WAY BACK
  1337	001506'	404 01 0 00 002753'		AND	T1,[17B12]	;ERROR--GET THE CHANNEL
  1338	001507'	434 01 0 00 002754'		OR	T1,[GETSTS T2]	;GET ERRROR BITS
  1339	001510'	256 00 0 00 000001 		XCT	T1
  1340	001511'	602 02 0 00 022000 		TRNE	T2,IO.EOF!IO.EOT;END OF SOMETHING?
  1341	001512'	254 00 0 00 001530'		JRST	TPOPJ		;YES
  1342	001513'	250 01 0 00 000002 		EXCH	T1,T2		;NO--GET BITS IN RIGHT PLACE, SAVE I/O INSTR
  1343	001514'	540 02 0 00 000001 		HRR	T2,T1		;PUT BITS IN THE INSTR
  1344						SAVE$	T2		;SAVE I/O INSTR A SEC
  1345	001516'	260 17 0 00 001532'		WARN.	EF$NCR!EF$OCT,IOE,<I/O ERROR - STATUS=>
  1346	001517'	300242	002761'
  1347					;	STRNG$	<, FILE >
  1348					;	LDB	T1,[POINT 4,(P),12]	;GET CHANNEL
  1349					;	MOVE	T1,[EXP INPSPC,OUTSPC]-1(T1) ;GET FDB ADDRESS
  1350					;	CALL	.TFBLK##	;TYPE FILE
  1351						STRNG$	< - CONTINUING
  1352	001520'	201 01 0 00 002762'	>
  1353	001521'	260 17 0 00 001464*
  1354						RESTR$	T1		;GET INSTR BACK
  1355	001523'	620 01 0 00 740000 		TRZ	T1,IO.ERR	;CLEAR ERROR BITS
  1356	001524'	621 01 0 00 002000 		TLZ	T1,002000	;GETSTS BECOMES SETSTS
  1357	001525'	256 00 0 00 000001 		XCT	T1
  1358	001526'				TPOPJ1:	RESTR$	T1		;GET T1 AGAIN
  1359	001527'	354 00 0 17 000000 		AOSA	(P)
  1360	001530'				TPOPJ:	RESTR$	T1
  1361	001531'	263 17 0 00 000000 		POPJ	P,

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 34
BIORTH	MAC	 3-FEB-77 13:19		ERROR HANDLER

  1362					SUBTTL	ERROR HANDLER
  1363
  1364					;EHNDLR -- HANDLE ALL ERRORS
  1365					;THE ONLY CALL IS THRU THE ERROR. MACRO
  1366
  1367	001532'	260 17 0 00 001623'	EHNDLR:	CALL	SAVACS		;SAVE THE ACS
  1368	001533'	200 05 1 17 000000 		MOVE	P1,@0(P)	;GET FLAGS AND ADDRESSES
  1369	001534'	336 00 1 00 000414*		SKIPN	@.TYOCH##	;IS SCAN TTCALLING?
  1370						 JRST	[SETZM	ERRTYX	;YES--CLEAR FLAG
  1371	001535'	254 00 0 00 002766'			JRST	EHND.0]	;AND SKIP ON
  1372	001536'	400 01 0 00 000000 		SETZ	T1,		;NO--SO MAKE IT
  1373	001537'	260 17 0 00 001534*		CALL	.TYOCH##	;TELL SCAN
  1374	001540'	202 01 0 00 002325'		MOVEM	T1,ERRTYX	;REMEMBER/SET FLAG
  1375	001541'	201 01 0 00 000077 	EHND.0:	MOVEI	T1,"?"		;ASSUME AN ERROR
  1376	001542'	603 05 0 00 000200 		TLNE	P1,EF$WRN	;CHECK WARNING
  1377	001543'	201 01 0 00 000045 		MOVEI	T1,"%"		;YES
  1378	001544'	603 05 0 00 000100 		TLNE	P1,EF$INF	;IF BOTH OFF NOW THEN INFO
  1379	001545'	201 01 0 00 000133 		MOVEI	T1,"["		;GOOD THING WE CHECKED
  1380	001546'	260 17 0 00 001371*		CALL	.TCHAR##	;OUTPUT THE START OF MESSAGE
  1381	001547'	205 01 0 00 425157 		MOVSI	T1,MY$PFX	;SET UP MY PREFIX
  1382	001550'	544 01 0 05 000000 		HLR	T1,(P1)		;GET MESSAGE PREFIX
  1383	001551'	260 17 0 00 000063*		CALL	.TSIXN##	;OUTPUT THE PREFIXES
  1384	001552'	260 17 0 00 000373*		CALL	.TSPAC##	;AND A SPACE
  1385	001553'	550 01 0 05 000000 		HRRZ	T1,(P1)		;GET STRING ADDRESS
  1386	001554'	260 17 0 00 001521*		CALL	.TSTRG##	;SEND IT
  1387	001555'	200 01 0 00 002145'		MOVE	T1,SAVAC+T1	;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
  1388	001556'	135 02 0 00 002770'		LDB	T2,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
  1389	001557'	303 02 0 00 000007 		CAILE	T2,EF$MAX	;CHECK LEGAL
  1390	001560'	201 02 0 00 000000 		 MOVEI	T2,0		;NOOOP
  1391	001561'	260 17 1 02 001603'		CALL	@ERRTAB(T2)	;CALL THE ROUTINE
  1392	001562'	603 05 0 00 000040 		TLNE	P1,EF$NCR	;IF NO CRLF THEN DON'T CLOSE INFO
  1393	001563'	254 00 0 00 001571'		 JRST	EHND.1		;NO--DON'T CHECK
  1394	001564'	201 01 0 00 000135 		MOVEI	T1,"]"		;PREPARE TO CLOSE INFO
  1395	001565'	603 05 0 00 000100 		TLNE	P1,EF$INF	;CHECK FOR INFO
  1396	001566'	260 17 0 00 001546*		CALL	.TCHAR##	;SEND INFO CLOSE
  1397	001567'	607 05 0 00 000040 		TLNN	P1,EF$NCR	;NO CARRIAGE RETURN?
  1398	001570'	260 17 0 00 001467*		CALL	.TCRLF##	;YES--SEND ONE
  1399	001571'	336 01 0 00 002325'	EHND.1:	SKIPN	T1,ERRTYX	;DID WE RESET SCAN?
  1400	001572'	254 00 0 00 001575'		 JRST	EHND.2		;NO
  1401	001573'	260 17 0 00 001537*		CALL	.TYOCH##	;AND RESTORE IT
  1402	001574'	402 00 0 00 002325'		SETZM	ERRTYX		;CLEAR FLAG
  1403	001575'	603 05 0 00 000400 	EHND.2:	TLNE	P1,EF$FTL	;NOW CHECK FATAL
  1404	001576'	254 00 0 00 001613'		 JRST	ERRFTL		;YES--GO DIE
  1405						;FALL INTO RESACS

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 35
BIORTH	MAC	 3-FEB-77 13:19		ERROR HANDLER

  1406					;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
  1407					;	CALL	RESACS
  1408					;	*ACS RESTORED FROM SAVAC*
  1409
  1410	001577'	202 17 0 00 002163'	RESACS:	MOVEM	17,SAVAC+17	;SAVE 17 TO RESTORE INTO IT
  1411	001600'	205 17 0 00 002144'		MOVSI	17,SAVAC
  1412	001601'	251 17 0 00 000017 		BLT	17,17		;REGISTERS ARE RESTORED
  1413	001602'	263 17 0 00 000000 		POPJ	P,		;RETURN
  1414
  1415	001603'	000000	000000*		ERRTAB:	.POPJ##			;CODE 0 -- NO ACTION
  1416	001604'	000000	000231*			.TDECW##		;CODE 1 -- TYPE T1 IN DECIMAL
  1417	001605'	000000	000000*			.TOCTW##		;CODE 2 -- TYPE T1 IN OCTAL
  1418	001606'	000000	001551*			.TSIXN##		;CODE 3 -- TYPE T1 IN SIXBIT
  1419	001607'	000000	000000*			.TPPNW##		;CODE 4 -- TYPE T1 AS PPN
  1420	001610'	000000	001554*			.TSTRG##		;CODE 5 -- T1 POINTS TO ASCIZ STRING
  1421	001611'	000000	001466*			.TFBLK##		;CODE 6 -- T1 POINTS AT FDB
  1422	001612'	000000	001345'			.TDATX			;CODE 7 -- TYPE T1 AS DAY/DATE
  1423
  1424					;HERE TO DIE--
  1425
  1426	001613'				ERRFTL:	SAVE$	.JBFF		;SAVE JBFF OVER RESET
  1427	001614'	047 00 0 00 000000 		RESET			;KILL ALL FILES
  1428						RESTR$	.JBFF		;GET JOBFF BACK
  1429	001616'	200 17 0 00 000013'		MOVE	P,INIPDP	;RESET PDL
  1430	001617'	260 17 0 00 000146*		CALL	.CLRBF##	;CLEAR ANY TYPE AHEAD OR UNEATEN COMMANDS
  1431	001620'	332 00 0 00 001632'		SKIPE	OFFSET		;CCL ENTRY
  1432	001621'	260 17 0 00 000037*		  CALL	.MONRT##	;YES--EXIT 1,
  1433	001622'	254 00 0 00 000035'		JRST	RESTRT		;AND RESTART ON CONTINUE
  1434
  1435					;SAVAC -- SAVE ALL ACS
  1436					;CALL -- PUSHJ P,SAVACS
  1437					;	*ACS SAVED IN SAVAC*	BEWARE!!
  1438
  1439	001623'	202 17 0 00 002163'	SAVACS:	MOVEM	17,SAVAC+17	;SAVE ONE
  1440	001624'	201 17 0 00 002144'		MOVEI	17,SAVAC
  1441	001625'	251 17 0 00 002162'		BLT	17,SAVAC+16
  1442	001626'	200 17 0 00 002163'		MOVE	17,SAVAC+17
  1443	001627'	263 17 0 00 000000 		POPJ	P,		;ACS ARE SAVED
  1444

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE 36
BIORTH	MAC	 3-FEB-77 13:19		STORAGE

  1445					SUBTTL	STORAGE
  1446
  1447					;STORAGE THAT REMAINS BETWEEN RUNS
  1448
  1449	001630'				U (ISCNVL)		;VALUE FROM .ISCAN
  1450	001631'				U (TLDVER)		;-1 WHEN TYPED VERSION TO TTY
  1451	001632'				U (OFFSET)		;STARTING OFFSET
  1452	001633'				U (LOGTIM)		;JOB LOGIN TIME
  1453
  1454			001634'		FW$ZER==.	;FIRST WORD ZEROED
  1455	001634'				U (PDLIST,LN$PDL)	;PUSHDOWN LIST
  1456	002144'				U (SAVAC,20)		;SAVE ACS HERE
  1457	002164'				U (PLTBUF,PLTBSZ+1)	;FORM A LINE HERE
  1458	002202'				U (FLFUTD)		;FLAGS FOR DATE-TIME GETTER
  1459	002203'				U (FLFUTR)
  1460	002204'				U (NOW)			;CURRENT DATE/TIME
  1461	002205'				U (VAL1)		;DON'T SEPARATE VALX
  1462	002206'				U (VAL2)
  1463	002207'				U (VAL3)
  1464	002210'				U (VAL4)
  1465	002211'				U (VAL5)
  1466	002212'				U (VAL6)
  1467	002213'				U (VAL7)
  1468	002214'				U (VAL8)
  1469	002215'				U (VAL9)
  1470	002216'				U (TEMP)		;TEMP
  1471	002217'				U (IPOS)
  1472	002220'				U (EPOS)
  1473	002221'				U (PPOS)
  1474	002222'				U (FILSPC,.FXLEN)	;SCAN FILE SPEC
  1475	002254'				U (OPNBLK,3)		;OPEN BLOCK
  1476	002257'				U (LKPBLK,.RBTIM)	;LOOKUP/ENTER BLOCK
  1477	002314'				U (PTHBLK,^D9)		;PATH BLOCK
  1478	002325'				U (ERRTYX)		;FLAG FOR EHNDLR
  1479	002326'				U (IBHR,3)		;INPUT BUFFER HEADER
  1480	002331'				U (OBHR,3)		;OUTPUT BUFFER HEADER
  1481			002334'		SCN$FZ==.	;FIRST WORD ZEROED AT CLRANS
  1482			002333'		SCN$LZ==.-1	;LAST WORD ZEROED AT CLRANS
  1483			002334'		SCN$FO==.	;FIRST WORD MINUS ONNED AT CLRANS
  1484	002334'				U (BIRTHD)		;/BIRTHDAY ARG
  1485	002335'				U (BEGNDT)		;/BEGIN
  1486	002336'				U (ENDATE)		;/END
  1487	002337'				U (PBEGND)		;PXXX SWITCHES (NOT USED)
  1488			002337'		SCN$LO==.-1	;LAST WORD ONNED AT CLRANS
  1489			002337'		LW$ZER==.-1	;LAST WORD ZEROED AT STARTUP
  1490
  1491			000000'			END	BIORTH

NO ERRORS DETECTED

PROGRAM BREAK IS 002771
CPU TIME USED 00:36.632

14K CORE USED

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE S-1
BIORTH	MAC	 3-FEB-77 13:19		SYMBOL TABLE

ATSIGN		000020	SPD	DATRIC		001001'		FS.NUE	100000	000000	SPD	PCHTBL		000415'		
BEGNDT		002335'		DAYOFW		001375'		FS.VRQ	040000	000000	SPD	PCYCLE		000027	SPD	
BIOEDT		000006	SPD	DAYS		001145'		FT$DDT		000000	SPD	PD.		000000	SPD	
BIOMIN		000000	SPD	DOPRMP		000060'		FT$OPT		000000	SPD	PDLIST		001634'		
BIOR.0		000030'		E$$DFL		001127'		FW$ZER		001634'	SPD	PJRST	254000	000000		
BIORTH		000000'		E$$DFZ		001131'		GETNW1		001310'		PLOT.0		000301'		
BIOVER		000002	SPD	E$$DOR		001032'		GETNW2		001312'		PLOT.1		000330'		
BIOWHO		000000	SPD	E$$DTM		001143'		GETNWX		001320'		PLOT.2		000364'		
BIRTHD		002334'		E$$ILR		001135'		GETSTS	062000	000000		PLOT.5		000371'		
C		000010	SPD	E$$MDD		001141'		GETTAB	047000	000041		PLOT.6		000403'		
CALL	260740	000000		E$$NBG		000240'		HALT	254200	000000		PLOT.9		000405'		
CHRO.0		001473'		E$$NFT		001117'		IBHR		002326'		PLOT0B		000313'		
CHRO.1		001475'		E$$NND		001123'		ICYCLE		000041	SPD	PLTBSZ		000015	SPD	
CHROUT		001471'		E$$NPF		001125'		IFX.1		000453'	EXT	PLTBUF		002164'		
CLOSE	070000	000000		E$$NPS		001121'		INIPDP		000013'		PLTWID		000074	SPD	
CMDLST		000065'		E$$UDM		001133'		IO.EOF		020000	SPD	PLTZER		000036	SPD	
CMPTFN		000204'		E$$UDN		001137'		IO.EOT		002000	SPD	PPOS		002221'		
CNTDT0		001227'		E.ILSC		000763'	EXT	IO.ERR		740000	SPD	PRMPTM		000064'		
CNTDT1		001230'		E.MDS		000634'		IPOS		002217'		PTHBLK		002314'		
CNTDT2		001236'		ECYCLE		000034	SPD	ISCNBL		000042'		PUTPLC		000454'		
CNTDT3		001237'		EF$DAT		000007	SPD	ISCNVL		001630'		RELEAS	071000	000000		
CNTDT4		001243'		EF$DEC		000001	SPD	LKENER		001460'		RESACS		001577'		
CNTDT5		001244'		EF$ERR		000000	SPD	LKPBLK		002257'		RESET	047000	000000		
CNTDT6		001245'		EF$FIL		000006	SPD	LN$PCH		000003	SPD	RESTRT		000035'		
COMPOS		000425'		EF$FTL		000400	SPD	LN$PDL		000310	SPD	SAVAC		002144'		
CRTCHK		000420'		EF$INF		000100	SPD	LOGTIM		001633'		SAVACS		001623'		
D		000012		EF$MAX		000007	SPD	LOOKUP	076000	000000		SCN$FO		002334'	SPD	
DATIC		001055'		EF$NCR		000040	SPD	LSPDTM		000033	SPD	SCN$FZ		002334'	SPD	
DATIC1		000521'		EF$OCT		000002	SPD	LW$ZER		002337'	SPD	SCN$LO		002337'	SPD	
DATIC2		000524'		EF$PPN		000004	SPD	MNDPTR		001201'		SCN$LZ		002333'	SPD	
DATID		001102'		EF$SIX		000003	SPD	MONPTR		001200'		SIN.		000437'	EXT	
DATIF1		000473'		EF$STR		000005	SPD	MONTAB		001321'		SPCDAY		001170'		
DATIG		001060'		EF$WRN		000200	SPD	MONTHS		001154'		SPDATM		001176'		
DATIM		000525'		EHND.0		001541'		MX$CRT		000004	SPD	SPLGTM		001173'		
DATIMD		000637'		EHND.1		001571'		MX.		000000	SPD	SPMIDN		001175'		
DATIMM		000575'		EHND.2		001575'		MY$NAM	425157	626450	SPD	SPNOON		001174'		
DATIMN		000612'		EHNDLR		001532'		MY$PFX		425157	SPD	T1		000001		
DATIMO		000631'		ENDATE		002336'		N		000007	SPD	T2		000002		
DATIMW		000567'		ENTER	077000	000000		N$CMDS		000001	SPD	T3		000003		
DATIMX		001024'		EPOS		002220'		NOOP		300000	SPD	T4		000004		
DATIN		000656'		ERRFTL		001613'		NOW		002204'		TEMP		002216'		
DATIP1		000506'		ERRTAB		001603'		OBHR		002331'		TLDVER		001631'		
DATIRA		000747'		ERRTYX		002325'		OFFSET		001632'		TPOPJ		001530'		
DATIRB		000772'		F		000011		OPEN	050000	000000		TPOPJ1		001526'		
DATIRD		001006'		F.NAM		000246'	EXT	OPENER		001452'		TWOPI		000041'		
DATIRM		001034'		FILSPC		002222'		OPENIO		001404'		VAL1		002205'		
DATIRN		000761'		FL$BKW		100000	SPD	OPNBLK		002254'		VAL2		002206'		
DATIRR		001022'		FL$CRT		040000	SPD	OUT	057000	000000		VAL3		002207'		
DATIT		000700'		FL$FIL		400000	SPD	OUTC		000001	SPD	VAL4		002210'		
DATITR		000704'		FL$HVB		200000	SPD	P		000017		VAL5		002211'		
DATIY		000722'		FLFUTD		002202'		P1		000005		VAL6		002212'		
DATIY0		000717'		FLFUTR		002203'		P2		000006		VAL7		002213'		
DATIY1		000731'		FLOAT.	132000	000233		P3		000007		VAL8		002214'		
DATMM1		000716'		FLT.1		000434'	EXT	P4		000010		VAL9		002215'		
DATMMM		000710'		FS.LRG	200000	000000	SPD	PBEGND		002337'		VSCNBL		000050'		

BIORTH -- PROGRAM TO CHART BIORHYTHMS %2(6)	MACRO %50A(441)-2 14:08 23-FEB-77 PAGE S-2
BIORTH	MAC	 3-FEB-77 13:19		SYMBOL TABLE

VSWTD		000110'		.POPJ		001603'	EXT	
VSWTL		000006	SPD	.POPJ1		001116'	EXT	
VSWTM		000102'		.QSCAN		000140'	EXT	
VSWTN		000066'		.RBCNT		000000	SPD	
VSWTP		000074'		.RBEXT		000003	SPD	
WLDERR		001455'		.RBTIM		000035	SPD	
X		000000		.RECOR		000014'	EXT	
XCTIO		001501'		.SAVE1		001355'	EXT	
ZZ		000007	SPD	.SAVE2		000235'	EXT	
$BIRTH		000116'		.SAVE3		001406'	EXT	
$CHART		000235'		.SIXSC		000710'	EXT	
$COMPA		000124'		.STOPB		001416'	EXT	
$PLOT		000235'		.TCHAR		001566'	EXT	
$POPJ		001451'		.TCOLN		001342'	EXT	
$POPJ1		001450'		.TCRLF		001570'	EXT	
$POPJ2		001447'		.TDATE		001355'		
%%BIOV	000200	000006	SIN	.TDATX		001345'		
%%JOBD	043000	000443	SPD	.TDEC2		001374'	EXT	
%%MACT	000100	000024	SIN	.TDECW		001604'	EXT	
%%SCNM	000700	000203	SIN	.TDTTM		001336'		
%%UUOS	101100	000225	SIN	.TFBLK		001611'	EXT	
%CNDTM	000053	000011	SPD	.TIAUC		000722'	EXT	
.ALCBF		000274'	EXT	.TICAN		000761'	EXT	
.BFCTR		000002	SPD	.TOCTW		001605'	EXT	
.BFPTR		000001	SPD	.TPCNT		000231'		
.CLRBF		001617'	EXT	.TPPNW		001607'	EXT	
.CNTDT		001202'		.TSIXN		001606'	EXT	
.CNVDT		001260'		.TSPAC		001552'	EXT	
.DATIC		000513'		.TSTRG		001610'	EXT	
.DATIF		000463'		.TTIME		001344'	EXT	
.DATIG		000464'		.TVERW		000026'	EXT	
.DATIM		000512'		.TYOCH		001573'	EXT	
.DATIP		000477'		.VSCAN		000036'	EXT	
.DATIQ		000500'		
.DECNC		000670'	EXT	
.DECNW		001075'	EXT	
.FILIN		000244'	EXT	
.FREBF		000412'	EXT	
.FXDEV		000000	SPD	
.FXEXT		000003	SPD	
.FXLEN		000032	SPD	
.FXNAM		000001	SPD	
.FXNMM		000002	SPD	
.GTJLT		000130	SPD	
.GTNOW		001253'		
.GTSPC		000253'	EXT	
.IOASC		000000	SPD	
.ISCAN		000016'	EXT	
.JBFF		000121		
.JBVER		000137		
.LASWD		001025'	EXT	
.MONRT		001621'	EXT	
.NAME		000712'	EXT	
.NMUL		001030'	EXT	
.OPBUF		000002	SPD	
ATSIGN	   101#	  1271	  1282
BEGNDT	   240	   276	   442	  1485#
BIOEDT	    12#	    19	    22
BIOMIN	    13#	    22
BIOR.0	   208	   214#
BIORTH	   189#	  1491
BIOVER	    11#	    19	    22
BIOWHO	    14#	    22
BIRTHD	   301	   457	   545	  1484#
C	    71#	   299	   410	   590	   609	   627	   631	   678	   679	   719	   757	   771	   778	   779
	   808	   813	   814	   817	   933	   941	   948
CHRO.0	  1317#	  1323
CHRO.1	  1316	  1320#
CHROUT	   437	  1315#
CMDLST	   227	   253#	   254
CMPTFN	   336	   339	   342	   372#
CNTDT0	  1070	  1075#
CNTDT1	  1079#
CNTDT2	  1081	  1085#
CNTDT3	  1087#	  1090
CNTDT4	  1088	  1092#
CNTDT5	  1083	  1093#
CNTDT6	  1047	  1095#
COMPOS	   478	   482	   486	   540#
CRTCHK	   480	   484	   488	   535#
D	    69#	    69	   442	   443	   444	   448	   452	   507	   515	   516	   519	   520	   544
DATIC	   708	   766	   836	   933#
DATIC1	   628	   631#
DATIC2	   630	   634#
DATID	   942	   949	   956#
DATIF1	   591	   594#
DATIG	   790	   937#
DATIM	   594	   613	   632	   671#
DATIMD	   681	   755#
DATIMM	   691	   714#
DATIMN	   717	   729#
DATIMO	   740	   747#
DATIMW	   707#	   737	   749
DATIMX	   712	   733	   798	   900#
DATIN	   758	   771#
DATIP1	   610	   613#
DATIRA	   809	   834#
DATIRB	   860#	   880
DATIRD	   877	   882#	   884
DATIRM	   887	   896	   911#
DATIRN	   793	   838	   851#
DATIRR	   886	   892	   896#
DATIT	   772	   790#
DATITR	   769	   795#
DATIY	   812#	   818
DATIY0	   726	   808#
DATIY1	   815	   819#
DATMM1	   788	   807#
DATMMM	   780	   800#
DATRIC	   872	   876#
DAYOFW	  1200	  1240#
DAYS	   689	  1000#	  1031	  1036
DOPRMP	   231	   246#
E$$DFL	   724	   763	   774	   784	   787	   939	   945	   952	   979#
E$$DFZ	   775	   981#
E$$DOR	   903	   907#
E$$DTM	   684	   991#
E$$ILR	   819	   822	   985#
E$$MDD	   720	   989#
E$$NBG	   299	   407#
E$$NFT	   596	   971#
E$$NND	   722	   756	   782	   937	   946	   953	   975#
E$$NPF	   694	   761	   977#
E$$NPS	   615	   973#
E$$UDM	   803	   983#
E$$UDN	   687	   987#
E.ILSC	   853
E.MDS	   743	   751#
ECYCLE	    45	   338	   481
EF$DAT	   126#
EF$DEC	   120#
EF$ERR	   108#	  1305
EF$FIL	   125#	  1297	  1301
EF$FTL	   109#	   408	   753	   908	   972	   974	   976	   978	   980	   982	   984	   986	   988	   990
	   992	  1110	  1297	  1301	  1403
EF$INF	   111#	  1378	  1395
EF$MAX	   127#	  1389
EF$NCR	   112#	  1305	  1346	  1392	  1397
EF$OCT	   121#	  1305	  1346
EF$PPN	   123#
EF$SIX	   122#	   753
EF$STR	   124#
EF$WRN	   110#	  1346	  1376
EHND.0	  1371	  1375#
EHND.1	  1393	  1399#
EHND.2	  1400	  1403#
EHNDLR	   407	   752	   907	   971	   973	   975	   977	   979	   981	   983	   985	   987	   989	   991
	  1109	  1296	  1300	  1304	  1345	  1367#
ENDATE	   280	   440	   450	   451	   452	   516	   520	  1486#
EPOS	   340	   350	   359	   483	   532	  1472#
ERRFTL	  1311	  1404	  1426#
ERRTAB	  1391	  1415#
ERRTYX	  1370	  1374	  1399	  1402	  1478#
F	    68#	    68	   298	   302	   406	   409	   436	   446	   453	   498	   514	   522	   538
F.NAM	   412	   413
FILSPC	   416	   420	   421	   423	   424	   425	   426	   428	   429	   430	  1474#
FL$BKW	    86#	    86	   409	   453	   514
FL$CRT	    87#	    87	   409	   498	   538
FL$FIL	    84#	    84	   409	   436	   446	   522
FL$HVB	    85#	    85	   298	   302	   406
FLFUTD	   588	   589	   608	   626	   672	   693	   702	   747	   759	   837	   888	   893	  1458#
FLFUTR	   587	   592	   607	   611	   625	   629	   633	   671	   695	   760	   792	   795	  1459#
FLT.1	   547
FS.LRG	   282	   283	   284	   285	   286	   287	   288	   289	   290	   291	   292	   293
FS.NUE	   282	   286	   288	   292
FS.VRQ	   282	   286	   288	   292
FT$DDT	    48	   274	   280	   286	   292	   305
FT$OPT	    47
FW$ZER	   196	   197	  1454#
GETNW1	  1147	  1151#
GETNW2	  1129	  1153#
GETNWX	  1111	  1160#
IBHR	  1479#
ICYCLE	    44	   335	   477
IFX.1	   392	   562
INIPDP	   201#	  1429
IO.EOF	  1340
IO.EOT	  1340
IO.ERR	  1355
IPOS	   337	   346	   358	   479	   531	  1471#
ISCNBL	   203	   226#
ISCNVL	   205	  1449#
LKENER	  1287	  1303#
LKPBLK	  1262	  1267	  1285	  1303	  1476#
LN$PCH	   500	   534#
LN$PDL	    37	   201	  1455
LOGTIM	   217	   731	  1452#
LSPDTM	  1031#	  1036
LW$ZER	   198	  1489#
MNDPTR	   685	  1036#
MONPTR	   801	  1035#
MONTAB	  1087	  1092	  1131	  1163#
MONTHS	   715	   805	  1008#	  1035
MX$CRT	    40	   537
MX.	   282#	   282	   283	   284	   285	   286	   287
MY$NAM	    38	   253
MY$PFX	    39	   228	   251	  1381
N	    70#	   301	   325	   333	   595	   614	   684	   688	   689	   690	   698	   699	   700	   704
	   705	   706	   707	   709	   711	   714	   715	   716	   718	   722	   723	   725	   731	   735
	   736	   739	   744	   745	   746	   748	   756	   762	   764	   767	   768	   773	   775	   776
	   782	   783	   785	   786	   796	   797	   804	   805	   807	   811	   816	   817	   823	   885
	   886	   894	   895	   897	   902	   904	   937	   938	   940	   944	   946	   947	   951	   953
	   954	   967
N$CMDS	   227	   254#
NOOP	   134#	   408	   753	   908	   972	   974	   976	   978	   980	   982	   984	   986	   988	   990
	   992	  1110	  1297	  1301	  1305	  1346
NOW	   372	   377	   595	   614	   677	   696	   701	   735	   739	   744	   797	   854	   889	   891
	  1460#
OBHR	   432	   434	   526	  1315	  1317	  1480#
OFFSET	   191	   206	   228	  1431	  1451#
OPENER	  1280	  1295#
OPENIO	   431	  1254#
OPNBLK	   434	  1261	  1269	  1273	  1277	  1475#
OUTC	    92#	   432	   524	   525	  1321
P	    72#	    96	   200	   317	   363	   405	   440	   523	   529	   539	   547	   576	   585	   593
	   594	   597	   605	   612	   613	   616	   623	   634	   676	   683	   686	   707	   708	   709
	   710	   721	   755	   765	   766	   777	   781	   790	   800	   802	   812	   836	   851	   855
	   887	   896	   905	   934	   935	   943	   950	  1046	  1095	  1099	  1100	  1125	  1126	  1155
	  1160	  1184	  1186	  1187	  1188	  1190	  1197	  1202	  1212	  1217	  1231	  1254	  1255	  1288
	  1289	  1290	  1291	  1318	  1332	  1335	  1336	  1345	  1355	  1359	  1361	  1368	  1413	  1427
	  1429	  1443
P1	    64#	    64	   325	   373	   500	   501	   502	   505	  1132	  1134	  1139	  1151	  1230	  1257
	  1258	  1260	  1295	  1299	  1308	  1368	  1376	  1378	  1382	  1385	  1388	  1392	  1395	  1397
	  1403
P2	    65#	    65	   333	   378	  1258	  1268	  1270	  1271	  1274	  1282
P3	    66#	    66	    70	  1274	  1275	  1276	  1278	  1281
P4	    67#	    67	    71
PBEGND	   241	  1487#
PCHTBL	   501	   502	   531#	   534
PCYCLE	    46	   341	   485
PD.	   288#	   288	   289	   290	   291	   292	   293
PDLIST	   201	  1455#
PLOT.0	   410	   415	   440#
PLOT.1	   473#	   517	   521
PLOT.2	   501#	   505
PLOT.5	   506#
PLOT.6	   520#
PLOT.9	   518	   522#
PLOT0B	   447	   450#
PLTBSZ	    43	   476	  1457
PLTBUF	   474	   475	   476	   510	   572	  1457#
PLTWID	    41	    42	   494	   497	   554
PLTZER	    42#	   492	   535
PPOS	   343	   354	   360	   487	   533	  1473#
PRMPTM	   247	   251#
PTHBLK	  1263	  1477#
PUTPLC	   491	   493	   495	   499	   504	   570#
RESACS	  1410#
RESTRT	   219#	   222	  1433
SAVAC	  1387	  1410	  1411	  1439	  1440	  1441	  1442	  1456#
SAVACS	  1367	  1439#
SCN$FO	  1483#
SCN$FZ	  1481#
SCN$LO	  1488#
SCN$LZ	  1482#
SIN.	   550
SPCDAY	   741	  1021#
SPDATM	  1029#
SPLGTM	   730	  1025#
SPMIDN	   738	  1027#
SPNOON	   734	  1026#
T1	    60#	    60	   189	   190	   191	   203	   205	   209	   211	   214	   215	   216	   217	   219
	   246	   247	   248	   319	   322	   327	   330	   335	   337	   338	   340	   341	   343	   344
	   346	   348	   350	   352	   354	   356	   358	   359	   360	   361	   375	   380	   385	   386
	   387	   388	   389	   390	   391	   397	   416	   419	   421	   422	   426	   427	   429	   430
	   433	   437	   440	   443	   445	   448	   449	   451	   455	   457	   466	   470	   473	   474
	   475	   476	   477	   479	   481	   483	   485	   487	   489	   496	   501	   507	   510	   513
	   515	   519	   526	   529	   535	   536	   537	   540	   542	   544	   546	   548	   552	   553
	   554	   555	   556	   557	   558	   559	   560	   561	   575	   671	   672	   674	   675	   677
	   685	   688	   693	   695	   701	   703	   706	   710	   711	   714	   729	   751	   759	   760
	   761	   801	   804	   811	   818	   819	   820	   821	   826	   828	   840	   841	   842	   843
	   844	   854	   856	   860	   861	   875	   876	   889	   891	   897	   900	   901	   911	   912
	   913	   914	   915	   916	   956	   957	   958	   960	   961	   963	   965	   966	   967	  1046
	  1047	  1048	  1052	  1055	  1063	  1064	  1065	  1066	  1068	  1079	  1080	  1089	  1093	  1095
	  1096	  1097	  1098	  1107	  1108	  1126	  1135	  1143	  1146	  1155	  1157	  1158	  1159	  1186
	  1190	  1197	  1198	  1199	  1200	  1202	  1204	  1213	  1214	  1215	  1219	  1232	  1233	  1234
	  1236	  1254	  1257	  1259	  1260	  1266	  1267	  1268	  1269	  1270	  1272	  1273	  1277	  1278
	  1279	  1281	  1283	  1284	  1285	  1286	  1295	  1299	  1303	  1306	  1308	  1317	  1335	  1337
	  1338	  1339	  1342	  1343	  1352	  1355	  1356	  1357	  1359	  1361	  1372	  1374	  1375	  1377
	  1379	  1381	  1382	  1385	  1387	  1394	  1399
T2	    61#	    61	   372	   373	   374	   375	   376	   381	   382	   383	   384	   386	   388	   417
	   434	   490	   492	   494	   497	   502	   503	   541	   542	   543	   545	   546	   570	   572
	   696	   697	   729	   730	   734	   738	   741	   742	   745	   823	   824	   827	   832	   858
	   860	   879	   917	   918	   919	   920	   921	   922	   923	   924	   925	   926	   964	  1057
	  1058	  1064	  1068	  1069	  1071	  1073	  1085	  1087	  1090	  1092	  1099	  1127	  1128	  1135
	  1136	  1137	  1140	  1143	  1144	  1145	  1146	  1147	  1148	  1149	  1156	  1186	  1200	  1204
	  1215	  1216	  1236	  1237	  1261	  1338	  1340	  1342	  1343	  1345	  1388	  1389	  1390	  1391
T3	    62#	    62	   376	   377	   378	   379	   380	   574	   698	   825	   829	   831	   856	   857
	   870	   871	   874	   879	   885	  1060	  1061	  1066	  1072	  1074	  1075	  1081	  1130	  1131
	  1133	  1138	  1150	  1262
T4	    63#	    63	   381	   571	   572	   573	   575	   830	   859	   868	   869	   871	   873	   875
	   876	   878	   880	   882	   883	   884	   888	   891	  1062	  1082	  1084	  1087	  1092	  1093
	  1131	  1140	  1145	  1149	  1151	  1152	  1153	  1159	  1214	  1218	  1232	  1263
TEMP	   543	   548	   549	   551	   553	   556	   558	   559	   561	  1470#
TEST%%	   474	  1108
TLDVER	   207	   218	  1450#
TPOPJ	  1341	  1360#
TPOPJ1	  1358#
TWOPI	   223#	   541
VAL1	   673	   674	   869	   873	   875	   876	   882	   883	  1461#
VAL2	   674	   841	   894	   895	   915	   954	   962	   963	  1462#
VAL3	   842	   913	   947	   959	   960	  1463#
VAL4	   844	   911	   940	   956	  1464#
VAL5	   725	   764	   768	   776	   785	   834	   925	  1465#
VAL6	   718	   807	   835	   923	  1466#
VAL7	   830	   921	  1467#
VAL8	   831	   919	  1468#
VAL9	   675	   832	   917	  1469#
VSCNBL	   219	   235#
VSWTD	   237	   288#
VSWTL	   236	   276#
VSWTM	   237	   282#
VSWTN	   236	   270#	   276
VSWTP	   238	   276#
WLDERR	  1265	  1299#
X	    59#	    59	   551
XCTIO	  1320	  1332#
ZZ	    57#	    59	    59#	    60	    60#	    61	    61#	    62	    62#	    63	    63#	    64	    64#	    65
	    65#	    66	    66#	    67	    67#	    68	    68#	    69	    69#	    82#	    84	    84#	    85	    85#
	    86	    86#	    87	    87#	   118#	   120	   120#	   121	   121#	   122	   122#	   123	   123#	   124
	   124#	   125	   125#	   126	   126#	   127	   129
$BIRTH	   283	   297#
$CHART	   284	   403#
$COMPA	   285	   316#
$PLOT	   287	   402#
$POPJ	  1291#
$POPJ1	  1290#
$POPJ2	  1289#	  1333
%%BIOV	    22#	    23
%%JOBD	    27	    27#
%%MACT	    29	    29#
%%SCNM	    30	    30#
%%UUOS	    28	    28#
%CNDTM	  1107
..TEMP	   276#	   276	   277#	   278#	   279#	   280#	   280	   281#	   282#	   282	   283	   283#	   284	   284#
	   285	   285#	   286	   286#	   287	   287#	   288	   288#	   289	   289#	   290	   290#	   291	   291#
	   292	   292#	   293	   293#	   294
..TEMR	   288#	   288	   289#	   289	   290#	   290	   291#	   291	   292#	   292	   293#	   293	   294
.ALCBF	   435
.BFCTR	  1315
.BFPTR	  1317
.CLRBF	   318	   326	   334	  1430
.CNTDT	   855	  1046#	  1184	  1203
.CNVDT	   927	  1125#
.DATIC	   625#
.DATIF	   585#
.DATIG	   587#
.DATIM	   282	   286	   300	   324	   332	   623#
.DATIP	   605#
.DATIQ	   607#
.DECNC	   755	   781
.DECNW	   721	   935	   943	   950
.FILIN	   411
.FREBF	   527
.FXDEV	   420	   421
.FXEXT	   428	   429
.FXLEN	   417	  1259	  1474
.FXNAM	   423	   425	   426
.FXNMM	   424
.GTJLT	   214
.GTNOW	   441	   676	  1107#
.GTSPC	   418
.IOASC	   432
.ISCAN	   204
.JBFF	  1427	  1429
.JBVER	    21	   211
.LASWD	   901
.MONRT	   221	  1432
.NAME	   686	   802
.NMUL	   904
.OPBUF	  1273
.POPJ	  1415
.POPJ1	   303	   968
.QSCAN	   320	   328
.RBCNT	  1267
.RBEXT	  1303
.RBTIM	  1262	  1266	  1476
.RECOR	   202
.SAVE1	  1125	  1212
.SAVE2	   316	   404
.SAVE3	  1256
.SIXSC	   683	   800
.STOPB	  1264
.TCHAR	   398	  1235	  1380	  1396
.TCOLN	  1188
.TCRLF	   213	   399	   472	   512	  1310	  1398
.TDATE	  1187	  1212#
.TDATX	   458	   508	  1197#	  1422
.TDEC2	  1217	  1238
.TDECW	   396	  1416
.TDTTM	   900	  1184#
.TFBLK	  1309	  1421
.TIAUC	   585	   593	   605	   612	   623	   634	   765	   777	   812
.TICAN	   851
.TOCTW	  1417
.TPCNT	   347	   351	   355	   362	   396#
.TPPNW	  1419
.TSIXN	   249	  1383	  1418
.TSPAC	   509	  1384
.TSTRG	   210	   323	   331	   345	   349	   353	   357	   456	   467	   471	   511	  1201	  1231	  1307
	  1353	  1386	  1420
.TTIME	  1190
.TVERW	   212
.TYOCH	   438	   529	  1369	  1373	  1401
.VSCAN	   220
AC$	    53#	    59	    60	    61	    62	    63	    64	    65	    66	    67	    68	    69
ASCIZ$	   182#
CALL	    96#	   202	   204	   210	   212	   213	   220	   221	   300	   316	   318	   320	   323	   324
	   326	   328	   331	   332	   334	   336	   339	   342	   345	   347	   349	   351	   353	   355
	   357	   362	   396	   398	   404	   407	   411	   418	   431	   435	   438	   441	   456	   458
	   467	   471	   472	   478	   480	   482	   484	   486	   488	   491	   493	   495	   499	   504
	   508	   509	   511	   512	   527	   550	   752	   907	   971	   973	   975	   977	   979	   981
	   983	   985	   987	   989	   991	  1109	  1201	  1203	  1235	  1256	  1264	  1296	  1300	  1304
	  1307	  1309	  1310	  1320	  1345	  1353	  1367	  1373	  1380	  1383	  1384	  1386	  1391	  1396
	  1398	  1401	  1430	  1432
CLOSE	   524
CTITLE	    17#	    19
DOSCAN	   269
ENTER	  1283
ERROR.	   137#	   407	   752	   907	   971	   973	   975	   977	   979	   981	   983	   985	   987	   989
	   991	  1109	  1296	  1300	  1304	  1345
ETYP	   115#	   120	   121	   122	   123	   124	   125	   126
FLAG$	    78#	    84	    85	    86	    87
FLOAT.	    97#	   384	   385	   540	   555
GETSTS	  1338
GETTAB	   215	  1108
HALT	   791	  1322
INFO.	   149#
LOOKUP	  1284
M$FAIL	   152#	   907	   971	   973	   975	   977	   979	   981	   983	   985	   987	   989	   991
MOVX	   473	  1107
ND	    37	    38	    39	    40	    41	    43	    44	    45	    46	    47	    48
OPEN	  1277
OUT	  1321
PJRST	   249	   392	   399	   529	   562	   632	   927	  1190	  1238
RELEAS	   525
RESET	   199	  1427
RESTR$	   164#	   528	  1189	  1354	  1358	  1360	  1428
SAVE$	   157#	   439	  1185	  1334	  1344	  1426
SP	   270	   271	   272	   273	   274	   275	   276	   277	   278	   279	   280	   281	   282	   283
	   284	   285	   286	   287	   288	   289	   290	   291	   292	   293
STORE	   193	   196	   473
STRNG$	   176#	   209	   322	   330	   344	   348	   352	   356	   454	   459	   468	  1306	  1351
SWTCHS	   257#	   270	   276	   282	   288
U	   171#	  1449	  1450	  1451	  1452	  1455	  1456	  1457	  1458	  1459	  1460	  1461	  1462	  1463
	  1464	  1465	  1466	  1467	  1468	  1469	  1470	  1471	  1472	  1473	  1474	  1475	  1476	  1477
	  1478	  1479	  1480	  1484	  1485	  1486	  1487
VRSN.	    22
WARN.	   144#	  1345
X	   270#	   270	   271	   272	   273	   274	   275	   276#	   276	   277	   278	   279	   280	   281
	   282#	   282	   283	   284	   285	   286	   287	   288#	   288	   289	   290	   291	   292	   293
XX	   997#	  1000	  1001	  1002	  1003	  1004	  1005	  1006	  1008	  1009	  1010	  1011	  1012	  1013
	  1014	  1015	  1016	  1017	  1018	  1019	  1021	  1022	  1023	  1025	  1026	  1027	  1029	  1030