Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/ti.fai
There are no other files named ti.fai in the archive.
title	TI

search	monsym
asuppress

subttl	Definitions

bugger==1				;debug switch

A=1
B=2
C=3
D=4
E=5
P=17					;stack
pdepth==20
stack:	block	pdepth
opdef	call	[pushj P,]
opdef	ret	[popj P,]
opdef	calret	[jrst]

cr==15					;general constants
lf==12

i== 6
for n in (year,month,date,day,hour,minute,buffon)  {  n== i  i== i+1  }

define xx (name,offset,args) <
	name= .-offset
	for n in (args)  {
		point 7,[asciz "n"]
	}
>

xx(ones,1,<one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen>)
xx(tens,2,<twenty,thirty,forty,fifty,sixty,seventy,eighty,ninety>)
xx(rank,1,<first,second,third,fourth,fifth,sixth,seventh,eighth,ninth,tenth,eleventh,twelfth>)
xx(days,0,<Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday>)
xx(months,0,<January,February,March,April,May,June,July,August,September,October,November,December>)

linlen== =80/5

line:	block	linlen			;message buffer
line2:	block   linlen			;second line of message
tmpbuf:	block	linlen			;temporary buffer

redata::				;Data that needs to be reinitialized

;>>Tricky<<
;We assume the data is initially in the desired starting state.  The first
;initialization just takes a snapshot of all the data starting at REDATA
;onwards, storing it into INIBL.  We want subsequent inits to copy from
;INIBL back to REDATA.  So we want INITI to change into REINI, which we
;accomplish by placing REINI at the end of the data and INIBL on top of
;INITI, and then allowing INITI to copy REINI along with all the data, right
;onto the original version of INITI.

ifn .-redata,<
reini:	move	0,[inibl,,redata]	;This is the real initializer.
	blt	0,reini-1

inibl:	block	reini-redata		;storage for snapshot.

initi:	move	0,[redata,,inibl] ;Initial initializer self-initializes INITI.
	blt	0, .
> ;ifn
ifndef initi,<
initi:
> ;ifndef
	ret
subttl	General purpose

	idpb	C,A		;Copy from string B to string A, using
copy:	ildb	C,B		;  C for the characters in transit.
	jumpn	C,.-2		;Copies up to but not including the
	ret			;  null byte.  Handles null string.

messy0:	setz	C,0			;Deposit a null to terminate string.
	idpb	C,A
messy:	hrroi	A,line			;Output message buffer to terminal.
	PSOUT%
	ret	

crlf:	movei	C,cr			;Deposit CR and LF into buffer.
	idpb	C,A
	movei	C,lf
	idpb	C,A
	ret
subttl	Ti

getim:	seto	B,-1
	setz	D,0
	ODCNV%
	hlrz	year,B
	hrrz	month,B
	hlrz	date,C
	addi	date,1
	hrrz	day,C
	movei	hour,=30(D)	;seconds rounded to nearest minute
	idivi	hour,=60	;seconds to minutes
	idivi	hour,=60	;minutes to hours and minutes
	ret

numstr:	caig	B,=19
	 calret	[ move B,ones(B)
		  calret copy ]
	idivi	B,=10
numst1:	move	B,tens(B)
	jumpe	C,copy
	move	D,C
	call	copy
	movei	C,"-"
	idpb	C,A
	move	B,ones(D)
	calret	copy

nthstr:	caig	B,=12
	 calret	[ move B,rank(B)
		  calret copy ]
	caig	B,=19
	 calret	[ move B,ones(B)
		  call copy
		  movei C,"t"
		  idpb C,A
		  movei C,"h"
		  idpb C,A
		  ret ]
	idivi	B,=10
	move	B,tens(B)
	move	D,C
	call	copy
	jumpe	D,[ movei C,"i"
		    dpb C,A
		    move B,[point 7,[asciz "eth"]]
		    calret copy ]
	movei	C,"-"
	idpb	C,A
	move	B,rank(D)
	calret	copy

