mirror of
https://github.com/PDP-10/its.git
synced 2026-02-05 08:04:38 +00:00
BDAY, happy birthday dragon.
This commit is contained in:
Lars Brinkhoff
committed by
Eric Swenson
Eric Swenson
parent
4db412b320
commit
82a94fc0d0
378
src/sysen1/bday.74
Executable file
378
src/sysen1/bday.74
Executable file
@@ -0,0 +1,378 @@
|
||||
; -*-Midas-*-
|
||||
|
||||
title BDAY - Happy Birthday Demon.
|
||||
|
||||
a=1
|
||||
b=2
|
||||
c=3
|
||||
d=4
|
||||
e=5
|
||||
t=6
|
||||
tt=7
|
||||
|
||||
ct=13 ; counter
|
||||
ent=14 ; current entry
|
||||
siz=15 ; size of current entry
|
||||
n=16 ; pointer into NAMES
|
||||
p=17 ; pdl ptr
|
||||
|
||||
; Channels
|
||||
lsrch==1 ; for LSRTNS
|
||||
urkch==2 ; for CRASH
|
||||
out=8 ; normal output
|
||||
|
||||
; Instructions
|
||||
call=:pushj p,
|
||||
return=:popj p,
|
||||
jcall==:jrst
|
||||
tyo=:.iot out,
|
||||
|
||||
; Flags (in 0)
|
||||
flags==0
|
||||
%fnick==1_17. ; nickname used
|
||||
%fname==1_16. ; name used
|
||||
%fntur==1_15. ; not a turist
|
||||
|
||||
define syscall name,args
|
||||
.call [setz ? sixbit /name/ ? args(400000)]
|
||||
termin
|
||||
|
||||
define princ &string&
|
||||
move t,[440700,,[ascii string]]
|
||||
movei tt,.length string
|
||||
.call siot
|
||||
call crash
|
||||
termin
|
||||
|
||||
define terpri
|
||||
tyo [^M]
|
||||
tyo [^J]
|
||||
termin
|
||||
|
||||
define save locs
|
||||
irp loc,,[locs]
|
||||
push p,loc
|
||||
termin
|
||||
termin
|
||||
|
||||
define restore locs
|
||||
irp loc,rest,[locs]
|
||||
restore [rest]
|
||||
pop p,loc
|
||||
.istop
|
||||
termin
|
||||
termin
|
||||
|
||||
lpdl==100.
|
||||
.vector pdl(lpdl)
|
||||
|
||||
lbuffer==500.
|
||||
.vector buffer(lbuffer) ; buffer for small strings
|
||||
.scalar bufptr ; pointer to start of free string space
|
||||
.scalar bufct ; count of space free in buffer
|
||||
|
||||
.scalar today ; todays month and day
|
||||
|
||||
n.flags==0 ; name table entry format
|
||||
n.uname==1
|
||||
n.name==2
|
||||
n.length==3
|
||||
ln==4
|
||||
lnames==ln*100. ; room for 100. people
|
||||
.vector names(lnames) ; name table
|
||||
.scalar nnames ; number of entries
|
||||
|
||||
go: .core ffpage
|
||||
call crash
|
||||
move p,[-lpdl,,pdl-1]
|
||||
move t,[440700,,buffer]
|
||||
movem t,bufptr
|
||||
movei t,lbuffer*5
|
||||
movem t,bufct
|
||||
call datime"timget
|
||||
camn a,[-1]
|
||||
call crash
|
||||
and a,[datime"tm%day\datime"tm%mon]
|
||||
movem a,today
|
||||
movei a,lsrch
|
||||
move b,[ffpage-400,,ffpage]
|
||||
call lsrtns"lsrmap
|
||||
call crash
|
||||
.close lsrch,
|
||||
move b,lsrtns"lsradr
|
||||
move b,lsrtns"hdrdta(b)
|
||||
call lsrtns"lsrget
|
||||
call crash
|
||||
move ent,b
|
||||
movei n,names
|
||||
setzm nnames
|
||||
|
||||
loop: hlrz siz,(ent)
|
||||
jumpe siz,report
|
||||
movei a,lsrtns"i$brth
|
||||
call item
|
||||
jrst next
|
||||
move d,a
|
||||
call datime"engdat
|
||||
jrst next
|
||||
and a,[datime"tm%day\datime"tm%mon]
|
||||
came a,today
|
||||
jrst next
|
||||
tro %fnick\%fname\%fntur
|
||||
movei a,lsrtns"i$grp
|
||||
call item
|
||||
jrst nogrp
|
||||
ildb b,a
|
||||
cain b,"T
|
||||
trz %fntur
|
||||
nogrp: movei a,lsrtns"i$unam
|
||||
call item
|
||||
call crash
|
||||
aos nnames
|
||||
movem a,n.uname(n)
|
||||
movei a,lsrtns"i$nick
|
||||
call item
|
||||
jrst nonick
|
||||
call search
|
||||
jrst nonick
|
||||
jumpe e,win
|
||||
cain e,54 ; comma
|
||||
jrst win
|
||||
nonick: trz %fnick
|
||||
movei a,lsrtns"i$name
|
||||
call item
|
||||
jrst noname
|
||||
move b,bufptr
|
||||
call lsrtns"lsrnam
|
||||
jrst noname
|
||||
move a,bufptr
|
||||
call search
|
||||
jrst noname
|
||||
caie e,40 ; space
|
||||
jrst noname
|
||||
movem b,bufptr
|
||||
movni t,1(d)
|
||||
addb t,bufct
|
||||
caige t,200. ; room for 200. characters?
|
||||
call crash
|
||||
jrst win
|
||||
|
||||
noname: trz %fname
|
||||
move a,n.uname(n)
|
||||
call zlen
|
||||
move d,tt
|
||||
win: movem flags,n.flags(n)
|
||||
movem a,n.name(n)
|
||||
movem d,n.length(n)
|
||||
addi n,ln
|
||||
cail n,names+lnames
|
||||
call crash
|
||||
next: add ent,siz
|
||||
jrst loop
|
||||
|
||||
; A (arg, val): ascii string
|
||||
; B (val): bp to terminating character.
|
||||
; D (val): count of letters
|
||||
; E (val): terminating character
|
||||
; Skips if at least two letters found
|
||||
search: move b,a
|
||||
setzi d,
|
||||
srch1: ildb e,b
|
||||
cail e,"a
|
||||
caile e,"z
|
||||
skipa
|
||||
aoja d,srch1
|
||||
cail e,"A
|
||||
caile e,"Z
|
||||
skipa
|
||||
aoja d,srch1
|
||||
cail e,"0
|
||||
caile e,"9
|
||||
skipa
|
||||
aoja d,srch1
|
||||
cail d,2
|
||||
aos (p)
|
||||
return
|
||||
|
||||
report: call open
|
||||
princ "HIPY-PAPY-BTHUTHDTH-THUTHDA-BTHUTHDY"
|
||||
call subject
|
||||
princ "Today's Birthdays"
|
||||
call text
|
||||
movei n,names
|
||||
skiple ct,nnames
|
||||
jrst rprt0
|
||||
princ "No birthdays today!"
|
||||
terpri
|
||||
call close
|
||||
call die
|
||||
|
||||
rprtlp: addi n,ln
|
||||
terpri
|
||||
rprt0: sojl ct,wish
|
||||
move a,n.uname(n)
|
||||
call zprint
|
||||
princ " ("
|
||||
move t,n.name(n)
|
||||
move tt,n.length(n)
|
||||
.call siot
|
||||
call crash
|
||||
princ ")"
|
||||
move flags,n.flags(n)
|
||||
trnn %fntur
|
||||
jrst [ princ " T"
|
||||
jrst .+1]
|
||||
trne %fnick
|
||||
jrst rprtlp
|
||||
trne %fname
|
||||
jrst [ princ " +"
|
||||
jrst rprtlp]
|
||||
princ " *"
|
||||
jrst rprtlp
|
||||
|
||||
wish: call close
|
||||
skipn wishsw
|
||||
call die
|
||||
movei n,names
|
||||
skipa ct,nnames
|
||||
wishlp: addi n,ln
|
||||
sojl ct,wishz
|
||||
move flags,n.flags(n)
|
||||
trnn %fntur
|
||||
jrst wishlp
|
||||
call open
|
||||
move a,n.uname(n)
|
||||
call zprint
|
||||
call subject
|
||||
princ "Happy Birthday!"
|
||||
call text
|
||||
princ "Happy birthday to you,
|
||||
Happy birthday to you,
|
||||
Happy birthday dear "
|
||||
move t,n.name(n)
|
||||
move tt,n.length(n)
|
||||
.call siot
|
||||
call crash
|
||||
princ ",
|
||||
Happy birthday to you.
|
||||
"
|
||||
call close
|
||||
jrst wishlp
|
||||
|
||||
wishz: call die
|
||||
|
||||
open: syscall open,[[.uao,,out] ? [sixbit /dsk/]
|
||||
[sixbit /_bday_/] ? [sixbit /output/] ? outdir]
|
||||
call crash
|
||||
princ "FROM-PROGRAM:BDAY
|
||||
AUTHOR:DRAGON
|
||||
HEADER-FORCE:RFC733
|
||||
RCPT:"
|
||||
return
|
||||
|
||||
subjec: princ "
|
||||
SUBJECT:"
|
||||
return
|
||||
|
||||
text: princ "
|
||||
TEXT;-1
|
||||
"
|
||||
return
|
||||
|
||||
close: syscall renmwo,[movei out ? [sixbit /mail/] ? [sixbit />/]]
|
||||
call crash
|
||||
.close out,
|
||||
return
|
||||
|
||||
datime"$$inf==1
|
||||
datime"$$out==1
|
||||
.insrt dsk:syseng;datime
|
||||
|
||||
; A (arg): time word
|
||||
datprt: move d,bufptr
|
||||
call datime"datasc
|
||||
move a,bufptr
|
||||
jcall zprint
|
||||
|
||||
lsrtns"$$ulnm==0
|
||||
lsrtns"$$ulnp==0
|
||||
lsrtns"$$ovly==0
|
||||
.insrt dsk:syseng;lsrtns
|
||||
|
||||
; A (arg): item number
|
||||
; A (val): asciz string
|
||||
item: move b,ent
|
||||
call lsrtns"lsritm
|
||||
return
|
||||
hop: aos (p)
|
||||
cpopj: return
|
||||
|
||||
; A (arg, val): asciz string
|
||||
zprint: call zlen
|
||||
move t,a
|
||||
.call siot
|
||||
call crash
|
||||
return
|
||||
|
||||
; A (arg, val): asciz string
|
||||
; TT (val): its length
|
||||
zlen: setzi tt,
|
||||
move e,a
|
||||
lngth1: ildb t,e
|
||||
jumpe t,cpopj
|
||||
aoja tt,lngth1
|
||||
|
||||
.scalar crashx,bchn,bchnst,losepc
|
||||
|
||||
; AAAIIIIEEEEE!!!!!!
|
||||
crash: skipe debug
|
||||
jrst crash1
|
||||
.core ffpage
|
||||
call die ; ???
|
||||
.suset [.rbchn,,bchn]
|
||||
syscall status,[move bchn ? movem bchnst]
|
||||
jfcl
|
||||
syscall open,[[.uio,,urkch] ? [sixbit /dsk/]
|
||||
[sixbit /bday/] ? [sixbit />/] ? [sixbit /crash/]]
|
||||
call die ; ???
|
||||
setz crashx
|
||||
push p,0 ; PDUMP misses the flags...
|
||||
syscall pdump,[movei %jself ? movei urkch ? crashx]
|
||||
call die ; ???
|
||||
.iot urkch,[jrst crashr]
|
||||
.iot urkch,[jrst crashr]
|
||||
.close urkch,
|
||||
call die
|
||||
|
||||
crashr: pop p,0
|
||||
crash1: pop p,losepc
|
||||
sos losepc
|
||||
sos losepc
|
||||
syscall lose,[movei 0 ? losepc]
|
||||
.lose %lssys
|
||||
|
||||
die: skipe debug
|
||||
.value
|
||||
.logout 1,
|
||||
|
||||
siot: setz
|
||||
sixbit /siot/
|
||||
movei out
|
||||
move t
|
||||
setz tt
|
||||
|
||||
monlen: 31. ? 29. ? 31. ? 30. ? 31. ? 30.
|
||||
31. ? 31. ? 30. ? 31. ? 30. ? 31.
|
||||
|
||||
cnstnt:
|
||||
constants
|
||||
variables
|
||||
|
||||
outdir: sixbit /.mail./ ; directory to write mail queue files
|
||||
debug: 0 ; Non-0 => dubug mode
|
||||
wishsw: -1 ; Non-0 => actually send messages
|
||||
|
||||
ffpage==:<<.-1>_-10.>+1
|
||||
ffaddr=:ffpage_10.
|
||||
|
||||
end go
|
||||
Reference in New Issue
Block a user