Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/exec3.mac
There are 47 other files named exec3.mac in the archive. Click here to see a list.
;713 add literals label
; use new configuration switches
;712 DEC release version
; UPD ID= 141, SNARK:<5.EXEC>EXEC3.MAC.12, 12-Mar-82 13:14:58 by CHALL
;TCO 6.1068 DSKR7- MAKE GNJFN LOOK FOR INV FILES FOR ARCHIVE OPTION, TOO
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21, 28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 53, SNARK:<5.EXEC>EXEC3.MAC.9, 26-Aug-81 10:35:11 by CHALL
;TCO 5.1476 - MAKE THE NOISE FOR EACH DIR COMMAND BE DISTINCT
; UPD ID= 34, SNARK:<5.EXEC>EXEC3.MAC.8, 14-Aug-81 19:12:33 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 13, SNARK:<5.EXEC>EXEC3.MAC.6, 16-Jul-81 09:02:54 by CHALL
;TCO 5.1414 ..SIZE- CHANGE (IN PAGES OR BLOCKS) TO (IN PAGES)
; UPD ID= 2236, SNARK:<5.EXEC>EXEC3.MAC.5, 22-Jun-81 15:23:31 by GROUT
;TCO 5.1377 - Make sequential checksumming on disk faster
;<HELLIWELL.EXEC.5>EXEC3.MAC.6, 18-May-81 10:02:38, EDIT BY HELLIWELL
;MAKE DECTAPE DIRECTORY SUPPORT NOT UNDER NOSHIP
; UPD ID= 2191, SNARK:<5.EXEC>EXEC3.MAC.3, 11-Jun-81 16:08:58 by MOSER
;TCO 5.1368 FIX A BUG IN TCO 5.1307.
; UPD ID= 1937, SNARK:<5.EXEC>EXEC3.MAC.2, 5-May-81 13:35:18 by GROUT
;tco 5.1307 - Fix DFILL so CTRL/V isn't counted on output
;REMOVE MFRK CONDITIONALS
; UPD ID= 1428, SNARK:<5.EXEC>EXEC3.MAC.9, 9-Jan-81 14:22:30 by OSMAN
;tco 5.1231 - Add RESIST-MIGRATION and PROHIBIT-MIGRATION subcommands
; UPD ID= 982, SNARK:<5.EXEC>EXEC3.MAC.8, 3-Sep-80 12:22:28 by HESS
; Use of DPGF flag incorrect for DECtapes
; UPD ID= 715, SNARK:<5.EXEC>EXEC3.MAC.7, 1-Jul-80 08:46:27 by OSMAN
;tco 5.1080 - Make TIMES (AND DATES OF) ON[OFF]LINE-EXPIRATION work right
; UPD ID= 682, SNARK:<5.EXEC>EXEC3.MAC.6, 20-Jun-80 13:41:04 by OSMAN
; UPD ID= 681, SNARK:<5.EXEC>EXEC3.MAC.5, 20-Jun-80 13:25:16 by OSMAN
;tco 5.1072 - Add ONLINE subcommand
; UPD ID= 533, SNARK:<5.EXEC>EXEC3.MAC.4, 20-May-80 14:55:38 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 487, SNARK:<4.1.EXEC>EXEC3.MAC.9, 28-Apr-80 15:59:38 by TOMCZAK
;TCO#4.1.1151 - Fix CRAM subcommand
;<4.1.EXEC>EXEC3.MAC.8, 29-Feb-80 14:06:33, EDIT BY OSMAN
;tco 4.1.1097 - Don't say "string space exhausted" after many DELETE commands
;<4.1.EXEC>EXEC3.MAC.7, 5-Nov-79 09:41:39, EDIT BY OSMAN
;tco 4.1.1007 - Prevent ill trap when XTND turned on and doing DIR EVERYTHING
;<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) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
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:!Z ;CHECKSUM CONTROL WORD
FDBSUM:!Z ;CHECKSUM
FDBRLN:!Z ;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::
XARC,< MOVX Q1,PONETF!POETF!PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PTWF!PLBF!DCREF!
DWRF!DRDF!POEF!SCF!PONEF>
NOXARC,<MOVX Q1,PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PTWF!PLBF!DCREF!DWRF!DRDF!SCF>
MOVX Q2,SHF!SNEF!UCREF!UWRF!RETF ;GET WRITE AND CREATE DIRS ALSO
NOISE <full, of files>
JRST DIR0
.VDIRE::MOVX Q1,PPF!SIZPF!PWTF!PLBF!DWRF
NONEWF,<MOVX Q2,VDIRF> ;VDIRECTORY FLAG
NEWF,< MOVX Q2,VDIRF!UWRF>
NOISE <verbose, of files>
JRST DIR0
XTND,<
.QD:: MOVX Q2,DFOF!VDIRF!UWRF ;DELETED FILES ONLY
MOVX Q1,PPF!SIZPF!PWTF!PLBF!DWRF
NOISE <of deleted files>
JRST DIR0
.RDIRE::SETZ Q2,
MOVX Q1,SIZPF!DRDF!PRTF
TXO Z,CHRDF!REVF
NOISE <of files by read date> ;7 correction
;7 NOISE <of files by creation date>
JRST DIR0
.WDIRE::MOVX Q2,UCREF!UWRF
MOVX Q1,SIZPF!DWRF!PWTF
TXO Z,CHWRF!REVF
NOISE <of files by write date>
JRST DIR0
>
;DIRECTORY.
; CAN TAKE AN ARGUMENT SPECIFYING DIRECTORY OR FILES TO LIST. CAN BE
; TERMINATED WITH COMMA TO INITIATE SUBCOMMAND INPUT.
;
; ACS: Z/ LH FLAGS:
; 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
; RH FLAGS:
DSKF==1B26 ;B26: DEVICE IS A DSK
MTAF==1B27 ;B27: DEVICE IS A MAGTAPE
DECF==1B28 ;B28: DEVICE IS A DECTAPE
PDNF==1B29 ;B29: DIRECTORY CHANGED
; FLAGS FOR ORDER OF PRINTOUT:
CHTPF==1B30 ;B30: CHRONOLOGICAL BY TAPE WRITE
CHWRF==1B31 ;B31: CHRONOLOGICAL BY WRITE DATE
CHRDF==1B32 ;B32: CHRON READ
CHCRF==1B33 ;B33: CHRON CREATION
ALPHAF==1B34 ;B34: ALPHABETIC
REVF==1B35 ;B35: INVERSE ALPHABETIC OR CHRONOLOGICAL
SORTF==CHTPF!CHWRF!CHRDF!CHCRF!ALPHAF ;SOME SORT OF SORTING NEEDED
;
; Q1/ FIELDS-TO-PRINT INFO A LA JFNS JSYS CALL.
; (SEE ALSO RH Q2)
DPGF==1B14 ;B14: DON'T PRINT GENERATION NUMBERS (FOR
; DECTAPE)
PONETF==1B15 ;B15: ONLINE EXPIRATION TIME
POETF==1B16 ;B16: OFFLINE EXPIRATION TIME
PPF==1B17 ;B17: PROTECTION
ACCF==1B20 ;B20: ACCOUNT
SIZPF==1B21 ;B21: SIZE IN PAGES OR BLOCKS
PCTF==1B22 ;B22: CREATION TIME (AND DATE)
PWTF==1B23 ;B23: WRITE TIME (AND DATE)
PRTF==1B24 ;B24: READ TIME (AND DATE)
PTWF==1B25 ;B25: TAPE-WRITE TIMES (AND DATES)
PLBF==1B26 ;B26: PRINT LENGTH IN BYTES
DCREF==1B27 ;B27: CREATE DATE
DWRF==1B28 ;B28: WRITE DATE
DRDF==1B29 ;B29: READ DATE
PTDF==1B30 ;B30: TAPE-WRITE DATE
POEF==1B31 ;B31: OFFLINE EXPIRATION DATE/INTERVAL
SCF==1B32 ;B32: SUPPRESS COLUMNATION (CRAM)
PONEF==1B33 ;B33: ONLINE EXPIRATION DATE/INTERVAL
Q1NTAP==PONETF!POETF!PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PTWF!PLBF!DCREF!
DWRF!DRDF!PTDF!POEF!PONEF ;INVALID Q1 SUBCOMMANDS FOR MAGTAPE
Q1NDTA==PONETF!POETF!PPF!ACCF!PCTF!PRTF!PTWF!PLBF!DCREF!DRDF!PTDF!
POEF!PONEF ;INVALID Q1 SUBCOMMANDS FOR DECTAPE
;
; Q2/ LH FLAGS FOR FORMAT, ETC:
RESTO==1B5 ;B5: RESISTED-MIGRATION FILES ONLY
PROHBO==1B6 ;B6: PROHIBITED-MIGRATION FILES ONLY
OFFO==1B7 ;B7: OFFLINE FILES ONLY
ONOF==1B8 ;B8: ONLINE FILES ONLY
INVFO==1B9 ;B9: INVISIBLE FILES ONLY
ARFO==1B10 ;B10: ARCHIVED FILES ONLY
VDIRF==1B11 ;B11: VDIRECTORY, ONLY DIR PART OF HEADING
; PRINTS
FHF==1B12 ;B12: 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
;
; 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
FSCF==1B23 ;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==RESTO!PROHBO!OFFO!ONOF!INVFO!ARFO!DFOF!CHKF!UCREF!UWRF!RETF!
BEFORF!SINCEF!SMALLF!LARGEF ;SUBCOMMANDS DENOTED IN Q2 THAT AREN'T ALLOWED
; FOR MAGTAPE
Q2NDTA==RESTO!PROHBO!OFFO!ONOF!INVFO!ARFO!DFOF!UCREF!UWRF!RETF
;INVALID Q2 SUBCOMMANDS FOR DECTAPE
.TDIRE::TXO Z,CHWRF!REVF ;CHRON BY WRITE DATE, REVERSE
MOVX Q1,PWTF!DWRF ;WRITE TIME, DATE
NOISE <of files by write date>
SETZ Q2, ;NO SPECIAL FORMAT
JRST DIR0
.DIREC::SETZB Q1,Q2 ;NOTHING SPECIAL AT ALL
NOISE <of files>
;ALL DIRECTORY'S JOIN HERE
DIR0: TRVAR <ONMESL,OFMESL,TFORMT,TABLNX,NOFLG,SAVPTR,REALP2,SAVQ3,SVDCNT,
DIRJFN,DCNT,NEWPTR,CELADR,TPWRNF,DTWRNF,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,SEQPGC,SEQSWC>
SETZM KEPDNM ;INITIALIZE TO NO "FIND"
SETZM LPFDB
SETZM DIRJFN ;NO SPECIAL JFN YET
SETZM GRANDF ;NO REQUESTING GRAND TOTAL YET
SETOM TYPING ;TYPEOUT HAPPENING
;DECODE ARGUMENT LIST WITH SUBROUTINE "DIRARG" IN EXECSU.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?
ABSKP ;NO
ETYPE <%Can't summarize checksums during "FIND"%_>
;EXECUTE "DIRECTORY"
;OPEN OUTPUT FILE, IF ANY.
SKIPN A,DIRJFN ;OUTJFN
JRST DIRREG ;NO SPECIAL JFN
MOVX B,OF%WR ;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 MAGTAPE SUBCOMMANDS
; YET
SETZM DTWRNF ;HAVEN'T WARNED ABOUT BAD DECTAPE 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
HRROI A,OFMES ;MEASURE LENGTHS OF HEADER STRINGS
CALL BCOUNT
ADDI B,1 ;LEAVE SPACE BETWEEN FIELDS
MOVEM B,OFMESL
HRROI A,ONMES
CALL BCOUNT
ADDI B,1 ;LEAVE SPACE BETWEEN FIELDS
MOVEM B,ONMESL
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
MOVE 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: CALL 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,[POINTR B,DV%TYP] ;DEVICE TYPE
TXZ Z,DSKF!MTAF!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
SETZ C, ;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
CAIE B,.DVDTA ;DECTAPE?
ERROR <Illegal device>
;DECTAPE. DEV DESIGNATOR IN A.
TXO Z,DECF ;SAY DECTAPE
CALL DTADIR ;SET UP 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 "*"?
ABSKP ;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,[.FHSLF,,BUF0PN]
MOVX C,FLD(1,PM%RPT)
PMAP
UNMDR1: SETO A,
MOVE B,[.FHSLF,,BUF1PN]
MOVX C,PM%CNT!FLD(<BUFLPN-BUF1PN+1>,PM%RPT)
PMAP
RET
;DIRECTORY...
;SUBCOMMAND TABLE
$DIRS: TABLE
T account,ONEWRD,...ACC
T alphabetically,
T archive,,.AROLY ;ARCHIVED FILES ONLY
T before ;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
LPTD,< T lpt> ;713
T no,,..NO
T offline,,.OFOLY ;OFFLINE FILES ONLY
T online ;ONLINE FILES ONLY
T output
T prohibit-migration,,.PROLY ;PROHIBITED-FROM-MIGRATION FILES ONLY
T protection,ONEWRD,..PROT
T resist-migration,,.REOLY ;RESISTED-FROM-MIGRATION FILES ONLY
T reverse
T separate
T since ;WRITTEN "SINCE" GIVEN TIME AND DATE
T size,,..SIZE
T smaller ;"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,FSCF
RET
.CRAM: NOISE <output>
CONFIRM
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
MOVE A,(P3) ;GET DATE BIT
TLNE Z,F1 ;TIME WANTED WITH DATE?
IOR A,1(P3) ;YES, ACCUMULATE TIME BIT WITH DATE BIT
SKIPN NOFLG ;DIFFERENT ACTION ON "NO"
IOR Q1,A ;UPDATES JFNS OPTIONS FROM TABLE
SKIPE NOFLG
TDZ Q1,A ;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
PCTF]
XARC,< T offline-expiration,,[POEF
POETF]
T online-expiration,,[PONEF
PONETF]
>
T read,,[DRDF
PRTF]
T tape-write,,[PTDF
PTWF]
T write,,[DWRF
PWTF]
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
.REOLY: NOISE <files only>
CONFIRM
TXO Q2,RESTO
RET
.PROLY: NOISE <files only>
CONFIRM
TXO Q2,PROHBO
RET
.OFOLY: NOISE <files only>
CONFIRM
TXO Q2,OFFO
TXZ Q2,ONOF ;CANCEL POSSIBLE PREVIOUS ONLINE
RET
.ONLIN: NOISE <files only>
CONFIRM
TXO Q2,ONOF
TXZ Q2,OFFO ;CANCEL POSSIBLE PREVIOUS OFFLINE
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:
XARC,< IOR Q1,[1B8!1B11!DPGF!PONETF!POETF!PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!
PTWF!PLBF!DCREF!DWRF!DRDF!POEF!PONEF!1B34!1B35]>
NOXARC,<IOR Q1,[1B8!1B11!DPGF!PPF!ACCF!SIZPF!PCTF!PWTF!PRTF!PTWF!PLBF!DCREF!
DWRF!DRDF!1B34!1B35]> ;ALL FIELDS THAT CAN BE PRINTED
TDO Q2,[SNEF!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:"
LPTD,< ;713
.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::MOVX 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
> ;713 end LPTD
.OUTPU: NOISE <to file>
MOVE A,[[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
LPTD,< T lpt,ONEWRD,.NLPT> ;713
T protection,ONEWRD,.NPROT
T reverse,,.NREVER
T separate,ONEWRD,.NSEPA
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: TXO Q2,SHF ;SAY NO HEADER
TXZ Q2,FHF ;SAY DON'T FORCE HEADER
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!SNEF
RET
.NSEPA: TXZ Q2,SMVF!SNEF ;NO SEPARATE
RET
..SIZE: NOISE <in pages>
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
OFMES: ASCIZ/Offline expiration/ ;USED AND MEASURED HEADER STRINGS
ONMES: ASCIZ/Online expiration/
;DHEAD
; TYPE HEADING, IF ANY, FOR DISK FILE DIRECTORY PRINTOUT. THIS ROUTINE MUST
; BE CHANGED WHENEVER DFILE'S FORMAT IS CHANGED!
;
; ACCEPTS: Q1/ FIELDS TO PRINT BITS
; Q2/ SHF TO SUPPRESS HEADING
DHEAD: TXNE Z,DECF
JRST DTAHDR ;DECTAPE HEADER IS DIFFERENT
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,PONETF!POETF!SIZPF!PCTF!PWTF!PRTF!PTWF!PLBF!DCREF!DWRF!DRDF!
PTDF!POEF!PONEF ;ANYTHING TO LIST AFTER ACCT FIELD?
TXNE Q2,CHKF!UCREF!UWRF!RETF ;ANY OF THIS MAGIC?
ABSKP ;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
SETZ C, ;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,PCTF!DCREF ;CREATION DATE
ETYPE <Creation %3M>
TXNE P2,PCTF ;CREATION TIME
ETYPE < %3M>
TXNE P2,PWTF!DWRF
ETYPE <Write %3M>
TXNE P2,PWTF
ETYPE < %3M>
TXNE P2,PRTF!DRDF
ETYPE <Read %3M>
TXNE P2,PRTF
ETYPE < %3M>
TXNE P2,PTWF!PTDF
ETYPE <Tape-write %3M>
TXNE P2,PTWF
ETYPE < %3M>
TXNE P2,PONETF!PONEF
ETYPE <Online expiration %3M>
HRROI A,OFMES ;POINT TO "OFFINE EXPIRATION"
TXNE P2,POETF!POEF
ETYPE <%1M %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.
XTRAS==2 ;EXTRA SPACES NEEDED
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,ACCF ;ACCT CROSSES ANOTHER.
PRINT .CHTAB
TXNN P2,SCF ;UNLESS COLUMNATION SUPPRESSED,
PRINT .CHTAB ;FOLLOWING FIELDS BEGIN AT NEXT TAB STOP
SKIPLE A,[XTRAS] ;ANY EXTRA SPACES NEEDED?
DINDN1: PRINT " " ;YES, PRINT THEM
SOJG A,DINDN1 ;PRINT DESIRED NUMBER
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
ETYPE < LIST protection violation%_> ;FOR A SINGLE FILE
TLNE Z,GROUPF
ETYPE < Plus file(s) that are LIST protected from you%_>
DSKP5: SETZM LPNAME ;NOT "SAME NAME AS PREVIOUS" YET
SETZM LPEXT
TXNN Z,DECF ;IS THIS A DECTAPE?
JRST DSKP6 ;NO, CHECK MAGTAPE
SETZ A, ;NO ILLEGAL OPTIONS YET
TXZE P2,Q1NDTA ;TURN OFF ALL OPTIONS ILLEGAL FOR DECTAPE
MOVEI A,1 ;FLAG SOME WERE ON
TXZE Q2,Q2NDTA ;TURN OFF ALL OPTIONS ILLEGAL FOR DECTAPE
MOVEI A,1 ;FLAG SOME WERE ON
CAIE A,0 ;ANY ON?
SKIPE DTWRNF ;YES, WARNING GIVEN YET?
ABSKP ;NO, NO MESSAGE
ETYPE <%%Invalid options for dectape being ignored%_>
SETOM DTWRNF ;REMEMBER GIVEN
JRST DSKP0
DSKP6: TXNN Z,MTAF ;NO. IS THIS A TAPE?
JRST DSKP0 ;NO WARNINGS NECESSARY
SETZ A, ;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?
ABSKP
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
ABSKP ;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
MOVX C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF ;PRINT DEV, PRINT
; DIR, PUNCUATE
TXNE Z,MTAF!DECF ;IS THIS A MAGTAPE OR DECTAPE?
MOVX C,FLD(.JSSSD,JS%DEV)!JS%PAF ;YES. GET DEVICE ONLY THEN
JFNS
ERJMP R
SKIPN DSBUF
JRST DNAMEX ;NULL STRING, PRINT NOTHING
TXNE Z,MTAF!DECF ;IS THIS AN MT OR DTA?
JRST [SETZM NAMDIR
JRST DNAME8] ;YES. NO DIRECTORY THEN
PUSH P,A
MOVX 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
ABSKP ;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)
MOVX C,NO%MAG!NO%LFL!NO%ZRO!FLD(6,NO%COL)!FLD(10,NO%RDX)
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 - DECTAPE SPECIFIC
;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.
DTADIR: TXNN Z,SORTF ;ORDER SPCIFIED?
TXO Z,ALPHAF ;NO, DEFAULT TO ALPHABETIC
;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
DTADR2: ILDB D,B ;FETCH A SLOT BYTE
AOS DTATBL(D) ;INDEX APPROPRIATE TABLE WORD
SOJG C,DTADR2
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,[-^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
;DSKDIR
; SUBROUTINE TO LIST DISK OR DECTAPE DIRECTORY READS (WITH
; GNJFN),SORTS,PRINTS ONE DIRECTORY
;
; ACCEPTS: Z/ FLAGS, SEE COMMENT FOR Q1,Q2
; A/ SOURCE DEVICE DESIGNATOR FOR DECTAPE
; Q1,Q2/ VARIOUS FLAGS, SEE COMMENTS AT BEGINNING OF
; "DIRECTORY", INCL Q2 B12 FOR DECTAPE.
; INIFH1/ POINTER TO INDEXABLE FILE HANDLE
; RETURNS: Z/ F2 SET IF ADDITIONAL FILES ARE TO BE LISTED FOR CURRENT
; INDEXABLE FILE HANDLE.
; CLOBBERS A-D,Q3-GG.
;BUFFER DEFINITIONS
DTADRC==BUF0 ;WHERE DECTAPE DIRECTORY IS READ
DTATBL==BUF0+200 ;TABLE FOR DECTAPE FILE LENGTHS
CHKBUF==BUF1 ;WHERE TO READ DATA FOR CHECKSUM
CKBFPN==BUF1PN ;7
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 EXECDE.MAC. SUCCESSIVE PAGES UPWARD FROM BUF1 ARE USED.
; THERE ARE ENOUGH PAGES BELOW DDT AS LONG AS DIRECTORY LENGTH REMAINS
; LIMITED TO 4K.
;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.
DSKDIR: SETZ P4, ;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 [ETYPE < 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
TXNE Z,MTAF!DECF ;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?
ABSKP ; 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,RESTO ;RESIST-MIGRATION ONLY?
JRST DSKNRE ;NO
MOVE A,.FBBBT(C) ;YES, GET INFO FOR THIS FILE
TXNN A,AR%NAR ;IS THIS FILE RESISTED?
JRST DSKR7 ;NO, SO SKIP IT
DSKNRE: TXNN Q2,PROHBO ;PROHIBIT-MIGRATION ONLY?
JRST DSKNBO ;NO
MOVE A,.FBBBT(C) ;YES, GET INFO
TXNN A,AR%EXM ;IS THIS FILE PROHIBITED FROM MIGRATION
JRST DSKR7 ;NO, SO SKIP IT
DSKNBO: 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,ONOF ;USER ONLY WANTS ONLINE?
TXNN A,FB%OFF ;YES. IS THIS FILE ONLINE?
ABSKP ;USER DIDN'T CARE, OR DOES AND FILE IS ONLINE.
JRST DSKR7 ;USER WANTS ONLINE ONLY, AND THIS FILE IS
; OFFLINE.
TXNE Q2,OFFO ;OFFLINE ONLY?
TXNE A,FB%OFF ;YES, IS FILE OFFLINE?
ABSKP ;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?
ABSKP ;ONE OF THEM IS ON
JRST DSKR7
TXNN Q2,INVFO ;WANT TO FILTER OUT VISIBLE FILES?
TXZ A,FB%INV ;NO, MAKE INVISIBLE 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
MOVX B,FLD(44,OF%BSZ)!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
DVCHR ;DEVICE CHARACTERISTICS FOR JFN
HLRZ A,A
CAIE A,.DVDES+.DVDSK ;DSK?
JRST DSKRC1 ;NO, DO IT SEQUENTIALLY
TXNN Q2,FSCF ;SEQUENTIAL DISK CHECKSUM?
JRST DSKRC5 ;NO, SKIP SEQUENTIAL DISK SETUP
LOAD C,FB%BSZ,.FBBYV(D) ;COMPUTE LAST FULL PAGE OF FILE
MOVX A,^D36
IDIV A,C ;COMPUTE NUMBER OF BYTES IN WORD
MOVE B,.FBSIZ(D) ;GET FILE SIZE IN BYTES
IDIV B,A ;COMPUTE NUMBER OF WORDS IN FILE
LSH B,-^D9 ;COMPUTE NUMBER OF PAGES BEFORE USING SIN
JUMPE B,DSKRC1 ;IF NONE TO USE, GO START SIN'ING,
MOVEM B,SEQPGC ;OTHERWISE STORE SEQUENTIAL PAGE COUNTER
LSH B,^D9 ;COMPUTE WORD NUMBER TO START SIN'ING AT
MOVEM B,SEQSWC ;STORE SIN WORD COUNT
JRST DSKRC7 ;AND REJOIN COMMON CODE
DSKRC5: SETZM SEQPGC ;MAKE SOSE AT END OF LOOP ALWAYS FAIL
SETOM FDBCHK(D) ;FLAG CHECKSUM BY PAGES
AOS DIRFL1 ;COUNT FOR SUMMARY
AOS DIRFL2 ;AND FOR GRAND
DSKRC7: HRLZ A,@INIFH1 ;GET JFN,,0
MOVE B,[.FHSLF,,CKBFPN] ;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
TXNN Q2,FSCF ;JUMP IF DOING SEQUENTIAL CHECKSUM
CAIN D,0 ;OR IF NO HOLE
JRST DSKRC4
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 ;SET UP AOBJN POINTER TO WHOLE PAGE
CALL CHKSOM ;CHECKSUM IT
ADDI A,1 ;COMPUTE NEXT PAGE TO GET
SOSE SEQPGC ;WAS THIS THE LAST PAGE TO DO WITH PMAP?
JRST DSKRC3 ;NO, GO GET NEXT PAGE
SETO A, ;RELEASE CHKBUF PAGE FROM MAP
MOVE B,[.FHSLF,,CKBFPN]
SETZ C,
PMAP
HRRZ A,@INIFH1 ;RESET BYTE POINTER FOR SIN'ING
MOVE B,SEQSWC
SFPTR
CALL CJERR ;SHOULD NEVER FAIL
DSKRC1: HRRZ A,@INIFH1 ;GET JFN AGAIN
MOVE B,[POINT 36,CHKBUF] ;INTO CHKBUF
MOVNI C,1000 ;MAX 1000 WORDS
SIN
MOVNI C,1000(C) ;MAKE AOBJN POINTER TO WORDS READ
HRLZ C,C
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: MOVNI C,1000(C) ;MAKE AOBJN POINTER TO WORDS READ
JUMPE C,DSKRC2 ;IN CASE NO WORDS READ
HRLZ C,C
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,,CKBFPN]
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
MOVX C,FLD(^D10,NO%RDX) ;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
MOVX C,FLD(.JSAOF,JS%ACT)
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
SETZ C,
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
SETZ C,
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
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,(ASCPTR) ;NAME
HRR P5,.FBCTL(D)
MOVX P4,6
DTADRN: ILDB P3,P5 ;NAME CHAR LOOP
CAIE P3,0
SUBI P3,40
LSH P3,36
LSHC P2,6
SOJG P4,DTADRN
HRLI P5,(ASCPTR) ;EXTENSION
HLR P5,.FBEXL(D)
MOVX P4,3
DTADRE: ILDB B,P5 ;EXT CHAR LOOP
CAIE B,0
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
;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
TXNN Q2,INVFO!ARFO ;DOING INVISIBLE OR ARCHIVED FILES?
TXO A,GJ%GIV ;NO, DON'T LET GNJFN FIND THEM
TXNE A,77B5 ;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
ABSKP ;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
TXNN 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?
ABSKP ;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.
SETZ P4, ;INDEX OF CURRENT (LAST INSERTED) SORTED TABLE
; ENTRY
MOVX 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, SEE BELOW
;UNSORTED ENTRY GREATER, SEARCH FORWARD
GRATR: LDB P4,[POINT 9,TABLE(P4),17] ;GET FWD PTR
CALL FDBSC ;COMPARE AGAIN
JRST GRATR1 ;LESS
JRST GRATR1 ;EQUAL OR AT END OF TABLE
JRST GRATR ;GREATER, KEEP SEARCHING
;LESS OR EQUAL, PUT IT BEFORE THIS ONE
GRATR1: 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
; COMPARES FDBS ACCORDING TO SORT KEY SPECIFIED
;
; ACCEPTS: Z/ RH HAS SORT KEY FLAGS
; P1,P4/ INDICES TO TABLE ENTRIES
; RETURNS: +1 IF P4 LESS
; +2 IF P4 EQUAL, OR P4 POINTS TO NULL TABEL ENTRY
; +3 IF P4 GREATER
; 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 ARE EQUAL, COMPARE EXTENSIONS
HLRZ A,.FBEXL(Q1)
HLRZ B,.FBEXL(Q3)
CALL FDBSTC
;EXTENSIONS ARE EQUAL, COMPARE VERSIONS
HLRZ A,.FBGEN(Q1)
HLRZ B,.FBGEN(Q3)
JRST FDBSC3 ;JOIN CHRONOLOGICAL CASE FOR COMPARE
;DSKDIR... SUBR FDBSC...
; FOR EACH CHRONOLOGICAL COMPARISON FETCH THE DATES AND TIMES TO COMPARE THEN
; CONVERGE ON COMPARE
FDBSC2: TXNN Z,CHTPF ;TAPE-WRITE
JRST FDBSC4
MOVE A,.FBTDT(Q1)
MOVE B,.FBTDT(Q3)
JRST FDBSC3
FDBSC4: TRNN Z,1B31
JRST FDBSC5
MOVE A,.FBWRT(Q1) ;WRITE
MOVE B,.FBWRT(Q3)
JRST FDBSC3
FDBSC5: TXNN Z,CHRDF ;CHRONOLOGICAL BY READ?
JRST FDBSC6
MOVE A,.FBREF(Q1) ;READ
MOVE B,.FBREF(Q3)
JRST FDBSC3
FDBSC6: 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.
;
; ACCEPTS: A,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 [ADJSP P,-1 ;FORGET RETURN
JRST FDBLS]
ADJSP P,-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: SETZ P4, ;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
TXNE Z,DECF ;DTA?
JRST COUNT1 ;YES, DO BLOCKS
SKIPGE DIRCN1
SETZM DIRCN1
SKIPGE DIRCN2
SETZM DIRCN2
ADDM A,DIRCN1
ADDM A,DIRCN2
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
;
; ACCEPTS: Q2/ SMVF: DON'T PUT MULTIPLE VERSIONS OF SAME NAME.EXT ON
; SAME LINE
; SNEF: 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
; 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
;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
MOVX B,"," ;USE A COMMA,
SUBI D,1
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
MOVX D,3 ;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: MOVX B,"."
DFL05A: TXNE Z,DECF ;NO GENERATION FOR DECTAPE
JRST DFL05B
PRINT @B ;ADDITIONAL VERSION ON SAME LINE JOINS HERE
HLRZ B,.FBGEN(Q3) ;VERSION
MOVX C,FLD(^D10,NO%RDX)
CALL DFNOUT ;NOUT AND KEEP TRACK OF COLS USED.
DFL05B: 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,["*"]
MOVX 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.
;
; ACCEPTS: Q1,Q2/ AS FOR "DFILE" ABOVE.
; LPFDB/ ZERO OR POINTER TO FDB FOR WHICH TO FINISH PRINTOUT
; LFPOS/ - # COLS LINE OVERFLOW, AS REQUIRED FOR "DFILL"
; 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
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
MOVX C,FLD(10,NO%RDX)
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: TRNN P2,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,(B) ;MAKE PROPER LH
CALL DFILL ;PRINT THE STRING
JRST DFR08
DFR07A: TLZ B,700000 ;NUMERICAL ACCT: CLEAR HI BITS.
MOVX C,FLD(^D10,NO%RDX) ;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 DFR81 ;7 no, check next field
;7 JRST DFR86
HRROI B,[ASCIZ/;T/]
CALL DFILL ;SOUT AND KEEP TRACK OF COLUMNS
DFR81: LDB C,[POINTR .FBCTL(Q3),FB%FCF] ;7 get file class
SETZ B, ;7
CAIN C,.FBKEP ;7 autokeep?
HRROI B,[ASCIZ/;K/] ;7 yes
CAIN C,.FBEPH ;7 ephemeral?
HRROI B, [ASCIZ/;E/] ;7 yes
SKIPE B ;7 if none of the above, don't print anything
CALL DFILL ;7 otherwise, print the string
DFR86: MOVE B,.FBCTL(Q3)
TXNN B,FB%OFF ;OFFLINE?
JRST DFR09 ;NYET
HRROI B,[ASCIZ/;OFFLINE/]
CALL DFILL
;DFREST...
DFR09: TXNN P2,PONETF!POETF!SIZPF!PCTF!PWTF!PRTF!PTWF!PLBF!DCREF!DWRF!DRDF!
PTDF!POEF!PONEF ;ANYTHING MORE TO PRINT?
TXNE Q2,CHKF!UCREF!UWRF!RETF
ABSKP
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
MOVX D,14+XTRAS ;RAISED FROM 14 WHEN ";OFFLINE" ADDED
TXNE Z,DECF ;FOR DECTAPE
SUBI D,2 ;2 LESS
ADDM D,DCNT
MOVX D,6 ;ANOTHER TAB STOP FOR PROT
TXNE P2,PPF
ADDM D,DCNT
TRNE P2,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
MOVX C,FLD(^D10,NO%RDX) ;DECIMAL
CAIGE B,^D1000 ;WILL FIT IN 3 COLS?
HRLI C,(<NO%LFL!FLD(3,NO%COL)>) ;YES, RIGHT JUSTIFY IT
MOVX 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: TXNN P2,PLBF
JRST DFR10A
MOVE B,.FBSIZ(Q3)
MOVX C,FLD(^D10,NO%RDX) ;DECIMAL
CALL DFNOUT ;NO COLUMNATION YET
PRINT "("
LDB B,[POINTR (<.FBBYV(Q3)>,FB%BSZ)] ;BYTE SIZE
MOVX C,FLD(^D10,NO%RDX)
CALL DFNOUT
PRINT ")"
HRROI B,[ASCIZ/ /] ;NOW A SEPERATING SPACE, PLUS ENOUGH MORE
MOVX D,11 ;SO "SIZE(LENGTH)" TAKES UP 10 COLS,
ADDM D,DCNT
CALL DFILL ;( 10 - ()'S+" "=9), LESS EXCESS USED BY NAME.
DFR10A: TXNN Q2,RETF
JRST DFR10B
LDB B,[POINTR (<.FBBYV(Q3)>,FB%RET)] ;GEN RET COUNT
MOVX C,FLD(^D10,NO%RDX) ;DECIMAL
TXNN P2,SCF ;COLUMNATING?
HRLI C,(<NO%LFL!FLD(3,NO%COL)>) ;YES, RIGHT JUSTIFY IT
MOVX D,3 ;3 COLS MIN WIDTH, LESS PRECEDING OVERFLOW
ADDM D,DCNT
CALL DFNOUT ;NOUT WITH FANCY COLUMNATION
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.
MOVEM C,TFORMT ;REMEMBER ODTIM FORMAT FLAGS
TXNN P2,PCTF!DCREF
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.
DFR11: TXNN P2,PWTF!DWRF
JRST DFR12
TXZ C,OT%NTM
TXNN P2,PWTF
TXO C,OT%NTM
MOVE B,.FBWRT(Q3) ;WRITE DATE
TXNE Z,DECF
JRST [CALL DTADAT ;PRINT DECTAPE FORMAT DATE
PRINT " "
JRST DFR12]
JUMPE B,[CALL TNEVER
JRST DFR12]
CALL DOOTIM
DFR12: TXNN P2,PRTF!DRDF
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
DFR120: TXNN P2,PTWF!PTDF
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
DFR129: TXNN P2,PONETF!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 [MOVE A,ONMESL ;GET CORRECT WIDTH
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 [HRLZ B,B ;PUT # DAYS IN DAYS PORTION OF D&T
ADD B,C ;ADD IN MOST RECENT DATE & TIME
JRST .+1]
MOVE C,TFORMT ;GET FORMAT FLAGS
TXNN P2,PONETF
TXO C,OT%NTM ;INCLUDE THE TIME
MOVE A,ONMESL ;GET CORRECT WIDTH
CALL DFTIM ;PRINT DATE OR DATE-TIME
DFR130: TXNN P2,POETF!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 [MOVE A,OFMESL ;GET CORRECT WIDTH
CALL DFNA ;NOT ON TAPE YET, N/A
JRST DFR131]
TLNN B,-1 ;INTERVAL?
JRST [HRLZ B,B
ADD B,C ;ADD # DAYS TO DAY PART
JRST .+1]
MOVE C,TFORMT ;GET ODTIM FORMAT FLAGS
TXNN P2,POETF
TXO C,OT%NTM ;INCLUDE THE TIME
MOVE A,OFMESL ;GET LENGTH OF OFF-LINE HEADER MESSAGE
CALL DFTIM ;PRINT DATE OR DATE-TIME
DFR131: TXNN Q2,UCREF ;CREATE DIR?
JRST DFR12B
HRRO B,.FBUSE(Q3)
CALL DFRDIR
DFR12B: 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)
MOVX C,NO%MAG!NO%LFL!NO%ZRO!FLD(6,NO%COL)!FLD(10,NO%RDX)
MOVX D,7
ADDM D,DCNT
CALL DFNOUT
MOVX B," "
SKIPGE FDBCHK(Q3)
MOVX 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>
;EOL AND EXIT
DFR121:
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: MOVX D,11
ADDM D,DCNT
CALL DFILL
PRINT " "
RET
DFNA: ADDM A,DCNT
HRROI B,[ASCIZ"N/A"]
CALL DFILL ;PRINT STRING AND FILL
PRINT " " ;AT LEAST ONE SPACE
RET
DFNONE: HRROI B,[ASCIZ/None /]
ETYPE <%2M>
RET
;SUBROUTINE DTADAT - PRINTS DECTAPE FORMAT DATE
; USED IN DFREST, OLDTAD.
;
; ACCEPTS: B/ DECTAPE FORMAT 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
;DCMPR - SUBOUTINE FOR DFILE.
;
; ACCEPTS: B,C/ POINTERS TO STRINGS
; RETURNS: +1 NEITHER POINTER IS ZERO, AND STRINGS ARE NOT SAME
; +2 EITHER POINTER IS ZERO, OR IF STRINGS ARE SAME
DCMPR: JUMPE C,RSKP
JUMPE B,RSKP
HRLI B,(ASCPTR)
HRLI C,(ASCPTR)
DCMPR1: ILDB A,C
ILDB D,B
CAME A,D
RET ;DIFFERENT
JUMPN A,DCMPR1 ;TERMINATE ON NULL
RETSKP
;DFDBCM: COMPARE FDB'S, COMPARE ONLY FIELDS TO BE PRINTED
; ONE CALL IN "DFILE".
;
; ACCEPTS: E/ DFILE FORMAT WORD (FIELDS TO BE COMPARED)
; Q3/ POINTER TO FDB
; LPFDB/ POINTER TO FDB
; RETURNS: +1 FDB'S NOT SAME
; +2 FDB'S SAME
; CLOBBERS: B,C,D
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%TMP!FB%BAT!FB%OFF!FB%FCF ;7 BAT/TMP/OFF DIFFERENT? - add FCF
RET ;YES, GIVE DIFFERENT RETURN
TXNN P2,PPF ;PROTECTION: IS IT TO BE LISTED?
JRST DFDBC1 ;NO, CONTINUE COMPARING FIELDS
MOVE C,.FBPRT(B)
CAME C,.FBPRT(Q3) ;IS IT SAME?
RET ;NO, DIFFERENT
DFDBC1: TRNN P2,ACCF ;ACCOUNT
JRST DFDBC2
MOVE C,.FBACT(B)
CAME C,.FBACT(Q3)
RET
DFDBC2: TXNN P2,SIZPF ;SIZE IN PAGES
JRST DFDBC3
HRRZ C,.FBBYV(B)
HRRZ D,.FBBYV(Q3)
CAME C,D
RET
DFDBC3: TXNN P2,PLBF ;BYTES
JRST DFDC9
MOVE C,.FBSIZ(B)
CAME C,.FBSIZ(Q3)
RET
LDB C,[POINTR (<.FBBYV(B)>,FB%BSZ)] ;ALSO MAKE SURE BYTES ARE SAME SIZE
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: MOVE C,.FBCRV(B) ;DATES AND TIMES
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,PTWF!PTDF ;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?
ABSKP ;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.
;
; ACCEPTS: 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
POP P,A
HRROI B,DSBUF
CALLRET DFILL ;PRINT STRING AND FILL
;DFTIM - IS LIKE DFNOUT BUT PRINTS A DATE/TIME
;
; ACCEPTS: A/ WIDTH OF FIELD
; B,C/ ODTIM STUFF
DFTIM: ADDM A,DCNT ;TELL DFILL ABOUT THE FIELD WIDTH
HRROI A,DSBUF ;WRITE STRING TO BUFFER
ODTIM
HRROI B,DSBUF ;POINT TO STRING AGAIN
CALL DFILL ;PRINT STRING AND FILL IN
PRINT " " ;LEAVE AT LEAST ONE SPACE
RET
;DFILL - SUBROUTINE FOR DFILE.
;
; ACCEPTS: B/ STRING TO OUTPUT
; DCNT/ FIELD WIDTH (FILLS WITH TRAILING SPACES)
; RETURNS: D/ NUMBER OF COLUMNS OVERFLOW
; CLOBBERS: B,C
DFILL: HLRZ C,B
CAIN C,-1
HRLI B,(ASCPTR) ;FILL IN LH BYTE PTR FOR -1
ETYPE <%2M>
MOVE D,DCNT
DFILL1: ILDB C,B
CAIE C,.TICCV ;IS CHAR A CTRL/V?
SOJL D,DFILL9 ;NO, CHECK FOR OVERFLOW
JUMPN C,DFILL1
DFILL2: TXNN P2,SCF ;SUPPRESS COLUMNATION?
PRINT " "
SOJGE D,DFILL2
DFILL9: JUMPE C,[ADDI D,1
MOVEM D,DCNT ;UPDATE COLUMN POSITION
RET] ;REMOVE THE NULL TERMINATOR FROM COUNT
ILDB C,B ;COUNT CHARS OVER SPECIFIED MINIMUM
CAIE C,.TICCV ;CONTROL-V?
SOJA D,DFILL9
JRST DFILL9
LITS3: ;713 debugging aid: literals label
END