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 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
18
19 CTITLE (TITLE,,\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
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
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
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,
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 ,[''$PFX'',,[ASCIZ @$MSG@ ] ]
139 >
140
141 ;WARN. FLGS,PFX,MSG
142
143 DEFINE WARN. ($FLGS,$PFX,$MSG)
144
145
146 ;INFO. FLGS,PFX,MSG
147
148 DEFINE INFO. ($FLGS,$PFX,$MSG)
149
150
151 DEFINE M$FAIL ($PFX,$MSG)
152
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
159 LIST>
160
161 ;RESTR$ RESTORES DATA FROM THE STACK
162
163 DEFINE RESTR$ (X)
164
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
178
179 ;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY
180
181 DEFINE ASCIZ$ (S)
182
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$ ;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 ;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 ;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$
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,
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$
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$
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$
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$
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$
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$
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,
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, ;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,
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 >
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,
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,
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,
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,
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,
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 ; ;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,
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