From 82a94fc0d019ba606b0eed56ca20cf4360fd6e6b Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Fri, 24 Feb 2017 22:31:38 +0100 Subject: [PATCH] BDAY, happy birthday dragon. --- README.md | 1 + build/build.tcl | 5 + src/sysen1/bday.74 | 378 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 384 insertions(+) create mode 100755 src/sysen1/bday.74 diff --git a/README.md b/README.md index 0aaddc22..9c791d3a 100644 --- a/README.md +++ b/README.md @@ -110,6 +110,7 @@ A list of [known ITS machines](doc/machines.md). - ATSIGN DEVICE, load device drivers. - ATSIGN TARAKA, starts dragons. - ATSIGN TCP, TCP support. + - BDAY, happy birthday demon. - BINPRT, display information about binary executable file. - BITPRT, print JCL as bits. - BYE, say goodbye to user. Used in LOGOUT scripts. diff --git a/build/build.tcl b/build/build.tcl index 20638989..2ee8603c 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -849,6 +849,11 @@ respond "*" ":kill\r" respond "*" ":link sys;atsign pword,sysbin;pword bin\r" respond "*" ":link sys;ts panda,sysbin;panda bin\r" +# bday +respond "*" ":midas sysbin;_sysen1;bday\r" +expect ":KILL" +respond "*" ":link dragon;bday daily,sysbin;bday bin\r" + # sender respond "*" ":midas sysbin;sender_sysen1;sender\r" expect ":KILL" diff --git a/src/sysen1/bday.74 b/src/sysen1/bday.74 new file mode 100755 index 00000000..5773ea58 --- /dev/null +++ b/src/sysen1/bday.74 @@ -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