; -*-MACRO-*- .=0 for EMACS use only
; <GERGELY.EXP>CHKBBD.MAC.95, 27-Jan-86 22:10:19, Edit by GERGELY
;
TITLE CHKBBD
SUBTTL Copyright (C) by D.N.D, Canada and Peter J. Gergely
COMMENT `
This program cleans up the bulletin boards. It zeroes any
invalid entry (files only, or never logged in). A list of .IDX files may be
given or a wildcarded file list.
The program makes use of the macros available in the files
CMD.UNV, SYS:CMD.REL, PJGSYM.UNV, SYS:PJGSYM.REL.
This computer program is the property of THE CANADIAN DEPARTMENT OF
NATIONAL DEFENCE. It shall be used only for purposes authorized by the
department. It shall not be disclosed to a third party without the
Department's written permission.
Queries and comments should be sent to:
Peter J. Gergely
Defence Research Establishment Atlantic
P.O. Box 1012
Dartmouth, N.S.
Canada B2Y 3Z7
Phone: 1(902) 426-3100
Copyright (C) by the authors.
This software is the sole property of the author and may not be copied
by any means without the expressed written consent of the author.
There is no expressed or implied warranty that this software is
suitable for its intended or any other use, or that it will perform
any function whatsoever.
`
; Necessary External Files and Symbols
SEARCH MONSYM,MACSYM,CMD,PJGSYM
.REQUIRE SYS:MACREL,SYS:CMD,SYS:PJGSYM
.TEXT \CHKBBD/SAVE\
SALL
; Template definitions and program version parameters
;
;
; +-----Who edited (0--DEC, 1--DEC SWS, 6--DREA)
; | +-----Program Version
; | | +-----Minor Version (a letter)
; | | | +-----The edit number
; | | | | +-----The length of the Push down stack (PDLST)
; | | | | | +-----The start address
; | | | | | | +-----The Re-entry address
; | | | | | | | +-----Your name
; V V V V V V V V
PJGSTG(6,4,102,1,200,START,REENT,<
Peter J. Gergely
Defence Research Establishment Atlantic
P.O. Box 1012
Dartmouth, N.S.
Canada B2Y 3Z7
Phone: 1(902) 426-3100
>)
; Storage variables
PJGACS ; Get the standard AC's
K==7
X==11 ; Used to find device and directory
JBSA==120 ;[57] Here is the word set by loader
DIR: BLOCK 30 ; Storage for directory information
DIRBEG: Z ; The first directory to check
DIREND: .INFIN ; The last directory to check
;
; File JFN related storage
;
MAXJFN==^D100 ; The maximum allowable JFNS
JFNPNT==10 ; Accumulator to point into JFN tables
HANDLE: BLOCK MAXJFN+1 ; The Indexable file handle table
SJFN: BLOCK 1 ; The current JFN we are on
OUTJFN: .PRIOU ; The output JFN
CURJFN: BLOCK 1 ; The current JFN
JFNBLK: ; GTJFN argument block
GJ%OLD!GJ%DEL!GJ%IFG!GJ%FLG!GJ%XTN!.GJDEF ; Flags
Z ; Input,,Output Specs.
POINT 7,DEVICE ; Device
POINT 7,DIRECTORY ; Directory
POINT 7,[ASCIZ \MAIL\] ; Default Filename
POINT 7,[ASCIZ \IDX\] ; Default Extension
Z ; Default Protection
Z ; Default Account
Z ; Associated JFN
G1%IIN!1 ; Extended argument block
Z ; Exact Copy of Typescript
Z ; # of bytes in destination string
Z ; CTRL/R text byte pointe
Z ; Beginning of dest. block (obsolete)
Z ; Pointer to file spec. attribute blk.
;
; Other storage
;
MMRPAG==20 ; Must correspond to MM's .IDX files
MMWPAG==40
MMPDIF==<MMWPAG-MMRPAG> ; Difference in the pages
NRMFLG: -1 ; Zero if USER format
FULLFL: -1 ; Zero if summary only
FIRSTF: Z ; Nonzero if something was found
RSTCNT: Z ; Number of entries reset
FILFLG: Z ; Nonzero if flag name given
MAXDIR: Z ; The absolute highest directory number
MAXLEN: MMPDIF ; The maximum allowable pages to pmap
MAXPAG: 100 ; The absolute maximum allowable pages
NPAGES: Z ; The length of the file in pages
SIZE: Z ; The number of bytes in the mail file
DATPG0: BLOCK 1 ; [PJG] Read date's
DATPG1: BLOCK 1 ; [PJG] Write dates
PG0ADD: Z ; The true address of the pmap space
PG1ADD: Z ; The true address of the pmap space
TEMP: BLOCK 10 ; Temporary storage for things
TIME: Z ; The time of last read (internal)
USER: BLOCK 20 ; The directory associated with time
CURDAY: BLOCK 1 ; The current day
OLDDAT: BLOCK 1 ; The current day a year ago
AGEFLG: BLOCK 1 ; Nonzero, if current dir is too old
DEVICE: BLOCK 2 ; Default device
DIRECT: BLOCK 10 ; Default directory
BUFFER: BLOCK 100 ; Some buffer space
ZERALL: BLOCK 1 ; Nonzero if we are to empty file
MALJFN: BLOCK 1 ; The mail file JFN
; Storage for COMND Jsys and valid commands
CMDSTG ; Storage for the COMND JSYS
SUBLST: SUBLEN,,SUBLEN ; The subcommands
KWD DATE,.DATE
KWD DAYS,.DAYS
KWD EXIT,.ENDIT
KWD FORMAT,.FORM
KWD OUTPUT,.OUTPT
KWD RANGE,.RANGE
KWI ABORT,.ENDIT
KWI PAGES,.PAGE
KWI START,.BEGIN
SUBLEN==.-SUBLST-1
SWILST: SWILEN,,SWILEN
KWD DATE:,.DATE0
KWD DAYS:,.DAYS0
KWD FORMAT:,.FORM0
KWD OUTPUT:,.OUTP0
SWILEN==.-SWILST-1
FRMLST: FRMLEN,,FRMLEN
KWD BRIEF,.FBRF
KWD FULL,.FFULL
KWD NORMAL,.FNORM
KWD USER,.FUSER
FRMLEN==.-FRMLST-1
; PROGRAM STARTS HERE
REENT: JRST START ; Reentry point
START: STPROG ; default program start
; .RSCNF is returned non-zero if there
; is something in the rescan buffer
; Command JSYS activation starts here
CMDSTA: PROMPT (CHKBBD> ) ; The prompt for the COMND JSYS
SETZB J,HANDLE ; Zero both the index count and the
; storage location for number of JFN's
CMDST0: MOVE A,[JFNBLK,,CJFNBK]
BLT A,CJFNBK+11
MOVEI A,[FLDDB. .CMCFM,<CM%SDH>,,,,[
FLDDB. .CMFIL,,,,,[
FLDDB. .CMSWI,,SWILST]]] ; Get a filename
CALL RFIELD
FNTYP. D ; Get the argument type
CAIN D,.CMCFM ; Was it a return
JRST ENDIT ; Yes then done
CAIE D,.CMSWI
IFSKP.
MOVE A,(B) ; Get address of command ROUTINE
CALL (A) ; Execute the command
JRST CMDST0
ENDIF.
AOS J ; Add one to the JFN count
MOVEM J,HANDLE ; Save it
MOVEM B,HANDLE(J) ; Save the indexable handle
CMALOP: MOVE A,OUTJFN
CAIN A,.PRIOU
IFSKP.
MOVEI A,[FLDDB. .CMCMA,<CM%HPP!CM%SDH>,,
<Comma to continue,
or a carriage return to terminate>,,[
FLDDB. .CMCFM,<CM%SDH>]]
; Read either a comma or carriage
ELSE.
MOVEI A,[FLDDB. .CMSWI,,SWILST,,,[
FLDDB. .CMCMA,<CM%HPP!CM%SDH>,,
<Comma to continue, or a carriage return to terminate>,,[
FLDDB. .CMCFM,<CM%SDH>]]]
; Read either a comma or carriage or switch
ENDIF.
CALL RFIELD ; return
FNTYP. D
CAIN D,.CMCFM
JRST STPROC ; If a CR then done reading commands,
CAIE D,.CMSWI
IFSKP.
MOVE A,(B) ; Get address of command ROUTINE
CALL (A) ; Execute the command
JRST CMALOP
ENDIF.
; Otherwise we might have more files
; or may want to enter subcommands
MOVE A,[JFNBLK,,CJFNBK]
BLT A,CJFNBK+11
MOVEI A,[FLDDB. .CMCFM,<CM%HPP!CM%SDH>,,
<Another file spec., or a carriage return for subcommands>,,[
FLDDB. .CMFIL,CM%SDH]]
; Read either a file or CR
CALL RFIELD
FNTYP. D
CAIN D,.CMCFM
JRST SUBCOM ; IF CR then want to enter
; subcommands, othewise we have
; another filespec
CAIL J,MAXJFN ; Are we at the maximum number of JFNs?
JRST CMALOP ; Yes then accept no more
AOS J ; Increment the JFN count
MOVEM J,HANDLE ; Save it
MOVEM B,HANDLE(J) ; Save the indexable handle
JRST CMALOP ; Continue with this loop
;
; STPROC -- Start processing the files
STPROC: MOVN JFNPNT,HANDLE ; Make a counter out of the number of
HRLZ JFNPNT,JFNPNT ; JFN's
AOS JFNPNT ; Increment right half, which is the
; position in the handle table
SKIPL JFNPNT ; Check if a valid counter exists
JRST ENDIT ; Go to the end of the program
SETZM FILFLG ; Say no files jet
CALL PRCLOP ; Process loop
JRST ENDIT ; Go to the end of the program
; SUBCOM -- Subcommand processing is performed here
SUBCOM: PROMPT(SUBCMD> ) ; Subcommand prompt
MOVEI A,[FLDDB. .CMKEY,,SUBLST,,,[
FLDDB. .CMCFM,CM%SDH]]
; Get the subcommands
CALL RFIELD ; Read in a keyword
FNTYP. D
CAIN D,.CMCFM ; default of start processing
JRST .BEG1
MOVE A,(B) ; Get address of command ROUTINE
CALL (A) ; Execute the command
JRST SUBCOM ; Go get next command
FORM: NOISE (of output)
MOVEI A,[FLDDB. .CMKEY,,FRMLST,,NORMAL]
CALL CFIELD
MOVE A,(B)
CALL (A)
JRST SUBCOM
FORM0: MOVEI A,[FLDDB. .CMKEY,,FRMLST,,NORMAL]
CALL RFIELD
MOVE A,(B)
CALL (A)
RET
FFULL: SETOM FULLFL
SETOM NRMFLG
RET
FBRF: SETZM FULLFL
SETZM NRMFLG
RET
FUSER: SETZM NRMFLG
RET
FNORM: SETOM NRMFLG
RET
OUTPT: NOISE (information to) ; Change the output file
MOVEI A,[FLDDB. .CMOFI,CM%DPP,,,TTY:] ; The default is the TTY
CALL CFIELD
JRST .OUTP1
OUTP0: MOVEI A,[FLDDB. .CMOFI,CM%DPP,,,TTY:] ; The default is the TTY
CALL RFIELD
OUTP1: MOVE E,B
PUSH P,B
HRRZ A,OUTJFN ; Get the old jfn
CAIN A,E ; See if they are the same
JRST [ POP P,B
RET]
CAIN A,.PRIOU ; Check if the output terminal
JRST .OUTP2
CLOSF% ; Otherwise close the output jfn
ERCAL NOTBAD
OUTP2: POP P,B
MOVEM B,OUTJFN ; Save this JFN
MOVE A,B ; Open it in seven bit write
MOVX B,<FLD(7,OF%BSZ)!OF%WR>
OPENF%
ERJMP .OUERR
RET
OUERR: TMSG <% Could not open > ; Output the error message
MOVEI A,.PRIOU
HRRZ B,OUTJFN ; and the file name
MOVE C,[XWD 111110,1]
SETZ D,
JFNS%
ERCAL NOTBAD
TMSG < for output.
>
RET
RANGE: NOISE (of directories from) ; Set range of directories to scan
SETZM DIRBEG ; Set lower to zero
MOVEI A,[FLDDB. .CMNUM,<CM%DPP>,^D8,,0] ; Read in the number
CALL RFIELD ; and confirm it
JUMPL B,[TMSG <% Negative numbers are illegal. Value set to 0.
> ; Error message for negatives
JRST RNGHGH] ; and continue with command
MOVEM B,DIRBEG ; Stuff it away
RNGHGH: MOVE A,[.INFIN] ; Upper bound to infinity
MOVEM A,DIREND
NOISE (to) ; Here to set end
MOVEI A,[FLDDB. .CMNUM,<CM%DPP>,^D8,,377777777777] ; Def infin.
CALL CFIELD ; Confirm it
JUMPL B,[TMSG <% Negative numbers are illegal. Value set to infinity.
> ; Error message if negative
RET]
MOVEM B,DIREND ; Stuff it away
MOVE A,DIRBEG ; Check for DIRBEG > DIREND
CAMLE A,DIREND
JRST [ TMSG<% Negative range given. Resetting it to all directories.
>
SETZM DIRBEG ; Zero beginning
MOVX A,.INFIN ; Set end to infinity
MOVEM A,DIREND
RET]
RET
DAYS: NOISE (for declaring entry extinct)
MOVEI A,[FLDDB. .CMNUM,<CM%DPP>,^D10,,366] ; A decimal number
CALL CFIELD ; Confirm the field as well
JUMPL B,[TMSG <% Negative numbers are illegal. No action taken.
> ; Error message if negative
RET]
MOVE A,CURDAY
SUB A,B
MOVEM A,OLDDAT
RET
DAYS0: MOVEI A,[FLDDB. .CMNUM,<CM%DPP>,^D10,,366] ; A decimal number
CALL RFIELD ; Confirm the field as well
JUMPL B,[TMSG <% Negative numbers are illegal. No action taken.
> ; Error message if negative
RET]
MOVE A,CURDAY
SUB A,B
MOVEM A,OLDDAT
RET
DATE: NOISE (for declaring entries extinct)
MOVEI A,[FLDDB. .CMTAD,,CM%IDA]
CALL CFIELD
HLRZM B,OLDDAT
RET
DATE0: MOVEI A,[FLDDB. .CMTAD,,CM%IDA]
CALL RFIELD
HLRZM B,OLDDAT
RET
PAGE: NOISE (of available memory to use) ; Allow expansion of input
MOVEI A,[FLDDB. .CMNUM,<CM%DPP>,^D10,,100] ; A decimal number
CALL CFIELD ; Confirm the field as well
JUMPL B,[TMSG <% Negative numbers are illegal. No action taken.
> ; Error message if negative
RET]
CAILE B,MAXPAG ; Cannot exceed absolut maximum
JRST [ TMSG <% Number given exceeds allowable maximum
>
RET]
MOVEM B,MAXLEN ; Stuff it away
RET
ENDIT: NOISE (the program) ; Here on the abort or exit command
CONFRM
POP P,A ; Won't return so pop
JRST ENDIT
BEGIN: NOISE (the directory listing) ; Start processing
CONFRM
POP P,A ; Wont return so stop
BEG1: JRST STPROC ; Start up processing
PRCLOP: SKIPE A,HANDLE(JFNPNT) ; Get the JFN and skip if invalid
CALL PRCGRP
AOBJN JFNPNT,PRCLOP ; Increment the counter and continue
RET
PRCGRP: MOVE A,HANDLE(JFNPNT)
MOVEM A,SJFN
PRCGR0: HRRZ A,SJFN
CALL PRCFIL ; PRCFIL Get's AC1 with current JFN
MOVE A,SJFN ; Get the indexable file handle that
GNJFN% ; was saved, and get the next file
ERJMP [RET] ; Done this one if it failed
;Any other processing when changing file
JRST PRCGR0
PRCFIL: MOVEM A,CURJFN
SETZM ZERALL
SETZ E,
MOVE A,CURJFN
MOVE B,[1,,.FBSIZ]
MOVEI C,E
GTFDB%
ERJMP [RET]
SETZ J,
MOVE A,CURJFN
MOVE B,[1,,.FBBYV]
MOVEI C,J
GTFDB%
ERJMP [RET]
HRRZ J,J
SKIPN E
SKIPE J
CAIA
JRST [RET]
SETZ E,
HRRZ A,CURJFN
MOVE B,[1,,.FBCTL]
MOVEI C,E
GTFDB%
ERJMP [RET]
TXNE E,FB%DEL
RET
HRROI A,BUFFER
HRRZ B,CURJFN
MOVX C,FLD(1,JS%DEV)!FLD(1,JS%DIR)!FLD(1,JS%NAM)!JS%PAF
JFNS%
ERJMP PRCFL0
FMSG <.TXT>
MOVX A,GJ%OLD!GJ%DEL!1
HRROI B,BUFFER
GTJFN%
ERJMP PRCFL0
HRRZM A,MALJFN
SETZ E,
MOVE A,MALJFN
MOVE B,[1,,.FBCTL]
MOVEI C,E
GTFDB%
ERJMP [MOVE A,MALJFN
RLJFN%
ERCAL NOTBAD
JRST PRCFL1]
MOVE A,MALJFN
RLJFN%
ERCAL NOTBAD
JUMPE E,PRCFL1
TXNN E,FB%DEL
JRST PRCFL1
PRCFL0: TMSG <Processing >
MOVEI A,.PRIOU
HRRZ B,CURJFN
MOVX C,JS%SPC
JFNS%
ERCAL NOTBAD
TMSG <
% Nonexistent, deleted or empty mail file. Deleting all entries >
HRRZ A,CURJFN
MOVX B,<OF%RD!OF%WR!OF%THW> ; access
OPENF%
ERCAL NOTBAD
DO.
HRLZ A,CURJFN
FFUFP%
ERJMP [TMSG <[OK]
>
JRST ENDLP.]
MOVE B,A
SETO A,
SETZ C,
PMAP%
ERJMP [TMSG <[FAILED]
>
JRST ENDLP.]
LOOP.
ENDDO.
MOVX A,FLD(.FBSIZ,CF%DSP) ; Set byte length to 0
HRR A,CURJFN
SETO B,
SETZ C,
CHFDB%
ERCAL NOTBAD
MOVX A,FLD(.FBBYV,CF%DSP) ; Set byte size 36 , page length 0
HRR A,CURJFN
MOVX B,FLD(77,FB%BSZ)!FLD(777777,FB%PGC)
MOVX C,FLD(44,FB%BSZ)!FLD(0,FB%PGC)
CHFDB%
ERCAL NOTBAD
MOVX A,CO%NRJ ; CLOSE THE FILE
HRR A,CURJFN
CLOSF%
ERCAL NOTBAD
RET
PRCFL1: HRRZ A,CURJFN
MOVX B,<OF%RD!OF%WR!OF%THW> ; access
OPENF%
ERJMP [RET]
SETZM FIRSTF
SETZM RSTCNT
GETSIZ: HRRZ A,CURJFN ; Get the size of the DAT file
HRLI A,MMRPAG
FFFFP%
ERJMP [TMSG <% File has never been used.
>
JRST ENDIT] ; Error condition
CAME A,[-1]
IFSKP.
MOVE A,CURJFN ; Get the size of the DAT file
SIZEF%
ERJMP [TMSG <% File has never been used.
>
JRST ENDIT] ; Error condition
SOS C ; [PJG] One for the index page.
MOVE D,C
CAILE D,MMPDIF
MOVEI D,MMPDIF
ELSE.
HRRZ D,A
SUBI D,MMRPAG
CAILE D,MMPDIF
MOVEI D,MMPDIF
ENDIF.
CAMLE D,MAXLEN ; See if it is not too big
JRST [ TMSG <% File is too large to read into memory
>
JRST ENDIT]
MOVEM D,NPAGES ; Save the page length
IMULI D,1000 ; Multiply by 1000 and subtract 1
SOS D ; because directory go from 0
MOVEM D,MAXDIR ; Save the number of max. directory
HRLZ A,CURJFN ; JFN,,starting page = 0
HRRI A,MMRPAG
HRLZI B,.FHSLF ; Handle,,Page in memory
HRR B,DATPG0
MOVX C,<PM%CNT!PM%WT!PM%RD> ; and flags=count,read acc,write
HRR C,NPAGES ; Count of pages to read
PMAP% ; PMAP into memory
ERCAL BAD
HRLZ A,CURJFN ; JFN,,starting page = 0
HRRI A,MMWPAG
HRLZI B,.FHSLF ; Handle,,Page in memory
HRR B,DATPG1
MOVX C,<PM%CNT!PM%WT!PM%RD> ; and flags=count,read acc,write
HRR C,NPAGES ; Count of pages to read
PMAP% ; PMAP into memory
ERCAL BAD
MOVE A,DIREND ; Set up the counter into E
CAMLE A,MAXDIR ; If DIREND>MAXDIR reset the value
MOVE A,MAXDIR
SUB A,DIRBEG ; Subtract directory begin
SKIPGE A ; If range negative then quit
JRST [ TMSG<% Negative number of directories requested
>
JRST ENDIT]
AOS A ; Add one to get a true count
MOVN A,A ; Multiply it by -1
HRLZ E,A ; Create the count index
ADD E,DIRBEG ; Get the first directory to do
HRRZ A,DATPG0 ; Set count word to A,,Start add
IMULI A,1000 ; where start = startpage*1000
MOVEM A,PG0ADD ; Save the start address
MOVE A,DATPG1 ; Save the address of the byte counter
IMULI A,1000 ; page
MOVEM A,PG1ADD
SETZM FIRSTF ; No directories found yet
SETZM RSTCNT
LOOP: HRRZ J,E
ADD J,PG0ADD ; [PJG] Add it back in
SKIPN (J)
JRST INCLP ; If nothing then go to the next one
SKIPE FIRSTF ; Skip if no header printed yet
JRST LOOP1
MOVE A,OUTJFN
CAIN A,.PRIOU
IFSKP.
TMSG <Processing >
MOVEI A,.PRIOU
HRRZ B,CURJFN
MOVX C,JS%SPC
JFNS%
ERCAL NOTBAD
TMSG <
>
ENDIF.
SKIPN NRMFLG
JRST LOOP1
SKIPN FILFLG
IFSKP.
MOVE A,OUTJFN
FMSG <
>
ELSE.
SETOM FILFLG
ENDIF.
MOVE A,OUTJFN
FMSG <
Processing >
MOVE A,OUTJFN
HRRZ B,CURJFN
MOVX C,JS%SPC
JFNS%
ERCAL NOTBAD
MOVE A,OUTJFN
FMSG <
>
SKIPN FULLFL
IFSKP.
MOVE A,OUTJFN ; Output the header
FMSG <
Date and Time
Dir # User Name Last Read Message File Last Written
>
ENDIF.
LOOP1: AOS FIRSTF ; Increment the directory count
SKIPN FULLFL ; Just count if brief mode
JRST INCLP
HRROI A,USER ; Write directory to USER
SKIPN NRMFLG
IFSKP.
HRRZ B,E ; Get the directory number which is
; the relative word address in
MOVX C,<NO%LFL!NO%OOV!FLD(4,NO%COL)!FLD(10,NO%RDX)> ; Output
NOUT% ; the octal directory number
ERCAL [HRROI A,USER
RET]
FMSG <. > ; A separator
ENDIF.
SETZM AGEFLG ; If we go to NODIR then it is because
; that the directory does not exist or
; it is files only or because ZERALL
; is set
HRRZ B,E ; restore the user number
HRLI B,500000 ; The left have contains the dev.
DIRST% ; Translate the user number
ERJMP NODIR
HRRZ A,E ; Get the directory
HRLI A,540000 ; Make it a directory
MOVEI B,DIR ; Store it here
SETZ C,
GTDIR% ; Get the directory information
ERJMP OUTTXT ; An error implies unprivileged so
; just output the info
MOVE B,DIR+.CDMOD ; Get the mode word
TXNE B,CD%DIR ; Check if files-only
JRST NODIR ; Yes, then reset directory
MOVE B,DIR+.CDLLD ; GET DATE OF LAST LOGIN
JUMPE B,NODIR ; Reset the directory if never logged
SETOM AGEFLG ; Say we are testing age
HLRZ B,(J) ; Check for system date and time incorr
CAMGE B,OLDDAT ; If older than a year ago, reset also
JRST NODIR
OUTTXT: MOVE A,OUTJFN ; Write it out to output device
HRROI B,USER ; Stored in USER
MOVEI C,0 ; All the text should go
MOVEI D,0 ; End on a null
SOUT%
ERCAL BAD
MOVE A,[POINT 7,USER] ; Calculate the terminal column
CALL TERCOL ; it is in
MOVEM B,TEMP ; Save it temporarily
MOVE C,B ; If longer than 4 tabs = 32 col
SUBI C,^D32 ; Then put in a carriage return
SKIPL C ; and go to the proper column
JRST [ MOVE A,OUTJFN
FMSG <
>
SETZ C, ; Make sure all are output
JRST DTWRIT]
MOVEI C,^D31 ; Calculate how many we need
SUB C,TEMP
IDIVI C,10
ADDI C,1
DTWRIT: MOVE A,OUTJFN ; Write out the column justification
HRROI B,[ASCIZ \ \] ; 3 tabs
MOVEI D,0 ; End on a null
SOUT%
ERCAL BAD
HLRZ B,(J) ; Check for system date and time incorr
CAMLE B,CURDAY ;
IFSKP.
MOVE A,OUTJFN
FMSG < >
ELSE.
MOVE A,CURDAY
HRLM A,(J)
MOVE A,OUTJFN
FMSG <*>
ENDIF.
MOVE A,OUTJFN ; Output the time of the last message
MOVE B,(J) ; read
MOVEI C,0 ; Get the brief format
ODTIM% ; Translate the internal format
ERCAL BAD
GETVTM: SKIPN NRMFLG
JRST EOL
MOVE A,OUTJFN ; Output a separator
FMSG < >
HRRZ J,E
ADD J,PG1ADD
SKIPN B,(J) ; 0 means never read
IFNSK.
MOVE A,OUTJFN
FMSG < Never>
JRST EOL
ENDIF.
HLRZ B,(J) ; Check for system date and time incorr
CAMLE B,CURDAY
IFSKP.
MOVE A,OUTJFN
FMSG < >
ELSE.
MOVE A,CURDAY
HRLM A,(J)
MOVE A,OUTJFN
FMSG <*>
ENDIF.
MOVE A,OUTJFN
SUB B,(J) ; Subtract the time of the last
; message read
MOVM B,B ; Take the absolute value of it
CAIG B,1 ; Ignore if it differs by one
JRST EOL
MOVE A,OUTJFN
MOVE B,(J) ; Output this time if not the same
MOVEI C,0 ; Get the brief format
ODTIM% ; Translate the internal format
ERCAL BAD
EOL: SKIPE NRMFLG
IFSKP.
MOVE A,OUTJFN
FMSG < >
MOVE A,OUTJFN
HRRZ B,CURJFN
MOVX C,JS%DEV!JS%DIR!JS%NAM!JS%PAF
JFNS%
ERCAL NOTBAD
ENDIF.
MOVE A,OUTJFN ; Output a CRLF at the end of the line
FMSG <
> ; Terminate the line
JRST INCLP ; [PJG] Finished then continue
;
; NODIR -- Nonexistant directory. Reset the internal values
NODIR: MOVEI A,.PRIOU ; Output the directory number
HRROI B,USER
SETZB C,D
SOUT%
ERCAL NOTBAD
SKIPN AGEFLG
IFSKP.
TMSG < [Resetting this entry line (too old)]
>
ELSE.
TMSG < [Resetting this entry line]
>
ENDIF.
HRRZ J,E
HRRZ K,E
ADD J,PG0ADD
ADD K,PG1ADD
SETZM (J)
SETZM (K)
AOS RSTCNT ; Increment number reset
; RET
INCLP: AOBJN E,LOOP ; Repeat until done what we want
MOVE A,FIRSTF
SUB A,RSTCNT ; Remove number reset
MOVEM A,FIRSTF
CAIE A,1
IFSKP.
MOVE A,OUTJFN
FMSG < 1 Reader found>
ELSE.
MOVE A,OUTJFN
FMSG < >
MOVE A,OUTJFN
MOVE B,FIRSTF
MOVX C,<NO%LFL!NO%OOV!FLD(4,NO%COL)!FLD(10,NO%RDX)> ; Output
NOUT%
ERCAL NOTBAD
FMSG < Readers found>
ENDIF.
MOVE A,OUTJFN ; Output the time of the last message
FMSG < >
MOVE A,OUTJFN
SETO B,
MOVEI C,0 ; Get the brief format
ODTIM% ; Translate the internal format
ERCAL BAD
SKIPE NRMFLG
IFSKP.
MOVE A,OUTJFN
FMSG < >
MOVE A,OUTJFN
HRRZ B,CURJFN
MOVX C,JS%DEV!JS%DIR!JS%NAM!JS%PAF
JFNS%
ERCAL NOTBAD
ENDIF.
MOVE A,OUTJFN
FMSG <
>
MOVE A,FIRSTF ; Get the number of directories done
CAIG A,10 ; More than ten then output a bottom
IFSKP.
SKIPN NRMFLG
IFSKP.
SKIPN FULLFL
IFSKP.
MOVE A,OUTJFN
FMSG <
Dir # User Name Last Read Message File Last Written
Date and Time
>
ENDIF.
ENDIF.
ENDIF.
UNMAP: HRROI A,-1 ; Required to unmap process pages
HRLZI B,.FHSLF ; Process handle,,and page
HRR B,DATPG0 ; Get the page
HRRZ C,NPAGES ; The number of pages to unmap
PMAP%
ERCAL NOTBAD
HRROI A,-1 ; Required to unmap process pages
HRLZI B,.FHSLF ; Process handle,,and page
HRR B,DATPG1 ; Get the page
HRRZ C,NPAGES ; The number of pages to unmap
PMAP%
ERCAL NOTBAD
MOVX A,CO%NRJ ; CLOSE THE FILE
HRR A,CURJFN
CLOSF%
ERCAL NOTBAD
RET
; PRGINI -- Program initialization
;
PRGINI:
HRROI A,[ASCIZ \BBD:\] ;See if BBD: exists
STDEV%
TDZA X,X ;Use X as a flag saying "bbd: exists or not"
SETO X, ;Zero means doesn't exist. This routine only
JUMPE X,PRGIN0 ;If it doesn't exist, go around
MOVX A,GJ%SHT!GJ%OFG ;Get parse only JFN
HRROI B,[ASCIZ \BBD:\]
GTJFN%
ERJMP PRGIN0
HRRZ B,A ;Get JFN in right place
HRROI A,DEVICE ;Store device name for GTJFN% later
MOVX C,FLD(.JSAOF,JS%DEV)
JFNS%
ERCAL NOTBAD
HRROI A,DIRECT ; Store the directory
MOVX C,FLD(.JSAOF,JS%DIR)
JFNS%
ERCAL NOTBAD
PRGIN0: MOVEI A,.PRIOU ; Default output is to TTY:
MOVEM A,OUTJFN
SETOM NRMFLG ; Default is NORMAL Format
SETOM FULLFL ; Default is FULL Format
GTAD%
ERCAL BAD
HLRZM A,CURDAY
MOVE A,CURDAY
SUBI A,^D366
MOVEM A,OLDDAT ; Keep this value for other things
SETZM DIRBEG ; Directory begin is zero
MOVE A,[.INFIN]
MOVEM A,DIREND ; Directory end is infinity
HLRZ A, .JBSA ;[57] Find end of file
ADDI A, 777 ;[57] Find first free page after everything
LSH A, -9
MOVEM A, DATPG0 ;[57] Here it is
ADDI A,MMPDIF
MOVEM A, DATPG1 ; [PJG] Data page for write access is
; [PJG] next
RET
; Program termination
ENDIT: MOVX A,.FHSLF ; Current file handle
CLZFF% ; Close anything we can
ERCAL NOTBAD
HRROI A,-1 ; -1 for all JFNS
RLJFN% ; Release anything we can
ERCAL NOTBAD
RESET% ; Reset
HALTF% ; Here is where we stop the program
JRST START ; In case of a restart
END <LEVEC,,EVECT>
-------
