Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/exec3.mac
There are 47 other files named exec3.mac in the archive. Click here to see a list.
;<4.EXEC>EXEC3.MAC.109, 3-Jan-80 16:06:45, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.1.EXEC>EXEC3.MAC.6, 2-Nov-79 17:02:14, EDIT BY OSMAN
;CHANGE $USER TO $USERS
;CHANGE $DATE TO $DATES TO AVOID CONFLICT
;<4.1.EXEC>EXEC3.MAC.2, 2-Nov-79 16:42:21, EDIT BY OSMAN
;CHANGE $DIR TO $DIRS TO AVOID CONFLICT WITH SOMETHING
;<4.EXEC>EXEC3.MAC.107, 25-Sep-79 08:28:49, EDIT BY OSMAN
;Fix end-test at DSKS1
;<4.EXEC>EXEC3.MAC.106, 21-Sep-79 12:56:07, EDIT BY OSMAN
;tco 4.2481 - Fix TDIRECTORY of directories that cause "storage full"
;<4.EXEC>EXEC3.MAC.105, 20-Sep-79 14:16:29, EDIT BY OSMAN
;tco 4.2479 - Buffer filespecs if FIND n specified.
;<4.EXEC>EXEC3.MAC.104, 12-Sep-79 15:58:48, Edit by HESS
; Add time to RD and WD (XTND only)
;<4.EXEC>EXEC3.MAC.101, 21-Aug-79 11:53:52, EDIT BY OSMAN
;MORE OF 4.2413
;<4.EXEC>EXEC3.MAC.100, 21-Aug-79 10:37:34, EDIT BY OSMAN
;tco 4.2413 - Fix REVERSE CHRONOLOGICAL
;<HESS.TEMP.E>EXEC3.MAC.5, 27-Jul-79 12:37:33, Edit by HESS
; Add extended features
;<4.EXEC>EXEC3.MAC.96, 15-Aug-79 14:03:17, EDIT BY OSMAN
;TCO 4.2400 - Allow many things after NO
;<4.EXEC>EXEC3.MAC.94, 3-Aug-79 13:51:26, EDIT BY OSMAN
;tco 4.2373 - Finish previous filespec line before printing error
;<4.EXEC>EXEC3.MAC.93, 24-Jul-79 15:33:34, EDIT BY OSMAN
;FIX CHRONOLOGICAL
;<4.EXEC>EXEC3.MAC.92, 22-Jul-79 14:12:09, EDIT BY HELLIWELL
;FIXES FOR DECTAPE, ALL UNDER NOSHIP
;<4.EXEC>EXEC3.MAC.81, 16-Jul-79 09:08:40, EDIT BY OSMAN
;USE %? INSTEAD OF DEFUNCT %ERSTR FOR PRINTING CHECKSUM ERROR MESSAGE
;<4.EXEC>EXEC3.MAC.65, 29-Jun-79 13:15:54, EDIT BY OSMAN
;tco 4.2316 - Print directory as it comes instead of buffering!!
;<4.EXEC>EXEC3.MAC.64, 27-Jun-79 11:07:23, EDIT BY OSMAN
;tco 4.3213 - Don't do extra SINs in DIRECTORY
;<4.EXEC>EXEC3.MAC.63, 21-Jun-79 13:35:33, EDIT BY OSMAN
;REMOVE EXTRANEOUS REFS TO RLJFNS
;<4.EXEC>EXEC3.MAC.61, 7-Jun-79 17:02:17, EDIT BY OSMAN
;tco 4.2278 - Fix TIMES (AND DATES OF) TAPE-WRITE
;<4.EXEC>EXEC3.MAC.60, 6-Jun-79 11:53:54, EDIT BY HELLIWELL
;USE ETYPE <%1'> INPLACE OF CALL SIXPRS
;<4.EXEC>EXEC3.MAC.59, 6-Jun-79 10:01:31, EDIT BY OSMAN
;tco 4.2274 - don't leave jfn's around on ^C
;<4.EXEC>EXEC3.MAC.58, 4-Jun-79 14:01:30, EDIT BY OSMAN
;tco 4.2271 - At DI3, don't lose jfn on jfnstk
;<4.EXEC>EXEC3.MAC.55, 26-Apr-79 14:27:55, EDIT BY OSMAN
;MOVE CALL DHEAD TO DFILE, SO P2 IS SET UP
;<4.EXEC>EXEC3.MAC.54, 26-Apr-79 13:48:57, EDIT BY OSMAN
;<4.EXEC>EXEC3.MAC.53, 25-Apr-79 15:50:50, EDIT BY OSMAN
;ADD ACCF
;<4.EXEC>EXEC3.MAC.52, 24-Apr-79 17:22:29, EDIT BY OSMAN
;<4.EXEC>EXEC3.MAC.40, 16-Mar-79 15:09:58, EDIT BY OSMAN
;Control which subcommands are allowed for magtape
;<4.EXEC>EXEC3.MAC.37, 14-Mar-79 14:40:28, EDIT BY OSMAN
;USE DTPX INSTEAD OF DTX IN SINCE AND BEFORE SUBCOMMANDS
;<4.EXEC>EXEC3.MAC.35, 13-Mar-79 15:50:54, EDIT BY OSMAN
;REWIND TAPE BEFORE AND AFTER DIRECTORY COMMAND
;<4.EXEC>EXEC3.MAC.33, 12-Mar-79 17:50:13, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXEC3.MAC.31, 6-Mar-79 09:52:48, EDIT BY OSMAN
;GET RID OF $GTJFN
;<4.EXEC>EXEC3.MAC.29, 1-Feb-79 16:08:00, EDIT BY HURLEY.CALVIN
; Make DIR,ARC find both visible and invisible files UNLESS one specifically
; says "INV"
;<4.EXEC>EXEC3.MAC.28, 26-Jan-79 15:42:09, EDIT BY OSMAN
;DON'T DISPLAY EXPIRATION DATES EXCEPT WITH XARC TURNED ON
;<4.EXEC>EXEC3.MAC.27, 26-Jan-79 15:27:03, EDIT BY OSMAN
;reallow the INVISIBLE subcommand (Take it out of XARC)
;<4.EXEC>EXEC3.MAC.26, 24-Jan-79 12:34:09, EDIT BY HURLEY.CALVIN
; Get archive pending bit from .FBBBT rather than .FBBK0
;<4.EXEC>EXEC3.MAC.25, 18-Jan-79 18:13:40, EDIT BY OSMAN
;<4.EXEC>EXEC3.MAC.24, 18-Jan-79 17:59:45, EDIT BY OSMAN
;PUT XARC AROUND INVISIBLE SUBCOMMAND
;<4.EXEC>EXEC3.MAC.23, 12-Jan-79 16:59:15, EDIT BY HURLEY.CALVIN
; RELOAD A WITH .FBCTL AT DSKRNO
;<4.EXEC>EXEC3.MAC.22, 12-Jan-79 15:53:15, EDIT BY OSMAN
;prevent display of "plus files list protected against you". (clear f1 after subcommands)
;<4.EXEC>EXEC3.MAC.21, 4-Jan-79 11:34:06, EDIT BY HURLEY.CALVIN
; Fix tests for sorting to include CHRON TAPE-WRITE
;<4.EXEC>EXEC3.MAC.20, 5-Dec-78 14:16:27, EDIT BY MILLER
;DON'T CLOBBER B WHEN DOING THE JFNS
;<4.EXEC>EXEC3.MAC.19, 2-Dec-78 14:52:07, EDIT BY MILLER
;INSERT CODE AT DSK2 TO GET GEN # FOR TAPE DEVICES
;<HURLEY.CALVIN>EXEC3.MAC.1, 8-Nov-78 20:49:05, EDIT BY HURLEY.CALVIN
; Change MOVE to HRRZ A,@INIFH1 in DSKR1
;<4.EXEC>EXEC3.MAC.17, 6-Nov-78 19:54:43, Edit by CALVIN
; CATCH REQUESTS FOR TOO MANY FDB WORDS (OLD FDB'S)
; CHECK FOR OFFLINE DIFFERENTNESS AT DFDBCM; MAKE SURE OFFLINE EXP
; HEADER PRINTED BY CHECKING 1B31 AT DHEAD1-4
;<4.EXEC>EXEC3.MAC.16, 1-Nov-78 09:23:18, EDIT BY MILLER
;ADD CODE TO DO DIR OF MT'S
;<ARC-DEC>EXEC3.MAC.10, 13-Sep-78 07:27:13, EDIT BY CALVIN
; Fix bugs in directory with OFF/ONLINE expiration dates
; Install online and offline expiration dates
;<CALVIN>EXEC3.MAC.1, 10-Aug-78 09:36:56, EDIT BY CALVIN
; Strip out TAPES subcommand
;<3-ARC-EXEC>EXEC3.MAC.5, 4-Aug-78 10:03:46, EDIT BY CALVIN
; Bugfix from BBN 3 version
;<3-ARC-EXEC>EXEC3.MAC.4, 15-May-78 18:28:05, Edit by MTRAVERS
;Fixed some non-rel-3 stuff
;<3-ARC-EXEC>EXEC3.MAC.3, 14-May-78 20:41:41, Edit by MTRAVERS
;<3-ARC-EXEC>EXEC3.MAC.2, 14-May-78 20:18:42, Edit by MTRAVERS
;<3-ARC-EXEC>EXEC3.MAC.1, 14-May-78 20:12:22, Edit by MTRAVERS
; Added all the archive stuff
;GET RID OF REFS TO SYMBOLS B0 B1 ETC
;<4.EXEC>EXEC3.MAC.11, 15-Sep-78 23:07:20, EDIT BY OSMAN
;REMOVE REFS TO CSBUF
;<4.EXEC>EXEC3.MAC.10, 14-Sep-78 11:58:15, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE NOW SEARCHES ALL ELSE
;<4.EXEC>EXEC3.MAC.9, 27-Jul-78 14:54:17, Edit by HELLIWELL
;STOP USING P6 UNDER NOSHIP
;<4.EXEC>EXEC3.MAC.8, 13-Jul-78 14:52:08, EDIT BY OSMAN
;USE LOCAL VERSION OF KEEPNM (KEPDNM)
;<4.EXEC>EXEC3.MAC.7, 13-Jul-78 14:43:03, EDIT BY OSMAN
;CHANGE TAG DIRFL1 TO DIRFL0
;<4.EXEC>EXEC3.MAC.6, 13-Jul-78 14:37:19, EDIT BY OSMAN
;MAKE SIZCN1, SIZCN2, PAGFL1, PAGFL2 BE LOCAL (DIRCN1...)
;<4.EXEC>EXEC3.MAC.5, 29-Jun-78 15:51:02, EDIT BY OSMAN
;make dirno be local
;<4.EXEC>EXEC3.MAC.3, 28-Jun-78 15:40:41, EDIT BY OSMAN
;USE TRVAR FOR VARIABLES
;<4.EXEC>EXEC3.MAC.2, 23-Jun-78 21:10:26, EDIT BY OSMAN
;REMOVE DFRDR1, FIND1A (UNREFERENCED SYMBOLS)
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH XDEF
TTITLE EXEC3
;THIS FILE CONTAINS THE 'DIRECTORY' COMMAND
;DEFINITIONS REQUIRED FOR DIRECTORY LISTER
FDBHGH==.FBFET ;HIGHEST FDB ENTRY WE'LL READ
;USED FOR $GTFDB AND WHERE TO START
;SPACE AFTERWARDS (.FBHDR THRU .FBREF
PHASE 1+FDBHGH ;OTHER INFO STARTS BEYOND GTFDB INFO
FDBCHK:! 0 ;CHECKSUM CONTROL WORD
FDBSUM:! 0 ;CHECKSUM
FDBRLN:! 0 ;REAL LENGTH STORED HERE, INCLUDING STRINGS
FDBLEN==FDBRLN+1 ;LENGTH OF FILE INFO BLOCK, NOT COUNTING STRINGS
DEPHASE
;FDIRECTORY
;FULL FILE DESCRIPTION
;INTENDED TYPICAL USE IS "FDIRECTORY <FILE NAME>" WHICH GIVES AN "EVERYTHING"
; DIRECTORY PRINTOUT FOR THE SINGLE FILE, WITHOUT EXCESS SPACES OR HEADG
;BUT IMPLEMENTATION IS LIKE "DIR" PLUS SUBCOMMANDS
; CRAM, EVERYTHING, AND NO (HEADING);
; THUS ADDITIONAL SUBCOMMANDS AND DIFFERENT ARGUMENTS (INCLUDING NONE)
; ARE POSSIBLE.
.FDIRE:: MOVX Q1,1B8!1B11!1B14!PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PLBF!DCREF!DWRF!DRDF!SCF!1B35+XARC <POEF+PONEF+>PTWF
MOVE Q2,[1B13+1B15+1B19+1B20+1B24] ;GET WRITE AND CREATE DIRS ALSO
JRST DIR0
.VDIRE:: MOVX Q1,1B8!1B11!1B14!PPF!SIZPF!PWTF!PLBF!DWRF!1B35
NOXTND,<MOVX Q2,VDIRF> ;VDIRECTORY FLAG
XTND,< MOVX Q2,VDIRF!UWRF>
JRST DIR0
XTND,<
.QD:: MOVX Q2,DFOF!VDIRF!UWRF ; Deleted files only
MOVX Q1,1B8!1B11!1B14!PPF!SIZPF!PWTF!PLBF!DWRF!1B35
JRST DIR0
.RDIRE::SETZ Q2,
MOVX Q1,1B8!1B11!1B14!SIZPF!DRDF!PRTF!1B35
TXO Z,CHRDF!REVF
JRST DIR0
.WDIRE::MOVX Q2,UCREF!UWRF
MOVX Q1,1B8!1B11!1B14!SIZPF!DWRF!PWTF!1B35
TXO Z,CHWRF!REVF
JRST DIR0
>
;DIRECTORY.
;CAN TAKE AN ARGUMENT SPECIFYING DIRECTORY OR FILES TO LIST.
;CAN BE TERMINATED WITH COMMA TO INITIATE SUBCOMMAND INPUT.
TDIS==5 ;NUMBER OF BITS TO LEFT OF DATE BITS THE TIME BITS ARE
;AC USE
; Q1 FIELDS-TO-PRINT INFO A LA JFNS JSYS CALL. (SEE ALSO RH Q2)
PONEF==1B33 ;B33: Online expiration date/interval
SCF==1B32 ;B32: SUPPRESS COLUMNATION (CRAM)
POEF==1B31 ;B31: Offline expiration date/interval
PTDF==1B30 ;B30: Tape-write Date
DRDF==1B29 ;B29: READ DATE
DWRF==1B28 ;B28: WRITE DATE
DCREF==1B27 ;B27: CREATE DATE
PLBF==1B26 ;B26: PRINT LENGTH IN BYTES
PTWF==PTDF_TDIS ;B25: Tape-write times (and dates)
PRTF==DRDF_TDIS ;B24: READ TIME (AND DATE)
PWTF==DWRF_TDIS ;B23: WRITE TIME (AND DATE)
PCTF==DCREF_TDIS ;B22: CREATION TIME (AND DATE)
SIZPF==1B21 ;B21: SIZE IN PAGES OR BLOCKS
ACCF==1B20 ;B20: ACCOUNT
PPF==1B17 ;B17: Protection
Q1NTAP==PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PLBF!DCREF!DWRF!DRDF!PTDF!POEF!PONEF!PTWF ;INVALID Q1 SUBCOMMANDS FOR MAGTAPE
; Q2 LH FLAGS FOR FORMAT, ETC:
OFFO==1B7 ; B7 Offline files only
INVFO==1B8 ; B8 Invisible files only
ARFO==1B9 ; B9 Archived files only
VDIRF==1B10 ; B10 VDIRECTORY, ONLY DIR PART OF HEADING PRINTS
FHF==1B11 ; B11 FORCE HEADING
SHF==1B13 ; B13 SUPPRESS HEADING
SMVF==1B14 ; B14 SUPPRESS MULTIPLE VERSIONS ON SAME LINE
SNEF==1B15 ; B15 SUPPRESS OMISSION OF NAME, EXT WHEN SAME AS ABOVE
DSF==1B16 ; B16 DOUBLE SPACE
DFOF==1B17 ; B17 DELETED FILES ONLY
; Q2 RH MORE "WHAT TO PRINT" FLAGS:
CHKF==1B18 ; B18 CHECKSUM FILES
UCREF==1B19 ; B19 LIST CREATE DIRECTORY
UWRF==1B20 ; B20 LIST WRITE DIRECTORY
SOF==1B21 ; B21 SUMMARY ONLY
SSF==1B22 ; B22 SUPPRESS SUMMARY
; B23 FORCE SEQUENTIAL CHECKSUM
RETF==1B24 ; B24 PRINT VERSION RETENTION COUNT
BEFORF==1B25 ; B25 "BEFORE" SWITCH GIVEN
SINCEF==1B26 ; B26 "SINCE" SWITCH GIVEN
SMALLF==1B27 ; B27 "SMALLER" SUBCOMMAND GIVEN
LARGEF==1B28 ; B28 "LARGER" SUBCOMMAND GIVEN
Q2NTAP==OFFO!INVFO!ARFO!DFOF!CHKF!UCREF!UWRF!RETF!BEFORF!SINCEF!SMALLF!LARGEF ;SUBCOMMANDS DENOTED IN Q2 THAT AREN'T ALLOWED FOR MAGTAPE
;FLAGS IN Z:
DSKF==1B26 ;DEVICE IS A DSK
MTAF==1B27 ;DEVICE IS A MAGTAPE
DECF==1B28 ;DEVICE IS A DECTAPE
PDNF==1B29 ;DIRECTORY CHANGED
; FLAGS FOR ORDER OF PRINTOUT:
CHTPF==1B30 ;B30=40 Chronological by tape write
CHWRF==1B31 ;B31=20 CHRONOLOGICAL BY WRITE DATE
CHRDF==1B32 ;B32=10 CHRON READ
CHCRF==1B33 ;B33=4 CHRON CREATION
ALPHAF==1B34 ;B34=2 ALPHABETIC
REVF==1B35 ;B35=1 INVERSE ALPHABETIC OR CHRONOLOGICAL
; LH Z:
; F1: ON IF LIST ACCESS VIOLATION(S)
; F2: ON IF MORE FILES TO LIST FOR THIS IFH
; F3: ON IF MORE THAN ONE ARGUMENT IN LIST
SORTF==CHWRF!CHRDF!CHTPF!CHCRF!ALPHAF ;SOME SORT OF SORTING NEEDED
.TDIRE:: TXO Z,CHWRF!REVF ;CHRON BY WRITE DATE, REVERSE
SKIPA Q1,[1B8!1B11!1B14!PWTF!DWRF] ;WRITE TIME, DATE
.DIREC:: MOVX Q1,1B8!1B11!1B14!1B35
SETZ Q2, ;DEFAULT: NO SPECIAL FORMAT
;"VDIRECTORY" JOINS HERE
DIR0: TRVAR <TABLNX,NOFLG,SAVPTR,REALP2,SAVQ3,SVDCNT,DIRJFN,DCNT,NEWPTR,CELADR,TPWRNF,REALQ2,GRANDF,TAPJFN,<DSBUF,FILWDS>,DIRCN1,DIRCN2,DIRFL1,DIRFL2,DIRNO,BEFDAT,BATCN1,BATCN2,BLKCN1,BLKCN2,CHKCN0,CHKCN1,CHKCN2,CHKPSV,ERRCN1,ERRCN2,FILCN1,FILCN2,FNDPTR,LFPOS,LPEXT,LPFDB,LPNAME,LRGSIZ,LSTPAG,NAMDIR,PNTCNT,SINDAT,SMLSIZ,KEPDNM>
NOISE <OF FILES>
SETZM KEPDNM ;INITIALIZE TO NO "FIND"
SETZM LPFDB
SETZM DIRJFN ;NO SPECIAL JFN YET
SETZM GRANDF ;NO REQUESTING GRAND TOTAL YET
XTND,<
SETOM TYPING ; TYPEOUT HAPPENING
>
;DECODE ARGUMENT LIST WITH SUBROUTINE "DIRARG" IN SUBRS.MAC.
;THIS INPUTS A FILE GROUP (NAMES WITH "*" ALLOWED,
;MULTIPLE NAMES ALLOWED, -2 RETURNED FOR NO SUCH FILE, ETC.)
;DEFAULTS NOTHING TO WHOLE CONNECTED DIRECTORY;
;INTERPRETS COMMA OR EOL TERMINATOR TO THE
;WORD "DIRECTORY".
PUSH P,Z ; Save flags
TXO Z,IGINV ; Find invisible files
CALL DIRARG
JRST [ POP P,A ; Get flags back
TXZ Z,IGINV ; Set IGINV as before
TXNE A,IGINV
TXO Z,IGINV
SUBCOM $DIRS ;INPUT SUBCOMMANDS FROM TABLE $DIRS
JRST DIRSB1]
POP P,A
TXZ Z,IGINV
TXNE A,IGINV
TXO Z,IGINV
DIRSB1: SKIPE KEPDNM ;DOING "FIND"?
TXNN Q2,CHKF ;YES, ALSO CHECKSUM?
CAIA ;NO
TYPE <%Can't summarize checksums during "FIND"
>
;EXECUTE "DIRECTORY"
;OPEN OUTPUT FILE, IF ANY.
SKIPN A,DIRJFN ;OUTJFN
JRST DIRREG ;NO SPECIAL JFN
MOVEI B,1B20 ;WRITE.
CALL $OPEN7 ;OPEN, 7 BIT BYTES, MODE 0.
MOVE A,DIRJFN
MOVEM A,COJFN ;SET UP STANDARD OUTPUT STREAM TO BE FILE
DIRREG: SETZM TPWRNF ;HAVEN'T WARNED ABOUT BAD SUBCOMMANDS YET
MOVE A,INIFH1 ;PTR TO FIRST JFN IN BUFFER
CAMGE A,INIFH2 ;PTR TO LAST
TLO Z,F3 ;SET FLAG IF MORE THAN 1JFN
SETZM NAMDIR ;NAME OF PREVIOUS DIRECTORY PRINTED (0 IS ILLEGAL)
SETOM DIRCN1
SETOM DIRCN2
SETOM BLKCN1
SETOM BLKCN2
SETZM CHKCN1
SETZM CHKCN2
SETZM FILCN1
SETZM FILCN2
SETZM BATCN1
SETZM BATCN2
SETZM ERRCN1
SETZM ERRCN2
SETZM DIRFL1
SETZM DIRFL2
SETOM PNTCNT
TLZ Z,F1!F2 ;NO LIST ERRORS YET, NO OLD JFN
MOVEM Q2,REALQ2 ;REMEMBER WHAT USER REQUESTED
MOVEM Q1,REALP2 ;REMEMBER OTHER ITEMS USER REQUESTED
;COME BACK HERE TO PROCESS NEXT ARGUMENT IN LIST
DIRFL: CALL UNMDR1 ;UNMAP DIRECTORY BUFFER PAGES, THUS 0ING THEM
TLNN Z,F2 ;DON'T PRINT HEADING IF FINISHING OLD JFN
TXO Z,PDNF ;SAY DIRECTORY CHANGED
HRRZ A,@INIFH1 ;SEE IF REAL JFN NEXT
CAIE A,FI%ERR ;IS THIS AN ERRONEOUS JFN?
JRST DI3 ;NO
CALL DFREST ;FINISH PREVIOUS FILESPEC BEFORE HANDLING ERROR
HLRZ A,@INIFH1 ;YES, GET ADDRESS OF ERROR BLOCK
MOVE B,.FIJFN(A) ;GET JFN
MOVE A,CSBUFP ;SOME BUFFER SPACE
MOVX C,FLD(.JSAOF,JS%DEV)!JS%PAF ;GET PUNCTUATED DEVICE FIELD
JFNS ;GET IT (I CAN'T IMAGINE THIS JFNS CAN FAIL)
MOVE B,CSBUFP ;POINT TO THE DEVICE
MOVX A,GJ%SHT ;REGULAR GTJFN
CALL GTJFS ;GET HANDLE ON THE TAPE FOR REWINDING IT
JRST DI3 ;IF THIS FAILS, GIVE ORIGINAL ERROR
MOVEM A,TAPJFN ;SAVE HANDLE ON TAPE
DVCHR ;SEE IF THIS IS A MAGTAPE
LOAD A,DV%TYP,B
CAIE A,.DVMTA ;MAGTAPE?
JRST DI3 ;NO, GIVE ORIGINAL ERROR
MOVE A,TAPJFN ;GET JFN TO REWIND THE TAPE
CALL REWIND ;REWIND THE TAPE
MOVE A,[.NULIO,,.NULIO] ;DON'T LET GTJFN READ FROM REAL TERMINAL!
MOVEM A,.GJSRC+CJFNBK
MOVX A,GJ%OLD!GJ%IFG!.GJALL ;OLD FILE, ALLOW WILDCARDING, DEFAULT TO ALL GENERATIONS
MOVEM A,.GJGEN+CJFNBK
HRROI A,[ASCIZ /*/] ;DEFAULT ALL FILESPEC FIELDS TO STARS
MOVEM A,.GJNAM+CJFNBK ;SO "MT1:" = "MT1:*.*.*"
MOVEM A,.GJEXT+CJFNBK
HLRZ A,@INIFH1 ;POINT TO BLOCK AGAIN
HRROI B,.FISTR(A) ;GET POINTER TO FILESPEC THAT USER TYPED
MOVEI A,CJFNBK ;ASSUME OTHER DEFAULTS ARE CORRECT IN BLOCK
CALL GTJFS ;GET "REAL" JFN ON TAPE FILE
JRST DI3 ;IF THIS FAILS, GIVE USER ORIGINAL ERROR
EXCH A,@INIFH1 ;STORE NEW REAL JFN; GET OLD ONE
MOVE B,JBUFP ;SEE WHERE WE ARE ON JFN STACK
MOVEM A,(B) ;LEAVE OLD JFN ON STACK SO IT GETS FLUSHED LATER
TXO Z,MTAF ;REMEMBER WE'VE GOT A MAGTAPE
JRST DDIR ;GO DO DIRECTORY OF IT
DI3: PUSHJ P,NXFILE ;CHECK AND PRINT MESSAGE FOR NON-EX FILES
JRST [ SKIPE INIFH1 ;ALL TERMS DONE?
JRST DIRFL ;NO, DO NEXT
JRST DIRFL0] ;ALL DONE
TLZE Z,F2 ;DOING MORE OF SAME JFN?
JRST DDIR ;YES, SO WE KNOW WHAT KIND OF DEVICE IT IS
HRRZ A,@INIFH1
DVCHR
LDB B,[POINT 9,B,17] ;DEVICE TYPE
TXZ Z,MTAF!DSKF!DECF ;CLEAR SPECIAL DEVICE FLAGS
JUMPE B,[ TXO Z,DSKF ;REMEMBER IT'S A DISK
JRST DDIR]
CAIN B,.DVMTA ;IS THIS AN MT?
JRST [ TXO Z,MTAF ;YES. REMEMBER THAT
HRRZ A,@INIFH1 ;MIGHT AS WELL USE THAT JFN FOR THE TAPE JFN
MOVEM A,TAPJFN ;REMEMBER TAPE JFN
CALL REWIND ;REWIND THE TAPE
MOVE B,@INIFH1 ;GET JFN AGAIN
MOVE A,CSBUFP ;SOME STRING SPACE
MOVEI C,0 ;STANDARD OUTPUT
JFNS ;GET STRING FOR WHAT HE TYPED
MOVX A,GJ%IFG!GJ%OLD!GJ%SHT ;ALLOW STARS, FILE MUST EXIST, SHORT FORM
MOVE B,CSBUFP ;POINT TO STRING
CALL GTJFS ;GET HANDLE ON FIRST FILE TO LIST
CALL CJERRE ;SHOULDN'T FAIL, I DON'T THINK.
EXCH A,@INIFH1 ;USE THIS NEW JFN
MOVE B,JBUFP ;GET ADDRESS OF NEW JFN
MOVEM A,(B) ;COMPLETE THE SWAP ON THE JFN STACK
JRST DDIR] ;AND PROCEED
NOSHIP,< CAIE B,.DVDTA ;DECTAPE?>
ERROR <Illegal device>
NOSHIP,<
;DECTAPE. DEV DESIGNATOR IN A.
TXO Z,DECF ;SAY DECTAPE
CALL DTADIR ;SETUP DIRECTORY INFO
>
;DISK
;Q1,Q2, AND Z STILL CONTAIN VARIOUS FLAGS (SEE ABOVE)
DDIR: CALL DSKDIR ;LIST IT
;DONE A DEVICE OR DIRECTORY.
;F2 SET IF MORE FILES FOR THIS JFN.
TLNE Z,F2
JRST DIRFL ;GO DO NEXT ONE FOR THIS JFN
;(ALREADY GNJFN'D).
MOVE A,TAPJFN ;GET JFN ON TAPE
TXNE Z,MTAF ;IS THIS A MAGTAPE?
CALL REWIND ;YES, REWIND IT
AOS A,INIFH1 ;STEP POINTER INTO JFN BUFFER
CAMG A,INIFH2 ;BEYOND END?
JRST DIRFL ;NO
DIRFL0: CALL DFREST ;FINISH VERY LAST LINE
CALL UNMDIR ;UNMAP BUFFERS
CALL CNTDMP ;DUMP OUT LAST COUNTS
TXNN Q2,SSF ;SKIP IF SUPPRESSING SUMMARY
SKIPG PNTCNT
JRST NGRAND
MOVE A,DIRCN2
MOVEM A,DIRCN1
MOVE A,BLKCN2
MOVEM A,BLKCN1
MOVE A,CHKCN2
MOVEM A,CHKCN1
MOVE A,FILCN2
MOVEM A,FILCN1
MOVE A,BATCN2
MOVEM A,BATCN1
MOVE A,ERRCN2
MOVEM A,ERRCN1
MOVE A,DIRFL2
MOVEM A,DIRFL1
SETOM GRANDF ;SAY WE WANT GRAND
CALL CNTDMP
NGRAND: SKIPE BATCN2 ;ANY BAT FILES?
TXNE Q2,SOF ;YES, DID WE PRINT "*"?
CAIA ;NO
ETYPE <%_* Indicates file(s) with possible data errors%_>
RET
;UNMDIR
;SUBROUTINE TO UNMAP PAGES USED AS BUFFERS IN LISTING DIRECTORIES
;CLOBBERS A-D. ALSO USED IN LIST/TYPE.
UNMDIR::SETO A,
MOVE B,[XWD .FHSLF,<BUF0>B44]
MOVEI C,1
PMAP
UNMDR1: SETO A,
MOVE B,[XWD .FHSLF,<BUF1>B44]
MOVE C,[PM%CNT+<BUFL-BUF1>B44+1]
PMAP
RET
;DIRECTORY...
;SUBCOMMAND TABLE
$DIRS: TABLE
T ACCOUNT,ONEWRD,...ACC
T ALPHABETICALLY,
T ARCHIVE,,.AROLY ; Archived files only
T BEFORE ;ONLY LIST FILES WRITTEN "BEFORE" GIVEN TIME AND DATE
T CHECKSUM,
T CHRONOLOGICAL,
T CRAM,
T DATES,
T DELETED,,..DELE
T DOUBLESPACE,
T EVERYTHING,ONEWRD
T FIND,,..FIND
T GENERATION-RETENTION-COUNT,ONEWRD,.VERSI
T HEADING,ONEWRD
T INVISIBLE,,.INOLY ; Invisible files only
T LARGER ;ONLY FILES "LARGER" THAN SPECIFIED SIZE
T LENGTH,
T LPT,
T NO,,..NO
T OFFLINE,,.OFOLY ; Offline files only
T OUTPUT,
T PROTECTION,ONEWRD,..PROT
T REVERSE,
T SEPARATE,
T SINCE ;ONLY FILES WRITTEN "SINCE" GIVEN TIME AND DATE
T SIZE,,..SIZE
T SMALLER ;ONLY FILES "SMALLER" THAN SPECIFIED SIZE
T TIMES,
T USER,
TEND
;SUB-COMMAND ROUTINES FOR "DIRECTORY" COMMAND
...ACC: TRO Q1,ACCF
RET
.NACCO: TRZ Q1,ACCF ;NO ACCOUNTS
RET
.ALPHA: NOISE <SORTED>
CONFIRM
TXZ Z,SORTF ;CLEAR ORDER OF PRINTOUT FLAGS
TXO Z,ALPHAF
RET
.CHRON: NOISE <BY>
KEYWD $CHRON
T WRITE,,CHWRF ;NULL DEFAULTS TO THIS
JRST CERR ;NOT FOUND IN TABLE
CONFIRM
TXZ Z,SORTF ;CLEAR FLAGS RELATED TO ORDER OF PRINTOUT
IOR Z,P3 ;PUT IN THOSE FROM RESPONSE DECODING
RET
$CHRON: TABLE
T CREATION,,CHCRF
T READ,,CHRDF
T TAPE-WRITE,,CHTPF
T WRITE,,CHWRF
TEND
.HEADI: TXO Q2,FHF
RET
;DIRECTORY SUB-COMMANDS...
.CHECK: NOISE (FILES)
KEYWD $CHECK
T BY-PAGES,,..CHKP
JRST CERR
CALL (P3) ;PRINT NOISE, GET BIT
CONFIRM
TXO Q2,CHKF ;CHECKSUM
TRZ Q2,1B23 ;CLEAR PREVIOUS SETTING
TRO Q2,(P3) ;SET THIS ONE
RET
$CHECK: TABLE
T BY-PAGES,,..CHKP
T SEQUENTIALLY,,..CHKS
TEND
.NCHEC: TXZ Q2,CHKF ;NO CHECKSUM
RET
..CHKP: NOISE <ON DISK>
SETZ P3,
RET
..CHKS: NOISE <ALWAYS>
MOVEI P3,1B23
RET
.CRAM: NOISE <OUTPUT>
TXO Q1,SCF
RET
.NCRAM: TXZ Q1,SCF ;NO CRAM
RET
.NDATE: SETOM NOFLG ;REMEMBER "NO"
JRST DATES0
.DATES: SETZM NOFLG ;SAY "YES"
DATES0: NOISE <OF>
TLZ Z,F1
DATES1: KEYWD $DATES ;"TIMES" JOINS HERE
T WRITE,,DWRF
JRST CERR
CONFIRM
MOVEI P3,(P3)
MOVE A,P3 ;GET THE DATE BITS
TLNE Z,F1
LSH P3,TDIS ;TIME BITS ARE TDIS BITS TO LEFT OF DATE BITS
IOR P3,A ;ACCUMULATE DATE BITS INTO TIME BITS
SKIPN NOFLG ;DIFFERENT ACTION ON "NO"
IORI Q1,(P3) ;UPDATES JFNS OPTIONS FROM TABLE
SKIPE NOFLG
TDZ Q1,P3 ;TURN OFF INSTEAD OF ON IF "NO"
RET
.NTIME: SETOM NOFLG ;REMEMBER "NO"
JRST NTIME0
.TIMES: SETZM NOFLG ;SAY "YES"
NTIME0: NOISE <AND DATES OF>
TLO Z,F1
JRST DATES1
$DATES: TABLE
T CREATION,,DCREF
XARC <
T OFFLINE-EXPIRATION,,POEF
T ONLINE-EXPIRATION,,PONEF
>
T READ,,DRDF
T TAPE-WRITE,,PTDF
T WRITE,,DWRF
TEND
.NUSER: SETOM NOFLG
JRST USER0 ;NO USER
.USER: SETZM NOFLG ;SAY "YES"
USER0: NOISE <WHO LAST>
KEYWD $USERS
T WROTE,
JRST CERR
JRST (P3)
$USERS: TABLE
T CREATED,
T WROTE,
TEND
.WROTE: NOISE <FILE>
CONFIRM
SKIPN NOFLG
TXO Q2,UWRF
SKIPE NOFLG
TXZ Q2,UWRF ;TURN OFF IF NO
RET
.CREAT: NOISE <FILE>
CONFIRM
SKIPN NOFLG
TXO Q2,UCREF
SKIPE NOFLG
TXZ Q2,UCREF ;TURN OFF IF NO
RET
.AROLY: NOISE <Files only>
CONFIRM
TXO Q2,ARFO
RET
.INOLY: NOISE <Files only>
CONFIRM
TXO Q2,INVFO
RET
.OFOLY: NOISE <Files only>
CONFIRM
TXO Q2,OFFO
RET
..DELE: NOISE <FILES ONLY>
CONFIRM
TLO Q2,1 ;SAY DELETED FILES ONLY
RET
.DOUBL: NOISE <OUTPUT LINES>
CONFIRM
TXO Q2,DSF ;SAY DOUBLE SPACE
RET
.NDOUB: TXZ Q2,DSF ;NO DOUBLESPACE
RET
.EVERY: IOR Q1,[XARC <POEF+PONEF>+001111177703] ;ALL FIELDS THAT CAN BE PRINTED
TDO Q2,[1B15+UCREF+UWRF+RETF] ;GET WRITE AND CREATE DIRS ALSO
RET ;THIS IS TOO MUCH TO FIT ONE TTY LINE.
..FIND: NOISE <FILES WITH MORE THAN>
DEFX <1> ;DEFAULT IS 1
DECX <Number of generations>
CMERRX
CAIN B,1
NOISE <GENERATION>
CAIE B,1
NOISE <GENERATIONS>
CONFIRM
MOVEM B,KEPDNM ;STORE NUMBER OF VERSIONS HERE
RET
.LENGT: NOISE <IN BYTES>
CONFIRM
TXO Q1,PLBF ;SAY PRINT LENGTH IN BYTES
RET
.NLENG: TXZ Q1,PLBF ;NO LENGTH
RET
;DIRECTORY SUB-COMMANDS...
;"LPT" IS SHORT FOR "OUTPUT (TO) LPT:"
.LPT:: CALL FINLPT ;FINISH THE SUBCOMMAND
MOVEM A,DIRJFN ;REMEMBER OUTPUT JFN
RET
.NLPT: SETZM DIRJFN ;FORGET LPT JFN
RET
;SUBROUTINE USED BY SYSTAT AND DIRECTORY FOR SUBCOMMAND TO ESTABLISH
;LPT AS OUTPUT DEVICE
FINLPT:: NOISE <IS OUTPUT DEVICE>
CONFIRM
CALLRET GETLPT ;GET JFN ON LPT AND RETURN
GETLPT:: MOVSI A,(GJ%FOU!GJ%NEW!GJ%SHT)
MOVE B,[POINT 7,[ASCIZ /LPT:/],-1]
CALL GTJFS ;GET AND STACK JFN
CALL CJERRE ;PROBABLY "LPT" SUBCOMMAND WHEN LPT: DEFINED AS JUNK:
RET
.OUTPU: NOISE <TO FILE>
MOVE A,[XWD [ASCIZ /DIR/],[ASCIZ /DIR/]] ;DEFAULT NAME & EXT
CALL COUTFN
JRST CERR
CONFIRM
MOVEM A,DIRJFN ;ESTABLISH OUTPUT DEVICE
RET
..NO: KEYWD $$NO
T HEADING,,.NHEAD
JRST CERR
JRST (P3)
$$NO: TABLE
T ACCOUNT,ONEWRD,.NACCO
T CHECKSUM,ONEWRD,.NCHEC
T CRAM,ONEWRD,.NCRAM
T DATES,,.DATES
T DOUBLESPACE,ONEWRD,.NDOUBL
T FILE-LINES,ONEWRD,.NFILE
T GENERATION-RETENTION-COUNT,ONEWRD,.NGENE
T HEADING,ONEWRD,.NHEAD
T LENGTH,ONEWRD,.NLENG
T LPT,ONEWRD,.NLPT
T PROTECTION,ONEWRD,.NPROT
T REVERSE,,.NREVER
T SEPARATE,ONEWRD,.SEPAR
T SIZE,ONEWRD,.NSIZE
T SUMMARY-LINES,ONEWRD,.NSUMM
T TIMES,,.NTIME
T USER,,.NUSER
TEND
.NFILE: TXO Q2,SOF
RET
.NSUMM: TXO Q2,SSF
RET
.NHEAD: TLO Q2,(1B13) ;GRNTEE NO HEADER
TXZ Q2,FHF ;CLEAR THIS ALSO
RET
..PROT: TXO Q1,PPF ;PRINT PROTECTION
RET
.NPROT: TXZ Q1,PPF ;NO PROTECTION
RET
.REVER: NOISE <SORTING>
CONFIRM
TXO Z,REVF ;SAY LIST IN REVERSE ORDER
RET
.NREVE: NOISE (SORTING)
CONFIRM
TXZ Z,REVF ;NO REVERSE
RET
;SINCE (TIME AND DATE) ONLY LIST FILES WRITTEN SINCE CERTAIN DATE
.SINCE: NOISE (DATE AND TIME)
DTPX <
Only files written more recently than specified date and time will be listed>
CMERRX <Invalid SINCE subcommand>
CONFIRM
MOVEM B,SINDAT ;REMEMBER WHAT DATE SUPPLIED
TXO Q2,SINCEF ;REMEMBER THAT SINCE SUBCOMMAND GIVEN
RET
;BEFORE (DATE AND TIME) ONLY LIST FILES WRITTEN BEFORE CERTAIN DATE
.BEFOR: NOISE (DATE AND TIME)
DTPX <
Only files written earlier than specified date and time will be listed>
CMERRX <Invalid BEFORE subcommand>
CONFIRM
MOVEM B,BEFDAT
TXO Q2,BEFORF
RET
;SMALLER (THAN) ONLY LIST SMALL FILES
.SMALL: NOISE (THAN)
DECX <Only files smaller than specified decimal number of pages will be listed>
CMERRX <Invalid SMALLER subcommand>
CONFIRM
MOVEM B,SMLSIZ ;SAVE UPPERBOUND ON SIZE
TXO Q2,SMALLF ;NOTE THAT THIS SUBCOMMAND GIVEN
RET
;LARGER (THAN) ONLY LIST LARGE FILS
.LARGE: NOISE (THAN)
DECX <Only files larger than specified decimal number of pages will be listed>
CMERRX <Invalid LARGER subcommand>
CONFIRM
MOVEM B,LRGSIZ
TXO Q2,LARGEF
RET
.SEPAR: NOISE (LINES FOR EACH FILESPEC)
CONFIRM
TXO Q2,SMVF!1B15
RET
.NSEPA: TXZ Q2,SMVF!1B15 ;NO SEPARATE
RET
..SIZE: NOISE <IN PAGES OR BLOCKS>
CONFIRM
TXO Q1,SIZPF
RET
.NSIZE: TXZ Q1,SIZPF ;NO SIZE
RET
.VERSI: TXO Q2,RETF ;CAUSE GENERATION-RETENTION-COUNT TYPEOUT
RET
.NGENE: TXZ Q2,RETF ;NO GENERATION-RETENTION-COUNT
RET
;DHEAD
;TYPE HEADING, IF ANY, FOR DISK FILE DIRECTORY PRINTOUT.
;THIS ROUTINE MUST BE CHANGED WHENEVER DFILE'S FORMAT IS CHANGED!
;TAKES: Q1: FIELDS TO PRINT BITS
; Q2: B13 TO SUPPRESS HEADING
DHEAD:
NOSHIP,<
TXNE Z,DECF
JRST DTAHDR ;DECTAPE HEADER IS DIFFERENT
>;NOSHIP
PUSH P,A
TXNE Q2,FHF ;WANT TO FORCE HEADER?
JRST DHEAD1 ;YES - SKIP OTHER TESTS
TXNE Q2,VDIRF!SHF!SOF ;"VDIRECTORY","SUPP. HEAD.", "DTA", OR "SUMMARY" FLAGS ON?
JRST DHEADZ ;YES, NO HEADING
TXNN P2,SIZPF+DCREF+DWRF+DRDF+PLBF+PCTF+PWTF+PRTF+PTDF+POEF+PONEF+PTWF ;ANYTHING TO LIST AFTER ACCT FIELD?
TXNE Q2,CHKF+UCREF+UWRF+RETF ;ANY OF THIS MAGIC?
CAIA ;YES, HEADER
JRST DHEADZ ;NO, NON-VERBOSE LISTINGS GET NO HEADING
DHEAD1: PUSH P,B
PUSH P,C
CALL DINDNT ;INDENT THE RIGHT AMOUNT FOR FIELDS TO PRINT
;PRINT HEADERS FOR THE COLUMNS TO BE INCLUDED IN THIS LISTING
MOVEI C,0 ;FIRST ASSUME SUPPRESSING COLUMNATION
TXNN P2,SCF ;ARE WE?
HRROI C,[ASCIZ / /] ;NO, SO PUT SPACES IN
TXNE P2,SIZPF ;SIZE IN PAGES
ETYPE <PGS >
TXNE P2,PLBF ;SIZE IN BYTES
ETYPE <Bytes(SZ) %3M>
TXNE Q2,RETF ;GENERATION RETENTION COUNT
ETYPE <Ret %3M>
TXNE P2,DCREF+PCTF ;CREATION DATE
ETYPE <Creation %3M>
TXNE P2,PCTF ;CREATION TIME
ETYPE < %3M>
TXNE P2,DWRF+PWTF
ETYPE <Write %3M>
TXNE P2,PWTF
ETYPE < %3M>
TXNE P2,DRDF+PRTF
ETYPE <Read %3M>
TXNE P2,PRTF
ETYPE < %3M>
TXNE P2,PTDF+PTWF
ETYPE <Tape-write %3M>
TXNE P2,PTWF
ETYPE < %3M>
TXNE P2,PONEF
ETYPE <Online expiration%3M>
TXNE P2,POEF
ETYPE <Offline expiration%3M>
TXNE Q2,UCREF
ETYPE <Creator %3M>
TXNE Q2,UWRF
ETYPE <Writer %3M>
TXNE Q2,CHKF
ETYPE <Checksum>
ETYPE <%_%%_>
POP P,C
POP P,B
DHEADZ: POP P,A
RET
;DINDNT: SUBR TO INDENT THE RIGHT AMOUNT BEFORE HEADING,
; AS A FUNCTION OF FIELDS TO BE PRINTED.
;ALSO USED BY DFREST WHEN GOING TO A NEW LINE.
DINDNT: PRINT .CHTAB ;NAME, EXT, VERSION CROSS FIRST TAB STOP
TXNE P2,PPF ;PROTECTION, IF REQUESTED IN PRINTOUT,
PRINT .CHTAB ;CROSSES ANOTHER TAB STOP.
TRNE P2,1B19!ACCF ;ACCT CROSSES ANOTHER.
PRINT .CHTAB
TXNN P2,SCF ;UNLESS COLUMNATION SUPPRESSED,
PRINT .CHTAB ;FOLLOWING FIELDS BEGIN AT NEXT TAB STOP
RET
;DNAME
;SUBROUTINE TO TYPE DIRECTORY NAME IF "*" GIVEN
;FOR DIRECTORY OR IF MORE THAN ONE ARGUMENT
;IN LIST OR IF OUTPUT NOT TO TERMINAL.
DNAME: MOVE Q2,REALQ2 ;START WITH ALL THE FLAGS
MOVE P2,REALP2 ;ALL FOR DISK
CALL DFREST ;PRINT REST OF LAST LINE
TLZN Z,F1 ;ANY LIST ACCESS ERRORS?
JRST DSKP5
TLNN Z,GROUPF
TYPE < LIST protection violation
> ;FOR A SINGLE FILE
TLNE Z,GROUPF
TYPE < Plus file(s) that are LIST protected from you
>
DSKP5: SETZM LPNAME ;NOT "SAME NAME AS PREVIOUS" YET
SETZM LPEXT
NOSHIP,<
TXNE Z,DECF
AND P2,[7B8+7B11+SIZPF+DWRF+PWTF] ;DECTAPE
>
TXNN Z,MTAF ;NO. IS THIS A TAPE?
JRST DSKP0 ;NO WARNINGS NECESSARY
MOVEI A,0 ;SEE IF WARNING NEEDED
TXZE P2,Q1NTAP ;TURN OFF ALL OPTIONS ILLEGAL FOR TAPE
MOVEI A,1 ;SAY WARNING NEEDED
TXZE Q2,Q2NTAP ;SEE IF ANY ILLEGAL COMBINATIONS REQUESTED HERE
MOVEI A,1 ;YES!
CAIE A,0 ;PRINT WARNING IF ANY VIOLATIONS
SKIPE TPWRNF ;HAVE WE ALREADY WARNED ABOUT TAPE?
CAIA
ETYPE <%%Invalid options for magtape being ignored%_>
SETOM TPWRNF ;DON'T GIVE WARNING MORE THAN ONCE!
DSKP0: TXNE Q2,SHF ;HEADING SUPPRESS?
TXNN Q2,SSF ;YES, OK IF NO SUMMARY
CAIA ;BUT MUST HAVE IT OTHERWISE
RET
PUSH P,A
PUSH P,B
PUSH P,C
HRROI A,DSBUF ;JFNS TO STRING BUFFER
SETZM DSBUF ;SO WE'LL KNOW IF SOMETHING GETS WRITTEN
HRRZ B,@INIFH1 ;JFN OF CURRENT ARG
MOVE C,[1B2+1B5+1B35] ;PRINT DEV, PRINT DIR, PUNCUATE
NOSHIP,<
TXNN Z,DECF ;DECTAPE: DEVICE ONLY
>
TXNE Z,MTAF ;IS THIS A MAGTAP
MOVE C,[2B2+1B35] ;YES. GET DEVICE ONLY THEN
JFNS
ERJMP R
SKIPN DSBUF
JRST DNAMEX ;NULL STRING, PRINT NOTHING
NOSHIP,<
TXNE Z,DECF
JRST [ SETZM NAMDIR
JRST DNAME8] ;DTA: BESURE HEADING, ETC WILL PRINT
>
TXNE Z,MTAF ;IS THIS AN MT?
JRST [ SETZM NAMDIR
JRST DNAME8] ;YES. NO DIRECTORY THEN
PUSH P,A
MOVSI A,(RC%EMO) ;NO RECOGNITION ALLOWED
HRROI B,DSBUF
RCDIR
MOVEM C,DIRNO ;SAVE DIRECTORY NUMBER
POP P,B
MOVE A,DIRNO
CAMN A,NAMDIR
JRST DNAMEX ;NO CHANGE, DON'T PRINT AGAIN
MOVEM A,NAMDIR
DNAME8: CALL CNTDMP
TXNN P2,SCF ;SKIP INITIAL CR IN CRAM FORMAT FOR "VDIRECTORY"
ETYPE <%_> ;BLANK LINE ABOVE DIRECTORY
HRROI B,DSBUF
ETYPE < %2M%%_>
CALL DHEAD ;PRINT HEADINGS
TXNE Q2,DSF
ETYPE <%_> ;EXTRA EOL IF DOUBLE-SPACING
DNAMEX: POP P,C
POP P,B
POP P,A
RET
;CNTDMP
;SUBROUTINE TO DUMP SIZE, LENGTH, CHECKSUM TOTALS
CNTDMP: TXNN Q2,SSF ;SUPPRESSING SUMMARY?
SKIPG A,FILCN1 ;NO, ANY FILES IN THIS TERM?
RET ;RETURN IMMEDIATELY IF NO FILES
CAIN A,1 ;IF ONLY 1 FILE,
TXNE Q2,SOF ;AND NOT SUMMARY ONLY
CAIA ;NOPE
JRST CNTDM9 ;THEN NO PRINT, BUT RESET COUNTERS
ETYPE <%_>
HRROI B,[ASCIZ/ Total of /]
SKIPE GRANDF ;REQUESTING "GRAND"?
HRROI B,[ASCIZ/ Grand total of /] ;YES
ETYPE <%2M>
TXNN P2,SIZPF ;SIZE REQUESTED?
JRST CNTDM2
SKIPGE B,DIRCN1
JRST CNTDM0
ETYPE <%2Q page>
MOVE C,DIRCN1
CAIE C,1
TYPE <s>
SKIPL BLKCN1
TYPE < and >
CNTDM0: SKIPGE B,BLKCN1
JRST CNTDM1
ETYPE <%2Q block>
MOVE C,BLKCN1
CAIE C,1
TYPE <s>
CNTDM1: TYPE < in >
CNTDM2: MOVE B,FILCN1
ETYPE <%2Q file>
MOVE C,FILCN1
CAIE C,1
PRINT "s"
TXNN Q2,CHKF ;CHECKSUM?
JRST CNTDM3
SKIPE KEPDNM ;CAN'T GET CORRECT SUMMARY WITH THIS
JRST CNTDM4 ;JUST SUMMARIZE FILE ERRORS
TYPE <, Checksum = >
HLRZ B,CHKCN1
HRRZ C,CHKCN1
ADD C,B
HLRZ B,C
ADDI B,(C)
MOVE C,[1B0+1B2+1B3+6B17+10]
MOVE A,CSBUFP ;WRITE NUMBER TO TEMPORARY BUFFER
NOUT
CALL JERRC
MOVE A,CSBUFP
ETYPE <%1M> ;TYPE THE NUMBER
SKIPN B,DIRFL1
JRST CNTDM4
CAMN B,FILCN1 ;IF SAME AS NUMBER OF FILES,
JRST [ HRROI B,[ASCIZ/ P/] ;JUST PRINT "P"
JRST CNTDM6]
MOVE B,DIRFL1
ETYPE <, %2q>
HRROI B,[ASCIZ/ by pages/]
CNTDM6: ETYPE <%2M>
CNTDM4: SKIPN ERRCN1
JRST CNTDM3
MOVE B,ERRCN1
ETYPE <, with %2q checksum error>
MOVE C,ERRCN1
CAIE C,1
TYPE <s>
CNTDM3: SKIPN BATCN1
JRST CNTDM5
MOVE B,BATCN1
ETYPE <, %2q file>
MOVE C,BATCN1
CAIE C,1
TYPE <s>
TYPE < with possible data errors>
CNTDM5: ETYPE <%_>
CNTDM9: AOS PNTCNT ;COUNT A SUBTOTAL EVEN IF WE DON'T PRINT IT
SETOM DIRCN1
SETOM BLKCN1
SETZM CHKCN1
SETZM FILCN1
SETZM BATCN1
SETZM ERRCN1
SETZM DIRFL1
RET
;DTADIR
NOSHIP,<
DTADIR: TRNN Z,76 ;ORDERING SPECIFIED?
TXO Z,ALPHAF ;NO, DEFAULT TO ALPHABETIC
;DSKDIR...
;DECTAPE SPECIFIC PROCESSING.
;FORMAT OF THE DIRECTORY BLOCK ON DECTAPE:
; WORDS 0-82: 5-BIT "SLOTS", 1 PER BLOCK: 0 FREE,
; 1-22 FILE NUMBER
; 27 DIRECTORY & TENDUMP BLOCKS
; WORDS 83-104: NAMES OF FILES 1-22
; WORDS 105-126: LH: EXT. B24-35: WRITE DATE.
;READ DIRECTORY
MOVEI B,DTADRC ;WHERE TO READ IT. DEV DESIG STILL IN A.
RDDIR ;READ IT
CALL [ CAIN A,RDDIX1
ERROR <Trouble reading directory,
maybe dectape not on "REMOTE">
JRST CJERR]
;SCAN "SLOTS" PORTION OF DIRECTORY, COUNTING BLOCKS IN FILES
MOVE B,[POINT 5,DTADRC,-1] ;5 BITS PER BLOCK ON TAPE
MOVEI C,^D578 ;# BLOCKS ON TAPE
ILDB D,B ;FETCH A SLOT BYTE
AOS DTATBL(D) ;INDEX APPROPRIATE TABLE WORD
SOJG C,.-2
RET
;TYPE # FREE BLOCKS
;SUPPRESS IF NOT LISTING WHOLE DIRECTORY ??
DTAHDR: TXNE P2,SCF
RET ;OMIT IN CRAM FORMAT (VDIRECTORY)
PUSH P,A
SKIPN DTADRC+^D127
JRST DTFRE0 ;NO LABEL
TXNE Q2,DSF
ETYPE <%_> ;EXTRA EOL IF DOUBLE-SPACING
MOVE A,DTADRC+^D127
ETYPE< Tape id: %1'%%_>
DTFRE0: TXNE Q2,DSF
ETYPE <%_> ;EXTRA EOL IF DOUBLE-SPACING
MOVE B,DTATBL+0
ETYPE < %2Q. Free blocks, >
MOVE C,[XWD -^D22,^D83] ;PREPARE TO LOOP THROUGH ALL NAMES
SETZ B, ;COLLECT COUNT HERE
DTFRE1: SKIPN DTADRC(C) ;NAME HERE?
ADDI B,1 ;NO, COUNT FREE SPACE
AOBJN C,DTFRE1 ;LOOP
ETYPE <%2Q. Free files%_%%_>
POP P,A
RET
> ;END NOSHIP
;DSKDIR
;SUBROUTINE TO LIST DISK OR DECTAPE DIRECTORY
;READS (WITH GNJFN),SORTS,PRINTS ONE DIRECTORY
;TAKES: A: SOURCE DEVICE DESIGNATOR FOR DECTAPE
; INIFH1: POINTER TO INDEXABLE FILE HANDLE
; Z,Q1,Q2: VARIOUS FLAGS, SEE COMMENTS AT
; BEGINNING OF "DIRECTORY", INCL Q2 B12 FOR DECTAPE.
;RETURNS F2 SET IF ADDITIONAL FILES ARE TO BE LISTED
; FOR CURRENT INDEXABLE FILE HANDLE.
;CLOBBERS A-D,Q3-GG.
;BUFFER DEFINITIONS
NOSHIP,<
DTADRC==BUF0 ;WHERE DECTAPE DIRECTORY IS READ
DTATBL==BUF0+200 ;TABLE FOR DECTAPE FILE LENGTHS
>;NOSHIP
CHKBUF==BUF1 ;WHERE TO READ DATA FOR CHECKSUM
TABLE=BUF2 ;WHERE SYMBOL TABLE IS BUILT
TABLEN==776 ;LENGTH OF TABLE. CANNOT
;BE GREATER THAN 511.
DIRBUF=TABLE+TABLEN ;BOTTOM OF STRING AND FDB STORAGE
;BUF1 IS DEFINED IN D.MAC
;SUCCESSIVE PAGES UPWARD FROM BUF1 ARE USED.
;THERE ARE ENOUGH PAGES BELOW DDT AS LONG
;AS DIRECTORY LENGTH REMAINS LIMITED TO 4K.
DSKDIR:
;DSKDIR ...
;READ FDB, NAME, EXT OF EACH FILE TO LIST,
;LOOPING OVER FILES WITH GNJFN, STOPPING IF DEVICE OR
;DIRECTORY CHANGES.
;IN FDB PUT POINTERS TO NAME, EXT, AND ACCT STRINGS.
;FOR DECTAPE FILES A DUMMY FDB CONTAINING NAME, EXT, WRITE DATE,
; # BLOCKS, AND THE REST 0 IS BUILT
;FORM TABLE OF POINTERS TO FDB'S STARTING AT "TABLE".
;LH OF EACH POINTER WORDS HAS 9-BIT REVERSE AND
;FORWARD LIST POINTERS TO PERMIT SORTING IN PLACE
;AND LISTING IN FORWARD OR REVERSE ORDER.
;WORD TABLE +0 IS A DUMMY, WITH FORWARD POINTER
;TO HEAD OF LIST, REVERSE POINTER TO END, AND
;0 RH TO TERMINATE SORT AND PRINT OPERATIONS.
;FIRST ENTRY IN LIST HAS 0 REV PTR, LAST HAS 0 FWD PTR.
MOVEI P4,0 ;INITIALIZE TABLE INDEX
SETZM FNDPTR ;INITIALIZE PREVIOUS EXT POINTER
MOVEI C,DIRBUF ;INITIALIZE BUFFER SPACE POINTER
;TOP OF LOOP
;CHECK FOR TABLE FULL, IF SO PRINT MULTIPLE PARTIAL DIRECTORIES
DSKR1: CAIG C,720+BUFL
CAIL P4,TABLEN-1
JRST [ TYPE < Storage full,
Directory will be printed in two or more sections
>
JRST DSKR8] ;GO SET F2, LIST THIS MUCH.
;DSKDIR... READ...
;READ AND STORE FDB AND STRINGS FOR A FILE
NOSHIP,<
TXNE Z,DECF
JRST DSKR2 ;FOR DTA LEAVE A 0 BLOCK FOR "FDB"
>
TXNE Z,MTAF ;IS THIS AN MT?
JRST DSKR2 ;YES. DON'T DO GTFDB THEN
HRRZ A,@INIFH1 ;JFN
MOVE B,[FDBHGH+1,,.FBHDR] ;LEN,,START
;C ALREADY SET RIGHT
GTFDB ; GET THE FDB
ERJMP [CALL %GETER ; GET THE ERROR
HRRZ A,ERCOD
CAIN A,GFDBX3 ; LIST ACCESS NOT ALLOWED?
JRST [TLO Z,F1 ;FLAG INVOKES MSG LATER
JRST DSKR7] ;SKIP THIS ONE
CAIE A,GFDBX2
CAIN A,GFDBX1 ; INVALID # WORDS OR DISPLACEMENT?
CAIA ; ONE OF THOSE
JRST JERRE ; NEITHER, LOOSE
HRRZ A,@INIFH1 ; RETRIEVE THE JFN
MOVE B,[.FBLN0+1,,.FBHDR] ; GET WHAT WE CAN
GTFDB
ERJMP JERRE
JRST .+1]
MOVE A,.FBCTL(C) ;CONTROL BITS WORD OF FDB
TXNE Q2,DFOF ;"DELETED FILES ONLY" REQUESTED?
TXC A,FB%DEL ;YES,COMPLEMENT "DELETED" BIT
TXNE A,FB%DEL ;IS THIS FILE DELETED OR NOT
;AS REQUESTED?
JRST DSKR7 ;NO SKIP IT.
TXNN Q2,BEFORF ;"BEFORE" SWITCH?
JRST DSKRNB ;NO
MOVE A,.FBWRT(C) ;GET WRITE DATE OF FILE
caml a,befdat ;is file old enough?
JRST DSKR7 ;NO SKIP IT.
DSKRNB: TXNN Q2,SINCEF ;"SINCE" SWITCH?
JRST DSKRNS ;NO
MOVE A,.FBWRT(C) ;YES, GET WRITE DATE OF FILE
CAMG A,SINDAT ;IS FILE NEW ENOUGH?
JRST DSKR7 ;NO
DSKRNS: TXNN Q2,SMALLF ;"SMALLER" SWITCH GIVEN?
JRST DSKRNM ;NO
HRRZ A,.FBBYV(C) ;GET FILE PAGE SIZE
CAML A,SMLSIZ ;IS FILE SMALL ENOUGH?
JRST DSKR7 ;NO
DSKRNM: TXNN Q2,LARGEF ;"LARGER" SWITCH GIVEN?
JRST DSKRNO ;NO
HRRZ A,.FBBYV(C) ;GET FILE PAGE SIZE
CAMG A,LRGSIZ ;IF FILE BIG ENOUGH?
JRST DSKR7 ;NO
DSKRNO: MOVE A,.FBCTL(C) ; RECOVER CTL BITS
TXNE Q2,OFFO ; Offline only?
TXNE A,FB%OFF ; Yes, is file offline?
CAIA ; No, or no & yes
JRST DSKR7
TXNE Q2,ARFO ; Archived?
JRST [ MOVE B,.FBBBT(C) ; Get request bits etc.
TXNN A,FB%ARC ; Archived?
TXNE B,AR%RAR ; Voluntary request?
CAIA ; One of them is on
JRST DSKR7
TXNN Q2,INVFO ; Want to filter out visible files?
TXZ A,FB%INV ; No, make invisble appear visible...
JRST .+1]
TXNE Q2,INVFO ; Invisible?
TXC A,FB%INV
TXNE A,FB%INV
JRST DSKR7 ; No
DSKR2: MOVEM C,SAVPTR ;REMEMBER POINTER TO FDB
TXZE Z,PDNF ;TIME TO PRINT DIR NAME?
CALL DNAME ;YES, BECAUSE MAYBE IT CHANGED
MOVE D,SAVPTR ;RESTORE POINTER TO FDB
TXNN Q2,CHKF ;REQUESTING CHECKSUM?
JRST DSKRNC ;NO
HRRZ A,@INIFH1 ;GET JFN
MOVE B,[44B5+0B9+OF%RD+OF%PDT] ;READ FULL WORDS, MODE 0, PRESERVE DATES
OPENF
JRST [ HRRZM A,FDBCHK(D);STORE ERROR CODE FOR LATER
AOS ERRCN1
AOS ERRCN2 ;COUNT ERROR
JRST DSKRNC]
MOVEM P,CHKPSV ;SAVE P IN CASE OF ERROR
MOVEI B,FILEOF ;WHERE TO GO ON EOF
MOVEM B,EOFDSP
MOVEI B,DSKRCE ;WHERE TO GO ON DATA ERROR
MOVEM B,DATDSP
MOVEI B,DSKRCI ;WHERE TO GO ON ILLEGAL ACCESS, ETC.
MOVEM B,ILIDSP
SETZM CHKCN0 ;INTIALIZE FILE CHECKSUM
TRNE Q2,1B23 ;FORCING SEQUENTIAL?
JRST DSKRC1 ;YES
DVCHR ;DEVICE CHARACTERISTICS FOR JFN
HLRZ A,A
CAIE A,.DVDES+.DVDSK ;DSK?
JRST DSKRC1 ;NO, DO IT SEQUENTIALLY
SETOM FDBCHK(D) ;FLAG CHECKSUM BY PAGES
AOS DIRFL1 ;COUNT FOR SUMMARY
AOS DIRFL2 ;AND FOR GRAND
HRLZ A,@INIFH1 ;GET JFN,,0
MOVE B,[.FHSLF,,<CHKBUF>B44] ;FORK,,PAGE
DSKRC3: HRRZM A,LSTPAG ;SAVE PAGE WE ARE STARTING AT
FFUFP ;FIND NEXT USED FILE PAGE
JRST [ CAIN A,FFUFX3 ;NO MORE PAGES?
JRST DSKRC2 ;RIGHT, NORMAL END
JRST DSKRC6] ;GO STORE ERROR CODE
HRRZ D,A ;GET JUST PAGE
SUB D,LSTPAG ;GET OFFSET FROM WHERE WE STARTED
JUMPE D,DSKRC4 ;JUMP IF NO HOLE
MOVNI C,(D) ;YES, GET -PAGE #
HRL C,D ;MAKE IT PAGE #,,-PAGE #
PUSH P,C ;STUFF WORD ONTO STACK
MOVSI C,-1
HRRI C,-CHKBUF(P) ;ARRANGE TO POINT AT IT
CALL CHKSOM ;CHECKSUM 1 WORD
POP P,(P) ;RESTORE STACK
DSKRC4: LDF C,PM%RD ;READ ACCESS
PMAP ;MAP PAGE INTO BUFFER
MOVSI C,-1000 ;SETUP AOBJN POINTER TO WHOLE PAGE
CALL CHKSOM ;CHECKSUM IT
AOJA A,DSKRC3 ;GO GET NEXT PAGE
DSKRC1: HRRZ A,@INIFH1 ;GET JFN AGAIN
MOVE B,[POINT 36,CHKBUF] ;INTO CHKBUF
MOVEI C,1000 ;MAX 1000 WORDS
SIN
MOVSI C,-1000(C) ;MAKE AOBJN POINTER TO WORDS READ
CALL CHKSOM
JRST DSKRC1 ;LOOP TILL EOF
CHKSOM: MOVE D,CHKCN0
ROT D,1
ADD D,CHKBUF(C)
MOVEM D,CHKCN0
MOVE D,CHKCN1
ROT D,1
ADD D,CHKBUF(C)
MOVEM D,CHKCN1
MOVE D,CHKCN2
ROT D,1
ADD D,CHKBUF(C)
MOVEM D,CHKCN2
AOBJN C,CHKSOM
RET
FILEOF: MOVSI C,-1000(C) ;MAKE AOBJN POINTER TO WORDS READ
JUMPE C,DSKRC2 ;IN CASE NO WORDS READ
CALL CHKSOM
JRST DSKRC2 ;NO ERROR ENDING
DSKRCE: MOVNI A,2 ;DATA ERROR FLAG
JRST DSKRC6
DSKRCI: HRRZ A,ERCOD
DSKRC6: MOVE P,CHKPSV ;RESTORE STACK TO CORRECT LEVEL
MOVE D,SAVPTR
MOVEM A,FDBCHK(D) ;STORE ERROR CODE FOR PRINT LATER
AOS ERRCN1
AOS ERRCN2 ;COUNT ERROR
DSKRC2: MOVE D,SAVPTR
SETO A,
MOVE B,[.FHSLF,,<CHKBUF>B44]
SETZ C,
PMAP ;RELEASE PAGE FROM MAP
MOVE A,CHKCN0
MOVEM A,FDBSUM(D) ;STORE CHECKSUM
SETZM EOFDSP
SETZM DATDSP
SETZM ILIDSP
HRRO A,@INIFH1
CLOSF ;LOT GO OF FILE, BUT NOT JFN
CALL JERR ;SHOULD BE ABLE TO LET GO
DSKRNC: HRROI A,FDBLEN(D) ;CREATE STRING POINTER PAST FDB AND CHECKSUM INFO
HRRM A,.FBCTL(D) ;NAME POINTER TO FDB
HRRZ B,@INIFH1 ;JFN
MOVX C,FLD(.JSAOF,JS%NAM) ;FORMAT
TXNE Q2,SOF ;"NO FILES"
JRST DSK1 ;YES, SO DON'T WASTE TIME DOING JFNS
JFNS ;GET NAME STRING
ERCAL JERRE
DSK1: TXNE Z,MTAF ;IS THIS A TAPE?
JRST [ PUSH P,A ;SAVE START
HRROI A,2(A) ;YES. GET A PLACE TO STORE VERSION
MOVX C,FLD(.JSAOF,JS%GEN)
JFNS ;GET VERSION
ERJMP [POP P,A ;FAILED. CLEAN UP STACK
JRST .+1] ;AND DONE
POP P,A ;GET BACK SP
HRROI A,2(A) ;GET POINTER TO VERSION
MOVEI C,^D10 ;GET IT AS DECIMAL
NIN ;DO IT
ERJMP .+1 ;IF FAILED, GIVE UP
HRLM B,.FBGEN(D) ;SAVE VERSION IN "FDB"
JRST .+1] ;AND PROCEED
HRRZ B,@INIFH1 ;GET JFN AGAIN
HRROI A,2(A) ;STRING POINTER TO BEGINNING OF NEXT WORD TO USE
;LEAVES A 0 WORD TO TERMINATE
;STRING FOR SORT.
HRLM A,.FBEXL(D) ;EXT PTR TO FDB
MOVX C,FLD(.JSAOF,JS%TYP)
TXNE Q2,SOF ;"NO FILES"?
JRST DSK2 ;YES, SO DON'T BOTHER READING EXTENSION
JFNS ;EXTENSION STRING
ERCAL JERRE
DSK2: MOVE B,.FBACT(D) ;ACCOUNT
JUMPLE B,DSKR2B ;NUMERIC OR MISSING
HRROI A,2(A)
HRRZM A,.FBACT(D)
HRRZ B,@INIFH1
MOVEI C,1B20
TRNN P2,ACCF ;"ACCOUNT"?
JRST DSK3 ;NO, SO DON'T BOTHER GETTING IT
JFNS ;GET ACCOUNT STRING
ERCAL JERRE
DSK3:
DSKR2B: HRROI B,2(A) ;POINTER TO STORE LAST WRITER'S NAME
HRLM B,.FBUSE(D) ;REMEMBER WHERE NAME GETS STORED
TXNN Q2,UWRF ;"USER (WHO LAST) WROTE"?
JRST DSK5 ;NO, SO DON'T GET IT
MOVE A,@INIFH1 ;FILE TO GET LAST WRITER OF
HRLI A,.GFLWR ;SPECIFY WE WANT LAST WRITER
HLRO B,.FBUSE(D) ;SAY WHERE IT GOES IN MEMORY
GFUST
ERCAL [ HRROI A,[ASCIZ /?Unknown/]
HLRO B,.FBUSE(D) ;USE "UNKNOWN" IF CAN'T GET AUTHOR
MOVEI C,0
SIN
RET]
DSK5: HRROI B,2(B) ;GET POINTER FOR STORING AUTHOR
HRRM B,.FBUSE(D) ;REMEMBER WHERE AUTHOR IS STORED
TXNN Q2,UCREF ;"USER (WHO LAST) CREATED"?
JRST DSK6 ;NO, SO DON'T GET IT
MOVE A,@INIFH1 ;FILE TO GET LAST CREATOR OF
HRLI A,.GFAUT ;SPECIFY WE WANT AUTHOR
HRRO B,.FBUSE(D) ;TELL MONITOR WHERE TO PUT IT
GFUST
ERCAL [ HRROI A,[ASCIZ /?Unknown/]
HRRO B,.FBUSE(D) ;USE "UNKNOWN" IF CAN'T GET AUTHOR
MOVEI C,0
SIN
RET]
DSK6:
MOVEI C,2(B) ;WHERE TO STORE NEXT FDB
;AGAIN LEAVING A 0 WORD POINTER
MOVE A,C ;GET START OF NEW FDB
SUB A,D ;COMPUTE LENGTH OF ONE WE'RE FINISHING
MOVEM A,FDBRLN(D) ;STORE REAL LENGTH
NOSHIP,<
TXNN Z,DECF
JRST DSKR5
;PRESERVE THESE ACS
PUSH P,P1
PUSH P,P2
PUSH P,P3
PUSH P,P4
PUSH P,P5
;FOR DTA PICK UP DATE AND SIZE
;SEARCH DIRECTORY TO GET DATE (IN SAME WORD AS EXT)
;AND SIZE (AT SAME INDEX INTO DTATBL).
HRLZI P1,-^D22
;CONVERT NAME AND EXT FROM "FDB" TO SIXBIT IN P2, CC.
;CLOBBERS P2-FF.
HRLI P5,<POINT 7,0,-1>B53 ;NAME
HRR P5,.FBCTL(D)
MOVEI P4,6
DTADRN: ILDB P3,P5 ;NAME CHAR LOOP
JUMPE P3,.+2
SUBI P3,40
LSH P3,36
LSHC P2,6
SOJG P4,DTADRN
HRLI P5,<POINT 7,0,-1>B53 ;EXTENSION
HLR P5,.FBEXL(D)
MOVEI P4,3
DTADRE: ILDB B,P5 ;EXT CHAR LOOP
JUMPE B,.+2
SUBI B,40
LSH P3,6 ;MAKE ROOM FOR NEXT CHAR
DPB B,[POINT 6,P3,35] ;BUILD SIXBIT EXT IN P3
SOJG P4,DTADRE
DTADR1: CAME P2,DTADRC+^D83(P1)
JRST DTADR9 ;WRONG NAME
HRLZ B,P3 ;XWD EXT,0 FROM "FDB"
XOR B,DTADRC+^D105(P1) ;COMPARE EXT, PICK UP DATE FROM DTADRC
TLNE B,-1
JRST DTADR9 ;WRONG EXT
DPB B,[POINT 12,.FBWRT(D),35] ;DATE TO "FDB"
;COPY EXTRA BITS FOR DATE75
LDB B,[POINT 1,DTADRC+0(P1),35]
DPB B,[POINT 1,.FBWRT(D),23]
LDB B,[POINT 1,DTADRC+^D22(P1),35]
DPB B,[POINT 1,.FBWRT(D),22]
LDB B,[POINT 1,DTADRC+^D44(P1),35]
DPB B,[POINT 1,.FBWRT(D),21]
HRRZ B,DTATBL+1(P1)
HRRM B,.FBBYV(D) ;SIZE IN BLOCKS
JRST DTADR8
DTADR9: AOBJN P1,DTADR1 ;IF NOT FOUND LEAVE THINGS 0
DTADR8: POP P,P5
POP P,P4
POP P,P3
POP P,P2
POP P,P1
> ;END NOSHIP
;DSKDIR... READ...
;MAKE TABLE ENTRY
DSKR5: DPB P4,[POINT 9,TABLE+1(P4),8] ;REVERSE POINTER
;TO ENTRY WE ARE ABOUT TO USE
MOVEI P4,1(P4) ;INCREMENT TABLE INDEX
DPB P4,[POINT 9,TABLE-1(P4),17] ;FORWARD POINTER
;TO PREVIOUS ENTRY
;LEAVES 0 IN LAST ENTRY.
HRRM D,TABLE(P4) ;POINTER TO FDB TO THIS TABLE ENTRY
;STEP TO NEXT FILE, STOP IF ANOTHER DEVICE OR DIRECTORY
DSKR7: MOVE A,@INIFH1
TLNN Q2,(1B8) ; Doing invisible files?
TXZ A,GJ%GIV ; no, don't let GNJFN find them
TLNE A,<77B5>B53 ;IF NO *-FLAGS SKIP GNJFN AND ITS BUGS
GNJFN
JRST [ CALL FNDFIX ;CHECK FOR "FIND"
JRST DSKR9] ;NO MORE,DONE READING
;THIS ASSUMES GNJFN DOES RETURN
;"WHAT CHANGED" BITS.
TLNE A,76 ;DEV, DIR, NAME, EXT CHANGE?
CALL FNDFIX ;YES, CHECK FOR "FIND"
TXNE A,GN%STR!GN%DIR ;STRUCTURE OR DIRECTORY CHANGED?
TXO Z,PDNF ;SAY DIRECTORY CHANGED
SKIPE KEPDNM ;"FIND" SUBCOMMAND?
JRST DSKR10 ;YES, BUFFER THE SPECS
TXNN Z,SORTF ;USER ASK FOR SORTING?
TXNE Z,REVF ;IF REVERSE ALPHABETIC, BUFFER IT
CAIA ;BUFFER IT, SINCE SORTING NEEDED
JRST DSKR8 ;NO, PRINT NOW INSTEAD OF BUFFERING
DSKR10: TLNN A,70 ;DEVICE OR DIRECTORY CHANGED?
JRST DSKR1 ;NO,DO THIS FILE.
DSKR8: TLO Z,F2 ;YES,SAY THERE'S MORE FOR THIS JFN,
;SORT AND PRINT WHAT WE HAVE
DSKR9: DPB P4,[POINT 9,TABLE,8] ;PUT "REVERSE" POINTER
;TO LAST ENTRY IN DUMMY ENTRY 0.
;USED FOR REVERSE UNSORTED LISTING.
MOVEM P4,TABLNX ;REMEMBER REAL TABLE LENGTH
TRNN Z,SORTF ;ANY ORDER-OF-PRINTOUT FLAGS ON?
JRST DSKP ;NO, NO SORT REQUIRED, GO PRINT
TXNE Z,ALPHAF ;SORTING ALPHABETICALLY?
TXNN Z,DSKF ;ALPHABETIC AND DISK DIRECTORY?
CAIA ;OTHER THAN ALPHABETIC, OR NOT DISK, SO SORT.
JRST DSKP ;ALREADY SORTED BY MONITOR IF DISK AND ALPHABETIC
;DSKDIR...
;SORT DISK DIRECTORY
;FOR EACH SUCCESSIVE WORD OF UNSORTED TABLE, FIND
;PLACE TO PUT IT IN LIST-STRUCTURED TABLE, STARTING
;FROM LAST INSERTED ENTRY TO MAKE MAXIMUM
;USE OF PARTIAL ORDERING.
;ENDS OF LIST ARE INDICATED BY 0 RH OF TABLE WORD.
;START WITH ZEROED WORD 0; THIS PUTS POINTERS TO IT
;(AS TERMINATING ENTRY) AT EACH END OF LIST.
SETZM TABLE ;INITIALIZE SORTED TABLE:
;MAKES LAST FIND AND FIRST REV
;PTR POINT TO A WORD (NAMELY THIS WORD) WITH 0 RH.
MOVEI P4,0 ;INDEX OF CURRENT (LAST INSERTED)
;SORTED TABLE ENTRY
MOVEI P1,1 ;INDEX INTO UNSORTED TABLE
;TOP OF LOOP
DSKS1: CAMLE P1,TABLNX ;SEE IF WE'VE SCANNED ENTIRE TABLE
JRST DSKP ;NO MORE TO SORT, GO PRINT
CALL FDBSC ;COMPARE ENTRY (P4) TO (P1),3 RETURNS
JRST LESS ;UNSORTED ENTRY (P4) LESS
JRST HERE ;EQUAL
;GREATER
;UNSORTED ENTRY GREATER, SEARCH FORWARD
GRATR: LDB P4,[POINT 9,TABLE(P4),17] ;GET FWD PTR
CALL FDBSC ;COMPARE AGAIN
JRST .+3 ;LESS
JRST .+2 ;EQUAL OR AT END OF TABLE
JRST GRATR ;GREATER, KEEP SEARCHING
;LESS OR EQUAL, PUT IT BEFORE THIS ONE
LDB P4,[POINT 9,TABLE(P4),8] ;BACK UP 1
JRST HERE ;PUT IT AFTER THIS ONE
;UNSORTED ENTRY LESS, SEARCH BACKWARD
LESS: LDB P4,[POINT 9,TABLE(P4),8] ;GET REVERSE PTR
CALL FDBSC
JRST LESS ;KEEP SEARCHING
JRST HERE ;EQUAL OR BEGINNING OF TABLE
;JRST HERE
;INSERT ENTRY AFTER CURRENT ENTRY BY UPDATING LIST POINTERS
HERE: LDB A,[POINT 9,TABLE(P4),17] ;SORTED ENTRY'S FWD PTR
DPB A,[POINT 9,TABLE(P1),17] ;TO ENTRY BEING INSERTED
DPB P1,[POINT 9,TABLE(P4),17] ;SET FWD PTR OF
;SORTED ENTRY TO POINT AT NEW ENTRY
DPB P1,[POINT 9,TABLE(A),8] ;SET REV PTR OF ENTRY
;FOLLOWING SORTED ENTRY TO POINT AT NEW ENTRY
DPB P4,[POINT 9,TABLE(P1),8] ;SET NEW ENTRY'S REV
;PTR TO POINT PREVIOUS SORTED ENTRY
MOVE P4,P1 ;ENTRY JUST INSERTED IS CURRENT
AOJA P1,DSKS1 ;BOTTOM OF LOOP: NEXT UNSORTED ONE
;DSKDIR...
;SUBROUTINE FDBSC FOR SORT
;COMPARE FDB'S THAT TABLE ENTRIES SPECIFIED BY INDICES
;IN P4 AND P1 POINT TO.
;RETURN+1 IF P4 LESS, +2 =, +3 GREATER
;ACCORDING TO SORT KEY SPECIFIED BY FLAGS IN RHZ
;RET +2 IF P4 POINTS TO NULL TABLE ENTRY.
;CLOBBERS A - D, Q3, BB.
FDBSC: HRRZ Q1,TABLE(P4) ;Q1 POINTS TO FIRST FDB
HRRZ Q3,TABLE(P1) ;Q3 TO SECOND
JUMPE Q1,FDBEQ ;NULL, RETURN AS THOUGH EQUAL.
TXNN Z,ALPHAF
JRST FDBSC2
;ALPHABETIC COMPARISON.
;COMPARE NAMES
HRRZ A,.FBCTL(Q1) ;NAME PTRS
HRRZ B,.FBCTL(Q3)
CALL FDBSTC ;STRING COMPARE RETURNS HERE
;ONLY IF EQUAL.
;NAMES =, COMPARE EXTENSIONS
HLRZ A,.FBEXL(Q1)
HLRZ B,.FBEXL(Q3)
CALL FDBSTC
;=, COMPARE VERSIONS
HLRZ A,.FBGEN(Q1)
HLRZ B,.FBGEN(Q3)
JRST FDBSC3 ;JOIN CHRONOLOGICAL CASE FOR COMPARE
;DSKDIR SORT SUBR FDBSC...
;FOR EACH CHRONOLOGICAL COMPARISON FETCH THE DATES AND TIMES
;TO COMPARE THEN CONVERGE ON COMPARE
FDBSC2: TXNN Z,CHTPF ; Tape-write
JRST .+4
MOVE A,.FBTDT(Q1)
MOVE B,.FBTDT(Q3)
JRST FDBSC3
TRNN Z,1B31
JRST .+4
MOVE A,.FBWRT(Q1) ;WRITE
MOVE B,.FBWRT(Q3)
JRST FDBSC3
TXNN Z,CHRDF ;CHRONOLOGICAL BY READ?
JRST .+4
MOVE A,.FBREF(Q1) ;READ
MOVE B,.FBREF(Q3)
JRST FDBSC3
TXNN Z,CHCRF ;CHRONO BY CREATION?
JRST FDBGR ;NO SORTING SPECIFIED (IE DIRECTORY ORDER).
;TREAT AS THO GREATER. NOTE THAT "REVERSE"
;STILL WORKS.
;THIS IS WHERE TO ADD CASES
MOVE A,.FBCRV(Q1) ;CREATE
MOVE B,.FBCRV(Q3)
FDBSC3: CAMN A,B
JRST FDBEQ
CAML A,B ;RETURN "GREATER" IF DATE LESS
JRST FDBLS ;BECAUSE DEFAULT ORDER IS
JRST FDBGR ;REVERSE CHRONOLOGICAL
FDBGR: AOS (P)
FDBEQ: AOS (P)
FDBLS: RET
;DSKDIR... SORT...
;FDBSTC: STRING COMPARE FOR FDBSC.
;A AND B POINT TO STRING BLOCKS WITH
;HEADER WORD AND 0 WORD AFTER.
;RETURNS IF =, ELSE GOES TO FDBLS OR FDBGR.
;CLOBBERS A-D.
FDBST1: SKIPN (A) ;WORDS =. END OF STRINGS?
RET ;YES, STRINGS =.
MOVEI A,1(A)
MOVEI B,1(B)
;ENTER HERE
FDBSTC: JCRY0 .+1
MOVE C,(A) ;FETCH WORD OF FIRST STRING
;PASSING HEADER WORD.
SUB C,(B) ;SUBTRACT WORD OF 2ND STRING
JUMPE C,FDBST1 ;WORDS =?
JCRY0 [ SUB P,[XWD 1,1] ;FORGET RETURN
JRST FDBLS]
SUB P,[XWD 1,1]
JRST FDBGR
;FNDFIX
;DECREASE NUMBER OF ENTRIES BY KEPDNM
;BUT ONLY BACK TO FNDPTR
FNDFIX: SKIPN KEPDNM ;IGNORING ANY?
RET ;NO, NO-OP
SUB P4,KEPDNM ;REMOVE N HIGHEST NUMBERED VERSIONS
CAMGE P4,FNDPTR ;BACKUP TOO FAR?
MOVE P4,FNDPTR ;YES, ONLY REMOVE THIS FILE
MOVEM P4,FNDPTR ;RESET FNDPTR
PUSH P,A
SETZ A,
DPB A,[POINT 9,TABLE(P4),17] ;CLEAR FORWARD POINTER
POP P,A
RET
;DSKDIR...
;PRINT DISK DIRECTORY
DSKP: MOVEI P4,0 ;P4 IS TABLE POINTER
;WORD TABLE+0 IS A DUMMY,
;NOT TO BE LISTED
DSKP1: TXNN Z,REVF ;SKIP IF REVERSE ORDER
LDB P4,[POINT 9,TABLE(P4),17] ;FWD POINTER
TXNE Z,REVF ;SKIP IF NORMAL ORDER
LDB P4,[POINT 9,TABLE(P4),8] ;REVERSE PTR
HRRZ Q3,TABLE(P4) ;FDB PTR FROM TABLE ENTRY
JUMPE Q3,DSKP4 ;0 MEANS END
CALL COUNTF ;DO COUNTING
TXNN Q2,SOF ;SKIP PRINT IF "NO FILE-LINES".
CALL DFILE ;LIST THIS ENTRY
JRST DSKP1
DSKP4: RET ;RETURN FROM DSKDIR
;COUNTF
;COUNT AND CHECKSUM FILE, ADD TO SUMMARY CELLS
COUNTF: HRRZ A,.FBBYV(Q3) ;GET SIZE IN PAGES OR BLOCKS
NOSHIP,<
TXNE Z,DECF ;DTA?
JRST COUNT1 ;YES, DO BLOCKS
>
SKIPGE DIRCN1
SETZM DIRCN1
SKIPGE DIRCN2
SETZM DIRCN2
ADDM A,DIRCN1
ADDM A,DIRCN2
NOSHIP,<
JRST COUNT2
COUNT1: SKIPGE BLKCN1
SETZM BLKCN1
SKIPGE BLKCN2
SETZM BLKCN2
ADDM A,BLKCN1
ADDM A,BLKCN2
COUNT2:>
AOS FILCN1 ;COUNT ANOTHER FILE
AOS FILCN2
MOVE A,.FBCTL(Q3) ;GET FILE BITS
TXNN A,FB%BAT ;BAD BLOCKS IN FILE?
RET ;NO, RETURN
AOS BATCN1 ;YES, COUNT FILE
AOS BATCN2
RET
;DFILE
;LIST ONE FILE
;TAKES:
; P2: WHAT FIELDS TO PRINT BITS -- SAME AS JFNS'S EXCEPT
; COMBINATIONS NOT PRODUCED BY "DIRECTORY" COMMAND AREN'T
; NECESSARILY HANDLED.
; AND ALSO: B26 (PLBF): PRINT LENGTH IN BYTES.
; B27 (PCTF)-30: CREATE, WRITE, READ, TAPE WRITE TIMES (IMPLYING DATES)
; B32: SUPPRESS COLUMNATION
; Q2: B14(SMVF): DON'T PUT MULTIPLE VERSIONS OF SAME NAME.EXT
; ON SAME LINE
; B15: SUPPRESS THE NORMAL OMISSION OF NAME OR NAME.EXT
; WHEN SAME AS THOSE LAST PRINTED
; B16: ON FOR DOUBLE-SPACING
; B17: ON TO LIST DELETED FILES ONLY
; Q3: POINTER TO FDB
; DCNT IS USED TO KEEP TRACK OF THE POSITION ON THE LINE. IT HAS A VALUE
; WHICH IS A NUMBER OF SPACES RELATIVE TO WHERE YOU WANT TO BE. I.E.
; POSITIVE MEANS THAT FILL IS NEEDED, AND NEGATIVE MEANS THAT YOU
; ARE TOO FAR BECAUSE ONE OR MORE FIELDS HAS OVERFLOWED.
;EACH LINE UP THROUGH THE EXTENSION MUST TAKE AT LEAST 3 SPACES--I.E.
;THE LEADING BLANK, ONE SPACE FOR THE NAME, AND THE DOT BEFORE
;THE EXTENSION. IF THE NAME IS NOT BEING PRINTED BECAUSE IT IS
;THE SAME AS THE PREVIOUS LINE, 3 LEADING BLANKS ARE USED. IF
;THE NAME AND EXTENSION ARE NOT BEING PRINTED BECAUSE BOTH ARE THE
;SAME AS THE PREVIOUS LINE, 6 LEADING BLANKS ARE USED.
;DFILE
DFILE: SETZM DCNT ;NO FIELDS HAVE EXCEEDED MIN WIDTH YET
;NAME, EXTENSION, VERSION
HRRZ B,.FBCTL(Q3) ;NAME
; IF NAME IS SAME AS THAT LAST PRINTED, JUST PRINT 3 SPACES.
TXNE Q2,SNEF
JRST DFL03A ;FLAG SUPPRESSES COMPACT FORMAT
SKIPE C,LPNAME ;LAST NAME PRINTED. TREAT NONE AS "DIFFERENT".
CALL DCMPR ;COMPARE CURRENT NAME TO LAST PRINTED
JRST DFL03A ;DIFFERENT, PRINT IT.
HLRZ B,.FBEXL(Q3)
SKIPE C,LPEXT
CALL DCMPR ;NAME IS SAME, IS EXT SAME ALSO?
JRST [ CALL DFREST ;FINISH PREVIOUS LINE, IF ANY.
CALL BATSPC ;TYPE "*" OR " "
MOVE B,[POINT 7,[ASCIZ / /],-1] ;NAME SAME, EXT DIFF
AOS DCNT
JRST DFL03B] ;PRINT SPACES AND PROCEED TO EXTENSION
;NAME AND EXTENSION ARE THE SAME AS THOSE LAST PRINTED.
;NORMALLY PUT COMMA AND ADDITIONAL VERSION ON SAME LINE UNLESS
; SOME OTHER FIELD TO BE PRINTED IS DIFFERENT,
; BUT IF THAT IS SUPPRESSED OR A FIELD IS DIFFERENT,
; START NEW LINE WITH TAB INSTEAD OF NAME.EXT.
TXNE Q2,SMVF
JRST DFL02B ;MULTIPLE VERSIONS PER LINE SUPPRESSED
;COMPARE CURRENT FDB TO PREVIOUS, COMPARING ONLY THOSE
; FIELDS WHICH ARE TO BE PRINTED.
CALL DFDBCM
JRST DFL02B ;DIFFERENT, NEW LINE.
MOVE D,LFPOS ;SAME, RETRIEVE "POSITION" ON THIS LINE
MOVEI B,"," ;USE A COMMA,
SOJ D,
MOVEM D,DCNT
JRST DFL05A ;ACCOUNT COLUMN USED BY COMMA,
;AND GO PRINT VERSION ON SAME LINE.
;FINISH OLD LINE AND START NEW FOR SAME NAME.EXT
DFL02B: CALL DFREST ;PRINT REST OF LAST FILE'S INFO, IF ANY
MOVEI D,^D3 ;ACCOUNT FOR THE 3 MINIMUM SPACES
MOVEM D,DCNT
CALL BATSPC ;TYPE "*" OR " "
HRROI B,[ASCIZ / /] ;BUT INDENT 6 SPACES IF NO NAME.EXT
CALL DFILL ;SPACES(S) IN PLACE OF NAME.EXT
JRST DFL05 ;GO PRINT VERSION
;ROUTINE USED BY DFILE TO RELEASE STORAGE USED BY PREVIOUSLY REMEMBERED
;STRING, AND STORE NEW ONE.
;
;ACCEPTS: A/ NEW STRING POINTER
; B/ LOCATION HOLDING POINTER TO OLD STRING
;
;RETURNS: +1 WITH OLD STRING RELEASED, AND NEW STRING STORED
DFL: MOVEM A,NEWPTR ;REMEMBER POINTER TO NEW STRING
MOVEM B,CELADR ;REMEMBER WHERE NEW POINTER GOES
SKIPN A,@CELADR ;ANY OLD POINTER?
JRST DFL1 ;NO
CALL STREM ;YES, RELEASE STORAGE
DFL1: MOVE A,NEWPTR ;GET POINTER TO NEW STRING
CALL BUFFS ;BUFFER IT UP
MOVEM A,@CELADR ;REMEMBER NEW POINTER
RET
;ROUTINE TO FLUSH FDB POINTED TO BY LPFDB IF LPFDB IS NON-ZERO.
;LPFDB IS CLEARED TO SHOW THAT ITS FDB HAS BEEN FLUSHED.
FLSFDB: SKIPN B,LPFDB ;ANYTHING TO FLUSH?
RET ;NO
MOVE A,FDBRLN(B) ;YES, SAY HOW MANY WORDS TO FLUSH
SETZM LPFDB ;SAY FDB IS FLUSHED
CALLRET RETBUF ;RETURN ITS SPACE TO FREE POOL AND RETURN.
;DFILE...
;PRINT NAME
DFL03A: CALL DFREST ;PRINT REST OF PREVIOUS LINE, IF ANY
AOS DCNT
CALL BATSPC ;TYPE "*" OR " "
HRRO A,.FBCTL(Q3) ;NAME BLOCK RELATIVE LOCATION
MOVEI B,LPNAME ;RELEASE PREVIOUS NAME SINCE THEY MAY USE UP STORAGE
CALL DFL ;REMEMBER LAST NAME PRINTED
MOVE B,LPNAME
DFL03B: AOS DCNT ;USE 1 COLUMNS MINIMUM
CALL DFILL ;PRINT NAME OR SPACES
;PRINT EXTENSION
HLRO A,.FBEXL(Q3) ;EXT
MOVEI B,LPEXT
CALL DFL ;REMEMBER LAST EXTENSION (FILE TYPE)
PRINT "."
MOVE B,LPEXT
CALL DFILL ;OUTPUT EXTENSION
;PRINT FIRST VERSION ON LINE
DFL05: MOVEI B,"."
DFL05A: TLNE P2,<1B14>B53 ;SUPPRESS FOR DTA
PRINT @B ;ADDITIONAL VERSION ON SAME LINE JOINS HERE
HLRZ B,.FBGEN(Q3) ;VERSION
MOVEI C,^D10
TLNE P2,<1B14>B53
CALL DFNOUT ;NOUT AND KEEP TRACK OF COLS USED.
CALL FLSFDB ;FLUSH PREVIOUS SAVED FDB
MOVE A,FDBRLN(Q3) ;GET REAL LENGTH OF FDB BEING SAVED
CALL GETBUF ;ALLOCATE A BUFFER FOR STORING NEW FDB
MOVE C,Q3 ;GET OLD ADDRESS
SUB C,A ;GET AMOUNT TO BE SUBTRACTED FROM STRING ADDRESS OFFSETS
MOVEM A,LPFDB ;REMEMBER ADDRESS OF SAVED FDB
MOVE B,FDBRLN(Q3) ;GET LENGTH OF FDB BEING MOVED
ADDI B,-1(A) ;COMPUTE LAST WORD TO BE STORED INTO
HRL A,Q3 ;MAKE BLT POINTER FOR SAVING FDB
BLT A,(B) ;COPY THE FDB
MOVE A,LPFDB ;GET NEW LOCATION OF THE FDB
HRRZ B,.FBCTL(A) ;GET OLD POINTER TO NAME
SUB B,C ;FIX IT DUE TO NEW FDB LOCATION
HRRM B,.FBCTL(A)
HLRZ B,.FBEXT(A) ;FIX FILE TYPE POINTER
SUB B,C
HRLM B,.FBEXT(A)
HRRZ B,.FBACT(A) ;ACCOUNT
SUB B,C
HRRM B,.FBACT(A)
HLRZ B,.FBUSE(A) ;AUTHOR
SUB B,C
HRLM B,.FBUSE(A)
HRRZ B,.FBUSE(A) ;WRITER
SUB B,C
HRRM B,.FBUSE(A)
MOVE D,DCNT
MOVEM D,LFPOS ;LINE "POSITION" (- # COLS OV) ALSO
RET
;PRINTING OF ADDITIONAL FIELDS FOR THIS NAME.EXT;VERSION IS DEFERRED
; SO THAT ADDITIONAL VERSION NUMBERS MAY BE PRINTED HERE,
; SEPARATED BY COMMAS.
BATSPC: MOVE B,.FBCTL(Q3)
TXNE B,FB%BAT
SKIPA B,["*"]
MOVEI B," "
PRINT @B
SOS DCNT
RET
;DFREST
;LIST REST OF FIELDS AFTER VERSION NUMBER
;CALLED FROM DFILE WHEN A DIFFERENT VERSION NUMBER IS DETECTED,
; AND AT END OF LISTING.
;TAKES: LPFDB: ZERO OR POINTER TO FDB FOR WHICH TO FINISH PRINTOUT
; LFPOS: - # COLS LINE OVERFLOW, AS REQUIRED FOR "DFILL"
; Q1,Q2: AS FOR "DFILE" ABOVE.
;RETURNS: LPFDB 0, B,C CLOBBERED, D-Q3 PRESERVED.
DFREST: SKIPN LPFDB
RET ;NOTHING TO PRINT REST OF, RETURN.
MOVEM Q3,SAVQ3
MOVE A,DCNT
MOVEM A,SVDCNT ;SAVE OLD COLUMN
MOVE Q3,LPFDB ;LOCATION OF FDB
MOVE D,LFPOS ;LINE OVERFLOW SITUATION
MOVEM D,DCNT
;PROTECTION
NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,PPF
JRST DFR07 ;PRINTING PROTECTION NOT REQUESTED
TYPE <;P>
LDB B,[POINT 3,.FBPRT(Q3),2] ;LEFT HALF OF PROTECTION WORD
CAIE B,5 ;5 MEANS 33-BIT OCTAL IN REST OF WORD
JRST DFR06A ;ANYTHING ELSE IS MAGIC
MOVE B,.FBPRT(Q3)
TLZ B,700000
MOVEI C,10
CALL DFNOUT ;NOUT AND KEEP TRACK OF COLUMNS USED
JRST DFR07
DFR06A: HRROI B,[ASCIZ /<Fancy protection>/]
CALL DFILL ;DFILE WILL HAVE TO BE MODIFIED WHEN HAIRY
;PROTECTION IS IMPLEMENTED. ___________
;DFREST...
;ACCOUNT
DFR07: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TRNN P2,1B19!ACCF
JRST DFR08
TYPE <;A>
MOVE B,.FBACT(Q3)
JUMPL B,DFR07A
;STRING ACCOUNT
SKIPN .FBACT(Q3) ;"NONE" FOR NO BLOCK # OR PTR FOUND
HRROI B,[ASCIZ /None/]
HRROI B,0(B) ;MAKE PROPER LH
CALL DFILL ;PRINT THE STRING
JRST DFR08
DFR07A: TLZ B,700000 ;NUMERICAL ACCT: CLEAR HI BITS.
MOVEI C,^D10 ;DECIMAL
CALL DFNOUT ;NOUT AND KEEP TRACK OF CHARACTERS OUTPUT
; ;T: ALWAYS PRINTED IF FILE IS TEMPORARY.
DFR08: MOVE B,.FBCTL(Q3) ;CONTROL BITS
TXNN B,FB%TMP ;IS FILE TEMP?
JRST DFR86
HRROI B,[ASCIZ /;T/]
CALL DFILL ;SOUT AND KEEP TRACK OF COLUMNS
DFR86: MOVE B,.FBCTL(Q3)
TXNN B,FB%OFF ; Offline?
JRST DFR09 ; Nyet
HRROI B,[ASCIZ /;OFFLINE/]
CALL DFILL
;DFREST...
DFR09: TXNN P2,SIZPF+DCREF+DWRF+DRDF+PLBF+PCTF+PWTF+PRTF+PTDF+POEF+PONEF+PTWF ;ANYTHING MORE TO PRINT?
TXNE Q2,CHKF+UCREF+UWRF+RETF
CAIA
JRST DFR13 ;NO
;BEFORE PRINTING THE REST SPACE OVER TO THE APPROPRIATE TAB STOP,
;OR PRINT ONE SPACE IF BEYOND IT, OR USE A NEW LINE IF TOO FAR BEYOND.
TXNN P2,SCF ;NEVER AN EOL IF COLUMNATION SUPPRESSED
MOVE D,DCNT
CAML D,[-35] ;TO MUCH LINE OVERFLOW?
JRST DFR09A ;OK
;-35 WAS CHOSEN BECUASE IT IS ONE CHARACTER SHORT OF PUSHING
;DATES CLEAR INTO NEXT COLUMN WHEN ;A AND ;P ARE PRESENT.
ETYPE <%_>
CALL DINDNT ;INDENT THE RIGHT AMOUNT ON NEW LINE
SETZM DCNT ;NO LINE OVERFLOW NOW
JRST DFR09C
DFR09A: HRROI B,[ASCIZ / /] ;THE ONE SPACE
MOVEI D,^D12 ;RIGHT # COLS BEYOND MIN FOR NAME, EXT, VER
ADDM D,DCNT
NOSHIP,<
MOVNI D,2 ;2 COLS NARROWER FOR DECTAPE
TXNE Z,DECF
ADDM D,DCNT
>
MOVEI D,6 ;ANOTHER TAB STOP FOR PROT
TXNE P2,PPF
ADDM D,DCNT
TRNE P2,1B19!ACCF
ADDM D,DCNT ;ACCT LIKEWISE (";A" AND ";P NOT COUNTED IND)
CALL DFILL ;SOUT AND ADD SPACES
;SIZE IN PAGES OR DECTAPE BLOCKS
DFR09C: TXNN P2,SIZPF
JRST DFR09D
HRRZ B,.FBBYV(Q3) ;SIZE IN PAGES
MOVEI C,^D10 ;DECIMAL
CAIGE B,^D1000 ;WILL FIT IN 3 COLS?
HRLI C,(1B2+3B17) ;YES, RIGHT JUSTIFY IT
MOVEI D,3 ;3 COLS MIN WIDTH, LESS PRECEDING OVERFLOW
ADDM D,DCNT
CALL DFNOUT ;NOUT WITH FANCY COLUMNATION
PRINT " "
;LENGTH IN BYTES: PRINT "LENGTH(SIZE)"
DFR09D: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,PLBF
JRST DFR10A
MOVE B,.FBSIZ(Q3)
MOVEI C,^D10 ;DECIMAL
CALL DFNOUT ;NO COLUMNATION YET
PRINT "("
LDB B,[POINTR (<.FBBYV(Q3)>,FB%BSZ)] ;BYTE SIZE
MOVEI C,^D10
CALL DFNOUT
PRINT ")"
HRROI B,[ASCIZ / /] ;NOW A SEPERATING SPACE, PLUS ENOUGH MORE
MOVEI D,^D9 ;SO "SIZE(LENGTH)" TAKES UP 10 COLS,
ADDM D,DCNT
CALL DFILL ;( 10 - ()'S+" "=9), LESS EXCESS USED BY NAME.
DFR10A: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN Q2,RETF
JRST DFR10B
LDB B,[POINTR (<.FBBYV(Q3)>,FB%RET)] ;GEN RET COUNT
MOVEI C,^D10 ;DECIMAL
TXNN P2,SCF ;COLUMNATING?
HRLI C,(1B2+3B17) ;YES, RIGHT JUSTIFY IT
MOVEI D,3 ;3 COLS MIN WIDTH, LESS PRECEDING OVERFLOW
ADDM D,DCNT
NOSHIP,<
TXNE Z,DECF ;DTA?
JRST [ CALL DFILL ;YES, FILL FIELD WITH SPACES
JRST DFR10C]
>
CALL DFNOUT ;NOUT WITH FANCY COLUMNATION
DFR10C: PRINT " "
;DFREST...
;THE VARIOUS DATES AND TIMES
DFR10B: SETZ C, ;DATE AND TIME FORMAT: DD-MMM-YY HH:MM:SS
TXNE P2,SCF ;SUPPRESS COLUMNATION?
TXO C,OT%SCL ;SUPPRESS COLUMNATION.
NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,DCREF+PCTF
JRST DFR11
TXNN P2,PCTF ;TIME TO BE INCLUDED?
TXO C,OT%NTM ;NO, EXCLUDE IT
SKIPN B,.FBCRV(Q3) ;VERSION CREATION DATE & TIME
JRST [ CALL TNEVER
JRST DFR11]
CALL DOOTIM ;PRINT DATE AND MAYBE TIME.
PRINT " "
DFR11: TXNN P2,DWRF+PWTF
JRST DFR12
TXZ C,OT%NTM
TXNN P2,PWTF
TXO C,OT%NTM
MOVE B,.FBWRT(Q3) ;WRITE DATE
NOSHIP,<
TXNE Z,DECF
JRST [ CALL DTADAT ;PRINT DECTAPE FORMAT DATE
PRINT " "
JRST DFR12]
>
JUMPE B,[CALL TNEVER
JRST DFR12]
CALL DOOTIM
PRINT " "
DFR12: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,DRDF+PRTF
JRST DFR120
TXZ C,OT%NTM
TXNN P2,PRTF
TXO C,OT%NTM
SKIPN B,.FBREF(Q3) ;LAST REFERENCE (NON-WRITE) DATE
JRST [ CALL TNEVER
JRST DFR120]
CALL DOOTIM
PRINT " "
DFR120: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,PTDF+PTWF
JRST DFR129
TXZ C,OT%NTM ; No time
TXNN P2,PTWF
TXO C,OT%NTM ; Include the time
SKIPN B,.FBTDT(Q3) ; Tape write T&D
JRST [ CALL TNEVER
JRST DFR129]
CALL DOOTIM
PRINT " "
DFR129: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,PONEF ; Print online expiration?
JRST DFR130 ; No
SKIPN B,.FBNET(Q3) ; Yes, get it
JRST [ CALL DFNONE ; There isn't one
JRST DFR130]
MOVX C,FB%OFF ; Is the file offline?
TDNE C,.FBCTL(Q3)
JRST [ CALL DFNA ; Yes, online exp n/a
JRST DFR130]
MOVE C,.FBCRE(Q3) ; Find the newest date
CAMGE C,.FBCRV(Q3)
MOVE C,.FBCRV(Q3)
CAMGE C,.FBWRT(Q3)
MOVE C,.FBWRT(Q3)
CAMGE C,.FBREF(Q3)
MOVE C,.FBREF(Q3)
TLNN B,-1 ; Interval?
JRST [ HRLZS B ; Put # days in days portion of d&t
ADD B,C ; Add in most recent date & time
JRST .+1]
CALL DFDAEX ; Print the expiration date
DFR130: NOSHIP,< TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN P2,POEF ; Want offline exp date?
JRST DFR131 ; No
SKIPN B,.FBFET(Q3) ; Pick up the off exp date/interval
JRST [ CALL DFNONE ; There is none
JRST DFR131]
SKIPN C,.FBTDT(Q3) ; Get time written to tape
JRST [ CALL DFNA ; Not on tape yet, n/a
JRST DFR131]
TLNN B,-1 ; Interval?
JRST [ HRLZS B
ADD B,C ; Add # days to day part
JRST .+1]
CALL DFDAEX ; Print expiration date
DFR131: NOSHIP,<TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN Q2,UCREF ;CREATE DIR?
JRST DFR12B
HRRO B,.FBUSE(Q3)
CALL DFRDIR
DFR12B: NOSHIP,<TXNN Z,DECF > ;NOT FOR DECTAPES
TXNN Q2,UWRF
JRST DFR12Z
HLRO B,.FBUSE(Q3)
CALL DFRDIR
DFR12Z: TXNN Q2,CHKF ;CHECKSUM
JRST DFR13 ;NO
SKIPLE B,FDBCHK(Q3) ;GET CHECKSUM CODE
JRST [ ETYPE <%2?>
JRST DFR121]
CAMN B,[-2] ;FLAG FOR DATA ERROR
JRST DFR12E
HLRZ B,FDBSUM(Q3)
HRRZ C,FDBSUM(Q3)
ADD C,B
HLRZ B,C
ADDI B,(C)
MOVE C,[1B0+1B2+1B3+6B17+10]
MOVEI D,7
ADDM D,DCNT
CALL DFNOUT
MOVEI B," "
SKIPGE FDBCHK(Q3)
MOVEI B,"P"
PRINT @B
JRST DFR121
;ROUTINE CALLED FROM ABOVE TO OUTPUT VARIOUS FORMATS OF DATE AND TIME
DOOTIM: MOVE A,CSBUFP ;GET SOME STRING SPACE
ODTIM ;MAKE THE STRING
MOVE A,CSBUFP
ETYPE <%1M> ;PUT STRING IN OUTPUT BUFFER
RET
DFR12E: TYPE <Data error in file>
DFR121:
;EOL AND EXIT
DFR13: ETYPE <%_>
TLNE Q2,2 ;DOUBLE-SPACE?
ETYPE <%_> ;YES, ANOTHER EOL.
MOVE A,SVDCNT
MOVEM A,DCNT
MOVE Q3,SAVQ3
CALLRET FLSFDB ;THROW AWAY FDB SO IT ISN'T LISTED AGAIN
TNEVER: HRROI B,[ASCIZ/Never /]
TXNE C,OT%NTM
HRROI B,[ASCIZ/Never /]
TXNE C,OT%SCL
HRROI B,[ASCIZ/Never /]
ETYPE <%2m>
RET
DFRDIR: MOVEI D,9
ADDM D,DCNT
CALL DFILL
PRINT " "
RET
DFNA: HRROI B,[ASCIZ \N/A \]
DFNA1: ETYPE <%2m>
RET
DFNONE: HRROI B,[ASCIZ /None /]
JRST DFNA1
DFDAEX: ETYPE <%2d >
JRST DFNA1
NOSHIP,<
;SUBROUTINE DTADAT: PRINTS DECTAPE FORMAT DATE FROM B.
;USED IN DFREST, OLDTAD.
;TAKES: B: DATE. CLOBBERS A,C,D.
DTADAT: ATSAVE
PUSH P,Q1
MOVEI D,ILIDAT ;TRAP FOR ILLEGAL DATE
MOVEM D,ILIDSP
MOVE D,B
IDIVI D,^D31
HRLZ C,Q1 ;DAY OF MONTH
IDIVI D,^D12
HRR B,Q1 ;MONTH
HRLI B,^D1964(D) ;YEAR
MOVX Q1,OT%NTM ;SUPPRESS TIME
MOVE A,CSBUFP ;STORE STRING HERE
ODTNC ;OUTPUT DATE WITHOUT CONVERSION FROM INTERNAL
SETZM ILIDSP ;CLEAR ILLEGAL INST DISP
MOVE A,CSBUFP ;GET STRING POINTER
ETYPE <%1M> ;OUTPUT IT
POP P,Q1
RET
ILIDAT: TYPE <Ill. date>
POP P,Q1
RET
>;NOSHIP
;DCMPR: SUBOUTINE FOR DFILE.
;COMPARE STRING C POINTS TO TO STRING B POINTS TO.
;SKIP IF EITHER POINTER IS ZERO OR IF STRINGS ARE SAME.
DCMPR: JUMPE C,RSKP
JUMPE B,RSKP
HRLI B,<POINT 7,0,-1>B53
HRLI C,<POINT 7,0,-1>B53
DCMPR1: ILDB A,C
ILDB D,B
CAME A,D
RET ;DIFFERENT
JUMPN A,DCMPR1 ;TERMINATE ON NULL
RETSKP
;DFDBCM: COMPARE FDB'S POINTED TO BY Q3 AND LPFDB
;COMPARE ONLY FIELDS TO BE PRINTED, PER DFILE FORMAT WORD IN E.
;SKIPS IF SAME. CLOBBERS B,C,D. ONE CALL IN "DFILE".
DFDBCM: MOVE B,LPFDB
JUMPE B,[RET] ;NO PREVIOUS FDB, GIVE "DIFFERENT" RETURN
MOVE C,.FBCTL(B)
XOR C,.FBCTL(Q3) ;COMPARE FILE BITS
TXNE C,FB%BAT!FB%TMP!FB%OFF ;BAT/TMP/OFF DIFFERENT?
RET ;YES, GIVE DIFFERENT RETURN
TXNN P2,PPF ;PROTECTION: IS IT TO BE LISTED?
JRST .+4 ;NO, CONTINUE COMPARING FIELDS
MOVE C,.FBPRT(B)
CAME C,.FBPRT(Q3) ;IS IT SAME?
RET ;NO, DIFFERENT
TRNN P2,1B19!ACCF ;ACCOUNT
JRST .+4
MOVE C,.FBACT(B)
CAME C,.FBACT(Q3)
RET
TXNN P2,SIZPF ;SIZE IN PAGES
JRST .+5
HRRZ C,.FBBYV(B)
HRRZ D,.FBBYV(Q3)
CAME C,D
RET
TXNN P2,PLBF ;BYTES
JRST DFDC9
MOVE C,.FBSIZ(B)
CAME C,.FBSIZ(Q3)
RET
;ALSO MAKE SURE BYTES ARE SAME SIZE:
LDB C,[POINTR (<.FBBYV(B)>,FB%BSZ)]
LDB D,[POINTR (<.FBBYV(Q3)>,FB%BSZ)]
CAME C,D
RET
DFDC9: TXNN Q2,RETF ;VERSION RETENTION COUNT?
JRST DFDC10 ;NO
LDB C,[POINTR (<.FBBYV(B)>,FB%RET)]
LDB D,[POINTR (<.FBBYV(Q3)>,FB%RET)]
CAME C,D
RET
DFDC10: ;DATES AND TIMES
MOVE C,.FBCRV(B)
XOR C,.FBCRV(Q3)
TXNN P2,PCTF
TRZ C,-1 ;NOT TIME, MASK IT OUT.
TXNE P2,DCREF+PCTF ;CREATE DATE OR TIME TO BE PRINTED?
JUMPN C,[RET] ;YES, TEST FOR SAME
MOVE C,.FBWRT(B)
XOR C,.FBWRT(Q3)
TXNN P2,PWTF
TRZ C,-1
TXNE P2,DWRF+PWTF
JUMPN C,[RET]
MOVE C,.FBREF(B)
XOR C,.FBREF(Q3)
TXNN P2,PRTF
TRZ C,-1
TXNE P2,DRDF+PRTF
JUMPN C,[RET]
TXNN Q2,CHKF ;CHECKSUM?
JRST DFDC12 ;NO
MOVE C,FDBCHK(B)
CAME C,FDBCHK(Q3)
RET
MOVE C,FDBSUM(B)
CAME C,FDBSUM(Q3)
RET
DFDC12: MOVE C,.FBTDT(B) ; Tape write date/time
XOR C,.FBTDT(Q3)
TXNN P2,PTWF
TRZ C,-1 ; Not time, get rid of that
TXNE P2,PTDF+PTWF ; Doing tape-write date/time?
JUMPN C,R ; Do they match?
PUSH P,A ;SAVE A
PUSH P,B ;SAVE POINTER TO FDB
HLRO A,.FBUSE(B) ;GET POINTER TO LAST WRITER STRING
HLRO B,.FBUSE(Q3) ;OTHER FILE'S LAST WRITER STRING
STCMP ;COMPARE WRITER'S NAMES
HLL C,A ;SAVE COMPARISON RESULT IN L.H. OF C
POP P,B ;GET BACK POINTER TO LAST WRITER STRING
HRRO A,.FBUSE(B) ;MAKE POINTER TO AUTHOR NAME
HRRO B,.FBUSE(Q3) ;POINTER TO OTHER AUTHOR
STCMP ;COMPARE AUTHOR'S NAMES
HLR C,A ;STORE COMPARISON RESULT IN R.H. OF C
POP P,A ;RESTORE A
TXNE Q2,UCREF ;CREATE DIRS?
TRNN C,-1 ;YES, DIFFERENT?
CAIA ;NO
RET ;YES
TXNE Q2,UWRF ;WRITE DIRS?
TLNN C,-1 ;YES, DIFFERENT?
RETSKP ;NO
RET ;YES
;DFNOUT: SUBROUTINE FOR DFILE.
;LIKE NOUT EXCEPT ADDS TRAILING SPACES, LIKE "DFILL" (NEXT),
;USING DCNT IN SAME MANNER.
;REQUIRES A, B, C SET UP FOR NOUT, DCNT FOR DFILL.
;CLOBBERS B, C.
DFNOUT: PUSH P,A
HRROI A,DSBUF ;STRING BUFFER PTR
NOUT ;CONVERT NUMBER TO STRING IN CORE
CALL JERRC ;GENERAL JSYS ERROR ROUTINE FOR ERR # IN C
SETZ C,
IDPB C,A ;APPEND NULL (NOUT REALLY DOESN'T !)
POP P,A
HRROI B,DSBUF
;FALL INTO DFILL.
;DFILL: SUBROUTINE FOR DFILE.
;OUTPUT STRING B POINTS TO, THEN TYPE SPACES IF NECESSARY TO
;MAKE IT TAKE UP NUMBER OF COLUMNS SPECIFIED IN D.
;DESTINATION IN A; CLOBBERS B,C; RETURNS - # COLS OVERFLOW IN D.
DFILL: HLRZ C,B
CAIN C,-1
HRLI B,<POINT 7,0,-1>B53 ;FILL IN LH BYTE PTR FOR -1
ETYPE <%2m>
MOVE D,DCNT
ILDB C,B
SOJL D,DFILL9
JUMPN C,.-2
TXNN P2,SCF ;SUPPRESS COLUMNATION?
PRINT " "
SOJGE D,.-2
DFILL9: JUMPE C,[ AOJ D,
MOVEM D,DCNT ;UPDATE COLUMN POSITION
RET] ;REMOVE THE NULL TERMINATOR FROM COUNT
ILDB C,B ;COUNT CHARS OVER SPECIFIED MINIMUM
SOJA D,.-2
END