Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
10,7/amis/pom.mid
There are no other files named pom.mid in the archive.
	TITLE	POM - Phase Of the Moon routine for AMIS
DEFINE	gtad	; Define the GTAD JSYS as a macro under Bottoms-10
	PUSHJ	P,.gtad
TERMIN
a=1
b=2
c=3
d=4
e=5
pomptr=6
p=17
call=PUSHJ P,
strsize=40
	.GLOBAL	getpom
	.DECTW
.qmtch==1
; The following routine was extracted from ITS TECO for Twenex
; by L-H "Krsna" Eriksson.
; Type out phase of the moon
pom:	GTAD
	SUB	A,synofs		; Offset to nearest new moon to day 0
	IDIV	A,synp			; Divide into quarter periods
	ANDI	A,3			; Get period
	MOVEI	A,phsnms(A)
	CALL	ascind			; Type its name
	MULI	B,24.*60.*60.		; Convert to seconds
	LSH	C,1			; Flush duplicate sign bit
	LSHC	B,17.			; Get one word product
	MOVEI	E,tdhmst
tdhms1:	IDIVI	B,@(E)
	JUMPE	B,tdhms2
	HRLM	C,(P)
	CALL	[AOJA E,tdhms1]		; Increment and recurse
	HLRZ	C,(P)
tdhms2:	CALL	dpt			; Type it in decimal
	HLLZ	A,(E)
	SOJA	E,sixin1		; Back up, type and return
; Use some other output routine, such as sixnty or ascind.
phsnms:	ASCII	/NM+/
	ASCII	/FQ+/
	ASCII	/FM+/
	ASCII	/LQ+/
tdhmst:	SIXBIT	/S./+60.
	SIXBIT	/M./+60.
	SIXBIT	/H./+24.
	SIXBIT	/D./+<,-1>
synp:	<29.53059&<777,,-1>>_-6		; Length of quarter in GTAD units
synofs:	22,,253553			; 18 days and a bit
; End of code copied from ITS TECO
; To get the date in GTAD format, we do a GETTAB.
.gtad:	MOVE	1,[%CNDTM]
	GETTAB	1,		; Get time and date in universal format.
	 JFCL
	POPJ	P,		; return.
; The following routines are used by POM to return its results.
ascind:	HRLI	A,440700		; Make a byte pointer
	ILDB	A-1,A			; Get a byte
	JUMPN	A-1,[			; Quit if all done
		IDPB	A-1,pomptr	; Dump it
		JRST	ascind+1]	; ..and loop a bit
	POPJ	P,
sixin1:	SETZ	A-1,			; Zero character ac
	LSHC	A-1,6			; Get 1st SIXBIT character
	JUMPN	A-1,[			; Quit if all done
		ADDI	A-1," "		; Make it ASCII
		IDPB	A-1,pomptr	; Dump it
		JRST	sixin1]		; ..and loop a bit.
	POPJ	P,
dpt:	IDIVI	C,12			; Extract last digit
	HRLM	D,(P)			; A hack.
	SKIPE	C			; Done?
	 CALL	dpt			; Recurse
	HLRZ	D,(P)			; Another hack
	ADDI	D,"0"			; Make a digit
	IDPB	D,pomptr		; Dump it
	POPJ	P,			; ..and return
getpom:	MOVE	pomptr,2		; Get string pointer from PASCAL
	HRLI	2,[.BYTE 7	
		REPEAT STRSIZE,[" "
]
		.BYTE]
	BLT	2,<STRSIZE/5>-1(pomptr)	; Blank out the string
	HRLI	pomptr,440700		; Make a byte pointer
	JRST	pom			; Call the ITS POM routine
	END