Trailing-Edge
-
PDP-10 Archives
-
BB-H311D-RM
-
swskit-tools/actdmp.mac
There are 3 other files named actdmp.mac in the archive. Click here to see a list.
TITLE ACTDMP
SEARCH MACSYM,MONSYM,ACTSYM
SALL ;do not expand macros
STDAC. ;standard ACs
Comment &
This program is designed to dump an ACCOUNTS-TABLE.BIN file into
another file that can be more easily read by people. It was originally
designed to produce a file(s) that can be re-read by ACTGEN. And
amazingly enough, as long as there are no sub-accounts in the file, it
works as intended! At sometime in the future it might even work for
subaccounts also...
The are a number of sections of code that have been commented out.
These sections were originally put in to write messages to the screen
for debugging purposes. However, it might be desirable to have these
available to the person using this program, so I left them in. If
these "features" are wanted, just uncomment them. I didn't even
bother commenting most of them, but they are pretty self expainitory...
Good Luck!!!
&
; Defines for Edit/Version numbers.
PRGVER==1 ;version number
PRGMIN==0 ;minor version number
PRGEDT==^D2 ;edit number
PRGWHO==0 ;last edit by
%PRG==<BYTE (3)PRGWHO(9)PRGVER(6)PRGMIN(18)VI%DEC+PRGEDT>
COMMENT\
2 JGZ 9-APR-84
USE VI%DEC FOR DECIMAL VERSION NUMBER, ADD ENTRY VECTOR.
\ ;End revision history
.PDLSZ==^D50 ;Push down stack size
.ACCWD==^D50 ;stack for account pointers
.TXTSZ==^D200 ;size of text buffer (bytes)
.ATMSZ==.TXTSZ ;size of atom buffer (bytes)
.HLPSZ==20*5 ;size of help buffer (bytes)
.PAGSZ==1000 ;size of a page (words)
.MXWID==^D80 ;default # of characters / line in output field
EX%LIN==1B0 ;1 indicates line count already checkd
; block types for accounting blocks
.TYHSH==:577001 ;block type of hash table
.TYACC==:577002 ;block type of account string
.TYUNM==:577003 ;block type of user name
.TYUGP==:577004 ;block type of user group
.TYALU==:577005 ;block type of "all users"
.TYDNM==:577006 ;block type of directory name
.TYDGP==:577007 ;block type of directory group
.TYALD==:577010 ;block type of "all directories"
.TYNUL==:577011 ;block type of nulls
.TYWUS==:577012 ;block type of wild card user name string
LOC 140 ;CROCK SINCE RWW CAN'T PROGRAM
ACTDMP: JRST MAIN ;Start
JRST MAIN ;Reenter
EXP %PRG ;Version number
MAIN: RESET ;Reset world
SETZ F, ;clear all flags
MOVE P,[IOWD .PDLSZ,PDLST] ;Set up stack
PARSE: ;here to initialize command
MOVEI T1,CMDBLK ;address of command state block
MOVEI T2,[FLDDB. (.CMINI)] ;initialize
COMND ;do it
ERJMP EOFCHK ;check for end of file on take file
RPARSE: ;re-parse address
CALL FIXUP ;do some clean up (this is a nop)
MOVEI T1,CMDBLK ;address of command state block
MOVEI T2,[FLDDB. (.CMKEY,,KWLST)] ;parse a keyword
COMND ;do it
ERJMP EOFCHK ;check for end of file on take file
TLNE T1,(CM%NOP) ;valid command?
JRST [CALL WERROR ;no, write error message
TMSG < - "> ;more error message
HRROI T1,ATMBUF ;still more
PSOUT ;write it
TMSG <"> ;still more
HRROI T1,CRLF ;write a CR/LF
PSOUT ;do it
JRST PARSE] ;let user try again
HRRZ T1,(T2) ;yes, get subroutine address
CALL (T1) ;do subroutine
JRST PARSE ;when returned, parse new command
.DUMP: ;here on DUMP command
HRROI T1,GDUMP ;pointer to noise string
CALL GDWORD ;parse it
RET ;error, return
MOVX T1,GJ%OLD+GJ%MSG ;want old JFN, with message
MOVEM T1,JFNBLK ;save it
HRROI T1,RNAM ;pointer to default file name (input)
MOVEM T1,JFNBLK+.GJNAM ;save it for parsing
HRROI T1,REXT ;pointer to default extension (input)
MOVEM T1,JFNBLK+.GJEXT ;save it for parsing
MOVEI T1,CMDBLK ;address of command state block
MOVEI T2,[FLDDB. (.CMFIL)] ;parse a file name (input)
COMND ;do it
ERJMP EOFCHK ;check for EOF on take file
TLNE T1,(CM%NOP) ;valid command?
JRST [CALL WERROR ;no, write error message
RET] ;return
MOVEM T2,READJF ;yes, save input JFN
HRROI T1,GDUMP0 ;pointer to new noise word
CALL GDWORD ;parse it
JRST [MOVE T1,READJF ;not parsed, get input JFN
RLJFN ;release it
ERJMP FATAL ;write error message
SETZB READJF,WRITEJ ;clear out storage
RET] ;return to calling routine
MOVX T1,GJ%FOU+GJ%NEW+GJ%MSG ;want new file, with message
MOVEM T1,JFNBLK ;save type of request
HRROI T1,WNAM ;pointer to default file name (output)
MOVEM T1,JFNBLK+.GJNAM ;save it (allow default name)
HRROI T1,WEXT ;pointer to default file extension
MOVEM T1,JFNBLK+.GJEXT ;save it (allow default extension)
MOVEI T1,CMDBLK ;address of command state block
MOVEI T2,[FLDDB. (.CMFIL)] ;want an output file
COMND ;parse name of file
ERJMP FATAL ;write error message, stop
TLNE T1,(CM%NOP) ;valid command?
JRST [CALL WERROR ;no, write error message
RET] ;return (let user try again)
MOVEM T2,WRITEJ ;yes, save output JFN
CALL CNFRM ;confirmed?
JRST [MOVE T1,WRITEJ ;no, get output JFN
RLJFN ;release it
ERJMP FATAL ;write error message
MOVE T1,READJF ;get input JFN
RLJFN ;release it
ERJMP FATAL ;write error message
SETZB WRITEJ,READJF ;clear out the storage
RET] ;return to calling routine
MOVE T1,WRITEJ ;get output JFN
MOVX T2,7B5+OF%WR ;7-bit, write access
OPENF ;open output file
ERJMP FATAL ;write error message, stop
HRROI T2,[ASCIZ/; This file was generated by ACTDMP/] ;message
SETZ T3, ;to indicate where this file came from
SOUT ;do it
ERJMP FATAL ;oops...
MOVE T1,READJF ;get input JFN
MOVX T2,0B5+OF%RD ;default byte size, read access
OPENF ;open input file
ERJMP FATAL ;write error message, stop
CALL HSHMAP ;yes, map the hash table
JRST [CALL TSTCOL ;not the hash table, error
TMSG <?Invalid hash table in file: > ;error message
MOVEI T1,.PRIOU ;write to TTY:
MOVE T2,READJF ;get input JFN
SETZ T3, ;the "normal" way
JFNS ;write out the file name
ERJMP FATAL ;write error message, stop
SETO T1, ;-1 in T1 (unmap)
MOVE T2,[.FHSLF,,.HSHPG] ;me,,page number of process
SETZ T3, ;one page only
PMAP ;unmap the page
ERJMP FATAL ;write error message, stop
MOVE T1,READJF ;get input JFN
CLOSF ;close it
ERJMP FATAL ;write error message, stop
MOVE T1,WRITEJ ;get output JFN
CLOSF ;close it
ERJMP FATAL ;write error message, stop
RET] ;return
DUMP0: ;main loop to check accounts
MOVE T1,HSHCNT ;get next address to check
SUBI T1,HSHPAG ;make it an index into the page
CAML T1,HSHSIZ ;is word in hash table?
JRST [CALL TSTCOL ;no, write CRLF if needed
TMSG <%End of hash table> ;write message that we are done
SETO T1, ;-1 in T1 (unmap)
MOVE T2,[.FHSLF,,.HSHPG] ;me,,page number of process
SETZ T3, ;one page only
PMAP ;unmap the page
ERJMP FATAL ;write error message, stop
SETO T1, ;-1 in T1 (unmap)
MOVE T2,[.FHSLF,,.ACCPG] ;me,,page number of process
SETZ T3, ;one page only
PMAP ;unmap the page
ERJMP FATAL ;write error message, stop
MOVE T1,READJF ;get input JFN
CLOSF ;close it
ERJMP FATAL ;write error message, stop
MOVE T1,WRITEJ ;get output JFN
HRROI T2,CRLF ;make sure file ends with a CR/LF
SETZ T3, ;make sure...
SOUT ;do it
ERJMP FATAL ;write error message,stop
CLOSF ;close output file
ERJMP FATAL ;write error message, stop
RET] ;return
MOVE T1,@HSHCNT ;get the accounts hash value
JUMPE T1,[ AOS HSHCNT ;bump counter to next word
JRST DUMP0] ;go back and try next one.
DUMP1: CALL ACCMAP ;map in the page for account
JRST [CALL TSTCOL ;write CRLF if needed
TMSG <?Unexpected error after call to ACCMAP>
RET] ;return
; write out where the account starts...
; CALL TSTCOL
; TMSG <*** Account is located at: >
; MOVEI T1,.PRIOU
; SKIPN T2,NXTACC ;if colision, use this address
; MOVE T2,@HSHCNT ;not a collision, use hash table
; MOVEI T3,10 ;either case, use octal
; NOUT ;write address of account
; ERJMP FATAL ;write error message, stop
; HRROI T1,CRLF ;pointer to CR/LF
; PSOUT ;write it
SKIPN T1,NXTACC ;if colision, use this address
MOVE T1,@HSHCNT ;get address in ACCOUNTS-TABLE
ANDI T1,.PAGSZ-1 ;make it just the offset...
MOVEM T1,ACCWRD ;save the word for later use
ADDI T1,ACCPAG ;add the beginning of the page
MOVEM T1,ACCPTR ;save pointer to account start
HLRZ Q1,(T1) ;get block type
CAIL Q1,.TYHSH ;less that hash type?
CAILE Q1,.TYACC ;no, less than account block?
JRST [CALL TSTCOL ;invalid type, do error stuff
TMSG <?Unexpected block type at: >
MOVEI T1,.PRIOU ;write to TTY:
MOVE T2,ACCPG ;get the page number
IMULI T2,.PAGSZ ;make it a page value
ADD T2,ACCWRD ;add the word number
MOVEI T3,10 ;octal (for ease in FILDDT)
NOUT ;write address where error
ERJMP FATAL ;write error, stop
HRROI T1,CRLF ;pointer to CR/LF
PSOUT ;write it
JRST .+1] ;continue
CAIN Q1,.TYHSH ;is it the HASH table?
JRST [CALL TSTCOL ;yes, check if CR/LF needed
TMSG <?Hash table encounted in middle of file, aborting...>
RET] ;return back to command parser
CAIN Q1,.TYACC ;is it an account block?
CALL ACCOUT ;yes, do account stuff
JRST DUMP1 ;account pointed to another
; (there was a colision!)
;no colision, do next account
AOS HSHCNT ;bump counter to next word
JRST DUMP0 ;go back and try next word
; This routine will map the hash table for the ACCOUNTS-TABLE.BIN.
; It will also check its validity by making sure that this really
; and truely is the hash table.
;
; CALL HSHMAP ;calling sequence
;
; returns:
; +1 If not a valid hash table
; +2 If it is a valid hash table
;
HSHMAP:
HRLZ T1,READJF ;JFN,,page (0)
MOVE T2,[.FHSLF,,.HSHPG] ;me,,page number
MOVX T3,PM%RD ;read access only
PMAP ;map in the hash page only
ERJMP FATAL ;write error message, stop
MOVE T1,HSHPAG ;get the first word of has table
ERJMP [CALL TSTCOL ;output CR/LF if needed
TMSG <?Unexpected error in routine HSHMAP, aborting...>
JRST FATAL] ;write error message, stop
HLRZ T2,T1 ;get left half of block type
CAIE T2,.TYHSH ;is this the hash table?
RET ;no, return +1
HRRZ T1,HSHPAG ;get RH of first word of hash table
MOVEM T1,HSHSIZ ;save the size of the hash table
MOVEI T1,HSHPAG ;get address of hash page data
MOVEM T1,HSHCNT ;save it
AOS HSHCNT ;set count of next hash word to read
RETSKP ;yes, return +2
; subroutine to map account's data
;
; calling sequence:
; T1/ address of account's data (this can be gotten from HSHPAG)
; CALL ACCMAP
;
; returns:
; +1 page not mapped
; +2 page mapped
ACCMAP:
IDIVI T1,.PAGSZ ;make it a page number
MOVE T2,T1 ;save the page number
SUB T1,ACCPG ;get difference of pages
SKIPN T1 ;are the two numbers the same?
RETSKP ;yes, page already mapped...
; return +2...
MOVEM T2,ACCPG ;save the new page number
MOVE T1,T2 ;put page number back in T1
HRL T1,READJF ;put JFN in LH of T1
MOVE T2,[.FHSLF,,.ACCPG] ;me,,where to map page
MOVX T3,PM%RD ;for read access
PMAP ;map the page
ERJMP FATAL ;write error message, stop
; CALL TSTCOL
; TMSG <%% *** Mapping a new page for an account>
RETSKP ;page mapped, return +2
; routine to write out the account string and all other stuff from the
; account block.
ACCOUT: SETZM WIDCNT ;set the width count to zero
MOVE T1,WRITEJ ;get output JFN
HRROI T2,CRLF ;always start new account with a CR/LF
SETZ T3, ;all of it
SOUT ;do it
ERJMP FATAL ;error, write message, stop
HRROI T2,[ASCIZ/ACCOUNT /] ;string
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;write error message, stop
MOVE T2,ACCPTR ;get start of account
ADDI T2,4 ;get word 4 of block
HRRO T2,T2 ;make it a byte pointer
SETZ T3, ;all of it
SOUT ;write account string to file
ERJMP FATAL ;write error message, stop
CALL XPIRES ;write expiration date if need
MOVE T2,ACCPTR ;start of account block
ADDI T2,2 ;get word 2
HLRZ T2,@T2 ;put LH in RH
JUMPE T2,ACCOU1 ;if /CLASS used, continue
MOVE T4,T2 ;save class
HRROI T2,[ASCIZ\ /CLASS:\] ;string
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;write error message, stop
MOVE T2,T4 ;retrieve the class
LSH T2,-^D9 ;right justify it
SUBI T2,1 ;adjust it down (ACTGEN adds 1
; to the class.)
MOVEI T3,12 ;decimal
NOUT ;write it
ERJMP FATAL ;write error message, stop
ACCOU1: ;here to write out a CR/LF
MOVE T1,ACCPTR ;get pointer to account
ADDI T1,3 ;get word containing pointer to
;next account (colision?)
MOVE T1,@T1 ;get pointer
MOVEM T1,NXTACC ;save it for later use
ACCOU2:
MOVE T1,ACCPTR ;get pointer to block checking
HRRZ T2,@ACCPTR ;get length of block
ADD T1,T2 ;add it to get next block wrd 0
CAIL T1,ACCPAG+.PAGSZ ;check if new address is off page
JRST ACCOU3 ;yes, do next account
MOVEM T1,ACCPTR ;save new pointer
HLRZ Q1,@ACCPTR ;get the block type
SKIPN Q1 ;is this an empty section?
JRST [CALL TSTCOL ;yes, check if CR/LF needed
TMSG <%End of account> ;write a message
HRROI T1,CRLF ;pointer to CR/LF
PSOUT ;write it
JRST ACCOU3] ;do cleanup, return
CAIN Q1,.TYHSH ;is it the HASH table?
JRST [CALL TSTCOL ;yes, check if CR/LF needed
TMSG <?Hash table encounted in middle of account, aborting...>
JRST ACCOU3] ;do cleanup, return
CAIN Q1,.TYACC ;is it an account block?
JRST ACCOU3 ;yes, do clean up.
CAIN Q1,.TYUNM ;is it an user name block?
JRST UNMOUT ;yes, do user name stuff
CAIN Q1,.TYUGP ;is it an user group block?
JRST UGPOUT ;yes, do user group stuff
CAIN Q1,.TYALU ;is it an "all users" block?
JRST UNMOUT ;yes, do all users stuff
CAIN Q1,.TYDNM ;is it a directory name block?
JRST DNMOUT ;yes, do directory stuff
CAIN Q1,.TYDGP ;is it a directory group block?
JRST DGPOUT ;yes, do directory stuff
CAIN Q1,.TYALD ;is it an "all directories"?
JRST DNMOUT ;yes, do all directories stuff
CAIN Q1,.TYNUL ;is it a null block?
JRST ACCOU3 ;yes, do cleanup
CAIN Q1,.TYWUS ;wild card user name string?
JRST UNMOUT ;yes, do wild card user name
; This should not be able to happen, but if it does, section of code
; writes some data that might be useful... It the continues with the
; next account (Hopefully!)
CALL TSTCOL ;write CR/LF if needed
TMSG <?Unexpected block type: > ;message
MOVEI T1,.PRIOU ;to TTY:
MOVE T2,Q1 ;get unknown block type
MOVEI T3,10 ;octal
NOUT ;write it out
ERJMP FATAL ;write error message, stop
TMSG < at location > ;more message
MOVEI T1,.PRIOU ;to TTY:
MOVE T2,ACCPTR ;get address of violating block
MOVEI T3,10 ;in octal
NOUT ;write it
ERJMP FATAL ;write error message, stop
RETSKP ;return + 2 (let this thing
;proceed with other accounts)
UNMOUT: ;here to write out USER blocks
; MOVE T1,WRITEJ ;get output JFN
HRROI T1,TEMP ;pointer to tempory storage area
HRROI T2,[ASCIZ/ , /] ;set up pointer if on same line
MOVE Q2,LSTTYP ;get last block type
CAIN Q2,.TYUNM ;was it a user name?
JRST UNMOU1 ;yes, stay on same line
CAIN Q2,.TYALU ;was it a "all user" name (*)?
JRST UNMOU1 ;yes, stay on same line
CAIN Q2,.TYWUS ;was it a "wild user name" (OP*)?
JRST UNMOU1 ;yes, stay on same line
SETZM WIDCNT ;zero out count of characters so far
HRROI T2,CRLF ;wasn't a user name of any type
SETZ T3, ;want a new line...
SOUT ;do it
ERJMP FATAL ;write error message, stop
HRROI T2,[ASCIZ/USER /] ;if new line, need "USER" text
UNMOU1: SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;write error message, stop
MOVE T2,ACCPTR ;get addr of beginning of block
ADDI T2,2 ;get addr of user name
HRRO T2,T2 ;make it a pointer
CAIN Q1,.TYALU ;is this an "all user" block?
HRROI T2,[ASCIZ/*/] ;yes, need this, cause no text stored
SETZ T3, ;all of it
SOUT ;write it to output file
ERJMP FATAL ;write error message, stop
CALL XPIRES ;write /EXPIRES: iff needed
TLNE F,(EX%LIN)
JRST UNMOU4
SETZM BYTCNT
HRROI T1,TEMP
UNMOU3: BIN
ERJMP FATAL
JUMPE T2,UNMOU2
AOS BYTCNT
JRST UNMOU3
UNMOU2:
MOVE T1,BYTCNT
CAMLE T1,MAXWID
JRST [TLO F,(EX%LIN)
SETZM LSTTYP
JRST UNMOUT]
ADD T1,WIDCNT
MOVEM T1,WIDCNT
CAMG T1,MAXWID
JRST [MOVEM T1,WIDCNT
JRST UNMOU4]
TLO F,(EX%LIN)
SETZM LSTTYP
JRST UNMOUT
UNMOU4:
TLZ F,(EX%LIN)
MOVE T1,WRITEJ
HRROI T2,TEMP
SETZ T3,
SOUT
ERJMP FATAL
MOVEM Q1,LSTTYP ;save block type
JRST ACCOU2 ;go back and do next block
UGPOUT:
MOVE T1,WRITEJ ;get output JFN
HRROI T2,CRLF ;start new line
SETZ T3, ;all of it
SOUT ;do it
ERJMP FATAL ;write error message, stop
HRROI T2,[ASCIZ\GROUP /USER:\] ;this is required text for each entry
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;write error message, stop
MOVE T2,ACCPTR ;get addr of beginning of block
ADDI T2,2 ;get the addr of user number
MOVE T2,@T2 ;get the user number
MOVEI T3,12 ;want it in decimal
NOUT ;write it
ERJMP FATAL ;write error message, stop
CALL XPIRES ;write /EXPIRES: iff needed
MOVEM Q1,LSTTYP ;save block type
JRST ACCOU2 ;do next block
DNMOUT: ;here to write out directory blocks
MOVE T1,WRITEJ ;get output JFN
HRROI T2,CRLF ;new line
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;write error message, stop
HRROI T2,[ASCIZ/DIRECTORY /] ;this is needed
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;error, write message, stop
MOVE T2,ACCPTR ;get addr of start of block
ADDI T2,2 ;get addr of structure name
MOVE T2,@T2 ;get structure name (sixbit)
CALL SIXASC ;convert name to ascii
JRST [MOVEI T2,":" ;if something there, put a ":" in T2
BOUT ;make it a device name...
ERJMP FATAL ;error, write message, stop
JRST .+1] ;continue
MOVEI T2,"<" ;need bracket
BOUT ;write the byte
ERJMP FATAL ;error, write message, stop
MOVE T2,ACCPTR ;get addr of start of block
ADDI T2,3 ;get addr of directory name
HRRO T2,T2 ;make it a pointer
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;error, write message, stop
MOVE T2,">" ;need another bracket (close name)
BOUT ;finish un the directory name...
ERJMP FATAL ;error, write message, stop
CALL XPIRES ;write /EXPIRES: iff needed
MOVEM Q1,LSTTYP ;save type of this block
JRST ACCOU2 ;do next block
DGPOUT: ;here to write a directory group block
SETZM WIDCNT ;zero out count of characters
MOVE T1,WRITEJ ;get output JFN
HRROI T2,CRLF ;force new line
SETZ T3, ;all of it
SOUT ;do it
ERJMP FATAL ;error, write message, stop
HRROI T2,[ASCIZ\GROUP \] ;always want this text
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;error, write message, stop
MOVE T2,ACCPTR ;get addr of start of block
ADDI T2,2 ;get addr of structure name
MOVE T2,@T2 ;get structure name (sixbit)
CALL SIXASC ;convert name to ascii
JRST [MOVEI T2,":" ;if something there, put a ":" in T2
BOUT ;make it a device name...
ERJMP FATAL ;error, write message, stop
JRST .+1] ;continue
HRROI T2,[ASCIZ\/DIRECTORY:\] ;this is always needed
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;error, write message, stop
MOVE T2,ACCPTR ;get addr of start of block
ADDI T2,3 ;get addr of directory number
MOVE T2,(T2) ;get directory number
MOVEI T3,12 ;want it in decimal
NOUT ;write it
ERJMP FATAL ;error, write message, stop
CALL XPIRES ;write /EXPIRES: iff needed
MOVEM Q1,LSTTYP ;save type of this block
JRST ACCOU2 ;do next block
ACCOU3:
SETZM WIDCNT ;zero out count of characters
SETZM LSTTYP ;force a new line
SKIPN NXTACC ;another account?
RETSKP ;no, return + 2
; CALL TSTCOL
; TMSG <*** Processing an alternate accounts block...>
MOVE T1,NXTACC ;yes, get address of it
RET ;return
; This routine will write the expiration date on the current line
; iff it is needed...
;
; Calling sequence:
; T1/ destination designator ;(preserved)
; CALL XPIRES
;
; Returns:
; +1 alawys
;
XPIRES:
SAVEAC <T1> ;save T1
MOVE T2,ACCPTR ;get start of account block
ADDI T2,1 ;get word 1 of block
MOVE T2,@T2 ;get the expiration date
JUMPE T2,XPIRE0 ;if account expires, write it
MOVE T4,T2 ;save expiration date
HRROI T2,[ASCIZ\ /EXPIRES:\] ;string
SETZ T3, ;all of it
SOUT ;write it
ERJMP FATAL ;write error message, stop
MOVE T2,T4 ;get expiration date back
MOVX T3,OT%NSC ;omit the seconds
ODTIM ;write date & time
ERJMP FATAL ;write error message, stop
XPIRE0: RET ;return, restore ACs
; routine to write a sixbit string (one word only) out in
; ascii
;
; calling sequence:
; T1/ output JFN (or valid byte pointer)
; T2/ sixbit word
; CALL SIXASC
;
; returns:
; +1 if something was in T2 at calling time
; +2 if T2 contains 0,,0
;
SIXASC:
SAVEAC <T1> ;save the output JFN
MOVE T3,T2 ;move the word into T3 (for shifting)
JUMPE T2,[RETSKP] ;if first word is zero, no structure...
SIXAS1: SETZ T2, ;clear T2 (no garbage)
LSHC T2,^D6 ;move in one byte (sixbit)
JUMPE T2,SIXAS0 ;is it a space? yes, end...
ADDI T2,40 ;make it ascii
BOUT ;write it
ERJMP FATAL ;write error message
JRST SIXAS1 ;do next byte
SIXAS0: RET ;return
.EXIT: ;here on EXIT command
HRROI T1,GEXIT
CALL GDWORD
RET
CALL CNFRM
RET
HALTF
JRST ACTDMP
.HELP: ;here on HELP command
HRROI T1,GHELP ;pointer to noise word
CALL GDWORD ;parse it
RET ;error, return
CALL CNFRM ;confirmed?
RET ;no, return
MOVSI T1,(GJ%OLD+GJ%SHT) ;old file, short JFN
HRROI T2,[ASCIZ/HLP:ACTDMP.HLP/] ;name of help file
GTJFN ;get a JFN on help file
ERJMP [CALL TSTCOL ;error, write CR/LF if needed
TMSG <?No help file available> ;write error message
RET] ;return
MOVX T2,7B5+OF%RD ;read access, ascii
OPENF ;open help file
ERJMP FATAL ;error, write message, stop
MOVEM T1,HLPJFN ;save help JFN
LOOP: MOVE T1,HLPJFN ;get help JFN
HRROI T2,HLPBUF ;where to store text
MOVEI T3,.HLPSZ ;until buffer full
MOVEI T4,0 ;or until NUL
SIN ;read in a buffer
ERJMP ENDHLP ;if error, check for EOF on help file
MOVEI T1,.PRIOU ;write to TTY:
HRROI T2,HLPBUF ;the help buffer
MOVEI T3,.HLPSZ ;the entire buffer
MOVEI T4,0 ;or until a NUL
SOUT ;write the buffer
ERJMP FATAL ;error, write message, stop
JRST LOOP ;go back and do next buffer
ENDHLP: MOVE T1,HLPJFN ;get help JFN again
GTSTS ;get file's status
ERJMP FATAL ;error, write message, stop
TLNN T2,(GS%EOF) ;test for EOF on file
JRST FATAL ;not at EOF, error, write message, stop
MOVEI T1,.PRIOU ;at EOF, get TTY designator
HRROI T2,HLPBUF ;pointer to last buffer in file
MOVEI T3,.HLPSZ ;entire buffer
MOVEI T4,0 ;or until NUL
SOUT ;write buffer
ERJMP FATAL ;error, write message, stop
MOVE T1,HLPJFN ;get help file JFN again
CLOSF ;close it
ERJMP FATAL ;error, write message, stop
RET ;return to main routine
.PUSH:
HRROI T1,GPUSH ;here on PUSH command
CALL GDWORD
RET
CALL CNFRM
RET
CALL TSTCOL
TMSG <%Not implemented yet...>
RET
.TAKE: ;here on TAKE command
HRROI T1,GTAKE
CALL GDWORD
RET
CALL CNFRM
RET
CALL TSTCOL
TMSG <%Not implemented yet...>
RET
.WIDTH:
HRROI T1,GWIDTH
CALL GDWORD
RET
MOVEI T1,CMDBLK
MOVEI T2,[FLDDB. (.CMNUM,<CM%SDH+CM%DPP+CM%HPP>,^D10,<Maximum # of characters per line in output file>,<80>)]
COMND
ERJMP FATAL
TLNE T1,(CM%NOP)
JRST [CALL WERROR
RET]
MOVE T4,T2
CALL CNFRM
RET
MOVEM T4,MAXWID
RET
SUBTTL CONFIRMATION SUBROUTINE
COMMENT\
This subroutine can be called to ask for confirmation, and
should be called at the end of all parsing command strings.
calling sequence:
CALL CNFRM
return:
+1 if NOT confirmed
+2 if confirmed
\
CNFRM: ;here to confirm a parse
MOVEI T1,CMDBLK ;command state block address
MOVEI T2,[FLDDB. (.CMCFM)] ;function block address
COMND ;parse it (confirm)
ERJMP EOFCHK ;oops...
TLNN T1,(CM%NOP) ;confirmed?
RETSKP ;yes, return +2
CALL WERROR ;no, return error message
RET ;return +1
SUBTTL GUIDE WORD PARSING SUBROUTINE
COMMENT\
This subroutine is used to pase a guide word for a command.
accepts in AC1, pointer to guide word string.
calling sequence:
HRROI T1,GUIDE ;where GUIDE: ASCIZ/To MONITOR/
CALL GDWORD ;parse it
return:
+1 if invalid guide word is parsed
+2 if valid (or no) guide word is parsed
\
GDWORD:
HRRO T3,T1 ;-1,,Addr of guide words
MOVEI T1,CMDBLK ;address of command state block
MOVEI T2,[FLDDB. (.CMNOI)] ;parse a noise word
MOVE T4,T2 ;copy address into T4
ADDI T4,.CMDAT ;add index into table
MOVEM T3,(T4) ;save the pointer in the table
COMND ;parse the guide word
ERJMP EOFCHK ;on error, check for EOF
TLNN T1,(CM%NOP) ;ok noise word?
RETSKP ;yes, return +2
CALL WERROR ;no, write error message
RET ;return +1
RSKP: AOS 0(P) ;make it +2
RET ;return +2
EOFCHK:
RET
FIXUP:
MOVE T1,READJF ;get input JFN
RLJFN ;release it
ERJMP .+1 ;don't care
MOVE T1,WRITEJ ;get output JFN
RLJFN ;release it
ERJMP .+1 ;don't care
RET ;return
; subroutine to test column position and output CRLF if needed
TSTCOL: MOVEI T1,.PRIOU ;get primary output designator
RFPOS ;read file position
HRRZS T2 ;keep just the column position
SKIPE T2 ;if at column 1 do not output CR/LF
TMSG <
> ;no, output a CRLF
RET ;return to whence we came
SUBTTL STORAGE FOR PROGRAM
PDLST: BLOCK .PDLSZ ;Stack
CMDBLK:
RPARSE
.PRIIN,,.PRIOU
-1,,PROMPT
-1,,TXTBUF
-1,,TXTBUF
.TXTSZ
0
-1,,ATMBUF
.ATMSZ
JFNBLK
JFNBLK:
0
.PRIIN,,.PRIOU
0
0
0
0
0
0
0
BLOCK 10
READJF: BLOCK 1 ;JFN for input file
WRITEJ: BLOCK 1 ;JFN for output file
HLPJFN: BLOCK 1 ;JFN for help file
TXTBUF: BLOCK .TXTSZ/5 ;text buffer (for COMND JSYS)
ATMBUF: BLOCK .ATMSZ/5 ;atom buffer (for COMND JSYS)
HLPBUF: BLOCK .HLPSZ/5
KWLST: ;keyword list
.KW.SZ ,, .KW.SZ ;size
DUMP$ ,, .DUMP
EXIT$ ,, .EXIT
HELP$ ,, .HELP
PUSH$ ,, .PUSH
TAKE$ ,, .TAKE
WIDTH$ ,, .WIDTH
.KW.SZ==: . - KWLST - 1
TEMP: BLOCK 200
BYTCNT: BLOCK 1
WIDCNT: BLOCK 1
MAXWID: .MXWID
; pages needed for PMAPing in the ACCOUNTS-TABLE.BIN file
ACCPG: BLOCK 1 ;current account page mapped
ACCWRD: BLOCK 1 ;word in page (ACCPAG) currently being checked
ACCPTR: BLOCK 1 ;address of first word of accounts
NXTACC: BLOCK 1 ;address of alternate account (if one exists)
LSTTYP: BLOCK 1 ;block type of last block processed
HSHCNT: BLOCK 1 ;next word to be read in hash table
HSHSIZ: BLOCK 1 ;size of hash table (words)
SUBTTL ASCIZ AND SIXBIT STRINGS.
CRLF: ASCIZ/
/ ;CR/LF
QUEST: ASCIZ/?/ ;Question Mark
PERCNT: ASCIZ/%/ ;Percent sign
PROMPT: ASCIZ/ACTDMP>/ ;prompt
RNAM: ASCIZ/ACCOUNTS-TABLE/ ;default name for input file
REXT: ASCIZ/BIN/ ;default extension for input file
WNAM: ASCIZ/DUMP-OF/ ;default name for outptu file
WEXT: ASCIZ/ACCOUNTING-DATA-BASE/ ;default extension for output file
; commands
DUMP$: ASCIZ/DUMP/
EXIT$: ASCIZ/EXIT/
HELP$: ASCIZ/HELP/
PUSH$: ASCIZ/PUSH/
TAKE$: ASCIZ/TAKE/
WIDTH$: ASCIZ/WIDTH/
; noise words
GDUMP: ASCIZ/file/
GDUMP0: ASCIZ/into file/
GEXIT: ASCIZ/out of ACTDMP/
GHELP: ASCIZ/with ACTDMP/
GPUSH: ASCIZ/to new EXEC/
GTAKE: ASCIZ/commands from/
GWIDTH: ASCIZ/of lines in lines in output file/
SUBTTL ERROR HANDLING ROUTINE.
FATAL: ;here on a fatal error (exit program)
CALL TSTCOL ;write a CR/LF iff needed
HRROI T1,QUEST ;get ready to write fatal error message
PSOUT ;write the first part
CALL ERROR ;write the error
HALTF ;stop
JRST .-1 ;don't allow user to "CONTINUE" on a
; fatal error
WERROR: ;here to write a non-fatal "?" error
CALL TSTCOL ;put curse in column one
HRROI T1,QUEST ;pointer to question mark
PSOUT ;write it
JRST ERROR ;write an error message
WARN: ;here on a warning message (continue)
CALL TSTCOL ;write a CR/LF iff needed
HRROI T1,PERCNT ;get ready to write warning message
PSOUT ;write the first part
;"fall through" to error text handling
ERROR: ;here to write actual error
MOVEI T1,.PRIOU ;write to TTY:
HRLOI T2,.FHSLF ;for me, most recent
SETZ T3, ;no byte limit
ERSTR ;get (and write) the error
JFCL ;if error with ERSTR, ignore it
JFCL ;if error with ERSTR, ignore it
POPJ P, ;return
; full page data (PMAP) at end...
.PAGE0=<<./1000>+1>*1000 ;get address of next page (in memory at
; assembly time)
LOC .PAGE0
.HSHPG==./.PAGSZ ;get page number of hash page
HSHPAG: BLOCK .PAGSZ ;hash page in ACCOUNTS-TABLE.BIN
LOC .PAGE0+.PAGSZ
.ACCPG==./1000
ACCPAG: BLOCK .PAGSZ ;the actual data page for the account
END <3,,ACTDMP> ;end of source code