Trailing-Edge
-
PDP-10 Archives
-
BB-H311B-RM
-
swskit-utilities/dirtst.mac
There are 7 other files named dirtst.mac in the archive. Click here to see a list.
;<TOMCZAK.EXEC>DIRTST.MAC.8, 22-Jan-80 14:07:57, EDIT BY TOMCZAK
;ACCEPT TWO DIFFERENT FDB SIZES WHEN V1 FDB
;<V-SOURCES>DIRTST.MAC.32, 14-Jun-79 10:15:49, EDIT BY HELLIWELL
;INCREASE SIZES OF FDB AREA AND SYMBOL TABLE AREA
TITLE DIRTST - NEW FORMAT DIRECTORY TESTER
SUBTTL D. KIRSCHEN 2-13-75
; ACCUMULATOR DEFINITIONS
; =========== ===========
T1= 1 ;JSYS ARGUMENT AC 1
T2= 2 ;JSYS ARGUMENT AC 2
T3= 3 ;JSYS ARGUMENT AC 3
T4= 4 ;JSYS ARGUMENT AC 4
P1= 5 ;TEMPORARY AC 1
P2= 6 ;TEMPORARY AC 2
P3= 7 ;TEMPORARY AC 3
P4= 10 ;TEMPORARY AC 4
I1= 11 ;INDEX/COUNTER 1
I2= 12 ;INDEX/COUNTER 2
FB= 13 ;BASE ADDRESS OF FDB
Q1= 14 ;PRESERVED AC 1
Q2= 15 ;PRESERVED AC 2
MA= 16 ;MAPPING ADDRESS
P= 17 ;PUSH-DOWN POINTER
SALL
.REQUIRE SYS:MACREL, SYS:MONSYM
SEARCH MACSYM, MONSYM
; VERSION NUMBER DEFINITIONS
VMAJOR==15 ;MAJOR VERSION OF DIRTST
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==47 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
VDIRTS== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
; MISCELLANEOUS SYMBOL DEFINITIONS
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
PDLSIZ== 50 ;PUSH-DOWN LIST SIZE
PRIMRY== .PRIIN,,.PRIOU ;PRIMARY JFN'S
DIRORG== 200 ;PAGE WHERE DIRECTORY IS MAPPED
DIRADR== DIRORG*1000 ;ADDRESS WHERE DIRECTORY IS MAPPED
PAGSIZ== 1000 ;SIZE OF A PAGE
FDBPGS== 200 ;# OF PAGES TO MAP FDB'S INTO
STBPGS== 40 ;# OF PAGES TO MAP SYMBOL TABLE INTO
MAXREP== ^D72 ;MAXIMUM OF 72 CHARS IN REPLIES
REPSIZ== MAXREP/5+1 ;SIZE OF USER'S REPLY BUFFER
STGADR==77,,-1
SUBTTL SYMBOL AND DATA STRUCTURE DEFINITIONS
; BLOCK TYPE DEFINITIONS
.TYNAM== 400001 ;NAME BLOCK
.TYEXT== 400002 ;EXTENSION BLOCK
.TYACT== 400003 ;ACCOUNT BLOCK
.TYUNS== 400004 ;USER NAME STRING
.TYFDB== 400100 ;FILE DESCRIPTOR BLOCK
.TYLAC== 400200 ;LEGAL ACCOUNT BLOCK
.TYDIR== 400300 ;DIRECTORY PAGE
.TYSYM== 400400 ;SYMBOL TABLE
.TYFRE== 400500 ;FREE BLOCK
.TYFBT== 400600 ;FREE STORAGE BIT TABLE
.TYGDB== 400700 ;GROUP DESCRIPTOR BLOCK
; SYMBOL TABLE ENTRY TYPES
.STNAM== 0 ;FILE NAME ENTRY, POINTER IS TO FDB
.STUNS== 2 ;USER NAME ENTRY, POINTER IS TO A USER NAME BLOCK
.STACT== 4 ;ACCOUNT ENTRY, POINTER IS TO ACT BLOCK
.STMSK== 7B2 ;MASK FOR SYMBOL TABLE ENTRY TYPE
.STPTR== 77777,,-1 ;MASK FOR SYMBOL TABLE ENTRY POINTER
STHSIZ== 2 ;SIZE OF SYMBOL TABLE HEADER
STESIZ== 2 ;SIZE OF SYMBOL TABLE ENTRIES
; STRUCTURE DEFINITION FOR FIRST PAGE OF DIRECTORY
DEFSTR (DIRTYP,DIRPG0+00,17,18) ;DIRECTORY BLOCK TYPE (.TYDIR)
DEFSTR (DIRLHD,DIRPG0+00,35,18) ;LENGTH OF HEADER
DEFSTR (DIRPAG,DIRPG0+01,17,18) ;PAGE # WITHIN DIRECTORY
DEFSTR (DIRNUM,DIRPG0+01,35,18) ;DIRECTORY NUMBER
DEFSTR (DIRFFB,DIRPG0+02,35,36) ;POINTER TO FIRST FREE BLOCK
DEFSTR (DIRBOT,DIRPG0+03,35,36) ;START ADDRESS OF SYMBOL TABLE
DEFSTR (DIRTOP,DIRPG0+04,35,36) ;ADDRESS OF END OF SYMBOL TABLE
DEFSTR (DIRFRE,DIRPG0+05,35,36) ;LAST ADR USED FOR FDB'S
DEFSTR (DIRFBT,DIRPG0+06,35,36) ;POINTER TO FREE POOL BIT TABLE
DEFSTR (DIRDPW,DIRPG0+07,35,36) ;DEFAULT FILE PROTECTION WORD
DEFSTR (DIRPRT,DIRPG0+10,35,36) ;DIRECTORY PROTECTION
DEFSTR (DIRDBK,DIRPG0+11,35,36) ;BACKUP SPECIFICATION
DEFSTR (DIRLIQ,DIRPG0+12,35,36) ;MAX LOGGED-IN DISK ALLOCATION
DEFSTR (DIRLOQ,DIRPG0+13,35,36) ;MAX LOGGED-OUT ALLOCATION
DEFSTR (DIRCUR,DIRPG0+14,35,36) ;CURRENT DISK ALLOCATION
DEFSTR (DIRNAM,DIRPG0+15,35,36) ;POINTER TO NAME STRING
DEFSTR (DIRPSW,DIRPG0+16,35,36) ;POINTER TO PASSWORD STRING
DEFSTR (DIRCAP,DIRPG0+17,35,36) ;PRIVILEGE BITS
DEFSTR (DIRMOD,DIRPG0+20,35,36) ;MODE BITS
DEFSTR (DIRDAT,DIRPG0+21,35,36) ;DATE AND TIME OF LAST LOGIN
DEFSTR (DIRUGR,DIRPG0+22,35,36) ;GROUPS THIS USER BELONGS TO
DEFSTR (DIRGRP,DIRPG0+23,35,36) ;DIRECTORY GROUPS
DEFSTR (DIRUDT,DIRPG0+24,35,36) ;LAST UPDATE DATE AND TIME
DEFSTR (DIRSCT,DIRPG0+25,35,18) ;SUBDIRECTORY COUNT
DEFSTR (DIRSDM,DIRPG0+25,17,18) ;SUBDIRECTORY MAXIMUM
DEFSTR (DIRSGP,DIRPG0+26,35,36) ;SUBDIRECTORY USER GROUPS
DEFSTR (DIRACT,DIRPG0+27,35,36) ;DEFAULT DIRECTORY ACCOUNT
DEFSTR (DIRDNE,DIRPG0+30,35,36) ;DEFAULT ONLINE EXPIRATION DATE/INTERVAL
DEFSTR (DIRDFE,DIRPG0+31,35,36) ;DEFAULT OFFLINE EXPIRATION DATE/INTERVAL
; OFFSETS TO VALUES AT BEGINNING OF EACH DIRECTORY PAGE
.DIDPC== 0 ;DIRECTORY PAGE CODE (.TYDIR)
.DILHD== 0 ;LENGTH OF HEADER AREA FOR THIS PAGE
.DIRPN== 1 ;RELATIVE PAGE # WITHIN DIRECTORY
.DITDN== 1 ;THIS DIRECTORY NUMBER
.DIFFB== 2 ;POINTER TO FIRST FREE BLOCK
; OFFSETS TO VALUES IN FREE BLOCK HEADERS
.FRTYP== 0 ;BLOCK TYPE (.TYFRE)
.FRLEN== 0 ;LENGTH OF BLOCK
.FRPTR== 1 ;POINTER TO NEXT BLOCK ON FREE LIST
; OFFSETS TO VALUES IN THE NAME BLOCK
.NBTYP== 0 ;BLOCK TYPE (.TYNAM)
.NBLEN== 0 ;LENGTH OF BLOCK
.NBPTR== 1 ;POINTER TO ASCIZ NAME STRING
MINNBL== 2 ;MINIMUM NAME BLOCK LENGTH
; OFFSETS TO VALUES IN THE EXTENSION BLOCK
.EBTYP== 0 ;BLOCK TYPE (.TYEXT)
.EBLEN== 0 ;LENGTH OF BLOCK
.EBPTR== 1 ;POINTER TO ASCIZ EXTENSION STRING
MINEBL== 2 ;MINIMUM EXTENSION BLOCK LENGTH
; OFFSETS TO VALUES IN THE ACCOUNT BLOCK
.ABTYP== 0 ;TYPE OF BLOCK (.TYACT)
.ABLEN== 0 ;LENGTH OF BLOCK
.ABCNT== 1 ;SHARE COUNT
.ABPTR== 2 ;POINTER TO ACCOUNT STRING
MINABL== 3 ;MINIMUM ACCOUNT BLOCK LENGTH
; OFFSETS TO VALUES IN USER NAME BLOCKS
.UNTYP==0 ;TYPE OF BLOCK (.TYUNS)
.UNLEN==0 ;LENGTH OF BLOCK
.UNCNT==1 ;SHARE COUNT
.UNPTR==2 ;POINTER TO USER NAME STRING
MINUNS==3 ;MINIMUM LENGTH OF USER NAME BLOCKS
BT%TYP==-1,,0 ;MASK FOR BLOCK TYPE FIELD
BT%VER==770000 ;MASK FOR VERSION OF DIRECTORY BLOCKS
BT%LEN==7777 ;MASK FOR LENGTH OF DIRECTORY BLOCKS
SUBTTL MACRO DEFINITIONS
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
DEFINE O.STR (STRING)
< MOVE T1,OUTJFN
XLIST
HRROI T2,[ASCIZ\STRING\]
SETZM T3
SOUT
LIST
>
DEFINE O.OCT(NUM)
< MOVE T1,OUTJFN
XLIST
MOVE T2,NUM
MOVEI T3,10
NOUT
CALL TYPERR
LIST
>
DEFINE O.DEC (NUM)
< MOVE T1,OUTJFN
XLIST
MOVE T2,<NUM>
MOVEI T3,^D10
NOUT
CALL TYPERR
MOVEI T2,"."
BOUT
LIST
>
DEFINE O.CRLF
< MOVE T1,OUTJFN
XLIST
MOVEI T2,.CHCRT
BOUT
MOVEI T2,.CHLFD
BOUT
LIST
>
DEFINE MAPTST (ADR,ERR)
< MOVE MA,ADR
XLIST
CAML MA,MAPBOT
CAMLE MA,MAPTOP
JRST [ CALL MAPDIR
IFB <ERR>,<RET>
IFNB <ERR>,<JRST ERR>
JRST .+1]
LIST
>
DEFINE GETMPW (AC,LOC,ERR)
< MAPTST LOC,ERR
XLIST
HRRZ AC,MA
ADD AC,FDBOFS
MOVE AC,(AC)
LIST
>
DEFINE GETSYM (AC,LOC)
< HRRZ AC,LOC
XLIST
ADD AC,STBOFS
MOVE AC,(AC)
LIST
>
DEFINE PUTSYM (AC,LOC)
< HRRZ AC,LOC
XLIST
ADD AC,STBOFS
MOVEM AC,(AC)
LIST
>
DEFINE TLOAD (AC,LOC,ADR)
< MOVE MA,LOC
XLIST
CAML MA,MAPBOT
CAMLE MA,MAPTOP
CALL MAPDIR
LOAD AC,LOC,ADR
LIST
>
DEFINE CRLF
< MOVEI T1,.CHCRT
XLIST
PBOUT
MOVEI T1,.CHLFD
PBOUT
LIST
>
DEFINE SAY (STRING)
< HRROI T1,[ASCIZ\STRING\]
XLIST
MOVEM T1,LASTQ
PSOUT
LIST
>
DEFINE SAYCR (STRING)
< HRROI T1,[ASCIZ\STRING
\]
XLIST
MOVEM T1,LASTQ
PSOUT
LIST
>
DEFINE PUTOCT
< MOVEI T1, 101
XLIST
MOVE T3, [1B0+^D8]
NOUT
CALL TYPERR
LIST
>
SUBTTL MAIN ENTRY POINT AND INITIALIZATION
START: RESET ;CLEAR THE UNIVERSE
MOVE P,PDP ;SET UP STACK
MOVX T1,.PRIOU ;GET DEFAULT OUTPUT JFN
MOVEM T1,OUTJFN ;DEFUALT IS PRIMARY OUTPUT FILE
SUBTTL COMMAND PARSER AND DISPATCH
HRROI T1,PROMPT ;GET POINTER TO PROMPT STRING
MOVEM T1,CMDBLK+.CMRTY ;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
HRROI T1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM T1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM T1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;SAVE PRIMARY JFN'S
MOVEI T1,PARSE1 ;GET RE-PARSE ADDRESS
MOVEM T1,CMDBLK+.CMFLG ;SAVE RE-PARSE 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: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
COMND ;INITIALIZE COMMAND SCANNER JSYS
PARSE1: MOVE P,PDP ;SET UP STACK
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
MOVEI T1,GJFBLK ;GET ADDRESS OF GTJFN BLOCK
MOVEM T1,CMDBLK+.CMGJB ;STORE POINTER TO GTJFN BLOCK
MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;GET FUNCTION BLOCK
COMND ;DO INITIAL PARSE
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 <? DIRTST: No such DIRTST 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
CALL (T1) ;PERFORM REQUESTED FUNCTION
JRST PARSE ;GO PARSE NEXT COMMAND
SUBTTL TEST COMMAND
.TEST:
DOMAP: STKVAR <TSTJFN,TSTOUT>
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMNOI,,<TXT(DIRECTORY FILE)>)]
COMND ;PARSE NOISE WORDS
TXNN T1,CM%NOP ;PARSED GUIDE PHRASE OK ?
JRST TEST05 ;YES, GO ON
HRROI T1,[ASCIZ/Invalid guide phrase/]
CALLRET TYPATM ;GO OUTPUT USER'S TEXT
RET ;DONE, RETURN
; HERE ON A VALID GUIDE PHRASE - PARSE DIRECTORY FILE SPECIFICATION
TEST05: GJINF ;GET CONNECTED DIRECTORY NUMBER
HRROI T1,REPLY ;GET POINTER TO DIRECTORY NAME
DIRST ;GET STRING FOR DIRECTORY NAME
JRST [ SETZM DIRFDB+.CMDEF ;FAILED, CLEAR DEFAULT
JRST TEST10 ] ;GO DO INPUT WITHOUT DEFAULT
MOVE T1,[POINT 7,REPLY] ;GET POINTER TO STR:<DIR> STRING
CALL GTSTR ;SET UP TO DUMP CONNECTED DIRECTORY STRING
JRST [ SETZM DIRFDB+.CMDEF ;FAILED, CLEAR DEFAULT
JRST TEST10 ] ;GO DO INPUT WITHOUT DEFAULT
MOVEM T2,DIRFDB+.CMDEF ;SAVE POINTER TO DEFAULT STRING
MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR
SETZM GJFBLK ; THE GTJFN BLOCK
BLT T1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVX T1,GJ%IFG!GJ%PHY!GJ%IFG ;FLAGS
MOVEM T1,GJFBLK+.GJGEN ;SAVE FLAGS
HRROI T1,[ASCIZ/DIRECTORY/] ;GET DEFAULT EXTENSION
MOVEM T1,GJFBLK+.GJEXT ;SAVE EXTENSION DEFAULT
HRROI T1,[ASCIZ/ROOT-DIRECTORY/]
MOVEM T1,GJFBLK+.GJDIR ;SAVE DEFAULT DIRECTORY POINTER
TEST10: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,DIRFDB ;GET ADDRESS OF DIRECTORY FILESPEC FDB
COMND ;PARSE FILESPEC
TXNN T1,CM%NOP ;FILENAME PARSED OK ?
JRST TEST15 ;YES, GO STORE DIRECTORY NUMBER
CALL TSTCOL ;OUTPUT CRLF IF NEEDED
TMSG <? DIRTST: No such directory file as ">
HRROI T1,ATMBFR ;GET ATOM BUFFER POINTER
PSOUT ;OUTPUT NAME ENTERED BY USER
TMSG <"
> ;OUTPUT END OF MESSAGE
MOVEI T1,.PRIOU ;GET OUTPUT JFN
HRLOI T2,.FHSLF ;GET OUR PROCESS HANDLE
SETZM T3 ;NO FLAGS
ERSTR ;OUTPUT ERROR STRING
JFCL ;IGNORE ERRORS
JFCL ;IGNORE ERRORS
CALL TSTCOL ;OUTPUT CRLF IF NEEDED
RET ;RETURN
; HERE ON A VALID DIRECTORY FILE SPECIFICATION - PARSE END OF COMMAND
TEST15: MOVEM T2,TSTJFN ;SAVE JFN
MOVEI T2,[FLDDB. (.CMCFM)]
COMND ;CONFIRM COMMAND
TXNE T1,CM%NOP ;END-OF-COMMAND SEEN OK ?
CALLRET COMER2 ;NO, GO ISSUE MESSAGE
MOVEI T1,.FHSLF ;GET OUR FORK HANDLE
RPCAP ;READ OUR ENABLED CAPABILITIES
TXNN T3,SC%WHL!SC%OPR ;WHEEL OR OPERATOR ENABLED ?
JRST [ CALL TSTCOL ;NO, NEW LINE IF NEEDED
TMSG <? DIRTST: WHEEL or OPERATOR capability required
> ;OUTPUT MESSAGE
HALTF ;QUIT
JRST START ] ;AND START AGAIN IF CONTINUE'D
MOVE T1,OUTJFN ;GET JFN BACK AGAIN
MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
OPENF ;OPEN THE FILE
JRST [ JSERR ;UNEXPECTED ERROR
MOVE T1,OUTJFN ;GET JFN
RLJFN ;RELEASE JFN
JFCL ;IGNORE ERRORS
RET ] ;RETURN
MOVE T1,TSTJFN ;GET JFN OF DIRECTORY FILE
MOVEM T1,DIRFLG ;ALSO SAVE FLAGS
MOVEM T1,DIRJFN ;SAVE DIRECTORY JFN
HRRZ T1,DIRJFN ;GET DIRECTORY JFN
MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD+OF%THW>
OPENF ;OPEN THE FILE TO BE TESTED
JRST [ JSERR ;ERROR, ISSUE MESSAGE
MOVE T1,DIRJFN ;GET JFN BACK
RLJFN ;RELEASE THE JFN
JFCL ;IGNORE ERRORS HERE
RET ] ;RETURN
; ..
; ..
; HERE TO START TESTING
TEST20: CALL MAPDP0 ;GO MAP FIRST PAGE OF DIRECTORY
CALL MAPSTB ;GO MAP IN THE SYMBOL TABLE
MOVEI MA,0 ;GET AN ADDRESS TO MAP
CALL MAPDIR ;GO MAP SOMETHING TO START
JRST [ CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? DIRTST: Could not map directory file
>
HALTF ;DIE
JRST START ] ;TRY AGAIN
SETZM ERRCNT ;INITIALIZE ERROR COUNT
CALL SETNAM ;GO SET UP DIRECTORY NAME
MAIN00: MOVE T1,OUTJFN ;GET OUTPUT JFN
MOVEI T2,.CHFFD ;GET A FORM FEED
BOUT ;OUTPUT A FORM FEED
O.STR <Test of directory >
MOVE T1,OUTJFN ;GET OUTPUT JFN
HRROI T2,CURNAM ;GET POINTER TO DIRECTORY NAME
SETZM T3 ;TERMINATE ON NULL
SOUT ;OUTPUT DIRECTORY NAME
O.STR <, # > ;OUTPUT PUNCTUATION
HRRZ P1,CURDIR ;GET DIR #
O.OCT P1 ;OUTPUT DIRECTORY NUMBER
MOVE T1,OUTJFN ;GET OUTPUT JFN
O.STR (<, on >) ;OUTPUT PUNCTUATION
MOVE T1,OUTJFN ;GET OUTPUT JFN
SETOM T2 ;USE CURRENT DATE AND TIME
SETZM T3 ;USE STANDARD DATE FORMAT
ODTIM ;OUTPUT THE DATE AND TIME
O.CRLF ;OUTPUT A CRLF
O.CRLF ;LEAVE A BLANK LINE
MAIN01: CALL DIRCHK ;GO CHECK HEADER OF EACH PAGE
CALL DUPCHK ;CHECK FOR DUPLICATE ST ENTRIES
CALL ORDCHK ;GO CHECK ALPHABETIC ORDERINGS
CALL TSTBLK ;INSURE ALL BLOCKS POINTED TO
CALL GENTST ;CHECK ORDERING OF GENERATIONS
CALL CHKFRN ;VERIFY NO PTRS GO TO FREE LIST
CALL FRETST ;CHECK THAT NO FREE BLOCKS ABUT
NEWTST: CALL PTRTST ;GO CHECK CONSISTENCY OF FDB'S
O.CRLF ;LEAVE A BLANK LINE
SKIPN NEXCNT ;ANY FDB'S WITH FD%NEX ON ?
JRST MAIN65 ;NO, OMIT MESSAGE
O.STR <% > ;OUTPUT INITIAL PART OF MESSAGE
O.DEC NEXCNT ;OUTPUT # OF FDB'S WITH FD%NEX
O.STR < FDB's with FD%NEX on were found
>
MAIN65: CALL SUMMRY ;OUTPUT A SUMMARY
MOVE T1,OUTJFN ;GET OUTPUT JFN
DVCHR ;GET CHARACTERISTICS
LOAD T4,DV%TYP,T2 ;GET JUST THE DEVICE TYPE
CAIN T4,.DVTTY ;A TERMINAL ?
JRST MAIN80 ;YES, DO NOT OUTPUT SUMMARY AGAIN
MOVE T1,OUTJFN ;GET OUTPUT JFN
MOVEM T1,TSTOUT ;SAVE OUTPUT JFN
MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT JFN
MOVEM T1,OUTJFN ;SAVE AS TEMPORARY OUTPUT JFN
CALL SUMMRY ;OUTPUT SUMMARY TO TERMINAL
MOVE T1,TSTOUT ;GET ORIGINAL OUTPUT JFN
MOVEM T1,OUTJFN ;SAVE OUTPUT JFN
MAIN80: SETOM T1 ;REMOVE PAGES FROM THIS FORK
HRRZI T2,DIRPG0 ;GET ADR WERE MAPPING BEGINS
LSH T2,-^D9 ;CONVERT ADR TO A PAGE NUMBER
HRLI T2,.FHSLF ;GET OUR FORK HANDLE
MOVX T3,FDBPGS+STBPGS+3 ;GET # OF PAGES TO REMOVE
TXO T3,PM%CNT ;INDICATE PMAP SHOULD ITERATE
PMAP ;MAP THE PAGES INTO LIMBO
HRRZ T1,DIRJFN ;GET DIRECTORY JFN
TLO T1,400000 ;DO NOT RELEASE JFN
CLOSF ;CLOSE DIRECTORY FILE
CALL PUTERR ;UNEXPECTED ERROR, CONTINUE
MOVE T1,DIRFLG ;GET FLAGS AND DIRECTORY JFN
GNJFN ;GET NEXT JFN IN GROUP
JRST ALLDON ;NO MORE FILES, ALL DONE
MOVEM T1,DIRJFN ;SAVE THE DIRECTORY JFN
CALL OPNDIR ;GO OPEN DIRECTORY FILE
JRST TEST20 ;GO DO NEXT DIRECTORY
; HERE AT COMPLETION OF TESTS - CLEAN UP AND RETURN TO PARSER
ALLDON: MOVE T1,OUTJFN ;GET OUTPUT JFN
MOVEI T2,.CHFFD ;GET A FORM FEED CHARACTER
BOUT ;OUTPUT A FORM FEED
MOVE T1,OUTJFN ;GET OUTPUT JFN
TXO T1,CO%NRJ ;KEEP THE JFN
CLOSF ;CLOSE OUTPUT FILE
CALL PUTERR ;UNEXPECTED ERROR, CONTINUE
RET ;RETURN TO PARSER
;SUMMRY - ROUTINE TO OUTPUT SUMMARY AFTER PERFORMING TESTS
SUMMRY: SKIPN ERRCNT ;ANY ERRORS FOUND ?
JRST SMRY70 ;NO, GO SAY SO
O.STR <[Total of >
O.DEC ERRCNT ;OUTPUT # OF ERRORS
O.STR < error> ;OUTPUT NEXT PART OF MESSAGE
MOVE P1,ERRCNT ;GET # OF ERRORS FOUND
CAIG P1,1 ;MORE THAN ONE ERROR FOUND ?
JRST SMRY67 ;NO, USE 1-ERROR MESSAGE
O.STR <s were detected]
>
RET ;DONE
SMRY67: O.STR < was detected]
>
RET ;DONE
SMRY70: O.STR <[No errors were detected]
>
RET ;DONE
;SETNAM - ROUTINE TO SET UP THE NAME OF DIRECTORY BEING TESTED
SETNAM: HRROI T1,REPLY ;GET ADDRESS OF TEMPORARY BUFFER
HRRZ T2,DIRJFN ;GET JFN OF DIRECTORY FILE
MOVX T3,<FLD(.JSAOF,JS%DEV)+JS%PAF>
JFNS ;GET THE STRUCTURE NAME
HRROI T1,REPLY ;GET POINTER TO STR NAME
STDEV ;GET DEV DESIGNATOR
ERJMP R ;FAILED, RETURN
HRLM T2,NUMDIR ;SAVE STR UNIQUE CODE
HRRZ T1,DIRJFN ;GET DIRECTORY FILE JFN
MOVE T2,[1,,.FBGEN] ;GET DIR # FROM FDB
MOVEI T3,T4 ;PUT DIR # INTO T4
GTFDB ;GET DIRECTORY NUMBER
ERJMP R ;RETURN ON FAILURE
HRRM T4,NUMDIR ;FORM COMPLETE DIRECTORY DESIGNATOR
MOVE T1,NUMDIR ;GET DIRECTORY DESIGNATOR
HRRZM T1,CURDIR ;SAVE JUST DIR # PART
HRROI T1,CURNAM ;GET POINTER TO WHERE NAME GOES
MOVE T2,NUMDIR ;GET DIRECTORY DESIGNATOR
DIRST ;FORM DIRECTORY NAME
JRST [ HRROI T1,CURNAM ;FAILED, USE SOME OTHER STRING
HRROI T2,[ASCIZ/*** <Unknown Directory Name> ***/]
SETZM T3
SOUT ;SAVE STRING
JRST .+1] ;CONTINUE
RET ;DONE
; DIRCHK - ROUTINE TO CHECK THE HEADER IN EACH PAGE OF THE
; DIRECTORY FOR CONSISTENCY. PERFORMS THE FOLLOWING
; TESTS:
; 1. BLOCK TYPE SHOULD BE 403000
; 2. DIRECTORY # SHOULD BE THE SAME IN EACH PAGE.
; 3. PAGE # SHOULD INCREMENT FOR EACH PAGE.
;
; CALL: CALL DIRCHK
; RETURN
DIRCHK: SETZM I2 ;START WITH PAGE 0
LOAD I1,DIRFRE ;GET HIGHEST ADR+1 USED BLOCKS
JUMPE I1,DIRCH1 ;IF JUST PAGE 0, ALL SET
SUBI I1,1 ;COMPUTE HIGHEST ADR ACTUALLY USED
LSH I1,-^D9 ;CONVERT TO A PAGE NUMBER
DIRCH1: MOVE P1,I2 ;GET # OF PAGE TO CHECK
LSH P1,^D9 ;CONVERT PAGE # TO AN ADDRESS
MOVEI P2,.DIDPC(P1) ;GET DIRECTORY PAGE CODE ADR
GETMPW P3,P2 ;GET WORD ROM HEADER
HLRZ P3,P3 ;KEEP JUST THE CODE
CAIN P3,.TYDIR ;CORRECT CODE ?
JRST DIRCH2 ;YES, GO ON TO NEXT CHECK
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Incorrect Block Type >
O.OCT P3 ;OUTPUT THE BLOCK TYPE
O.STR < encountered in directory page >
O.OCT I2 ;OUTPUT DIRECTORY PAGE #
O.CRLF ;NEW LINE
DIRCH2: MOVE P1,I2 ;GET PAGE # TO CHECK
LSH P1,^D9 ;CONVERT PAGE # TO ADDRESS
MOVEI P2,.DITDN(P1) ;GET ADR OF DIRECTORY NUMBER
GETMPW P3,P2 ;GET THIS DIRECTORY NUMBER
HRRZ P3,P3 ;KEEP JUST THE DIR NUMBER
CAMN P3,CURDIR ;CORRECT DIRECTORY NUMBER ?
JRST DIRCH3 ;YES, GO ON TO NEXT CHECK
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Incorrect directory number >
O.OCT P3 ;OUTPUT DIRECTORY # FOUND
O.STR < found on directory page >
O.OCT I2 ;OUTPUT PAGE #
O.STR <
Expected directory # was >
O.OCT CURDIR ;OUTPUT EXPECTED #
O.CRLF
DIRCH3: MOVE P1,I2 ;COPY PAGE # TO CHECK
LSH P1,^D9 ;CONVERT PAGE # TO ADDRESS
MOVEI P2,.DIRPN(P1) ;GET ADR OF PAGE #
GETMPW P3,P2 ;GET WORD FROM HEADER
HLRZ P3,P3 ;GET RELATIVE PAGE NUMBER
CAMN P3,I2 ;CORRECT PAGE NUMBER ?
JRST DIRCH4 ;YES, GO ON
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Incorrect page # >
O.OCT P3 ;OUTPUT PAGE # FOUND
O.STR < found on page >
O.OCT I2 ;OUTPUT REAL PAGE #
O.STR < of directory
>
DIRCH4: CAMGE I2,I1 ;DONE ALL PAGES YET ?
AOJA I2,DIRCH1 ;NO, GO DO NEXT PAGE
LOAD P1,DIRBOT ;GET BOTTOM ADR OF SYMBOL TABLE
GETSYM P2,P1 ;GET FIRST WORD OF SYMBOL TABLE
HLRZ P3,P2 ;GET BLOCK TYPE
CAIN P3,.TYSYM ;BLOCK TYPE = SYMBOL TABLE ?
RET ;YES, RETURN
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Incorrect Block Type >
O.OCT P3 ;OUTPUT BLOCK TYPE
O.STR < in first word of Symbol Table
>
RET ;RETURN
SUBTTL SYMBOL TABLE CHECKER
; DUPCHK - ROUTINE TO CHECK FOR DUPLICATE ENTRIES IN THE
; SYMBOL TABLE.
;
; CALL: CALL DUPCHK
; RETURN
DUPCHK: STKVAR <CURPTR> ;ALLOCATE TEMPORARY STORAGE
LOAD I1,DIRBOT ;GET BOTTOM ADR OF SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY
DUPCH1: LOAD P1,DIRTOP ;GET TOP ADDRESS IN SYMBOL TABLE
CAMG P1,I1 ;AT END OF TABLE YET ?
RET ;YES, RETURN TO WHENCE WE CAME
GETSYM P1,I1 ;NO, GET ADDRESS OF A BLOCK
MOVEM P1,CURPTR ;SAVE POINTER TO BLOCK
MOVEI I2,STESIZ(I1) ;GET ADDRESS OF NEXT ENTRY
; LOOP TO SEE IF THE BLOCK ADDRESS P1 IS DUPLICATED
DUPCH2: LOAD P4,DIRTOP ;GET ADDRESS OF TOP OF TABLE
CAMG P4,I2 ;AT END-OF-SYMBOL TABLE YET ?
JRST DUPCH3 ;YES, GO COMPARE NEXT ENTRY
GETSYM P3,I2 ;NO, GET FIRST WORD OF ENTRY
CAMN P3,CURPTR ;DUPLICATE ENTRY ?
CALL DUPENT ;YES, GO ISSUE ERROR MESSAGE
ADDI I2,STESIZ ;INCREMENT POINTER TO NEXT ENTRY
JRST DUPCH2 ;GO CHECK FOR END-OF-TABLE
DUPCH3: ADDI I1,STESIZ ;INCREMENT POINTER TO NEXT ENTRY
JRST DUPCH1 ;GO CHECK NEXT ENTRY IN TABLE
; DUPENT - ROUTINE TO ISSUE AN ERROR MESSAGE ON ENCOUNTERING
; A DUPLICATE POINTER IN THE SYMBOL TABLE.
;
; CALL: MOVE I1,ADDRESS OF FIRST ENTRY
; MOVE I2,ADDRESS OF DUPLICATE ENTRY
; CALL DUPENT
; RETURN
DUPENT: O.STR <? Duplicate pointers In Symbol Table
First entry at >
O.OCT <I1> ;OUTPUT ADDRESS OF ENTRY
O.STR < is:
>
MOVE Q1,I1 ;COPY ADDRESS IN ARGUMENT AC
CALL PUTSTE ;GO OUTPUT SYMBOL TABLE ENTRY
o.str < Second entry at >
O.OCT (I2) ;OUTPUT ADR OF DUPLICATE ENTRY
O.STR < is
>
MOVE Q1,I1 ;COPY ADDRESS IN ARGUMENT AC
CALL PUTSTE ;GO OUTPUT SYMBOL TABLE ENTRY
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
RET ;RETURN TO WHENCE WE CAME ...
; PUTSTE - ROUTINE TO OUTPUT A SYMBOL TABLE ENTRY
;
; CALL: MOVE Q1,ADDRESS OF ENTRY
; CALL PUTSTE
; RETURN
PUTSTE: O.STR < Type & Pointer: >
GETSYM T2,Q1 ;GET FIRST WORD OF ENTRY
MOVE T1,OUTJFN ;GET OUTPUT JFN
MOVE T3,[1B0+10] ;PRINT MAGNITUDE, RADIX IS OCTAL
NOUT ;OUTPUT THE FIRST WORD OF ENTRY
CALL TYPERR ;UNEXPECTED ERROR
O.STR <
Name string: >
MOVEI P1,1(Q1) ;GET ADDRESS OF SECOND WORD
GETSYM P2,P1 ;GET ASCII NAME
MOVE T1,OUTJFN ;GET OUTPUT JFN
HRROI T2,P2 ;FORM POINTER TO NAME
MOVEI T3,5 ;OUTPUT 5 CHARACTERS MAX
SETZM T4 ;TERMINATE IF NULL SEEN
SOUT ;OUTPUT THE NAME STRING
O.CRLF ;OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; ORDCHK - ROUTINE TO CHECK THE ALPHABETIC ORDERING OR
; STRINGS IN THE DIRECTORY.
;
; CALL: CALL ORDCHK
; RETURN
ORDCHK: STKVAR <LSTSYM,ORDTYP> ;ALLOCATE TEMPORARY STORAGE
MOVEI T1,.STNAM ;GET FIRST TYPE OF SYMBOL TABLE ENTRIES
MOVEM T1,ORDTYP ;SAVE CURRENT ENTRY TYPE
LOAD I1,DIRBOT ;GET BOTTOM ADR OF SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY
LOAD P1,DIRTOP ;GET TOP ADDRESS IN SYMBOL TABLE
CAMG P1,I1 ;CHECKED ALL ENTRIES YET ?
JRST ORDCK7 ;YES, GO CHECK EXT CHAINS
MOVEI P1,1(I1) ;GET ADDRESS OF SYMBOL
GETSYM P2,P1 ;GET SYMBOL FROM TABLE
LSH P2,-1 ;MAKE THE NUMBER POSITIVE
ORDCK1: MOVEM P2,LSTSYM ;SAVE LAST SYMBOL
ADDI I1,STESIZ ;POINT TO NEXT ENTRY IN TABLE
LOAD P1,DIRTOP ;GET TOP ADR IN SYMBOL TABLE
CAMG P1,I1 ;REACHED LAST ENTRY YET ?
JRST ORDCK7 ;YES, GO CHECK EXT CHAINS
MOVEI P1,1(I1) ;GET ADR OF SYMBOL
GETSYM P2,P1 ;GET A SYMBOL FROM TABLE
GETSYM P4,I1 ;GET FIRST WORD OF ENTRY
LDB P4,[POINTR P4,.STMSK] ;GET ENTRY TYPE
CAME P4,ORDTYP ;SAME AS CURRENT TYPE ?
JRST [ MOVEM P4,ORDTYP ;NO, SAVE NEW CURRENT TYPE
LSH P2,-1 ;MAKE THE NEW "LAST NUMBER" POSITIVE
JRST ORDCK1 ] ;GO START CHECKING NEXT SECTION OF TABLE
LSH P2,-1 ;MAKE NUMBER POSITIVE
CAMN P2,LSTSYM ;THIS SYMBOL SAME AS LAST ?
JRST ORDCK2 ;YES, GO CHECK ENTIRE NAME
CAMG P2,LSTSYM ;THIS SYMBOL .GT. LAST ?
CALL ORDERR ;NO, ISSUE ERROR MESSAGE
JRST ORDCK1 ;GO CHECK NEXT PAIR OF SYMBOLS
ORDCK2: GETSYM P1,I1 ;GET FIRST WORD OF ENTRY 1
LDB Q1,[POINTR P1,.STPTR] ;GET ADR IN ENTRY
LDB P2,[POINTR P1,.STMSK] ;GET TYPE OF ENTRY
CAIE P2,.STNAM ;IS THIS A POINTER TO AN FDB ?
JRST ORDCK3 ;NO, WE HAVE ACCOUNT BLOCK ADR
MOVEI P1,.FBNAM(Q1) ;YES, GET ADR OF PTR TO NAME BLK
GETMPW P2,P1 ;GET ADR OF NAME BLOCK
MOVEI Q1,.NBPTR(P2) ;GET ADR OF NAME STRING
JRST ORDCK4 ;GO GET PREVIOUS ENTRY
ORDCK3: ADDI Q1,.ABPTR ;POINT TO ACCOUNT STRING
ORDCK4: MOVEI P1,-STESIZ(I1) ;GET ADR OF PREVIOUS ENTRY
GETSYM P2,P1 ;GET FIRST WORD OF ENTRY
LDB Q2,[POINTR P2,.STPTR] ;GET ADR IN ENTRY
LDB P3,[POINTR P2,.STMSK] ;GET TYPE OF ENTRY
CAIE P3,.STNAM ;IS THIS AN FDB ADDRESS ?
JRST ORDCK5 ;NO, MUST BE AN ACCOUNT BLK
MOVEI P1,.FBNAM(Q2) ;YES, GET ADDRESS OF NAME BLK
GETMPW P2,P1 ;GET ADDRESS OF NAME BLOCK
MOVEI Q2,.NBPTR(P2) ;GET ADDRESS OF NAME STRING
JRST ORDCK6 ;GO COMPARE THE STRINGS
ORDCK5: ADDI Q2,.ABPTR ;FORM POINTER TO ACCOUNT STRING
;FALL INTO ORDCK6 ...
ORDCK6: CALL STRCMP ;GO COMPARE THE STRINGS
JUMPG Q1,ORDCK1 ;GO CHECK NEXT PAIR OF ENTRIES
CALL ORDERR ;GO ISSUE ERROR MESSAGE
MOVEI P1,1(I1) ;GET ADR OF THIS SYMBOL
GETSYM P2,P1 ;GET THE SYMBOL AGAIN
JRST ORDCK1 ;GO CHECK NEXT PAIR OF ENTRIES
ORDCK7: CALLRET ORDEXT ;GO CHECK EXT ORDERING
; ORDERR - ROUTINE TO ISSUE ERROR MESSAGE IF THE SYMBOL TABLE
; IS OUT OF ORDER.
;
; CALL: MOVE I1,ADR OF BAD ENTRY
; CALL ORDERR
; RETURN
ORDERR: O.STR <
? Symbol Table entry at >
O.OCT I1 ;OUTPUT ADR OF ENTRY
O.STR < is out of order
>
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
RET ;RETURN TO WHENCE WE CAME ...
; ORDEXT - ROUTINE TO CHECK THE ORDERING OF FDB'S ON AN
; EXTENSION CHAIN.
;
; CALL: CALL ORDEXT
; RETURN
ORDEXT: STKVAR <LSTEXT,LSTFDB> ;ALLOCATE TEMPORARY STORAGE
LOAD I1,DIRBOT ;GET BOTTOM ADR IN SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY
ORDEX1: LOAD P1,DIRTOP ;GET TOP ADR IN SYMBOL TABLE
CAMG P1,I1 ;ALL ENTRIES CHECKED YET ?
RET ;YES, RETURN
GETSYM P1,I1 ;NO, GET FIRST WORD OF ENTRY
LDB P2,[POINTR P1,.STMSK] ;GET ENTRY TYPE
CAIE P2,.STNAM ;FILENAME ENTRY ?
JRST ORDEX3 ;NO, GO CHECK NEXT ENTRY
LDB FB,[POINTR P1,.STPTR] ;YES, GET ADR OF FDB
MOVEI P1,.FBEXT(FB) ;GET ADDRESS OF PTR TO EXT BLOCK
GETMPW P2,P1 ;GET ADDRESS OF EXT BLOCK
MOVEI P2,.EBPTR(P2) ;GET ADDRESS OF EXTENSION STRING
MOVEM P2,LSTEXT ;SAVE ADDRESS OF LAST EXTENSION
ORDEX2: MOVEM FB,LSTFDB ;SAVE ADDRESS OF LAST FDB
MOVEI P1,.FBEXL(FB) ;GET ADR OF PTR TO NEXT EXT FDB
GETMPW FB,P1 ;GET ADDRESS OF NEXT EXT FDB
JUMPE FB,ORDEX3 ;IF END-OF-CHAIN, DO NEXT CHAIN
MOVEI P1,.FBEXT(FB) ;GET ADR OF PTR TO EXT STRING
GETMPW P2,P1 ;GET ADDRESS OF EXTENSION BLOCK
MOVEI Q2,.EBPTR(P2) ;GET ADDRESS OF EXTENSION STRING
MOVE Q1,LSTEXT ;GET ADDRESS OF LAST STRING
MOVEM Q2,LSTEXT ;SAVE NEW LAST EXTENSION
CALL STRCMP ;COMPARE THE TWO EXTENSIONS
JUMPL Q1,ORDEX2 ;IF ORDERING OK, CHECK NEXT EXT
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Extension chain is out of order
FDB with bad extension is at address >
O.OCT FB ;OUTPUT THE FDB ADDRESS
O.STR <
Previous FDB is at address >
MOVE P1,LSTFDB ;GET ADR OF PREVIOUS FDB
O.OCT P1 ;OUTPUT FDB ADDRESS
O.CRLF ;OUTPUT A CRLF
JRST ORDEX2 ;GO CHECK NEXT PAIR OF STRINGS
ORDEX3: ADDI I1,STESIZ ;POINT TO NEXT ENTRY
JRST ORDEX1 ;GO CHECK NEXT PAIR OF EXT'S
SUBTTL CHECK ORDERING OF FDB'S ON GENERATION CHAINS
; GENTST - ROUTINE TO CHECK THE ORDERING OF FDB'S ON GENERATION
; CHAINS.
;
; CALL: CALL GENTST
; RETURN, MESSAGE ISSUED IF APPROPRIATE
GENTST: STKVAR <EXHEAD,CURGEN> ;ALLOCATE TEMPORARY STORAGE
LOAD I1,DIRBOT ;GET BOTTOM ADR IN SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY IN TABLE
GENTS1: LOAD P1,DIRTOP ;GET TOP ADR IN SYMBOL TABLE
CAMG P1,I1 ;CHECKED ALL ENTRIES YET ?
RET ;YES, RETURN
GETSYM P1,I1 ;NO, GET FIRST WORD OF ENTRY
LDB P2,[POINTR P1,.STMSK] ;GET ENTRY TYPE
CAIE P2,.STNAM ;IS THIS AN FDB ADR ?
JRST GENTS5 ;NO, GO CHECK NEXT ENTRY
LDB P1,[POINTR P1,.STPTR] ;YES, GET ADR OF FDB
GENTS2: MOVEM P1,EXHEAD ;SAVE ADR OF HEAD OF CHAIN
MOVEI P2,.FBGEN(P1) ;GET ADR OF GENERATION
GETMPW P3,P2 ;GET GENERATION FROM FDB
GENTS3: HLRZM P3,CURGEN ;SAVE THIS GENERATION
MOVEI P2,.FBGNL(P1) ;GET ADR OF PTR TO NEXT GEN
GETMPW P1,P2 ;GET POINTER TO NEXT GEN FDB
JUMPE P1,GENTS4 ;IF END-OF-CHAIN, TRY NEXT EXT
MOVEI P2,.FBGEN(P1) ;GET ADR OF GENERATION WORD
GETMPW P3,P2 ;GET GENERATION WORD FROM FDB
HLRZ P4,P3 ;GET JUST THE GENERATION
CAML P4,CURGEN ;IS THE ORDERING CORRECT ?
CALL GENERR ;NO, ISSUE ERROR MESSAGE
JRST GENTS3 ;GO CHECK NEXT FDB ON CHAIN
GENTS4: MOVE P1,EXHEAD ;GET ADR OF FDB AT HEAD OF CHAIN
MOVEI P2,.FBEXL(P1) ;GET ADR OF PTR TO NEXT FDB
GETMPW P1,P2 ;GET POINTER TO NEXT FDB
JUMPN P1,GENTS2 ;GO CHECK THIS EXT CHAIN
GENTS5: ADDI I1,STESIZ ;POINT TO NEXT ENTRY IN S.T.
JRST GENTS1 ;GO CHECK NEXT FDB CHAIN
; GENERR - ROUTINE TO ISSUE AN ERROR MESSAGE IF THE FDB'S ON
; A GENERATION CHAIN WERE FOUND TO BE OUT OF ORDER.
;
; CALL: MOVE P1,ADR OF FDB
; CALL GENERR
; RETURN
GENERR: STKVAR <BADFDB> ;ALLOCATE TEMPORARY STORAGE
MOVEM P1,BADFDB ;SAVE ADR OF FDB
O.STR <
? Generation chain is out of order
fdb with bad generation is at address >
move P1,badfdb ;restore fdb address
o.oct P1 ;output address of fdb
o.crlf ;output a crlf
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
ret ;return to whence we came ...
SUBTTL FREE LIST CHECKER
; CHKFRN - ROUTINE TO DETERMINE IF ANY OF THE POINTERS IN
; AN FDB CHAIN OF POINTING INTO THE FREE LIST.
;
; CALL: CALL CHKFRN
; RETURN, ERROR MESSAGES ISSUED IF APPROPRIATE
CHKFRN: LOAD I1,DIRBOT ;GET BOTTOM ADR OF SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY
CHKFN1: LOAD P1,DIRTOP ;GET TOP ADDRESS IN SYMBOL TABLE
CAMG P1,I1 ;AT END-OF-TABLE YET ?
RET ;YES, RETURN
GETSYM Q1,I1 ;GET A SYMBOL TABLE ENTRY
LDB P1,[POINTR Q1,.STMSK] ;GET JUST THE TYPE CODE
CAIE P1,.STNAM ;IS THIS A POINTER TO AN FDB ?
JRST CHKFN4 ;NO, GO CHECK ACCOUNT BLOCK
CALL BLKCHK ;YES, GO SEE IF ITS ON FREE LIST
JRST [ HRROI T2,[ASCIZ/FDB/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFN2 ] ;GO CHECK NAME BLOCK
CHKFN2: MOVEI P1,.FBNAM(Q1) ;GET ADDRESS OF NAME WORD IN FDB
GETMPW Q1,P1 ;GET THE NAME WORD FROM THE FDB
CALL BLKCHK ;SEE IF NAME BLK IS ON FREE LIST
JRST [ HRROI T2,[ASCIZ/Name Block/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFN3 ] ;GO CHECK REST OF EXT CHAIN
CHKFN3: GETSYM P1,I1 ;GET SYMBOL TABLE ENTRY AGAIN
LDB FB,[POINTR(P1,.STPTR)] ;GET JUST THE BLOCK ADDRESS
CALL CHKFRE ;GO CHECK ENTIRE EXT CHAIN
JRST CHKFN5 ;CHECK NEXT SYMBOL TABLE ENTRY
CHKFN4: CALL BLKCHK ;GO CHECK ACCOUNT BLOCK
JRST [ HRROI T2,[ASCIZ/Account Block/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFN5 ] ;GO CHECK NEXT ENTRY
CHKFN5: ADDI I1,STESIZ ;POINT TO NEXT ENTRY IN TABLE
JRST CHKFN1 ;GO CHECK THE NEXT ENTRY
; CHKFRE - ROUTINE TO DETERMINE IF ANY OF THE POINTERS IN
; THE FDB'S ON AN EXTENSION CHAIN POINT INTO THE
; FREE LIST.
;
; CALL: MOVE FB, ADDRESS OF FDB AT HEAD OF CHAIN
; CALL CHKFRE
; RETURN, ERROR MESSAGE ISSUED IF ANY POINTERS
; POINTED INTO THE FREE LIST.
CHKFRE: STKVAR <ARGFDB> ;ALLOCATE TEMPORARY STORAGE
MOVEM FB,ARGFDB ;SAVE ARGUMENT FDB ADDRESS
CHKFE1: MOVE P1,FB ;GET ADR OF FDB AT HEAD OF CHAIN
MOVEI P2,.FBEXT(P1) ;GET ADDRESS OF EXTENSION WORD
GETMPW Q1,P2 ;GET EXTENSION WORD FROM FDB
CALL BLKCHK ;GO CHECK EXTENSION BLOCK
JRST [ HRROI T2,[ASCIZ/Extension Block/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFE2 ] ;GO CHECK GENERATION CHAIN
CHKFE2: CALL CHKFRG ;GO CHECK ACCOUNT, GEN POINTERS
MOVEI P1,.FBEXL(FB) ;GET ADDRESS OF EXTENSION WORD
GETMPW FB,P1 ;GET EXTENSION WORD FROM FDB
JUMPE FB,CHKFE3 ;IF END-OF-CHAIN, GO RETURN
MOVE Q1,FB ;GET ADDRESS OF NEXT CHAIN
CALL BLKCHK ;GO CHECK HEAD OF NEXT EXT CHAIN
JRST [ HRROI T2,[ASCIZ/FDB/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFE1 ] ;GO CHECK NEXT EXT CHAIN
JRST CHKFE1 ;GO CHECK NEXT EXT CHAIN
CHKFE3: MOVE FB,ARGFDB ;RESTORE ORIGINAL FDB ADDRESS
RET ;RETURN TO WHENCE WE CAME ...
; CHKFRG - ROUTINE TO DETERMINE IF ANY OF THE FDB OR ACCOUNT
; BLOCK POINTERS IN THE FDB'S ON A GIVEN GENERATION
; CHAIN POINT INTO THE FREE LIST.
;
; CALL: MOVE FB,ADDRESS OF FDB AT HEAD OF GEN CHAIN
; CALL CHKFRG
; RETURN, ERROR MESSAGE ISSUED FOR ANY
; POINTERS ERRONEOUSLY POINTING INTO FREE LIST.
CHKFRG: STKVAR <CURFDB> ;ALLOCATE TEMPORARY STORAGE
MOVE P1,FB ;COPY CURRENT FDB ADDRESS
CHKFG1: MOVEM P1,CURFDB ;SAVE CURRENT FDB ADDRESS
MOVEI P2,.FBACT(P1) ;GET ADDRESS OF ACCOUNT WORD
GETMPW Q1,P2 ;GET ACCOUNT WORD FROM FDB
JUMPL Q1,CHKFG2 ;IF NUMERIC, GO CHECK GEN
CALL BLKCHK ;GO SEE IF ACCOUNT BLOCK IS OK
JRST [ HRROI T2,[ASCIZ/Account Block/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFG2 ] ;GO CHECK GENERATION POINTER
CHKFG2: MOVE P1,CURFDB ;GET CURRENT FDB ADDRESS
MOVEI P2,.FBGNL(P1) ;GET ADDRESS OF GEN WORD
GETMPW Q1,P2 ;GET GEN LINK WORD FROM FDB
JUMPE Q1,R ;RETURN IF END-OF-GEN CHAIN
CALL BLKCHK ;SEE IF NEXT FDB IS ON FREE LIST
JRST [ HRROI T2,[ASCIZ/FDB/]
CALL BOFLER ;BLOCK ON FREE LIST ERROR
JRST CHKFG3 ] ;GO CHECK NEXT FDB ON GEN CHAIN
CHKFG3: MOVE P1,CURFDB ;GET CURRENT FDB ADDRESS
MOVEI P2,.FBGNL(P1) ;GET ADDRESS OF GEN WORD
GETMPW P1,P2 ;GET GEN LINK WORD FROM FDB
JRST CHKFG1 ;GO CHECK NEXT FDB ON GEN CHAIN
; BOFLER - ROUTINE TO ISSUE AN ERROR MESSAGE IF A BLOCK IS FOUND
; TO BE ERRONEOUSLY ON THE FREE LIST.
;
; CALL: HRROI T2,[ASCIZ/TYPE OF BLOCK/]
; CALL BOFLER
; RETURN
BOFLER: STKVAR <BLKTYP> ;ALLOCATE TEMPORARY STORAGE
MOVEM T2,BLKTYP ;SAVE THE POINTER TO BLOCK TYPE
O.STR <
? > ;OUTPUT INITIAL PUNCTUATION
MOVE T1,OUTJFN ;GET OUTPUT JFN
MOVE T2,BLKTYP ;GET POINTER TO BLOCK TYPER
SETZM T3 ;TERMINATE ON NULL
SOUT ;OUTPUT THE BLOCK TYPE
O.STR < at > ;OUTPUT PREPOSITION...
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.STR < is on the Free List !
>
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
RET ;RETURN TO WHENCE WE CAME ...
; BLKCHK - ROUTINE TO DETERMINE IF THE BLOCK WHOSE ADDRESS IS
; IN Q1 IS ON THE FREE LIST.
;
; CALL: MOVE Q1,ADDRESS OF BLOCK TO CHECK
; CALL BLKCHK
; BLOCK IS ON FREE LIST
; BLOCK IS NOT ON FREE LIST
BLKCHK: MOVE P1,Q1 ;COPY ADDRESS OF ARGUMENT BLOCK
TRZ P1,777 ;COMPUTE FIRST ADDRESS IN PAGE
MOVEI P1,.DIFFB(P1) ;GET FIRST FREE BLOCK ADR
GETMPW Q2,P1 ;GET ADDRESS OF FIRST FREE BLOCK
JUMPE Q2,RSKP ;RETURN IF THERE ARE NO
; FREE BLOCKS ON THIS PAGE
BLKCH1: GETMPW P1,Q2 ;GET FIRST WORD IN FREE BLOCK
HLRZ P2,P1 ;GET BLOCK TYPE CODE
CAIE P2,.TYFRE ;IS THIS A FREE BLOCK ?
CALL FREERR ;NO, ISSUE ERROR MESSAGE !
CALL FRECHK ;ARG BLOCK IN THFREE BLOCK ?
RET ;YES, RETURN NON-SKIP
MOVEI P1,.FRPTR(Q2) ;GET ADDRESS OF LINK TO NEXT BLK
GETMPW Q2,P1 ;GET ADDRESS OF NEXT FREE BLK
JUMPN Q2,BLKCH1 ;CHECK NEXT BLK IF MORE ON LIST
RETSKP ;RETURN IF END-OF-FREE-LIST
; FRECHK - ROUTINE TO DETERMINE IF THE BLOCK WHOSE ADDRESS IS IN
; Q1 IS IN THE FREE BLOCK WHOSE HEADER WORD IS IN Q2.
;
; CALL: MOVE Q1,ADDRESS OF BLOCK TO CHECK
; MOVE Q2,ADDRESS OF HEADER OF FREE BLOCK
; CALL FRECHK
; ARG BLOCK IS IN FREE BLOCK
; ARG BLOCK IS NOT IN FREE BLOCK
FRECHK: GETMPW P3,Q2 ;GET HEADER OF FREE BLOCK
LOAD P1,BT%LEN,P3 ;GET LENGTH OF FREE BLOCK
ADD P1,Q2 ;COMPUTE FIRST ADR PAST FREE BLK
CAML Q1,Q2 ;ARG BLOCK LOWER THAN FREE BLK ?
CAML Q1,P1 ; OR PAST END OF FREE BLOCK ?
RETSKP ;YES, ARG BLOCK NOT IN FREE BLK
RET ;NO, ARG BLOCK IS IN FREE BLOCK
; FREERR - ROUTINE TO ISSUE ERROR MESSAGE IF FREE LIST IS
; SCREWED UP.
;
; CALL: CALL FREERR
; RETURN
FREERR: STKVAR <TMPTYP> ;ALLOCATE TEMPORARY STORAGE
MOVEM P2,TMPTYP ;SAVE TYPE ENCOUNTERED
O.STR <
? Incorrect Block Type >
MOVE P2,TMPTYP ;GET TYPE BACK
O.OCT P2 ;OUTPUT TYPE
O.STR < in Free Block at >
O.OCT Q2 ;OUTPUT ADDRESS OF BLOCK
O.CRLF
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
RET
; FRETST - ROUTINE TO TEST THE BLOCKS ON THE FREE LIST TO INSURE
; THAT NONE OF THE BLOCKS ABUT.
;
; CALL: CALL FRETST
; RETURN, ERROR MESSAGE ISSUED IF NEEDED
FRETST: STKVAR <BLK1,BLK2> ;ALLOCATE TEMPORARY STORAGE
MOVEI I2,0 ;START WITH PAGE 0 OF DIRECTORY
LOAD I1,DIRFRE ;GET HIGHEST ADR+1 FOR BLOCKS
JUMPE I1,FRETS1 ;IF JUST PAGE 0, WE ARE ALL SET
SUBI I1,1 ;COMPUTE HIGHEST ADR USED
LSH I1,-^D9 ;GET HIGHEST PAGE # TO CHECK
FRETS1: MOVE P1,I2 ;GET CURRENT PAGE #
LSH P1,^D9 ;CONVERT PAGE # TO ADDRESS
MOVEI P1,.DIFFB(P1) ;GET ADR OF FIRST FREE BLOCK PTR
GETMPW P2,P1 ;GET POINTER TO FREE BLOCK
JUMPE P2,FRETS4 ;IF NO FREE LIST, TRY NEXT PAGE
FRETS2: MOVEM P2,BLK1 ;SAVE ADR OF FIRST BLOCK
MOVEI P1,.FRLEN(P2) ;GET ADR OF LENGTH OF BLOCK
GETMPW P3,P1 ;GET FIRST WORD OF FREE BLOCK
LOAD P1,BT%LEN,P3 ;GET JUST THE BLOCK LENGTH
ADD P1,BLK1 ;COMPUTE ADR OF NEXT BLOCK
MOVEI P3,.FRPTR(P2) ;GET ADR OF PTR TO NEXT BLOCK
GETMPW P4,P3 ;GET POINTER TO NEXT BLOCK
MOVEM P4,BLK2 ;SAVE SECOND BLOCK ADR
CAME P1,P4 ;TWO FREE BLOCKS ABUT ?
JRST FRETS3 ;NO, GO ON TO NEXT CHECK
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Two consecutive free blocks found at >
MOVE P2,BLK1 ;GET ADR OF FIRST BLOCK
O.OCT P2 ;OUTPUT ADDRESS OF FIRST BLOCK
O.STR < and at > ;OUTPUT SOME TEXT
MOVE P4,BLK2 ;GET ADR OF SECOND BLOCK
O.OCT P4 ;OUTPUT SECOND FREE BLOCK ADR
O.CRLF ;OUTPUT A CRLF
FRETS3: MOVE P2,BLK2 ;GET ADR OF NEXT BLOCK
JUMPN P2,FRETS2 ;GO CHECK NEXT PAIR OF BLOCKS
FRETS4: ADDI I2,1 ;INCREMENT THE CURRENT PAGE #
CAMG I2,I1 ;CHECKED ALL PAGES YET ?
JRST FRETS1 ;NO, GO CHECK NEXT PAGE
RET ;YES, RETURN
SUBTTL TESTS TO CHECK CONSISTENCY OF FDB'S AND POINTERS
; PTRTST - ROUTINE TO TEST THE CONSISTENCY OF FDB POINTERS AND
; THE BLOCKS POINTED TO BY FDB'S.
;
; CALL: CALL PTRTST
; RETURN
PTRTST: STKVAR <NAMBLK,EXTBLK,NXTEXT> ;ALLOCATE TEMP STORAGE
LOAD I1,DIRBOT ;GET BOTTOM ADR IN SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY IN S.T.
PTRT00: LOAD P1,DIRTOP ;GET TOP ADR IN SYMBOL TABLE
CAMG P1,I1 ;CHECKED ALL ENTRIES YET ?
RET ;YES, RETURN
GETSYM P1,I1 ;NO, GET A S.T. ENTRY
LDB P2,[POINTR P1,.STMSK] ;GET ENTRY TYPE
CAIE P2,.STNAM ;IS THIS AN FDB ENTRY ?
JRST PTRP13 ;NO, GO CHECK NEXT ENTRY IN S.T.
LDB FB,[POINTR P1,.STPTR] ;YES, GET ADDRESS OF FDB
CALL TSTNAM ;GO TEST NAME BLOCK
MOVEM T1,NAMBLK ;SAVE ADDRESS OF NAME BLOCK
PTRT02: CALL TSTEXT ;GO TEST EXTENSION BLOCK
MOVEM T1,EXTBLK ;SAVE ADDRESS OF EXTENSION BLOCK
MOVEI P1,.FBEXL(FB) ;GET ADR OF PTR TO NEXT EXT FDB
GETMPW P2,P1 ;GET ADR OF NEXT EXT FDB
MOVEM P2,NXTEXT ;SAVE ADDRESS OF NEXT EXTENSION FDB
PTRT05: MOVE T1,NAMBLK ;GET ADDRESS OF NAME BLOCK
MOVE T2,EXTBLK ;GET ADDRESS OF EXTENSION BLOCK
CALL TSTFDB ;GO TEST THIS FDB
CALL TSTACT ;GO TEST THE ACCOUNT BLOCK
CALL TSTUNS ;GO TEST THE USER NAME STRING
; ..
; ..
PTRP11: MOVEI P1,.FBEXL(FB) ;GET ADR OF PTR TO NEXT-EXT FDB
GETMPW P2,P1 ;GET ADDRESS OF NEXT-EXT FDB
CAMN P2,NXTEXT ;CORRECT POINTER ?
JRST PTRP12 ;YES, GO ON TO NEXT GENERATION
AOS ERRCNT ;NO, INCREMENT ERROR COUNT
O.STR <
? Incorrect pointer > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT POINTER TO NEXT-EXT FDB
O.STR < to next-extension FDB, in FDB at >
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR <
Correct pointer to next-extension FDB is >
O.OCT NXTEXT ;OUTPUT POINTER TO NEXT-EXT
O.CRLF ;OUTPUT A CRLF
PTRP12: MOVEI P1,.FBGNL(FB) ;GET ADR OF PTR TO NEXT GEN FDB
GETMPW FB,P1 ;GET ADDRESS OF NEXT GEN FDB
JUMPN FB,PTRT05 ;GO CHECK NEXT GEN FDB
MOVE FB,NXTEXT ;GET ADR OF NEXT-EXT FDB
JUMPN FB,PTRT02 ;GO CHECK NEXT EXT CHAIN
PTRP13: ADDI I1,STESIZ ;POINT TO NEXT ENTRY IN S.T.
JRST PTRT00 ;GO CHECK NEXT FDB CHAIN
;TSTNAM - ROUTINE TO CHECK CONSISTENCY OF NAME BLOCK
;
;ACCEPTS IN FB/ ADDRESS OF FDB
; CALL TSTNAM
;RETURNS: +1 ALWAYS, WITH T1/ ADDRESS OF NAME BLOCK
TSTNAM: MOVEI P1,.FBNAM(FB) ;GET ADR OF PTR TO NAME BLOCK
GETMPW P2,P1 ;GET ADDRESS OF NAME BLOCK
GETMPW P3,P2 ;GET FIRST WORD OF NAME BLOCK
HLRZ P4,P3 ;GET THE BLOCK TYPE
CAIN P4,.TYNAM ;IS THIS A NAME BLOCK ?
JRST TNAM10 ;YES, GO CHECK LENGTH OF BLOCK
AOS ERRCNT ;NO, INCREMENT COUNT OF ERRORS
O.STR <
? Name Block pointer > ;OUTPUT FIRST PART OF ERROR MSG
O.OCT P2 ;OUTPUT ADDRESS OF NAME BLOCK
O.STR < in FDB at > ;OUTPUT NEXT PART OF MESSAGE
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR < does not point to a Name Block
>
TNAM10: LOAD P4,BT%LEN,P3 ;GET LENGTH OF NAME BLOCK
CAIL P4,MINNBL ;LESS THAN MINIMUM LENGTH ?
JRST TNAM20 ;NO, GO CHECK EXTENSION BLOCK
AOS ERRCNT ;YES, INCREMENT ERROR COUNT
O.STR <
? Name block at > ;OUTPUT FIRST PART OF ERROR MSG
O.OCT P2 ;OUTPUT ADDRESS OF NAME BLOCK
O.STR < is less than > ;OUTPUT NEXT PART OF MESSAGE
O.DEC [MINNBL] ;OUTPUT MINIMUM LENGTH
O.STR < words long
>
; DONE - RETURN
TNAM20: MOVE T1,P2 ;COPY ADDRESS OF NAME BLOCK
RET ;DONE, RETURN TO CALLER
;TSTEXT - ROUTINE TO CHECK EXTENSION BLOCK
;
;ACCEPTS IN FB/ ADDRESS OF FDB
; CALL TSTEXT
;RETURNS: +1 ALWAYS, WITH T1/ ADDRESS OF EXTENSION BLOCK
TSTEXT: MOVEI P1,.FBEXT(FB) ;GET ADR OF PTR TO EXTENSION BLK
GETMPW P2,P1 ;GET ADR OF EXTENSION BLOCK
MOVEI P1,.FBCTL(FB) ;GET ADR OF CONTROL BITS
GETMPW P4,P1 ;GET CONTROL BITS FOR FDB
TXNE P4,FB%NEX ;IS THERE AN EXTENSION YET ?
AOS NEXCNT ;NO, INCREMENT COUNT OF NEX'S
TXNE P4,FB%NEX ;IS THERE AN EXTENSION YET ?
JRST TEXT10 ;NO, DO NOT TEST EXT POINTER
GETMPW P3,P2 ;GET FIRST WORD OF EXTENSION BLK
HLRZ P4,P3 ;GET THE BLOCK TYPE
CAIN P4,.TYEXT ;IS THIS AN EXTENSION BLOCK ?
JRST TEXT10 ;YES, GO CHECK THE LENGTH
AOS ERRCNT ;NO, INCREMENT ERROR COUNT
O.STR <
? Extension Block pointer > ;OUTPUT FIRST PART OF ERROR MSG
O.OCT P2 ;OUTPUT ADR OF EXTENSION BLOCK
O.STR < in FDB at > ;OUTPUT NEXT PART OF MESSAGE
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR < does not point to an Extension Block
>
TEXT10: LOAD P4,BT%LEN,P3 ;GET LENGTH OF EXTENSION BLOCK
CAIL P4,MINEBL ;LESS THAN MINIMUM LENGTH ?
JRST TEXT20 ;NO, GO CHECK THE FDB ITSELF
AOS ERRCNT ;YES, INCREMENT ERROR COUNT
O.STR <
? Extension Block at > ;OUTPUT FIRST PART OF ERROR MSG
O.OCT P2 ;OUTPUT ADDRESS OF EXT BLOCK
O.STR < is less than > ;OUTPUT NEXT PART OF MESSAGE
O.DEC [MINEBL] ;OUTPUT MINIMUM LENGTH
O.STR < words long
>
TEXT20: MOVE T1,P2 ;GET ADDRESS OF EXTENSION BLOCK
RET ;DONE, RETURN
;TSTFDB - ROUTINE TO CHECK AN FDB
;
;ACCEPTS IN T1/ ADDRESS OF NAME BLOCK FOR THIS FDB
; T2/ ADDRESS OF EXTENSION BLOCK FOR THIS FDB
; CALL TSTFDB
;RETURNS: +1 ALWAYS
TSTFDB: ASUBR <TFDNAM,TFDEXT>
MOVEI P1,.FBHDR(FB) ;GET ADR OF HEADER WORD
GETMPW P2,P1 ;GET HEADER WORD FROM FDB
HLRZ P3,P2 ;GET BLOCK TYPE FROM FDB
CAIN P3,.TYFDB ;IS THIS AN FDB
JRST TFDB10 ;YES, GO CHECK THE LENGTH
AOS ERRCNT ;INCREMENT ERROR COUNT
O.STR <
? Incorrect block type > ;OUTPUT FIRST PART OF ERROR MSG
O.OCT P3 ;OUTPUT THE BLOCK TYPE FOUND
O.STR < in block on FDB chain at >
O.OCT FB ;OUTPUT ADDRESS OF "FDB"
O.CRLF ;OUTPUT A CRLF
TFDB10: LOAD P3,BT%LEN,P2 ;GET THE LENGTH OF THE FDB
LOAD T1,BT%VER,P2 ;GET VERSION # OF FDB
CAMN P3,FDBLEN(T1) ;CORRECT LENGTH FOR FDB OF THIS VERSION ?
JRST TFDB20 ;YES, GO CHECK POINTER TO NAME
SKIPN -1(T1) ;V1 FDB?
JRST [ CAMN P3,OLDV1 ;YES, TWO ACCEPTABLE SIZES
JRST TFDB20 ;MATCHES SHORT V1
JRST .+1] ;STILL WRONG
AOS ERRCNT ;NO, INCREMENT COUNT OF ERRORS
O.STR <
? Incorrect length >
O.DEC P3 ;OUTPUT THE WRONG LENGTH
O.STR < in FDB at > ;OUTPUT NEXT PART OF MESSAGE
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR <
Correct FDB length is assumed to be >
LOAD P1,BT%VER,P2 ;GET VERSION OF FDB AGAIN
MOVE P1,FDBLEN(P1) ;GET CORRECT FDB LENGTH
O.DEC P1 ;OUTPUT CORRECT LENGTH
TFDB20: MOVEI P1,.FBNAM(FB) ;GET ADR OF PTR TO NAME BLOCK
GETMPW P2,P1 ;GET ADDRESS OF NAME BLOCK
CAMN P2,TFDNAM ;CORRECT NAME BLOCK POINTER ?
JRST TFDB30 ;YES, GO CHECK EXTENSION PTR
AOS ERRCNT ;NO, INCREMENT ERROR COUNT
O.STR <
? Incorrect Name Block pointer >
O.OCT P2 ;OUTPUT BAD NAME BLOCK PTR
O.STR < found in FDB at >
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR <
Correct Name block Pointer is >
O.OCT TFDNAM ;OUTPUT CORRECT POINTER
O.CRLF ;OUTPUT A CRLF
TFDB30: MOVEI P1,.FBEXT(FB) ;GET ADR OF PTR TO EXT BLOCK
GETMPW P2,P1 ;GET ADDRESS OF EXT BLOCK
CAMN P2,TFDEXT ;CORRECT EXT BLOCK POINTER ?
JRST TFDB40 ;YES, GO CHECK ACCOUNT BLOCK
AOS ERRCNT ;NO, INCREMENT ERROR COUNT
O.STR <
? Incorrect Extension Block pointer >
O.OCT P2 ;OUTPUT ADDRESS OF EXT BLOCK
O.STR < found in FDB at >
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR <
Correct Extension Block pointer is >
O.OCT TFDEXT ;OUTPUT CORRECT POINTER
O.CRLF ;OUTPUT A CRLF
TFDB40: RET ;DONE
;TSTACT - ROUTINE TO CHECK AN ACCOUNT BLOCK
TSTACT: MOVEI P1,.FBACT(FB) ;GET ADR OF PTR TO ACCOUNT BLK
GETMPW P2,P1 ;GET ADDRESS OF ACCOUNT BLOCK
JUMPLE P2,TACT20 ;IF NOT ALPHANUMERIC, GO ON
GETMPW P3,P2 ;GET FIRST WORD OF ACCOUNT BLK
HLRZ P4,P3 ;GET JUST THE BLOCK TYPE
CAIN P4,.TYACT ;IS THIS AN ACCOUNT BLOCK ?
JRST TACT10 ;YES, GO CHECK THE BLOCK LENGTH
AOS ERRCNT ;NO, INCREMENT COUNT OF ERRORS
O.STR <
? Account Block pointer > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT THE ADR OF THE ACT BLOCK
O.STR < in FDB at > ;OUTPUT NEXT PART OF MESSAGE
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR < does not point to an Account Block
>
TACT10: LOAD P4,BT%LEN,P3 ;GET LENGTH OF ACCOUNT BLOCK
CAIL P4,MINABL ;LESS THAN MINIMUM LENGTH ?
JRST TACT20 ;NO, GO CHECK NEXT-EXT POINTER
AOS ERRCNT ;YES, INCREMENT ERROR COUNT
O.STR <
? Account Block at > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT ADDRESS OF BLOCK
O.STR < is less than > ;OUTPUT NEXT PART OF MESSAGE
O.DEC [MINABL] ;OUTPUT MINIMUM LENGTH
O.STR < words long
>
TACT20: RET ;DONE, RETURN
;TSTUNS - ROUTINE TO CHECK USER NAME BLOCKS
TSTUNS: MOVEI P1,.FBHDR(FB) ;GET ADR OF HEADER WORD
GETMPW P2,P1 ;GET HEADER WORD FROM FDB
LOAD T1,BT%VER,P2 ;GET VERSION # OF FDB
caig t1,0 ;version 0 fdb's have no name strings
ret ;do not check if version 0 fdb
MOVEI P1,.FBAUT(FB) ;GET ADR OF PTR TO USER NAME BLK
GETMPW P2,P1 ;GET ADDRESS OF USER NAME BLOCK
JUMPE P2,TUNS20 ;IF NONE, GO ON
GETMPW P3,P2 ;GET FIRST WORD OF USER NAME BLK
HLRZ P4,P3 ;GET JUST THE BLOCK TYPE
CAIN P4,.TYUNS ;IS THIS AN USER NAME BLOCK ?
JRST TUNS10 ;YES, GO CHECK THE BLOCK LENGTH
AOS ERRCNT ;NO, INCREMENT COUNT OF ERRORS
O.STR <
? Author pointer > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT THE ADR OF THE ACT BLOCK
O.STR < in FDB at > ;OUTPUT NEXT PART OF MESSAGE
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR < does not point to a User Name Block
>
TUNS10: LOAD P4,BT%LEN,P3 ;GET LENGTH OF USER NAME BLOCK
CAIL P4,MINUNS ;LESS THAN MINIMUM LENGTH ?
JRST TUNS20 ;NO, GO ON
AOS ERRCNT ;YES, INCREMENT ERROR COUNT
O.STR <
? User Name Block at > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT ADDRESS OF BLOCK
O.STR < is less than > ;OUTPUT NEXT PART OF MESSAGE
O.DEC [MINUNS] ;OUTPUT MINIMUM LENGTH
O.STR < words long
>
TUNS20: MOVEI P1,.FBLWR(FB) ;GET ADR OF PTR TO USER NAME BLK
GETMPW P2,P1 ;GET ADDRESS OF USER NAME BLOCK
JUMPE P2,TUNS40 ;IF NONE, GO ON
GETMPW P3,P2 ;GET FIRST WORD OF USER NAME BLK
HLRZ P4,P3 ;GET JUST THE BLOCK TYPE
CAIN P4,.TYUNS ;IS THIS AN USER NAME BLOCK ?
JRST TUNS30 ;YES, GO CHECK THE BLOCK LENGTH
AOS ERRCNT ;NO, INCREMENT COUNT OF ERRORS
O.STR <
? Last Writer pointer > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT THE ADR OF THE ACT BLOCK
O.STR < in FDB at > ;OUTPUT NEXT PART OF MESSAGE
O.OCT FB ;OUTPUT ADDRESS OF FDB
O.STR < does not point to a User Name Block
>
;..
;..
; CHECK LENGTH OF USER NAME BLOCK
TUNS30: LOAD P4,BT%LEN,P3 ;GET LENGTH OF USER NAME BLOCK
CAIL P4,MINUNS ;LESS THAN MINIMUM LENGTH ?
JRST TUNS40 ;NO, GO ON
AOS ERRCNT ;YES, INCREMENT ERROR COUNT
O.STR <
? User Name Block at > ;OUTPUT FIRST PART OF MESSAGE
O.OCT P2 ;OUTPUT ADDRESS OF BLOCK
O.STR < is less than > ;OUTPUT NEXT PART OF MESSAGE
O.DEC [MINUNS] ;OUTPUT MINIMUM LENGTH
O.STR < words long
>
TUNS40: RET ;DONE, RETURN
SUBTTL ROUTINES TO INSURE THAT ALL BLOCKS ARE POINTED TO
; TSTBLK - ROUTINE TO CHECK TO SEE IF EVERY FDB AND ACCOUNT
; BLOCK IN THE DIRECTORY IS POINTED TO BY EITHER A
; SYMBOL TABLE ENTRY OR BY A POINTER IN AN FDB.
;
; CALL: CALL TSTBLK
; RETURN
TSTBLK: STKVAR <CURPAG,CURLEN,OLDI1> ;ALLOCATE TEMP STORAGE
SETZM CURPAG ;START AT PAGE 0 OF DIRECTORY
TSTBK1: MOVE P1,CURPAG ;GET CURRENT PAGE #
LSH P1,^D9 ;CONVERT PAGE # TO AN ADDRESS
ADDI P1,.DILHD ;COMPUTE ADR OF HEADER LENGTH
GETMPW P2,P1 ;GET THE HEADER LENGTH WORD
LOAD I1,BT%LEN,P2 ;GET JUST THE HEADER LENGTH
MOVE P2,CURPAG ;GET THE CURRENT PAGE #
LSH P2,^D9 ;COMPUTE FIRST ADR IN PAGE
ADD I1,P2 ;COMPUTE ADR OF FIRST BLOCK
LOAD P1,DIRFRE ;GET HIGHEST ADR USED FOR BLOCKS
CAML I1,P1 ;AT HIGHEST ADR YET ?
RET ;YES, RETURN
TSTBK2: MOVE Q1,I1 ;GET POSSIBLE FDB ADDRESS
MOVEM I1,OLDI1 ;SAVE CURRENT ADDRESS
GETMPW P1,I1 ;GET FIRST WORD OF THIS BLOCK
LOAD T1,BT%LEN,P1 ;GET JUST THE LENGTH
HRRZM T1,CURLEN ;SAVE LENGTH OF CURRENT BLOCK
HLRZ P1,P1 ;GET BLOCK TYPE FIELD
MOVEI P2,TYPSIZ-1 ;GET INDEX INTO TYPTAB
TSTBK3: HLRZ P3,TYPTAB(P2) ;GET A VALID BLOCK TYPE
CAMN P3,P1 ;FOUND A VALID BLOCK TYPE ?
JRST TSTBK4 ;YES, GO CHECK THE BLOCK
SOJGE P2,TSTBK3 ;NO, GO CHECK NEXT VALID TYPE
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Unknown block type > ;ISSUE FIRST PART OF MESSAGE
O.OCT P1 ;OUTPUT BLOCK TYPE
O.STR < found at address >
O.OCT I1 ;OUTPUT ADDRESS
O.STR < in directory
>
DIRQ2B: SAYCR <[Searching for a valid block ...]>
dirQ2c: ADDI I1,1 ;GET NEXT WORD IN DIRECTORY
LOAD P1,DIRFRE ;GET END OF FREE STORAGE
CAMGE I1,P1 ;CHECK REMAINDER OF DIRECTORY ?
JRST DIRQ2d ;nO, GO CHECK THIS WORD
SAYCR <[End of directory - no more blocks found]>
RET ;RETURN TO WHENCE WE CAME ...
DIRQ2D: GETMPW P1,I1 ;GET A WORD
HLRZ P2,P1 ;GET POSSIBLE BLOCK TYPE
MOVEI P3,TYPSIZ-1 ;GET INDEX INTO TYPTAB
DIRQ2E: HLRZ P4,TYPTAB(P3) ;GET A VALID BLOCK TYPE
CAMN P4,P2 ;COULD THIS BE A GOOD BLOCK ?
JRST DIRQ2F ;YES, GO START OUTPUT AGAIN
SOJGE P3,DIRQ2E ;NO, CHECK NEXT TABLE ENTRY
JRST DIRQ2C ;GO CHECK NEXT WORD IN DIRECTORY
; HERE WHEN VALID BLOCK FOUND AFTER UNKNOWN BLOCK TYPE ENCOUNTERED
DIRQ2F: SAY <[Valid block type found at >
MOVE T2,I1 ;GET ADDRESS
PUTOCT ;OUTPUT ADDRESS OF BLOCK
SAYCR <]>
MOVEM I1,OLDI1 ;DON'T LOOK AT THIS BLOCK AGAIN
GETMPW T1,I1 ;GET FIRST WORD OF THIS GOOD BLOCK
LOAD T1,BT%LEN,T1 ;GET JUST THE LENGTH
HRRZM T1,CURLEN ;FUDGE TO LOOK AT NEXT BLOCK
MOVE P2,P3 ;GET INDEX INTO TYPTAB
TSTBK4: HRRZ P1,TYPTAB(P2) ;GET ADDRESS OF CHECKING ROUTINE
CALL (P1) ;CALL THE CHECKING ROUTINE
TSTBK5: MOVE I1,OLDI1 ;RESTORE ORIGINAL I1
ADD I1,CURLEN ;POINT TO THE NEXT BLOCK
LOAD P1,DIRFRE ;GET HIGHEST ADR USED FOR BLOCKS
CAML I1,P1 ;CHECKED ALL BLOCKS YET ?
RET ;YES, RETURN
MOVE P1,CURPAG ;GET CURRENT PAGE #
LSH P1,^D9 ;CONVERT PAGE # TO ADDRESS
CAIGE I1,PAGSIZ(P1) ;AT END OF PAGE YET ?
JRST TSTBK2 ;NO, GO CHECK NEXT BLOCK
CAIG I1,PAGSIZ(P1) ;BLOCK LENGTHS ADD CORRECTLY ?
JRST TSTBK6 ;YES, SEE IF MORE PAGES TO CHECK
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Inconsistency in directory page >
O.OCT CURPAG
O.STR <
Sum of all block lengths + address of Free
Space Pool is greater than 1000 !
>
TSTBK6: AOS CURPAG ;NO, INCREMENT CURRENT PAGE #
JRST TSTBK1 ;GO CHECK NEXT PAGE IN DIRECTORY
; CHKNAM - ROUTINE TO DETERMINE IF A GIVEN NAME BLOCK IS POINTED
; TO BY EITHER A SYMBOL TABLE ENTRY OR THE POINTERS TO
; THE PASSWORD OR USER NAME IN THE HEADER ON PAGE 0.
;
; CALL: MOVE Q1,ADDRESS OF NAME BLOCK
; CALL CHKNAM
; RETURN, ERROR MESSAGE ISSUED IF NO POINTER FOUND
CHKNAM: LOAD I1,DIRBOT ;GET BOTTOM ADR IN SYMBOL TABLE
CHKNM1: LOAD P1,DIRTOP ;GET TOP OF SYMBOL TABLE
CAML I1,P1 ;DONE ALL ENTRIES YET ?
JRST CHKNM3 ;YES, GO CHECK NAME, PASSWORD
GETSYM P1,I1 ;NO, GET SYMBOL TABLE ENTRY
LDB P2,[POINTR(P1,.STMSK)] ;GET TYPE OF ENTRY
CAIE P2,.STNAM ;IS THIS A POINTER TO AN FDB ?
JRST CHKNM2 ;NO, GO LOOK AT NEXT ENTRY
LDB P1,[POINTR(P1,.STPTR)] ;YES, GET ADDRESS OF FDB
MOVEI P2,.FBNAM(P1) ;GET ADR OF POINTER TO NAME
GETMPW P3,P2 ;GET POINTER TO NAME BLOCK
CAMN Q1,P3 ;FOUND DESIRED NAME BLOCK ?
RET ;YES, RETURN FOUND
CHKNM2: ADDI I1,STESIZ ;INCREMENT POINTER TO NEXT ENTRY
JRST CHKNM1 ;GO LOOK AT NEXT TABLE ENTRY
CHKNM3: LOAD P1,DIRNAM ;GET POINTER TO USER NAME
CAMN P1,Q1 ;FOUND DESIRED NAME BLOCK ?
RET ;YES, RETURN TO WHENCE WE CAME
LOAD P1,DIRPSW ;NO, GET POINTER TO PASSWORD
CAMN P1,Q1 ;FOUND DESIRED NAME BLOCK ?
RET ;YES, RETURN FOUND
LOAD P1,DIRACT ;GET POINTER TO DEFAULT ACCOUNT
CAMN P1,Q1 ;FOUND DESIRED NAME BLOCK ?
RET ;YES, RETURN FOUND
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? No pointer in directory to Name Block at >
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.STR <:
> ;OUTPUT PUNCTUATION
GETMPW T2,Q1 ;GET FIRST WORD OF BLOCK
MOVE T3,[1B0+10] ;PRINT MAGNITUDE, USE OCTAL
CALL PUTHLF ;OUTPUT TWO HALFWORDS
O.STR <
> ;OUTPUT MORE PUNCTUATION
MOVE T1,OUTJFN ;GET OUTPUT JFN
HRROI T2,1(Q1) ;GET POINTER TO STRING
ADD T2,FDBOFS ;POINT TO ADR IN CORE, NOT FILE
SETZM T3 ;TERMINATE ON A NULL
SOUT ;OUTPUT THE STRING
O.CRLF ;NEW LINE
RET ;RETURN
; CHECKX - ROUTINE TO DETERMINE IF A GIVEN EXTENSION BLOCK IS
; POINTED TO BY ANY FDB.
;
; CALL: MOVE Q1,ADR OF EXTENSION BLOCK
; CALL CHECKX
; RETURN, ERROR MESSAGE ISSUED IF BLOCK NOT FOUND
CHECKX: LOAD I1,DIRBOT ;GET BOTTOM ADR IN SYMBOL TABLE
CHEKX1: LOAD P1,DIRTOP ;GET TOP OF SYMBOL TABLE
CAML I1,P1 ;DONE ALL ENTRIES YET ?
JRST CHEKX3 ;YES, GO ISSUE ERROR MESSAGE
GETSYM P1,I1 ;NO, GET SYMBOL TABLE ENTRY
LDB P2,[POINTR(P1,.STMSK)] ;GET TYPE OF ENTRY
CAIE P2,.STNAM ;IS THIS A POINTER TO AN FDB ?
JRST CHEKX2 ;NO, GO LOOK AT NEXT ENTRY
LDB FB,[POINTR(P1,.STPTR)] ;YES, GET ADDRESS OF FDB
CALL CKEXT ;SEE IF EXT BLK IS ON THIS CHAIN
RET ;FOUND, RETURN
CHEKX2: ADDI I1,STESIZ ;INCREMENT POINTER TO NEXT ENTRY
JRST CHEKX1 ;GO LOOK AT NEXT TABLE ENTRY
CHEKX3: O.STR <
? No pointer in directory to Extension Block at >
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.STR <:
> ;OUTPUT PUNCTUATION
GETMPW T2,Q1 ;GET FIRST WORD OF BLOCK
MOVE T3,[1B0+10] ;PRINT MAGNITUDE, USE OCTAL
CALL PUTHLF ;GO OUTPUT TWO HALFWORDS
O.STR <
> ;OUTPUT MORE PUNCTUATION
MOVE T1,OUTJFN ;GET OUTPUT JFN
HRROI T2,1(Q1) ;GET POINTER TO STRING
ADD T2,FDBOFS ;POINT TO ADR IN CORE, NOT FILE
SETZM T3 ;TERMINATE ON A NULL
SOUT ;OUTPUT THE STRING
O.CRLF ;NEW LINE
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
RET ;RETURN
; CKEXT - ROUTINE TO DETERMINE IF A GIVEN EXTENSION BLOCK IS
; ON A GIVEN EXTENSION CHAIN OF FDB'S.
;
; CALL: MOVE Q1,ADDRESS OF EXTENSION BLOCK
; MOVE FB,ADDRESS OF FDB AT HEAD OF CHAIN
; CALL CKEXT
; RETURN HERE IF EXT BLOCK FOUND
; RETURN HERE IF EXT BLOCK NOT POINTED TO
CKEXT: MOVEI P1,.FBEXT(FB) ;GET ADDRESS OF PTR TO EXT BLOCK
GETMPW P2,P1 ;GET ADR OF EXTENSION BLOCK
CAMN P2,Q1 ;FOUND DESIRED EXTENSION BLOCK ?
RET ;YES, RETURN
MOVEI P1,.FBEXL(FB) ;NO, GET ADR OF PTR TO NEXT FDB
GETMPW FB,P1 ;GET ADDRESS OF NEXT FDB
JUMPN FB,CKEXT ;GO CHECK NEXT FDB
RETSKP ;END-OF-CHAIN, RETURN NOT-FOUND
; CHKFDB - ROUTINE TO DETERMINE IF A GIVEN FDB IS POINTED TO BY
; EITHER A SYMBOL TABLE ENTRY OR BY ANOTHER FDB.
;
; CALL: MOVE Q1,FDB TO LOOK FOR
; CALL CHKFDB
; RETURN, ERROR MESSAGE ISSUED IF FDB
; WAS NOT FOUND ...
CHKFDB: LOAD I1,DIRBOT ;GET ADDRESS OF START OF TABLE
ADDI I1,STHSIZ ;COMPUTE ADDRESS OF FIRST ENTRY
CHKFD1: GETSYM P1,I1 ;GET ENTRY TYPE AND ADDRESS
LDB P2,[POINTR(P1,.STMSK)] ;GET ENTRY TYPE ONLY
CAIE P2,.STNAM ;IS THIS A POINTER TO AN FDB ?
JRST CHKFD2 ;NO, GO CHECK NEXT BLOCK
LDB FB,[POINTR(P1,.STPTR)] ;YES, GET ADDRESS OF FDB
CALL CHKEXT ;SEE IF DESIRED FDB IS ON THIS CHAIN
JRST CHKFD2 ;NO, GO CHECK NEXT CHAIN
RET ;TARGET FDB FOUND, RETURN
CHKFD2: ADDI I1,STESIZ ;COMPUTE ADDRESS OF NEXT ENTRY
LOAD P1,DIRTOP ;GET HIGHEST SYMBOL TABLE ADR
CAMGE I1,P1 ;CHECK ALL ENTRIES YET ?
JRST CHKFD1 ;NO, GO BACK AND CHECK NEXT ENTRY
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? No pointer in directory to FDB at >
O.OCT Q1 ;OUTPUT ADDRESS OF TARGET
O.CRLF ;OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; CHKEXT - ROUTINE TO DETERMINE IF A GIVEN FDB IS ON A GIVEN
; EXTENSION CHAIN.
;
; CALL: MOVE FB,ADDRESS OF BASE FDB
; MOVE Q1,FDB ADDRESS TO LOOK FOR
; CALL CHKEXT
; RETURN HERE IF NOT FOUND
; RETURN HERE IF FDB FOUND ON CHAIN
CHKEXT: STKVAR <NXTEXT,TARGET,OLDFB> ;ALLOCATE TEMP STORAGE
MOVEM FB,OLDFB ;SAVE ORIGINAL BASE FDB
MOVEI P1,.FBEXL(FB) ;GET ADDRESS OF EXT WORD IN FDB
CHKEX1: GETMPW P2,P1 ;GET EXTENSION WORD FROM FDB
MOVEM P2,NXTEXT ;SAVE THE LINK TO NEXT FDB
MOVEM Q1,TARGET ;SAVE TARGET FDB ADDRESS
CALL CHKGEN ;SEE IF TARGET IS ON GEN CHAIN
JRST CHKEX2 ;NO, GO LOOK AT NEXT EXTENSION
MOVE FB,OLDFB ;RESTORE ORIGINAL BASE FDB ADR
RETSKP ;YES, GIVE SKIP RETURN
CHKEX2: MOVE Q1,TARGET ;RESTORE TARGET FDB ADDRESS
MOVE FB,NXTEXT ;GET ADDRESS OF NEXT EXT FDB
MOVEI P1,.FBEXL(FB) ;GET ADDRESS OF NEXT EXT WORD
JUMPN FB,CHKEX1 ;GO CHECK NEXT FDB ON CHAIN
MOVE FB,OLDFB ;RESTORE ORIGINAL BASE FDB ADR
RET ;RETURN NOT-FOUND
; CHKGEN - ROUTINE TO DETERMINE IF A GIVEN FDB IS ON A GIVEN
; GENERATION CHAIN.
;
; CALL: MOVE Q1,FDB ADDRESS TO LOOK FOR
; MOVE FB,ADDRESS OF FIRST FDB ON CHAIN
; CALL CHKGEN
; RETURN NON-SKIP IF FDB NOT ON CHAIN
; RETURN SKIP IF FDB FOUND ON THIS CHAIN
CHKGEN: CAMN FB,Q1 ;DESIRED FDB AT HEAD OF CHAIN ?
RETSKP ;YES, GIVE FOUND RETURN
MOVEI P1,.FBGNL(FB) ;NO, SET UP FIRST FDB ADDRESS
CHKGN1: GETMPW P2,P1 ;GET GENERATION FIELD OF FDB
JUMPE P2,R ;RETURN IF END-OF-CHAIN
CAMN P2,Q1 ;FOUND CORRECT FDB YET ?
RETSKP ;YES, GIVE FOUND RETURN
MOVEI P1,.FBGNL(P2) ;GET ADDRESS OF NEXT GEN WORD
JRST CHKGN1 ;GO BACK AND CHECK NEXT FDB
; CHKACT - ROUTINE TO DETERMINE IF A GIVEN ACCOUNT BLOCK IS
; POINTED TO BY EITHER A SYMBOL TABLE ENTRY OR AN FDB.
;
; CALL: MOVE Q1,ACCOUNT BLOCK ADDRESS TO LOOK FOR
; CALL CHKACT
; RETURN, ERROR MESSAGE ISSUED IF ACCOUNT BLOCK
; WAS NOT FOUND ...
CHKACT: STKVAR <CUREXT,COUNT> ;ALLOCATE TEMPORARY STORAGE
SETZM COUNT ;INITIALIZE COMPUTED COUNT
CALL FNDACT ;DOES SYMBOL TABLE ENTRY EXIST ?
JRST CHKA00 ;ENTRY EXISTS, GO CHECK POINTERS
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? No Symbol Table entry exists for Account Block At >
O.OCT Q1
O.CRLF ;OUTPUT A CRLF
CALL PUTACT ;GO OUTPUT THE ACCOUNT BLOCK
O.CRLF ;OUTPUT A CRLF
CHKA00: MOVEI P1,.ABCNT(Q1) ;GET ADDRESS OF SHARE COUNT
GETMPW P2,P1 ;GET SHARE COUNT FROM BLOCK
JUMPN P2,CHKAC0 ;COUNT SHOULD BE NON-ZERO
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Account Block at >
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.STR < has a share count of 0 !
>
CALL PUTACT ;GO OUTPUT THE ACCOUNT BLOCK
CHKAC0: LOAD I1,DIRBOT ;GET ADDRESS OF START OF TABLE
ADDI I1,STHSIZ ;COMPUTE ADDRESS OF FIRST ENTRY
CHKAC1: LOAD P1,DIRTOP ;GET TOP ADR OF SYMBOL TABLE
CAMG P1,I1 ;CHECKED ALL ENTRIES YET ?
JRST CHKAC5 ;YES, GO VERIFY SHARE COUNT
GETSYM P1,I1 ;GET ENTRY TYPE AND ADDRESS
LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
CAIE P2,.STNAM ;IS THIS AN FDB ENTRY ?
JRST CHKAC4 ;NO, GO CHECK NEXT ENTRY
LDB P1,[POINTR P1,.STPTR] ;GET POINTER TO FDB
CHKAC2: MOVEM P1,CUREXT ;SAVE ADR OF HEAD OF EXT CHAIN
CHKAC3: MOVEI P2,.FBACT(P1) ;GET ADDRESS OF ACCOUNT POINTER
GETMPW P3,P2 ;GET POINTER TO ACCOUNT BLOCK
CAMN P3,Q1 ;IS THIS DESIRED POINTER ?
AOS COUNT ;YES, INCREMENT THE COUNT
MOVEI P2,.FBGNL(P1) ;GET ADR OF NEXT GEN POINTER
GETMPW P1,P2 ;GET POINTER TO NEXT GEN FDB
JUMPN P1,CHKAC3 ;GO CHECK NEXT FDB ON GEN CHAIN
MOVE P1,CUREXT ;GET ADR OF CURRENT CHAIN HEAD
MOVEI P2,.FBEXL(P1) ;GET ADR OF POINTER TO NEXT EXT
GETMPW P1,P2 ;GET POINTER TO NEXT EXT FDB
JUMPN P1,CHKAC2 ;GO COUNT POINTERS ON NEXT CHAIN
CHKAC4: ADDI I1,STESIZ ;COMPUTE ADDRESS OF NEXT ENTRY
JRST CHKAC1 ;NO, GO BACK, CHECK NEXT ENTRY
CHKAC5: MOVEI P1,.ABCNT(Q1) ;GET ADDRESS OF SHARE COUNT
GETMPW P2,P1 ;GET SHARE COUNT IN BLOCK
CAMN P2,COUNT ;IS COUNT IN BLOCK CORRECT ?
RET ;YES, CHECK WITH COUNT IN BLOCK
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Incorrect share count in Account Block At >
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.CRLF ;OUTPUT A CRLF
CALL PUTACT ;OUTPUT THE ACCOUNT BLOCK
O.STR <
Computed share count is >
O.OCT COUNT ;OUTPUT THE COUNT
O.STR <
Share count in block is >
MOVEI P1,.ABCNT(Q1) ;GET ADR OF SHARE COUNT
GETMPW P2,P1 ;GET SHARE COUNT IN BLOCK
O.OCT P2 ;OUTPUT SHARE COUNT
O.CRLF ;OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; CHKUNS - ROUTINE TO DETERMINE IF A GIVEN USER NAME BLOCK IS
; POINTED TO BY EITHER A SYMBOL TABLE ENTRY OR AN FDB.
;
; CALL: MOVE Q1,USER NAME BLOCK ADDRESS TO LOOK FOR
; CALL CHKUNS
; RETURN, ERROR MESSAGE ISSUED IF USER NAME BLOCK
; WAS NOT FOUND ...
CHKUNS: STKVAR <UNSEXT,UNSCNT> ;ALLOCATE TEMPORARY STORAGE
SETZM UNSCNT ;INITIALIZE COMPUTED COUNT
CALL FNDUNS ;DOES SYMBOL TABLE ENTRY EXIST ?
JRST CHKU00 ;ENTRY EXISTS, GO CHECK POINTERS
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? No Symbol Table entry exists for User Name Block at >
O.OCT Q1
O.CRLF ;OUTPUT A CRLF
CALL PUTUNS ;GO OUTPUT THE USER NAME BLOCK
O.CRLF ;OUTPUT A CRLF
CHKU00: MOVEI P1,.UNCNT(Q1) ;GET ADDRESS OF SHARE COUNT
GETMPW P2,P1 ;GET SHARE COUNT FROM BLOCK
JUMPN P2,CHKUN0 ;COUNT SHOULD BE NON-ZERO
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? User Name Block at >
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.STR < has a share count of 0 !
>
CALL PUTUNS ;GO OUTPUT THE USER NAME BLOCK
CHKUN0: LOAD I1,DIRBOT ;GET ADDRESS OF START OF TABLE
ADDI I1,STHSIZ ;COMPUTE ADDRESS OF FIRST ENTRY
CHKUN1: LOAD P1,DIRTOP ;GET TOP ADR OF SYMBOL TABLE
CAMG P1,I1 ;CHECKED ALL ENTRIES YET ?
JRST CHKUN5 ;YES, GO VERIFY SHARE COUNT
GETSYM P1,I1 ;GET ENTRY TYPE AND ADDRESS
LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
CAIE P2,.STNAM ;IS THIS AN FDB ENTRY ?
JRST CHKUN4 ;NO, GO CHECK NEXT ENTRY
LDB P1,[POINTR P1,.STPTR] ;GET POINTER TO FDB
CHKUN2: MOVEM P1,UNSEXT ;SAVE ADR OF HEAD OF EXT CHAIN
CHKUN3: MOVEI P2,.FBAUT(P1) ;GET ADDRESS OF AUTHOR POINTER
GETMPW P3,P2 ;GET POINTER TO USER NAME BLOCK
CAMN P3,Q1 ;IS THIS DESIRED POINTER ?
AOS UNSCNT ;YES, INCREMENT THE COUNT
MOVEI P2,.FBLWR(P1) ;GET ADDRESS OF LAST WRITER POINTER
GETMPW P3,P2 ;GET POINTER TO USER NAME STRING BLOCK
CAMN P3,Q1 ;IS THIS THE DESIRED POINTER ?
AOS UNSCNT ;YES, INCREMENT COUNT OF POINTERS FOUND
MOVEI P2,.FBGNL(P1) ;GET ADR OF NEXT GEN POINTER
GETMPW P1,P2 ;GET POINTER TO NEXT GEN FDB
JUMPN P1,CHKUN3 ;GO CHECK NEXT FDB ON GEN CHAIN
MOVE P1,UNSEXT ;GET ADR OF CURRENT CHAIN HEAD
MOVEI P2,.FBEXL(P1) ;GET ADR OF POINTER TO NEXT EXT
GETMPW P1,P2 ;GET POINTER TO NEXT EXT FDB
JUMPN P1,CHKUN2 ;GO COUNT POINTERS ON NEXT CHAIN
CHKUN4: ADDI I1,STESIZ ;COMPUTE ADDRESS OF NEXT ENTRY
JRST CHKUN1 ;NO, GO BACK, CHECK NEXT ENTRY
CHKUN5: MOVEI P1,.UNCNT(Q1) ;GET ADDRESS OF SHARE COUNT
GETMPW P2,P1 ;GET SHARE COUNT IN BLOCK
CAMN P2,UNSCNT ;IS COUNT IN BLOCK CORRECT ?
RET ;YES, CHECK WITH COUNT IN BLOCK
AOS ERRCNT ;INCREMENT # OF ERRORS DETECTED
O.STR <
? Incorrect share count in User Name Block at >
O.OCT Q1 ;OUTPUT ADDRESS OF BLOCK
O.CRLF ;OUTPUT A CRLF
CALL PUTUNS ;OUTPUT THE USER NAME BLOCK
O.STR <
Computed share count is >
O.OCT COUNT ;OUTPUT THE COUNT
O.STR <
Share count in block is >
MOVEI P1,.UNCNT(Q1) ;GET ADR OF SHARE COUNT
GETMPW P2,P1 ;GET SHARE COUNT IN BLOCK
O.OCT P2 ;OUTPUT SHARE COUNT
O.CRLF ;OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; PUTACT - ROUTINE TO OUTPUT AN ACOUNT BLOCK
;
; CALL: MOVE Q1, ADR OF ACCOUNT BLOCK
; CALL PUTACT
; RETURN
PUTACT: O.STR < > ;OUTPUT A TAB
MOVEI P1,.ABTYP(Q1) ;GET ADDRESS OF FIRST WORD
GETMPW T2,P1 ;GET FIRST WORD OF BLOCK
MOVE T3,[1B0+10] ;PRINT MAGNITUDE, USE OCTAL
CALL PUTHLF ;GO OUTPUT TWO HALFWORDS
O.STR <
> ;OUTPUT MORE PUNCTUATION
MOVEI P1,.ABCNT(Q1) ;GET ADDRESS OF SHARE COUNT
GETMPW T2,P1 ;GET SHARE COUNT
O.OCT T2 ;OUTPUT SHARE COUNT
O.STR <
> ;YET MORE PUNCTUATION
MOVE T1,OUTJFN ;GET OUTPUT JFN
HRROI T2,2(Q1) ;GET FILE ADDRESS OF STRING
ADD T2,FDBOFS ;POINT TO MEMORY ADDRESS
SETZM T3 ;TERMINATE ON NULL
SOUT ;OUTPUT ACCOUNT STRING
O.CRLF ;OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; PUTUNS - ROUTINE TO OUTPUT A USER NAME BLOCK
;
; CALL: MOVE Q1, ADR OF USER NAME BLOCK
; CALL PUTUNS
; RETURN
PUTUNS: O.STR < > ;OUTPUT A TAB
MOVEI P1,.UNTYP(Q1) ;GET ADDRESS OF FIRST WORD
GETMPW T2,P1 ;GET FIRST WORD OF BLOCK
MOVE T3,[1B0+10] ;PRINT MAGNITUDE, USE OCTAL
CALL PUTHLF ;GO OUTPUT TWO HALFWORDS
O.STR <
> ;OUTPUT MORE PUNCTUATION
MOVEI P1,.UNCNT(Q1) ;GET ADDRESS OF SHARE COUNT
GETMPW T2,P1 ;GET SHARE COUNT
O.OCT T2 ;OUTPUT SHARE COUNT
O.STR <
> ;YET MORE PUNCTUATION
MOVE T1,OUTJFN ;GET OUTPUT JFN
HRROI T2,2(Q1) ;GET FILE ADDRESS OF STRING
ADD T2,FDBOFS ;POINT TO MEMORY ADDRESS
SETZM T3 ;TERMINATE ON NULL
SOUT ;OUTPUT USER NAME STRING
O.CRLF ;OUTPUT A CRLF
RET ;RETURN TO WHENCE WE CAME ...
; CKACTE - ROUTINE TO DETERMINE IF A GIVEN ACCOUNT BLOCK IS
; POINTED TO BE ANY FDB ON A GIVEN EXTENSION CHAIN.
;
; CALL: MOVE Q1,ADDRESS OF ACCOUNT BLOCK
; MOVE FB,ADDRESS OF FDB AT HEAD OF CHAIN
; CALL CKACTE
; RETURN NON-SKIP IF ACCOUNT BLOCK NOT FOUND
; RETURN SKIP IF ACCOUNT BLOCK IS ON CHAIN
CKACTE: STKVAR <SAVEFB> ;ALLOCATE TEMPORARY STORAGE
MOVEM FB,SAVEFB ;SAVE INITIAL VALUE OF FB
CKACE1: CALL CKACTG ;SEE IF BLOCK IS ON GEN CHAIN
JRST CKACE2 ;NOT ON THIS GEN CHAIN, GO ON
JRST CKACE3 ;BLOCK FOUND, GO RETURN
CKACE2: MOVEI P1,.FBEXL(FB) ;GET ADDRESS OF EXTENSION WORD
GETMPW FB,P1 ;GET EXTENSION WORD FROM FDB
JUMPN FB,CKACE1 ;GO CHECK NEXT GEN CHAIN
MOVE FB,SAVEFB ;BLOCK NOT FOUND, RESTORE FB
RET ;RETURN TO WHENCE WE CAME ...
CKACE3: MOVE FB,SAVEFB ;RESTORE ORIGINAL VALUE OF FB
RETSKP ;RETURN TO WHENCE WE CAME +1 ...
; CKACTG - ROUTINE TO DETERMINE IF A GIVEN ACCOUNT BLOCK
; IS POINTED TO BY ANY FDB ON A GIVEN GENERATION
; CHAIN.
;
; CALL: MOVE Q1,ACCOUNT BLOCK ADDRESS
; MOVE FB,ADDRESS OF HEAD OF GEN CHAIN
; CALL CKACTG
; RETURN NON-SKIP IF ACCOUNT BLOCK NOT FOUND
; RETURN SKIP IF ACCOUNT BLOCK FOUND ON CHAIN
CKACTG: MOVE P1,FB ;COPY ADDRESS OF HEAD OF CHAIN
CKACG1: MOVEI P2,.FBACT(P1) ;GET ADDRESS OF ACCOUNT WORD
GETMPW P3,P2 ;GET ACCOUNT WORD FROM FDB
JUMPL P3,CKACG2 ;IF NUMERIC ACCOUNT, GO ON
CAMN Q1,P3 ;GOT CORRECT POINTER ?
RETSKP ;YES, RETURN FOUND
CKACG2: MOVEI P2,.FBGNL(P1) ;GET ADDRESS OF GENERATION WORD
GETMPW P1,P2 ;GET GEN LINK WORD FROM FDB
JUMPN P1,CKACG1 ;GO CHECK NEXT FDB ON CHAIN
RET ;END-OF-CHAIN, RETURN NOT FOUND
; FNDACT - ROUTINE TO LOOK THROUGH THE SYMBOL TABLE FOR AN
; ENTRY FOR A GIVEN ACCOUNT.
;
; CALL: MOVE Q1,POINTER TO ACCOUNT BLOCK
; CALL FNDACT
; RETURN NON-SKIP IF ACCOUNT ENTRY FOUND
; RETURN SKIP IF NO ENTRY IN SYMBOL TABLE
FNDACT: LOAD I1,DIRBOT ;GET BOTTOM ADR OF SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY
FNDAC1: LOAD P1,DIRTOP ;GET TOP ADDRESS IN SYMBOL TABLE
CAMG P1,I1 ;AT END-OF-TABLE YET ?
RETSKP ;YES, RETURN SKIP
GETSYM P1,I1 ;GET A SYMBOL TABLE ENTRY
LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
CAIE P2,.STACT ;IS THIS AN ACCOUNT ENTRY ?
JRST FNDAC2 ;NO, GO CHECK NEXT ENTRY
HRRZ P2,P1 ;YES, GET POINTER TO BLOCK
CAMN P2,Q1 ;IS THIS THE DESIRED ENTRY ?
RET ;YES, RETURN FOUND
FNDAC2: ADDI I1,STESIZ ;POINT TO NEXT ENTRY
JRST FNDAC1 ;GO CHECK NEXT ENTRY IN TABLE
; FNDUNS - ROUTINE TO LOOK THROUGH THE SYMBOL TABLE FOR AN
; ENTRY FOR A GIVEN USER NAME BLOCK.
;
; CALL: MOVE Q1,POINTER TO USER NAME BLOCK
; CALL FNDUNS
; RETURN NON-SKIP IF ENTRY FOUND
; RETURN SKIP IF NO ENTRY IN SYMBOL TABLE
FNDUNS: LOAD I1,DIRBOT ;GET BOTTOM ADR OF SYMBOL TABLE
ADDI I1,STHSIZ ;POINT TO FIRST ENTRY
FNDUN1: LOAD P1,DIRTOP ;GET TOP ADDRESS IN SYMBOL TABLE
CAMG P1,I1 ;AT END-OF-TABLE YET ?
RETSKP ;YES, RETURN SKIP
GETSYM P1,I1 ;GET A SYMBOL TABLE ENTRY
LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
CAIE P2,.STUNS ;IS THIS AN USER NAME ENTRY ?
JRST FNDUN2 ;NO, GO CHECK NEXT ENTRY
HRRZ P2,P1 ;YES, GET POINTER TO BLOCK
CAMN P2,Q1 ;IS THIS THE DESIRED ENTRY ?
RET ;YES, RETURN FOUND
FNDUN2: ADDI I1,STESIZ ;POINT TO NEXT ENTRY
JRST FNDUN1 ;GO CHECK NEXT ENTRY IN TABLE
SUBTTL LIST AND OUTPUT COMMANDS
.LIST: STKVAR <LPTJFN>
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMNOI,,<TXT(OUTPUT ON PRINTER)>)]
COMND ;PARSE NOISE FIELD
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRMATION FUNCTION
COMND ;PARSE END OF COMMAND
TXNE T1,CM%NOP ;END OF COMMAND PARSED OK ?
CALLRET COMER2 ;NO, GO ISSUE ERROR MESSAGE
; HERE TO GET A JFN FOR THE PRINTER
MOVX T1,GJ%FOU!GJ%SHT ;GET FLAGS
HRROI T2,[ASCIZ/LPT:DIRTST.TXT/] ;GET NAME OF OUTPUT FILE
GTJFN ;GET A JFN FOR THE PRINTER
JRST [ JSERR ;UNEXPECTED ERROR
RET ] ;RETURN
HRRZM T1,LPTJFN ;SAVE OUTPUT JFN
SKIPE T1,OUTJFN ;GET PREVIOUS JFN
CLOSF ;CLOSE LAST OUTPUT JFN
JFCL ;IGNORE ERRORS
SKIPE T1,OUTJFN ;GET OUTPUT JFN AGAIN
RLJFN ;RELEASE JFN
JFCL ;IGNORE ERRORS
MOVE T1,LPTJFN ;RESTORE NEW LPT JFN
MOVEM T1,OUTJFN ;SAVE NEW OUTPUT JFN
RET ;RETURN TO PARSER
; OUTPUT COMMAND
.OUTPT: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMNOI,,<TXT(OUTPUT TO FILE)>)]
COMND ;PARSE NOISE
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMOFI,,,,<DIRTST.TXT>)]
COMND ;PARSE FILE SPEC
TXNN T1,CM%NOP ;PARSED OK ?
JRST OUTPT5 ;YES, GO ON
CALL TSTCOL ;NO, ISSUE NEW LINE IF NEEDED
TMSG <? DIRTST: Invalid filespec, >
MOVX T1,.PRIOU ;GET PRIMARY OUTPUT JFN
HRLOI T2,.FHSLF ;THIS FORK, LAST ERROR
SETZM T3 ;
ERSTR ;OUTPUT ERROR FROM JSYS
JFCL ;IGNORE ERRORS HERE
JFCL ;IGNORE ERRORS HERE
TMSG <
> ;OUTPUT CRLF
RET ;RETURN TO WHENCE WE CAME ...
; HERE ON A GOOD FILESPEC
OUTPT5: STKVAR <OTPJFN> ;ALLOCATE SPACE FOR OUTPUT JFN
MOVEM T2,OTPJFN ;SAVE JFN
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRM FUNCTION
COMND ;PARSE END OF COMMAND
TXNE T1,CM%NOP ;PARSED OK ?
CALLRET COMER2 ;NO, GO ISSUE MESSAGE
SKIPE T1,OUTJFN ;GET PREVIOUS JFN
CLOSF ;CLOSE LAST OUTPUT JFN
JFCL ;IGNORE ERRORS
SKIPE T1,OUTJFN ;GET OUTPUT JFN AGAIN
RLJFN ;RELEASE JFN
JFCL ;IGNORE ERRORS
MOVE T1,OTPJFN ;GET NEW OUTPUT JFN AGAIN
MOVEM T1,OUTJFN ;SAVE GOOD OUTPUT JFN
RET ;RETURN TO PARSER
; TYPE COMMAND
.TYPE: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMNOI,,<TXT(OUTPUT ON TERMINAL)>)]
COMND ;PARSE NOISE
MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRMATION FUNCTION
COMND ;PARSE END OF COMMAND
TXNE T1,CM%NOP ;PARSED OK ?
CALLRET COMER2 ;NO, ISSUE MESSAGE
SKIPE T1,OUTJFN ;GET PREVIOUS JFN
CLOSF ;CLOSE LAST OUTPUT JFN
JFCL ;IGNORE ERRORS
SKIPE T1,OUTJFN ;GET OUTPUT JFN AGAIN
RLJFN ;RELEASE JFN
JFCL ;IGNORE ERRORS
MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT JFN
MOVEM T1,OUTJFN ;SAVE NEW OUTPUT JFN
RET ;RETURN TO PARSER
SUBTTL HELP AND EXIT COMMANDS
; HELP COMMAND
.HELP: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIRMATION
COMND ;WAIT FOR CONFIRMATION
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
CALLRET COMER2 ;NO, ISSUE ERROR MESSAGE AND RETURN
HRROI T1,HLPMSG ;GET POINTER TO HELP MESSAGE
PSOUT ;OUTPUT HELP MESSAGE
RET ;GO PARSE NEXT COMMAND
; EXIT COMMAND
.EXIT: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMNOI,,<TXT(TO MONITOR)>)]
COMND ;PARSE NOISE PHRASE
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND ;PARSE CONFIRMATION
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
CALLRET COMER2 ;NO, ISSUE ERROR MESSAGE AND RETURN
SETOM T1 ;INDICATE ALL FILES SHOULD BE CLOSED
CLOSF ;CLOSE ALL OPEN FILES
JSERR ;UNEXPECTED ERROR
HALTF ;RETURN TO MONITOR
JRST START ;IF CONTINUE'D, START OVER
SUBTTL VERIFY (FILES) FILE-SPEC
.VERFY: STKVAR <VFYJFN>
HRROI T2,[ASCIZ /FILES/] ;GET GUIDE WORD
CALL SKPNOI ;PARSE GUIDE WORD
RET ;FAILED
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
MOVX T1,GJ%OLD!GJ%SHT!GJ%IFG ;GET FLAGS
MOVEM T1,GJFBLK+.GJGEN ;SAVE FLAGS
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFIL)] ;FILESPEC FUNCTION
COMND ;PARSE A FILESPEC
ERJMP R ;FAILED, RETURN
TXNN T1,CM%NOP ;PARSED FILESPEC OK ?
JRST VRFY10 ;YES, GO SAVE JFN
HRROI T1,[ASCIZ/Invalid filespec/]
CALL TYPATM ;OUTPUT THE TEXT ENTERED
TMSG < > ;INDENT NEXT LINE
CALLRET PUTERR ;AND ALSO TYPE JSYS ERROR MESSAGE
; HERE WITH A VALID FILESPEC
VRFY10: MOVEM T2,VFYJFN ;SAVE JFN OF FILES TO VERIFY
CALL ENDCOM ;PARSE END OF COMMAND
RET ;FAILED, RETURN
MOVEI T1,.FHSLF ;GET OUR FORK HANDLE
RPCAP ;READ OUR ENABLED CAPABILITIES
TXNN T3,SC%WHL!SC%OPR ;WHEEL OR OPERATOR ENABLED ?
JRST [ CALL TSTCOL ;NO, NEW LINE IF NEEDED
TMSG <? DIRTST: WHEEL or OPERATOR capability required
> ;OUTPUT MESSAGE
HALTF ;QUIT
JRST START ] ;AND START AGAIN IF CONTINUE'D
VRFY20: MOVE T1,VFYJFN ;RESTORE JFN
CALL TYPFIL ;OUTPUT FILENAME IF CHANGED
MOVE T1,VFYJFN ;GET JFN AGAIN
CALL SETFIL ;GO SET UP TO VERIFY THIS FILE
RET ;FAILED, RETURN
CALL VFYFIL ;GO CHECK THIS FILE
MOVE T1,VFYJFN ;GET JFN AGAIN
GNJFN ;GET NEXT JFN IN GROUP
ERJMP R ;DONE, RETURN
JRST VRFY20 ;GO DO NEXT FILE
RET ;DONE, RETURN
;SETFIL - ROUTINE TO SET UP TO VERIFY A FILE
;
;ACCEPTS IN T1/ JFN
; CALL SETFIL
;RETURNS: +1 FAILED
; +2 SUCCESS, WITH T1/ FLAGS FROM FDB
; T2/ DEVICE DESIGNATOR FOR THIS FILE
; T3/ INDEX BLOCK ADR FROM FDB
SETFIL: HRRZ T1,T1 ;KEEP JUST THE JFN
MOVE T2,[3,,.FBCTL] ;READ 3 FDB WORDS
MOVEI T3,FILARG ;DESTINATION
GTFDB ;DO IT
ERJMP R ;RETURN ON FAILURE
;GET STRUCTURE NAME FOR DSKOP
MOVE T2,T1 ;MOVE THE JFN
HRROI T1,STRNAM ;WHERE TO PUT STRUCTURE NAME
MOVX T3,1B2 ;DEVICE NAME ONLY
JFNS ;DO IT
ERJMP R ;RETURN ON FAILURE
HRROI T1,STRNAM ;GET STR NAME
STDEV ;GET DEVICE DESIGNATOR
ERJMP R ;RETURN ON FAILURE
MOVE T1,FILARG ;GET FLAGS FOR THIS FILE
MOVE T3,FILARG+2 ;GET ADDRESS OF XB FOR THIS FILE
RETSKP ;DONE, RETURN SUCCESS
;TYPFIL - ROUTINE TO OUTPUT THE NAME OF A FILE WHEN THE NAME CHANGES
;
;ACCEPTS IN T1/ JFN
; CALL TYPFIL
;RETURNS: +1 ALWAYS
TYPFIL: ASUBR <TPFJFN>
O.STR < > ;INDENT OUTPUT ONE SPACE
SETZ T3, ;OUTPUT THE NAME
HRRZ T2,TPFJFN ;COPY JFN
MOVE T1,OUTJFN ;GET OUTPUT JFN
JFNS ;OUTPUT NAME
ERJMP R ;FAILED, RETURN
O.STR < > ;ADD A DASH OF PUNCTUATION
RET ;DONE, RETURN
;DSKRED - ROUTINE TO READ THE DISK
;
;ACCEPTS IN T1/ DISK ADDRESS TO READ
; T2/ DEVICE DESIGNATOR
; T3/ DESTINATION ADDRESS FOR PAGE
; CALL DSKRED
;RETURNS: +1 ERROR, WITH T1/ ERROR TYPE
; +2 SUCCESS, WITH T1/ NON-ZERO IF RETRIES WERE NEEDED
DSKRED: ASUBR <DRDADR,DRDDES>
SAVEAC (P1,P2)
MOVEM T1,LSTDSK ;SAVE DISK ADDRESS
MOVEI P1,10 ;MAX RETRIES WITH NO ERROR RECOVERY
SETUP1: MOVEI T2,.DOPSR ;STR RELATIVE ADDRESSING
STOR T2,DOP%AT,1 ;STORE IT
SETONE DOP%SN,1 ;SAY DEVICE DESIGNATOR IN T4
MOVEI T2,1000
TXO T2,DOP%IR!DOP%IL ;INHIBIT ERROR RECOVERY
MOVE T4,DRDDES ;DEVICE DESIGNATOR
DSKOP ;DO IT
JUMPN T1,[ MOVE T1,LSTDSK ;GET LAST DISK ADDRESS AGAIN
SOJGE P1,SETUP1 ;DO MAX RETRIES BEFORE GIVING UP
SETONE DOP%SN,T1
MOVEI P2,.DOPSR
STOR P2,DOP%AT,T1 ;SET UP NEW ARGS
TXZ T2,DOP%IR!DOP%IL ;ALLOW ERROR RECOVERY THIS TIME
DSKOP ;TRY IT AGAIN
RET] ;RETURN WITH CODE IN A
CAIE P1,10 ;ANY RETRIES?
SETOM T1 ;YES. REMEMBER THIS
RETSKP ;NO
;VFYFIL - ROUTINE TO VERIFY THE PAGES IN ONE FILE
;
;ACCEPTS IN T1/ FLAGS FROM FDB
; T2/ DEVICE DESIGNATOR
; T3/ XB ADDRESS FROM FDB
; CALL VFYFIL
;RETURNS: +1 ALWAYS, APPROPRIATE MESSAGES ISSUED
VFYFIL: ASUBR <VFLFLG,VFLDEV,VFLXB,VFLERR>
SAVEAC (P1,P2,P3)
STKVAR <VFLMSG,VFLTYP>
SETZM VFLMSG ;START BY ASSUMING [OK]
; DETERMINE IF THIS IS A LONG FILE
MOVE T2,VFLFLG ;GET THE FDB FLAGS
TXNN T2,FB%LNG ;IS THIS A LONG FILE?
JRST [ MOVE T1,VFLXB ;NO, SAVE PT ADDRESS
MOVEM T1,IDXPAG ; AS ONLY PTT ENTRY
MOVSI P3,-1 ;ONLY LOOK AT ONE ENTRY
JRST VFL10] ;AND GO PROCESS THE PTT
MOVE T1,VFLXB ;GET XB ADDRESS
MOVE T2,VFLDEV ;GET DEVICE DESIGNATOR
CALL REDPTT ;GO READ AND CHECK PTT
RET ;FAILED. THEN DON'T BOTHER WITH DATA
MOVSI P3,-1000 ;OK. CHECK ALL PAGE TABLES
; HERE TO CHECK EACH PAGE TABLE (JUST ONE IF FILE IS NOT LONG)
VFL10: SKIPN T1,IDXPAG(P3) ;GET PAGE TABLE ADDRESS
JRST VFL20 ;NONE HERE.
TLZ T1,777000 ;IGNORE CHECKSUM
JUMPE T1,VFL20 ;SKIP IT IF NOTHING HERE
MOVE T2,VFLDEV ;GET DEVICE DESIGNATOR
MOVEI T3,PTPAGE ;WHERE TO PUT IT
CALL DSKRED ;GET IT
JRST [ MOVEM T1,VFLERR ;SAVE ERROR FLAG
HRROI T1,[ASCIZ /? Hard error reading PT # /]
SKIPN T1 ;WAS IT REALLY HARD ?
HRROI T1,[ASCIZ /? Recoverable error reading PT # /]
MOVE T1,OUTJFN ;GET OUTPUT JFN
SETZM T3 ;STOP ON NULL
SOUT ;OUTPUT TEXT
HRRZ Q1,P3 ;GET JUST THE PT #
O.OCT Q1 ;OUTPUT PT #
CALL PRTDSK ;OUTPUT DISK ADDRESS
SKIPN VFLERR ;RECOVERABLE?
JRST .+1 ;YES. PROCEED
JRST VFL20]
SKIPE T1 ;CLEAN READ?
JRST [ O.STR <% Transient error reading PT # >
HRRZ Q1,P3 ;GET JUST THE PT #
O.OCT Q1 ;OUTPUT PT #
CALL PRTDSK ;DISC ADDRESS
JRST .+1] ;AND PROCEED
MOVEI T1,PTPAGE ;THE PAGE WHERE THE XB IS
CALL CHKSUM ;VERIFY IT
JRST [ O.STR <? Check sum error reading PT # >
HRRZ Q1,P3 ;GET JUST THE PT #
O.OCT Q1 ;OUTPUT PT #
CALL PRTDSK ;OUTPUT DISK ADDRESS
SETOM VFLMSG ;NOTE NOT TO SAY [OK]
JRST VFL20] ;DO NEXT PT
HRRZ T1,P1 ;GET PAGE TABLE NUMBER
MOVE T2,VFLDEV ;GET DEVICE DESIGNATOR
CALL VFYPT ;GO CHECK DATA PAGES FOR THIS PT
SETOM VFLMSG ;FAILED, DO NOT SAY [OK]
VFL20: AOBJN P3,VFL10 ;LOOP OVER ALL PAGE TABLES
SKIPE VFLMSG ;SAY [OK] ?
RET ;DONE, RETURN
O.STR <[OK]> ;OUTPUT INFORMATIVE MESSAGE
O.CRLF ;AND NEW LINE
RET ;DONE, RETURN
;REDPTT - ROUTINE TO READ AND CHECK A PAGE TABLE TABLE
;
;ACCEPTS IN T1/ DISK ADDRESS OF PAGE TABLE TABLE
; T2/ DEVICE DESIGNATOR
; CALL REDPTT
;RETURNS: +1 FAILED, PTT IS BAD
; +2 SUCCESS, PTT IS OK
REDPTT: ASUBR <RDPADR,RDPDEV,RDPFLG>
MOVEI T3,IDXPAG ;WHERE ITS GOING
MOVE T2,RDPDEV ;GET DEVICE DESIGNATOR
CALL DSKRED ;GO SET UP ARGS AND DO OPERATION
JRST [ MOVEM T1,RDPFLG ;SAVE ERROR FLAG
HRROI T2,[ASCIZ /? Hard error reading PTT/]
SKIPN T1 ;WAS IT REALLY HARD?
HRROI T2,[ASCIZ /? Recoverable error reading PTT/]
SETZM T3 ;STOP ON NULL
MOVE T1,OUTJFN ;GET OUTPUT JFN
SOUT ;OUTPUT TEXT
CALL PRTDSK ;output disk address
SKIPN RDPFLG ;HARD ERROR
JRST .+1 ;NO. GO ON
RET ] ;YES, DONE.
SKIPE T1 ;CLEAN READ?
JRST [ O.STR <% Transient error reading PTT>
CALL PRTDSK ;PRINT ADDRESS
JRST .+1] ;DONE
MOVEI T1,IDXPAG ;THE PAGE WHERE XB IS
CALL CHKSUM ;VERIFY BLOCK
JRST [ O.STR <? Checksum error on PTT>
CALL PRTDSK ;PRINT DISK ADDRESS
RET ] ;AND SKIP THE FILE
RETSKP ;DONE, RETURN SUCCESS
;VFYPT - ROUTINE TO VERIFY THE PAGES IN ONE PAGE TABLE
;
;ACCEPTS IN T1/ PAGE TABLE NUMBER
; T2/ DEVICE DESIGNATOR
; CALL VFYPT
;RETURNS: +1 FAILED, PT OR DATA PAGE UNREADABLE
; +2 SUCCESS, PT AND DATA PAGES OK
VFYPT: SAVEAC (P1,P2,P3)
STKVAR <VFPFLG>
SETZM VFPFLG ;ASSUME PT AND DATA PAGES ARE OK
MOVE P2,T2 ;SAVE DEVICE DESIGNATOR
MOVE P3,T1 ;SAVE PAGE TABLE NUMBER
MOVSI P1,-1000 ;LOOP OVER ALL DATA PAGES
VFPT10: SKIPN T1,PTPAGE(P1) ;DO NEXT DATA PAGE
JRST VFPT20 ;NONE HERE
TLZ T1,777000 ;IGNORE CHECKSUM
JUMPE T1,VFPT20 ;IF NOW ZERO, IGNORE IT
MOVE T2,P2 ;GET DEVICE DESIGNATOR
MOVEI T3,DATPAG ;WHERE TO PUT IT
CALL DSKRED ;DO IT
JRST [ HRROI T2,[ASCIZ /? Hard error reading page # /]
SKIPN T1 ;REALLY HARD?
HRROI T2,[ASCIZ /? Recoverable error reading page # /]
SETZM T3 ;STOP ON NULL
MOVE T1,OUTJFN ;GET OUTPUT JFN
SOUT ;OUTPUT STRING
HRRZ Q1,P1 ;GET JUST THE PAGE #
O.OCT Q1 ;OUTPUT PAGE #
HRROI T2,[ASCIZ / of PT # /]
SOUT ;OUTPUT STRING
O.OCT P3 ;OUTPUT PAGE TABLE NUMBER
CALL PRTDSK ;OUTPUT DISK ADDRESS
SETOM VFPFLG ;NOTE MESSAGE HAS BEEN OUTPUT
JRST VFPT20] ;DO NEXT PAGE
SKIPE T1 ;ANY RETRIES NEEDED ?
JRST [ O.STR <% Transient error reading page # >
HRRZ Q1,P1 ;GET JUST THE PAGE #
O.OCT Q1 ;OUTPUT PAGE #
O.STR < of PT # >
O.OCT P3 ;OUTPUT PAGE TABLE NUMBER
CALL PRTDSK ;output disk address
SETOM VFPFLG ;NOTE MESSAGE HAS BEEN OUTPUT
JRST .+1]
VFPT20: AOBJN P1,VFPT10 ;DO ALL OF IT
SKIPE VFPFLG ;ANY MESSAGES OUTPUT ?
RET ;YES, RETURN FAILURE
RETSKP ;NO, RETURN SUCCESS
;PRTDSK - ROUTINE TO TYPE A DISK ADDRESS
;
;ACCEPTS IN LSTDSK/ LAST DISK ADDRESS READ
; CALL PRTDSK
;RETURNS: +1 ALWAYS
PRTDSK: O.STR <, Disk Address >
MOVE T2,LSTDSK ;GET DISK ADDRESS TO OUTPUT
MOVE T3,[1B0+10] ;GET NOUT FLAGS
CALL PUTHLF ;OUTPUT DISK ADDRESS
O.CRLF ;OUTPUT END OF LINE
RET ;DONE, RETURN
;CHECK SUM SUBROUTINE
; T1/ XB BLOCK ADDRESS
CHKSUM: MOVSI T2,-4 ;# OF WORDS TO DO
HRRI T2,0(T1) ;GET ADDRESS
MOVE T3,[POINT ^D9,T4]
PUSH P,T1
CHKLOP: LDB T1,[POINT ^D9,0(T2),8] ;GET NEXT PART
IDPB T1,T3 ;SAVE IT
AOBJN T2,CHKLOP ;DO ALL 36 BITS
POP P,T1 ;GET BACK ADDRESS
SETCA T4, ;GET COMPLEMENT OF CHECK SUM
JCRY0 .+1
MOVSI T3,-1000 ;THE LOOP COUNTER
HRLI T1,T3
CHKLO1: MOVE T2,@T1 ;GET NEXT ADDRESS
LOAD T2,STGADR,T2 ;GET ADDRESS PART ONLY
SKIPN T2 ;HAVE AN ADDRESS?
HRRZ T2,T3 ;NO. USE OFFSET IN XB THEN
ADD T4,T2
JCRY0 [AOJA T4,.+1]
CHKLO2: AOBJN T3,CHKLO1 ;DO THEM ALL
CAME T4,[-1] ;GOOD CHECKSUM?
RET ;NO
RETSKP ;YES, RETURN SUCCESS
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 r ;error, go check for eof on take file
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
JRST [ CALLRET COMER2 ] ;NO, ISSUE ERROR MESSAGE AND RETURN
RETSKP ;SUCCESS, 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 R ;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
;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: STKVAR <ATOMPT>
MOVEM T1,ATOMPT ;SAVE ATOM POINTER
CALL TSTCOL ;ISSUE NEW LINE IF NEEDED
TMSG <? DIRTST: > ;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
SUBTTL COMMAND ERROR SUBROUTINES
; INVALID END-OF-COMMAND
COMER2: CALL TSTCOL ;TEST COLUMN POSITION
TMSG <? DIRTST: 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
hrrz t2,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 ...
; PUTHLF - ROUTINE TO PRINT A 36-BIT QUANTITY AS TWO HALFWORDS.
; OUTPUT GOES TO JFN "OUTJFN"
;
; CALL: MOVE T2,36-BIT QUANTITY
; MOVE T3,RADIX AND CONTROL BITS
; CALL PUTHLF
; RETURN
PUTHLF: STKVAR <VALUE,RAIDIX> ;ALLOCATE TEMPORARY STORAGE
MOVEM T2,VALUE ;SAVE THE VALUE TO OUTPUT
MOVE T1,OUTJFN ;GET JFN FOR OUTPUT
HLRZ T2,T2 ;GET LEFT HALFWORD TO OUTPUT
NOUT ;OUTPUT THE LEFT HALFWORD
CALL TYPERR ;UNEXPECTED ERROR
MOVEM T3,RAIDIX ;SAVE THE RAIDIX
HRROI T2,[ASCIZ /,,/] ;GET PUNCTUATION
SETZM T3 ;TERMINATE ON NULL
SOUT ;OUTPUT PUNCTUATION
MOVE T3,RAIDIX ;RESTORE THE RAIDIX
MOVE T2,VALUE ;RESTORE ORIGINAL QUANTITY
HRRZ T2,T2 ;GET JUST THE RIGHT HALF
NOUT ;OUTPUT RIGHT HALFWORD
CALL TYPERR ;UNEXPECTED ERROR
RET ;RETURN TO WHENCE WE CAME ...
SUBTTL MAPPING SUBROUTINES
; MAPDP0 - ROUTINE TO MAP DIRECTORY PAGE 0 INTO THE
; ADDRESS SPACE OF THIS PROCESS.
;
; CALL: [JFN FOR DIRECTORY FILE IS IN DIRJFN]
; CALL MAPDP0
; RETURN
MAPDP0: HRLZ T1,DIRJFN ;GET DIRECTORY JFN,, FILE PAGE 0
MOVSI T2,.FHSLF ;GET OUR FORK HANDLE
MOVEI P1,DIRPG0 ;GET CORE ADDRESS OF DIR PAGE 0
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
HRR T2,P1 ;COPY ADDRESS TO ARG AC FOR PMAP
MOVX T3,PM%RD ;READ ACCESS ONLY
PMAP ;MAP THE PAGES
RET ;RETURN TO WHENCE WE CAME ...
; MAPDIR - ROUTINE TO MAP PAGES FROM THE DIRECTORY FILE INTO THE
; ADDRESS SPACE OF THIS PROCESS.
;
; CALL: [JFN FOR DIRECTORY FILE IS IN DIRJFN]
; MOVE MA,REQUIRED ADDRESS
; CALL MAPDIR
; RETURN
MAPDIR: CALL SAVACS ;GO SAVE ALL AC'S
HRLZ T1,DIRJFN ;GET DIRECTORY JFN
MOVE P1,MA ;COPY ADDRESS REQUIRED
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
HRR T1,P1 ;GET PAGE # IN FILE
MOVSI T2,.FHSLF ;GET OUR FORK HANDLE
MOVEI P1,MAPPGS ;GET CORE ADDRESS OF DIR PAGE
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
HRR T2,P1 ;COPY ADDRESS TO ARG AC FOR PMAP
MOVX T3,PM%RD!PM%CNT ;READ ACCESS ONLY, ITERATION CNT
HRRI T3,FDBPGS ;GET # OF PAGES TO MAP
LOAD P1,DIRFRE ;GET HIGHEST ADDRESS+1 FOR FDB'S
SUBI P1,1 ;COMPUTE HIGHEST ADR FOR FDB'S
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
MOVE P2,MA ;GET DESIRED ADDRESS
LSH P2,-^D9 ;CONVERT ADDRESS TO A PAGE #
SUB P1,P2 ;COMPUTE # OF PAGES TO MAP-1
ADDI P1,1 ;COMPUTE # OF PAGES TO MAP
CAIG P1,FDBPGS ;LESS THAN # OF MAPPING PAGES ?
HRR T3,P1 ;YES, USE LESSER # OF PAGES
HRREI T4,-1(T3) ;SAVE # OF PAGES TO MAP-1
PMAP ;MAP THE PAGES
ERJMP R ;FAILED
MOVE P1,MA ;GET REQUIRED ADDRESS
TRZ P1,777 ;COMPUTE LOWEST ADDRESS MAPPED
MOVEM P1,MAPBOT ;SAVE LOWEST ADDRESS MAPPED
LSH P1,-^D9 ;CONVERT LOWEST ADR TO PAGE #
ADD P1,T4 ;COMPUTE HIGHEST PAGE MAPPED
LSH P1,^D9 ;CONVERT PAGE # TO ADDRESS
TRO P1,777 ;COMPUTE HIGHEST ADR MAPPED
MOVEM P1,MAPTOP ;SAVE HIGHEST ADR MAPPED
MOVEI P1,MAPPGS ;GET ADDRESS OF MAPPED AREA
HRRZ P2,T1 ;GET PAGE # IN FILE
LSH P2,^D9 ;COMPUTE ADDRESS IN FILE
SUB P1,P2 ;COMPUTE MAPPED ADDRESS OFFSET
MOVEM P1,FDBOFS ;SAVE OFFSET TO MAPPED ADDRESSES
CALL RESACS ;GO RESTORE ALL THE AC'S
RETSKP ;RETURN TO WHENCE WE CAME ...
; MAPSTB - ROUTINE TO MAP THE SYMBOL TABLE INTO THE ADDRESS
; SPACE OF THIS PROCESS.
;
; CALL: [PAGE 0 OF DIRECTORY MUST BE MAPPED]
; CALL MAPSTB
; RETURN
MAPSTB: HRLZ T1,DIRJFN ;GET JFN OF DIRECTORY FILE
LOAD P1,DIRBOT ;GET START ADDRESS OF TABLE
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
HRR T1,P1 ;COPY PAGE # TO ARG AC FOR PMAP
MOVSI T2,.FHSLF ;GET OUR FORK HANDLE
MOVEI P1,SYMTAB ;GET ADDRESS TO MAP TABLE INTO
LSH P1,-^D9 ;CONVERT ADDRESS TO A PAGE #
HRR T2,P1 ;COPY PAGE # TO ARG AC FOR PMAP
MOVX T3,<PM%CNT!PM%RD> ;MULTIPLE PAGES, READ
LOAD P1,DIRBOT ;GET BOTTOM ADDRESS OF TABLE
LOAD P2,DIRTOP ;GET TOP ADDRESS OF SYMBOL TABLE
SUB P2,P1 ;COMPUTE SIZE OF TABLE
LSH P2,-^D9 ;CONVERT # OF WORDS TO PAGES
HRRI T3,1(P2) ;COPY # OF PAGES TO MAP
PMAP ;MAP THE PAGES
MOVEI P1,SYMTAB ;GET CORE ADR OF SYMBOL TABLE
HRRZ P2,T1 ;GET PAGE # IN DIRECTORY
LSH P2,^D9 ;CONVERT PAGE # TO ADDRESS
SUB P1,P2 ;COMPUTE REQUIRED OFFSET
MOVEM P1,STBOFS ;SAVE OFFSET TO SYMBOL TABLE
RET ;RETURN TO WHENCE WE CAME ...
; GETDIR - ROUTINE TO INPUT A DIRECTORY NAME, POSSIBLY WITH
; RECOGNITION.
;
; CALL: CALL GETDIR
; RETURN WITH DIRECTORY # IN CURDIR
GETDIr: SAY (Directory file: ) ;ASK FOR DIRECTORY NAME
SETZM REPLY ;CLEAR FIRST WORD OF REPLY
MOVE P1,[REPLY,,REPLY+1] ;GET SOURCE,,DESTINATION
BLT P1,REPLY+REPSIZ-1 ;CLEAR ENTIRE REPLY BUFFER
GTDJFN: MOVE P1,[JFNBLK,,JFNBLK+1] ;GET SOURCE,,DESTINATION
SETZM JFNBLK ;CLEAR FIRST WORD OF GTJFN BLOCK
BLT P1,JFNBLK+GJFSIZ-1 ;CLEAR ENTIRE GTJFN BLOCK
setzm jfnblk+.gjnam ;let user supply the name
HRROI P1,[ASCIZ/ROOT-DIRECTORY/]
MOVEM P1,JFNBLK+.GJDIR ;SAVE DIRECTORY
HRROI P1,[ASCIZ/DIRECTORY/] ;GET POINTER TO EXTENSION
MOVEM P1,JFNBLK+.GJEXT ;STORE POINTER TO EXTENSION
MOVX P1,GJ%old!gj%ifg ;GET old!gj%ifg FILE BIT
MOVEM P1,JFNBLK+.GJGEN ;SAVE THE FLAGS
movx P1,primry ;use primary input for name
MOVEM P1,JFNBLK+.GJSRC ;STORE JFN'S
MOVEI T1,JFNBLK ;GET POINTER TO GTJFN BLOCK
SETZM T2 ;NO MAIN STRING POINTER
GTJFN ;GET A JFN FOR DIRECTORY FILE
CALL TYPERR ;UNEXPECTED ERROR
MOVEM T1,DIRJFN ;SAVE DIRECTORY JFN
MOVEM T1,DIRFLG ;SAVE FLAGS FOR GNJFN
CALLRET OPNDIR ;GO OPEN THE DIRECTORY FILE
; OPNDIR - ROUTINE TO OPEN THE DIRECTORY FILE AND SET UP THE
; DIRECTORY NUMBER IN CURDIR.
;
; CALL: CALL OPNDIR
; RETURN WITH DIRECTORY FILE OPEN
OPNDIR: HRRZ T1,DIRJFN ;GET JUST THE JFN
MOVE T2,[440000,,202000] ;36 BIT BYTES, READ, THAWED
OPENF ;OPEN THE FILE
CALL TYPERR ;UNEXPECTED ERROR
SETZM NEXCNT ;INITIALIZE COUNT OF NEX FDB'S
RET ;RETURN TO WHENCE WE CAME ...
; STRCMP - ROUTINE TO COMPARE TWO STRINGS
;
; CALL: MOVE Q1,ADDRESS OF STRING 1
; MOVE Q2,ADDRESS OF STRING 2
; CALL STRCMP
; RETURN WITH Q1:
; -1 IF STRING 1 IS .LT. STRING 2
; 0 IF STRING 1 IS .EQ. STRING 2
; 1 IF STRING 1 IS .GT. STRING 2
STRCMP: MOVEI P3,-1(Q1) ;GET ADR -1 OF STRING 2
ANDI P3,777 ;KEEP JUST LOW-ORDER PART
ADDI P3,STRPG1 ;FORM CORE ADDRESS OF STRING
HRLI P3,(POINT 7,0,35) ;FORM POINTER TO STRING 1
MOVEI P4,-1(Q2) ;GET ADR -1 OF STRING 2
ANDI P4,777 ;KEEP JUST THE LOW-ORDER PART
ADDI P4,STRPG2 ;FORM CORE ADDRESS OF STRING
HRLI P4,(POINT 7,0,35) ;FORM POINTER TO STRING 2
HRLZ T1,DIRJFN ;GET JFN OF DIRECTORY FILE
MOVE P1,Q1 ;GET ADDRESS DESIRED
LSH P1,-^D9 ;CONVERT ADDRESS TO A PAGE #
HRR T1,P1 ;GET FILE PAGE TO MAP
MOVSI T2,.FHSLF ;GET OUR FORK HANDLE
MOVEI P1,STRPG1 ;GET ADDRESS OF CORE PAGE
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
HRR T2,P1 ;GET PAGE # IN CORE
MOVX T3,PM%RD ;READ ACCESS ONLY
PMAP ;MAP THE PAGE
HRLZ T1,DIRJFN ;GET JFN OF DIRECTORY FILE
MOVE P1,Q2 ;GET ADDRESS DESIRED
LSH P1,-^D9 ;CONVERT ADDRESS TO A PAGE #
HRR T1,P1 ;GET FILE PAGE TO MAP
MOVSI T2,.FHSLF ;GET OUR FORK HANDLE
MOVEI P1,STRPG2 ;GET ADDRESS OF CORE PAGE
LSH P1,-^D9 ;CONVERT ADDRESS TO PAGE #
HRR T2,P1 ;GET PAGE # IN CORE
MOVX T3,PM%RD ;READ ACCESS ONLY
PMAP ;MAP THE PAGE
STRCM1: MAPTST Q1 ;INSURE PAGE IS MAPPED
ILDB P1,P3 ;GET A CHARACTER FROM STRING 1
JUMPE P1,STRCM2 ;IF END-OF-STRING 1, CHECK FOR =
MAPTST Q2 ;INSURE THAT PAGE IS MAPPED
ILDB P2,P4 ;GET A CHARACTER FROM STRING 2
CAIN P1,(P2) ;ARE THE CHARACTERS THE SAME ?
JRST STRCM1 ;YES, GO CHECK NEXT CHARACTERS
SETOM Q1 ;ASSUME STRING 1 .LT. STRING 2
CAML P1,P2 ;IS STRING 1 .LT. STRING 2 ?
MOVEI Q1,1 ;NO, STRING 1 .GT. STRING 2
RET ;RETURN TO WHENCE WE CAME ...
; HERE WHEN A MATCH OCCURRED
STRCM2: MAPTST Q2 ;INSURE THAT THE PAGE IS MAPPED
ILDB P1,P4 ;GET NEXT CHAR FROM STRING 2
SETOM Q1 ;ASSUME STRING 1 .LT. STRING 2
SKIPN P1 ;WAS THIS AN EXACT MATCH ?
SETZM Q1 ;YES, FLAG EXACT MATCH
RET ;RETURN TO WHENCE WE CAME ...
;GTFILE - GET FILE NAME FOR THIS DIRECTORY AND GET A JFN ON IT
;
;ACCEPTS IN T1/ POINTER TO DIRECTORY SPEC
; T2/ DIRECTORY DESIGNATOR
; CALL GTFILE
;RETURNS: +1 FAILED
; +2 SUCCESS, WITH DIRJFN CONTAINING JFN OF DIRECTORY FILE
GTFILE: TDZA T4,T4 ;NOTE JFN WANTED
GTSTR: SETOM T4 ;NOTE STRING WANTED
STKVAR <GTFPTR,GTFDIR,DOTPTR,BRKPTR,GTFFLG>
MOVEM T1,GTFPTR ;SAVE POINTER TO DIRECTORY SPEC
MOVEM T2,GTFDIR ;SAVE DIRECTORY DESIGNATOR
MOVEM T4,GTFFLG ;SAVE FLAG
SETZM DOTPTR ;INDICATE DOT NOT FOUND YET
SETZM BRKPTR ;INDICATE BRACKET NOT FOUND YET
GTFIL1: ILDB T2,T1 ;GET NEXT CHARACTER IN STRING
CAIN T2,"<" ;LEFT BRACKET?
JRST [ MOVEM T1,BRKPTR ;YES. SAVE ITS POINTER
JRST GTFIL1] ;GO GET NEXT CHARACTER
CAIN T2,"." ;IS IT A DOT?
JRST [ MOVEM T1,DOTPTR ;YES. SAVE ITS POINTER
JRST GTFIL1] ;GO GET NEXT CHARACTER
CAIE T2,">" ;IS IT A RIGHT BRACKET?
JRST GTFIL1 ;NO. GO GET NEXT CHARACTER
SKIPN DOTPTR ;FOUND RIGHT BRACKET. HAVE WE SEEN A DOT?
JRST GTFIL2 ;NO. MUST BE IN <ROOT-DIRECTORY>
;HERE WHEN THIS IS A SUBDIRECTORY. ;WE HAVE STR:<DIRECTORY.SUBDIRECTORY>.
;CONVERT TO STR:<DIRECTORY>SUBDIRECTORY.DIRECTORY
DPB T2,DOTPTR ;REPLACE DOT WITH RIGHT BRACKET
MOVEI T2,"." ;GET A DOT
DPB T2,T1 ;REPLACE RIGHT BRACKET WITH DOT
HRROI T2,[ASCIZ/DIRECTORY/] ;T2/ SOURCE IS THIS STRING
SETZ T3, ;T3/ STOP ON NULL
SOUT ;FORM STR:<DIR>SUBDIR.DIRECTORY
MOVE T2,GTFPTR ;GET POINTER TO DIRECTORY SPEC
JRST GTFIL3 ;GO GET JFN
;HERE WHEN DIRECTORY IS IN ROOT-DIRECTORY. FORM STR:<ROOT-DIRECTORY>DIR.DIRECTORY
GTFIL2: HRROI T1,TMPSTR ;GET POINTER TO TEMPORARY STRING AREA
HLRZ T2,GTFDIR ;GET STRUCTURE UNIQUE CODE
HRLI T2,.DVDES ;FORM DEVICE DESIGNATOR
DEVST ;GET STRING FOR STR
RET ;FAILED, RETURN FAILURE
MOVX T2,":" ;GET STR PUNCTUATION
IDPB T2,T1 ;ADD STR PUNCTUATION
HRROI T2,[ASCIZ/<ROOT-DIRECTORY>/]
SETZM T3 ;TERMINATE ON NULL
SOUT ;ADD DIRECTORY TO STR STRING
MOVE T2,BRKPTR ;POINT TO LEFT BRACKET
MOVEI T3,^D40 ;DIRECTORY NAME <=39 CHARACTERS
MOVEI T4,">" ;STOP ON RIGHT BRACKET
SOUT ;COPY DIRECTORY NAME
SETOM T3 ;BACK UP POINTER OVER THE BRACKET
IBP T3,T1
MOVEM T3,T1 ;T1/ DESTINATION IS END OF DIRECTORY NAME
HRROI T2,[ASCIZ/.DIRECTORY/] ;T2/ POINTER TO SOURCE
SETZ T3, ;T3/ STOP ON NULL
SOUT ;COPY ".DIRECTORY" TO END OF STRING
HRROI T2,TMPSTR ;POINT TO START OF THIS STRING
JRST GTFIL3 ;GO GET JFN
;T2 POINTS TO FILE SPEC. GET A JFN ON THIS DIRECTORY FILE
GTFIL3: SKIPE GTFFLG ;STRING WANTED ?
RETSKP ;YES, RETURN STRING
MOVX T1,GJ%PHY!GJ%SHT!GJ%OLD ;PHYSICAL ONLY, SHORT BLOCK
GTJFN ;GET A JFN
RET ;FAILED, RETURN ERROR
HRRZM T1,DIRJFN ;SAVE JFN
RETSKP ;DONE, RETURN
; ECHOFF - ROUTINE TO TURN OFF ECHOING FOR ESCAPES
;
; CALL: CALL ECHOFF
; RETURN
ECHOFF: MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT JFN
RFCOC ;READ ECHOING BITS
TRZ T3,3B19 ;TURN OFF ESCAPE ECHOING
SFCOC ;TELL MONITOR
RET ;RETURN TO WHENCE WE CAME ...
; SAVACS - ROUTINE TO SAVE ALL 16 ACCUMULATORS.
;
; CALL: CALL SAVACS
; RETURN
SAVACS: MOVEM 0,SAVE0 ;SAVE ACCUMULATOR 0
MOVE 0,[t1,,SAVET1] ;SET UP FOR BLT
BLT 0,SAVET1+16 ;SAVE NEXT 15 ACCUMULATORS
RET ;RETURN TO WHENCE WE CAME ...
; RESACS - ROUTINE TO RESTORE ALL 16 ACCUMULATORS
;
; CALL: CALL RESACS
; RETURN
RESACS: MOVE 0,[SAVET1,,T1] ;SET UP FOR BLT
BLT 0,17 ;RESTORE AC'S 1-17
MOVE 0,SAVE0 ;RESTORE AC 0
RET ;RETURN TO WHENCE WE CAME ...
; TYPERR - SUBROUTINE TO TYPE AN ERROR MESSAGE ON THE TERMINAL
; WHEN A JSYS GIVES AN ERROR RETURN.
;
; CALL: CALL TYPERR
; HALT THE PROCESS
;
; OR: CALL PUTERR
; RETURN
;
; PRESERVES ACCUMULATOR T1 - USES T2 AND T3
PUTERR: SKIPA P1,[0] ;GET "RETURN TO CALLER" FLAG
TYPERR: SETOM P1 ;GET "STOP DEAD" FLAG
MOVE P2,T1 ;SAVE REGISTER T1
HRROI T1,[ASCIZ/
? DIRTST: An unexpected error has occurred
/]
PSOUT ;TYPE FIRST PART OF MESSAGE
MOVEI T1,.CHTAB ;GET TAB CHARACTER
PBOUT ;TYPE A TAB
MOVEI T1,.PRIOU ;USE PRIMARY OUTPUT
HRLOI T2,.FHSLF ;CURRENT FORK, LAST ERROR
CLEAR T3, ;EXPAND PARAMETER VALUES
ERSTR ;OUTPUT THE ERROR MESSAGE
JRST TYPER1 ;UNDEFINED ERROR NUMBER
JRST TYPER2 ;ERSTR ERROR
CRLF
MOVE T1,P2 ;RESTORE REGISTER T1
JUMPN P1,STOP ;GO STOP IF CALLED BY PUTERR
RET ; OR RETURN IF CALLED BY TYPERR
TYPER1: HRROI T1,[ASCIZ/
? DIRTST: An unkown error has occurred
/]
PSOUT ;TYPE THE MESSAGE
MOVE T1,P2 ;RESTORE REGISTER T1
JUMPN P1,STOP ;GO STOP IF CALLED BY TYPERR
.POPJ: RET ; OR RETURN IF CALLED BY PUTERR
; HERE IF AN ERROR OCCURRED WHILE TYPING AN ERROR MESSAGE
TYPER2: HRROI T1,[ASCIZ/
? DIRTST: Error occurred while typing an error message
/]
PSOUT ;OUTPUT THE ERROR MESSAGE
MOVE T1,P2 ;RESTORE REGISTER T1
JUMPE P1,.POPJ ;IF CALLED VIA PUTERR, RETURN
STOP: HALTF ;HALT THIS PROCESS
JRST STOP ;IN CASE OF CONTINUE
SUBTTL CONSTANT DATA
.DIRECT FLBLST
HLPMSG: ASCIZ /
FUNCTIONS
DIRTST checks the format of directory files and reports any invalid
or inconsistent data.
DIRTST can verify the readability of files by "manually" reading
all of the pages in each file and performing consistency checks on
the files' page tables.
COMMANDS
EXIT (TO MONITOR)
HELP
LIST (OUTPUT TO PRINTER)
OUTPUT (TO FILE) File-specification
TEST (DIRECTORY FILE) File-specification-of-directory-file
TYPE (OUTPUT ON TERMINAL)
VERIFY (FILES) File-specification
LIST, OUTPUT, and TYPE affect the destination of subsequent TEST
or VERIFY commands.
EXAMPLES
To test the consistency of directory PAYROL:<WEEKLY>,
DIRTST>TEST (DIRECTORY FILE) PAYROL:<ROOT-DIRECTORY>WEEKLY.DIRECTORY
To test the consistency of directory PS:<R.JONES>,
DIRTST>TEST (DIRECTORY FILE) PS:<R>JONES.DIRECTORY
To test the consistency of directory PS:<RESEARCH.PROJ3.SOURCES>,
DIRTST>TEST (DIRECTORY FILE) PS:<RESEARCH.PROJ3>SOURCES.DIRECTORY
To verify the readability of file STR:<LIBRARY>APPLICATION.EXE,
DIRTST>VERIFY (FILES) STR:<LIBRARY>APPLICATION.EXE
To verify the readability of all files in PS:<SYSTEM>,
DIRTST>VERIFY (FILES) PS:<SYSTEM>*.*.*
RESTRICTIONS
WHEEL or OPERATOR capability is required.
/
PDP: IOWD PDLSIZ, PDL ;PUSH DOWN POINTER
; TABLE OF VALID BLOCK TYPES AND CHECKING ROUTINES
TYPTAB: .TYFDB ,, CHKFDB
.TYACT ,, CHKACT
.TYNAM ,, CHKNAM
.TYEXT ,, CHECKX
.TYUNS ,, CHKUNS
.TYSYM ,, R
.TYDIR ,, R
.TYFRE ,, R
.TYLAC ,, R
.TYGDB ,, R
.TYFBT ,, R
TYPSIZ== .-TYPTAB
; ENTRY VECTOR
ENTVEC: JRST START
JRST START
VDIRTS
; PROMPT STRING
PROMPT: ASCIZ /DIRTST>/
; COMMAND TABLE
CMDTAB: CMDSIZ-1,,CMDSIZ-1
XWD [ASCIZ/EXIT/], .EXIT
XWD [ASCIZ/HELP/], .HELP
XWD [ASCIZ/LIST/], .LIST
XWD [ASCIZ/OUTPUT/], .OUTPT
XWD [ASCIZ/TEST/], .TEST
XWD [ASCIZ/TYPE/], .TYPE
XWD [ASCIZ/VERIFY/], .VERFY
CMDSIZ==.-CMDTAB
FDBLEN: 30 ;VERSION 0 - LENGTH 30 OCTAL
.FBLEN ;VERSION 1 - CURRENT LENGTH 37 OCTAL
OLDV1: 31 ;VERSION 1 ALSO ALLOWS 31 OCTAL
SUBTTL VARIABLE DATA STORAGE
DIRFDB: FLD(.CMFIL,CM%FNC)+CM%DPP
GJFBLK ;ADDRESS OF GTJFN BLOCK
EXP 0
EXP .-. ;DEFAULT POINTER, DIRECTORY COMMAND FILLS IN
PDL: BLOCK PDLSIZ ;STACK
SAVE0: BLOCK 1 ;ACCUMULATOR 0 SAVED HERE
SAVET1: BLOCK 17 ;ACCUMULATORS 1-17 SAVED HERE
DIRBUF: BLOCK ^D8 ;NAME OF DIRECTORY TO TEST
CURNAM: BLOCK ^D8 ;DIRECTORY NAME BEING TESTED
TMPSTR: BLOCK 50 ;TEMPORARY STRING AREA
REPLY: BLOCK REPSIZ ;BUFFER FOR USER REPLIES
LASTQ: BLOCK 1 ;POINTER TO LAST OUTPUT FOR ^R
OUTJFN: BLOCK 1 ;JFN FOR OUTPUT FILE
DIRJFN: BLOCK 1 ;JFN FOR DIRECTORY FILE
DIRFLG: BLOCK 1 ;FLAGS (AND JFN) FOR DIRECTORY
CURDIR: BLOCK 1 ;# OF DIRECTORY CURRENTLY MAPPED
STBOFS: BLOCK 1 ;ADDRESS OFFSET FOR SYMBOL TABLE
FDBOFS: BLOCK 1 ;ADDRESS OFFSET FOR FDB STORAGE
MAPBOT: BLOCK 1 ;LOWEST ADR MAPPED IN FDB AREA
MAPTOP: BLOCK 1 ;HIGHEST ADR MAPPED IN FDB AREA
JFNBLK: BLOCK GJFSIZ ;GTJFN TABLE OF STRING POINTERS
INDENT: BLOCK 1 ;CURRENT # OF TABS TO INDENT
ERRCNT: BLOCK 1 ;NUMBER OF ERRORS DETECTED
NEXCNT: BLOCK 1 ; # OF FDB'S WITH FB%NEX ON
CMDBLK: BLOCK .CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;ATOM BUFFER FOR COMND JSYS
GJFBLK: BLOCK GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
NUMDIR: BLOCK 1 ;DIRECTORY NUMBER
filarg: block 3 ;gtfdb words for verify function
strnam: block 10 ;structure name for verify function
lstdsk: block 1 ;last disk address read
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
; AREAS INTO WHICH PORTIONS OF THE DIRECTORY ARE MAPPED
LOC DIRADR ;CHOOSE SOME HIGH ADDRESS,
; OUT OF THE WAY OF THE PROGRAM
DIRPG0: BLOCK PAGSIZ ;PAGE 0 OF THE DIRECTORY
MAPPGS: BLOCK FDBPGS*PAGSIZ ;PAGES FOR MAPPING FDB'S
SYMTAB: BLOCK STBPGS*PAGSIZ ;ENTIRE SYMBOL TABLE
STRPG1: BLOCK PAGSIZ ;FIRST PAGE FOR STRING COMAPRES
STRPG2: BLOCK PAGSIZ ;SECOND PAGE FOR STRING COMPARES
PTPAGE: BLOCK PAGSIZ ;PAGE TO READ PAGE TABLES INTO
DATPAG: BLOCK PAGSIZ ;PAGE TO READ DATA PAGES INTO
IDXPAG: BLOCK PAGSIZ ;PAGE FOR XB'S
RELOC
END <3,,ENTVEC>