Trailing-Edge
-
PDP-10 Archives
-
bb-d868a-bm
-
3-sources/actgen.mac
There are 33 other files named actgen.mac in the archive. Click here to see a list.
;<3-UTILITIES>ACTGEN.MAC.15, 8-Nov-77 13:53:14, EDIT BY KIRSCHEN
;<3-UTILITIES>ACTGEN.MAC.14, 8-Nov-77 10:43:41, EDIT BY KIRSCHEN
;<3-UTILITIES>ACTGEN.MAC.13, 8-Nov-77 10:37:50, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>ACTGEN.MAC.12, 2-Nov-77 15:12:11, EDIT BY KIRSCHEN
;FIX BUG INDUCED BY DUPLICATE ACCOUNTS: P6 CLOBBERAGE DUE TO INCORRECT
;USE OF TRVAR/ASUBR.
;<3-UTILITIES>ACTGEN.MAC.11, 26-Oct-77 10:57:05, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>ACTGEN.MAC.9, 20-Oct-77 09:05:28, EDIT BY KIRSCHEN
;LEFT JUSTIFY SIXBIT NAMES OF LESS THAN 6 CHARACTERS
;<3-UTILITIES>ACTGEN.MAC.8, 29-Sep-77 21:21:31, EDIT BY OSMAN
;CHANGE RLJFN TO CLZFF SO OTHER PROCESS'S JFN'S AREN'T WIPED OUT
;<3-UTILITIES>ACTGEN.MAC.7, 8-Sep-77 16:12:46, EDIT BY HURLEY
;MAKE ACTGEN NOT PRINT PANIC LEVEL INTERRUPT ON SIMPLE FAILURES
;<3-UTILITIES>ACTGEN.MAC.6, 25-Aug-77 11:45:12, EDIT BY KIRSCHEN
;FIX VERSION NUMBERS FOR RELEASE 3
;<MACK>ACTGEN.MAC.347, 22-Aug-77 16:35:37, Edit by MACK
;CLEAR USER NAME BLOCK AFTER EACH USE
;<MACK>ACTGEN.MAC.346, 17-Aug-77 16:00:49, Edit by MACK
;<MACK>ACTGEN.MAC.344, 17-Aug-77 10:38:04, Edit by MACK
;<MACK>ACTGEN.MAC.341, 16-Aug-77 15:19:57, Edit by MACK
;WILDCARDING USER NAME STRINGS
;<MACK>ACTGEN.MAC.340, 11-Aug-77 13:21:39, Edit by MACK
;ADD ACTDAT DEFSTR'S TO ACTGEN
;<MACK>ACTGEN.MAC.336, 3-Aug-77 14:24:15, Edit by MACK
;<MACK>ACTGEN.MAC.335, 1-Aug-77 17:52:04, Edit by MACK
;ADDED ACTGEN HELP MESSAGE
;<MACK>ACTGEN.MAC.333, 28-Jul-77 14:17:30, Edit by MACK
;<MACK>ACTGEN.MAC.332, 28-Jul-77 14:08:26, Edit by MACK
;<MACK>ACTGEN.MAC.331, 28-Jul-77 11:49:48, Edit by MACK
;<MACK>ACTGEN.MAC.330, 28-Jul-77 10:38:59, Edit by MACK
;<MACK>ACTGEN.MAC.328, 28-Jul-77 08:20:19, Edit by MACK
;<MACK>ACTGEN.MAC.326, 27-Jul-77 14:05:41, Edit by MACK
;ADD INSTALL COMMAND
;<MACK>ACTGEN.MAC.324, 26-Jul-77 13:50:13, Edit by MACK
;COMND JSYS ERROR MSGS PRINTED WHEN THEY OCCUR
;<MACK>ACTGEN.MAC.323, 26-Jul-77 12:15:24, Edit by MACK
;<MACK>ACTGEN.MAC.322, 26-Jul-77 11:15:45, Edit by MACK
;<MACK>ACTGEN.MAC.321, 26-Jul-77 10:53:20, Edit by MACK
;POPDAT CHECKS TO SEE IF DATSTK IS EMPTY BEFORE POPPING
;<MACK>ACTGEN.MAC.320, 26-Jul-77 09:51:46, Edit by MACK
;<MACK>ACTGEN.MAC.319, 5-Jul-77 09:48:51, Edit by MACK
;<MACK>ACTGEN.MAC.318, 1-Jul-77 16:21:35, Edit by MACK
;<MACK>ACTGEN.MAC.317, 30-Jun-77 16:59:36, Edit by MACK
;<MACK>ACTGEN.MAC.316, 30-Jun-77 15:31:12, Edit by MACK
;<MACK>ACTGEN.MAC.315, 30-Jun-77 15:15:22, Edit by MACK
;ADJUST ACTBYT WHEN ERRORS IN .ACCT FOUND
;<MACK>ACTGEN.MAC.314, 30-Jun-77 10:03:51, Edit by MACK
;<MACK>ACTGEN.MAC.311, 29-Jun-77 11:10:27, Edit by MACK
;<MACK>ACTGEN.MAC.309, 27-Jun-77 14:55:21, Edit by MACK
;FIXED FREE STG MANAGER TO ZERO THE BLOCK
;<MACK>ACTGEN.MAC.306, 27-Jun-77 13:29:58, Edit by MACK
;ADDED CM%DWC TO .CMDAT OF .CMDIR FOR DIRECTORY-NAME WILDCARDING
;<MACK>ACTGEN.MAC.305, 27-Jun-77 08:36:12, Edit by MACK
;FIXED ACCOUNT LENGTH PROBLEM
;<MACK>ACTGEN.MAC.304, 21-Jun-77 13:28:46, Edit by MACK
;<MACK>ACTGEN.MAC.301, 17-Jun-77 15:19:29, Edit by MACK
;<MACK>ACTGEN.MAC.300, 16-Jun-77 14:48:21, Edit by MACK
;ADDED CM%PO TO FDB FOR DIRECTORY AND USER NAMES
;<MACK>ACTGEN.MAC.299, 15-Jun-77 15:52:17, Edit by MACK
;<MACK>ACTGEN.MAC.298, 15-Jun-77 15:36:24, Edit by MACK
;<MACK>ACTGEN.MAC.297, 8-Jun-77 11:00:24, Edit by MACK
;ADDED CM%RAI TO .CMFLG OF COMND STATE BLOCK
;<MACK>ACTGEN.MAC.288, 16-May-77 10:47:59, Edit by MACK
;<MACK>ACTGEN.MAC.264, 10-May-77 11:01:15, Edit by MACK
;HASH ALGORITHM AND COLLISION RESOLUTION
;<MACK>ACTGEN.MAC.221, 26-Apr-77 17:19:57, Edit by MACK
;COSMETIC CODE CLEANUP
;<MACK>ACTGEN.MAC.212, 26-Apr-77 12:09:41, Edit by MACK
;<MACK>ACTGEN.MAC.205, 24-Apr-77 21:38:17, Edit by MACK
;REMOVED JSERR AFTER SOUTS
;<MACK>ACTGEN.MAC.199, 19-Apr-77 16:50:21, Edit by MACK
;BLKOUT AND ASSOCIATED ROUTINES ADDED
;<MACK>ACTGEN.MAC.194, 14-Apr-77 16:08:18, Edit by MACK
;REWRITE OF DATA POPPING/MERGING IN .ACCT AND AT EOF
;<MACK>ACTGEN.MAC.179, 11-Apr-77 10:23:18, Edit by MACK
;FIXED ERROR HANDLERS PRSERR AND PUTERR
;<MACK>ACTGEN.MAC.167, 6-Apr-77 13:41:46, Edit by MACK
;REMOVED CODE TO REINIT PDL-STACK AT PARSE1
;<MACK>ACTGEN.MAC.163, 5-Apr-77 11:53:57, Edit by MACK
;ROUTINES SAVCMD AND RESCMD PUSH AND POP COMND STATE BLOCK AND BUFFER
; ON CMDSTK
;<MACK>ACTGEN.MAC.159, 4-Apr-77 14:41:05, Edit by MACK
;<MACK>ACTGEN.MAC.158, 4-Apr-77 10:39:42, Edit by MACK
;ACTIVATE ALL CALLS TO PLBLK
;<MACK>ACTGEN.MAC.157, 4-Apr-77 10:20:43, Edit by MACK
;CELL TOTLEN KEEPS TRACK OF LENGTH OF DATA BLOCKS - ULTIMATELY PUT
; IN DATASZ IN ACTHDR
;<MACK>ACTGEN.MAC.155, 31-Mar-77 10:29:44, Edit by MACK
;TWO CONTEXT STACKS: ONE FOR JFNS, ONE FOR PTRS TO ACCT VAL DATA
; IN FREE SPACE. STACK PTRS ARE P2 FOR JFNSTK AND P3 FOR DATSTK
;<MACK>ACTGEN.MAC.153, 30-Mar-77 13:52:35, Edit by MACK
;.FSPTR IN LH OF ENTRY ON CONTEXT STACK MEANS ENTRY PTS TO FREE SPACE
;<MACK>ACTGEN.MAC.152, 30-Mar-77 11:16:43, Edit by MACK
;FREE SPACE HEADER CREATED AT ACTGEN INITIALIZATION
;<MACK>ACTGEN.MAC.145, 28-Mar-77 17:14:10, Edit by MACK
;EXPANDED PLBLK TO ASK FOR FREE SPACE FOR DATA BLOCKS
;<MACK>ACTGEN.MAC.141, 28-Mar-77 13:35:44, Edit by MACK
;ADDED ROUTINES GETFRE AND RELFRE TO MANAGE FREE STORAGE
;<MACK>ACTGEN.MAC.134, 24-Mar-77 11:18:32, Edit by MACK
;ALTERED "ACCOUNT" CODE
;<MACK>ACTGEN.MAC.130, 24-Mar-77 09:38:19, Edit by MACK
;CREATED F (AC6) - FLAG AC
;P3 IS POINTER TO CONTEXT STACK
;<MACK>ACTGEN.MAC.122, 10-Mar-77 09:24:17, Edit by MACK
;ADDITIONS TO USER NAME/ALL USERS ROUTINES
;<MACK>ACTGEN.MAC.114, 9-Mar-77 13:38:19, Edit by MACK
;DISABLE CALLS TO PLBLK TEMPORARILY
;<MACK>ACTGEN.MAC.110, 8-Mar-77 13:52:38, Edit by MACK
;<MACK>ACTGEN.MAC.107, 8-Mar-77 11:59:11, Edit by MACK
;<MACK>ACTGEN.MAC.104, 7-Mar-77 15:45:19, Edit by MACK
;REVISED .GROUP CODE
;<MACK>ACTGEN.MAC.100, 4-Mar-77 16:18:22, Edit by MACK
;<MACK>ACTGEN.MAC.95, 3-Mar-77 14:55:07, Edit by MACK
;CODE TO DO GTJFN/OPENF ON <SYSTEM>ACCOUNTS-TABLE.BIN
;<MACK>ACTGEN.MAC.89, 3-Mar-77 09:31:48, Edit by MACK
;ADDED PI SYSTEM INIT AND INTERRUPT HANDLERS
;CTRL/A IS ESCAPE CHR TO GET BACK TO ACTGEN COMMAND LEVEL
;<MACK>ACTGEN.MAC.86, 2-Mar-77 15:25:10, Edit by MACK
;PLDIR SEPARATES AND DEPUNCTUATES FIELDS IN THE STRING STR:<DIRNAME>
;<MACK>ACTGEN.MAC.78, 1-Mar-77 16:23:38, Edit by MACK
;ADDED ERROR HANDLERS PRSERR AND JSYSER
;<MACK>ACTGEN.MAC.65, 16-Feb-77 11:20:54, Edit by MACK
;ADDED ROUTINE GETFNC TO GET FBD FUNCTION CODE USED BY COMND
;<MACK>ACTGEN.MAC.61, 15-Feb-77 13:53:53, Edit by MACK
;REMOVED TAKTST CODE AND CALL TO IT FROM ENDCOM
;PLDIR DOES JSERR IF DIRST FAILS
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE ACTGEN
SEARCH MONSYM, MACSYM
.REQUIRE SYS:MACREL
SALL
; ACCUMULATOR DEFINITIONS
F=0 ;USED BY ACTGEN
T1=1 ;TEMPORARY
T2=2 ;TEMPORARY
T3=3 ;TEMPORARY
T4=4 ;TEMPORARY
Q1=5 ;PRESERVED
Q2=6
Q3=7 ;PRESERVED
P1=10 ;USED BY ACTGEN
P2=11 ;USED BY ACTGEN
P3=12 ;USED BY ACTGEN
P4=13 ;USED BY ACTGEN
P5=14 ;PRESERVED
P6=15 ;PRESERVED (CAUTION, USED BY SOME MACROS IN MACSYM)
CX=16 ;RESERVED FOR SUPPORT CODE
P=17 ;PUSH-DOWN POINTER
; LOCAL AC USAGE
;
; F/ FLAG AC
; P1/ START ADDRESS OF AN ACCOUNT DATA BLOCK
; P2/ POINTER TO JFN STACK
; P3/ POINTER TO DATA STACK
; P4/ POINTER TO COMND STATE BLOCK STACK
; THESE STACKS ARE NORMAL PUSHDOWN LISTS
; VERSION NUMBER DEFINITIONS
VMAJOR==3 ;MAJOR VERSION OF ACTGEN
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==2 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
VACTGEN== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
KEYSIZ==.CMDEF+2 ;DITTO
PDLEN==100 ;PUSH-DOWN STACK DEPTH
JFNLEN==^D20 ;JFN STACK DEPTH
CMSLEN==20*<.CMGJB+5+BUFSIZ> ;COMND STATE STACK DEPTH
DATLEN==^D200 ;DATA STACK DEPTH
MAXLEN==^D39 ;MAX # CHARACTERS IN ACCOUNT, USER, OR DIR NAME
HTBLEN==1000 ;HASH TABLE SIZE - CURRENTLY ONE PAGE
HSHLEN==HTBLEN-1 ;NUMBER OF HASH VALUES
HTBBLK==100000 ;START OF HASH TABLE IN THIS FORK
HSHVAL==HTBBLK+1 ;START OF HASH VALUES IN HASH TABLE
; FREE SPACE BOUNDS
MINFRE==HTBBLK+HTBLEN ;LOWER LIMIT STARTS AFTER HASH TABLE
MAXFRE==770000 ;UPPER LIMIT
STDECH=="A"-100 ;STANDARD ESCAPE CHARACTER
STDESC==1B<STDECH> ;CHANNEL MASK FOR ESCAPE CHARACTER
; DATSTK ENTRIES
DEFSTR (ENTYP,0,17,18) ;TYPE OF ENTRY
DEFSTR (FSADR,0,35,18) ;ADDRESS OF DATA BLOCK IN FREE SPACE
;GENERAL PARAMETERS
; ALL BLOCKS HAVE THESE FIELDS - NULL BLOCK DOES NOT HAVE
; AN EXPIRATION DATE
DEFSTR (BKTYP,0,17,18) ;BLOCK TYPE
DEFSTR (BKLEN,0,35,18) ;BLOCK LENGTH
DEFSTR (XPDAT,1,35,36) ;EXPIRATION DATE
;HASH TABLE
;ACCOUNT HEADER
DEFSTR (DATASZ,2,35,36) ;TOTAL LENGTH OF ACCOUNT DATA BLOCK
DEFSTR (ACPTR,3,35,36) ;POINTER TO NEXT ACCOUNT DATA BLOCK
DEFSTR (ACNAM,4,35,36) ;START OF ASCIZ ACCOUNT STRING NAME
;USER NAME
DEFSTR (USRNM,2,35,36) ;START OF USER NAME STRING
;SXSTR - SIXBIT STRUCTURE NAME - IS COMMON TO ALL DIRECTORY ENTRIES
DEFSTR (SXSTR,2,35,36) ;SIXBIT STRUCTURE NAME
;DIRECTORY NAME
DEFSTR (DIRNM,3,35,36) ;START OF DIRECTORY NAME STRING
;USER GROUP
DEFSTR (USRGP,2,35,36) ;GROUP NUMBER
;DIRECTORY GROUP
DEFSTR (DIRGP,3,35,36) ;GROUP NUMBER
;BLOCK TYPES
.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
SUBTTL MAIN ENTRY POINT AND INITIALIZATION
START: SKIPE ACTJFN ;ACCOUNT FILE OPEN?
CALL CLSACT ;YES, GO UNMAP AND CLOSE IT
RESET ;RESET THE UNIVERSE
MOVX T1,.FHSLF ;GET CAPABILITIES FOR THIS PROCESS
RPCAP
TXNN T3,SC%WHL!SC%OPR ;PRIVILEGED USER?
JRST [ TMSG <? WHEEL or OPERATOR capability required>
HALTF
JRST START] ;GO RESTART
MOVX T1,.FHSLF ;INITIALIZE INTERRUPT SYSTEM
DIR ;TURN IT OFF FIRST
MOVE T2,[LEVTAB,,CHNTAB] ;SET UP PI SYSTEM
SIR
MOVX T1,.FHSLF ;GET OUR FORK HANDLE
MOVEI T2,STDECH ;SET UP STANDARD ESCAPE CHARACTER
MOVEM T2,TRPCHR
AIC ;ON CHANNEL 5
HRLZ T1,TRPCHR ;ENABLE ESCAPE CHARACTER
HRRI T1,TRPCHN ; ON ITS OWN CHANNEL
ATI
MOVX T1,.FHSLF
MOVE T2,ONCHNS ;ACTIVATE ALL DESIRED CHANNELS
AIC
MOVX T1,.FHSLF ;GET OUR FORK HANDLE
EIR ;ENABLE PI SYSTEM
;...
SUBTTL COMMAND PARSER AND DISPATCH
;...
START1: MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
MOVE P2,[IOWD JFNLEN,JFNSTK] ;SET UP JFN STACK
MOVE P3,[IOWD DATLEN,DATSTK] ;SET UP DATA STACK
MOVE P4,[IOWD CMSLEN,CMDSTK] ;SET UP COMND BLOCK STACK
SETZ F, ;RESET FLAGS
TXO F,FTTFLG ;TURN ON FIRST-TIME-THROUGH FLAG
CALL BLKBLT ;ZERO SOME STORAGE SPACE
CALL FSHDR ;SET UP FREE SPACE HEADER
MOVEI T1,ACTTAB
MOVEM T1,CMDTAB
MOVEM T1,CMDBLK+.CMRTY ;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,,OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
START2: HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
HRROI T1,PTRBUF ;GET POINTER TO NEXT FIELD TO BE PARSED
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVE T1,[CM%RAI+CM%XIF+PARSE1] ;CONVERT LOWERCASE TO UPPER, INDIRECT FILES NOT ALLOWED, REPARSE ADDRESS
MOVEM T1,CMDBLK+.CMFLG ;SAVE REPARSE ADDRESS
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
MOVEI T1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM T1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI T1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM T1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI T1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM T1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
PARSE: HRROI T1,PROMPT ;GET POINTER TO PROGRAM'S PROMPT STRING
CALL CMDINI ;OUTPUT THE PROMPT
PARSE1: MOVE T1,[CZ%NCL+.FHSLF] ;RELEASE ALL NON-OPEN JFN'S OF OURSELF AND BELOW
CLZFF
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
MOVEI T1,GJFBLK ;GET ADDRESS OF GTJFN BLOCK
MOVEM T1,CMDBLK+.CMGJB ;STORE POINTER TO GTJFN BLOCK
PARSE3: CALL SETFDB
MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
COMND ;DO INITIAL PARSE
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;VALID COMMAND ENTERED ?
JRST PARSE5 ;YES, GO DISPATCH TO PROCESSING ROUTINE
CALL TSTCOL ;TEST COLUMN POSITION, NEW LINE IF NEEDED
TMSG <? ACTGEN: No such ACTGEN command as ">
MOVE T1,CMDBLK+.CMABP ;GET POINTER TO ATOM BUFFER
PSOUT ;OUTPUT STRING ENTERED BY USER
TMSG <"
> ;OUTPUT END-OF-MESSAGE
JRST PARSE ;GO TRY TO GET A COMMAND AGAIN
PARSE5: HRRZ T1,(T2) ;GET DISPATCH ADDRESS
TXNE F,BASFLG ;WAS A BAD ACCOUNT SEEN?
JRST [ CAIE T1,.ACCT ;IS IT A NEW ACCOUNT ENTRY?
JRST PARSE ;NO, IGNORE ENTRY AND PARSE NEXT ONE
JRST PARSE6] ;GO PARSE ACCOUNT ENTRY
PARSE6: CALL (T1) ;PERFORM REQUESTED FUNCTION
JRST PARSE ;GO PARSE NEXT COMMAND
;TRAP CHARACTER HANDLER
TRAP: MOVX T1,.PRIOU ;GET PRIMARY OUTPUT JFN
CFOBF ;CLEAR OUTPUT BUFFER
TMSG <
> ;PRINT A CRLF
MOVX T1,.PRIOU ;GET OUTPUT JFN AGAIN
MOVX T2,"^" ;ECHO ESCAPE CHAR
BOUT ; ON USER'S TERMINAL
MOVE T2,TRPCHR ;GET THE TRAP CHAR
TRO T2,100 ;TURN IT INTO ITS ASCII COUNTERPART
BOUT ;TYPE IT TO USER
CALL TSTCOL ;GET NEW LINE IF NEEDED
CALLRET RESUME ;CONTINUE
; ROUTINE TO ZERO SOME STORAGE LOCATIONS
; CALL BLKBLT
; RETURNS: +1 ALWAYS
; CLOBBERS T1
BLKBLT: SETZM STRUCT
MOVE T1,[XWD STRUCT,STRUCT+1]
BLT T1,STRUCT+ZBKLEN-1 ;ZERO THE BLOCK
RET
SUBTTL TAKE (COMMANDS FROM) FILE-SPEC
.TAKE: HRROI T2,[ASCIZ/COMMANDS FROM/] ;GET NOISE TEXT
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
MOVX T1,GJ%OLD ;GET EXISTING FILE FLAG
MOVEM T1,GJFBLK+.GJGEN ;STORE GTJFN FLAGS
HRROI T1,[ASCIZ/ACCOUNTS/] ;GET DEFAULT FILE NAME
MOVEM T1,GJFBLK+.GJNAM ;STORE DEFAULT FILE NAME
HRROI T1,[ASCIZ/CMD/] ;GET DEFAULT FILE TYPE FIELD
MOVEM T1,GJFBLK+.GJEXT ;STORE DEFAULT EXTENSION
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFIL)] ;GET FDB ADDRESS
COMND ;PARSE INPUT FILE SPEC
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;PARSED FILE-SPEC OK ?
JRST TAKE5 ;YES, GO ON AND SAVE INPUT JFN
HRROI T1,[ASCIZ/? ACTGEN: Invalid file specification, /]
CALL PUTERR ;ERROR
CALLRET RESUME ;GO RESTART
; HERE ON A GOOD INPUT FILE SPEC
TAKE5: HRRZM T2,INJFN ;SAVE INPUT JFN FOR COMMANDS
TXON F,TAKFLG ;TAKE FILE BEING PROCESSED?
JRST [ CALL ENDCOM ;NO, PARSE END OF COMMAND
RET ;RETURN, BAD CONFIRMATION
JRST .+1] ;GOOD RETURN, CONTINUE
CALL CLRGJF ;GO CLEAR GTJFN BLOCK USED BY COMND JSYS
;PREVIOUS CALL MAY GO AWAY... LEAVE HERE FOR NOW
SETZM NAMBUF ;INITIALIZE FILENAME BUFFER
HRROI T1,NAMBUF ;GET POINTER TO PLACE TO PUT FILENAME
MOVE T2,INJFN ;GET INPUT JFN
MOVX T3,<FLD(.JSAOF,JS%NAM)> ;GET FLAG BITS SAYING OUTPUT NAME ONLY
JFNS ;PUT FILENAME OF INPUT FILE IN BUFFER
TXNN F,FTTFLG ;FIRST TIME THROUGH ACTGEN?
JRST TAKE10 ;NO, FILES ARE ALREADY OPEN
MOVE T1,INJFN ;GET INPUT JFN
MOVE T2,[7B5+OF%RD] ;7-BIT BYTES, READ ACCESS
OPENF ;OPEN THE FILE
JRST [ HRROI T1,[ASCIZ/? Cannot open input file, /]
CALL PUTERR ;ISSUE REST OF MESSAGE AND RETURN
CALLRET RESUME]
;GET A JFN FOR OUTPUT FILE ACCOUNTS-TABLE.BIN
MOVX T1,GJ%FOU+GJ%SHT+.GJDEF
HRROI T2,[ASCIZ/ACCOUNTS-TABLE.BIN/]
GTJFN ;GET A JFN FOR DATA FILE
JRST [ HRROI T1,[ASCIZ/ ? Cannot get jfn for file ACCOUNTS-TABLE.BIN, /]
CALL PUTERR ;ISSUE REST OF MESSAGE AND RETURN
CALLRET RESUME]
;...
;...
;OPEN DATA FILE FOR WRITING
MOVEM T1,ACTJFN ;SAVE JFN
MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD+OF%WR> ;36-BIT BYTES, OPEN FOR WRITE AND READ
OPENF ;OPEN THE FILE
JRST [ HRROI T1,[ASCIZ/? Cannot open output file, /]
CALL PUTERR ;ISSUE REST OF MESSAGE AND RETURN
CALLRET RESUME]
HRLZ T1,ACTJFN ;OUTPUT FILE JFN
MOVEI T2,HTBBLK ;START OF HASH TABLE
IDIVI T2,HTBLEN ;PAGE # OF HASH TABLE IN THIS FORK
HRLI T2,.FHSLF ;SAY THIS PROCESS
MOVX T3,PM%RD+PM%WR ;READ/WRITE ACCESS
PMAP ;MAP FILE PG. 0 TO THIS FORK
SETZM HTBBLK ;ZERO HASH TABLE
MOVE T1,[XWD HTBBLK,HTBBLK+1]
BLT T1,HTBBLK+HTBLEN-1
MOVEI P1,HTBBLK ;POINTER TO HASH TABLE
MOVEI T1,.TYHSH ;HASH TABLE BLOCK TYPE
STOR T1,BKTYP,(P1) ;STORE IN HEADER WORD
MOVEI T1,HTBLEN ;TABLE LENGTH
STOR T1,BKLEN,(P1) ;STORE IN HEADER
MOVE T1,ACTJFN ;OUTPUT FILE JFN
MOVEI T2,HTBLEN ;BYTE #1000
MOVEM T2,BYTCNT ;SAVE AS # BYTES ALREADY WRITTEN OUT
SFPTR ;MAKE FILE PTR POINT TO
; TOP OF PAGE 1 FOR SUBSEQUENT I/O
; TO FILE
JRST [ HRROI T1,[ASCIZ/? Cannot set file pointer, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;GO RESTART
;SAVE JFNS'S AND GO PARSE ENTRIES
TAKE10: HRLZ T1,INJFN ;GET INPUT JFN
HRRI T1,.NULIO ;OUTPUT JFN IS ALWAYS NULL I/O
MOVEM T1,CMDBLK+.CMIOJ ;SAVE NEW JFN'S
MOVEI T1,TAKTAB ;POINTER TO FILE ENTRIES TABLE
MOVEM T1,CMDTAB ;STORE TO SET UP FDB FOR "TAKE" ENTRIES
JRST PARSE ;NO, CONTINUE TO PARSE FILE ENTRIES
SUBTTL ACCOUNT ENTRY
.ACCT: TRVAR <BYTLEN>
TXNN F,FTTFLG ;FIRST TIME THROUGH ACTGEN?
CALL ACCT5 ;NO, GO SEE IF A SUBACCOUNT WAS SEEN
TXZ F,FTTFLG ;RESET FLAG
SETZM TOTLEN ;RESET LENGTH OF ACCOUNT DATABLOCK
SETZM BYTLEN ;RESET LENGTH IN BYTES OF NEW ACCT STRING
SETZM ACTHDR ;CLEAR ACCOUNT HEADER
MOVE T1,[XWD ACTHDR,ACTHDR+1]
BLT T1,ACTHDR+12-1
MOVEI P1,ACTHDR ;GET ADDRESS OF ACCOUNT HEADER
MOVEI T1,CMDBLK ;GET ADDR OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFLD)] ;ARBITRARY FIELD FOR ACCOUNT NAME
COMND ;PARSE ACCOUNT STRING NAME
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST ACCTX ;NO, GO PROCESS ERROR
MOVEI T1,4(P1) ;PLACE TO PUT ACCOUNT NAME
HRLI T1,(<POINT 7,>) ;7-BIT BYTE POINTER
HRROI T2,ATMBFR ;PTR TO ACCOUNT NAME FOUND
MOVEI T3,MAXLEN+1 ;MAX # CHARS IN ACCOUNT NAME PLUS TERMINATOR
MOVEI T4,.CHNUL ;TERMINATE ON NULL BYTE
SOUT ;SAVE ACCOUNT NAME IN DATA BLOCK
LDB T2,T1 ;GET LAST CHARACTER MOVED
SKIPE T2 ;IS IT THE TERMINATOR?
JRST ACCTX1 ;NO, ERROR
SETZ T2,
IDPB T2,T1 ;PAD END OF ACCOUNT STRING QITH A NULL
MOVEI T2,MAXLEN+1 ;GET MAX # CHARS POSSIBLY MOVED
SUB T2,T3 ;COMPUTE # CHARS ACTUALLY IN THE STRING
SOS T2 ;SUBTRACT ONE FOR NULL COPIED
CALL CHKACT ;SEE IF ACCT NAME LENGTH IS OK
JRST ACCTX1 ;NO, RETURN ERROR
MOVEM T2,BYTLEN ;SAVE LENGTH OF THIS ACCT STRING
IDIVI T2,5 ;COMPUTE # WORDS IN STRING + REMAINDER
AOS T2 ;CORRECT THE COUNT
MOVEM T2,ACTLEN ;SAVE # WORDS IN ACCOUNT NAME
ADDI T2,4 ;LENGTH OF REST OF ACCOUNT HEADER
STOR T2,BKLEN,(P1) ;SAVE IN ACCOUNT BLOCK
MOVEM T2,TOTLEN ;KEEP TRACK OF BLOCK LENGTH SEEN SO FAR
MOVEI T2,.TYACC ;TYPE OF DATA BLOCK
STOR T2,BKTYP,(P1) ;SAVE BLOCK TYPE IN ACCOUNT HEADER
ACCT1: MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,ACTSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE A SWITCH OR CONFIRMATION CHAR
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST ACCTX ;NO, GO PROCESS ERROR
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST ACCT4 ;NO, PARSED A CONFIRMATION CHAR
HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
JRST ACCTX0 ;ERROR IN PARSING FIELD AFTER SWITCH
TXNE F,EXPFLG ;EXPIRATION DATE SEEN?
JRST ACCT3 ;YES
; ...
; ...
MOVEI T1,CMDBLK ;NO, MUST HAVE PARSED A SUBACCOUNT
MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE EXPIRATION DATE SWITCH OR CONFIRMATION CHAR
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST ACCTX0 ;NO, GO PROCESS ERROR
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST ACCT4 ;NO, MUST HAVE SEEN A CONFIRMATION CHAR
HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
JRST ACCTX0 ;ERROR IN PARSING FIELD AFTER SWITCH
STOR T2,XPDAT,(P1) ;PLACE DATE IN DATA BLOCK
CALL ACCT7 ;PLACE DATA BLOCK IN FREE SPACE
ACCT2: TXZ F,EXPFLG ;GOOD RETURN, RESET FLAG
CALL ENDCOM ;PARSE END-OF-ENTRY
RET ;ERROR RETURN
RET ;GOOD RETURN
;PARSING ERROR ENCOUNTERED IN ACCOUNT ENTRY
ACCTX0: MOVE T1,ACTBYT ;LENGTH OF ACCOUNT STRING BEING FORMED
SUB T1,BYTLEN ;SUBTRACT OFF LENGTH OF LOSING ACCOUNT
MOVEM T1,ACTBYT ;AND SAVE ADJUSTED LENGTH
HLRO T2,P2 ;GET CURRENT JFN STACK DEPTH
MOVNS T2 ;MAKE IT POSITIVE
CAIE T2,JFNLEN ;ANY PREVIOUS CONTEXTS ON STACK?
SOS ACTBYT ;YES, CORRECT COUNT FOR DELIMITER
ACCTX: HRROI T1,[ASCIZ/? Incorrect field: /]
CALL PRSERR ;SEND MSG TO USER
ACCTX2: TXZ F,EXPFLG!SASFLG ;RESET FLAGS
TXO F,BASFLG ;NOTE THAT A BAD ACCOUNT WAS SEEN
RET ;RETURN TO PARSE NEXT ENTRY
;ACCOUNT NAME TOO LONG, TELL USER
ACCTX1: HLRO T1,P2 ;JFN STACK DEPTH
MOVNS T1 ;MAKE IT POSITIVE
CAIN T1,JFNLEN ;ANY PREVIOUS CONTEXTS STACKED?
JRST ACCTX3 ;NO, GO PRINT MESSAGE
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? Subaccount >
HRROI T1,ATMBFR ;SUBACCOUNT NAME
PSOUT
TMSG < in entry: >
HRROI T1,BUFFER ;THIS ENTRY
PSOUT
TMSG <from file: >
MOVX T1,.PRIOU
MOVE T2,INJFN
SETZM T3
JFNS ;TELL USER FILE NAME
TMSG <
causes account name to exceed 39 characters
>
JRST ACCTX2 ;CONTINUE
ACCTX3: HRROI T1,[ASCIZ/? Account name too long: /]
CALL PRSERR ;TELL USER
JRST ACCTX2 ;AND CONTINUE
; ROUTINE TO SEE IF ACCOUNT NAME IS LEQ 39 CHARACTERS
; T2/ # CHARACTERS IN THIS ACCOUNT NAME
; CALL CHKACT
; RETURNS: +1 ERROR, NAME TOO LONG
; +2 OK, ACTBYT UPDATED
; CLOBBERS T1, T4
CHKACT: SAVEAC <T2>
HLRO T1,P2 ;GET CURRENT JFNSTK DEPTH
MOVNS T1 ;MAKE IT POSITIVE
CAIE T1,JFNLEN ;ANY PREVIOUS CONTEXTS ON STACK?
AOS T2 ;YES, ADD A BYTE FOR A DELIMITER
MOVE T1,ACTBYT ;# CHARS IN ACCOUNT NAME SO FAR
ADD T1,T2 ;NEW LENGTH IF THIS ACCT IS ADDED
CAILE T1,MAXLEN ;ACCEPTABLE LENGTH?
RET ;NO, ERROR RETURN
MOVEM T1,ACTBYT
RETSKP
;EXPIRATION DATE SEEN AS FIRST SWITCH
ACCT3: STOR T2,XPDAT,(P1) ;PLACE EXPIRATION DATE IN ACCOUNT HEADER
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,SUBSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE SUBACCOUNT SWITCH OR CONFIRMATION CHAR
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST ACCTX0 ;NO, GO PROCESS ERROR
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST [ TXZ F,EXPFLG ;NO, RESET FLAG
CALL ACCT7 ;PLACE DATA BLOCK IN FREE SPACE
RET] ;AND RETURN
HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
JRST ACCTX0 ;ERROR IN PARSING FIELD AFTER SWITCH
CALL ACCT7 ;PLACE DATA BLOCK IN FREE SPACE
JRST ACCT2 ;NOW PARSE END-OF-ENTRY
;PARSED A CONFIRMATION CHARACTER AND EXPIRATION DATE NOT SEEN
ACCT4: SETZM T2 ;SAY THAT ENTRY NEVER EXPIRES
STOR T2,XPDAT,(P1) ;PLACE IT IN ACCOUNT HEADER
TXZ F,EXPFLG ;RESET FLAG
CALL ACCT7 ;PLACE DATA BLOCK IN FREE SPACE
RET ;RETURN TO PARSE NEXT ENTRY
; ROUTINE TO POP THIS LEVEL'S DATA OFF DATSTK
; AND RELEASE FREE SPACE FOR IT
; CALL POPDAT
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
POPDAT: HLRO T1,P3 ;GET DATSTK DEPTH
MOVNS T1 ;MAKE IT POSITIVE
CAIL T1,DATLEN ;STACK EMPTY?
RET ;YES, RETURN NOW
HLRO T1,P2 ;GET JFN STACK DEPTH
MOVNS T1 ;MAKE IT POSITIVE
CAIN T1,JFNLEN ;ANY PREVIOUS CONTEXTS?
JRST POPDT1 ;NO, POP AND CHECK FOR EMPTY DATSTK
HRRZI T1,FRSHDR ;FREE SPACE HEADER
POP P3,T2 ;GET TOP ITEM ON STACK
JUMPE T2,POPDT3 ;IS IT A DELIMITER?
JRST POPDT2 ;NO, ACCOUNT DATA
POPDT3: POP P3,T2 ;GET DATSTK ENTRY
HLRZ T3,T2 ;GET ENTRY TYPE
CAIE T3,.FSPTR ;DOES IT POINT TO ACCT DATA?
JRST [ PUSH P3,[0] ;NO, PUT DELIMITER BACK
RET] ;ALL DONE, RETURN
POPDT2: HRRZ T3,T2 ;START OF BLOCK IN FREE SPACE
LOAD T3,BKTYP,(T3) ;GET BLOCK TYPE
CAIN T3,.TYACC ;IS IT AN ACCOUNT?
CALL DECBYT ;YES, GO ADJUST ACTBYT
CALL RELFRE ;RELEASE FREE SPACE FOR THE BLOCK
JRST POPDTX ;ERROR, CAN'T RELEASE FREE SPACE
JRST POPDT3
;JFN STACK EMPTY - POP DATSTK TILL STACK IS EMPTY
POPDT1: HRRZI T1,FRSHDR ;FREE SPACE HEADER
POPDT4: POP P3,T2 ;GET DATA ENTRY FROM STACK
JUMPE T2,POPDT5 ;IF DELIMITER, IGNORE AND CONTINUE
HRRZ T3,T2 ;GET FREE SPACE ADDRESS OF BLOCK
LOAD T3,BKTYP,(T3) ;GET BLOCK TYPE
CAIN T3,.TYACC ;IS IT AN ACCOUNT?
CALL DECBYT ;YES, ADJUST BYTE COUNT
CALL RELFRE ;RELEASE FREE SPACE FOR THE BLOCK
JRST POPDTX ;ERROR, CAN'T RELEASE FREE SPACE
POPDT5: HLRO T2,P3 ;NOW GET STACK DEPTH
MOVNS T2 ;MAKE IT POSITIVE
CAIE T2,DATLEN ;STACK EMPTY?
JRST POPDT4 ;NO, POP SOME MORE DATA
RET ;STACK EMPTY, RETURN
; ROUTINE TO PLACE ACCOUNT HEADER BLOCK IN FREE SPACE
; CALL ACCT7
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3, T4
ACCT7: STKVAR <ACC1,ACC2,ACC3,ACC4>
MOVEM T1,ACC1
MOVEM T2,ACC2
MOVEM T3,ACC3
MOVEM T4,ACC4
TXNE F,SASFLG ;SUBACCOUNT SEEN FOR THIS ACCOUNT?
JRST ACC71 ;YES, JUST PUT BLOCK IN FREE SPACE
SETZM TMPBUF ;CLEAR A BUFFER
MOVE T1,[XWD TMPBUF,TMPBUF+1]
BLT T1,TMPBUF+ATMSIZ-1
LOAD T4,BKLEN,(P1) ;LENGTH OF ACCOUNT HEADER
SUBI T4,4 ;LENGTH OF ACCOUNT NAME
MOVNS T4
HRLZ T1,T4
HRRI T1,4(P1) ;START OF ACCOUNT NAME
MOVEM T1,ACC1 ;SAVE THIS AOBJN POINTER TO ACCT NAME
CALL HSHNAM ;GET HASH VALUE FOR THIS ACCOUNT
MOVEI T2,HSHVAL ;START OF HASH VALUES
ADD T2,T1 ;HASH VALUE IS INDEX INTO HASH TABLE
MOVE T3,0(T2) ;GET THIS HASH TABLE ENTRY
JUMPE T3,ACC71 ;JUMP IF NO COLLISIONS ON THIS ENTRY
MOVE T1,ACTJFN ;COLLISION - GET OUTPUT FILE JFN
RFPTR ;GET CURRENT POSITION IN FILE
JRST [ HRROI T1,[ASCIZ/? Cannot read output file pointer, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;GO RESTART
MOVEM T2,ACC2 ;SAVE FILE PTR FOR NOW
ACC72: MOVEM T3,ACC3 ;SAVE POINTER TO ACCOUNT BLOCK IN FILE
RIN ;GET FIRST WD OF ACCT BLK IN FILE
JUMPE T2,[HRROI T1,[ASCIZ/? EOF unexpectedly reached, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;GO RESTART
; ...
; ...
HRRZ T3,T2 ;GET BLOCK LENGTH
MOVEM T3,ACC4 ;SAVE FOR NOW
BKJFN ;BACK UP FILE PTR TO PT TO HEADER WORD
JRST [ HRROI T1,[ASCIZ/? Cannot back up output file pointer, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;GO RESTART
MOVEI T2,TMPBUF ;PLACE TO PUT ACCT BLK FROM FILE
HRLI T2,(<POINT 36,>)
MOVNS T3 ;READ EVERY WORD IN ACCT BLOCK
SIN ;GET ACCOUNT BLOCK IN FILE
LOAD T1,BKLEN,(P1) ;BLOCK LENGTH OF COLLIDING ACCOUNT
MOVE T3,ACC4 ;BLOCK LENGTH OF ACCT BLK FROM FILE
CAME T1,T3 ;LENGTHS THE SAME?
JRST ACC70 ;NO, SEE IF ANOTHER ACCT BLK IS CHAINED TO THIS ONE
MOVEI T3,TMPBUF+4 ;POINT TO ACCOUNT NAME
MOVE T1,ACC1 ;ORIGINAL AOBJN PTR TO COLLIDING BLOCK
ACC73: MOVE T4,(T3) ;GET WORD IN COLLIDING ACCT NAME
CAME T4,(T1) ;ARE THE NAMES THE SAME SO FAR?
JRST ACC70 ;NO, GO CHECK FOR ANOTHER COLLISION
AOBJP T1,ACC74 ;SAME SO FAR - JUMP IF DONE
AOS T3 ;POINT TO NEXT WORD IN ACCT NAME IN FILE
JRST ACC73 ;CONTINUE SCAN
ACC70: MOVE T3,ACC3 ;GET PTR TO THIS BLOCK AGAIN
ADDI T3,3 ;PTR TO NEXT CHAINED BLOCK
MOVE T1,ACTJFN
RIN ;GET THE POINTER
MOVE T3,T2
JUMPE T3,[MOVE T2,ACC2 ;GET NEW POINTER VALUE
CALL RESFPT ;ALL DONE, GO RESET FILE POINTER
JRST ACC71] ;PLACE ACCOUNT BLOCK IN FILE
JRST ACC72 ;CONTINUE CHECKING CHAINED ACCT BLKS
ACC71: LOAD T3,BKLEN,(P1) ;GET NEW ACCOUNT BLOCK LENGTH
HRLZS T3
HRR T3,P1 ;ADDRESS OF ACCOUNT BLOCK
CALL PLBLK ;PLACE ACCT BLK IN FREE SPACE
JRST ACCXX ;ERROR
MOVEM T1,ACTPTR ;SAVE FREE SPACE LOC WHERE ACCT BLK WAS PUT
AOS ACTNUM ;ONE MORE GOOD ACCOUNT SEEN
RET
ACC74: HLRO T2,P2
MOVNS T2 ;JFN STACK DEPTH
CAIE T2,JFNLEN ;ANY PREVIOUS CONTEXTS ON STACK?
JRST ACC70 ;YES, GO CHECK FOR FOR ANOTHER COLLISION
HRROI T1,[ASCIZ/? Duplicate account: /]
CALL PRSERR ;HAVE ALREADY SEEN THIS ACCT, TELL USER
MOVE T2,ACC2 ;GET NEW POINTER VALUE
CALL RESFPT ;RESET FILE POINTER
MOVE T1,ACTBYT
SUB T1,BYTLEN ;IGNORE DUPLICATE ACCT IN CHAR COUNT
MOVEM T1,ACTBYT ;SAVE NEW LENGTH
HLRO T2,P2 ;GET JFN STACK DEPTH
MOVNS T2 ;MAKE IT POSITIVE
CAIE T2,JFNLEN ;ANY PREVIOUS CONTEXTS ON STACK?
SOS ACTBYT ;YES, SUBTRACT ONE FOR DELIMITER
TXZ F,EXPFLG!SASFLG ;RESET FLAGS
TXO F,BASFLG
RET ;RETURN TO PARSE NEXT ENTRY
; ROUTINE TO RESET OUTPUT FILE POINTER
; CALLED LOCALLY FROM ACCT7 ONLY
RESFPT: MOVE T1,ACTJFN ;OUTPUT FILE JFN
SFPTR ;SET OUTPUT FILE PTR TO OLD VALUE
JRST [ HRROI T1,[ASCIZ/? Cannot set output file pointer, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;GO RESTART
RET ;RETURN TO CALLER
; ROUTINE TO ADJUST ACTBYT WHEN POPPING AN ACCT BLK OFF DATSTK
; T2/ DATSTK POINTER TO ACCOUNT BLOCK
; CALL DECBYT
; RETURNS: +1 ALWAYS
; CLOBBERS T3, T4
DECBYT: SAVEAC <T1,T2>
HRRZS T2
ADDI T2,4 ;START OF ACCT NAME IN FREE SPACE
HRLI T2,(<POINT 7,>) ;TURN IT INTO A BYTE POINTER
MOVEI T1,.NULIO ;THROW THE STRING AWAY
MOVEI T3,MAXLEN ;MAX # CHARS IN ACCOUNT NAME
MOVEI T4,.CHNUL ;STOP ON NULL BYTE
SOUT
AOS T3 ;IGNORE THE NULL CHAR IN THE COUNT
MOVEI T2,MAXLEN
SUB T2,T3 ;GET # CHARS IN ACCT NAME TO BE POPPED
MOVE T3,ACTBYT ;GET # CHARS IN WHOLE ACCOUNT NAME
SUB T3,T2 ;DECREMENT BY # CHARS BEING POPPED
MOVEM T3,ACTBYT ;AND SAVE FOR LATER
HLRO T1,P2 ;GET CURRENT JFNSTK DEPTH
MOVNS T1 ;MAKE IT POSITIVE
CAIE T1,JFNLEN ;ANY PREVIOUS CONTEXTS ON STACK?
SOS ACTBYT ;YES, SUBTRACT ONE FOR DELIMITER
RET ;AND RETURN
POPDTX: CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? Cannot release free space block
>
CALLRET RESUME ;GO RESTART
ACCXX: HRROI T1,[ASCIZ/? Cannot place account block in free space/]
CALL ERRMES ;TELL USER
CALLRET RESUME ;GO RESTART
; ROUTINE TO CHECK TO SEE IF A SUBACCOUNT WAS SEEN
; IF YES, SAVE CURRENT STATE ON CONTEXT STACK AND GO PROCESS
; ENTRIES IN SUBACCOUNT FILE
; CALL ACCT5
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2
ACCT5: TXZE F,BASFLG ;WAS A BAD ACCOUNT SEEN?
RET ;YES, JUST CONTINUE WITH THIS ENTRY
MOVE T1,TOTLEN ;LENGTH OF CURRENT ACCOUNT BLOCK
MOVE T2,ACTPTR ;PTR TO CURRENT ACCOUNT HEADER IN FREE SPACE
STOR T1,DATASZ,(T2) ;SAVE LENGTH IN ACCOUNT HEADER
TXNN F,SASFLG ;SUBACCOUNT SEEN?
JRST [ CALL SCNSTK ;NO, SCAN DATSTK
CALL BLKOUT ;PLACE ACCOUNT DATA BLOCKS IN FILE
CALL POPDAT ;POP CURRENT DATA BLOCK
SOS ACTBYT ;ADJUST FOR NULL PADDED AT END OF COMPLETED ACCOUNT
RET] ;CONTINUE WITH CURRENT ENTRY
CALL SAVCXT ;SAVE CURRENT CONTEXT AND SET UP
; TO HANDLE SUBACCOUNT
CALL START2 ;GO PROCESS SUBACCOUNT ENTRIES
CALL POPDAT ;POP THIS ACCOUNT BLOCK
RET ;CONTINUE WITH CURRENT ENTRY
; ROUTINE TO SAVE CURRENT ACCOUNT CONTEXT ON STACKS AND
; OPEN SUBACCOUNT FOR PROCESSING
; CALL SAVCXT
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
SAVCXT: MOVX T1,GJ%OLD+GJ%SHT+.GJDEF
HRROI T2,SUBBUF ;POINTER TO FILESPEC
GTJFN ;GET A JFN FOR SUBACCOUNT
JRST [ TXZ F,SASFLG ;ERROR, RESET FLAG
HRROI T1,[ASCIZ/? Invalid file specification, /]
CALL PUTERR ;ISSUE REST OF MESSAGE AND RETURN
CALLRET RESUME]
MOVE T2,[7B5+OF%RD] ;7-BIT BYTES, READ ACCESS
OPENF ;OPEN SUBACCOUNT FILE
JRST [ TXZ F,SASFLG ;ERROR, RESET FLAG
HRROI T1,[ASCIZ/? ACTGEN: Cannot open input file, /]
CALL PUTERR ;ISSUE REST OF MESSAGE AND RETURN
CALLRET RESUME]
PUSH P2,INJFN ;SAVE OLD JFN ON STACK
MOVEM T1,INJFN ;SAVE NEW JFN
PUSH P3,[0] ;NOTE THE END OF OLD CONTEXT DATA PTRS
CALL SAVCMD ;SAVE OLD COMND STATE ON STACK
JRST SAVCX1 ;ERROR, CAN'T SAVE OLD COMND STATE
MOVE T1,INJFN ;GET NEW INJFN
HRLS T1,T1 ;PUT IT IN LH
HRRI T1,.NULIO ;OUTPUT JFN IS NULL I/O
MOVEM T1,CMDBLK+.CMIOJ ;SAVE NEW JFNS FOR COMND
SETZM NAMBUF
HRROI T1,NAMBUF ;POINTER TO BUFFER FOR FILENAME
MOVE T2,INJFN ;GET NEW JFN
MOVX T3,<FLD(.JSAOF,JS%NAM)> ;SAY OUTPUT NAME ONLY
JFNS ;PUT FILENAME IN BUFFER
TXZ F,SASFLG ;RESET FLAG
TXO F,FTTFLG ;FIRST TIME THROUGH FOR SUBACT
RET ;AND RETURN
SAVCX1: CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? Potential CMDSTK overflow
>
CALLRET RESUME ;GO RESTART
; SUBACCOUNT ENTRY
; RETURNS: +1 ERROR IN PARSING SUBACCOUNT FILE NAME
; +2 SUCCESS
; GTJFN BLOCK CLEARED IN .TAKE CODE BEFORE PARSING FILE ENTRIES
.SUBAC: MOVX T1,GJ%OLD ;GET EXISTING FILE FLAG
MOVEM T1,GJFBLK+.GJGEN ;STORE GTJFN FLAGS
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFIL)] ;GET FDB ADDRESS
COMND ;PARSE SUBACCOUNT FILESPEC
ERJMP CMDERR ;ERROR, GO CHECK EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FILESPEC OK?
RET ;NO, ERROR
;SAVE SUBACCOUNT FILE NAME IN BUFFER
HRROI T1,SUBBUF ;POINTER TO SUBACCOUNT BUFFER
HRROI T2,ATMBFR ;POINTER TO SUBACCOUNT NAME FOUND
MOVEI T3,.CHNUL ;TERMINATE ON NULL BYTE
SOUT ;SAVE SUBACCOUNT NAME IN BUFFER
TXO F,SASFLG ;NOTE THAT SUBACCOUNT WAS SEEN
RETSKP
;EXPIRATION DATE GIVEN FOR AN ENTRY
; RETURNS: +1 ERROR IN PARSING DATE
; +2 SUCCESS, T2/ EXP DATE AND TIME IN INTERNAL FORMAT
.XPIRE: MOVEI T1,CMDBLK ;GET ADDR OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMTAD,,CM%IDA!CM%ITM,,,<[FLDDB. (.CMTAD,,CM%IDA)]>)]
;PARSE DATE-&-TIME OR JUST A DATE
COMND ; AND CONVERT TO INTERNAL FORMAT
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
RET ;NO, ERROR
TXO F,EXPFLG ;NOTE THAT A DATE WAS SEEN
RETSKP ;GIVE GOOD RETURN
SUBTTL DIRECTORY ENTRY
.DIREC: MOVEI P1,DNMBLK ;GET ADDR OF DIRECTORY DATA BLOCK
MOVEI T1,CMDBLK ;GET ADDR OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMDIR,CM%PO,CM%DWC)]
COMND ;PARSE ANYTHING THAT LOOKS LIKE A DIR NAME
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST DIRECX ;NO
CALL PLDIR ;YES, GO SAVE IT IN DATA FILE
JRST DIRCX1 ;ERROR, TELL USER
;PARSE FIELDS REMAINING AFTER DIRECTORY NAME
DIREC1: MOVEI T1,CMDBLK ;START OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE A SWITCH OR CONFIRMATION
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST DIRECX ;NO, GO PROCESS ERROR
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIN T1,.CMCFM ;CONFIRMATION CHARACTER?
JRST DIREC2 ;YES, SET EXPIRATION DATE AND RETURN
HRRZ T1,(T2) ;NO, GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
JRST DIRECX ;ERROR IN PARSING FIELD AFTER SWITCH
STOR T2,XPDAT,(P1) ;SAVE EXPIRATION DATE IN DATA BLOCK
CALL ENDCOM ;NEXT FIELD MUST BE END-OF-ENTRY
RET ;ERROR RETURN
JRST DIREC3 ;GOOD RETURN
;NO EXPIRATION DATE GIVEN IN THE ENTRY
DIREC2: SETZ T2, ;NOTE THAT THIS ENTRY NEVER EXPIRES
STOR T2,XPDAT,(P1) ;PLACE DATE IN DATA BLOCK
DIREC3: TXZ F,EXPFLG ;RESET FLAG
MOVEI T1,.TYDNM ;BLOCK TYPE FOR DIRECTORY NAME
STOR T1,BKTYP,(P1) ;SAVE IT IN DIRECTORY DATA BLOCK
MOVE T1,DIRLEN ;DIRECTORY NAME LENGTH IN WORDS
ADDI T1,3 ; + # WORDS IN REST OF BLOCK
STOR T1,BKLEN,(P1) ;PUT BLOCK LENGTH IN DATA BLOCK
ADDM T1,TOTLEN ;INCREASE # OF DATA ITEMS SEEN FOR THIS ACCOUNT
HRLZ T3,T1 ;GET LENGTH IN LEFT HALF
HRR T3,P1 ;ADDRESS OF DIRECTORY DATA BLOCK
CALL PLBLK ;STORE DATA BLOCK AWAY
JRST DIRCXX ;ERROR
RET ;RETURN TO PARSER
DIRECX: HRROI T1,[ASCIZ/? Incorrect field: /]
CALL PRSERR ;TELL USER
RET ;GO PARSE NEXT ENTRY IN FILE
DIRCXX: HRROI T1,[ASCIZ/? Cannot place directory block in free space/]
CALL ERRMES ;TELL USER
CALLRET RESUME ;AND GO RESTART
DIRCX1: HRROI T1,[ASCIZ/? Cannot convert ASCIZ structure name to SIXBIT/]
CALL ERRMES
RET ;GO PARSE NEXT ENTRY
;PLACE DIRECTORY NAME IN DATA BLOCK
; UPON ENTERING, T2/ 36-BIT DIRECTORY NUMBER
;
; RETURNS: +1 ERROR
; +2 SUCCESS
PLDIR: ASUBR <PLDIR1>
HRROI T1,ATMBFR ;POINTER TO DIRECTORY NAME STRING
HRROI T2,TMPBUF ;TEMP BUFFER FOR STORING STRING
MOVEI T3,7 ;6 CHARS FOR STRUCTURE NAME AND ONE FOR ":"
MOVEI T4,":" ;READ TILL TERMINATOR SEEN
SIN ;PUT STRUCTURE NAME IN TMPBUF
MOVEM T1,PLDIR1 ;SAVE UPDATED POINTER INTO ATMSAV
SETZ T3,
DPB T3,T2 ;OVERWRITE ":" WITH A NULL
MOVE T1,TMPBUF ;GET STRUCTURE NAME
CAMN T1,[ASCIZ/DSK*/] ;IS IT ALL STRUCTURES?
JRST [ SETO T2, ;YES, TAKE NOTE OF THIS
JRST PLDR1] ;AND CONTINUE
MOVEI T1,TMPBUF ;ADDRESS OF ASCIZ STRUCTURE NAME
CALL ASCSIX ;CONVERT STRUCTURE NAME TO SIXBIT
RET ;ERROR RETURN
PLDR1: STOR T2,SXSTR,(P1) ;PUT STRUCTURE NAME IN DATA BLOCK
MOVE T1,PLDIR1 ;GET BACK POINTER INTO ATMSAV
CALL GETDIR ;GO GET THE DIRECTORY STRING
RET ;FAILED, RETURN ERROR
MOVEI T1,3(P1) ;PLACE TO PUT DIRECTORY NAME
HRLI T1,(<POINT 7,>) ;TURN IT INTO A BYTE POINTER
HRROI T2,TMPBUF ;POINTER TO DIRECTORY NAME STRING
MOVEI T3,MAXLEN ;MAX # CHARS IN DIRECTORY NAME
MOVEI T4,.CHNUL ;TERMINATE ON A NULL BYTE
SOUT ;PUT DIRECTORY NAME IN DATA BLOCK
MOVEI T2,MAXLEN ;GET MAX # CHARACTERS POSSIBLY MOVED
SUB T2,T3 ;COMPUTE # CHARS ACTUALLY IN THE STRING
IDIVI T2,5 ;COMPUTE # WORDS IN STRING + REMAINDER
SKIPE T3 ;DOES T2 HAVE EXACT # WORDS IN THE STRING?
ADDI T2,1 ;NO, CORRECT THE COUNT
MOVEM T2,DIRLEN ;SAVE # WORDS IN DIRECTORY NAME STRING
CAIE T2,1 ;IS DIR NAME ONE WORD LONG?
RETSKP ;NO, JUST RETURN
LOAD T2,DIRNM,(P1) ;GET DIRECTORY NAME
CAME T2,[ASCIZ/*/] ;IS IT ALL DIRECTORIES?
RETSKP ;NO, RETURN
SETO T2, ;NOTE THAT ALL DIRS ARE ALLOWED
STOR T2,DIRNM,(P1) ;PUT THIS IN DATA BLOCK INSTEAD
RETSKP
;GETDIR - ROUTINE TO REMOVE THE DIRECTORY STRING FROM THE ATOM BUFFER
;
;ACCEPTS IN T1/ POINTER TO START OF DIRECTORY STRING
; CALL GETDIR
;RETURNS: +1 FAILED
; +2 SUCCESS, WITH STRING NOW IN TMPBUF
GETDIR: IBP T1 ;SKIP OVER INITIAL BRACKET IN DIRECTORY STRING
MOVE T3,[POINT 7,TMPBUF] ;SET UP DESTINATION POINTER
MOVEI T4,MAXLEN ;GET MAX NUMBER OF CHARACTERS IN STRING
GTDR10: ILDB T2,T1 ;GET A CHARACTER FROM THE STRING
CAIE T2,">" ;TERMINATING BRACKET OF
CAIN T2,"]" ; EITHER VARIETY ?
JRST GTDR20 ;YES, GO TERMINATE STRING WITH NULL
IDPB T2,T3 ;DEPOSIT THE CHARACTER INTO DESTINATION
SOJG T4,GTDR10 ;GO GET NEXT CHARACTER FROM STRING
GTDR20: MOVEI T2,.CHNUL ;GET TERMINATING CHARACTER
IDPB T2,T3 ;TERMINATE STRING WITH NULL
RETSKP ;DONE, RETURN
SUBTTL USER ENTRY
.USRNM: MOVEI P1,UNMBLK ;GET ADDR OF USER NAME DATA BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMUSR,CM%PO,CM%DWC)]
COMND ;PARSE "*" OR ANYTHING THAT LOOKS LIKE A USER NAME
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST USRNX ;NO
CALL CHKSTR ;WAS "*" SEEN AS THE ONLY ARGUMENT?
SKIPA ;NO, CONTINUE
JRST USRNM8 ;YES, CREATE "ALL USERS" ENTRY
CALL PLUSR ;GO PUT USERNAME IN DATA BLOCK
USRNM1: MOVEI T1,CMDBLK ;PARSE THE NEXT FIELD
MOVEI T2,[FLDDB. (.CMCMA,,,,,<[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]>)]
COMND ;PARSE COMMA, SWITCH, OR ACTION CHAR
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST USRNX ;NO
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIN T1,.CMCMA ;PARSED A COMMA?
JRST USRNM3 ;YES, SEE IF EXPIRATION DATE WAS GIVEN
CAIN T1,.CMSWI ;PARSED A SWITCH?
JRST USRNM7 ;YES, GO PERFORM SWITCH FUNCTION
JRST USRNM5 ;MUST HAVE BEEN .CMCFM - RETURN
;COMMA PARSED - TRY TO PARSE NEXT FIELD AS USERNAME
USRNM2: MOVEI T1,CMDBLK ;GET ADDR OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMUSR,CM%PO,CM%DWC)] ;FDB FOR A USERNAME
COMND ;PARSE A USERNAME
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST USRNX ;NO, GO PRINT ERROR MESSAGE
CALL CHKSTR ;WAS "*" SEEN AS THE ONLY ARGUMENT?
SKIPA ;NO, CONTINUE
JRST USRNX ;YES, RETURN ERROR
CALL PLUSR ;PLACE USERNAME IN DATA BLOCK
JRST USRNM1 ;PARSE NEXT FIELD
USRNM3: TXZE F,EXPFLG ;EXPIRATION DATE SEEN?
JRST USRNM4 ;YES
SETZM T2 ;NO, ENTRY NEVER EXPIRES
STOR T2,XPDAT,(P1) ;PLACE DATE IN DATA BLOCK
USRNM4: CALL PLUS1 ;PUT USER DATA BLOCK IN FREE AREA
JRST USRNMX ;ERROR, GO TELL USER
JRST USRNM2 ;GO PARSE ANOTHER USERNAME
USRNM5: TXZE F,EXPFLG ;EXPIRATION DATE SEEN?
JRST USRNM6 ;YES, RETURN
SETZM T2 ;NO, ENTRY NEVER EXPIRES
STOR T2,XPDAT,(P1) ;SAVE DATE IN DATA BLOCK
USRNM6: CALL PLUS1 ;PUT USER DATA BLOCK IN FREE SPACE
JRST USRNMX ;ERROR
RET
;SWITCH PARSED - PERFORM SWITCH FUNCTION
USRNM7: HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
JRST USRNX ;ERROR IN PARSING FIELD AFTER SWITCH
STOR T2,XPDAT,(P1) ;SAVE EXPIRATION DATE IN DATA BLOCK
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCMA,,,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE A COMMA OR END-OF-ENTRY
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST USRNX ;NO
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIN T1,.CMCMA ;PARSED A COMMA?
JRST USRNM3 ;COMMA SEEN, PARSE NEXT FIELD
JRST USRNM5 ;NO, MUST HAVE SEEN END-OF-ENTRY
;"*" PARSED - PLACE IN FILE AND PARSE NEXT FIELD
USRNM8: MOVEI P1,ALUBLK ;GET ADDRESS OF "ALL USERS" DATA BLOCK
MOVEI T1,.TYALU ;BLOCK TYPE FOR "ALL USERS"
STOR T1,BKTYP,(P1) ;SAVE IT IN DATA BLOCK
MOVEI T1,2 ;DATA BLOCK LENGTH
STOR T1,BKLEN,(P1) ;SAVE IT IN DATA BLOCK
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE A SWITCH OR END-OF-ENTRY
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST USRNX ;NO, GO PRINT ERROR
CALL GETFNC ;GET FUNCTION CODE ACTUALLY USED
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST USRNM9 ;NO, RETURN
HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
JRST USRNX ;ERROR IN PARSING FIELD AFTER SWITCH
STOR T2,XPDAT,(P1) ;SAVE DATE IN DATA BLOCK
CALL ENDCOM ;GO PARSE END-OF-ENTRY
RET ;ERROR RETURN
JRST USRN10 ;GOOD RETURN
USRNM9: TXZE F,EXPFLG ;EXPIRATION DATE SEEN?
JRST USRN10 ;YES, RETURN
SETZM T2 ;NO, ENTRY NEVER EXPIRES
STOR T2,XPDAT,(P1) ;SAVE DATE IN DATA BLOCK
USRN10: LOAD T1,BKLEN,(P1) ;GET BLOCK LENGTH
ADDM T1,TOTLEN ;INCREASE # DATA ITEMS SEEN
CALL PLALU ;PLACE DATA BLOCK IN FREE SPACE
JRST USRNXX ;ERROR, TELL USER
RET ;RETURN
USRNX: HRROI T1,[ASCIZ/? Incorrect field: /]
CALL PRSERR ;TELL USER
RET ;GO PARSE NEXT ENTRY
USRNMX: HRROI T1,[ASCIZ/? Cannot place user block in free space/]
CALL ERRMES ;TELL USER
CALLRET RESUME ;AND GO RESTART
USRNXX: HRROI T1,[ASCIZ/? Cannot place "all users" block in free space/]
CALL ERRMES
CALLRET RESUME ;GO RESTART
; SEE IF A NAME STRING CONTAINS ANY WILDCARDS (% OR *)
; THIS ROUTINE IS CURRENTLY ONLY USED FOR USER NAMES
; CALL: T1/ ADDRESS OF STRING
; CALL CHKWLD
; RETURNS: +1 NO WILDCARDS
; +2 WILDCARD SEEN
; CLOBBERS T1 AND T2
CHKWLD: HRLI T1,(<POINT 7,>) ;BYTE POINTER TO STRING
CHKWL1: ILDB T2,T1 ;GET NEXT CHAR IN STRING
JUMPE T2,R ;ALL DONE, NO WILDCARDS
CAIN T2,"*" ;IS IT A *?
RETSKP ;YES
CAIN T2,"%" ;IS IT %?
RETSKP
JRST CHKWL1 ;NO, CONTINUE SCAN
; SEE IF "*" ONLY WAS PARSED AS ARGUMENT TO USER ENTRY
; CALL CHKSTR
; RETURNS: +1 "*" ONLY WASN'T SEEN
; +2 "*" ONLY WAS THE ARGUMENT
; CLOBBERS T1, T2
CHKSTR: MOVEI T1,ATMBFR
HRLI T1,(<POINT 7,>) ;BYTE PTR TO FIELD JUST PARSED
ILDB T2,T1 ;GET FIRST CHAR IN FIELD
CAIE T2,"*" ;WAS A * SEEN?
RET ;NO, RETURN NOW
ILDB T2,T1 ;GET NEXT CHARACTER
JUMPE T2,RSKP ;IF A NULL, SKIP RETURN
RET ;NEXT CHAR WASN'T A NULL
;PLACE "ALL USERS" DATA BLOCK IN FREE SPACE
; RETURNS: +1 ERROR
; +2 SUCCESS
PLALU: LOAD T3,BKLEN,(P1) ;GET LENGTH OF DATA BLOCK
HRLZS T3 ;PUT IT IN LEFT HALF
HRR T3,P1 ;ADDRESS OF "ALL USERS" BLOCK
CALL PLBLK ;SAVE BLOCK IN FREE SPACE
RET ;ERROR RETURN
RETSKP ;GOOD RETURN
;PLACE USERNAME IN DATA BLOCK
; UPON ENTERING, ATMBFR/ USER NAME STRING
PLUSR: MOVEI T1,2(P1) ;PLACE TO PUT USER NAME IN DATA BLOCK
HRLI T1,(<POINT 7,>) ;TURN IT INTO A BYTE POINTER
HRROI T2,ATMBFR ;SOURCE FOR USER NAME
MOVEI T3,MAXLEN ;MAXIMUM LENGTH OF USER NAME
MOVEI T4,.CHNUL ;TERMINATE ON A NULL BYTE
SOUT ;WRITE STRING INTO DATA BLOCK
MOVEI T2,MAXLEN ;GET MAXIMUM # CHARS POSSIBLY MOVED
SUB T2,T3 ;COMPUTE # CHARS ACTUALLY IN THE STRING
IDIVI T2,5 ;# WORDS IN STRING PLUS REMAINDER
SKIPE T3 ;DOES T2 HAVE EXACT # WORDS IN THE STRING?
ADDI T2,1 ;NO, CORRECT THE COUNT
MOVEM T2,USRLEN ;STORE IT AWAY
RET
;PLACE USER DATA BLOCK IN FREE SPACE
; RETURNS: +1 ERROR
; +2 SUCCESS
PLUS1: MOVEI Q1,.TYUNM ;BLOCK TYPE OF USER NAME BLOCK
MOVE T1,P1
ADDI T1,2 ;ADDRESS OF USER NAME IN THE BLOCK
CALL CHKWLD ;NAME CONTAIN ANY WILDCARDS?
SKIPA ;NO
MOVEI Q1,.TYWUS ;YES, CREATE A WILD USER BLOCK
STOR Q1,BKTYP,(P1) ;PUT BLOCK TYPE IN HEADER
MOVE T1,USRLEN ;GET LENGTH OF USER NAME IN WORDS
ADDI T1,2 ;PLUS 2 WORDS FOR REST OF HEADER
STOR T1,BKLEN,(P1) ;PUT IT IN HEADER BLOCK
ADDM T1,TOTLEN ;INCREASE # OF DATA ITEMS SEEN FOR THIS ACCOUNT
HRLZ T3,T1 ;GET LENGTH IN LEFT HALF
HRR T3,P1 ;ADDRESS OF USER NAME DATA BLOCK
CALL PLBLK ;STORE DATA BLOCK IN FREE SPACE
RET ;ERROR RETURN
SETZM UNMBLK
MOVE T1,[XWD UNMBLK,UNMBLK+1]
BLT T1,UNMBLK+^D8-1 ;CLEAR USER NAME BLOCK
RETSKP ;AND GIVE GOOD RETURN
SUBTTL GROUP ENTRY
.GROUP: HRROI T2,[ASCIZ/ON STRUCTURE/] ;POINTER TO NOISE WORDS
CALL SKPNOI ;PARSE NOISE WORDS
RET ;ERROR, RETURN TO PARSE NEXT ENTRY
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMDEV,,,,,<[FLDDB. (.CMSWI,,GRPSWI)]>)]
COMND ;PARSE A DEVICE NAME OR SWITCH
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST GROUPX ;NO, GO TELL USER
CALL GETFNC ;SEE WHAT KIND OF FIELD WAS PARSED
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST GROUP2 ;NO, MUST BE A STRUCTURE
GROUP1: HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PERFORM SWITCH FUNCTION
TXZ F,EXPFLG ;RESET EXPIRATION DATE FLAG
SETZM STRUCT ;RESET STRUCTURE NAME CELL
RET ;RETURN TO PARSE NEXT ENTRY
;PARSED A DEVICE NAME - FOR "/DIRECTORY:NNN" SWITCH
GROUP2: HLRZ T1,T2 ;GET DEVICE TYPE
CAIE T1,.DVDES+.DVDSK ;IS IT A STRUCTURE?
JRST GROUPX ;NO, RETURN ERROR
MOVEM T2,STRUCT ;YES, SAVE STRUCTURE DESIGNATOR
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,GRPSWI)]
COMND ;PARSE A MODIFYING SWITCH
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST GROUPX ;NO, GO TELL USER
JRST GROUP1 ;OK, CONTINUE
; ROUTINE TO PLACE STRUCTURE NAME IN DIRECTORY GROUP DATA BLOCK
; CALL: T2/ 36-BIT STRUCTURE DESIGNATOR
; CALL PLSTR
; RETURNS: +1 ERROR
; +2 SUCCESS
PLSTR: HRROI T1,ATMSAV ;PLACE TO PUT ASCIZ STRUCTURE NAME
DEVST ;TRANSLATE DESIGNATOR TO STRING
JRST [ HRROI T1,[ASCIZ/? Cannot convert structure designator, /]
CALL PUTERR ;UNEXPECTED JSYS FAILURE
CALLRET RESUME] ;GO RESTART
MOVEI T1,ATMSAV ;GET ADDRESS OF STRUCTURE NAME STRING
CALL ASCSIX ;CONVERT ASCIZ NAME TO SIXBIT
RET ;ERROR, NON-SIXBIT CHAR ENCOUNTERED
STOR T2,SXSTR,(P1) ;PLACE STRUCTURE NAME IN DATA BLOCK
RETSKP ;GOOD RETURN
GROUPX: HRROI T1,[ASCIZ/? Incorrect field: /]
CALL PRSERR ;TELL USER
RET ;GO PARSE NEXT ENTRY
SUBTTL GROUP SWITCHES
;PARSED A DIRECTORY GROUP SWITCH
.DGPNM: SKIPN STRUCT ;STRUCTURE NAME PARSED?
JRST GROUPX ;NO, ERROR
MOVEI P1,DGPBLK ;STARTING ADDR OF DATA BLOCK
MOVE T2,STRUCT ;GET STRUCTURE DESIGNATOR
CALL PLSTR ;PLACE IN DATA BLOCK
JRST DGPNMX ;ERROR, TELL USER
MOVEI T2,.TYDGP ;BLOCK TYPE FOR DIRECTORY GROUP
STOR T2,BKTYP,(P1) ;STORE IT IN GROUP DATA BLOCK
MOVEI T2,4 ;LENGTH OF DIRECTORY GROUP DATA BLOCK
STOR T2,BKLEN,(P1) ;STORE IT IN DATA BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMNUM,,^D10)]
COMND ;PARSE A DECIMAL GROUP NUMBER
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST GROUPX ;NO, GO PRINT ERROR
HRROI T1,ATMBFR ;POINTER TO GROUP NUMBER
MOVEI T3,^D10 ;TREAT IT AS A DECIMAL NUMBER
NIN ;PLACE IT IN T2
JRST [ HRROI T1,[ASCIZ/? Cannot get directory group number, /]
CALL PUTERR ;ERROR
CALLRET RESUME]
STOR T2,DIRGP,(P1) ;PLACE GROUP NUMBER IN DATA BLOCK
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE DATE SWITCH OR CONFIRMATION CHARACTER
ERJMP CMDERR
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST GROUPX ;NO
CALL GETFNC ;GET FUNCTION CODE
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST [ SETZM T1 ;EXPIRATION DATE IS 0
STOR T1,XPDAT,(P1) ;PLACE IN DATA BLOCK
JRST DGPNM1] ;PLACE DATA BLOCK IN FILE AND RET
HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PROCESS EXPIRATION DATE
JRST GROUPX ;ERROR IN PARSING FIELD AFTER SWITCH
STOR T2,XPDAT,(P1) ;SAVE IT IN DATA BLOCK
CALL ENDCOM ;NEXT FIELD MUST BE END-OF-ENTRY
RET ;ERROR RETURN
DGPNM1: LOAD T1,BKLEN,(P1) ;GET BLOCK LENGTH
ADDM T1,TOTLEN ;INCREASE # DATA ITEMS SEEN SO FAR
MOVE T3,[4,,DGPBLK] ;LENGTH,,START ADDR OF GROUP DATA BLOCK
CALL PLBLK ;PLACE DATA BLOCK IN FILE
JRST DGPNX1 ;ERROR, TELL USER
RET ;RETURN TO .GROUP CODE
DGPNMX: HRROI T1,[ASCIZ/? Cannot convert ASCIZ structure name to SIXBIT/]
CALL ERRMES ;TELL USER
RET ;RETURN TO PARSE NEXT ENTRY
DGPNX1: HRROI T1,[ASCIZ/? Cannot place directory group block in free space/]
CALL ERRMES
CALLRET RESUME ;GO RESTART
;PARSED A USER GROUP SWITCH
.UGPNM: MOVEI P1,UGPBLK ;ADDR OF USER GROUP DATA BLOCK
MOVEI T2,.TYUGP ;BLOCK TYPE OF USER GROUP DATA BLOCK
STOR T2,BKTYP,(P1) ;SAVE IN DATA BLOCK
MOVEI T2,3 ;LENGTH OF USER GROUP DATA BLOCK
STOR T2,BKLEN,(P1) ;STORE IT AWAY
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMNUM,,^D10)]
COMND ;PARSE A DECIMAL GROUP NUMBER
ERJMP CMDERR ;ERROR, CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST GROUPX ;NO
HRROI T1,ATMBFR ;POINTER TO GROUP NUMBER
MOVEI T3,^D10 ;TREAT IT AS A DECIMAL NUMBER
NIN ;PUT IT IN T2
JRST [ HRROI T1,[ASCIZ/? Cannot get user group number, /]
CALL PUTERR ;ERROR
RET]
STOR T2,USRGP,(P1) ;PLACE GROUP NUMBER IN DATA BLOCK
MOVEI T1,CMDBLK ;ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMSWI,,EXPSWI,,,<[FLDDB. (.CMCFM)]>)]
COMND ;PARSE DATE SWITCH OR CONFIRMATION CHARACTER
ERJMP CMDERR
TXNE T1,CM%NOP ;PARSED FIELD OK?
JRST GROUPX ;NO, GO PRINT ERROR
CALL GETFNC ;GET FUNCTION CODE
CAIE T1,.CMSWI ;PARSED A SWITCH?
JRST [ SETZM T1 ;EXPIRATION DATE IS 0
STOR T1,XPDAT,(P1) ;PLACE IT IN DATA BLOCK
JRST UGPNM1] ;AND RETURN
HRRZ T1,(T2) ;GET SWITCH DISPATCH ADDRESS
CALL (T1) ;PROCESS EXPIRATION DATE
JRST GROUPX ;ERROR IN PARSING FIELD AFTER SWITCH
STOR T2,XPDAT,(P1) ;SAVE DATE IN DATA BLOCK
CALL ENDCOM ;NEXT FIELD MUST BE END-OF-ENTRY
RET ;RETURN TO PARSE NEXT ENTRY
UGPNM1: LOAD T1,BKLEN,(P1) ;GET BLOCK LENGTH
ADDM T1, TOTLEN ;INCREASE # DATA ITEMS SEEN SO FAR
MOVE T3,[3,,UGPBLK] ;LENGTH,,START ADDR OF USER GROUP BLOCK
CALL PLBLK ;PLACE DATA BLOCK IN FILE
JRST UGPNMX ;ERROR, TELL USER
RET ;AND RETURN
UGPNMX: HRROI T1,[ASCIZ/? Cannot place user group block in free space/]
CALL ERRMES
CALLRET RESUME ;GO RESTART
SUBTTL INSTALL COMMAND
.INSTL: STKVAR <SYSJFN,FILEN,WORDS>
HRROI T2,[ASCIZ/NEW ACCOUNT VALIDATION DATA BASE/]
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;RETURN FAILURE
CALL ENDCOM ;PARSE END OF COMMAND
RET ;RETURN, BAD CONFIRMATION
MOVX T1,GJ%FOU+GJ%SHT+.GJDEF
HRROI T2,[ASCIZ/PS:<SYSTEM>ACCOUNTS-TABLE.BIN/]
GTJFN ;GET A JFN FOR THE <SYSTEM> FILE
JRST [ HRROI T1,[ASCIZ/? Cannot get a jfn for PS:<SYSTEM>ACCOUNTS-TABLE.BIN, /]
CALL PUTERR ;ISSUE REST OF MESSAGE AND RETURN
CALLRET RESUME]
MOVEM T1,SYSJFN ;SAVE THE JFN
MOVX T2,<FLD(^D36,OF%BSZ)+OF%WR>
OPENF ;OPEN THE FILE FOR WRITE
JRST [ HRROI T1,[ASCIZ/? Cannot open output file, /]
CALL PUTERR
CALLRET RESUME]
SKIPN ACTJFN ;DO WE HAVE A JFN FOR IT?
CALL GETJFN ;NO, GO GET ONE
MOVE T1,ACTJFN ;JFN OF NEWLY CREATED DATA BASE FILE
SIZEF ;GET LENGTH OF THE FILE IN WORDS
JRST [ HRROI T1,[ASCIZ/? Cannot get size of output file, /]
CALL PUTERR
CALLRET RESUME]
MOVEM T2,FILEN ;SAVE # WORDS IN THE FILE
; COPY ACCOUNTS-TABLE.BIN TO <SYSTEM>ACCOUNTS-TABLE.BIN
INSTL0: MOVE T1,ACTJFN
MOVEI T3,HTBLEN ;PAGE SIZE
CAMLE T3,FILEN ;AT LEAST ONE PAGE LEFT TO MOVE?
MOVE T3,FILEN ;NO, COPY ONLY EXACT # WORDS LEFT
MOVEM T3,WORDS ;SAVE # WORDS TO BE COPIED
MOVNS T3
MOVE T1,ACTJFN
HRRI T2,NULBLK
HRLI T2,(<POINT 36,>)
SIN ;COPY A PAGE INTO NULBLK BUFFER
MOVE T1,SYSJFN ;JFN OF <SYSTEM> FILE
HRRI T2,NULBLK
HRLI T2,(<POINT 36,>)
MOVE T3,WORDS
MOVNS T3
SOUT ;COPY NULBLK STUFF TO <SYSTEM> FILE
MOVE T1,FILEN ;# WORDS LEFT TO COPY ...
SUB T1,WORDS ; ... MINUS # WORDS JUST COPIED
JUMPLE T1,INSTL1 ;ANYTHING LEFT TO COPY?
MOVEM T1,FILEN ;YES, SAVE REMAINING WORD COUNT
JRST INSTL0 ;AND CONTINUE
; <SYSTEM>ACCOUNTS-TABLE.BIN HAS BEEN CREATED
; CLOSE ALL OPEN FILES AND ENABLE ACCOUNT VALIDATION
INSTL1: CALL CLSACT ;UNMAP AND CLOSE ACCOUNTS-TABLE.BIN
SETOM T1
CLOSF ;CLOSE ALL OPEN FILES
JRST [ HRROI T1,[ASCIZ/? Cannot close open files, /]
CALL PUTERR
CALLRET RESUME]
HRRZI T1,.USENA
USAGE ;ENABLE ACCOUNT VALIDATION
ERJMP [HRROI T1,[ASCIZ/? CANNOT INSTALL NEW ACCOUNT VALIDATION DATA BASE, /]
CALL PUTERR
CALLRET RESUME]
RET ;GO PARSE NEXT COMMAND
; GET A JFN FOR ACCOUNTS-TABLE.BIN IN THE CONNECTED DIR
; CALL GETJFN
; RETURNS: +1 ALWAYS
GETJFN: MOVX T1,GJ%OLD+GJ%SHT+.GJDEF ;MUST BE AN OLD FILE
HRROI T2,[ASCIZ/ACCOUNTS-TABLE.BIN/]
GTJFN ;GET JFN FOR THE EXISTING FILE
JRST [ HRROI T1,[ASCIZ/? Cannot get a jfn for ACCOUNTS-TABLE.BIN, /]
CALL PUTERR ;RETURN ERROR AND RESUME
CALLRET RESUME]
MOVEM T1,ACTJFN ;SAVE THE JFN
MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD>
OPENF ;OPEN THE FILE FOR READING
JRST [ HRROI T1,[ASCIZ/? Cannot open ACCOUNTS-TABLE.BIN, /]
CALL PUTERR
CALLRET RESUME]
RET ;RETURN
SUBTTL HELP AND EXIT COMMANDS
; HELP COMMAND
.HELP: HRROI T2,[ASCIZ/WITH ACTGEN/] ;GET NOISE WORDS
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL ENDCOM ;GO PARSE END OF COMMAND
RET ;BAD CONFIRMATION, RETURN
HRROI T1,HLPMSG ;GET POINTER TO HELP MESSAGE
PSOUT ;OUTPUT HELP MESSAGE
RET ;GO PARSE NEXT COMMAND
; EXIT COMMAND
.EXIT: HRROI T2,[ASCIZ/TO MONITOR/] ;GET NOISE PHRASE
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL ENDCOM ;GO PARSE END OF COMMAND
RET ;BAD CONFIRMATION, RETURN
SKIPE ACTJFN ;OUTPUT FILE OPEN?
CALL CLSACT ;YES, GO CLOSE IT
SETOM T1 ;INDICATE ALL FILES SHOULD BE CLOSED
CLOSF ;CLOSE ALL OPEN FILES
JRST [ HRROI T1,[ASCIZ/? Cannot close open files, /]
CALL PUTERR ;UNEXPECTED ERROR
JRST .+1]
HALTF ;RETURN TO MONITOR
CALLRET START ;IF CONTINUE'D, START OVER
; CLOSE OUTPUT FILE
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
CLSACT: CALL UNMAP ;UNMAP HASH PAGE
HRRZ T1,ACTJFN ;OUTPUT FILE JFN
CLOSF ;CLOSE THE FILE
JRST [ HRROI T1,[ASCIZ/? Cannot close output file, /]
CALL PUTERR ;ERROR, TELL USER
RET] ;AND RETURN
SETZM ACTJFN ;NOTE THAT THE FILE IS CLOSED
RET
; UNMAP PAGE WITH HASH TABLE
; CALL UNMAP
; RETURNS: +1 ALWAYS
UNMAP: SETOM T1
MOVEI T2,HTBBLK ;STARTING LOC OF HASH TABLE
IDIVI T2,HTBLEN ;PAGE # WHERE HASH TABLE LIVES
HRLI T2,.FHSLF ;SAY THIS PROCESS
SETZM T3
PMAP ;UNMAP THE HASH TABLE
RET ;AND RETURN
SUBTTL COMMAND ERROR SUBROUTINES
; INVALID END-OF-COMMAND
CFMERR: CALL TSTCOL ;TEST COLUMN POSITION
TMSG <? ACTGEN: Garbage at end-of-command
> ;OUTPUT ERROR MESSAGE
RET ;RETURN TO WHENCE WE CAME ...
; 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
JUMPE T2,R ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
TMSG <
> ;NO, OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME
; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A JSYS
; T1/ POINTER TO FIRST PART OF ERROR MESSAGE
; CALL PUTERR
;
; RETURNS: +1 ALWAYS
PUTERR: ASUBR <TEXT1>
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
MOVE T1,TEXT1 ;GET TEXT BACK
PSOUT
MOVX T1,.PRIOU ;PRIMARY OUTPUT JFN
HRLOI T2,.FHSLF ;OUR FORK, LAST ERROR CODE
SETZM T3 ;
ERSTR ;OUTPUT ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
TMSG <
> ;OUTPUT NEW LINE
TXNE F,TAKFLG ;COMMANDS COMING FROM A FILE?
JRST [ POP P,T1 ;YES, DON'T RETURN TO CALLER
RET] ;RETURN TO PARSE NEXT ENTRY
MOVE T1,[.PRIIN,,.PRIOU] ;RESET PRIMARY INPUT AND OUTPUT JFNS
MOVEM T1,CMDBLK+.CMIOJ ; IN COMMAND STATE BLOCK
MOVEI T1,ACTTAB ;RESET COMMAND TABLE VECTORS
MOVEM T1,CMDTAB ; FOR ACTGEN COMMANDS
RET ;RETURN TO CALLER
; ROUTINE TO PRINT ERROR MSG IF FIELD IN COMMAND CANNOT BE PARSED
;
; CALL: T1/ POINTER TO FIRST PART OF ERROR MESSAGE
; CALL PRSERR
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
PRSERR: ASUBR <PRSER1>
CALL TSTCOL ;TEST COLUMN POSITION
MOVE T1,PRSER1 ;GET TEXT BACK
PSOUT ;TELL USER
HRROI T1,ATMBFR ;GET LOSING FIELD
PSOUT
TMSG < in entry: >
HRROI T1,BUFFER ;GET ENTRY BEING PROCESSED
PSOUT ;TELL USER
TMSG <in file: >
MOVX T1,.PRIOU
MOVE T2,INJFN ;JFN OF FILE BEING WORKED ON
SETZM T3 ;NOTHING SPECIAL
JFNS ;TELL USER THE FILE NAME
TMSG <
>
RET ;RETURN TO CALLER
; ROUTINE TO PRINT ERROR MESSAGE
; T1/ POINTER TO TEXT TO BE PRINTED
; CALL ERRMES
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
ERRMES: ASUBR <ERRMS1>
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
MOVE T1,ERRMS1 ;GET TEXT
PSOUT ;TELL USER
ERRMS0: TMSG <
from entry: >
HRROI T1,BUFFER ;PRINT FAILING ENTRY
PSOUT
TMSG <
in file: >
MOVX T1,.PRIOU
MOVE T2,INJFN
SETZM T3
JFNS ;TELL USER THE FILE NAME
TMSG <
>
RET
;TYPATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PREFIX STRING TO BE TYPED
; CALL TYPATM
;RETURNS: +1 ALWAYS
TYPATM: ASUBR <ATOMPT>
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? ACTGEN: > ;OUTPUT INITIAL PART OF MESSAGE
MOVE T1,ATOMPT ;RESTORE ATOM POINTER
PSOUT ;OUTPUT THE STRING
TMSG < "> ;OUTPUT PUNCTUATION
HRROI T1,ATMBFR ;GET POINTER TO THE ATOM BUFFER
PSOUT ;OUTPUT THE TEXT ENTERED
TMSG <"
> ;OUTPUT END OF LINE
RET ;RETURN
;SETFDB - CREATES .CMKEY DESCRIPTOR BLOCK FOR .TAKE COMMAND
;RETURNS +1 ALWAYS, 2/ADDRESS OF FDB
SETFDB: MOVE T1,[KEYFDB,,KEYFDB+1] ;SET UP TO CLEAR FDB
SETZM KEYFDB ;CLEAR FIRST WD OF BLOCK
BLT T1,KEYFDB+KEYSIZ-1 ;CLEAR FDB
MOVX T1,.CMKEY ;FUNCTION TO PERFORM
STOR T1,CM%FNC,KEYFDB ;STORE FUNCTION CODE IN FD
MOVE T1,CMDTAB ;ADDR OF COMMAND TABLE
MOVEM T1,KEYFDB+.CMDAT ;STORE ADDR OF KEYWORD TABLE IN FDB
MOVEI T2,KEYFDB ;RETURN POINTER TO FDB
RET ;RETURN
SUBTTL PARSING SUBROUTINES
; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL: CALL ENDCOM
; RETURNS: +1 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
; +2 SUCCESS, COMMAND CONFIRMED
ENDCOM: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND ;PARSE CONFIRMATION
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
RETSKP ;SUCCESS, RETURN
CALLRET CFMERR ;NO, ISSUE ERROR MESSAGE AND RETURN
; ROUTINE TO PARSE NOISE PHRASE
;
; CALL: T2/ POINTER TO NOISE PHRASE
; CALL SKPNOI
; RETURNS: +1 ERROR, INVALID NOISE PHRASE
; +2 SUCCESS, NOISE PHRASE PARSED OK
SKPNOI: MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
SETZM NOIFDB ;CLEAR FIRST WORD OF BLOCK
BLT T1,NOIFDB+FDBSIZ-1 ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVX T1,.CMNOI ;GET FUNCTION TO PERFORM
STOR T1,CM%FNC,NOIFDB ;STORE FUNCTION CODE IN FDB
MOVEM T2,NOIFDB+.CMDAT ;STORE POINTER TO NOISE PHRASE IN FDB
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,NOIFDB ;GET ADDRESS OF FUNCTION BLOCK
COMND ;PARSE NOISE WORD
erjmp cmderr ;error, go check for eof on take file
TXNN T1,CM%NOP ;NOISE PHRASE PARSED OK ?
RETSKP ;YES, RETURN SUCCESS
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
HRROI T1,[ASCIZ/Invalid guide phrase/]
callret typatm ;output the text entered and return
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/ POINTER TO ASCIZ PROMPT STRING
; CALL CMDINI
;RETURNS: +1 ALWAYS, WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
; CALL TO CMDINI.
CMDINI: MOVEM T1,CMDBLK+.CMRTY ;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
POP P,SAVRET ;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
MOVEM P,SAVREP ;SAVE STACK POINTER TO BE RESET ON REPARSE
MOVE T1,[CM%RAI+CM%XIF+REPARS] ;CONVERT LOWERCASE TO UPPER, NO INDIRECT FILES, ADDRESS OF REPARSE ROUTINE
MOVEM T1,CMDBLK+.CMFLG ;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
COMND ;INITIALIZE COMMAND SCANNER JSYS
ERJMP CMDERR ;ERROR, GO SEE IF END OF "TAKE FILE"
JRST @SAVRET ;RETURN
; HERE TO PROCESS A REPARSE
REPARS: MOVE P,SAVREP ;RESET STACK POINTER
JRST @SAVRET ;RETURN TO CALLER OF CMDINI
SUBTTL GENERAL SUBROUTINES
;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND JSYS
; IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
; IS SIMPLY PROCESSED. ELSE AN ERROR MESSAGE IS ISSUED AND
; THE PROGRAM IS RESTARTED.
;
; CALL: JRST CMDERR
CMDERR: TXNN F,TAKFLG ;PROCESSING A TAKE FILE ?
JRST CMER10 ;NO, GO ISSUE ERROR MESSAGE
HLRZ T1,CMDBLK+.CMIOJ ;GET INPUT FILE JFN FOR TAKE FILE
GTSTS ;GET THE FILE'S STATUS
TXNN T2,GS%EOF ;AT END OF FILE ?
JRST CMER10 ;NO, GO ISSUE ERROR MESSAGE
TXZE F,BASFLG ;BAD ACCOUNT ENTRY SEEN?
JRST CMDER1 ;YES, CONTINUE
MOVE T1,TOTLEN ;EOF - GET LENGTH OF CURRENT ACCOUNT BLOCK
MOVE T2,ACTPTR ;PTR TO ACCOUNT HEADER IN FREE SPACE
STOR T1,DATASZ,(T2) ;STORE LENGTH IN ACCOUNT HEADER
TXNE F,SASFLG ;SUBACCOUNT SEEN?
JRST [ CALL SAVCXT ;YES, SAVE CURRENT CONTEXT
CALL START2 ;GO HANDLE SUBACCOUNT
CALL POPDAT ;GET RID OF ACCOUNT BLOCK
JRST CMDER1] ;AND CONTINUE
CALL SCNSTK ;SCAN DATSTK ENTRIES
CALL BLKOUT ;PUT COMPLETED ACCT BLOCKS IN OUTPUT FILE
CALL POPDAT ;FLUSH THIS LEVEL'S ACCOUNT BLOCK
SOS ACTBYT ;ADJUST COUNT FOR NULL PADDED AT END OF COMPLETED ACCOUNT
CMDER1: MOVE T1,INJFN ;MUST HAVE REACHED END OF THIS
; CONTEXT'S ACCOUNT DATA
CLOSF ;REACHED EOF ON THIS FILE - CLOSE IT
JRST [ HRROI T1,[ASCIZ/? Cannot close open file, /]
CALL PUTERR ;ERROR
CALLRET RESUME]
HLRO T1,P2 ;GET JFN STACK DEPTH
MOVNS T1 ;MAKE IT POSITIVE
CAIE T1,JFNLEN ;STACK EMPTY?
JRST CMDER2 ;NO, RESTORE PREVIOUS COMND STATE
MOVE T1,[.PRIIN,,.PRIOU] ;GET STANDARD PRIMARY JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;RESET INPUT AND OUTPUT JFN'S
TXZ F,TAKFLG ;MARK THAT TAKE FILE NOT BEING PROCESSED
TXO F,FTTFLG ;WILL BE FIRST TIME THROUGH AGAIN
SKIPE ACTJFN ;OUTPUT FILE OPEN?
CALL CLSACT ;YES, CLOSE OUTPUT FILE
CALL BLKBLT ;RESET STORAGE LOCATIONS
MOVEI T1,ACTTAB ;RESET COMMAND TABLE VECTOR
MOVEM T1,CMDTAB ; FOR ACTGEN COMMANDS
RET ;GO PROCESS NEXT ACTGEN COMMAND
CMER10: CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
HRROI T1,ERRSTR ;PUT MSG INTO A STRING
HRLOI T2,.FHSLF ;MOST RECENT COMND JSYS ERROR
SETZM T3
ERSTR ;GET ERROR TEXT
JFCL ;IGNORE ERRORS FOR NOW
SKIPA T1,[POINT 7,[ASCIZ/unknown error code/]]
HRROI T1,ERRSTR
PSOUT ;PRINT THE MSG
CALL ERRMS0 ;TELL USER WHERE THE ERROR CAME FROM
MOVEI T1,.PRIOU
DOBE ;WAIT FOR MSG TO BE PRINTED
JRST ENTVEC+1 ;AND GO SIMULATE A "REENTER"
CMDER2: CALL RESCMD ;RESTORE PREVIOUS COMND STATE
JRST CMDER3 ;ERROR, TELL USER
POP P2,INJFN ;GET JFN FOR PREVIOUS CONTEXT
RET ;CONTINUE WITH PREVIOUS CONTEXT'S ENTRIES
CMDER3: CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? Potential CMDSTK underflow
>
CALLRET RESUME ;GO RESTART
; ROUTINE TO GET FDB FUNCTION CODE USED BY COMND JSYS
;
; CALL: T3/ FDB ADDR GIVEN IN COMND CALL,,FDB ADDR ACTUALLY USED
; CALL GETFNC
; RETURNS: +1 ALWAYS, FUNCTION CODE IN T1
GETFNC: HRRZS T3 ;GET ADDRESS OF FDB ACTUALLY USED
MOVE T3,(T3) ;GET FIRST WORD OF FDB (.CMFNP)
LDB T1,[POINTR T3,CM%FNC] ;GET FUNCTION CODE USED
RET ;RETURN
; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL: CALL CLRGJF
; RETURNS: +1 ALWAYS
CLRGJF: MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD OF BLOCK
BLT T1,GJFBLK+GJFSIZ-1 ;CLEAR GTJFN BLOCK
RET ;RETURN TO WHENCE WE CAME ...
; ROUTINE TO CONVERT 6-CHARACTER ASCII STRUCTURE NAME TO SIXBIT
; CALL: T1/ ADDRESS OF ASCII STRING
; CALL ASCSIX
; RETURNS: +1 ERROR, NON-SIXBIT CHARACTER ENCOUNTERED
; +2 SUCCESS, T2/ SIXBIT STRING
ASCSIX: SETZM T2 ;CLEAR DESTINATION
SETOM T4 ;FORCE CHECKING THE FIRST CHARACTER
MOVEI T3,6 ;LOOP COUNTER- # OF SIXBIT CHARS/WORD
HRLI T1,(<POINT 7,>) ;BYTE POINTER TO STRING
ASCSX1: SKIPE T4 ;DON'T GET MORE CHARACTERS IF LAST CHAR WAS NULL
ILDB T4,T1 ;GET NEXT BYTE IN STRING
JUMPE T4,ASCSX2 ;IF NULL ENCOUNTERED, ALL DONE
CAIL T4,172 ;NOT AN ASCII CHARACTER?
RET ;YES, ERROR RETURN
CAIL T4,140 ;UPPER CASE CHARACTER?
CAILE T4,172 ;NO - LOWER CASE?
SKIPA
SUBI T4,40 ;CONVERT LOWER CASE TO SIXBIT UPPER
SUBI T4,40 ;CONVERT TO SIXBIT
ASCSX2: LSH T2,6 ;SHIFT DESTINATION STRING 6 BITS
IOR T2,T4 ;INSERT CONVERTED CHARACTER
SOJG T3, ASCSX1 ;CONVERT NEXT CHARACTER
RETSKP ;DONE, RETURN SUCCESS
; ROUTINE TO PLACE DATA BLOCK IN FREE SPACE
; CALL: T3/ LENGTH,,ADDRESS OF ASSEMBLED DATA BLOCK
; CALL PLBLK
; RETURNS: +1 ERROR
; +2 SUCCESS, T1/ FREE SPACE LOCATION WHERE BLOCK WAS PLACED
PLBLK: ASUBR <PLBLK1,PLBLK2,PLBLK3>
HLRZ T2,T3 ;GET BLOCK LENGTH
HRRZI T1,FRSHDR ;ADDRESS OF FREE SPACE HEADER
CALL GETFRE ;TRY TO GET SOME FREE SPACE FOR THE BLOCK
RET ;ERROR, NOT ENOUGH SPACE
MOVE T3,PLBLK3 ;GET ORIGINAL ARGUMENT BACK
HLRZ T2,T3 ;GET BLOCK LENGTH
ADD T2,T1 ;LENGTH + START ADDR OF WHERE TO PUT BLOCK IN FREE SPACE
SUBI T2,1 ;NOW HAVE LAST LOCATION OF WHERE BLOCK WILL GO
MOVEM T1,PLBLK1 ;SAVE FREE SPACE ADDRESS FOR NOW
HRLI T1,.FSPTR ;NOTE THAT THIS PTS TO DATA IN FREE SPACE
PUSH P3,T1 ;STACK PTR TO DATA BLOCK IN FREE SPACE
HRL T1,T3 ;ADDRESS OF BLOCK GOES IN LH
BLT T1,(T2) ;PLACE DATA BLOCK IN FREE SPACE
MOVE T1,PLBLK1 ;FREE SPACE ADDRESS OF BLOCK
RETSKP ;RETURN TO CALLER
SUBTTL FREE STORAGE MANAGER
; ROUTINE TO ASSIGN SPACE IN FREE STORAGE REGION
; CALL: RH(T1) ;LOCATION OF FREE STORAGE HEADER
; LH(T1) ;INDEX FIELD FOR REFERENCES TO T1 AND POINTERS
; ;I.E. @T1 REFERENCES FIRST WORD OF HEADER
; T2 ;SIZE OF BLOCK NEEDED
; CALL GETFRE
; RETURNS: +1 ERROR, NOT ENOUGH SPACE
; +2 SUCCESS, T1/ LOCATION OF THE BLOCK
; CLOBBERS T1, T2, T3, AND T4
; FREE STORAGE HEADER FORMAT:
; 0 ;LH POINTS TO FIRST FREE BLOCK
; 1 ;SPACE COUNTER
; 2 ;MOST COMMON BLOCK SIZE
; 3 ;LH HAS MAX TOP OF FREE STORAGE,
; ; RH HAS MINIMUM BOTTOM
; 4 ;TEMPORARY 2
; 5 ;TEMPORARY 3
GETFRE: CAMLE T2,1(T1) ;ANY POSSIBILITY OF SUCCESS?
RET ;NO, RETURN IMMEDIATELY
PUSH P,T2 ;SAVE DESIRED BLOCK SIZE
PUSH P,[0] ;BIGGEST BLOCK SEEN SO FAR
HRLOI T2,377777
MOVEM T2,4(T1) ;INITIAL BEST BLOCK SIZE
SETZM 5(T1) ;INITIAL LOCATION OF BEST BLOCK
MOVE T2,T1 ;START WITH THE HEADER WORD
GETFR1: HLRZ T3,0(T2) ;GET POINTER TO NEXT FREE BLOCK
JUMPE T3,GETFR2 ;NO MORE FREE BLOCKS TO EXAMINE
HRRZ T4,0(T3) ;GET SIZE OF THE BLOCK
CAMLE T4,0(P)
MOVEM T4,0(P)
CAMN T4,-1(P) ;IS IT THE RIGHT SIZE?
JRST GETFR3 ;YES, USE IT
CAML T4,-1(P) ;TOO SMALL?
CAML T4,4(T1) ;OR BIGGER THAN THE BEST?
JRST GETFR4 ;YES, IGNORE IT
MOVEM T4,4(T1) ;THIS ONE IS BETTER
MOVEM T2,5(T1)
GETFR4: MOVE T2,T3 ;STEP TO THE NEXT BLOCK
JRST GETFR1 ;AND REPEAT
GETFR2: SKIPN T2,5(T1) ;DID WE FIND ANYTHING?
JRST [ POP P,T2 ;NO, FLUSH TEMP
POP P,T2 ;MAKE TRANSPARENT TO T2 ON ERROR
RET]
MOVE T4,-1(P) ;GET DESIRED SIZE
HLRZ T3,0(T2) ;GET POINTER TO BLOCK TO BE USED
HRRM T4,0(T3) ;CONVERT TO DESIRED SIZE
ADD T4,T3 ;POINTER TO REMAINDER OF BLOCK
HRLM T4,0(T2) ;POINT PREVIOUS TO REMAINDER
HLLZ T2,0(T3) ;GET NEXT
HLLM T2,0(T4) ;POINT REMAINDER TO IT
; ...
; ...
MOVE T2,4(T1)
SUB T2,-1(P) ;SIZE OF REMAINDER
HRRM T2,0(T4) ;TO HEADER OF REMAINDER
GETFR5: SUB P,[1,,1] ;GET LOCATION BELOW TOP-OF-STACK
MOVN T2,0(P)
ADDM T2,1(T1) ;REDUCE COUNT OF SPACE LEFT
MOVEI T1,0(T3) ;GET ORIGIN OF BLOCK
HRROS (T1) ;SET LH TO ONES
CAMN T2,[-1] ;IS THIS A BLOCK OF ONE WORD?
JRST GETFR6 ;YES, DON'T ZERO ANYTHING THEN
HRRZ T2,(T1) ;GET RH
HRRZI T3,2(T1)
SETZM -1(T3) ;ZERO FIRST WORD BEFORE SETTING LEFT HALF INDEX
HRLI T3,1(T1)
ADD T2,T1
HRRZS T2
CAILE T2,(T3)
BLT T3,-1(T2) ;ZERO THE BLOCK
GETFR6: POP P,T2 ;RESTORE T2
RETSKP ;RETURN
GETFR3: HLL T4,0(T3)
HLLM T4,0(T2) ;POINT PREDECESSOR TO SUCCESSOR
JRST GETFR5
; ROUTINE TO RELEASE FREE STORAGE BLOCK
; LIFTED FROM MONITOR MODULE FREE, ROUTINE RELFRE
; CALL: T1/ LOCATION OF FREE STORAGE HEADER
; T2/ LOCATION OF THE BLOCK TO BE RETURNED
; CALL RELFRE
; RETURNS: +1 ERROR, CAN'T RELEASE THE BLOCK
; +2 SUCCESS, BLOCK RELEASED
; CLOBBERS T2, T3, AND T4
RELFRE: PUSH P,T1 ;SAVE LOCATION OF FREE STG HDR
HRRZ T4,0(T1)
HLRZ T4,3(T1)
HRRZ T1,3(T1)
CAILE T4,0(T2)
CAILE T1,0(T2)
JRST RLFRX1 ;ERROR - OUT OF RANGE
MOVE T1,0(P)
RELFR0: PUSH P,T2 ;SAVE LOCATION OF BLOCK TO FREE
HRLI T2,0 ;SOME FIX NEEDED HERE TO KEEP OUT OF SEC 0!!!!
HLLM T2,0(P)
MOVE T2,-1(P)
RELFR1: HLRZ T3,0(T2) ;GET LOCATION OF NEXT BLOCK
JUMPE T3,RELFR2 ;END OF LIST
CAML T3,0(P)
JRST RELFR2 ;OR ABOVE BLOCK BEING RETURNED
MOVE T2,T3
JRST RELFR1
RLFRX1: POP P,T1 ;ERROR, BLOCK OUT OF RANGE
RET ;RETURN
RELFR2: CAMN T3,0(P) ;RELEASING A BLOCK ALREADY RELEASED?
JSP CX,RLFRX2 ;YES, ERROR
CAIN T1,0(T2) ;THIS FIRST BLOCK ON FREE LIST?
JRST RELFR6 ;YES
HRRZ T4,0(T2) ;COMPUTE END OF PREVIOUS BLOCK
ADD T4,T2
CAMLE T4,0(P) ;PREVIOUS BLOCK OVERLAPS ONE BEING RELEASED?
JSP CX,RLFRX2 ;YES, ERROR
RELFR6: JUMPE T3,RELFR7 ;AT END OF FREE LIST?
HRRZ T4,0(P) ;COMPUTE END OF THIS BLOCK
ADD T4,@0(P)
CAMLE T4,T3 ;OVERLAPS NEXT BLOCK ON FREE LIST?
JSP CX,RLFRX2 ;YES, ERROR
RELFR7: HRRZ T4,@0(P)
ADDM T4,1(T1) ;AUGMENT COUNT OF REMAINING FREE SPACE
ADD T4,0(P) ;GET END OF BLOCK BEING RETURNED
CAIE T4,0(T3) ;SAME AS FOLLOWING BLOCK LOCATION?
JRST RELFR3 ;NO
HRRZ T4,0(T3) ;GET LENGTH OF FOLLOWING BLOCK
ADDM T4,@0(P) ;AUGMENT LENGTH OF BLOCK BEING RETURNED
HLLZ T4,0(T3) ;GET LOC OF SUCCESSOR OF SUCCESSOR
HLLM T4,@0(P)
RELFR5: MOVE T3,0(P)
HRLM T3,0(T2)
HRRZ T4,0(T2) ;LENGTH OF PREDECESSOR
ADD T4,T2 ;END OF PREDECESSOR
CAME T4,T3 ;SAME AS NEW BLOCK
JRST RELFR4 ;NO, DONE
MOVE T3,0(T3)
HLLM T3,0(T2)
HRRZS T3
ADDM T3,0(T2)
RELFR4: POP P,T2
POP P,T1
RETSKP ;GOOD RETURN
RELFR3: HRLM T3,@0(P) ;POINT RETURNED BLOCK TO SUCCESSOR
JRST RELFR5
RLFRX2: POP P,T2 ;ERROR, BAD BLOCK BEING RELEASED
POP P,T1
RET ;GIVE ERROR RETURN
; ROUTINE TO BUILD FREE SPACE HEADER AT ACTGEN INITIALIZATION
; FOR CALLS TO GETFRE AND RELFRE
;
; CALL FSHDR
; RETURNS: +1 ALWAYS
FSHDR: MOVEI T1,MINFRE
HRLOM T1,FRSHDR
MOVEI T1,MAXFRE+1
SUBI T1,MINFRE
HRRZM T1,MINFRE
MOVEM T1,FRSHDR+1
MOVE T1,[MAXFRE,,MINFRE]
MOVEM T1,FRSHDR+3
RET
SUBTTL SCAN DATSTK
; ROUTINE TO SCAN DATSTK, FLAGGING ACCOUNT AND DUPLICATE ENTRIES
; NEW ACCOUNT HEADER CREATED FOR DATA CURRENTLY ON STACK
;
; BLKLEN - HOLDS SUM OF DATA BLOCK LENGTHS
;
; CALL SCNSTK
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3, T4
SCNSTK: ASUBR <BLKLEN>
SETZM BLKLEN ;INITIALIZE BLOCK LENGTH COUNT
SETZM TMPBUF ;CLEAR THIS BUFFER
MOVE T1,[XWD TMPBUF,TMPBUF+1]
BLT T1,TMPBUF+ATMSIZ-1
MOVEI T1,TMPBUF ;PLACE WHERE NEW ACCOUNT HEADER IS GOING
SETOM T2
STOR T2,XPDAT,(T1) ;INIT EXPIRATION DATE TO -1 FIRST TIME THROUGH
MOVEI T2,4(T1)
HRLI T2,(<POINT 7,>)
MOVEM T2,BUFPTR ;INIT PTR INTO TMPBUF WHERE ACCOUNT
; NAME WILL GO
MOVEI T1,DATSTK ;CHECK FIRST STACK ENTRY INITIALLY
MOVEI T2,1(T1) ;START SCANNING STACK HERE INITIALLY
SCNST1: MOVE T3,(T1) ;FIRST STACK ENTRY FOR THIS SCAN
JUMPE T3,SCNST5 ;SKIP THIS ENTRY IF IT'S A DELIMITER
TXNE T3,ACNTRY ;IS IT AN ACCOUNT ENTRY?
JRST [ MOVE T3,T1 ;YES
CALL MAKHDR ;ADD ACCOUNT NAME TO NEW HEADER
JRST SCNST5] ;AND CONTINUE SCAN
TXNE T3,DPNTRY ; OR A DUPLICATE ENTRY?
JRST SCNST5 ;YES, SKIP THIS KIND OF ENTRY TOO
LOAD T3,BKTYP,(T3) ;TYPE OF DATA BLK BEING CHECKED
CAIN T3,.TYACC ;IS IT AN ACCOUNT ENTRY?
JRST [ MOVE T3,T1 ;YES ADD TO NEW ACCT HEADER
CALL MAKHDR
MOVX T4,ACNTRY ;FLAG IT AS AN ACCOUNT ENTRY
XORM T4,(T3)
JRST SCNST5] ;AND CONTINUE THE SCAN
LOAD T3,FSADR,(T1) ;GET BLOCK LENGTH
LOAD T3,BKLEN,(T3)
ADDM T3,BLKLEN ;ADD TO TOTAL
CAILE T2,(P3) ;WILL SCAN START PAST TOP OF STACK?
JRST SCNST6 ;YES, ALL DONE SCANNING STACK THEN
SCNST2: MOVE T3,(T2) ;START SCANNING STACK ENTRIES
JUMPE T3,SCNST4 ;SKIP THIS ENTRY IF IT'S A DELIMITER
LOAD T3,FSADR,(T1) ;TYPE OF DATA BLK BEING CHECKED
LOAD T3,BKTYP,(T3)
LOAD T4,FSADR,(T2) ;TYPE OF DATA BLK BEING SCANNED
LOAD T4,BKTYP,(T4)
CAME T3,T4 ;SAME BLOCK TYPE?
JRST SCNST4 ;NO, CONTINUE THE SCAN
CAIN T4,.TYACC ;IS SCANNED ENTRY AN ACCOUNT BLOCK?
JRST [ MOVE T3,T1 ;YES, ADD TO NEW ACCOUNT HEADER
CALL MAKHDR
MOVX T4,ACNTRY ;FLAG IT AS AN ACCOUNT ENTRY
XORM T4,(T3)
JRST SCNST4] ;AND CONTINUE THE SCAN
LOAD T3,FSADR,(T1) ;SAME TYPE - GET BLOCK LENGTHS
LOAD T3,BKLEN,(T3)
LOAD T4,FSADR,(T2)
LOAD T4,BKLEN,(T4)
; ...
; ...
CAME T3,T4 ;SAME BLOCK LENGTH?
JRST SCNST4 ;NO, CONTINUE THE SCAN
CALL DUPCHK ;SEE IF THEY ARE DUPLICATE ENTRIES
JRST SCNST4 ;NOT DUPLICATE, CONTINUE THE SCAN
JUMPE T3,[MOVX T4,DPNTRY ;DUPLICATE - SAME EXP DATE?
XORM T4,(T2) ;FLAG LOWER ENTRY AS DUPLICATE
JRST SCNST4] ;AND CONTINUE
CAME T3,T2 ;LOWER ENTRY HAVE LATER EXP DATE?
JRST [ PUSH P,T3 ;SAVE FOR NOW
LOAD T3,FSADR,(T3)
LOAD T3,BKLEN,(T3) ;GET THIS BLOCK'S LENGTH
MOVE T4,BLKLEN
SUB T4,T3 ;DON'T COUNT THIS LENGTH INTOTAL
MOVEM T4,BLKLEN
POP P,T3
JRST .+1]
MOVX T4,DPNTRY ;DIFFERENT EXPIRATION DATES
XORM T4,(T3) ;FLAG APPROPRIATE ENTRY AS DUPLICATE
SCNST4: AOS T2 ;GET NEXT ENTRY TO SCAN
CAIG T2,(P3) ;DONE SCANNING ALL STACK ENTRIES?
JRST SCNST2 ;NO, CONTINUE
SCNST5: AOS T1 ;YES, GET NEXT ENTRY TO CHECK
CAIG T1,(P3) ;DONE CHECKING ALL STACK ENTRIES?
JRST [ MOVEI T2,1(T1) ;NO, SCAN BEGINS HERE
JRST SCNST1] ;CONTINUE SCANNING
; DONE SCANNING STACK HERE - FINISH CREATING NEW ACCOUNT HEADER
SCNST6: SETZ T2,
MOVE T1,BUFPTR
IDPB T2,T1 ;ALWAYS PAD END OF ACCT STRING WITH A NULL
AOS ACTBYT ;AND ADJUST COUNT OF CHARS IN STRING
MOVE T1,ACTBYT ;# CHARS IN ACCOUNT NAME
IDIVI T1,5 ;GET # WORDS IN ACCOUNT NAME
SKIPE T2 ;ANY CHARS SPILL OVER?
AOS T1 ;YES, INCREMENT TOTAL
ADDI T1,4 ;ACCT NAME LENGTH + 4 WD FOR REST OF HEADER
MOVEI T2,TMPBUF ;START OF NEW ACCOUNT HEADER
STOR T1,BKLEN,(T2) ;SAVE HEADER LENGTH
ADDM T1,BLKLEN ;LENGTH OF HDR PLUS ALL DATA BLOCKS
MOVE T1,BLKLEN
STOR T1,DATASZ,(T2) ;SAVE IN ACCOUNT HEADER
SETZM T1
STOR T1,ACPTR,(T2) ;INITIALIZE THIS TO 0
MOVEI T1,.TYACC
STOR T1,BKTYP,(T2) ;BLOCK TYPE OF ACCOUNT HEADER
MOVE T3,T2 ;HEADER ADDRESS GOES IN T3
LOAD T3,BKLEN,(T3) ;LENGTH OF NEW ACCT HEADER
HRLZS T3 ;PUT IT IN LEFT HALF
HRRI T3,TMPBUF ;START ADDRESS OF HEADER AGAIN
CALL PLBLK ;PUT NEW HEADER IN FREE SPACE
JRST SCNSTX ;ERROR
MOVEM T1,ACTPTR ;SAVE LOCATION WHERE HDR WAS PUT
POP P3,T2 ;THROW AWAY PTR THAT PLBLK STACKED
RET
SCNSTX: CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? Cannot place account header in free space
>
CALLRET RESUME ;GO RESTART
; ROUTINE TO SEE IF TWO DATA BLOCKS ARE DUPLICATE
; T1/ DATSTK ADDRESS OF HIGHER-LEVEL BLOCK
; T2/ DATSTK ADDRESS OF LOWER-LEVEL BLOCK
; CALL DUPCHK
; RETURNS: +1 BLOCKS NOT DUPLICATE
; +2 DUPLICATE, T3/ 0 => BLOCKS HAVE SAME EXPIRATION DATE
; OR T3/ ENTRY WITH LATER EXPIRATION DATE
; CLOBBERS T3, T4
DUPCHK: ASUBR <DUPCH1,DUPCH2,DUPCH3,DUPCH4>
LOAD T3,FSADR,(T1)
LOAD T3,BKLEN,(T3) ;BLOCK LENGTH
SUBI T3,2 ;# WORDS TO COMPARE IN BLOCK
MOVNS T3
HRROS T3 ;MAKE IT A FULL-WORD NEGATIVE NUMBER
MOVEM T3,DUPCH4 ;SAVE AS LOOP INDEX
LOAD T3,FSADR,(T1) ;START OF HIGHER-LEVEL BLOCK IN FREE SPACE
MOVE T1,2(T3) ;PLACE TO START SCANNING FIRST BLOCK
LOAD T4,FSADR,(T2)
MOVE T2,2(T4) ;PLACE TO START SCANING LOWER-LEVEL BLOCK
DPCHK1: CAME T1,T2 ;BLOCK ENTRIES THE SAME?
JRST [ DMOVE T1,DUPCH1 ;NO, RESTORE ORIGINAL VALUES
RET] ;AND RETURN IMMEDIATELY
AOSL DUPCH4 ;ANY MORE ENTRIES TO COMPARE?
JRST EXPCHK ;NO, GO CHECK EXPIRATION DATES
AOS T3
MOVE T1,2(T3) ;GET NEXT ENTRY TO COMPARE
AOS T4
MOVE T2,2(T4)
JRST DPCHK1 ;CONTINUE COMPARING ENTRIES
; DUPLICATE ENTRIES SO FAR - COMPARE EXPIRATION DATES
EXPCHK: DMOVE T1,DUPCH1 ;RESTORE ORIGINAL CONTENTS
LOAD T3,FSADR,(T1)
LOAD T4,FSADR,(T2)
LOAD T3,XPDAT,(T3) ;EXP DATE OF HIGHER-LEVEL BLOCK
LOAD T4,XPDAT,(T4) ;EXP DATE OF LOWER-LEVEL BLOCK
CAMN T3,T4 ;SAME DATE?
JRST [ SETZM T3 ;YES, RETURN TO CALLER
RETSKP]
CAML T3,T4 ;DATES NOT THE SAME
JRST EXPCH1 ;LOWER BLOCK HAS EARLIER DATE
JUMPE T3,[MOVE T3,T1 ;NOTE THAT HIGHER BLK HAS LATER DATE
RETSKP] ;AND RETURN
MOVE T3,T2 ;LOWER BLK HAS LATER DATE
RETSKP
; LOWER BLOCK HAS EARLIER DATE
EXPCH1: JUMPE T4,[MOVE T3,T2 ;LOWER BLK REALLY HAS LATER DATE
RETSKP]
MOVE T3,T1 ;HIGHER BLK HAS LATER DATE
RETSKP ;RETURN
; ROUTINE TO FORM NEW ACCOUNT HEADER FROM ACCT BLOCKS ON STACK
; T3/ DATSTK ADDRESS OF AN ACCOUNT BLOCK
;
; ACTADR - HOLDS ADDRESS OF ACCOUNT BLOCK IN FREE SPACE
;
; CALL MAKHDR
; RETURNS: +1 ALWAYS
; CLOBBERS T4
MAKHDR: ASUBR <MKHDR1,MKHDR2,MKHDR3,ACTADR>
LOAD T4,FSADR,(T3)
MOVEM T4,ACTADR ;SAVE ADDR OF ACCT BLK IN FREE SPACE
LOAD T3,BKLEN,(T4) ;GET ACCOUNT BLOCK LENGTH
SUBI T3,4 ;LENGTH OF ACTUAL ACCOUNT NAME IN WORDS
MOVE T1,BUFPTR ;PTR INTO TMPBUF FOR FORMING ACCT NAME
MOVEI T3,TMPBUF
MOVE T3,4(T3) ;GET FIRST WORD OF ACCOUNT NAME
SKIPE T3 ;ACCOUNT NAME ALREADY BEING FORMED?
CALL INDLM ;YES, INSERT DELIMITER "."
MOVE T2,ACTADR
ADDI T2,4 ;ADDRESS IN BLOCK WHERE ACCT NAME BEGINS
HRLI T2,(<POINT 7,>) ;MAKE IT A BYTE POINTER
MOVEI T3,MAXLEN ;MAX # CHARS IN ACCOUNT NAME
MOVEI T4,.CHNUL ;TERMINATE ON NULL BYTE
SOUT ;PUT ACCOUNT NAME IN NEW HEADER
MOVEM T1,BUFPTR ;SAVE UPDATED PTR INTO TMPBUF
MOVEI T1,TMPBUF ;START OF NEW ACCT HEADER
LOAD T2,XPDAT,(T1) ;GET CURRENT EXPIRATION DATE
MOVE T3,ACTADR
LOAD T3,XPDAT,(T3) ;GET THIS ACCOUNT'S EXP DATE
SKIPGE T2 ;FIRST TIME IN FORMING THIS ACCT?
JRST [ STOR T3,XPDAT,(T1) ;YES, SAVE THIS ACCOUNT'S DATE
JRST MAKHD1] ;RETURN
CAMN T2,T3 ;DATES THE SAME?
JRST MAKHD1 ;YES, JUST RETURN
CAML T2,T3 ;DOES NEW HDR ALREADY HAVE AN EARLIER DATE?
JRST MAKHD2 ;NO, THIS ACCT HAS AN EARLIER ONE
JUMPE T2,[STOR T3,XPDAT,(T1) ;SAVE THIS ACCT'S DATE
; IF SAVED DATE WAS 0
JRST MAKHD1] ;RETURN
MAKHD1: DMOVE T1,MKHDR1 ;RESTORE ORIGINAL VALUES
MOVE T3,MKHDR3
RET ;KEEP CURRENT DATE AND RETURN
MAKHD2: JUMPE T3,MAKHD1 ;KEEP CURRENT DATE IF THIS DATE IS 0
STOR T3,XPDAT,(T1) ;SAVE THIS ACCOUNT'S DATE
JRST MAKHD1 ;RETURN
; ROUTINE TO INSERT DELIMITER "." BETWEEN ACCOUNT NAMES
; T1/ POINTER INTO ACCOUNT NAME IN TMPBUF
; CALL INDLM
; RETURNS: +1 ALWAYS
; CLOBBERS T3
INDLM: MOVEI T3,"."
DPB T3,T1 ;INSERT THE "."
RET
; ROUTINE TO HASH ACCOUNT STRING
; T1/ AOBJN POINTER TO ACCOUNT STRING (-LENGTH,,ADDRESS)
; CALL HSHNAM
; RETURNS: +1 ALWAYS, T1/ HASH VALUE
HSHNAM: ASUBR <HSHN1,HSHN2,HSHN3,HSHN4>
STKVAR <HSHTMP>
HLRZ T4,T1 ;GET BLOCK LENGTH
CAIN T4,-1 ;IS ACCOUNT ONE WORD LONG?
JRST [ MOVE T3,0(T1) ;YES, GET ACCOUNT STRING
MOVEM T3,HSHTMP ;SAVE IT
JRST HSHNM2] ;AND CONTINUE
MOVE T3,0(T1) ;GET FIRST WORD OF STRING
MOVEM T3,HSHTMP ;SAVE IT
ADD T1,[1,,1] ;POINT TO NEXT WORD IN STRING
HSHNM1: MOVE T3,0(T1)
XORM T3,HSHTMP
AOBJP T1,HSHNM2 ;HSHNM2 IF ALL DONE XOR'ING
JRST HSHNM1 ;CONTINUE XOR'ING
HSHNM2: MOVE T1,HSHTMP ;GET FINAL VALUE
XOR T1,RANDOM
MUL T1,RANDOM
MOVMS T1
IDIVI T1,HSHLEN ;DIVIDE BY # OF POSSIBLE HASH VALUES
MOVE T1,T2 ;REMAINDER IS HASH VALUE
DMOVE T2,HSHN2 ;RESTORE ORIGINAL VALUES
MOVE T4,HSHN4
RET ;RETURN TO CALLER
RANDOM: 5*5*5*5*5*5*5*5*5*5*5*5*5*5*5
; ROUTINE TO HASH ACCOUNT STRING AND FIX HASH TABLE
; T2/ ADDRESS OF ACCOUNT HEADER IN FREE SPACE
; CALL HASHER
; RETURNS: +1 ALWAYS
; CLOBBERS T3, T4
HASHER: ASUBR <HSHR1,HSHR2,HSHR3,HSHR4>
MOVE T1,T2
ADDI T1,4 ;START OF ACCOUNT STRING IN HEADER
LOAD T3,BKLEN,(T2) ;ACCOUNT HEADER LENGTH
SUBI T3,4 ;LENGTH OF ACCOUNT STRING
MOVNS T3 ;MAKE IT NEGATIVE
HRL T1,T3 ;MAKE AOBJN POINTER TO ACCOUNT STRING
CALL HSHNAM ;GET HASH VALUE
MOVEI T2,HSHVAL ;START OF HASH VALUES
ADD T2,T1 ;HASH VALUE IS OFFSET INTO HASH TABLE
MOVE T3,0(T2) ;GET HASH TABLE ENTRY
JUMPE T3,HASHR4 ;JUMP IF NO COLLISIONS ON THIS ENTRY
MOVE T1,ACTJFN ;COLLISION
RFPTR ;GET FILE POINTER
JRST [ HRROI T1,[ASCIZ/? Cannot read output file pointer, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;GO RESTART
MOVEM T2,HSHR3 ;SAVE FILE POINTER FOR NOW
HASHR1: ADDI T3,3 ;GET ACPTR OF THIS ACCOUNT BLOCK
RIN ;GET ITS VALUE
JUMPE T2,HASHR3 ;IF ZERO, NO MORE COLLISIONS
MOVEM T2,T3 ;COLLISION, CONTINUE SCANNING CHAIN
JRST HASHR1
; NO MORE COLLISIONS - SAVE POINTER IN FILE TO NEW ACCOUNT HEADER
HASHR3: MOVE T2,BYTCNT ;LOCATION IN FILE WHERE NEW
; ACCOUNT HEADER WILL GO
ROUT ;MAKE ACCT HDR AT END OF CHAIN POINT TO IT
MOVE T2,HSHR3
SFPTR ;RESET FILE POINTER
JRST [ HRROI T1,[ASCIZ/? Cannot set output file pointer, /]
CALL PUTERR ;ERROR, TELL USER
CALLRET RESUME] ;AND GO RESTART
JRST HASHR5 ;CLEAN UP AND RETURN
HASHR4: MOVE T1,BYTCNT ;LOCATION IN FILE WHERE NEW ACCT HDR WILL GO
MOVEM T1,0(T2) ;MAKE HASH TABLE ENTRY POINT TO IT
HASHR5: DMOVE T1,HSHR1 ;RESTORE ORIGINAL VALUES
RET ;AND RETURN
SUBTTL OUTPUT BLOCKS TO FILE
; ROUTINE TO PLACE NEW ACCOUNT HEADER AND DATA BLOCKS IN OUTPUT FILE
; CALL BLKOUT
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
BLKOUT: MOVE P1,ACTPTR ;POINTER TO ACCT HEADER IN FREE SPACE
LOAD T3,DATASZ,(P1) ;LENGTH OF ALL ACCT DATA BLOCKS
MOVE T1,BYTCNT ;GET # BYTES WRITTEN TO FILE SO FAR
IDIVI T1,HTBLEN ;NUMBER OF PAGES WRITTEN SO FAR
MOVEI T1,HTBLEN ; AND T2/ # BYTES WRITTEN ON CURRENT PAGE
SUB T1,T2 ;ROOM LEFT ON CURRENT PAGE
CAMGE T1,T3 ;ENOUGH ROOM TO PUT ACCT BLOCKS?
CALL NULFIL ;NO, FILL REST OF PAGE WITH NULLS
CALL OUTDAT ;PUT DATA BLOCKS IN FILE
RET ;AND RETURN
; ROUTINE TO SOUT ACCOUNT DATA BLOCKS TO FILE
; P1/ POINTER TO ACCOUNT HEADER IN FREE SPACE
; CALL OUTDAT
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
OUTDAT: MOVE T1,ACTJFN ;OUTPUT FILE JFN
MOVE T2,P1 ;ADDR OF ACCT HEADER IN FREE SPACE
CALL HASHER ;HASH ACCOUNT NAME AND FIX HASH TABLE
HRLI T2,(<POINT 36,>) ;MAKE POINTER TO ACCOUNT HEADER
LOAD T3,BKLEN,(P1) ;HEADER LENGTH
ADDM T3,BYTCNT ;INCREASE # WORDS WRITTEN
SOUT ;PUT ACCT HEADER IN FILE
MOVE T2,P1 ;GET FREE SPACE ADDRESS AGAIN
MOVEI T1,FRSHDR ;FREE STORAGE HEADER
CALL RELFRE ;RELEASE FREE SPACE FOR ACCT HEADER
JRST POPDTX ;ERROR, TELL USER
MOVEI T1,DATSTK ;START OF DATA BLOCKS ON STACK
OUTDT1: MOVE T2,(T1) ;GET PTR TO DATA BLOCK
JUMPE T2,OUTDT3 ;IF DELIMITER, JUST CONTINUE
TXZN T2,ACNTRY ;ACCOUNT ENTRY?
TXZE T2,DPNTRY ; OR DUPLICATE ENTRY?
JRST [ MOVEM T2,(T1) ;YES, SAVE NEWLY UNFLAGGED ENTRY
JRST OUTDT3] ;AND CONTINUE SCANNING STACK
CALL SOUTDT ;PLACE DATA BLOCK IN FILE AND CONTINUE
OUTDT3: AOS T1 ;GET NEXT STACK ENTRY
HRRZ T3,P3 ;GET CURRENT TOP OF STACK
CAMG T1,T3 ;ALL DONE SCANNING STACK?
JRST OUTDT1 ;NO, CONTINUE
RET
; ROUTINE TO SOUT DATA BLOCK TO FILE
; T2/ POINTER TO DATA BLOCK IN FREE SPACE
; CALL SOUTDT
; RETURNS: +1 ALWAYS
; CLOBBERS T2, T3
SOUTDT: ASUBR <SOUTD1>
LOAD T3,BKLEN,(T2) ;GET BLOCK LENGTH
ADDM T3,BYTCNT ;ADD SOUT'ED BLOCK SIZE TO TOTAL
HRRZS T2 ;POINTER TO DATA BLOCK IN FREE SPACE
HRLI T2,(<POINT 36,>) ;TURN IT INTO A BYTE POINTER
MOVE T1,ACTJFN ;OUTPUT FILE JFN
SOUT
MOVE T1,SOUTD1 ;RESTORE ORIGINAL VALUE
RET ;AND RETURN
; ROUTINE TO PLACE NULL BLOCK IN FILE
; T1/ NULL BLOCK SIZE (# WORDS LEFT ON PAGE)
; CALL NULFIL
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
NULFIL: SAVEAC <P1>
MOVEI P1,NULBLK ;GET NULBLK HEADER
MOVEI T2,.TYNUL ;NULL BLOCK TYPE
STOR T2,BKTYP,(P1)
STOR T1,BKLEN,(P1) ;BLOCK LENGTH
MOVE T3,T1
ADDM T3,BYTCNT ;INCREASE # BYTES WRITTEN
MOVE T1,ACTJFN ;NULBLK GOES TO OUTPUT FILE
MOVE T2,P1 ;BLOCK ADDRESS
HRLI T2,(<POINT 36,>) ;TURN IT INTO A POINTER
SOUT
RET ;AND RETURN
SUBTTL CMDSTK MANIPULATION
; ROUTINE TO SAVE CURRENT CONTEXT'S COMND STATE BLOCK
; AND BUFFER ON CMDSTK
;
; CALL SAVCMD
; RETURNS: +1 ERROR, SAVING BLOCK WILL CAUSE STACK OVERFLOW
; +2 SUCCESS
; CLOBBERS T1 AND T2
SAVCMD: HRRZI T1,BUFSIZ+.CMGJB+5 ;SIZE OF BLOCK TO BE SAVED
HRLS T1 ;PUT IT IN BOTH HALVES
ADD T1,P4 ;ADD CURRENT STACK POINTER
HLRZ T2,T1 ;NEW STACK DEPTH
HRROS T2 ;MAKE IT A FULL-WORD NEGATIVE NUMBER
JUMPGE T2,SAVCMX ;POTENTIAL OVERFLOW?
MOVE T2,T1 ;NO, SAVE IT IN T2
MOVEI T1,CMDBLK ;ADDRESS OF BLOCK TO BE SAVED
HRLS T1 ;PUT IT IN LH
HRRI T1,1(P4) ;TOP OF STACK IN RH
BLT T1,0(T2) ;SAVE BLOCK ON STACK
MOVEM T2,P4 ;FIX UP STACK POINTER
RETSKP ;GIVE GOOD RETURN
SAVCMX: RET ;ERROR RETURN
; ROUTINE TO RESTORE PREVIOUS CONTEXT'S COMND STATE BLOCK
; AND BUFFER FROM CMDSTK
;
; CALL CMDSTK
; RETURNS: +1 ERROR, RESTORING BLOCK WILL CAUSE STACK UNDERFLOW
; +2 SUCCESS
; CLOBBERS T1, T2, T3
RESCMD: HRRZI T1,.CMGJB+5+BUFSIZ ;SIZE OF BLOCK TO RESTORE
HRLS T1
MOVE T2,P4 ;GET CURRENT STACK POINTER
SUB T2,T1 ;SEE WHAT POINTER WILL BE AFTERWARDS
HLRZ T1,T2 ;GET NEW STACK DEPTH
HRROS T1 ;MAKE IT A FULL-WORD NEGATIVE NUMBER
CAIL T1,-1 ;POTENTIAL UNDERFLOW?
JRST RESCMX ;YES, GIVE ERROR RETURN
MOVE T3,T2 ;SAVE NEW POINTER IN T3
MOVEI T1,CMDBLK ;PLACE TO RESTORE BLOCK TO
HRLI T1,1(T2) ;START OF BLOCK ON STACK
MOVEI T2,CMDBLK+BUFSIZ+.CMGJB+4 ;LAST ADDRESS TO RESTORE TO
BLT T1,0(T2) ;RESTORE BLOCK AND BUFFER
MOVEM T3,P4 ;FIX UP STACK POINTER
RETSKP ;GIVE GOOD RETURN
RESCMX: RET
SUBTTL INTERRUPT HANDLERS
; TRAP HERE FOR PANIC-LEVEL INTERRUPTS
PANIC: TMSG <
Panic-level interrupt occurred, >
HRROI T1,ERRSTR ;PUT MESSAGE INTO A STRING
HRLOI T2,.FHSLF ; AND REASON FOR PANIC
SETZM T3
ERSTR
JFCL ;IGNORE ERRORS FOR NOW
SKIPA T1,[POINT 7,[ASCIZ/unknown error code/]]
HRROI T1,ERRSTR ;NOW PRINT THE MESSAGE
PSOUT
MOVEI T1,.PRIOU
DOBE ;WAIT FOR IT TO BE PRINTED
CALLRET RESUME ;RETURN TO ACTGEN COMMAND LEVEL
; RESUME AFTER PANIC-LEVEL INTERRUPT
RESUME: TXNE F,TAKFLG ;COMMANDS COMING FROM A FILE?
JRST RESUM1 ;YES, CLOSE ALL OPEN FILES
RESUM2: SKIPE ACTJFN ;OUTPUT FILE OPEN?
CALL CLSACT ;YES, GO CLOSE IT
SETZM INJFN ;ZERO INPUT FILE JFN CELL
SETZM OUTJFN ;ZERO OUTPUT FILE JFN CELL
SETZM ACTJFN ;ZERO DATA FILE JFN CELL
MOVEI T1,.PRIIN ;CLEAR TYPE-AHEAD
CFIBF ; OF UNREAD CHARACTERS
MOVEI T1,START1 ;START FROM SCRATCH
MOVEM T1,RETPC1 ; AFTER DEBRK
MOVEI T1,.FHSLF ;GET THE INTERRUPTS IN PROGRESS
RWM
JUMPE T2,START1 ;IF NONE IN PROGRESS, JUST GO RESTART
DEBRK
RESUM1: HLRO T2,P2 ;GET JFN STACK DEPTH
MOVNS T2 ;MAKE IT POSITIVE
CAIN T2,JFNLEN ;ANYTHING ON STACK?
JRST RESUM4 ;NO, JUST CLOSE INPUT FILE
RESUM3: POP P2,T1 ;GET A JFN
CLOSF
JRST [ HRROI T1,[ASCIZ/? Cannot close open files, /]
CALL PUTERR
JRST .+1]
HLRO T2,P2 ;GET NEW STACK DEPTH
MOVNS T2
CAIE T2,JFNLEN ;STACK EMPTY YET?
JRST RESUM3 ;NO, CONTINUE
RESUM4: MOVE T1,INJFN
CLOSF ;CLOSE CURRENT INPUT FILE
JRST [ HRROI T1,[ASCIZ/? Cannot close open files, /]
CALL PUTERR
JRST .+1]
JRST RESUM2 ;AND CONTINUE
; ROUTINE TO HANDLE END-OF-FILE INTERRUPTS
REPEAT 0,<
EOFINT: MOVE T1,INJFN ;GET "TAKE" INPUT FILE JFN
CLOSF ;CLOSE THE INPUT FILE
JRST [ CALL PUTERR ;UNEXPECTED ERROR
RET]
MOVE T1,OUTJFN ;OUTPUT FILE JFN
CLOSF ;CLOSE THE OUTPUT FILE
JRST [ CALL PUTERR ;UNEXPECTED ERROR
RET]
MOVEI T1,START1 ;RETURN ADDRESS
MOVEM T1,RETPC1 ;STORE RETURN ADDRESS
DEBRK ;DISMISS INTERRUPT
0
>
SUBTTL CONSTANTS AND TABLES
DEFINE TB(RTN,TXT)
< [ASCIZ/TXT/] ,, RTN
>
ACTTAB: ACTSIZ-1,, ACTSIZ ;CURRENT,,MAX SIZE OF COMMAND TABLE
TB (.EXIT,EXIT) ;EXIT TO MONITOR
TB (.HELP,HELP) ;OUTPUT HELP MESSAGE
TB (.INSTL,INSTALL) ;INSTALL NEW ACCOUNT VALIDATION DATA BASE
TB (.TAKE,TAKE) ;TAKE (COMMANDS FROM) FILE-SPEC ...
ACTSIZ== .-ACTTAB
;"TAKE" COMMANDS
TAKTAB: TAKSIZ-1,,TAKSIZ ;CURRENT,,MAX SIZE OF TAKE TABLE
TB (.ACCT,ACCOUNT) ;ACCOUNT STRING NAME
TB (.DIREC,DIRECTORY) ;DIRECTORY NAME
TB (.GROUP,GROUP) ;GROUP (USER OR DIRECTORY)
TB (.USRNM,USER) ;USER NAME (SINGLE OR LIST)
TAKSIZ== .-TAKTAB
;"ACCOUNT" MODIFIERS
ACTSWI: ACCSIZ-1,,ACCSIZ ;CURRENT,,MAX SIZE OF ACCOUNT SWITCH TABLE
TB (.XPIRE,EXPIRES:) ;EXPIRATION DATE
TB (.SUBAC,SUBACCOUNT:) ;SUBACCOUNT
ACCSIZ== .-ACTSWI
;SUBACCOUNT MODIFIER
SUBSWI: SUBSIZ-1,,SUBSIZ
TB (.SUBAC,SUBACCOUNT:) ;SUBACCOUNT
SUBSIZ==.-SUBSWI
;"GROUP" MODIFIERS
GRPSWI: GRPSIZ-1,,GRPSIZ
TB (.DGPNM,DIRECTORY:) ;DIRECTORY GROUP NUMBER
TB (.UGPNM,USER:) ;USER GROUP NUMBER
GRPSIZ== .-GRPSWI
;EXPIRATION DATE MODIFIER
EXPSWI: EXPSIZ-1,,EXPSIZ ;CURRENT,,MAX SIZE OF TABLE
TB (.XPIRE,EXPIRES:) ;EXPIRATION DATE
EXPSIZ==.-EXPSWI
PROMPT: ASCIZ /ACTGEN>/ ;PROMPT STRING
; LEVEL TABLE FOR INTERRUPT SYSTEM
LEVTAB: RETPC1
RETPC2
RETPC3
; ENTRY VECTOR DEFINITION
ENTVEC: JRST START ;MAIN ENTRY POINT
JRST START ;REENTER ENTRY POINT
EXP VACTGEN ;VERSION OF ACTGEN PROGRAM
; HELP TEXT
HLPMSG: ASCIZ /
TOPS-20 ACTGEN
FUNCTION
ACTGEN takes account validation data from text files
and creates the corresponding data base in the file
ACCOUNTS-TABLE.BIN.
COMMANDS
EXIT (TO MONITOR)
leave this program
HELP (WITH ACTGEN)
print this message on your terminal
INSTALL (NEW ACCOUNT VALIDATION DATA BASE)
copy the file ACCOUNTS-TABLE.BIN to PS:<SYSTEM>
ACCOUNTS-TABLE.BIN and enable this new
account validation scheme immediately
TAKE (COMMANDS FROM FILE) file specification
create the file ACCOUNTS-TABLE.BIN from
account validation data in the base file
and all files it points to
control-A is the escape character to return to ACTGEN command level.
HINTS
The default file specification for the TAKE command is
is named ACCOUNTS.CMD.
/
SUBTTL VARIABLE DATA STORAGE
;INTERRUPT CHANNELS
RADIX 5+5
CHNTAB:
0 ;ASSIGNABLE CHANNEL 0
0 ;ASSIGNABLE CHANNEL 1
0
0
0
1,,TRAP ;ESCAPE CHARACTER
TRPCHN==5 ; ON CHANNEL 5
0 ;6 - ARITHMETIC OVERFLOW
0 ;7 - FLOATING OVERFLOW
0 ;8 - RESERVED
1,,PANIC ;9 - PDL OVERFLOW
0 ;10 - END OF FILE
0 ;11 - DATA ERROR
0 ;12 - QUOTA EXCEEDED
0 ;13 - RESERVED
0 ;14 - TIME OF DAY (RESERVED)
1,,PANIC ;15 - ILLEGAL INSTRUCTION
1,,PANIC ;16 - ILLEGAL MEM READ
1,,PANIC ;17 - ILLEGAL MEM WRITE
1,,PANIC ;18 - ILLEGAL EXECUTE
0 ;19 - INFERIOR FORK TERMINATION
1,,PANIC ;20 - MACHINE SIZE EXCEEDED
0 ;21 - TRAP TO USER (RESERVED)
0 ;22 - NONEXISTENT PAGE REFERENCED
0 ;ASSIGNABLE CHANNEL 23
0 ;ASSIGNABLE CHANNEL 24
0
0
0
0
0
0
0
0
0
0
0
RADIX 8
ONCHNS: 1B<TRPCHN>+1B9+1B15+1B16+1B17+1B18+1B20
SAVRET: BLOCK 1 ;RETURN ADDRESS OF CMDINI CALLER
SAVREP: BLOCK 1 ;SAVED STACK POINTER TO RESTORE ON REPARSE
RETPC1: BLOCK 1 ;RETURN PC FOR INTERRUPT LEVEL 1
RETPC2: BLOCK 1 ;RETURN PC FOR INTERRUPT LEVEL 2
RETPC3: BLOCK 1 ;RETURN PC FOR INTERRUPT LEVEL 3
; NOTE: BUFFER MUST ALWAYS FOLLOW CMDBLK IN STORAGE
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
PTRBUF: BLOCK BUFSIZ ;PTR TO BEG OF NEXT FIELD TO BE PARSED
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
ATMSAV: BLOCK ATMSIZ ;BUFFER TO HOLD CONTENTS OF ATOM BUFFER
; FOR PROCESSING IN DATA FILE
TMPBUF: BLOCK ATMSIZ ;TEMPORARY BUFFER
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
PDL: BLOCK PDLEN ;PUSH DOWN POINTER
JFNSTK: BLOCK JFNLEN ;STACK OF OPEN JFNS FOR ACCT VALIDATION DATA SOURCE FILES
DATSTK: BLOCK DATLEN ;STACK OF PTRS TO ACCT DATA BLOCKS IN FREE SPACE
CMDSTK: BLOCK CMSLEN ;STACK OF COMND STATE BLOCKS AND BUFFERS
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
KEYFDB: BLOCK KEYSIZ ;FDB FOR KEYWORDS
NAMBUF: BLOCK 8 ;BUFFER FOR NAME OF INPUT FILE
SUBBUF: BLOCK 31 ;BUFFER FOR SUBACCOUNT FILE SPEC
FRSHDR: BLOCK 6 ;FREE STORAGE HEADER
INJFN: BLOCK 1 ;INPUT JFN FOR TAKE COMMAND
OUTJFN: BLOCK 1 ;OUTPUT JFN FOR TAKE COMMAND
CMDTAB: BLOCK 1 ;CELL CONTAINING "ACTGEN" OR "TAKE" COMMAND TABLE POINTERS
TRPCHR: BLOCK 1 ;TRAP CHAR TO GET BACK TO ACTGEN CMD LEVEL
ERRSTR: BLOCK 20 ;BLOCK FOR ERSTR STRINGS
ACTLEN: BLOCK 1 ;# WORDS IN ACCOUNT STRING NAME
DIRLEN: BLOCK 1 ;# WORDS IN DIRECTORY NAME STRING
USRLEN: BLOCK 1 ;# WORDS IN DIRECTORY NAME STRING
TOTLEN: BLOCK 1 ;LENGTH OF ALL DATA BLOCKS FOR AN ACCOUNT
;TOTLEN IS STORED IN DATASZ IN ACTHDR
; THE NEXT SEVEN LOCATIONS (STRUCT TO ACTBYT) ARE ALL SET
; TO ZERO AT ACTGEN INITIALIZATION
; NOTE: THESE LOCATIONS MUST ALWAYS REMAIN TOGETHER IN STORAGE
STRUCT: BLOCK 1 ;CELL FOR STRUCTURE DESIGNATOR
ACTBYT: BLOCK 1 ;# 7-BIT BYTES IN ACCOUNT NAME FORMED
ACTJFN: BLOCK 1 ;JFN FOR <SYSTEM>ACCOUNTS-TABLE.BIN
ACTNUM: BLOCK 1 ;COUNT OF GOOD ACCOUNT ENTRIES SEEN
ACTPTR: BLOCK 1 ;FREE SPACE ADDRESS WHERE ACCOUNT HEADER WAS PUT
BUFPTR: BLOCK 1 ;PTR INTO TMPBUF TO PUT ACCOUNT NAME
BYTCNT: BLOCK 1 ;COUNT OF BYTES WRITTEN TO OUTPUT FILE
ZBKLEN==.-STRUCT ;LENGTH OF BLOCK TO BE ZEROED
;ACCOUNTING DATA BLOCKS
ACTHDR: BLOCK 4+6 ;ACCOUNT HEADER PLUS 6 WORDS FOR ACCOUNT STRING NAME
UNMBLK: BLOCK 2+6 ;USER NAME HEADER PLUS 6 WDS FOR USER NAME
DNMBLK: BLOCK 3+6 ;DIRECTORY NAME HEADER PLUS 6 WDS FOR DIRECTORY NAME
UGPBLK: BLOCK 3 ;USER GROUP BLOCK
DGPBLK: BLOCK 4 ;DIRECTORY GROUP BLOCK
ALUBLK: BLOCK 2 ;ALL USERS
ALDBLK: BLOCK 3 ;ALL DIRECTORIES
NULBLK: BLOCK HTBLEN ;NULL BLOCK
;MAX NULBLK SIZE < ONE PAGE
;FLAGS IN F
EXPFLG==:1B0 ;EXPIRATION DATE SEEN FOR AN ENTRY IF NONZERO
FTTFLG==:1B1 ;FIRST-TIME-THROUGH-ACTGEN FLAG IF NONZERO
TAKFLG==:1B2 ;NONZERO IF PROCESSING A TAKE FILE
SASFLG==:1B3 ;SUBACCOUNT SEEN IN ACCOUNT ENTRY IF NONZERO
BASFLG==:1B4 ;BAD ACCOUNT ENTRY SEEN IF NONZERO
.FSPTR==:477777 ;ENTRY ON DATSTK IS A FREE SPACE
; POINTER IF .FSPTR IS IN LH
DPNTRY==:1B1 ;INDICATES A DUPLICATE ENTRY ON STACK
ACNTRY==:1B2 ;INDICATES AN ACCOUNT ENTRY ON STACK
XLIST
LIT
LIST
PRGEND==.
END <3,,ENTVEC>