minout:	move	B,[point 7,[asciz "It's "]]
	call	copy
	jumpe	minute,[ move B,[point 7,[asciz "exactly "]]
			 calret copy ]
	caile	minute,=30
	 jrst	min31
	cain	minute,=30
	 calret	[ move B,[point 7,[asciz "half past "]]
		  calret copy ]
	cain	minute,1
	 calret	[ move B,[point 7,[asciz "a minute after "]]
		  calret copy ]
	cain	minute,=15
	 calret	[ move B,[point 7,[asciz "a quarter past "]]
		  calret copy ]
	move	B,minute
	call	numstr
	move	B,[point 7,[asciz " after "]]
	calret	copy
min31:	move	B,hour
	addi	B,1
	idivi	B,=24
	move	hour,C
	cain	minute,=45
	 calret	[ move B,[point 7,[asciz "a quarter till "]]
		  calret copy ]
	cain	minute,=59
	 calret	[ move B,[point 7,[asciz "a minute till "]]
		  calret copy ]
	movei	B,=60
	sub	B,minute
	call	numstr
	move	B,[point 7,[asciz " till "]]
	calret	copy

hrout:	jumpe	hour,[ move B,[point 7,[asciz "midnight"]]
		       callret copy ]
	cain	hour,=12
	 calret	[ move B,[point 7,[asciz "noon"]]
		  calret copy ]
	caig	hour,=12
	 calret [ move B,ones(hour)
		  call copy
		  move B,[point 7,[asciz " in the morning"]]
		  calret copy ]
	subi	hour,=12
	move	B,ones(hour)
	call	copy
	caige	hour,6
	 calret	[ move B,[point 7,[asciz " in the afternoon"]]
		  calret copy ]
	move	B,[point 7,[asciz " in the evening"]]
	calret	copy

dayout:	move	B,[point 7,[asciz " on "]]
	call	copy
	move	B,days(day)
	calret	copy

datout:	move	B,[point 7,[asciz ", the "]]
	call	copy
	move	B,date
	calret	nthstr

monout:	move	B,[point 7,[asciz " of "]]
	call	copy
	move	B,months(month)
	calret	copy

yrout:	movei	C,","
	idpb	C,A
	movei	C," "
	idpb	C,A
	move	B,year
	idivi	B,=100
	move	E,C
	call	cent
	jumpe	E,[ret]
	move	B,[point 7,[asciz " and "]]
	call	copy
	move	B,E
	calret	numstr

cent:	move	D,B
	idivi	B,=10
	jumpe	C,[ call numstr
		    move B,[point 7,[asciz " thousand"]]
		    calret copy ]
	move	B,D
	call	numstr
	move	B,[point 7,[asciz " hundred"]]
	calret	copy

format:	move	B,[point 7,[byte(7) ".",cr,lf]]
	call	copy
	idpb	C,A			;Include the null byte.
	hrrz	B,A
	caige	B,line2
	 calret	messy
	move	B,[point 7,line2]
adjlp:	seto	D,-1			;Decrement BP in B.
	adjbp	D,B
	move	B,D
	ldb	C,B
	caie	C," "
	 jrst	adjlp
	move	A,[point 7,tmpbuf]
	call	copy
	idpb	C,A
	move	A,D
	movei	C,cr
	dpb	C,A			;Use BP from adjlp.
	movei	C,lf
	idpb	C,A
	move	B,[point 7,tmpbuf]
	call	copy
	calret	messy0+1

ti:	call	getim
	move	A,[point 7,line]
	call	minout
	call	hrout
	call	dayout
	call	datout
	call	monout
	call	yrout
	calret	format
subttl	Main

main:
start::	RESET%
	move	P,[iowd pdepth+1,stack]
	call	initi
	call	ti
stop::	HALTF%
	jrst	main

end	main