$!/* acf4:vmsnet.sources / duff@decus.com.au (Jim Duff) / 10:54 pm Nov 6, 1990 */ $!Hi Netters, $! here is a silly program for all you chronic clock watchers out there. $!It loads code into P1 space which sets your DCL prompt to the current time and $!then executes it as an AST. The AST resets itself every minute so what you end $!up with is a clock for a prompt! $! $!Enjoy, $!Jim Duff Net: DUFF@DECUS.COM.AU $!DEC Systems Specialist Voice: +61 2 258 2385 $!Midland Montagu Australia DTE: 0505224122018 $! $!(Come to think of it, this could have some useful applications...) $! $! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 7-NOV-1990 13:29:12.16 By user DUFF (Jim Duff) $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $! 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. TIME_PROMPT.MAR;2 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_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 $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ 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: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X`09.TITLE`09TIME_PROMPT - Set DCL prompt to current time X`09.IDENT`09/X01-000/ X X;++ X; Copyright `A9 1990 James F. Duff X; X; This program is free software; you can redistribute it and/or modify X; it under the terms of the GNU General Public License as published by X; the Free Software Foundation; either version 1, or (at your option) X; any later version. X; X; This program is distributed in the hope that it will be useful, X; but WITHOUT ANY WARRANTY; without even the implied warranty of X; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the X; GNU General Public License for more details. X; X; You should have received a copy of the GNU General Public License X; along with this program; if not, write to the Free Software X; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. X; X; The author can be contacted on the Internet at DUFF@DECUS.COM.AU. X;-- X X;++ X; X; FACILITY: X; X;`09Silly buggers X; X; ABSTRACT: X; X;`09This program loads code into P1 space that sets the DCL X;`09prompt to the current time, and executes it as an AST. The code X;`09in P1 space resets the AST to execute every minute. X; X; ENVIRONMENT: X; X;`09User, executive and kernal modes X; X; AUTHOR: X; X;`09James F. Duff,`0931-Oct-1990 X; X; MODIFIED BY: X; X;`09X01-000`09`09Jim Duff`0931-Oct-1990 X;`09Original version of module X; X;-- X`09.LINK`09"SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH X X`09.PSECT`09DATA XARGS:`09.BLKL`091 X X`09.PSECT`09CODE`09NOWRT,EXE,SHR X X`09.ENTRY`09TP,`5EM<> X`09$CMKRNL_S -`09`09`09`09; Get to kernal to load our code X`09`09ROUTIN=LOAD_EXEC X`09$CMEXEC_S -`09`09`09`09; Declare an executive mode ast X`09`09ROUTIN=FIRST_TIME X`09MOVZWL`09#SS$_NORMAL,R0`09`09`09; Indicate normal completion X`09RET`09`09`09`09`09; Return to caller X`09 X`09.ENTRY`09LOAD_EXEC,`5EM X`09TSTL`09CTL$GL_SITESPEC`09`09`09; Test site specific longword. X`09`09`09`09`09`09; Used to hold addr of code if X`09`09`09`09`09`09; it has already been loaded X`09BEQL`0910$`09`09`09`09; Branch if zero X`09MOVL`09CTL$GL_SITESPEC,ARGS`09`09; Just get addr of code X`09$CANTIM_S -`09`09`09`09; Cancel outstanding timer X`09`09REQIDT=#1777`09`09`09; using this timer id X`09BRB`0920$`09`09`09`09; Branch to exit X X10$:`09MOVL`09#TP_EXEC_LEN,R1`09`09`09; Come here to load code for X`09`09`09`09`09`09; 1st time. Length of code to R1 X`09JSB`09G`5EEXE$ALOP1IMAG`09`09`09; Get a block of P1 space X`09MOVL`09R2,ARGS`09`09`09`09; Addr of block to args X`09MOVL`09R2,CTL$GL_SITESPEC`09`09; Addr to site spec longword X`09MOVAB`09TP_EXEC,R6`09`09`09; Addr of our code to R6 X`09MOVC3`09#TP_EXEC_LEN,(R6),(R2)`09`09; Copy our code to P1 space X20$:`09MOVZWL`09#SS$_NORMAL,R0`09`09`09; Indicate success X`09RET`09`09`09`09`09; Return to user mode X X`09.ENTRY`09FIRST_TIME,`5EM<> X`09MOVL`09ARGS,R2`09`09`09`09; Addr of our code to R2 X`09$DCLAST_S -`09`09`09`09; Execute our code as an AST X`09`09ASTADR=(R2) X`09MOVZWL`09#SS$_NORMAL,R0`09`09`09; Indicate normal completion X`09RET`09`09`09`09`09; Return to user mode X X`09.PSECT`09LD$CODE`09NOWRT,EXE,REL,PIC,LCL X`09.ENTRY`09TP_EXEC,`5EM X XTIME = 0 XATIME_D = 8 XFAOSTR_D = 16 XPROMPT_D = 24 XATIME = 32 XFAOSTR = 36 XPROMPT = 46 X X`09SUBL`09#60,SP`09`09`09`09; Reserve space on stack X`09MOVL`09SP,R7`09`09`09`09; Point to stack with R7 X X`09MOVL`09#7,PROMPT_D(R7)`09`09`09; Length of prompt to desc X`09MOVAB`09PROMPT(R7),PROMPT_D+4(R7)`09; Address of string to desc X X`09MOVL`09#10,FAOSTR_D(R7)`09`09; Length of CTRSTR to desc X`09MOVAB`09FAOSTR(R7),FAOSTR_D+4(R7)`09; Addr fix X X`09MOVL`09#`5EA/!5/,FAOSTR+4(R7)`09`09; Next bit X`09MOVW`09#`5EA/`BB /,FAOSTR+8(R7)`09`09; Last bit X X`09$FAO_S`09CTRSTR=FAOSTR_D(R7), -`09`09; Format the prompt X`09`09OUTLEN=PROMPT_D(R7), - X`09`09OUTBUF=PROMPT_D(R7), - X`09`09P1=#0`09`09`09`09; Current time X X`09MOVAL`09@#CTL$AG_CLIDATA,R6`09`09; CLI data area addr to R6 X`09MOVC3`09#7,PROMPT(R7),628(R6)`09`09; Move our prompt to CLI area X`09MOVB`09#10,624(R6)`09`09`09; Indicate prompt length X X`09MOVL`09#4,ATIME_D(R7)`09`09`09; Length of delta time to desc X`09MOVAB`09ATIME(R7),ATIME_D+4(R7)`09`09; Addr fix X`09MOVL`09#`5EA/0 :1/,ATIME(R7)`09`09; 1 minute delta time X X`09$BINTIM_S -`09`09`09`09; Convert to binary time X`09`09TIMBUF=ATIME_D(R7), - X`09`09TIMADR=TIME(R7) X X`09MOVAB`09TP_EXEC,R6`09`09`09; Point to our code X`09$SETIMR_S -`09`09`09`09; Set a 1 minute timer X`09`09DAYTIM=TIME(R7), - X`09`09ASTADR=(R6), -`09`09`09; To execute us again X`09`09REQIDT=#1777`09`09`09; Use a timer id so we can X`09`09`09`09`09`09; cancel it if they execute this X`09`09`09`09`09`09; again. X X`09RET`09`09`09`09`09; Return to caller X`09 XTP_EXEC_LEN = .-TP_EXEC X`09.END`09TP $ CALL UNPACK TIME_PROMPT.MAR;2 3536376180 $ v=f$verify(v) $ EXIT