$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.2
$!   On  5-FEB-1993 14:56:26.04   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- December 1992
$!
$! 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. CALENDAR_TSR.MAR;1
$!       2. TSR.DESC;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 = "!"
$ 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
$ 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 file ", P1
$ 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 '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 LOOP EXITIF MARK(NONE)=END_OF(b);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 POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=END_OF(b);
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;`20CALENDAR_TSR.MAR`09`09Paul`20Klissner`09`09`201990
X;
X;`20The`20following`20program`20draws`20a`20one`20month`20calendar`20in`20the
V`20upper
X;`20right`20hand`20corner`20of`20the`20screen`20whenever`20the`20user`20presse
Vs`20the`20CTRL/D
X;`20key`20at`20the`20terminal.`20(The`20calendar`20display`20format`20is`20ill
Vustrated`20below).
X;
X;`20The`20time`20and`20current`20day`20of`20the`20month`20are`20highlighted
V`20on`20the
X;`20screen`20for`20added`20information`20and`20impact.
X;
X;`20The`20code`20that`20follows`20creates`20a`20self-contained`20TSR.`20`20It
V`20consists`20of
X;`20loader`20and`20unloader`20sections,`20as`20well`20as`20a`20calendar`20draw
Ving`20procedure
X;`20that`20gets`20relocated`20into`20P1`20space.
X;
X;
X;`20Example:
X;
X;
X;`09`20`20`20`20`20`20`20Mar.`20`2012:45`20pm`20`201991
X;`09`20`20`20`20`20`20`20Su`20Mo`20Tu`20We`20Th`20Fr`20Sa
X;`09`09`09`20`20`20`20`20`20`201`20`202
X;`09`093`20`204`20`205`20`206`20`207`20`208`20`209
X;`09`20`20`20`20`20`20`2010`2011`2012`2013`2014`2015`2016
X;`09`20`20`20`20`20`20`2017`2018`2019`2020`2021`2022`2023
X;`09`20`20`20`20`20`20`2024`2025`2026`2027`2028`2029`2030
X;`09`20`20`20`20`20`20`2031
X;
X;
X;---
X
X.library`20'sys$library:lib'
X.link`09`20'sys$system:sys.stb'
X
X$lnmdef
X
X
X;`20Modifiable`20parameter`20(specifies`20the`20TSR`20activation`20key):
X
X`09trap_key`20`20`20`20`20=`20`5Ea'D'`20-`2064`20`20`20`20`20`20`20;`20(CTRL/D
V)
X
X
X;`20The`20following`20macros`20create`20conditional`20branchs`20that`20have
V`20destinations
X;`20more`20than`20127`20bytes`20away.
X
X.macro`09BGTRU_W`20dest,?next
X`09blequ`09next
X`09brw`09dest
Xnext:
X`09.endm
X
X.macro`09BNEQU_W`20dest,?next
X`09beqlu`09next
X`09brw`09dest
Xnext:
X.endm
X
X.macro`09BLBC_W`09base,dest,?next
X`09blbs`09base,next
X`09brw`09dest
Xnext:
X.endm
X
X.macro`09BBC_W`09pos,base,dest,?next
X`09bbs`09pos,base,next
X`09brw`09dest
Xnext:
X.endm
X
X
Xmemloc:`20`09.blkl`09`09`09;`20Receives`20parse`20result
Xmemlen:`20`09.blkl`09`09`09;`20Receives`20parse`20result
Xlendescr:`09.long`204,hexlen`09`09;`20Descriptor`20for`20parsing`20logical`20n
Vame
Xlocdescr:`09.long`208,hexloc`09`09;`20Descriptor`20for`20parsing`20logical`20n
Vame
Xttname:`20`09.ascid`20'TT'`20`20`20`20`20`20`20`20`20`20`20`20`20;`20Descripto
Vr`20for`20current`20terminal
Xuserchan:`09.blkl`09`09`09;`20User`20mode`20channel`20to`20terminal
Xloadmsg:`09.ascid`20'Loaded`20CALENDAR,`20'`20;`20Residency`20message
Xnamedsc:`09.long`20132,10$`09`09`20`20`20;
X
X
X10$:`09`09.blkb`20132`09`09`20`20`20;
Xrmvname:`09.ascii`20'Removing`20CALENDAR,`20previously`20'
Xrmvname_len=.-rmvname
Xcrlf:`09`09.byte`2010,13`09`09;`20Carriage`20return/Linefeed`20bytes
X
X.entry`20MAIN,0
X
X`09$assign_s`20devnam=ttname,-`09;`20Assign`20user`20mode`20channel`20to`20ter
Vminal
X`09`09`20`20chan=userchan
X
X`09$qiow_s`20chan=userchan,-`20`09;`20Jump`20down`20one`20line
X`09`09func=#io$_writevblk,-
X`09`09p1=crlf,-
X`09`09p2=#2
X
X`09;`20****`20Now`20see`20if`20process`20TSR`20is`20loaded`20***
X
X1$:`09$trnlnm_s`20tabnam`20=`20lnm_table,-`09;Check`20process`20logical`20name
V`20table`20to
X`09`09`20`20lognam`20=`20lnm_name,-`09;see`20if`20this`20code`20is`20already
V`20resident.
X`09`09`20`20itmlst`20=`20lnm_list`09;(we`20don't`20want`20to`20load`20it`20twi
Vce)
X`09blbs`09r0,`203$`09`09`09;branch`20if`20translation`20was`20successful
X`09$cmkrnl_s`20routin`20=`20loader`09;Load`20code`20and`20table`20into`20p1
V`20space
X`09blbc`09r0,2$
X
X`09;`20****`20Display`20loaded`20message,`20if`20TSR`20was`20installed`20****
X
X`09$qiow_s`20chan=userchan,-`20`09;Display`20'loaded'`20message
X`09`09func=#io$_writevblk,-
X`09`09p1=loadmsg+8,-
X`09`09p2=loadmsg
X
X`09$qiow_s`20chan=userchan,-`20`09;Describe`20TSR`20memory`20location
X`09`09func=#io$_writevblk,-
X`09`09p1=lnm_equiv,-
X`09`09p2=#lnm_equiv_len+2
X
X2$:`09$exit_s`20r0
X
X3$:`09;`20****`20Display`20removal`20message,`20if`20TSR`20was`20previously
V`20installed`20****
X
X`09$qiow_s`20chan=userchan,-`20`09;Display`20removal`20message
X`09`09func=#io$_writevblk,-
X`09`09p1=rmvname,-
X`09`09p2=#rmvname_len
X
X`09$qiow_s`20chan=userchan,-`20`09;Describe`20previous`20location
X`09`09func=#io$_writevblk,-
X`09`09p1=lnm_equiv,-
X`09`09p2=#lnm_equiv_len+2
X
X`09;`20***`20PARSE`20LOGICAL`20NAME`20TO`20GET`20TSR`20MEMORY`20POINTER`20VALU
VES`20***
X
X`09;`20Get`20memory`20address
X`09pushl`09#4`09`09`09;#`20bytes`20to`20convert
X
X
X`09pushal`09memloc`09`09`09;Address`20of`20integer`20longword
X`09pushal`09locdescr`09`09;Address`20of`20text`20source
X`09calls`09#3,g`5Eots$cvt_tz_l`09;Convert`20from`20hex`20text`20to`20integer
X`09blbc`09r0,exit2`09`09;branch`20if`20error
X
X`09;`20Get`20memory`20size
X`09pushl`09#2`09`09`09;2`20bytes`20to`20cvt
X`09pushal`09memlen`09`09`09;Address`20of`20variable`20to`20convert`20to
X`09pushal`09lendescr`09`09;hex`20text`20length`20to`20convert`20from
X`09calls`09#3,g`5Eots$cvt_tz_l`09;convert`20from`20hex`20text`20to`20integer
X`09blbc`09r0,exit2`09`09;branch`20if`20error
X
X`09$cmkrnl_s`20routin`20=`20unloader`09;Unload`20the`20TSR
X
Xexit2:`09$exit_s`20r0`09`09`09;Exit`20with`20status
X
X;--
X;`20The`20following`20routine`20executes`20in`20Kernel`20mode.`20`20It`20alloc
Vates`20memory
X;`20for`20the`20TSR,`20and`20relocates`20the`20TSR`20it`20into`20P1`20space.
V`09It`20then`20activates
X;`20The`20TSR`20by`20calling`20it`20at`20non-AST`20level`20to`20initialize`20i
Vt.`20`20This`20routine
X;`20also`20creates`20a`20process`20private`20logical`20name`20to`20describe
V`20the`20TSR.
X;--
X.entry`20LOADER,0
X
X`09$assign_s`20devnam=ttname,-`09;get`20kernal`20mode`20channel`20to`20termina
Vl
X`09`09`20`20chan=ttkrnl
X
X1$:`09movl`09#code_size,r1`09`09;Get`20the`20size`20to`20allocate
X`09jsb`09g`5Eexe$alop1proc`20`09;Get`20memory`20to`20last`20beyond
X`09`09`09`09`09;the`20life`20of`20the`20image
X`09blbc`09r0,return`09`09;Return`20if`20we`20couldn't`20get`20the`20memory.
X`09movl`09r1,ast_memory_size`09;Save`20size`20of`20actual`20allocation
X`09movl`09r2,ast_vector`09`09;Save`20the`20address`20of`20the`20region
X
X`09movc`09#code_size,-`09`09;Copy`20ast`20code`20into`20buffer
X`09`09ast_code,-
X`09`09@ast_vector
X
X`09calls`09#0,@ast_vector`09`09;Activate`20AST`20code
X
X;`20****`20Fill`20in`20residency`20logical`20name`20with`20address`20and`20len
Vgth`20of`20TSR`20code`20****
X
X`09pushl`09#4`09`09`09;4`20bytes`20to`20convert
X`09pushl`09#8`09`09`09;8`20hex`20digits,`20minimum.
X`09pushal`09locdescr`09`09;address`20of`20target`20text
X`09pushal`09ast_vector`09`09;source`20value
X`09calls`09#4,g`5Eots$cvt_l_tz`09;convert
X`09blbc`09r0,return`09`09;branch`20if`20error
X
X`09pushl`09#2`09`09`09;2`20bytes`20to`20convert
X`09pushl`09#4`09`09`09;4`20hex`20digits,`20minimum.
X`09pushal`09lendescr`09`09;address`20of`20target`20text
X`09pushal`09ast_memory_size`20`09;source`20value
X`09calls`09#4,g`5Eots$cvt_l_tz`09;convert
X
X
X`09blbc`09r0,return`09`09;branch`20if`20error
X
X
X`09$crelnm_s`20attr`09`20=`20lnm_attributes,-`09;Create`20the`20Logical`20name
V
X`09`09`20`20tabnam`20=`20lnm_table,-
X`09`09`20`20lognam`20=`20lnm_name,-
X`09`09`20`20itmlst`20=`20lnm_list
Xreturn:`20ret
X
X;---
X;`20The`20following`20routine`20gets`20called`20in`20kernel`20mode`20to`20remo
Vve`20the`20TSR
X;`20completely`20from`20the`20process.`09Before`20being`20called,`20the`20loca
Vtion`20and`20size
X;`20of`20the`20TSR`20memory`20is`20saved`20at`20MEMLOC,`20and`20MEMLEN.`20`20T
Vhe`20logical`20name
X;`20describing`20the`20TSR`20is`20removed,`20and`20the`20kernel`20mode`20chann
Vel`20is`20deassigned.
X;`20(Note`20that`20the`20channel`20number`20is`20reserved`20at`20the`20beginni
Vng`20of`20the`20located
X;`20code`20for`20easy`20accessability).
X;--
X.entry`20UNLOADER,0
X
X;`20`20****`20`20Unloads`20the`20TSR`20from`20P1`20space,`20at`20non-ast`20lev
Vel`20****
X
X`09$dellnm_s`20tabnam=lnm_table,-`09;Delete`20the`20logical`20name
X`09`09`20`20lognam=lnm_name
X
X`09movl`09memloc,r0`09`09;Get`20the`20address`20of`20the`20tsr`20code
X`09$dassgn_s`20chan`20=`205(r0)`09`09;Remove`20the`20kernel`20mode`20channel
X`09movl`09memloc,r0`09`09;get`20the`20address`20of`20the`20tsr`20code`20again
X`09beqlu`0910$
X`09movzwl`09memlen,r1`09`09;get`20the`20length
X`09beqlu`0910$
X`09jsb`09g`5Eexe$deap1`09`09;Deallocate`20the`20code
X10$:`09ret`09`09`09`09;and`20return
X
X;---
X;`20`20Everything`20from`20this`20point`20forward`20comprises`20the`20resident
V`20code
X;`20`20and`20data`20that`20is`20be`20relocated`20into`20P1`20pool`20at`20runti
Vme.`20`20Note
X;`20`20that`20part`20of`20the`20initialization`20logic`20updates`20descriptors
V
X;`20`20with`20the`20MOVAL`20instruction`20after`20the`20code`20is`20relocated
X;`20`20so`20that`20all`20of`20the`20memory`20references`20reflect`20the`20new
V`20location
X;`20`20of`20the`20TSR`20routine.
X;---
XTSR_CODE_ADDRESS`20=`20.
X
XAST_CODE::
X
X`09;IMPORTANT:`20This`20routine`20must`20preserve`20all`20registers
X
X`09.word`20`5EM<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X
X`09;`20The`20following`20two`20lines`20must`20immediately`20follow`20the`20ent
Vry`20mask
X`09;`20so`20that`20the`20unloader`20can`20retrieve`20that`20channel`20number
V`20the`20out-of-band
X`09;`20key`20is`20assigned`20on.
X
X`09brw`09ttkrnl+4
X
X
Xttkrnl:`20.blkl
X
X
X`09tstl`09init_flag`09`09`09;`20Initialized`20yet?
X`09bnequ`091$`09`09`09`09;`20Branch`20if`20so
X`09jsb`09initialize`09`09`09;`20Otherwise`20initialize`20AST`20code
X`09ret`09`09`09`09`09;`20And`20exit
X
X`09;******************************************************************;
X`09;`20`20THIS`20CODE`20CREATES`20AND`20DISPLAYS`20A`20CALENDAR`20FOR`20THE
V`20CURRENT`20MONTH`20;
X`09;******************************************************************;
X
X1$:`09movb`09#`5Ex30,col`09`09`20`20`20`20`20`20`20;Initialize`20display`20col
Vumn
X`09moval`09col,outbuf+4`09`09`20`20`20`20`20`20`20;Get`20pointer`20to`20column
V`20text
X`09$qiow_s`20`20`20chan=ttkrnl,-`20`09`20`20`20`20`20`20`20;Get`20terminal`20c
Vharactersitics
X`09`09`20`20func=#io$_sensemode,-
X`09`09`20`20p1=ttcharbuf,-
X`09`09`20`20p2=#12
X`09blbc_w`09r0,astexit`09`09`20`20`20`20`20`20`20;Branch`20if`20error
X`09bbc_w`09#tt2$v_avo,ttcharbuf+8,astexit`20;Exit`20if`20TT`20doesn't`20have
V`20AVO
X`09extzv`09#16,#16,ttcharbuf,ttwidth`20`20`20`20`20`20;Get`20the`20terminal
V`20width
X`09subl`09#25,ttwidth`09`09`20`20`20`20`20`20`20;Subtract`20calendar`20width
V`20from
X`09`09`09`09`09`20`20`20`20`20`20`20;terminal`20width`20setting
X`09cmpl`09ttwidth,#99`09`09`20`20`20`20`20`20`20;How`20many`20digits`20in`20wi
Vdth?
X`09bgtr`095$`09`09`09`20`20`20`20`20`20`20;Branch`20if`20greater`20than`20two
X`09addl`09#1,outbuf+4`09`09`20`20`20`20`20`20`20;Shift`20descriptor`20referenc
Ve
X5$:`09$fao_s`09ctrstr=faobuf,-`20`09`20`20`20`20`20`20`20;Convert`20width`20to
V`20ASCII`20string
X`09`09outbuf=outbuf,-
X`09`09p1=ttwidth
X`09blbc_w`09r0,astexit`09`09`20`20`20`20`20`20`20;Branch`20if`20error
X
X`09$qiow_s`20chan=ttkrnl,-
X`09`09func=#io$_writevblk,-
X`09`09p1=save_pos,-
X`09`09p2=#2
X
X`09;`20***`20Fill`20in`20major`20components`20of`20the`20Calendar`20header`20*
V**
X
X`09movc5`09#0,dda,#32,#126,dda`09`09;Blank`20fill`20display`20array
X`09$asctim_s`20timbuf=systime_dsc`09`09;Get`20current`20VMS`20time
X`09movc`09#11,systime,work_date+8`20`09;Copy`20the`20current`20date
X`09movw`09#`5Ex3130,work_date+8`09`09;Adjust`20to`20be`201st`20of`20month
X`09movc`09#3,systime_mo`20,`20`20header_mo`09;Move`20month`20into`20header
X`09bisw`09#`5Ex2020,header_mo+1`09`09;2nd`20two`20digits`20to`20lower`20case
X`09movc`09#4,systime_year,`20header_year`09;Move`20year`20into`20header
X`09movl`09feb29+4,r3`09`09`09;Get`20address`20of`20FEB`2029`20string
X`09movc`09#4,systime_year,`207(r3)`09`09;Fill`20in`20year`20for`20Feb`2029`20c
Vheck
X`09movc`09#5,systime_hhmm,`20header_hhmm`09;Move`20in`20unconverted`20HH:MM
X`09$bintim_s`20timbuf=feb29,timadr=work_quad1;Check`20for`20validity
X`09blbc`09r0,7$`09`09`09`09;Branch`20if`20not`20a`20leap`20year
X`09movb`09#29,month_tbl+3`20`09`09;Make`20Feb.`20a`2029`20day`20month
X7$:`09$bintim_s`20timbuf=work_date,-`09`09;Get`20binary`20time`20for`20the
X`09`09`20`20timadr=work_quad1`09`09;`20first`20day`20of`20the`20month
X
X
X
X`09;Calculate`20the`20day`20of`20week
X`09movq`09work_quad1,r0`09`09`09;Get`20the`20current`20day
X`09ediv`09#60*10*1000*1000,r0,r0,r1`09;Get`20the`20time`20in`20min.`20from`201
V858
X`09clrl`09r1`09`09`09`09;(only`2032`20bits)
X`09ediv`09#24*60,r0,r0,r1`20`09`09;Time`20in`20days`20into`20r0
X`09addl2`09#2,r0`09`09`09`09;Nov.`2017,1858`20is`20a`20Wednesday
X`09clrl`09r1`09`09`09`09;Again`20only`2032`20bits
X`09ediv`09#7,r0,r0,r1`09`09`09;R0`20=`20#`20of`20weeks`20from`20ref.`20time.
X`09`09`09`09`09`09;R1`20=`20Day`20of`20week
X`09addl3`09#1,r1,dow`09`09`09;Adjust`20and`20save`20day`20of`20week
X
X`09;`20*****`20DETERMINE`20#`20OF`20DAYS`20IN`20CURRENT`20MONTH`20*****
X
X`09clrq`09r6`09`09`09`09;Clear`20search`20indicies
X`09moval`09months,r8`09`09`09;Addr`20of`20month`20name`20table
X8$:`09cmpc`09#3,(r8)`5Br6`5D,systime_mo`09`09;Month`20name`20match?
X`09beql`099$`09`09`09`09;Branch`20if`20so
X`09addl`09#3,r6`09`09`09`09;Check`20next`20array`20entry
X`09aobleq`09#11,r7,8$`09`09`09;Check`20next
X9$:`09movl`09month_tbl`5Br7`5D,r3`09`09;Get`20#`20of`20days`20in`20month
X
X`09;***`20Fill`20the`20calendar`20display`20array`20with`20the`20day`20number
V`20for
X`09;`20`20`20`20the`20month,`20with`20the`20first`20day`20positioned`20under
V`20the`20correct
X`09;`20`20`20`20day`20of`20the`20week.
X
X`09moval`09dda,r8`09`09`09`09;Addr.`20of`20array
X`09movq`09#1,r6`09`09`09`09;Initialize`20day`20counter
X`09mull3`09#3,dow,r2`09`09`09;Calc.`20initial`20offset`20in
X`09`09`09`09`09`09;Day`20Display`20Array`20(DDA)
X10$:`09clrq`09r4`09`09`09`09;Clear`20R4/R5
X`09ediv`09#10,r6,r4,r5`09`09`09;Get`20digits`20of`20month`20day
X`09bisl`09#`5Ex30,r4`09`09`09;Make`20high`20digit`20ASCII
X`09bisl`09#`5Ex30,r5`09`09`09;Make`20low`20digit`20ASCII
X`09cmpl`09r4,#`5Ex30`09`09`09;High`20digit`200?
X`09bnequ`0920$`09`09`09`09;Branch`20if`20not
X`09movl`09#`5Ex20,r4`09`09`09;Convert`20to`20a`20blank
X20$:`09movb`09r4,(r8)`5Br2`5D`09`09`09;Move`20into`20display`20array`20slot
X`09movb`09r5,1(r8)`5Br2`5D`09`09`09;Save`20for`20second`20digit
X`09incl`09r6`09`09`09`09;Increment`20day`20of`20month
X`09addl`09#3,r2`09`09`09`09;Point`20to`20next`20stash`20slot
X`09sobgtr`09r3,10$`09`09`09`09;Loop`20till`20day`20count`20exhausted
X
X`09;*****`20ADJUST`20DISPLAY`20TIME`20TO`20CIVILIAN`20FORMAT`20****
X
Xadjust_time:
X`09movc`09#3,amtext,header_ampm-1`20`09;Reset`20AM/PM`20text`20state
X`09bicw`09#`5Ex3030,header_hhmm`09`09;Cvt`20from`20ASCII`20HH`20to`20decimal
V`20values
X`09clrl`09r1`09`09`09`09;Zero`20the`20longword
X`09mulb3`09header_hhmm,#10,r1`09`09;Get`20high`20order`20digit`20of`20hour*10
X`09addb`09header_hhmm+1,r1`09`09;add`20in`20the`20low`20order`20digit`20HH
X`09`09`09`09`09`09;(result`20is`20integer`20value`20of`20HH)
X`09cmpl`09r1,#12`09`09`09`09;Compare`20to`20the`20hour`20of`20noon
X`09beqlu`0910$`09`09`09`09;Branch`20if`20noon`20hour`20now
X
X
X`09blssu`0920$`09`09`09`09;Branch`20if`20before`20hour`20of`20noon
X`09subl`09#12,r1`09`09`09`09;Its`20afternoon,`20cvt
X`09`09`09`09`09`09;from`20military`20time`20by
X`09`09`09`09`09`09;subtracting`2012
X`09clrl`09r2`09`09`09`09;Clean`20up`20high`20order`20part
X`09ediv`09#10,r1,r1,r2`09`09`09;Get`20High`20order`20digit`20value
X`09`09`09`09`09`09;into`20r1,`20and`20low`20order`20into`20r2
X`09movb`09r1,header_hhmm`09`09`09;Restore`20high`20order`20into
X`09`09`09`09`09`09;its`20position`20in`20time`20buffer
X`09movb`09r2,header_hhmm+1`09`09;Restore`20low`20order`20into`20time
X`09`09`09`09`09`09;buffer
X10$:`09movb`09#`5Ea"p",header_ampm`20`20`20`20`20`20`20`20`20`20`20`20`20`20;S
Vet`20to`20PM`20time
X20$:`09bisw`09#`5Ex3030,header_hhmm`09`09;Convert`20HH`20to`20displayable`20AS
VCII
X`09cmpb`09header_hhmm,#`5Ea"0"`20`20`20`20`20`20`20`20`20`20`20`20`20`20;Leadi
Vng`200?
X`09bnequ`0930$`09`09`09`09;Branch`20if`20not
X`09movb`09#`5Ea"`20",header_hhmm`20`20`20`20`20`20`20`20`20`20`20`20`20`20;If
V`20so,`20convert`20it`20to`20a`20blank
X30$:`09clrl`09r5`09`09`09`09;Line`20index
X40$:`09addb3`09#49,r5,row`09`09`09;Setup`20the`20display
X`09$qiow_s`20chan=ttkrnl,-`09`09`09;Clear`20line`20and`20position`20cursor
X`09`09func=#io$_writevblk,-
X`09`09p1=clreol,-
X`09`09p2=#clreol_size
X`09movl`09display_array`5Br5`5D,r2`09`09;Addr.`20of`20next`20line`20to`20displ
Vay
X`09movl`09#20,r0`09`09`09`09;Assume`20it`20is`20a`20short`20line
X`09tstl`09r5`09`09`09`09;Is`20it`20the`20long`20line?
X`09bnequ`0941$`09`09`09`09;Branch`20if`20not
X`09movl`09#27,r0`09`09`09`09;Correct`20the`20line`20length`20var.
X`09`09`09`09`09`09;Display`20current`20line`20from`20table
X41$:`09$qiow_s`20chan=ttkrnl,-`09`09`09;Display`20the`20line`20from`20the`20ar
Vray
X`09`09func=#io$_writevblk,-
X`09`09p1=(r2),-
X`09`09p2=r0
X
X`09aoblss`09#9,r5,40$`09`09`09;Branch`20to`20display`20`5Bnext`5D`20line
X
X
X;`20***************`20Highlight`20Current`20Day`20of`20Month`20on`20Calendar
V`20*****************
X;
X;`20Following`20algorithm`20used:
X;
X;`20`20<linear`20index>`20=`20<day`20of`20month`20to`20highlight>`20+`20<day
V`20of`20week`20for`201st`20of`20month>
X;`20`20<cursor`20display`20row>`20=`20(`20<linear`20index>/7`20)`20+`203
X;`20`20<cursor`20display`20col>`20=`20(`20<remainder-1>*3`20)`20+`20ttwidth
V`20+`203
X;
X`09movb`09systime_day,r1`09`09;Get`20high`20order`20digit`20(HOD)
X`09cmpb`09r1,#`5Ex30`09`09;Digit`200?
X`09bneq`0950$`09`09`09;Branch`20if`20not
X`09movb`09#`5Ex20,systime_day`09;Change`20it`20to`20a`20blank`20for`20later
X50$:`09movb`09systime_day+1,r0`09;Get`20LOD
X`09bicl`09#`5Ex30,r0`09`09;Convert`20to`20integer
X`09bicl`09#`5Ex30,r1`09`09;Convert`20to`20integer
X`09mulb3`09r1,#10,r1`09`09;high`20order`20digit`20*`2010
X`09addb`09r0,r1`09`09`09;+low`20order`20digit
X`09`09`09`09`09;(yields`20highlight`20day`20as`20integer)
X
X
X`09addl`09dow,r1`09`09`09;add`20day`20of`20week`20offset,
X`09`09`09`09`09;yeilding`20<linear`20index>
X`09clrl`09r2`09`09`09;Prep.`20for`20ediv.
X`09clrq`09r3`09`09`09;`20.
X`09decl`09r1`09`09`09;Correct`20day`20of`20week`20offset
X`09ediv`09#7,r1,r3,r4`09`09;Divide`20<linear`20index>`20by`207
X`09addb3`09#`5Ex33,r3,csr_row`09;Cursor`20Row`20is`20calculated
X`09decl`09r4`09`09`09;Remainder`20-`201
X`09mull`09#3,r4`09`09`09;horiz.`20index`20x
X`09`09`09`09`09;(display`20width`20for`20single`20day)
X`09addl`09ttwidth,r4`09`09;Add`20pos`20offset`20to`20display`20region
X`09addl`09#6,r4`09`09`09;Add`20pos`20offset`20within`20display`20region
X`09moval`09csr_col,outbuf+4`09;Setup`20descriptor`20so`20FAO`20moves`20literal
V
X`09`09`09`09`09;`20in`20to`20terminal`20cursor`20control`20area
X`09cmpl`09r4,#100`20`09`09;r4`20>`20100?
X`09bgtr`0960$`09`09`09;branch`20if`20so
X`09incl`09outbuf+4`09`09;If`20not`20shift`20right
X60$:`09movb`09#`5Ex30,csr_col`09`09;Initialize`20with`20a`20leading`200
X`09movl`09r4,scratch`09`09;Save
X
X`09$fao_s`09ctrstr=faobuf,-`20`09;Convert`20cursor`20location`20for`20esc.`20s
Veq.
X`09`09outbuf=outbuf,-
X`09`09p1=scratch
X
X`09$qiow_s`20chan=ttkrnl,-`09`09;Relocate`20the`20cursor`20to`20point`20to
X`09`09func=#io$_writevblk,-`09;Current`20day`20of`20month`20and`20turn`20on
X`09`09p1=csr_ctl,-`09`09;highlighting
X`09`09p2=#ctlsize
X
X`09$qiow_s`20chan=ttkrnl,-`09`09;Display`20day`20of`20month
X`09`09func=#io$_writevblk,-
X`09`09p1=systime_day,-
X`09`09p2=#2
X
X`09$qiow_s`20chan=ttkrnl,-`09`09;Turn`20off`20highlighting
X`09`09func=#io$_writevblk,-
X`09`09p1=attrib_off,-
X`09`09p2=#3
X
X`09$qiow_s`20chan=ttkrnl,-`09`09;Restore`20cursor`20to`20its`20position
X`09`09func=#io$_writevblk,-`09;before`20the`20calendar`20was`20displayed
X`09`09p1=restore_pos,-
X`09`09p2=#2
X
Xastexit:`20ret
X
X;--
X;`20The`20following`20code`20initializes`20the`20TSR`20by`20enabling`20the`20o
Vut-of-band
X;`20key`20on`20the`20kernel`20mode`20channel,`20relocating`20pointers,`20and
V`20displaying
X;`20an`20initialization`20message`20on`20the`20terminal.
X;--
XINITIALIZE:
X
X;`20****`20Initializes`20the`20AST`20level`20TSR`20code`20****
X
X
X`09incl`09`20init_flag
X
X`09$qiow_s`20`20chan=ttkrnl,-`09`09`09`09;Setup`20out`20of`20band`20key
X`09`09`20func=#io$_setmode!io$m_outband,-
X`09`09`20p1=@ast_vector,-
X`09`09`20p2=#omask
X
X
X10$:`09moval`09faobuf+8,faobuf+4`09`09`09;Relocate`20descriptors
X`09moval`09feb29+8,feb29+4`20`09`09`09;`20`20`20.
X`09moval`09work_date+8,work_date+4`20`09`09;`20`20`20.
X`09moval`09systime,systime_dsc+4`09`09`09;`20`20`20.
X`09moval`09hdr1,display_array`09`09`09;`20`20`20.
X`09moval`09hdr2,display_array+4`09`09`09;`20`20`20.
X`09moval`09lin1,display_array+8`09`09`09;`20`20`20.
X`09moval`09lin2,display_array+12`09`09`09;`20`20`20.
X`09moval`09lin3,display_array+16`09`09`09;`20`20`20.
X`09moval`09lin4,display_array+20`09`09`09;`20`20`20.
X`09moval`09lin5,display_array+24`09`09`09;`20`20`20.
X`09moval`09lin6,display_array+28`09`09`09;`20`20`20.
X`09moval`09lin7,display_array+32`09`09`09;`20`20`20.
X`09moval`09lnm_table+8,lnm_table+4`20`09`09;`20`20`20.
X`09moval`09lnm_name+8,lnm_name+4`09`09`09;`20`20`20.
X`09moval`09lnm_equiv+8,lnm_equiv+4`20`09`09;`20`20`20.
X
X`09$qiow_s`20chan=ttkrnl,-`09`09`09`09;Display`20message
X`09`09func=#io$_writevblk!io$m_breakthru,-
X`09`09p1`20=`20install_msg,-
X`09`09p2`20=`20#install_size
X
X`09rsb
X
X;`20****`20The`20following`20code`20is`20not`20used`20by`20this`20calendar,
V`20but
X;`20`20`20`20`20`20serves`20as`20an`20example`20of`20how`20a`20TSR`20can`20rem
Vove`20itself,
X;`20`20`20`20`20`20and`20the`20memory`20the`20it`20resides`20in`20without`20at
Vtempting`20to
X;`20`20`20`20`20`20execute`20in`20deleted`20address`20space.
X;
X;`20`20`20`20`20`20It`20involves`20some`20special`20stack`20manipulation.
X;
X;`09$dellnm_s`20tabnam=lnm_table,-`09;Delete`20the`20logical`20name
X;`09`09`20`20`20lognam=lnm_name
X;
X;`09$dassgn_s`20chan`20=`20ttkrnl`20`09;Remove`20the`20kernel`20mode`20channel
V
X;`09movl`09ast_vector,r0`09`09;Get`20the`20address`20of`20the`20TSR`20memory
X;`09movzwl`09ast_memory_size,r1`09;Get`20the`20length`20of`20the`20memory`20bl
Vock
X;
X;`09`20;The`20following`20line`20pushes`20two`20macro`20instructions`20on`20th
Ve`20stack
X;`09pushl`09#`5Ex045e04c0`09`09;`20`20`20`20ADDL`20#4,SP`20`20/`20`20RET
X;
X;`09movl`09sp,r7`09`09`09;Get`20stack`20pointer
X;`09pushl`09r7`09`09`09;Save`20on`20stack
X;`09jmp`09g`5Eexe$deap1`09`09;Deallocate`20the`20code,
X;`09`09`09`09`09;and`20return`20onto`20the`20kernel`20mode
X;`09`09`09`09`09;stack.`20`20The`20instructions`20on`20the
X
X
X;`09`09`09`09`09;stack`20will`20clean`20themselves`20off
X;`09`09`09`09`09;of`20the`20stack,`20and`20return`20from`20the
X;`09`09`09`09`09;AST`20routine.
X;-----------------------------------------------------------
X
X;`20****`20AST`20routine`20data`20areas`20****
X
Xhdr1:`09.ascii`09'MMM.`20`20'`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20;
VCalendar`20header
X`09.byte`0927,`5Ea'`5B',`5Ea'1',`5Ea'm'`20`20`20`20;Turns`20on`20highlight
X`09.ascii`09'HH:MM`20AM'`20`20`20`20`20`20`20`20`20`20`20`20`20`20;Template
V`20for`20current`20time`20display
X`09.byte`0927,`5Ea'`5B',`5Ea'm'`20`20`20`20`20`20`20`20`20`20;Turns`20off`20hi
Vghlight
X`09.ascii`09'`20`20YYYY`20'`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20;Raw
V`20Calendar`20display`20template
X
Xhdr2:`09.ascii`09'Su`20Mo`20Tu`20We`20Th`20Fr`20Sa`20'`20;2nd`20line`20of`20he
Vader
Xdda:`09`09`09`09`09;Day`20Display`20Array
Xlin1:`09.ascii`09'xx`20xx`20xx`20xx`20xx`20xx`20xx`20'`20;`20`20`20`20`20`20
V`20`20`20"
Xlin2:`09.ascii`09'xx`20xx`20xx`20xx`20xx`20xx`20xx`20'`20;`20`20`20`20`20`20
V`20`20`20"
Xlin3:`09.ascii`09'xx`20xx`20xx`20xx`20xx`20xx`20xx`20'`20;`20`20`20`20`20`20
V`20`20`20"
Xlin4:`09.ascii`09'xx`20xx`20xx`20xx`20xx`20xx`20xx`20'`20;`20`20`20`20`20`20
V`20`20`20"
Xlin5:`09.ascii`09'xx`20xx`20xx`20xx`20xx`20xx`20xx`20'`20;`20`20`20`20`20`20
V`20`20`20"
Xlin6:`09.ascii`09'xx`20xx`20xx`20xx`20xx`20xx`20xx`20'`20;`20`20`20`20`20`20
V`20`20`20"
X
X`09`09`09`09;Blank`20line`20to`20reset`20attrib
Xlin7:`09.byte`2027,`5Ea'`5B',`5Ea'm',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
X
X`09`09`09`09;Vector`20for`20line`20by`20line`20output
Xdisplay_array:`09`20.long`20hdr1,hdr2,lin1,lin2,lin3,lin4,lin5,lin6,lin7
X
Xamtext:`20`09.ascii`20"`20am"`20`20`20`20;Text`20to`20initialize`20am/pm`20dis
Vplay`20field
Xttwidth:`09.blkl`09`09;Current`20terminal`20width`20-`20display`20compensation
V
Xttcharbuf:`09.blkl`203`20`09;Buffer`20to`20receive`20current`20terminal`20char
Vs
Xfaobuf:`20`09.ascid`20'!ZB'`20`20`20`20;Control`20string`20for`20FAO
Xoutbuf:`20`09.long`203,col`09;Adjustable`20output`20descriptor`20for`20FAO
X
X`09`09`09`09;Look`20up`20table`20for`20month`20names
Xmonths:`20`09.ascii`20"JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
X
X`09`09`09`09;Parallel`20table`20containing`20#`20of`20days`20in`20months
Xmonth_tbl:`09.long`0931,28,31,30,31,30,31,31,30,31,30,31
X
X`09`09`09`09;Used`20to`20check`20existance`20of`20FEB`2029`20for`20year.
Xfeb29:`09`09.ascid`20'29-FEB-xxxx'
X
X`09`09`09`09;Work`20Date`20field`20for`20intermediary`20calculations
Xwork_date:`09.ascid`20'DD-MMM-YYYY'
X
Xwork_quad1:`09.blkq`09`09;Quadword`20time`20for`20intermediary`20date`20calcs
Xdow:`09`09.blkl`09`09;Field`20to`20hold`20the`20Day`20of`20Week`20number
Xscratch:`09.blkl`09`09;Work`20field
Xsave_pos:`09.byte`2027,`5Ea'7'`20`20;Control`20terminal`20to`20save`20cursor
V`20postion/attrib.
Xrestore_pos:`09.byte`2027,`5Ea'8'`20`20;Control`20terminal`20to`20restore`20cu
Vrsor/attrib.
Xattrib_off:`09.byte`2027,`5Ea'`5B',`5Ea'm'`20;Turn`20of`20attrib.
X
Xcsr_ctl:`09.byte`2027,`5Ea'`5B'`20`20;Move`20cursor`20and`20turn`20on`20highli
Vght
X
X
Xcsr_row:`09.ascii`20"0;"
Xcsr_col:`09.byte`20`5Ex30,`5Ex30,`5Ex30,`5Ea'H',27,`5Ea'`5B',`5Ea'1',`5Ea';',
V`5Ea'7',`5Ea'm'
Xctlsize`20=`20.-csr_ctl
X
Xclreol:`20`09.byte`2027,`5Ea'`5B'`20`20;Move`20cursor,`20clear`20to`20EOL,`20a
Vnd`20cancel`20highlight
X`20`20row:`09`09.ascii`20"0;"
X`20`20col:`09`09.byte`20`5Ex30,`5Ex30,`5Ex30,`5Ea'H',27,`5Ea'`5B',`5Ea'0',`5Ea
V'm'
X`09`09.byte`2027,`5Ea'`5B',`5Ea'K',`5Ex20,`5Ex20,`5Ex20
Xclreol_size`20=`20.-clreol
X
Xsystime_dsc:`20.long`2023,systime_dsc+8`09;Descriptor`20for`20time`20text`20bu
Vffer
Xsystime:`20`20`20`20`20.blkb`2023`09`09`09;Time`20text`20buffer
X
X;`20Define`20named`20offsets
X
Xheader_mo`20`20`20=`20hdr1`09`09`09;Offset`20to`20month`20(MMM)`20text`20in
V`20header
Xheader_hhmm`20=`20hdr1+10`09`09`09;Offset`20to`20hour/minute`20in`20header
Xheader_ampm`20=`20hdr1+16`09`09`09;Offset`20to`20AM/PM`20indicator
Xheader_year`20=`20hdr1+23`09`09`09;Offset`20to`20year`20`20(YYYY)
X
Xsystime_day`20`20=`20systime`09`09`09;Offset`20to`20day`20of`20month`20in`20sy
Vs-time
Xsystime_mo`20`20`20=`20systime+3`09`09;Offset`20to`20month`20of`20year
Xsystime_year`20=`20systime+7`09`09;Offset`20to`20year
Xsystime_hhmm`20=`20systime+12`09`09;Offset`20to`20time
X
Xscreen_clear_sequence_132:`09`09;Clr.`20Screen`20and`20set`20width`20to`20132
V`20col.
X`09`09.byte`2027,91,72,27,91,74,27,91,63,51,104
Xscreen_clear_size_132`20=`20.-`20screen_clear_sequence_132
X
Xscreen_clear_sequence_80:`09`09;Clr.`20Screen`20and`20set`20width`20to`20132
V`20col.
X`09`09.byte`2027,91,72,27,91,74,27,91,63,51,108
Xscreen_clear_size_80`20=`20.-`20screen_clear_sequence_80
X
Xremove_msg:`09.byte`2010,13`09`09;Removal`20message
X`09`09.ascii`20'Removing`20Calendar`20from`20process'
X`09`09.byte`2010,13
Xremove_size`20=`20.-remove_msg
X
Xinstall_msg:`09.byte`2010,13`09`09;Installation`20message
X`09`09.ascii`20'TSR`20Activation`20key:`20`20`20`20`5ED`20-`20Displays`20time/
Vcalendar'
X`09`09.byte`2010,10,13
Xinstall_size`20=`20.-install_msg
X
X.blkb`0920
Xinit_flag:`09`20.blkl`09`09`09;One-shot`20initialization
Xast_vector:`09`20.blkl`09`09`09;Address`20of`20relocated`20code
Xast_memory_size:`20.blkl`09`09`09;Size`20of`20relocated`20code
Xomask:`09`09`20.long`200,<1@trap_key>`09;Out`20of`20band`20key`20mask
Xlnm_attributes:`20`20.long`20<lnm$m_confine!-`20;logical`20name`20flags
X`09`09`09lnm$m_no_alias>
Xlnm_table:`09`20.ascid`20'LNM$PROCESS_TABLE';Specify`20process`20private`20tab
Vle
Xlnm_name:`09`20.ascid`20'*`20CALENDAR`20`5BTSR`5D'`20;Logical`20name
Xlnm_equiv:`09`20.ascii`20'resident`20at`20'`20`20;Parsable`20equivalence`20str
Ving
Xhexloc:`20`09`20.ascii`20'00000000'`20`20`20`20`20`20;Location`20of`20p1`20mem
Vory
X
X
X`09`09`20.ascii`20'`20('`20`20`20`20`20`20`20`20`20`20`20`20;
Xhexlen:`20`09`20.ascii`20'0000'`20`20`20`20`20`20`20`20`20`20;Size`20of`20p1
V`20block
X`09`09`20.ascii`20'`20bytes).'`20`20`20`20`20`20;
Xlnm_equiv_len`20=`20`20.-lnm_equiv`09`09;
X`09`09`20.byte`2010,13`09`09;
Xlnm_list:`09`20.word`2034,lnm$_string`09;Logical`20name`20item`20list
X`09`09`20.long`20lnm_equiv,0,0`09;
Xdescr:`09`09`20.long`2034,lnm_equiv`09;
X
Xcode_size`20`20=`20.-tsr_code_address`20`09;Calculates`20the`20size`20of`20the
V
X`09`09`09`09`09;code`20that`20gets`20relocated
X
X.end`20main
$ call unpack CALENDAR_TSR.MAR;1 303427721 ""
$!
$ create 'f'
XThis`20file`20contains`20a`20program`20written`20by`20Paul`20Klissner,`20autho
Vr`20of`20"A
XTerminate`20and`20Stay`20Resident`20Calendar`20for`20OpenVMS,"`20which`20ran
V`20on`20page`2025
Xin`20the`20January/February`201993`20issue`20of`20Digital`20Systems`20Journal.
V`20The`20program`20
Xhere`20can`20be`20activated`20while`20the`20user`20is`20in`20the`20middle`20of
V`20running`20unrelated`20
Xsoftware`20in`20the`20same`20user`20process.`20The`20example`20program`20is
V`20a`20terminate`20and`20
Xstay`20resident`20calendar/clock`20that`20can`20be`20made`20to`20appear`20on
V`20your`20screen`20at`20
Xvirtually`20any`20time`20while`20you're`20logged`20in.
$ call unpack TSR.DESC;1 810026594 ""
$ v=f$verify(v)
$ exit