$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created:
$!  Name : PRIMARY_SECONDARY_DAYS
$!  By   : mark.berryman@MVB.SAIC.COM
$!  Date : 31-MAR-1994 01:17:02.65
$!  Using: VMS_SHARE 8.4, (C) 1993 Andy Harper, Kings College London UK
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek 
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. DAY.MAR;1
$!
$ set="set"
$ set symbol/scope=(nolocal,noglobal)
$ f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$ e="write sys$error  ""%UNPACK"", "
$ w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ if f$getsyi("CPU") .gt. 127 then $ goto start
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes,P4=size
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped"
$ delete 'f'*
$ exit
$dirok:
$ x=f$search(P1)
$ if x .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped"
$ delete 'f'*
$ exit
$file_absent:
$ w "-I-UNPACK, Unpacking ", P5, " of ", P6, " - ", P1, " - ", P4, " Blocks"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT/NOJOURNAL 'f'/OUT='n'
PROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t,
SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE;PROCEDURE SkipPartsep LOCAL m;
LOOP m:=MARK(NONE);EXITIF m=END_OF(b);DELETE(m);EXITIF INDEX(ERASE_LINE,
"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE ProcessLine LOCAL c,s,l,b,
n,p;c := ERASE_CHARACTER(1);s := ERASE_LINE;IF c = "X" THEN SPLIT_LINE; ENDIF;
MOVE_HORIZONTAL(-1);l := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);
p := p+1;CASE c FROM ' ' TO '`' ['`']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2;[
' ']: p:=p+1;[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE;
PROCEDURE Decode LOCAL m;POSITION(BEGINNING_OF(b));LOOP m:=MARK(NONE);EXITIF m=
END_OF(b);DELETE(m);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=
1 THEN SkipPartSep;ELSE ProcessLine;MOVE_HORIZONTAL(1);ENDIF;ENDLOOP;
ENDPROCEDURE;SET(FACILITY_NAME,"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,
OFF);t:="0123456789ABCDEF";f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,GET_INFO(COMMAND_LINE,"output_file"));
QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ endsubroutine
$start:
$!
$ create 'f'
X`09.TITLE`09Day
X`09.IDENT`09'V1.0'
X
X;`20Author:
X;`20`20`20Jonathan`20Welch`20(jhwelch@ecs.umass.edu)
X;
X;`20Creation`20Date:
X;`20`20`2024-Mar-1994
X;
X;`20Purpose:
X;`20`20`20Indicate`20if`20today`20is`20a`20primary`20or`20seconday`20day`20for
V`20a`20given`20user
X;`20`20`20or`20if`20a`20system-wide`20setting`20has`20been`20established.
X;
X;`20Compilation:
X;`20`20`20$`20MACRO`20day
X;`20`20`20$`20LINK`20day
X;
X;`20Command`20definition:
X;`20`20`20Establish`20a`20foreign`20command`20pointing`20to`20the`20program.
V`20`20e.g.
X;`20`20`20$`20DAY`20:==`20$DISK:`5Bdir`5Dday
X;
X;`20Usage:
X;`20`20`20$`20DAY`20`5Busername`5D
X;
X;`20Note:
X;`20`20`20Only`20accounts`20with`20SYSPRV`20or`20GRPPRV`20can`20supply`20a`20u
Vsername`20that`20is`20different
X;`20`20`20than`20the`20one`20running`20the`20program.
X;
X
X`09$DSCDEF
X`09$JPIDEF
X`09$UAIDEF
X
X`09.LINK`09'SYS$SYSTEM:sys.stb'/selective_search
X
X`09.PSECT`09Data,`20NOEXE,`20LONG,`20WRT
X
XDay:`09`09.BLKL`091
X
XLn:`09`09.WORD`09512
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.BYTE`20`20`20DSC$K_DTYPE_T
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.BYTE`20`20`20DSC$K_CLASS_S
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.ADDRESS`20Ln_Buffer
XLn_Buffer:`09.BLKB`09512
X
XGetjpi:`09`09.LONG`097
X`09`09.LONG`090
X`09`09.LONG`090
X`09`09.LONG`090
X`09`09.ADDRESS`20Jpi_Itmlst
X`09`09.ADDRESS`20Iosb
X`09`09.LONG`090
X`09`09.LONG`090
XJpi_Itmlst:`09.WORD`0912
X`09`09.WORD`09JPI$_USERNAME
X`09`09.ADDRESS`20Username_Buffer
X`09`09.LONG`090
X`09`09.LONG`090
XIosb:`09`09.BLKQ`091
XUsername:`09.WORD`0912
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.BYTE`20`20`20DSC$K_DTYPE_T
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.BYTE`20`20`20DSC$K_CLASS_S
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.ADDRESS`20Username_Buffer
XUsername_Buffer:.BLKB`0912
X
XGetuai:`09`09.LONG`097
X`09`09.LONG`090
X`09`09.LONG`090
X`09`09.ADDRESS`20Username
X`09`09.ADDRESS`20Uai_Itmlst
X`09`09.LONG`090
X`09`09.LONG`090
X`09`09.LONG`090
XUai_Itmlst:`09.WORD`094
X`09`09.WORD`09UAI$_PRIMEDAYS
X`09`09.ADDRESS`20Primedays
X`09`09.LONG`090
X`09`09.LONG`090
XPrimedays:`09.BLKL`091
X
XCtrstr_User:`09.ASCID`09'Today`20is`20a`20!AS`20day`20for`20!AS'
XCtrstr_Sys:`09.ASCID`09'Today`20is`20a`20!AS`20day`20system-wide'
XOutbuf:`09`09.WORD`0980
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.BYTE`20`20`20DSC$K_DTYPE_T
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.BYTE`20`20`20DSC$K_CLASS_S
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20.ADDRESS`20Outbuf_Buffer
XOutbuf_Buffer:`09.BLKB`0980
XPrimary:`09.ASCID`09'primary'
XSecondary:`09.ASCID`09'secondary'
X
X`09.PSECT`09Code,`20EXE,`20LONG,`20NOWRT
X`09.ENTRY`09Display_Day,`20`5EM<R2>
X
X`09PUSHAL`09Day
X`09PUSHL`09#0
X`09CALLS`09#2,`20G`5ELIB$DAY_OF_WEEK
X`09BLBS`09R0,`2010$
X`09BRW`09900$
X10$:`09DECL`09Day`09;`20Days`20of`20week`20run`201-7,`20but`20bit`20positions
V`20are`200-6.
X
X`09PUSHAW`09Ln`09;`20Username`20supplied?
X`09PUSHL`09#0
X`09PUSHAQ`09Ln
X`09CALLS`09#3,`20G`5ELIB$GET_FOREIGN
X`09BLBS`09R0,`2020$
X`09BRW`09900$
X20$:`09TSTW`09Ln
X`09BEQL`0930$
X
X`09MOVQ`09Ln,`20Username
X`09BRB`0950$
X
X;`20No`20username`20was`20supplied`20on`20the`20command`20line,`20so`20default
V`20to`20the`20user
X;`20running`20the`20program.
X30$:`09CALLG`09Getjpi,`20SYS$GETJPIW
X`09BLBS`09R0,40$
X`09BRW`09900$
X40$:`09BLBS`09Iosb,`2050$
X`09BRW`09900$
X
X50$:`09CALLG`09Getuai,`20G`5ESYS$GETUAI
X`09BLBS`09R0,`2060$
X`09BRW`09900$
X
X60$:`09PUSHAQ`09Username`09`09;`20Might`20be`20orphaned`20on`20the`20stack.
X`09CLRL`09R2`09`09`09`09`09;`20Mode`20flag.
X`09BBC`09#EXE$V_EXPLICITS,`20EXE$GL_FLAGS,`2070$`09;`20Not`20explicitly`20set.
V
X`09MOVL`09#1,`20R2
X`09BBC`09#EXE$V_EXPLICITP,`20EXE$GL_FLAGS,`2080$`09;`20Is`20prime.
X`09BRB`0990$`09`09`09`09`09;`20Isn't`20prime.
X
X70$:`09BBS`09Day,`20Primedays,`2090$
X
X80$:`09PUSHAQ`09Primary
X`09BRB`09100$
X
X90$:`09PUSHAQ`09Secondary
X
X100$:`09PUSHAQ`09Outbuf
X`09PUSHAW`09Outbuf
X
X`09TSTL`09R2`09`09;`20Is`20there`20an`20overriding`20system-wide`20setting?
X`09BEQL`09110$`09`09;`20No.
X
X`09PUSHAQ`09Ctrstr_Sys`09;`20Yes.
X`09CALLS`09#4,`20SYS$FAO
X`09BRB`09120$
X
X110$:`09PUSHAQ`09Ctrstr_User
X`09CALLS`09#5,`20SYS$FAO
X120$:`09BLBC`09R0,`20900$
X
X`09PUSHAQ`09Outbuf
X`09CALLS`09#1,`20G`5ELIB$PUT_OUTPUT
X`09BLBC`09R0,`20900$
X
X800$:`09MOVL`09#SS$_NORMAL,`20R0
X900$:`09RET
X
X`09.END`09Display_Day
$ call unpack DAY.MAR;1 963594576 "" 6 1 1 
$ v=f$verify(v)
$ exit