Trailing-Edge
-
PDP-10 Archives
-
bb-d868c-bm_tops20_v4_2020_distr
-
4-sources/dumper.mac
There are 42 other files named dumper.mac in the archive. Click here to see a list.
;<4.UTILITIES>DUMPER.MAC.247, 3-Jan-80 15:25:42, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 129, SNARK:<4.UTILITIES>DUMPER.MAC.246, 12-Dec-79 17:03:24 by R.ACE
;TCO 4.2593 - FIX FOR RESTORING ARCHIVED FILES, FIX FOR CLEARING AR%RAR
;<4.UTILITIES>DUMPER.MAC.245, 19-Oct-79 06:26:28, EDIT BY R.ACE
;CHANGE TAG OF "PRINT" COMMAND HANDLER FROM "$DIR" TO "PRINT"
;BECAUSE OF CONFLICT WITH $DIR MACRO IN GLXMAC
;<4.UTILITIES>DUMPER.MAC.244, 19-Oct-79 05:57:30, EDIT BY R.ACE
;FIX RESTORE OF INVISIBLE BIT FOR BBN TAPES
;<4.UTILITIES>DUMPER.MAC.243, 25-Sep-79 09:36:52, EDIT BY R.ACE
;TCO 4.2484 - LABELED-TAPE SKIP - DON'T STOP AT END OF VOLUME
;<4.UTILITIES>DUMPER.MAC.242, 20-Sep-79 06:56:44, EDIT BY R.ACE
;TCO 4.2477 - CLEAN UP "UNABLE TO SET TAPE DATA MODE" A BIT
;<4.UTILITIES>DUMPER.MAC.241, 12-Sep-79 06:59:08, EDIT BY R.ACE
;TCO 4.2458 - DON'T CLEAR TNSF IN TAPE, REWIND COMMANDS
;<4.UTILITIES>DUMPER.MAC.240, 10-Sep-79 14:26:44, EDIT BY DBELL
;TCO 4.2450 - PREVENT "INVALID WILDCARD" ERROR IN INTERCHANGE MODE (AGAIN)
;<4.UTILITIES>DUMPER.MAC.239, 7-Sep-79 07:42:10, EDIT BY R.ACE
;FOR BBN - DON'T DO ARCF'S IN OLDAFX IF NOT ENABLED
;<4.UTILITIES>DUMPER.MAC.238, 23-Aug-79 08:55:33, EDIT BY R.ACE
;TCO 4.2390 - INCREMENTAL SAVES... CALL PASS2 FOR ALL FILESPECS
;PROSCRIBE "AS" FILESPEC FOR ARCHIVE/MIGRATION/INCREMENTAL SAVES
;<4.UTILITIES>DUMPER.MAC.237, 27-Jul-79 05:50:32, EDIT BY R.ACE
;TCO 4.2352 - DON'T UNLOAD AFTER SAVE WITH WILDCARDED DIR SPECIFICATION
;<4.UTILITIES>DUMPER.MAC.236, 12-Jul-79 06:07:50, EDIT BY R.ACE
;TCO 4.2323 - PERMIT USE OF ANSI LABELED TAPES
;<4.UTILITIES>DUMPER.MAC.235, 21-Jun-79 15:24:34, EDIT BY R.ACE
;TCO 4.2306 - FIX LOSING PAGE IF CONTINUED AFTER OVER-QUOTA FAILURE
;<4.UTILITIES>DUMPER.MAC.234, 17-Jun-79 19:18:07, EDIT BY R.ACE
;FIX UNLABELED BACKSPACE BUGS WHEN BOT IS ENCOUNTERED
;ARCFIX... DON'T DO ARCF'S IF NOT PRIVILEGED
;<4.UTILITIES>DUMPER.MAC.233, 7-Jun-79 09:11:55, EDIT BY R.ACE
;FIX SO DEFAULT FILESPEC FOR RETRIEVE USES DSK*:
;<4.UTILITIES>DUMPER.MAC.232, 7-Jun-79 06:06:50, EDIT BY R.ACE
;FIX ALL ERROR MESSAGES TO HAVE NO SPACE AFTER ? OR %
;DON'T SET DATA MODE WHEN OPENING TAPE JUST FOR REWIND
;(ON LABELED TAPES, THIS CAN CAUSE MOVEMENT AND POSSIBLE MTOPR FAILURE)
;<4.UTILITIES>DUMPER.MAC.231, 22-May-79 11:00:36, EDIT BY R.ACE
;MISCELLANEOUS FIXES
;<4.UTILITIES>DUMPER.MAC.230, 21-May-79 21:38:13, EDIT BY DBELL
;TCO 4.2255 - CHANGE DEFAULTS (AGAIN) FOR SAVE AND RESTORE TO BE
;YOUR CONNECTED STRUCTURE AND DIRECTORY.
;<4.UTILITIES>DUMPER.MAC.229, 4-May-79 16:08:30, EDIT BY R.ACE
;GET RID OF REDEOT FLAG - USE PAGNO INSTEAD
;PUT ERJMP AFTER MSTR TO ALLOW RUNNING R4 DUMPER ON TOPS-20 R3A
;<4.UTILITIES>DUMPER.MAC.228, 3-May-79 05:36:49, EDIT BY R.ACE
;MAKE PRINT COMMAND DO ALL VOLUMES IN THE SET
;<4.UTILITIES>DUMPER.MAC.227, 3-May-79 04:49:11, EDIT BY R.ACE
;PERMIT USE OF TOPS-20 LABELED TAPES
;FIX LABELED TAPE BUGS IN RECORD SEQUENCE BOOKKEEPING
;<4.UTILITIES>DUMPER.MAC.226, 26-Apr-79 22:51:41, EDIT BY DBELL
;HAVE SETGJB ALWAYS SET UP DEFAULT POINTERS FOR DEVICE AND DIRECTORY
;<4.UTILITIES>DUMPER.MAC.225, 23-Apr-79 08:16:29, EDIT BY R.ACE
;ADD BOX-TYPE COMMENTS DESCRIBING TAPE FORMATS
;<4.UTILITIES>DUMPER.MAC.224, 21-Apr-79 09:00:29, EDIT BY R.ACE
;FIX PROBLEM OF TAPE# GETTING RESET TO 1
;LAY MORE GROUNDWORK FOR LABELED TAPE SUPPORT
;ADD CODE TO WASHOU TO SET AR%RFL BIT IN FDB
;<4.UTILITIES>DUMPER.MAC.223, 17-Apr-79 13:20:59, EDIT BY R.ACE
;CLEAR RETSW ON CHECK AND RESTORE COMMANDS
;DON'T ACCEPT SWITCHES ON RETRIEVE COMMAND
;<4.UTILITIES>DUMPER.MAC.222, 13-Apr-79 04:52:43, EDIT BY R.ACE
;REMOVE /COLLECT SWITCH FROM SAVE COMMAND
;<4.UTILITIES>DUMPER.MAC.221, 12-Apr-79 15:32:10, Edit by R.ACE
;FIX RETRIEVAL TO REQUEUE REQUEST IF LOSING BECAUSE NO DISK SPACE
;ADD PRIVATE-QUASAR CODE
;CHANGE OCCURRENCES OF T1,T2,T3,T4 TO A,B,C,D RESPECTIVELY
;<4.UTILITIES>DUMPER.MAC.220, 11-Apr-79 16:55:10, Edit by KONEN
;CORRECT 7-BIT TO 6-BIT CONVERSION
;<4.UTILITIES>DUMPER.MAC.219, 6-Apr-79 14:59:46, Edit by KONEN
;MAKE USAGE STRUCTURE ENTRIES SIXBIT
;<4.UTILITIES>DUMPER.MAC.218, 1-Apr-79 19:11:59, EDIT BY DBELL
;MAKE DEFAULTS FOR SAVING AND RESTORING BE AS FOLLOWS:
; SAVE (FROM) CONN-STR:<CONN-DIR> (TO) SAME-AS-INPUT-SPEC
; RESTORE (FROM) DSK*:<CONN-DIR> (TO) SAME-AS-INPUT-SPEC
;<4.UTILITIES>DUMPER.MAC.217, 30-Mar-79 12:30:12, EDIT BY R.ACE
;TAKE OUT PROLOG MACRO REFERENCE
;DEFINE LOGICAL NAME RETRVL: FOR RETRIEVAL TAPES
;REARRANGE MREQ ROUTINE
;ADD NTAPER ENTRY TO NTAPE TO REWIND AFTER TAPE IS GOTTEN
;DON'T DISPLAY TAPE # FOR VIRTUAL DISK TAPES
;<HURLEY.CALVIN>DUMPER.MAC.2, 21-Mar-79 12:41:18, EDIT BY HURLEY.CALVIN
; Define BBN 101B FDB offsets and use them properly in OLDAFX
;<4.UTILITIES>DUMPER.MAC.216, 21-Mar-79 05:08:48, EDIT BY R.ACE
;IGNORE ERRORS FROM CHFDB SETTING FILE INVISIBLE TO PERMIT REL4
;DUMPER TO RUN ERROR-FREE ON REL3A
;<4.UTILITIES>DUMPER.MAC.215, 17-Mar-79 08:01:38, EDIT BY R.ACE
;FIX BUG WHEN RETRIEVING INVISIBLE FILES THAN SPAN VOLUMES
;THIS FIX HAS THE SIDE EFFECT OF MAKING ALL RETRIEVED FILES VISIBLE
;<4.UTILITIES>DUMPER.MAC.214, 16-Mar-79 13:17:28, EDIT BY R.ACE
;ADD ERJMP AFTER RCDIR IN LODUSR
;<4.UTILITIES>DUMPER.MAC.213, 15-Mar-79 22:44:59, EDIT BY DBELL
;ADD A CRLF IN THE "NOT DUMPED" MESSAGE AT NDMESS+7
;<4.UTILITIES>DUMPER.MAC.212, 15-Mar-79 09:23:37, EDIT BY R.ACE
;FIX HANDLING OF ERRORS FROM GTJFN ON OFFLINE FILE POINTER
;BYPASS STRUCTURE REGULATIONS IF WHEEL OR OPERATOR ENABLED
;<4.UTILITIES>DUMPER.MAC.211, 10-Mar-79 13:50:17, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>DUMPER.MAC.210, 8-Mar-79 13:53:58, EDIT BY R.ACE
;DUPLICATE USE OF PDB WAS CAUSING RETRIEVAL MOUNTS TO HANG
;SO CREATE MPDB FOR MOUNTING TAPES
;<4.UTILITIES>DUMPER.MAC.209, 5-Mar-79 14:41:02, EDIT BY HURLEY.CALVIN
; add time-stamp in retrieved message
;<4.UTILITIES>DUMPER.MAC.208, 28-Feb-79 15:30:58, EDIT BY DBELL
;AT OFNAM2 FIX "INVALID WILDCARD" ERROR ON RESTORING INTERCHANGE MODE FILES.
;<4.UTILITIES>DUMPER.MAC.207, 26-Feb-79 08:59:47, EDIT BY R.ACE
;NUMEROUS EDITS TO IMPLEMENT FOLLOWING FEATURES:
; MAKE DUMPER CONSCIOUS OF UNLABELED MT DEVICES, VOLIDS, ETC.
; REMOVE ARCHIVING TAPE NUMBERING SCHEME
;<R.ACE.LT>D.MAC.44, 18-Feb-79 15:19:07, EDIT BY DBELL
;TCO 4.2192 - MAKE THE DEVICE DSK*: WORK PROPERLY IN SAVE AND RESTORE
;<ARC-DEC>DUMPR4.MAC.16, 15-Dec-78 08:23:13, EDIT BY CALVIN
; Change to release 4 style QUASAR
;<ARC-DEC>DUMPR.MAC.30, 30-Nov-78 14:38:17, EDIT BY CALVIN
; Fix host output code & subroutinize it (code was in 3 places)
;<ARC-DEC>DUMPR.MAC.20, 9-Nov-78 09:31:23, EDIT BY CALVIN
; REPEAT 0 out expiration code in DUMPER
;<RETURN>DUMPX4.MAC.1, 12-Oct-78 20:38:00, Edit by CALVIN
; BEGIN INSTALLING IPCF STUFF FOR COMMUNICATION WITH QUASAR
;<ARC-DEC>DUMPN4.MAC.29, 2-Oct-78 09:11:03, EDIT BY CALVIN
; Install code to handle old style archive tapes
;<ARC-DEC>DUMPER.MAC.195, 18-Sep-78 08:25:11, EDIT BY CALVIN
; Merge in ARCHIVE/VIRTUAL disk code
;<4.UTILITIES>DUMPER.MAC.206, 27-Nov-78 10:41:51, Edit by LCAMPBELL
;<4.UTILITIES>DUMPER.MAC.205, 27-Nov-78 10:34:47, Edit by LCAMPBELL
; Add QUIT as synonym for EXIT
;<4.UTILITIES>DUMPER.MAC.204, 20-Nov-78 14:42:12, EDIT BY DBELL
;REMOVE CHKWLD ROUTINE FINALLY, AND USE WILD% JSYS INSTEAD
;<4.UTILITIES>DUMPER.MAC.203, 23-Oct-78 17:54:48, EDIT BY DBELL
;TCO 4.2061 - FIX EXTRANEOUS "TAPE HAS FILES MISSING" MESSAGES WHEN A
; RESTORE IS NOT STARTED ON THE FIRST TAPE.
;<4.UTILITIES>DUMPER.MAC.202, 12-Oct-78 20:34:04, EDIT BY DBELL
;TCO 4.2043 - FIX INFINITE LOOP WHEN SAVING FILE WHICH IS MULTIPLE OF 512 PAGES
;<4.UTILITIES>DUMPER.MAC.201, 3-Oct-78 00:23:04, EDIT BY DBELL
;TCO 4.2029 - FIX "JFN NOT ASSIGNED" ERROR DURING INCREMENTAL SAVE AT FIXBCK
;<4.UTILITIES>DUMPER.MAC.200, 25-Sep-78 22:50:14, EDIT BY DBELL
;TCO 4.2020 MAKE MULTI-REEL CHECK COMMAND WORK PROPERLY.
;<4.UTILITIES>DUMPER.MAC.199, 14-Sep-78 15:10:17, EDIT BY DBELL
;FIX ONCE AGAIN THE PROBLEM OF RESTORED FILE IN INTERCHANGE MODE
;HAVING THEIR PROTECTION SET TO 0.
;<4.UTILITIES>DUMPER.MAC.198, 22-Aug-78 17:11:44, EDIT BY DBELL
;TCO 4.1990 - ALLOW OPENING OF LIST DEVICES SUCH AS MTA0: AND PLPT0:
;<4.UTILITIES>DUMPER.MAC.197, 17-Aug-78 15:56:08, EDIT BY DBELL
;CHANGE "?" TO "%" IN "NO FILES DUMPED" MESSAGE
;<4.UTILITIES>DUMPER.MAC.196, 11-Aug-78 10:34:34, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.195, 10-Aug-78 15:43:52, Edit by PORCHER
;FIX FILE NUMBER CHECKING ACROSS TAPE BOUNDARIES
;UPDATE TO VERSION 4(174)
;<4.UTILITIES>DUMPER.MAC.193, 12-Jul-78 10:45:28, Edit by PORCHER
;TCO # 1944 - ADD FILE NUMBER CHECKING
;TCO # 1943 - REMOVE RPACS FOR EXISTING PAGES ON SAVE
;TCO # 1942 - INDICATE MISSING PAGES ON RESTORE
;<4.UTILITIES>DUMPER.MAC.192, 2-Jun-78 09:34:00, Edit by FORTMILLER
;<4.UTILITIES>DUMPER.MAC.191, 1-Jun-78 13:17:23, Edit by FORTMILLER
;TCO 1891 ADD 6250 BPI
;<4.UTILITIES>DUMPER.MAC.190, 19-May-78 17:30:03, Edit by PORCHER
;TCO # 1914 - REMOVE DUMPER VERSION HERALD
;TCO # 1913 - INCREASE FILESPEC DEFAULT AREAS TO 20 WORDS
;<4.UTILITIES>DUMPER.MAC.189, 16-May-78 16:22:51, Edit by PORCHER
;TCO # 1910 -- HANDLE ZERO BYTE SIZE CORRECTLY IN INTERCHANGE MODE
;<4.UTILITIES>DUMPER.MAC.188, 10-May-78 16:33:53, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.187, 10-May-78 14:39:14, Edit by PORCHER
;TCO # 1909 -- USE SYSTEM DEFAULT ACCOUNT IF TAPE ACCOUNT INVALID ON RESTORE
;MAKE BACKSPACE TO BEGINNING OF TAPE ONLY WARNING ERROR
;<4.UTILITIES>DUMPER.MAC.186, 27-Apr-78 16:58:35, Edit by PORCHER
;FIX BUGS IN /INCREMENTAL: ...
;<4.UTILITIES>DUMPER.MAC.185, 18-Apr-78 11:28:28, Edit by PORCHER
;TCO # 1903 - Add /FULL-INCREMENTAL, /INCREMENTAL:n, no restore of backup words
;<4.UTILITIES>DUMPER.MAC.184, 13-Apr-78 16:06:07, Edit by PORCHER
;MAKE CHECKSUM ERRORS INTERRUPTIBLE
;ALLOW FOR "DUMPX3" - BUFFER SIZE TOO BIG
;<4.UTILITIES>DUMPER.MAC.183, 12-Apr-78 13:16:14, Edit by PORCHER
;FIX EXPRESSION FOR MTBUF2 DUE TO MACRO BUG
;<4.UTILITIES>DUMPER.MAC.182, 6-Apr-78 17:33:33, Edit by PORCHER
;MAKE ALL ERRORS TYPE <CR> ONLY IF NOT AT LEFT MARGIN ALREADY
;<4.UTILITIES>DUMPER.MAC.181, 6-Apr-78 17:08:11, Edit by PORCHER
;PUT MTBUF1 AND MTBUF2 ON PAGE BOUNDARY FOR BLOCKING-FACTOR OF 15
;<4.UTILITIES>DUMPER.MAC.180, 6-Apr-78 16:31:25, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.179, 3-Apr-78 12:22:13, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.178, 3-Apr-78 08:55:45, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.177, 31-Mar-78 13:31:15, Edit by PORCHER
;MAKE BEGUSR COPY ENTIRE DIRECTORY NAME STRING
;USE DIRECTORY STRING (WITH WILD CARDS) FROM USER FOR RCDIR ON SAVE
;ALLOW TTY OUTPUT AFTER INTERRUPTED "PRINT TTY:"
;<4.UTILITIES>DUMPER.MAC.176, 31-Mar-78 10:49:14, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.175, 31-Mar-78 10:42:24, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.174, 31-Mar-78 10:21:55, Edit by PORCHER
;TCO # 1986 - PRINT FILENAME PROPERLY ON RESTORE ERRORS
;<4.UTILITIES>DUMPER.MAC.173, 30-Mar-78 16:27:11, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.172, 30-Mar-78 16:19:35, Edit by PORCHER
;UPDATE TO VERSION 4(166)
;MISCELLANEOUS BUG FIXES AND ...
;TCO # 1895 - COPY PROTECTION/ACCOUNT FROM OUTPUT SPEC IN SAVE/RESTORE
;TCO # 1894 - ALLOW JUST DATE IN BEFORE/SINCE COMMANDS
;TCO # 1893 - DON'T ABORT COMMAND IF "FILE NOT FOUND" IN SAVE COMMAND
;TCO # 1892 - AUTO-UNLOAD FOR MULTI-REEL SAVESETS, UNLOAD COMMAND
;<4.UTILITIES>DUMPER.MAC.170, 21-Mar-78 13:26:50, Edit by DBELL
;ALLOW /INCREMENTAL SWITCH IF NOT WHEEL, BUT THEN COMPLAIN
;<4.UTILITIES>DUMPER.MAC.169, 17-Mar-78 16:02:47, Edit by DBELL
;DON'T SET PROTECTION FROM TAPE IF RESTORING IN INTERCHANGE MODE
;<PORCHER>DUMPER.MAC.170, 16-Mar-78 16:25:07, Edit by PORCHER
;TCO # 1891 - CHANGES FOR MULTIPLE RECORD BLOCKING
;<4.UTILITIES>DUMPER.MAC.168, 17-Feb-78 18:05:26, Edit by DBELL
;HANDLE FULL WILDCARDS IN RESTORE COMMAND BY CALLING CHKWLD ROUTINE
;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.
IFNDEF DSKDMP,<DSKDMP==0> ; Build tape version
SEARCH MONSYM,MACSYM,QSRMAC,GLXMAC,ACTSYM
IFN DSKDMP,<SEARCH SPSYM>
TITLE DUMPER
SALL
.REQUIRE SYS:MACREL
.REQUIRE ARMAIL ; Need mailing routines
.DIRECT FLBLST
EXTERN MLTOWN,MLTLST,MLDONE,MLINIT
EXTERN .JBOPS ;135 NON-ZERO = USE PRIVATE QUASAR
; VERSION NUMBER DEFINITIONS
VMAJOR==4 ;MAJOR VERSION OF DUMPER
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==303 ;EDIT NUMBER
VWHO==0 ;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
; 1=BBN
VDUMPR== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
COMMENT ^
F O R M A T O F D U M P E R T A P E S
===========================================
EACH PHYSICAL RECORD WRITTEN BY DUMPER CONTAINS ONE OR MORE
LOGICAL RECORDS, EACH OF WHICH IS 518 (1006 OCTAL) WORDS LONG.
EACH LOGICAL RECORD HAS THE FOLLOWING FORMAT:
!=======================================================!
CHKSUM ! CHECKSUM OF ENTIRE 518-WORD RECORD !
!-------------------------------------------------------!
ACCESS ! PAGE ACCESS BITS (CURRENTLY NOT USED) !
!-------------------------------------------------------!
TAPNO !SCD! SAVESET NUMBER ! TAPE NUMBER !
!-------------------------------------------------------!
PAGNO !F1!F2! FILE # IN SET ! PAGE # IN FILE !
!-------------------------------------------------------!
TYP ! RECORD TYPE CODE (NEGATED) !
!-------------------------------------------------------!
SEQ ! RECORD SEQUENCE NUMBER (INCREASES BY 1) !
!=======================================================!
! !
! CONTENTS OF FILE PAGE IF DATA RECORD !
! OTHER TYPES HAVE OTHER INFORMATION HERE !
! !
!=======================================================!
TYPE VALUE MEANING
---- ----- -------
DATA 0 CONTENTS OF FILE PAGE
TPHD 1 NON-CONTINUED SAVESET HEADER
FLHD 2 FILE HEADER (CONTAINS FILESPEC, FDB)
FLTR 3 FILE TRAILER
TPTR 4 TAPE TRAILER (OCCURS ONLY AFTER LAST SAVESET)
USR 5 USER DIRECTORY INFORMATION
CTPH 6 CONTINUED SAVESET HEADER
FILL 7 NO MEANING, USED FOR PADDING
SCD (3 BITS) - 0=NORMAL SAVE, 1=COLLECTION, 2=ARCHIVE, 3=MIGRATION
F1 F2 MEANING
-- -- -------
0 0 OLD-FORMAT TAPE (NO FILE # IN PAGNO BITS 2-17)
1 1 OLD-FORMAT TAPE, CONTINUED FILE
0 1 NEW-FORMAT TAPE (FILE # IN PAGNO BITS 2-17)
1 0 NEW-FORMAT TAPE, CONTINUED FILE
A DUMPER TAPE IS A COLLECTION OF RECORDS ORGANIZED IN THE
FOLLOWING FASHION:
!=======================================================!
! HEADER FOR FIRST SAVESET (TPHD) !
!-------------------------------------------------------!
! USER INFO (USR) OR FILE (SEE BELOW) !
!-------------------------------------------------------!
! USER INFO OR FILE !
!-------------------------------------------------------!
! . !
! . !
! . !
!=======================================================!
! HEADER FOR SECOND SAVESET (TPHD) !
!-------------------------------------------------------!
! USER INFO (USR) OR FILE (SEE BELOW) !
!-------------------------------------------------------!
! USER INFO OR FILE !
!-------------------------------------------------------!
! . !
! . !
! . !
!=======================================================!
! !
! SUBSEQUENT SAVESETS !
! !
!=======================================================!
! !
! LAST SAVESET !
! !
!=======================================================!
! TAPE TRAILER (TPTR) !
!=======================================================!
NOTES:
1. ON LABELED TAPES, THE TPTR RECORD APPEARS ONLY IF
THE SAVESET IS CONTINUED ON ANOTHER TAPE.
2. SOLITARY TAPE MARKS (EOF'S) ARE IGNORED ON INPUT.
TWO CONSECUTIVE TAPE MARKS ARE INTERPRETED AS TPTR.
3. ON LABELED TAPES, EACH SAVESET OCCUPIES EXACTLY ONE FILE.
4. THE FIRST RECORD OF A CONTINUED SAVESET IS CTPH
INSTEAD OF TPHD.
A DISK FILE SAVED ON A DUMPER TAPE ALWAYS HAS THIS
SEQUENCE OF RECORDS:
!=======================================================!
! FILE HEADER (FLHD) !
!-------------------------------------------------------!
! DATA RECORD: 1 PAGE OF FILE (DATA) !
!-------------------------------------------------------!
! DATA RECORD: 1 PAGE OF FILE (DATA) !
!-------------------------------------------------------!
! . !
! . !
! . !
!-------------------------------------------------------!
! FILE TRAILER (FLTR) !
!=======================================================!
^
SUBTTL STORAGE AND DEFINITIONS
FMTV0==0 ;BBN (TENEX) DUMPER FORMAT
FMTV1==1
FMTV2==2
FMTV3==3 ;RELEASE 2 (FDB CHANGES, STRUCTURES, ETC.)
FMTV4==4 ;RELEASE 3 (NEW GTDIR BLOCKS)
CURFMT==FMTV4 ;DATA FORMAT TO WRITE
USRLH==500000 ;THIS IS TO IDENTIFY A USER
;NUMBER. IF THE MONITOR
;CHANGES THE DEFINITION, IT
;MUST CHANGE HERE
F=0
A=1
B=2
C=3
D=4
T1=1 ;DO NOT USE T1-T4. IN CASE SOMEONE SLIPS AND DOES
T2=2 ;USE THEM, THESE DEFS OVERRIDE THOSE IN GLXMAC.
T3=3
T4=4
Q1=5
Q2=6
Q3=7
P1=10
P2=11
P3=12
P4=13
P5=14
P6=15
CX=16
P=17
PGSIZ==1000 ;PAGE SIZE
; Definitions for old BBN style archive tapes (FDB offsets for 101B system)
.BBNBT==17 ; Old FBBBT
.BBNTF==20 ; TFN1,,TFN2
.BBNTS==21 ; TSN1,,TSN2
.BBNTP==22 ; TAPE1,,TAPE2
.BBNDT==23 ; Archive date & time
;FLAGS IN F
NOFLG==1B0 ;'NO' PRECEDED COMMAND
USRDAT==1B1 ;DUMP/LOAD USER DATA
T36MOD==1B2 ;36-BIT TAPE MODE
DIRCHG==1B3 ;OUTPUT DIRECTORY NOT SAME AS
;INPUT DIRECTORY
TNSF==1B4 ;TAPE NUMBER SET FLAG
LRERR==1B5 ;LAST RECORD HAD AN UNRECOVERABLE ERROR
SAVUSF==1B6 ;WE SHOULD SAVE USER DATA IF SET
DMPFLF==1B7 ;(SAVE) WE HAVE FOUND A VALID JFN TO DUMP
TF1==1B9 ;TEMP FLAGS FOR LOCAL USE
TF2==1B10 ;FILE CONTINUED ON NEXT REEL
LFDSK==1B11 ;LOG FILE NOT DISK
ICMT1==1B12 ;INTERCHANGE MODE - REPEAT LAST RECORD
ICMODF==1B13 ;USE INTERCHANGE MODE TAPE FORMAT
LDIRF==1B14 ;LIST DIRECTORIES WHILE RUNNING
LFILF==1B15 ;LIST FILES WHILE RUNNING
LTTYF==1B16 ;LOG FILE IS TTY
LREOF==1B17 ;LAST RECORD READ WAS EOF
SSA==1B18 ;SUPERSEDE ALWAYS
SSN==1B19 ;SUPERSEDE NEVER
RESPRO==1B20 ;RESTORE PROTECTION FROM TAPE
RESACC==1B21 ;RESTORE ACCOUNT FROM TAPE
CHKSM==1B23 ;CHECKSUMMING
CS%SEQ==1B24 ;SEQUENTIAL CHECKSUMMING
%ATF==1B32 ; "@" seen (GETOWN)
%VERBA==1B33 ; Take input "as is" (GETOWN)
COMMAF==1B34 ; Comma flag (For PRTTAP)
FST%PN==1B35 ; First ";" seen in FIXFMM (TENEX tape)
;FORMAT OF HEADER PORTION OF RECORD
XCKSUM==0 ;CHECKSUM
XACC==1 ;ACCESS
XTAPNO==2 ;TAPE NUMBER
XPAGNO==3 ;PAGE NUMBER
XTYP==4 ;RECORD TYPE
XSEQ==5 ;RECORD SEQUENCE
NHEAD==6 ;HEADER SIZE
NIHEAD==^D32 ;HEADER SIZE, INTERCHANGE FORMAT
MXHEAD==NHEAD ;SET MAX (NHEAD, NIHEAD)
IFG NIHEAD-MXHEAD,<MXHEAD==NIHEAD>
MAXBKF==^D15 ;MAXIMUM BLOCKING FACTOR
DEFBKF==^D1 ;DEFAULT BLOCKING FACTOR
MTBFSZ==<<NHEAD+PGSIZ>*MAXBKF>+1 ;SIZE OF PHYSICAL RECORD BUFFERS
IFG <MXHEAD+PGSIZ+1>-MTBFSZ,<MTBFSZ==MXHEAD+PGSIZ+1>
;(THE EXTRA 1 IS TO FORCE RECORD LENGTH ERROR
; ON READING TO DETERMINE BLOCKING FACTOR)
;LOCATIONS IN UPPER ADR SPACE
N.JFN==2*PGSIZ ;DOUBLE LENGTH BUFFER (JFNSTK)
CBFSIZ==2*PGSIZ ;2 PAGES (CBFR)
NJFNL==PGSIZ ;(JFNLST & JF2LST)
NQSRML==PGSIZ ; Page for communication with QUASAR
NSNDBD==PGSIZ*3 ; Amount of space allocated for message body
JFNLST=500000 ;LIST OF JFNS FOR CURRENT COMMAND
JF2LST=501000 ;LIST OF DEST JFNS, PARALLEL TO JFNLST
JFNSTK=502000 ;JFN STACK FOR REPARSE (2 PAGES)
CBFR=504000 ;2 PAGE LINE BUFFER FOR COMMAND
MBUF=506000 ;IPCF BUFFER USED DURING TAPE MOUNT
MTBUF1=MBUF+NQSRML ;ALTERNATING BUFFERS FOR MAGTAPE I/O
MTBUF2=<MTBUF1+MTBFSZ+777>&<^-777> ; . .
QSRMSR=<MTBUF2+MTBFSZ+777>&<^-777> ; Page for QUASAR communication
QSRMSS=QSRMSR+NQSRML ; FOR SENDING TO QUASAR
SNDBDY=QSRMSS+NQSRML ; Body of messages sent
IFL <577772-<SNDBDY+NSNDBD>>,<PRINTX SNDBDY and XBUFF overlap - Readjust upper core storage>
BUFF=600000
BUFPAG==<BUFF>B44
IFL BUFF-<<MTBUF2+MTBFSZ+777>&<^-777>>,<PRINTX ? MTBUF2 OVERLAPS BUFF>
BUFF2=601000
BF2PAG==<BUFF2>B44
BUF0==602000 ;FILE WINDOW
BUF0PG==<BUF0>B44 ;PAGE NUMBER OF SAME
XBUFF=BUFF-NHEAD ;BUFFER ORIGIN
CHKSUM=XBUFF+XCKSUM
ACCESS=XBUFF+XACC
TAPNO=XBUFF+XTAPNO
PAGNO=XBUFF+XPAGNO
TYP=XBUFF+XTYP
SEQ=XBUFF+XSEQ
;BITS IN LH OF PAGNO WORD
PGNCFL==1B0 ;CONTINUED TAPE FILE (SET IN FILE TRAILER,
; TAPE TRAILER, FILE HEADER)
PGNNFL==1B1 ;FILE NUMBER IS VALID (IF COMPLEMENT OF PGNCFL)
PGNFLN==177777B17 ;FILE NUMBER
;STRUCTURE OF RECORD HEADER FOR ARCHIVE/COL./MIG. TAPES
DEFSTR SSCOD,XTAPNO,2,3 ;SAVESET TYPE CODE:
SSCOL==1 ;COLLECTION RUN SAVESET
SSARC==2 ;ARCHIVE RUN SAVESET
SSMIG==3 ;MIGRATION RUN SAVESET
DEFSTR SSNO,XTAPNO,17,15 ;SAVESET NUMBER
DEFSTR TPNO,XTAPNO,35,18 ;TAPE NUMBER
DEFSTR TFNO,XPAGNO,17,16 ;TAPE FILE NUMBER
DEFSTR PGNO,XPAGNO,35,18 ;PAGE NO. IN FILE
;RECORD TYPE CODES
DATAX==0 ;DATA RECORD
TPHDX==1 ;TAPE HEADER
FLHDX==2 ;FILE HEADER
FLTRX==3 ;FILE TRAILER
TPTRX==4 ;TAPE TRAILER
USRX==5 ;USER BLOCK
CTPHX==6 ;CONTINUED SAVE
FILLX==7 ;FILLER RECORD
;NUMBER OF ERROR RETRIES FOR MTA
NRETRY==^D40
;LISTING FORMAT PARAMETERS
FLCOL==^D5 ;COLUMN FOR FILE NAME
WTCOL==^D60 ;COLUMN FOR WRITE DATE
SIZCOL==^D80 ;COLUMN FOR SIZE
CSCOL==^D100 ;COLUMN FOR CHECKSUM
PAGLEN==^D57 ;LINES PER LISTING PAGE
;FORMAT OF RECORDS ON TAPE
;TAPE HEADER
BFMSGP==1 ;PTR TO SAVE SET NAME
BFTAD==2 ;TAD OF SAVE
BFMSG==3 ;SAVE SET NAME
;FILE HEADER
FHNAM==0 ;FILE NAME
FHFDB==200 ;FDB
;DIRECTORY INFORMATION BLOCK
UHNAM==40 ;NAME STRING
UHPSW==60 ;PASSWORD STRING
UHACT==100 ;ACCOUNT STRING
UGLEN==200 ;USER/DIRECTORY GROUP LENGTH
CDUG==200 ;USER GROUPS
CDDG==400 ;DIRECTORY GROUPS
CDSG==600 ;SUBDIRECTORY GROUPS
;FILE NAME PUNCTUATION
DEVPCT==":" ;DEVICE
DIRBP=="<" ;DIRECTORY BEGIN
DIREP==">" ;DIRECTORY END
EXTPCT=="." ;EXTENSION
GENPCT=="." ;GENERATION
ATTPCT==";" ;ATTRIBUTE
SUBTTL INTERCHANGE FORMAT DEFINITIONS
BKFMT==1 ;FORMAT VERSION NUMBER (CONSTANT)
;RECORD TYPES
T$LBL==1 ;LABEL IDENTIFICATION RECORD
T$BEG==2 ;SAVE START
T$END==3 ;SAVE END
T$FIL==4 ;DISK FILE DATA
T$UFD==5 ;UFD RIB
T$EOV==6 ;END OF VOLUME
T$COM==7 ;COMMENT
T$CON==10 ;CONTINUE (SAME DATA AS T$BEG-T$END)
T$MAX==T$CON ;MAXIMUM RECORD TYPE
;STANDARD RECORD
G$TYPE==0 ;RECORD TYPE
G$SEQ==1 ;SEQUENCE NUMBER
G$RTNM==2 ;RELATIVE TAPE NUMBER
G$FLAG==3 ;RECORD DEPENDENT BITS
GF$EOF==1B0 ;LAST RECORD OF FILE
GF$RPT==1B1 ;REPEAT OF LAST RECORD WRITE ERROR
GF$NCH==1B2 ;IGNORE CHECKSUM
GF$SOF==1B3 ;START OF FILE
G$CHK==4 ;CHECKSUM
G$SIZ==5 ;NUMBER OF DATA WORDS
G$LND==6 ;TOTAL LENGTH OF NON-DATA SECTION
G$CUSW==13 ;RESERVED FOR CUSTOMER USE
;O$FILE/A$FLGS
B$PERM==1B0 ;PERMANENT
B$TEMP==1B1 ;TEMPORARY
B$DELE==1B2 ;ALREADY DELETED
B$DLRA==1B3 ;DON'T DELETE FOR LACK OF RECENT ACCESS
B$NQCF==1B4 ;NOT QUOTA CHECKED
B$NOCS==1B5 ;DOES NOT HAVE VALID CHECKSUMS
B$CSER==1B6 ;HAS CHECKSUM ERROR
B$WRER==1B7 ;HAS DISK WRITE ERROR
B$MRER==1B8 ;HAD <BACKUP READ ERROR ON RESTORE
B$DAER==1B9 ;DECLARED BAD BY DAMAGE ASSESMENT
;O$FILE BLOCK
A$FHLN==0 ;HEADER LENGTH WORD
A$FLGS==1 ;FLAGS
A$WRIT==2 ;CREATION DATE/TIME
A$ALLS==3 ;ALLOCATED SIZE
A$MODE==4 ;MODE
A$LENG==5 ;LENGTH
A$BSIZ==6 ;BYTE SIZE
A$VERS==7 ;VERSION
A$PROT==10 ;PROTECTION
A$ACCT==11 ;BYTE POINTER ACCOUNT STRING
A$NOTE==12 ;BYTE POINTER TO ANONOTATION STRING
A$CRET==13 ;CREATION DATE/TIME OF THIS GENERATION
A$REDT==14 ;LAST READ DATE/TIME OF THIS GENERATION
A$MODT==15 ;MONITOR SET LAST WRITE DATE/TIME
A$ESTS==16 ;ESTIMATED SIZE IN WORDS
A$RADR==17 ;REQUESTED DISK ADDRESS
A$FSIZ==20 ;MAXIMUM FILE SIZE IN WORDS
A$MUSR==21 ;BYTE POINTER TO ID OF LAST MODIFIER
A$CUSR==22 ;BYTE POINTER TO ID OF CREATOR
A$BKID==23 ;BYTE POINTER TO SAVE SET OF PREVIOUS <BACKUP
A$BKDT==24 ;DATE/TIME OF LAST BACKUP
A$NGRT==25 ;NUMBER OF GENERATIONS TO RETAIN
A$NRDS==26 ;NBR OPENS FOR READ THIS GENERATION
A$NWRT==27 ;NBR OPENS FOR WRITE THIS GENERATION
A$USRW==30 ;USER WORD
A$PCAW==31 ;PRIVILEGED CUSTOMER WORD
LN$AFH==32 ;LENGTH OF FIXED HEADER
;PROTECTION FIELDS
AC$OWN==377B19 ;OWNER ACCESS FIELD
AC$GRP==377B27 ;AFFINITY GROUP ACCESS FIELD
AC$WLD==377B35 ;WORLD ACCESS FIELD
PR$ATR==7B31 ;ATTRIBUTE PROTECTION SUBFIELD
PR$WRT==3B33 ;WRITE PROTECTION SUBFIELD
PR$RED==3B35 ;READ PROTECTION SUBFIELD
;O$DIRT/D$FLGS
DF$FOD==1B0 ;FILES ONLY DIRECTORY
DF$AAL==1B1 ;ALPHA ACCOUNTS ARE LEGAL
DF$RLM==1B2 ;REPEAT LOGIN MESSAGES
;O$DIRT BLOCK
D$FHLN==0 ;FIXED HEADER LENGTH WORD
D$FLGS==1 ;DIRECTORY FLAGS
D$ACCT==2 ;ACCOUNT NUMBER
D$PROT==3 ;DIRECTORY PROTECTION
D$FPRT==4 ;DEFAULT FILE PROTECTION
D$LOGT==5 ;LOGIN DATE/TIME
D$GENR==6 ;NUMBER GENERATIONS TO KEEP
D$QTF==7 ;LOGGED-IN QUOTA
D$QTO==10 ;LOGGED-OUT QUOTA
D$ACSL==11 ;ACCESS LIST
D$USRL==12 ;USER LIST
D$PRVL==13 ;PRIVILEGE LIST
D$PSWD==14 ;PASSWORD
LN$DFH==15 ;LENGTH OF DIRECTORY FIXED HEADER
;NON-DATA BLOCK TYPES
O$NAME==1 ;FULL PATH NAME BLOCK
O$FILE==2 ;FILE ATTRIBUTE BLOCK
O$DIRT==3 ;DIRECTORY ATTRIBUTE BLOCK
O$SYSN==4 ;SYSTEM HEADER BLOCK
O$SSNM==5 ;SAVE SET NAME BLOCK
;T$LBL RECORD
L$DATE==14 ;DATE/TIME OF LABELING
L$FMT==15 ;BACKUP FORMAT
L$BVER==16 ;BACKUP VERSION
L$MON==17 ;MONITOR TYPE
L$SVER==20 ;SYSTEM VERSION
L$APR==21 ;APR SERIAL NUMBER WRITING LABEL
L$DEV==22 ;DEVICE ID WRITING LABEL
L$MTCH==23 ;TAPE WRITE PAREMETERS
L$RLNM==24 ;SIXBIT TAPE REEL NAME
L$DSTR==25 ;DATE/TIME FOR DESTRUCTION
L$CUSW==37 ;RESERVED CUSTOMER WORD
;T$BEG, T$END, T$CON RECORDS
S$DATE==14 ;DATE/TIME OF START/END OF SAVE
S$FMT==15 ;RETRIEVAL VERSION
S$BVER==16 ;BACKUP VERSION
S$MON==17 ;MONITOR TYPE
S$SVER==20 ;SYSTEM VERSION
S$APR==21 ;APR SERIAL NUMBER
S$DEV==22 ;DEVICE ID WRITING SAVE SET
S$MTCH==23 ;TAPE WRITE PARAMETERS
S$RLNM==24 ;REELID
S$CUSW==37 ;CUSTOMER WORD
;T$UFD RECORD
D$PCHK==14 ;PATH CHECKSUM
D$LVL==15 ;UFD LEVEL (UFD=0, SFD1=1, ETC.)
D$STR==16 ;STRUCTURE OF UFD ( MAX OF 12(10) WORDS )
D$CUSW==37 ;CUSTOMER WORD
;T$FIL RECORD
F$PCHK==14 ;PATH CHECKSUM
F$RDW==15 ;RELATIVE DATA WORD OF FILE
F$PTH==16 ;START OF PATH BLOCK
LN$PTH==14 ;LENGTH OF F$PTH BLOCK
F$CUSW==37 ;RESERVED CUSTOMER WORD
F$NND==400 ;LENGTH OF NON-DATA PORTION OF FIRST RECORD
;T$FIL/O$NAME SUB-BLOCK TYPES
.FCDEV==1 ;DEVICE
.FCNAM==2 ;FILE NAME
.FCEXT==3 ;EXTENSION
.FCVER==4 ;VERSION
.FCGEN==5 ;GENERATION
.FCDIR==40 ;DIRECTORY
.FCSF1==41 ;FIRST SFD
.FCSF2==42 ;SECOND SFD
; Defn's for retrievals & QUASAR interface
DEFSTR TPNM1,.ARTP1,35,36 ; Tape 1 ID
DEFSTR TSN1,.ARSF1,17,18 ; Tape 1 saveset #
DEFSTR TFN1,.ARSF1,35,18 ; Tape 1 tape file #
DEFSTR TPNM2,.ARTP2,35,36 ; Tape 2 ID
DEFSTR TSN2,.ARSF2,17,18 ; Tape 2 saveset #
DEFSTR TFN2,.ARSF2,35,18 ; Tape 2 tape file #
FILNM=.ARPSZ+1 ; Where file name will start
SUBTTL STORAGE
;BUFFERS NOT CLEARED AT STARTUP
ICOBUF: BLOCK PGSIZ+NHEAD ;CONVERSION OUTPUT BUFFER
;STORAGE CLEARED AT STARTUP
STGBGN: ;BEGINNING OF STORAGE CLEARED AT STARTUP
; Do not seperate the following block
TPTSK: BLOCK 1 ; Internal task name on ret blk
TPRQUS: BLOCK 1 ; User who requested the retrieve
ABTFLG: BLOCK 1 ; Abort recieved from QUASAR
TPBLK:!
TPOFL: BLOCK 1 ; Flags
TAP1ID: BLOCK 1 ; Tape 1 ID
SSF1ID: BLOCK 1 ; Tape 1 saveset & tape file #
TAP2ID: BLOCK 1 ; Tape 2 ID
SSF2ID: BLOCK 1 ; Tape 2 saveset & tape file #
TPODT: BLOCK 1 ; Tape write date
TPPSZ: BLOCK 1 ; # pages in file
TAPNAM: BLOCK <6+1+1+^D39*2+1+^D39*2+1+^D39*2+1+6+1>/5 ; Space for file name (^V's incl)
TPACT: BLOCK <2*^D39>/5 ; Account of request
MYPID: BLOCK 1 ; My PID (for talking to QUASAR)
QSRPID: BLOCK 1 ; QUASAR's PID
PDB: BLOCK .IPCAS+11 ; Space for MUTILing around
MPDB: BLOCK 10 ;PDB FOR MOUNTING TAPES
NUSABL==27
USABLK: BLOCK NUSABL ; Block for USAGE
USADIR: BLOCK 20 ; Directory string for USAGE
USASTR: BLOCK ^D12 ; Structure name for USAGE
USASSI: BLOCK 2 ;SIXBIT STRUCTURE ID FOR USAGE
USAACT: BLOCK ^D39/5 ; Account string for USAGE
LHOSTN: BLOCK 1 ; Local host # (ARPAnet)
RFSPEC: BLOCK 11 ; Space for type in restart file
CURBUF: BLOCK 1 ;CURRENT OUTPUT BUFFER
FORMAT: BLOCK 1 ;DATA FORMAT
MTBUFF: BLOCK 1 ;BUFFER SWITCH
MTBPTR: BLOCK 1 ;ADDRESS OF CURRENT LOGICAL RECORD WITHIN
; MTBUF1 OR MTBUF2
MTRACT: BLOCK 1 ;READ-AHEAD REQUEST ISSUED
SETBKF: BLOCK 1 ;LAST BLOCKING-FACTOR SET
TAPBKF: BLOCK 1 ;BLOCKING-FACTOR OF CURRENT TAPE
BLKCNT: BLOCK 1 ;DOWN-COUNTER FOR LOGICAL RECORDS BLOCKED
; WITHIN EACH PHYSICAL RECORD
NAMBUF: BLOCK 100 ;FULL FILESPEC FOR FILE BEING DUMPED
ONMBUF: BLOCK 100 ;FULL SPEC FOR FILE NAME GOING ON TAPE
IPDLP: BLOCK 1 ;PDL POINTER AT INTERUPT TIME
TPDLP: BLOCK 1 ;TEMP PDL POINTER
PDLP: BLOCK 1 ;STACK PTR AT TOP OF COMMAND
NPDL==100
PDL: BLOCK NPDL ;MAIN FORK STACK
INIPTR: BLOCK 1 ;INITIAL JFN STACK POINTER
CMDPTR: BLOCK 1 ;TOP OF COMMAND POINTER
RPSPTR: BLOCK 1 ;REPARSE JFN STACK POINTER
CURPTR: BLOCK 1 ;CURRENT JFN STACK POINTER
NLINB==40
LINBUF: BLOCK NLINB ;RDTTY LINE BUFFER
TEMPS: BLOCK 100 ; Temp storage for FIXFMM
;COMND STORAGE
ACBSIZ==^D200/5 ;SIZE OF ATOM BUFFER
ACBFR: BLOCK ACBSIZ
CBLK: BLOCK .CMGJB+1 ;COMMAND STATE BLOCK
GJBLK: BLOCK .GJBFP+1 ;GTJFN ARG BLOCK
;COMMAND TYPE INFORMATION.
CMDTYP: BLOCK 1 ;CURRENT COMMAND TYPE HERE
TY%NOC==1B0 ;NO-CONTINUE COMMAND
TY%RPO==1B1 ;STACK JFNS FOR REPARSE ONLY
TY%MAP==1B2 ;COMMAND MAPS BUFPAG
TY%DBL==1B3 ;COMMAND USES JFNLST
;STORAGE FOR GTJFN DEFAULT STRINGS
DEFDEV: BLOCK 20 ;DEFAULT DEVICE
DEFDIR: BLOCK 20 ;DEFAULT DIRECTORY
DEFNAM: BLOCK 20 ;DEFAULT NAME
DEFEXT: BLOCK 20 ;DEFAULT EXTENSION
DEFVER: BLOCK 20 ;DEFAULT VERSION
DEFPRO: BLOCK 20 ;DEFAULT PROTECTION
DEFACC: BLOCK 20 ;DEFAULT ACCOUNT
NIJFN: BLOCK 1 ;SAVED JFNLST PTR IN CASE OF INTERRUPT
NJFN: BLOCK 1 ;NUMBER OF JFNS IN JFNLST IN USE
NJFN1: BLOCK 1 ;NUMBER ACTIVE JFNS STILL IN LIST
NSSNBF==^D140/5 ;SIZE OF SAVE SET NAME BUFFER
SSNBUF: BLOCK NSSNBF ;SAVE SET NAME BUFFER
MNTDSG: BLOCK 1 ;DESIGNATOR OF MT ASSIGNED BY QUASAR
MTDSG: BLOCK 1 ;DESIGNATOR FOR SPECIFIED MAGTAPE
MTTYP: BLOCK 1 ;TYPE OF MAGTAPE DEVICE
;-1 = MTA
; 0 = UNLABELED MT
;+1 = LABELED (TOPS-20) MT
NAMPTR: BLOCK 1 ;POINTER TO NAME FIELD OF NAMBUF
ONMPTR: BLOCK 1 ;POINTER TO NAME FIELD OF ONMBUF
OGNPTR: BLOCK 1 ;POINTER TO GENERATION NUMBER IN ONMBUF
OACPTR: BLOCK 1 ;POINTER TO ACCOUNT FIELD IN ONMBUF
NOFILS: BLOCK 1 ;NUMBER FILES DUMPED THIS DIRECTORY
TOTFIL: BLOCK 1 ;NUMBER FILES DUMPED ALL DIRECTORIES
WHEEL: BLOCK 1 ;NON-0 IF BEING RUN WITH WHEEL STATUS
DIRNUM: BLOCK 1 ;DIRECTORY NUMBER CURRENT DUMP DIRECTORY
RCDNUM: BLOCK 1 ;DIRECTORY NUMBER FOR RCDIR STEPPING
RCDSTR: BLOCK 12 ;STR:<*> STRING FOR RCDIR
SCNJFN: BLOCK 1 ;CURRENT JFN FOR DUMP SCAN
MTDEV: BLOCK 2 ;NAME STRING FOR SPECIFIED MTA
VOLID: BLOCK 2 ;CURRENT VOLUME IDENTIFIER (ASCIZ)
VOLID6: BLOCK 1 ;CURRENT VOLUME IDENTIFIER (SIXBIT)
DENSIT: BLOCK 1 ;SPECIFIED MTA DENSITY
PARITY: BLOCK 1 ;SPECIFIED MTA PARITY
LASTID: BLOCK 1 ;ID OF CURRENT DUMP PAGE FOR ERROR PSI
LSTERO: BLOCK 1 ;LAST ID REPORTED BY PSI
INT1AC: BLOCK 20 ;INT LEVEL 1 ACS
INT2AC: BLOCK 20 ;INT LEVEL 2 ACS
INT3AC: BLOCK 20 ;INT LEVEL 3 ACS
NINTPD==30 ;SIZE OF INT STACKS
INT1PD: BLOCK NINTPD ;INT LEVEL 1 STACK
INT2PD: BLOCK NINTPD ;INT LEVEL 2 STACK
INT3PD: BLOCK NINTPD ;INT LEVEL 3 STACK
LPC1: BLOCK 1 ;PSI PC'S
LPC2: BLOCK 1
LPC3: BLOCK 1
EINT1: BLOCK 2 ;JSR ENTRY
INTRQ: BLOCK 1 ;INTERRUPT REQUEST FLAG
INTPC: BLOCK 1 ;INTERRUPT PC
ICMDTY: BLOCK 1 ;INTERRUPTED COMMAND TYPE
CEXFLG: BLOCK 1 ;COMMAND IN EXECUTION FLAG
TRAPJ: BLOCK 1 ;TRAP RECOVERY JUMP ADDRESS
TRAPSP: BLOCK 1 ;TRAP RECOVERY STACK FENCE
ITRAPJ: BLOCK 1 ;INTERRUPTED TRAP RECOVERY
ITRAPS: BLOCK 1 ;...
RTAPNO: BLOCK 1 ;EXPECTED TAPE NUMBER OF READ
RSEQ: BLOCK 1 ;EXPECTED SEQ NUMBER ON READ
TAPLFT: BLOCK 1 ;SET TO 0 WHEN EOT MARK ENCOUNTERED
CNTR: BLOCK 1 ;PAGES THIS FILE REMAINING TO BE DUMPED
USRCNT: BLOCK 1 ;COUNT OF PAGES THIS DIR
TOTCNT: BLOCK 1 ;COUNT OF PAGES ALL DIRS
CDIRN: BLOCK 1 ;CONNECTED DIRECTORY NUMBER
CHECK: BLOCK 1 ;NON-0 IF CHECKING, 0 IF LOADING
LPTJFN: BLOCK 1 ;JFN FOR LISTING FILE
LSTFIL: BLOCK 40 ;FILESPEC FOR LOG FILE
INCRSW: BLOCK 1 ;-1 FOR FULL-INCREMENTAL, ELSE INCREMENTAL COUNT OR 0
TFNAME: BLOCK 100 ;SAVE FILE NAME HERE
DIRNAM: BLOCK 20 ;NAME STRING OF CURRENT DIRECTORY
ODRNAM: BLOCK 20 ;NAME STRING OF OUTPUT DIRECTORY
LSTDIR: BLOCK 20 ;NAME STRING OF LAST DIRECTORY
CONBUF: BLOCK 20 ;STORAGE OF CONNECTED STRUCTURE AND DIRECTORY
CONSTR: BLOCK 1 ;POINTER TO CONNECTED STRUCTURE STRING
CONDIR: BLOCK 1 ;POINTER TO CONNECTED STRUCTURE STRING
JFN: BLOCK 1 ;JFN FOR CURRENT DUMP OR LOAD FILE
MTJFN: BLOCK 1 ;JFN OF MAG TAPE
MTCOMS: BLOCK 2 ;MTA DUMPI/DUMPO COMMAND LIST
LPTPOS: BLOCK 1 ;LPT LINE POSITION
BGNTAD: BLOCK 1 ;TAD AT START OF SAVE
INIJFN: BLOCK 1 ;INITIAL JFN FOR SAVE
INIPGN: BLOCK 1 ;INITIAL PAGE NUMBER FOR SAVE
INICNT: BLOCK 1 ;SAVED COUNTER IF IN MIDDLE OF FILE
ININUM: BLOCK 1 ;FLAG FOR INITIAL DDB
FDB: BLOCK .FBLN0 ;FDB FOR CURRENT FILE
FDBAUT: BLOCK 10 ;STORE AUTHER OF FILE
FDBLWR: BLOCK 10 ;STORE LAST WRITER NAME
FDBARC: BLOCK .ARPSZ+1 ; Tape info for arc/col/mig
ICFDB: BLOCK .FBLN0 ;SAVED FDB FOR INTERCHANGE FORMAT
WBTAD: BLOCK 1 ;WRITTEN-BEFORE TAD
WSTAD: BLOCK 1 ;WRITTEN-SINCE TAD
ABTAD: BLOCK 1 ;ACCESSED-BEFORE TAD
ASTAD: BLOCK 1 ;ACCESSED-SINCE TAD
MBTAD: BLOCK 1 ;MOVED-BEFORE TAD
MSTAD: BLOCK 1 ;MOVED-SINCE TAD
DEVNAM: BLOCK 14 ;DEVICE NAME FOR INCREMENTAL SAVE
FBUF1: BLOCK 11 ;BUFFERS FOR FILESPEC STRING COMPARE
FBUF2: BLOCK 11
LPTBUF: BLOCK 40 ;BUFFER FOR LPT TEXT
LSTHDR: BLOCK ^D200/5 ;HEADING FOR EACH LISTING PAGE
LPTLIN: BLOCK 1 ;LISTING LINE NUMBER
LPTPAG: BLOCK 1 ;LISTING PAGE
TMODE: BLOCK 1 ;BIT 0 - LOCAL FLAG FOR MTOPN INDICATING
; TAPE DATA MODE MUST BE SET
;OF%RD - SET IF TAPE OPEN FOR READ
;OF%WR - SET IF TAPE OPEN FOR WRITE
NWTBIT: BLOCK 1 ;OVERLAP BIT
ICOLEN: BLOCK 1 ;LENGTH OF FILE FOR INTERCHANGE SAVE
;CHECKSUM INFORMATION
CHKCN0: BLOCK 1 ;CHECKSUM FOR FILE
LSTPGE: BLOCK 1 ;LAST PAGE CHECKSUMMED
FPGCNT: BLOCK 1 ;# OF COMPLETE PAGES BEFORE EOF
RMRPGE: BLOCK 1 ;PARTIAL PAGE BEFORE EOF
P2JFN: BLOCK 1 ;JFN FOR PASS2, INCREMENTAL & ARCHIVAL
UNLTAP: BLOCK 1 ;NON-0 FOR UNLOAD TAPE AFTER SAVE
ARCSW: BLOCK 1 ;NON-0 FOR ARCHIVE RUN
COLSW: BLOCK 1 ; 1=> COL; -1=>MIG
ARSETS: BLOCK 1 ;#SETS ARCHIVE INFO. IN FDB
ARCTSN: BLOCK 1 ;ARCHIVE SAVESET NO.
SSTYP: BLOCK 1 ;SAVESET TYPE (ARCHIVE, COLL., OR MIG.)
ARSSTB: BLOCK 5 ;ARG BLOCK FOR .ARSST
SPSEQ: BLOCK 1 ;SPEC. SEQ. NO. FOR RESTART OF ARCH. RUN
IDIR: BLOCK 12 ;INITIAL STR:DIRECTORY ON TAPE
CDIR: BLOCK 12 ;CURRENT STR:DIRECTORY FOR PASS 2
XDIR: BLOCK 12 ;STR:DIRECTORY AT END OF TAPE (PASS2)
FNDDIR: BLOCK 1 ;FLAG FOR FOUND XDIR (PASS2)
ISPEC: BLOCK 200 ;INITIAL FILESPEC ON TAPE
CSPEC: BLOCK 200 ;CURRENT FILESPEC (PASS2)
XSPEC: BLOCK 200 ;FILESPEC AT TAPE SWITCH
LODARC: BLOCK 1 ;FLAG LOAD ARCHIVE INFO
NXTRTP: BLOCK 1 ; Pointer to current retrieval blk
SNDFRK: BLOCK 1 ; SNDMSG fork handle
RETSW: BLOCK 1 ; Non 0 => doing retrievals
TPJFN: BLOCK 1 ; Temp JFN storage - used by SND & LSTMSG
; Do not separate the following SNDMSG blk
SNDTO: BLOCK 1
SNDSUB: BLOCK 1
SNDTXT: BLOCK 1
TOLST: BLOCK 40
BMBFLG: 0
CURSNP: 0 ; Text body ptr for ARMSUS routine
LTARDR: BLOCK 11 ; Current dir name for arc'd msgs
FKRTBK: BLOCK FILNM ; Fake retrieval block
TEMP: BLOCK 40 ; For file name in fake retrieval blk
STGEND: ;END OF STORAGE CLEARED AT STARTUP
; Block used for ACKing msgs with ACK request on
ACKBLK: MSHSIZ,,.QOHEL ; Size & hello
MF.NOM ; No message, just an ACK
.-. ; ACK code to be filled in
;FLAG USED IN DUMPI/DUMPO TO REQUEST OVERLAPPED OPERATION
NWTBT0: DM%NWT ;SET TO 0 FOR NON-OVERLAPPED
NBUF: 10 ;SIZE OF FILE WINDOW AT BUF0
INIPDL: IOWD NPDL,PDL ;INITIAL PUSH DOWN LIST
;STANDARD RETURNS
RSKP: AOS 0(P)
R: RET
;GTJFN BLOCK USED ONLY FOR REFERENCING FILES WHICH CAN BE INVISIBLE.
;***WARNING*** THE ONLY WORD OF THIS BLOCK WHICH SHOULD BE CHANGED
;IS THE FLAG WORD .GJGEN.
RETBLK: 0 ;FLAGS, FILLED IN AT RUNTIME
.NULIO,,.NULIO ;NO EXTRA INPUT OR OUTPUT
0 ; No device default
0 ; No directory
0 ; No name
0 ; No type
0 ; No protection
0 ; No account
0 ; No special JFN
G1%IIN ; Find invisible files
CRLF: ASCIZ/
/
DEFINE SAVPQ <
JSP CX,.SAV8##>
DEFINE SAVEQ <
JSP CX,.SAV3##>
DEFINE JSERR<
JSP CX,JSERR0>
DEFINE ERROR (TAG,MSG)<
JRST [ TMSGC <MSG
>
JRST TAG]>
DEFINE ERRORJ (TAG,MSG)<
JRST [ TMSGC <MSG, >
CALL JSERRM
JRST TAG]>
DEFINE FATAL (TXT) <
JRST [PUSH P,A
HRROI A,[ASCIZ \TXT\]
PSOUT
POP P,A
HALTF]>
DEFINE TMSG(S)<
HRROI B,[ASCIZ \S\]
CALL TMSGQ>
DEFINE LPMSG(S)<
HRROI B,[ASCIZ \S\]
CALL LPMSGQ>
DEFINE BTMSG(S)<
HRROI B,[ASCIZ \S\]
CALL BTMSGQ>
DEFINE TMSGC(S)<
HRROI B,[ASCIZ \S\]
CALL TMSGQC>
DEFINE BTMSGC(S)<
HRROI B,[ASCIZ \S\]
CALL BTMSQC>
DEFINE TXTPTR (MSG)<POINT 7,[ASCIZ \MSG\]>
DEFINE TB (DAT,TXT)<
XWD [ASCIZ \TXT\],DAT>
SUBTTL MAIN LOOP
;PROGRAM ENTRY VECTOR
ENTVEC: JRST START ;STARTING LOCATION
JRST CLRST ;REENTER LOCATION
VDUMPR ;VERSION NUMBER
START: RESET
MOVE A,[STGBGN,,STGBGN+1]
SETZM -1(1)
BLT A,STGEND-1 ;CLEAR ALL VARIABLES
MOVE P,INIPDL
MOVEM P,PDLP ;SET COMMAND STACK FENCE
MOVE A,[SIXBIT /LHOSTN/]
SYSGT ; Look up local ARPAnet site #
SKIPE B ; Table exist?
MOVEM A,LHOSTN ; Stash away local site #
MOVE A,[IOWD N.JFN,JFNSTK]
MOVEM A,INIPTR ;INITIALIZE JFN STACK POINTER
MOVEM A,RPSPTR ;REPARSE POINTER
MOVEM A,CURPTR ;AND CURRENT POINTER
MOVEM A,CMDPTR ;AND COMMAND POINTER
MOVE A,[JRST EINT1A]
MOVEM A,EINT1+1 ;SETUP JSR DISPATCH
MOVX F,LDIRF+RESPRO+RESACC ;DEFAULTS
SETZM LSTFIL ;NO LIST IS DEFAULT
SETO A,
MOVE B,[-2,,Q1]
MOVEI C,.JIDEN
GETJI ;GET JOB DEFAULT DENSITY AND PARITY
JSERR
MOVEM Q1,DENSIT ;SAVE THEM
MOVEM Q2,PARITY
MOVEI A,CURFMT ;DEFAULT IS CURRENT FORMAT
MOVEM A,FORMAT
MOVX A,DEFBKF ;GET DEFAULT BLOCKING-FACTOR
MOVEM A,SETBKF ; AS LAST BLOCKING-FACTOR SET
CALL MTBOT ;SET UP AS IF AT BEGINNING OF TAPE
HRROI A,[ASCIZ/RETRVL/]
STDEV ;RETRIEVAL TAPE FROM PREVIOUS RUN?
SKIPA ;NO
JRST [ LOAD A,DV%TYP,B
CAIE A,.DVMTA ;JUST MAKE SURE IT'S A TAPE
JRST .+1
MOVEM B,MNTDSG ;IS A TAPE
SETZ A,
CALL SETMNT ;RELEASE TAPE AND DELETE LOGICAL NAME
JRST .+1]
MOVEI A,.FHSLF
MOVE B,[LEVTAB,,CHNTAB]
SIR ;DECLARE INTERRUPT TABLES
EIR ;ENABLE INTERRUPTS
MOVE B,CHNMSK
AIC ;ACTIVATE CHANNELS
MOVE A,[.TICCE,,CECHN]
ATI ;ACTIVATE ^E INTERRUPT
CALL UNMAPB ;RESET BUFFERS
MOVEI A,.FHSLF
RPCAP
TXNE C,SC%WHL+SC%OPR ;WHEEL OR OPERATOR?
JRST [ SETOM WHEEL ;YES
MOVEI A,.MSIIC
MSTR ;OVERRIDE STRUCTURE REGULATION
ERCAL R ;POSSIBLY RUNNING ON TOPS-20 REL 3A
JRST .+1]
HRLOI A,377777 ;INIT 'BEFORE' DATE TO PLUS INFINITY
MOVEM A,ABTAD
MOVEM A,WBTAD
MOVEM A,MBTAD
MOVX A,1B0 ;INIT 'SINCE' DATE TO MINUS INFINITY
MOVEM A,ASTAD
MOVEM A,WSTAD
MOVEM A,MSTAD
MOVE A,[ICBLK,,CBLK] ;INIT COMMAND STATE BLOCK
BLT A,CBLK+.CMGJB
;RESET AND START COMMAND
CLRST: MOVE P,PDLP ;RESTORE PDL NOW
CALL MTCLS ;CLOSE MAGTAPE IF OPEN
SETZM TRAPJ ;CLEAR TRAP FENCE
SETZM INTPC ;NO ^E
MOVE P,INIPDL ;RESET PUSH DOWN LIST
CALL INIRST ;RESET JFN STACK TO INIPTR
; JRST RESTRT ;AND START OVER
; ..
;TOP OF COMMAND
RESTRT: MOVEM P,PDLP ;SAVE PDL POINTER
SETZM CMDTYP ;ZERO COMMAND TYPE FLAG
SETZM TRAPSP
SETZM TRAPJ ;ZERO TRAP STUFF
SETZM CEXFLG
SETZM INTRQ
MOVE A,CURPTR
CAME A,CMDPTR ;ERROR IF NOT SAME
ERROR BMBCM1,<?CMDPTR SHOULD EQUAL CURPTR>
TXZ F,NOFLG
MOVE A,CMDPTR ;GET COMMAND POINTER
MOVEM A,RPSPTR ;RESET REPARSE POINTER
MOVEM A,CURPTR ;AND CURRENT POINTER
MOVEI A,REPAR0 ;GET REPARSE ADDRESS
HRROI B,[ASCIZ /DUMPER>/] ;GET POINTER TO PROMPT
CALL CMDINI ;INIT FOR COMND JSYS
REPAR1: TXZ F,NOFLG ;FORGET STUFF FROM PARTIAL COMMAND
MOVEI A,CBLK
MOVEI B,[FLDDB. (.CMKEY,,CTBL,<command name>)]
COMND ;GET COMMAND NAME
NO1: TXNE A,CM%NOP
ERROR RESTRT,<?NOT A DEFINED COMMAND>
HRRZ B,0(B) ;GET POINTER TO COMMAND WORD
MOVE B,(B) ;FLAGS,,DISPATCH ADDRESS
MOVEM B,CMDTYP ;STORE AS CURRENT TYPE
JRST 0(B) ;DISPATCH TO IT
;HERE WHEN REPARSE NEEDED
REPAR0: MOVE P,PDLP ;RESTORE PDL PNTR
CALL REPRST ;RESET JFN STACK
JRST REPAR1 ;CONTINUE PARSE
REPRST: MOVE D,RPSPTR ;REPARSE POINTER
CALL RSTSTK ;RESET STACK TO REPARSE POINTER
RET ;RETURN
;HERE WHEN COMMAND COMPLETED
CDONE: SKIPN ARCSW ; Doing an archive run?
SKIPE COLSW ; Collection/migration?
JRST [ SKIPE ICMDTY ; One of those, Under ^E?
JRST .+1 ; Yes, don't clean up
SETZM ARCSW
SETZM COLSW
CALL MLDONE ; Finished with SNDMSG stuff
JRST .+1]
SKIPE RETSW ; Doing a retrieval?
JRST [ SKIPE ICMDTY ; Yes, under ^E?
JRST .+1 ; Yes, don't clean up now
CALL RETCLN ; Do clean up actions
CALL MLDONE ; We're done with SNDMSG fork
SETZM RETSW ; Flag no longer retrieving
CALL RELPID ; Relase PID used for QSR comm.
JRST .+1]
SETZM CEXFLG
SKIPN ICMDTY ;SKIP IF UNDER ^E
JRST [ TXZ F,TF2 ;NOT IN MIDDLE OF FILE
MOVE D,CMDPTR ;GET COMMAND POINTER
CAMN D,INIPTR ;COMPARE TO INITIAL POINTER
JRST .+1 ;SAME, OK
TMSGC <%CMDPTR SHOULD EQUAL INIPTR>
CALL INIRST ;RESET STUFF
JRST RESTRT] ;RESTART COMMAND
MOVE D,CMDPTR ;FINAL POINTER
CALL RSTSTK ;RESET STACK TO COMMAND POINTER
MOVEM D,RPSPTR ;SET BACK TO COMMAND POINTER
JRST RESTRT
;HERE TO BOMB THE CURRENT COMMAND
;IF COMMAND IS CONFIRMED, ENTER AT BMBCMD
;IF COMMAND IS NOT CONFIRMED, ENTER AT BMBCM1
BMBCMD: MOVE D,CMDTYP ;GET COMMAND TYPE
TXNE D,TY%MAP ;NOSKIP IF COMMAND MAPS BUFPAG
CALL UNMAPB ;RESET BUFFERS
BMBCM1: MOVE P,PDLP ;RESET PDL TO TOP OF COMMAND
MOVE D,CMDPTR ;RESET TO TOP OF COMMAND
CALL RSTSTK ;RESET STACK TO TOP OF COMMAND
MOVEM D,RPSPTR ;REPARSE POINTER RESET
MOVEI A,.PRIIN ;PRIMARY INPUT DEVICE
CFIBF ;CLEAR BUFFER
SKIPE RETSW ; In a retrieval?
JRST [ SKIPN MYPID ; Have a PID?
JRST .+1 ; No, forget this
CALL GDBYE ; Tell QUASAR goodbye
JFCL
CALL RELPID ; And release the PID
JRST .+1]
JRST RESTRT ;TOP OF NEW COMMAND
;CONFIRM
CONFRM: PUSH P,A
PUSH P,B
PUSH P,C ;BE TRANSPARENT
MOVEI A,CBLK
MOVEI B,[FLDDB. .CMCFM]
COMND ;CONFIRM
TXNE A,CM%NOP
ERROR BMBCM1,<?NOT CONFIRMED>
CALL JFNCFM ;WORK OVER JFN STACK
POP P,C
POP P,B
POP P,A
RET
; COMNDX - EXECUTE COMND JSYS AND HANDLE NO-PARSE ERRORS
; B/ ADDRESS OF FUNCTION DESCRIPTOR BLOCK (FDB)
; RETURNS +1: PARSE SUCCESSFUL; A,B,C/ AS RETURNED BY COMND
; TO BMBCM1 AFTER TYPING ERROR MESSAGE IF CM%NOP IS RETURNED
COMNDX: MOVEI A,CBLK ;GET STATE BLOCK ADDRESS
COMND ;ISSUE COMND
TXNN A,CM%NOP ;PARSE OK?
RET ;YES
TMSGC <?>
CALL JSERRM ;TYPE REASON FOR FAILURE
JRST BMBCM1
; COMNDN - SAME AS COMNDX, BUT TAKES +1 ON NO-PARSE, +2 ON SUCCESS
COMNDN: MOVEI A,CBLK
COMND
TXNN A,CM%NOP ;OK?
RETSKP ;YES
TMSGC <?>
CALLRET JSERRM ;TYPE REASON AND RETURN TO CALLER
; NOISE - PARSE NOISE PHRASE
; A/ STRING POINTER TO NOISE PHRASE
; RETURNS +1: NOISE PARSED SUCCESSFULLY
NOISE: STKVAR <<NOIFDB,2>>
MOVEM A,.CMDAT+NOIFDB ;STUFF POINTER IN FDB
MOVX A,FLD(.CMNOI,CM%FNC)
MOVEM A,.CMFNP+NOIFDB
MOVEI B,NOIFDB ;GET FDB ADDR
CALLRET COMNDX ;ISSUE COMND JSYS AND RETURN
; KEYWD - PARSE A KEYWORD
; A/ LH: ADDRESS OF ASCIZ HELP TEXT (0 IF NONE)
; RH: ADDRESS OF KEYWORD TABLE
; RETURNS +1: KEYWORD PARSED, B/ ADDRESS OF KEYWORD TABLE ENTRY
KEYWD: SAVEQ ;BUILD FDB IN Q1-Q3
MOVX Q1,FLD(.CMKEY,CM%FNC) ;.CMFNP WORD OF FDB
HRRZ Q2,A ;.CMDAT WORD OF FDB
HLRO Q3,A ;.CMHLP WORD OF FDB
TRNE Q3,-1 ;HELP MESSAGE SPECIFIED?
TXO Q1,CM%HPP ;YES, TELL COMND
MOVEI B,Q1 ;GET FDB ADDRESS FOR COMND
CALLRET COMNDX ;GO PARSE AND RETURN TO CALLER
; CMDINI - INITIALIZE FOR COMND JSYS
; A/ FLAGS,,REPARSE ADDRESS
; B/ STRING POINTER TO PROMPT
; RETURNS +1: ALWAYS
CMDINI: MOVEM A,CBLK+.CMFLG ;STORE FLAGS AND REPARSE ADDRESS
MOVEM B,CBLK+.CMRTY ;STORE POINTER TO PROMPT STRING
MOVEI B,[FLDDB. .CMINI] ;GET ADDRESS OF INIT FDB
CALLRET COMNDX ;ISSUE COMND JSYS AND RETURN +1
;COMMAND HAS JUST BEEN CONFIRMED. CHECK FOR UNDER ^E
;AND SET JFNSTK POINTERS CORRECTLY FOR CIRCUMSTANCES
;ROUTINE ASSUMES IT MAY USE AC'S A,B,C.
JFNCFM: SKIPE ICMDTY ;UNDER ^E?
JRST JFNCF1 ;YES, SEE IF THIS IS A CONTINUE CMD.
TXZ F,LTTYF
MOVE A,CMDTYP ;GET TYPE
TXNE A,TY%RPO ;SKIP IF NOT REPARSE ONLY
JRST [ MOVE A,RPSPTR ;GET REPARSE POINTER
MOVEM A,CURPTR ;STORE AS CURRENT POINTER
RET]
MOVE A,CURPTR ;CURRENT POINTER
MOVEM A,RPSPTR ;BECOMES REPARSE POINTER
RET
;THE USER HAS TYPED A COMMAND UNDER ^E. CHECK IF IT IS
;A CONTINUE OR NO-CONTINUE COMMAND. IF IT IS NO-CONTINUE,
;INFORM THE USER AND GIVE HER/HIM THE CHOICE BETWEEN THE
;OLD COMMAND AND THE CURRENT COMMAND.
;CALLED WITH A,B,C ON THE STACK AND WITH THE
;CURRENT COMMAND TYPE IN CMDTYP.
JFNCF1: MOVE A,CMDTYP ;GET COMMAND INFORMATION
TXNE A,TY%NOC ;SKIP IF CONTINUE-ABLE
JRST JFNCF2 ;NOT CONTINUE-ABLE
TXNN A,TY%RPO ;SKIP IF REPARSE ONLY
JRST [ MOVE B,RPSPTR ;GET REPARSE POINTER
MOVEM B,CMDPTR ;USE AS COMMAND POINTER
MOVE B,CURPTR ;CURRENT POINTER
MOVEM B,RPSPTR ;ALSO REPARSE POINTER
RET ] ;RETURN
MOVE B,RPSPTR ;GET REPARSE POINTER
MOVEM B,CURPTR ;RESET CURRENT POINTER
RET ;RETURN
;HERE IF UNDER ^E AND NOT CONTINUEABLE
JFNCF2: HRROI A,[ASCIZ\%Do you really want to abort your interrupted command? \]
CALL YESNO ;GET YES OR NO
JUMPE A,DLTNEW ;NO-- DELETE NEW COMMAND
; JRST DLTOLD ;YES-- DELETE OLD COMMAND
;HERE TO DELETE OLD COMMAND
DLTOLD: SAVPQ ;SAVE PERM REGS
TXZ F,LTTYF
SKIPE MTJFN ;TAPE OPEN?
JRST [ MOVX B,OF%RD ;YES
TDNE B,TMODE ;OPEN FOR READING
SKIPG MTTYP ; AND LABELED?
JRST .+1 ;NOT BOTH
CALL XGDSTS ;CLEAR ERRORS
CALL REWCV ;PROBABLY IN THE MIDDLE OF SOME SAVESET
JRST .+1]
CALL MTCLS ;CLOSE TAPE IF OPEN
SETZ A,
CALL SETMNT ;RELEASE MOUNTED MT IF ANY
TXZ F,TF2 ;NOT IN MIDDLE OF FILE
MOVE D,CMDPTR ;COMMAND POINTER
CAMN D,INIPTR ;SKIP IF JFNS TO DELETE
JRST DLTOL2 ;NONE
CALL UNMAPB ;RESET BUFFERS
DLTOL1: POP D,A ;GET OLD JFN
CALL RLSJFN ;THROW AWAY
CAME D,INIPTR ;SKIP IF DONE
JRST DLTOL1 ;LOOP
MOVE A,INIPTR ;INITIAL POINTER
MOVE B,CURPTR ;CURRENT POINTER
SUB B,CMDPTR ;NEW SIZE
HRLS B ;SIZE,,SIZE
ADD A,B ;NEW POINTER
MOVEM A,CURPTR ;STORE
HRLZ B,CMDPTR ;START BLT FROM
HRR B,INIPTR ;BLT TO
ADD B,[1,,1]
BLT B,0(A) ;MOVE IT
MOVE A,INIPTR
MOVEM A,CMDPTR
DLTOL2: MOVE A,CURPTR
MOVEM A,RPSPTR ;UPDATE REPARSE POINTER
MOVE A,LPTJFN ;LIST FILE JFN
CALL RLSJFN ;RELEASE IT
SETZM INTPC
SETZM ICMDTY ;NO LONGER UNDER ^E
MOVE A,INIPDL ;
MOVE B,P ;
SUB B,IPDLP ;# ITEMS TO GET RID OF
HRLS B ;IN BOTH SIDES
ADD A,B ;CONSTRUCT NEW POINTER
MOVE P,A ;AND STORE
HRLZ B,IPDLP ;BLT FROM
HRR B,INIPDL ;BLT TO
ADD B,[1,,1]
BLT B,0(A) ;MOVE IT
MOVE A,INIPDL
MOVEM A,PDLP ;RESET PDLP
HRRZS A,Q1 ;OFFSET ONLY
HRRZ B,NIJFN ;PICK UP INTERRUPTED OFFSET
SUB Q1,B ;NEW OFF SET
HRLS Q1 ;NEW OFFSET IN BOTH SIDES
HRLZ B,NIJFN ;BLT START OFFSET
MOVE C,[JFNLST,,JFNLST] ;BASE FOR FIRST BLT
ADD C,B ;FIGURE BLT START ADDRESSES
BLT C,JFNLST(Q1)
ADD B,[JF2LST,,JF2LST] ;BLT START ADDRESSES
BLT B,JF2LST(Q1)
MOVSI B,-NJFNL+1 ;SET UP Q1
ADD Q1,B ;...
RET
;HERE TO FORGET NEW COMMAND
DLTNEW: CALL REPRST ;RESET JFN STACK
MOVE P,PDLP ;SET PDL BACK
SETZM CMDTYP ;NO COMMAND
JRST RESTRT ;GO ON
;COMMAND NAME TABLE
DEFINE CTB (DAT,FLGS,TXT)<
XWD [ASCIZ \TXT\],[FLGS+DAT]>
CTBL: NCTBL,,NCTBL
CTB $AB4,,<ABEFORE>
CTB $ACC,,<ACCOUNT>
CTB $ASI,,<ASINCE>
CTB $B4,,<BEFORE>
CTB CHCK,TY%NOC+TY%MAP,<CHECK>
CTB $CSUM,,<CHECKSUM>
CTB $CONT,,<CONTINUE>
CTB $CREAT,,<CREATE>
CTB $DEN,,<DENSITY>
CTB $LDIR,,<DIRECTORIES>
CTB $EOT,TY%NOC+TY%MAP,<EOT>
CTB $EXIT,TY%NOC,<EXIT>
CTB $LFIL,,<FILES>
CTB $FMT,,<FORMAT>
CTB TYPHLP,,<HELP>
CTB $INDMD,,<INDUSTRY>
CTB $INISP,TY%RPO,<INITIAL>
CTB $ICMOD,TY%NOC,<INTERCHANGE>
CTB $LIST,TY%RPO,<LIST>
CTB $MB4,,<MBEFORE>
CTB $MSI,,<MSINCE>
CTB $NO,,<NO>
CTB $PAR,,<PARITY>
CTB PRINT,TY%NOC+TY%MAP,<PRINT>
CTB $PRO,,<PROTECTION>
CTB $EXIT,TY%NOC,<QUIT> ;synonym for EXIT
CTB $LOAD,TY%NOC+TY%MAP+TY%DBL,<RESTORE>
CTB $RETRI,TY%NOC+TY%MAP+TY%DBL,<RETRIEVE>
CTB $REW,TY%NOC,<REWIND>
CTB DUMP,TY%NOC+TY%MAP+TY%DBL,<SAVE>
CTB $$SET,,<SET>
CTB $SIL,,<SILENCE>
CTB $SINCE,,<SINCE>
CTB $SKIP,TY%NOC+TY%MAP,<SKIP>
CTB $SSNAM,,<SSNAME>
CTB $SUP,,<SUPERSEDE>
CTB $TAPE,TY%RPO,<TAPE>
CTB $UNL,TY%NOC,<UNLOAD>
NCTBL==.-CTBL-1
;INITIAL COMMAND STATE BLOCK
ICBLK: REPAR0 ;REPARSE DISPATCH
.PRIIN,,.PRIOU
POINT 7,[ASCIZ /DUMPER>/] ;PROMPT
POINT 7,CBFR
POINT 7,CBFR
CBFSIZ*5
0
POINT 7,ACBFR
ACBSIZ*5
GJBLK
SUBTTL COMMANDS
;DATE SETTING COMMANDS
;ACCESSED-BEFORE
$AB4: CALL GETTAD
MOVEM A,ABTAD
JRST CDONE
;ACCESSED-SINCE
$ASI: CALL GETTAD
MOVEM A,ASTAD
JRST CDONE
;WRITTEN-BEFORE
$B4: CALL GETTAD
MOVEM A,WBTAD
JRST CDONE
;WRITTEN-SINCE
$SINCE: CALL GETTAD
MOVEM A,WSTAD
JRST CDONE
;MOVED-BEFORE
$MB4: CALL GETTAD
MOVEM A,MBTAD
JRST CDONE
;MOVED-SINCE
$MSI: CALL GETTAD
MOVEM A,MSTAD
JRST CDONE
;GET TIME AND DATE AS NEXT FIELD
GETTAD: HRROI A,[ASCIZ/DATE AND TIME/]
CALL NOISE
MOVEI B,[FLDDB. (.CMTAD,,CM%IDA+CM%ITM,,,[FLDDB. (.CMTAD,,CM%IDA)])]
CALL COMNDX ;PARSE DATE WITH OPTIONAL TIME
MOVE A,B
CALLRET CONFRM ;CONFIRM IT
;INTERCHANGE MODE
$ICMOD: HRROI A,[ASCIZ/FORMAT/]
CALL NOISE
CALL CONFRM
TXNE F,NOFLG
TXZA F,ICMODF ;NO INTERCHANGE
TXO F,ICMODF ;INTERCHANGE
JRST CDONE
;(NO)CREATE DIRECTORIES FROM TAPE DATA ON RESTORE
$CREAT: HRROI A,[ASCIZ/DIRECTORIES FROM TAPE DATA/]
CALL NOISE
CALL CONFRM
TXNE F,NOFLG
TXZA F,USRDAT ;MEANS IGNORE USER DATA
TXO F,USRDAT
JRST CDONE
;(NO)INDUSTRY COMPATIBLE 36-BIT MODE, I.E. LIKE MULTICS AND BBN
$INDMD: HRROI A,[ASCIZ/COMPATIBLE 36-BIT MODE/]
CALL NOISE
CALL CONFRM
TXNE F,NOFLG
TXZA F,T36MOD ;NORMAL DEC 'CORE DUMP' MODE
TXO F,T36MOD ;ELSE 2 36-BIT WORDS IN 9 FRAMES
JRST CDONE
;INITIAL FILE SPECIFICATION FOR SAVE/RESTORE. MUST BE FILE WITHIN
;GROUP SPECIFIED IN SAVE OR RESTORE COMMAND. OPERATIONS
;BEGINS WITH THIS FILE.
$INISP: HRROI A,[ASCIZ/FILESPEC/]
CALL NOISE
SETZ B, ;PREPARE B IN CASE OF NEGATION
JXN F,NOFLG,$INIS1 ;JUMP IF NEGATED
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;SETUP DEFAULT STRING
MOVX A,GJ%OLD+GJ%IFG
HLLM A,GJBLK+.GJGEN ;ALLOW STARS
MOVEI A,CBLK
MOVEI B,[FLDDB. .CMFIL]
COMND
TXNE A,CM%NOP
ERRORJ RESTRT,<?INVALID FILESPEC>
CALL ADFILE ;ADD JFN TO JFN STACK
$INIS1: CALL CONFRM ;CONFIRM
EXCH B,INIJFN ;SAVE NEW JFN, GET OLD JFN
HRRZ A,B ;GET OLD JFN ALONE IN A
SKIPE A ;DID I HAVE A JFN BEFORE?
RLJFN ;YES, DUMP IT
JFCL
SETZM ININUM ;CLEAR DDB FLAG
JRST CDONE
;SAVESET NAME
$SSNAM: MOVE Q1,CBLK+.CMPTR ;SAVE CURRENT LINE POINTER
MOVEI B,[FLDDB. (.CMTXT,CM%SDH,,<arbitrary save set name text>)]
CALL COMNDX ;PARSE TO EOL
HRROI A,SSNBUF ;DESTINATION POINTER
MOVE B,CBLK+.CMABP ;POINT TO ATOM BUFFER WHERE TEXT IS NOW
SETZ C, ;ASCIZ
SOUT ;COPY NAME
JRST CDONE ;ALL DONE WITH $SSNAM
;SUPERSEDE ALWAYS/NEVER/OLDER
$SUP: MOVEI A,STBL
CALL KEYWD ;PARSE KEYWORD
CALL CONFRM
HRRZ B,0(B) ;GET FLAGS
TXZ F,SSA+SSN ;MOVE THEM TO F
IOR F,B
JRST CDONE
STBL: NSTBL,,NSTBL
TB SSA,<ALWAYS>
TB SSN,<NEVER>
TB 0,<OLDER>
NSTBL==.-STBL-1
;PROTECTION TO BE RESTORED FROM TAPE OR SYSTEM DEFAULT
$PRO: HRROI A,[ASCIZ/OF RESTORED FILES FROM/]
CALL NOISE
MOVEI A,ACCTB
CALL KEYWD ;PARSE KEYWORD
CALL CONFRM
HRRZ B,0(B)
SKIPN B ;SET FLAG PER ARGUMENT
TXZA F,RESPRO
TXO F,RESPRO
JRST CDONE
;ACCOUNT OF RESTORED FILES TO BE SET FROM TAPE OR SYSTEM DEFAULT
$ACC: HRROI A,[ASCIZ/OF RESTORED FILES FROM/]
CALL NOISE
MOVEI A,ACCTB
CALL KEYWD ;PARSE KEYWORD
CALL CONFRM
HRRZ B,0(B)
SKIPN B ;SET FLAG PER ARG
TXZA F,RESACC
TXO F,RESACC
JRST CDONE
;ARGUMENT KEYWORD TABLE FOR PROTECTION AND ACCOUNT
ACCTB: NACCTB,,NACCTB
TB 0,<SYSTEM-DEFAULT>
TB 1,<TAPE>
NACCTB==.-ACCTB-1
;TAPE - SETS MTA UNIT SPECIFICATION
$TAPE: HRROI A,[ASCIZ/DEVICE/]
CALL NOISE
CALL PRSTAP ;PARSE MAGTAPE DESIGNATOR, GET JFN IN B
JRST RESTRT ;USER BLEW IT
CALL ADLIST ;ADD JFN TO JFN STACK
CALL CONFRM ;CONFIRM IT
MOVE A,B ;PASS JFN
CALL CHKMTJ ;CHECK OUT JFN
JRST RESTRT ;FAILED
JRST CDONE
;NTAPE - GET TAPE SPEC FOR SECOND AND SUBSEQUENT TAPES
;NTAPER ENTRY REWINDS TAPE BEFORE RETURNING
;RETURNS +1: ERROR SWITCHING VOLUMES
; +2: SUCCESS
NTAPE: TDZA A,A ;NO REWIND
NTAPER: MOVEI A,1 ;REWIND
SAVEQ
MOVE Q2,A ;SAVE REWIND FLAG
MOVEM P,TPDLP ;TEMPORARY PLACE TO SAVE P
NTAPE1: SETZM VOLID6 ;CLEAR VOLID
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
SKIPE MTDSG ;SKIP IF NO TAPE DEVICE YET
JRST [ SKIPGE A,MTTYP ;WHAT KIND OF TAPE?
JRST .+1 ;MTA, HAVE TO TALK TO USER
JUMPE A,NTUMT ;UNLABELED MT, DO VOLSWITCH
RETSKP] ;LABELED MT, NO ACTION NECESSARY
MOVEI A,NTAPEC ;REPARSE ADDRESS
HRROI B,[ASCIZ /$ Tape filespec /]
CALL CMDINI ;INIT FOR COMND JSYS
NTAPE2: CALL PRSTAP ;PARSE TAPE FILESPEC
JRST NTAPE1 ;ERROR
CALL ADLIST ;ADD JFN TO JFN STACK
MOVE Q1,B ;SAVE JFN
MOVEI B,[FLDDB. .CMCFM]
CALL COMNDN ;GET CONFIRMATION
JRST [ CALL REPRST ;ERROR, CLEAN UP DEAD JFNS
JRST NTAPE1] ;TRY AGAIN
MOVE A,RPSPTR ;REPARSE POINTER
MOVEM A,CURPTR ;RESET TO REPARSE POINTER
MOVE A,Q1 ;GET JFN IN A FOR CHKMTJ
CALL CHKMTJ ;SETUP FOR OPEN
JRST NTAPE1 ;FAILED
JUMPE Q2,RSKP ;RETURN NOW IF NO REWIND REQUESTED
CALL MTOPNX ;GET IT OPEN
CALL REWCV ;REWIND IT
CALL MTCLS ;CLOSE IT
RETSKP
;REPARSE HERE
NTAPEC: MOVE P,TPDLP ;RESTORE PNTR
CALL REPRST ;RESET JFN STACK
JRST NTAPE2 ;CONTINUE
; SWITCH TO NEXT VOLUME ON UNLABELED MT DEVICE
NTUMT: TMSGC <[Mounting next tape volume]
>
CALL MTOPNX ;OPEN JFN
MOVE A,MTJFN ;GET JFN
MOVEI B,.MOVLS ;VOLUME-SWITCH MTOPR FUNCTION CODE
MOVEI C,[EXP 3,.VSMRV,1] ;ARG LIST TO GET TO NEXT VOLUME
MTOPR
ERJMP [TMSG <?Cannot switch to next tape volume
?>
CALL JSERRM ;SAY WHY
CALLRET MTCLS] ;CLOSE JFN
MOVE A,MTJFN
CALL GMTINF ;UPDATE VOLID
CALL REWCV ;AT NEXT VOLUME, SO REWIND IT
CALL MTCLS
RETSKP
; PRSTAP - PARSE MAGTAPE FILESPEC
; RETURNS +1: ERROR ON PARSE, MESSAGE TYPED
; +2: SUCCESSFUL PARSE, B/ JFN
PRSTAP: MOVE A,[GJBLK,,GJBLK+1]
SETZM GJBLK
BLT A,GJBLK+.GJBFP ;CLEAR COMND GTJFN BLOCK
MOVEI A,CBLK
MOVEI B,[FLDDB. (.CMFIL,CM%SDH,,<magtape designator>)]
COMND ;READ MAGTAPE FILESPEC
TXNE A,CM%NOP
ERRORJ R,<?Invalid magtape designator>
RETSKP ;GOOD RETURN, B/ JFN
; CHKMTJ - GIVEN A JFN, CHECK IF IT IS A REASONABLE MAGTAPE JFN
; AND SET UP MTTYP, MTDSG, AND MTDEV
; A/ JFN (RELEASED BY CHKMTJ)
; RETURNS +1: NON-MAGTAPE OR ILLEGAL LABEL TYPE, ERROR MESSAGE TYPED
; +2: SUCCESS, MTDSG/ DESIGNATOR, MTDEV/ ASCIZ NAME
; MTTYP/ -1=MTA, 0=UNLABELED MT, +1=LABELED MT
CHKMTJ: SAVEQ
MOVE Q1,A ;SAVE JFN
DVCHR ;GET DEVICE CHARACTERISTICS
LOAD D,DV%TYP,B ;GET DEVICE TYPE
IFN DSKDMP,<MOVEI D,.DVMTA> ;For disk version, accept non-magtape
CAIE D,.DVMTA ;IS IT A MAGTAPE?
JRST [ JSP D,NTAP4 ;NO, GO GIVE ERROR MESSAGE
ASCIZ/ is not a magtape/]
MOVEM A,MTDSG ;SAVE DESIGNATOR
SETZM VOLID6 ;CLEAR VOLID IN CASE OF MTA
SETO B, ;ASSUME MTA
TRNN A,DV%PSD ;CORRECT?
JRST NTAP3 ;YES, SKIP MT CODE
MOVE A,Q1 ;GET JFN
CALL GMTINF ;GET LABEL TYPE IN A
MOVEI B,1 ;GET CODE FOR LABELED-MT
CAIE A,.LTANS ;ANSI?
CAIN A,.LTT20 ;OR TOPS-20?
JRST NTAP3 ;YES, LABELED MT
SETZ B, ;GET CODE FOR UNLABELED-MT
CAIN A,.LTUNL
JRST NTAP3 ;UNLABELED MT
MOVEI D,[ASCIZ/ illegal label type - must be UNLABELED or TOPS-20/]
NTAP4: MOVEI A,.PRIOU ;REPORT NAME
HRRZ B,Q1
MOVX C,2B2+2B5+2B8+2B11+1B35
JFNS
HRRO A,D ;GET STRING POINTER TO TEXT
PSOUT ;TYPE MESSAGE
MOVE A,Q1
RLJFN ;DUMP THE JFN
JFCL
SETZM MTDSG ;CLEAR DESIGNATOR
HRROI B,CRLF
CALLRET TMSGQ ;TYPE CRLF AND RETURN +1
NTAP3: MOVEM B,MTTYP ;STORE TYPE OF TAPE DEVICE
HRROI A,MTDEV ;GET DESTINATION STRING POINTER
HRRZ B,Q1 ;GET JFN
MOVE C,[1B2+1B35] ;DEVICE FIELD, PUNCTUATION
IFN DSKDMP,<MOVX C,1B8+1B11+1B14+1B35>
JFNS
MOVE A,Q1 ;RELEASE TEMP JFN
RLJFN
JFCL
RETSKP
;SET COMMAND
$$SET: MOVEI A,SETTBL
CALL KEYWD ;PARSE KEYWORD
HRRZ B,0(B)
MOVE B,(B)
MOVEM B,CMDTYP ;STORE AS CURRENT COMMAND TYPE
JRST 0(B) ;AND GO ON
SETTBL: NSETTB,,NSETTB
CTB SETBLK,,<BLOCKING-FACTOR>
CTB TAPNUM,,<TAPE-NUMBER>
NSETTB==.-SETTBL-1
;SET TAPE NUMBER --SETS REEL #
TAPNUM: HRROI A,[ASCIZ/DECIMAL NUMBER/]
CALL NOISE
MOVEI B,[FLDDB. (.CMNUM,,^D10)]
CALL COMNDX ;PARSE DECIMAL NUMBER
CALL CONFRM
MOVEM B,TAPNO
MOVEM B,RTAPNO ;IN CASE USER IS READING
TXO F,TNSF ;USER SET TAPE NUMBER
JRST CDONE
;SET BLOCKING-FACTOR
SETBLK: HRROI A,[ASCIZ/TO/]
CALL NOISE
MOVEI B,[FLDDB. (.CMNUM,,^D10,<number of records,>)]
CALL COMNDX ;PARSE DECIMAL NUMBER
PUSH P,B
HRROI A,[ASCIZ/RECORDS/]
CALL NOISE
CALL CONFRM
POP P,B
CAIGE B,1 ;MUST BE 1 OR GREATER
ERROR RESTRT,<?BLOCKING-FACTOR MUST BE GREATER THAN 0>
CAILE B,MAXBKF ;MUST BE WITHIN LIMIT
ERROR RESTRT,<?BLOCKING-FACTOR TOO LARGE>
MOVEM B,SETBKF ;REMEMBER BLOCKING-FACTOR
JRST CDONE
;TAPE PARAMETERS
;DENSITY
$DEN: HRROI A,[ASCIZ/OF MAGTAPE/]
CALL NOISE
MOVEI A,DENTAB
CALL KEYWD ;PARSE DENSITY KEYWORD
CALL CONFRM
HRRZ B,0(B) ;GET DENSITY CODE
MOVEM B,DENSIT ;SAVE FOR OPEN
JRST CDONE
DENTAB: NDENTB,,NDENTB
TB .SJD16,<1600-BPI>
TB .SJDN2,<200-BPI>
TB .SJDN5,<556-BPI>
TB .SJD62,<6250-BPI>
TB .SJDN8,<800-BPI>
TB .SJDDN,<JOB-DEFAULT>
NDENTB==.-DENTAB-1
;PARITY
$PAR: HRROI A,[ASCIZ/OF MAGTAPE/]
CALL NOISE
MOVEI A,PARTAB
CALL KEYWD ;PARSE PARITY KEYWORD
CALL CONFRM
HRRZ B,0(B) ;GET PARITY CODE
MOVEM B,PARITY ;SAVE FOR OPEN
JRST CDONE
PARTAB: NPARTB,,NPARTB
TB .SJPRE,<EVEN>
TB .SJPRO,<ODD>
NPARTB==.-PARTAB-1
;FORMAT SPECIFICATION - USEFUL IF STARTING IN MIDDLE OF TAPE
$FMT: HRROI A,[ASCIZ/VERSION NUMBER IS/]
CALL NOISE
MOVEI B,[FLDDB. (.CMNUM,,^D10)]
COMND
TXNE A,CM%NOP
ERROR RESTRT,<?NOT A DECIMAL NUMBER>
CALL CONFRM
MOVEM B,FORMAT ;SAVE SPECIFIED NUMBER
JRST CDONE
;'NO' - INVERTS MEANING OF FOLLOWING COMMAND
$NO: TXO F,NOFLG ;NOTE INVERSION
MOVEI B,[FLDDB. (.CMKEY,,NOTBL,<command name>)]
COMND ;ONLY CERTAIN COMMANDS AFTER NO
JRST NO1 ;JOIN NORMAL CASE
NOTBL: NNOTB,,NNOTB
CTB $CSUM,,<CHECKSUM>
CTB $CREAT,,<CREATE>
CTB $LDIR,,<DIRECTORIES>
CTB $LFIL,,<FILES>
CTB $INDMD,,<INDUSTRY>
CTB $INISP,,<INITIAL>
CTB $ICMOD,,<INTERCHANGE>
CTB $LIST,,<LIST>
CTB $SIL,,<SILENCE>
NNOTB==.-NOTBL-1
;'HELP'
TYPHLP: CALL CONFRM
MOVX A,GJ%OLD+GJ%SHT
HRROI B,[ASCIZ /SYS:DUMPER.HLP/]
GTJFN ;GET HELP FILE
JRST [ TMSG <?DUMPER help file not available, use "?" for list of commands.
>
JRST BMBCMD]
MOVEM A,JFN
MOVX B,<FLD(7,OF%BSZ)+OF%RD>
OPENF
JRST [ MOVE A,JFN
RLJFN
JFCL
CALL JSERR1
SETZM JFN
JRST BMBCMD]
TYPHL1: MOVE A,JFN ;COPY FILE TO TERMINAL
BIN
JUMPN B,[MOVEI A,.PRIOU
BOUT
JRST TYPHL1]
CLOSF ;NULL, ASSUME EOF
JFCL
SETZM JFN
JRST RESTRT
;EXIT
$EXIT: CALL CONFRM
HALTF
CALL MTCLS ;CLOSE MAGTAPE IF OPEN
JRST RESTRT ;IF CONTINUED
;TAPE POSITION COMMANDS
;REWIND
$REW: MOVEI B,[FLDDB. .CMKEY,,RWTB,,CURRENT-VOLUME]
CALL COMNDX ;PARSE KEYWORD
HRRZ B,(B) ;GET DISPATCH ADDRESS
JRST (B) ;OFF TO KEYWORD HANDLER
RWTB: RWTBL,,RWTBL
TB REWC,CURRENT-VOLUME
TB REWS,SWITCHING
RWTBL==.-RWTB-1
REWC: CALL CONFRM
CALL MTOPNX
CALL REWCV ;REWIND TO BEGINNING OF CURRENT VOLUME
JRST REW2
REWS: SAVEQ
HRROI A,[ASCIZ/TO VOLUME NUMBER/]
CALL NOISE
MOVEI B,[FLDDB. .CMNUM,CM%SDH,12,decimal sequence number of volume within set,1]
CALL COMNDX ;PARSE VOLUME #
CALL CONFRM
SKIPG Q3,B
ERROR RESTRT,<?VOLUME NUMBER MUST BE POSITIVE>
CALL MTOPNX ;OPEN MAGTAPE
SKIPGE A,MTTYP ;MTA DEVICE?
ERROR REW2,<?USE "TAPE" COMMAND TO SWITCH MTA DEVICES>
JUMPG A,[CAIE Q3,1 ;LABELED TAPE, CHECK VOLUME #
ERROR REW2,<?LABELED TAPES CAN BE SWITCHED ONLY TO VOLUME 1>
CALL REWVS ;REWIND TO FIRST VOLUME OF SET
JRST REW1]
MOVE A,MTJFN ;UNLABELED MT, GET JFN
MOVEI B,.MOVLS ;VOLUME-SWITCH FUNCTION
MOVEI C,Q1 ;ARG BLOCK ADDRESS
MOVEI Q1,3 ;PUT SIZE IN ARG BLOCK
MOVEI Q2,.VSMNV ;MOUNT ABSOULTE VOLUME # (IN Q3)
MTOPR
ERJMP [TMSG <
?>
CALL JSERRM ;TELL ABOUT ERROR
JRST REW1]
CALL REWCV ;REWIND TAPE, RESET COUNTERS
REW1: SETZM VOLID6 ;CLEAR VOLID
REW2: CALL MTCLS ;CLOSE MT
JRST CDONE
;UNLOAD
$UNL: CALL CONFRM ;CONFIRM
SKIPN MTDSG ;HAVE A TAPE YET?
ERROR BMBCMD,<?NO TAPE DEVICE SPECIFIED YET> ;NO
SKIPL MTTYP ;MT DEVICE?
ERROR CDONE,<%Use the DISMOUNT TAPE command to unload MOUNTed tapes> ;YES
CALL MTOPNX ;MTA DEVICE
CALL UNLOAD ;UNLOAD IT
JRST REW1 ;CLEAR VOLID, CLOSE TAPE, EXIT
;SKIP TO END OF TAPE, I.E. TO JUST BEFORE TAPE TRAILER RECORD
$EOT: CALL CONFRM ;CONFIRM
SETOM CEXFLG ;ALLOW INTERRUPT
CALL MTOPNR ;OPEN TAPE FOR READ
EOT1: CALL MTRED ;READ NEXT RECORD
JRST [ TMSG <, record ignored
>
JRST EOT1]
MOVN A,TYP ;CHECK TYPE
CAIE A,CTPHX
CAIN A,TPHDX ;TAPE HEADER?
JRST [ CALL TYHEDR ;YES, TYPE INFO
JRST EOT1]
CAIE A,TPTRX ;TAPE TRAILER?
JRST EOT1 ;NO, KEEP SCANNING
SKIPLE MTTYP ;YES, LABELED TAPE?
JRST [ JXE F,LREOF,EOT1 ;YES, LOOP IF NOT AT END OF LAST S/S
JRST EOT2] ;AT END OF ALL SAVESETS
CALL BACKSP ;BACK UP OVER TAPE TRAILER
CALL BACKSP ; and back over another
CALL FWRSP ; Then advance one to be going in
; proper direction
EOT2: CALL MTCLS ;CLOSE AND DONE
TMSGC <Tape positioned after last saveset
>
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
$CSUM: JXN F,NOFLG,CSUM1 ;JUMP IF USER WANTS NO CHECKSUM
HRROI A,[ASCIZ/FILES/]
CALL NOISE
MOVEI A,CSMTAB
CALL KEYWD ;PARSE KEYWORD
CSUM1: CALL CONFRM
HRRZ B,0(B)
TXZ F,CHKSM+CS%SEQ ;TURN OFF FLAGS
TXNN F,NOFLG ;SKIP IF 'NO CHECKSUM'
IOR F,B
JRST CDONE
CSMTAB: NCKTBL,,NCKTBL
TB CHKSM,<BY-PAGES>
TB CHKSM+CS%SEQ,<SEQUENTIAL>
NCKTBL==.-CSMTAB-1
;SKIP n SAVESETS
$SKIP: HRROI A,[ASCIZ/NUMBER OF SAVESETS/]
CALL NOISE
MOVEI B,[FLDDB. .CMNUM,,12] ;BASE 10 NUMBER
CALL COMNDX ;PARSE NUMBER OF SAVESETS TO SKIP
MOVE Q1,B ;SAVE IT
CALL CONFRM ;CONFIRM
SETOM CEXFLG ;ALLOW INTERRUPT
JUMPLE Q1,SKIPR ;SCAN REVERSE IF 0 OR NEG
;SKIPPING FORWARD
CALL MTOPNR ;OPEN TAPE FOR READ
CALL MTRED ;READ FIRST RECORD
JRST SKIPF1 ;BAD, IGNORE
MOVN A,TYP
CAIE A,CTPHX
CAIN A,TPHDX ;SAVESET HEADER?
AOJA Q1,SKIPF3 ;YES, SKIP ONE MORE THAN SPEC
JRST SKIPF2
SKIPF1: CALL MTRED ;SCAN FORWARD
JRST [ TMSG <, record ignored
>
JRST SKIPF1]
SKIPF2: MOVN A,TYP ;CHECK TYPE
CAIN A,TPTRX ;END OF TAPE?
JRST [ SKIPLE MTTYP ;YES, LABELED?
JRST SKIPF1 ;YES, IGNORE END-OF-VOLUME
CALL BACKSP ;UNLABELED, BACKSPACE OVER TAPE TRAILER
CALL MTCLS
TXO F,TNSF ;SET TAPE # KNOWN
ERROR (BMBCMD,<%End of tape encountered>)]
CAIE A,TPHDX ;TAPE HEADER?
JRST SKIPF1 ;NO, KEEP SCANNING
SKIPF3: CALL TYHEDR ;YES, TYPE INFO
SOJG Q1,SKIPF1 ;LOOP IF MORE SAVESETS TO SKIP
CALL BKTPHD ;BACKUP OVER TAPE HEADER & CLOSE TAPE
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
;SKIPPING REVERSE
SKIPR: SKIPLE MTTYP ;LABELED TAPE?
ERROR BMBCMD,<?Cannot backspace on labeled tape> ;YES, ERROR
CALL MTOPNR ;UNLABELED, OPEN IT
SETZM NWTBIT ;PREVENT OVERLAP READS
JRST SKIPR1
SKIPR2: CALL BACKSP ;BACKSPACE ONE RECORD NET
SKIPR1: CALL BACKSP
MOVE A,MTJFN ;GET TAPE JFN
GDSTS ;GET STATUS
TRNE B,MT%BOT ;AT BOT?
JRST SKIPR3 ;YES, IT HAS BEEN REPORTED, GO WRAP UP
CALL MTRED
JRST [ TMSG <, record ignored
>
JRST SKIPR2]
MOVN A,TYP ;CHECK TYPE
CAIE A,TPHDX ;TAPE HEADER?
CAIN A,CTPHX
SKIPA
JRST SKIPR2 ;NO, KEEP SCANNING
CALL TYHEDR ;YES, TYPE INFO
AOJLE Q1,SKIPR2 ;COUNT HEADERS SEEN
CALL BACKSP ;NO, BACK OVER LAST HEADER SEEN
SKIPR3: CALL MTCLS ;DONE WITH TAPE
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
;LISTING CONTROL COMMANDS
;(NO)DIRECTORIES
$LDIR: CALL CONFRM
TXNE F,NOFLG ;NEGATED?
TXZA F,LDIRF ;YES, NO DIRECTORIES
TXO F,LDIRF ;DIRECTORIES
JRST CDONE
;(NO)FILES
$LFIL: CALL CONFRM
TXNE F,NOFLG ;NEGATED?
TXZA F,LFILF ;YES, "NO FILES"
TXO F,LFILF ;"FILES"
JRST CDONE
;(NO)SILENCE
$SIL: CALL CONFRM
TXNE F,NOFLG ;NEGATED?
TXOA F,LFILF+LDIRF ;"NO SILENCE"
TXZ F,LFILF+LDIRF ;"SILENCE"
JRST CDONE
;SPECIFY LOG FILE
$LIST: JXN F,NOFLG,[CALL CONFRM ;IF NEGATED, NO FURTHER ARGS
SETZM LSTFIL ;NO LOG FILE
TXZ F,LTTYF+LFDSK ;NOT LOGGING TO ANYTHING
JRST CDONE]
HRROI A,[ASCIZ/LOG INFORMATION ON FILE/]
CALL NOISE
MOVEI B,[FLDDB. (.CMOFI,,,,<LPT:DUMPER.LOG>)]
COMND
TXNE A,CM%NOP
ERRORJ RESTRT,<?OUTPUT FILESPEC INVALID>
CALL ADLIST ;ADD JFN TO JFN STACK
CALL CONFRM
HRROI A,LSTFIL ;PUT FILESPEC INTO BUFFER
MOVX C,2B2+1B5+1B8+1B11+1B14+1B35
JFNS
MOVE A,B
RLJFN
JFCL
JRST CDONE
SUBTTL DIRECTORY LISTING
PRINT: HRROI A,[ASCIZ/DIRECTORY OF TAPE ONTO FILE/]
CALL NOISE
MOVEI B,[FLDDB. (.CMOFI,,,,<TTY:>)]
COMND
TXNE A,CM%NOP
ERRORJ RESTRT,<?OUTPUT FILESPEC INVALID>
CALL ADLIST ;ADD JFN TO JFN STACK
CALL CONFRM
MOVE A,B ;PICK UP JFN
CALL LPTOP0 ;OPEN DEVICE TO RECEIVE DIRECTORY
CALL DIRS ;DO IT VIA SUBROUTINE
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
DIRS: SETZM LSTHDR ;NO HEADER YET
CALL MTOPNR
SETOM CEXFLG ;ALLOW INTERRUPT
DIR1: CALL MTRED ;READ NEXT RECORD, DISPATCH ON TYPE
JRST [ TMSG <, record ignored
>
JRST DIR1]
MOVN B,TYP
CAIN B,FLHDX
JRST DIRF ;FILE HEADER
CAIN B,USRX
JRST DIRU ;USER INFO
CAIN B,TPTRX
JRST DIRE ;END OF TAPE
CAIE B,CTPHX
CAIN B,TPHDX
JRST DIRB ;BEGINNING OF TAPE
CAIN B,FLTRX
JRST DIRFDB ;FDB INFO
CALL PGECSM ;CHECKSUM DATA PAGE
JRST DIR1
;BEGINNING OF TAPE
DIRB: MOVE A,[POINT 7,LPTBUF]
CALL PRHEDR ;COMPOSE HEADER IN LPTBUF
HRROI B,LPTBUF
CALL BTMSGQ ;TYPE AND PRINT IT
BTMSG <
>
HRROI A,LSTHDR ;SAVE HEADER FOR LISTING
HRROI B,LPTBUF
SETZ C,
SOUT
CALL PRTHDR
BTMSG <
>
JRST DIR1
;END OF TAPE
DIRE: SKIPL PAGNO ;CONTINUED SAVE?
JRST DIRE01 ;NO-- GO ON
BTMSG <
End of tape, saveset continued on next reel.
>
SKIPLE MTTYP ;LABELED TAPE?
JRST DIR1 ;YES, CONTINUE SCANNING
CALL UNLOAD ;UNLABELED, UNLOAD IF MTA
CALL MTCLS ;CLOSE TAPE JFN
CALL NTAPER ;GET NEXT VOLUME UP
JRST [ BTMSG <
?Cannot switch to next volume.
>
JRST DIRE02] ;LOSE
CALL MTOPNR ;OPEN IT
JRST DIR1 ;CONTINUE LISTING
DIRE01: BTMSG <
End of tape.
>
DIRE02: SKIPN A,LPTJFN ;SEE IF LISTING?
JRST DIRE1 ;NO
MOVEI B,.CHFFD
BOUT
CLOSF
JFCL
SETZM LPTJFN
DIRE1: SKIPG MTTYP ;LABELED?
CALL BACKSP ;NO, BACKSPACE OVER TAPE TRAILER
CALLRET MTCLS
;USER INFO
DIRU: BTMSG <
DDB for >
HRROI B,BUFF+UHNAM
CALL BTMSGQ
BTMSG <
>
JRST DIR1
;BEGINNING OF FILE
DIRF: MOVEI B,FLCOL
CALL TAB ;TAB TO NAME COLUMN
SKIPN FORMAT ;BBN FORMAT?
CALL FIXFMM ;YES, FIX SEMICOLON
MOVE B,[POINT 7,BUFF]
DIRF1: ILDB A,B ;SCAN FILESPEC
CAIN A,";" ;END OF GENERATION?
SETZ A, ;YES, USE NULL
JUMPN A,DIRF1 ;JUMP IF NOT END OF STRING
DPB A,B ;TIE OFF STRING
HRROI B,BUFF
CALL LPMSGQ ;OUTPUT FILESPEC
SKIPL PAGNO ;SKIP IF FILE CONTINUED
JRST DIRF4 ;GO ON
LPMSG <
(File continued from previous reel)
>
JRST DIR1 ;DON'T RESET CHECKSUM
DIRF4: TXNN F,CHKSM ;SKIP IF CHECKSUMMING
JRST DIR1 ;REST WILL BE PRINTED FROM TRAILER
SETZM CHKCN0 ;INITIALIZE CHECKSUM
SETZM LSTPGE ;AND LAST PAGE #
TXNN F,CS%SEQ ;SKIP IF SEQUENTIAL
JRST DIR1 ;GO ON
CALL FILSZE ;FIGURE FILE SIZE
JRST DIR1 ;GO ON
;END OF FILE, FDB INFO
DIRFDB: SKIPL PAGNO ;SKIP IF FILE CONTINUED
JRST DIRF3 ;GO ON
LPMSG <
(File continued on next reel)
>
JRST DIR1 ;FDB PRINTER TO BE ADDED
DIRF3: MOVEI B,WTCOL
CALL TAB ;TAB TO WRITE COLUMN
HRROI A,LPTBUF ;CONSTRUCT DATE STRING IN LPT BUFFER
SKIPN B,BUFF+.FBWRT ;HAVE WRITE DATE?
JRST [ LPMSG <(NEVER)> ;NO
JRST DIRF2]
MOVX C,1B10+1B12+1B17
ODTIM ;YES, PRINT IT
HRROI B,LPTBUF
CALL LPMSGQ
DIRF2: MOVEI B,SIZCOL
CALL TAB ;TAB TO SIZE COLUMN
LOAD B,FB%PGC,BUFF+.FBBYV ;GET PAGE COUNT
MOVEI C,^D10
CALL LPNOUT ;OUTPUT SIZE
TXNE F,CHKSM ;SKIP IF CHECKSUMMING
CALL PRTCSM ;PRINT CHECKSUM
LPMSG <
>
JRST DIR1 ;GO ON
SUBTTL DUMP ROUTINES
DUMP: CALL DUMPS
TXO F,TNSF ;SET TAPE # KNOWN
JRST CDONE
DUMPS: HRROI A,[ASCIZ/DISK FILES/]
CALL NOISE
CALL GETCON ;OBTAIN CURRENT CONNECTED DIRECTORY
SETZM INCRSW ;DEFAULT NO INCREMENTAL
SETZM ARCSW ; Default not archive run
SETZM COLSW ; Default not collection/migration run
SKIPE ICMDTY ;SKIP IF NOT UNDER ^E
SKIPN Q1,NIJFN ;PICK UP POINTER, IF ANY
MOVSI Q1,-NJFNL+1 ;INIT PTR TO JFN LIST
SKIPA Q2,[[FLDDB. .CMSWI,,DSWTB,,,FILCDB]] ;ALLOW SWITCHES
DUMP1: MOVEI Q2,FILCDB ;GET FDB FOR FILESPEC ONLY
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;SETUP DEFAULT FILE SPEC
MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
HLLM A,GJBLK+.GJGEN
MOVEI A,CBLK
MOVE B,Q2 ;GET FDB ADDRESS
SETZ Q2, ;INDICATE FILE SPEC OK (WILL BE ERROR CODE IF NOT)
COMND ;GET FILESPEC OR SWITCH
JXN A,CM%NOP,DUMP2 ;IF NO PARSE, CHECK GTJFN ERROR
LOAD C,CM%FNC,0(C) ;GET CODE OF BLOCK USED
CAIE C,.CMSWI ;SWITCH?
JRST DUMP4 ;NO, MUST BE FILENAME
HRRZ B,0(B) ;GET DISPATCH
JRST 0(B)
;SWITCH TABLE
DSWTB: NDSWTB,,NDSWTB
TB $ARC,<ARCHIVE>
; TB $COL,<COLLECT> ;COLLECTION NOT SUPPORTED FOR RELEASE 4
TB $FINC,<FULL-INCREMENTAL>
TB $INC,<INCREMENTAL:>
TB $MIG,<MIGRATE>
TB $NINC,<NOINCREMENTAL>
NDSWTB==.-DSWTB-1
$ARC: SKIPN INCRSW ; Some kind of incremental?
SKIPE COLSW ; Or collection run?
ERROR BMBCM1,<?Switch combination invalid>
SETOM ARCSW
JRST DUMP1
$MIG: SKIPA A,[-1] ;FLAG AS MIGRATION
$COL: MOVEI A,1 ;FLAG AS COLLECTION
SKIPN INCRSW
SKIPE ARCSW
ERROR BMBCM1,<?Switch combination invalid>
MOVEM A,COLSW
JRST DUMP1
$FINC: SETO B, ;-1 MEANS FULL-INCREMENTAL
JRST $INC5
$INC: MOVEI B,1 ;ASSUME 1 TAPE FOR /INC:
JXE A,CM%SWT,$INC5 ;IF NO SWITCH TERMINATOR, USE 1
MOVEI B,[FLDDB. (.CMNUM,,^D10,<number of tapes each file must be on,>,<1>)]
CALL COMNDX ;PARSE # OF TAPES
CAIGE B,1 ;VALID NUMBER?
ERROR BMBCM1,<?TAPE COUNT MUST BE GREATER THAN 0>
$INC5: SKIPN ARCSW ; /ARCHIVE been specified?
SKIPE COLSW ; Or /COL or /MIGRATE ?
ERROR BMBCM1,<?Switch combination invalid>
MOVEM B,INCRSW ;SAVE INCREMENTAL STATE
JRST DUMP1
$NINC: SETZM INCRSW ;NO INCREMENTAL
JRST DUMP1
;COMMAND BLOCK FOR SOURCE FILE
FILCDB: FLDDB. (.CMFIL,CM%SDH,,<file group descriptor>)
;LIST OF GTJFN ERRORS WHICH ALL MEAN "FILE NOT FOUND"
OKGJXL: BYTE (18)GJFX16,GJFX17,GJFX18,GJFX19,GJFX20,GJFX24,GJFX32,GJFX35,GJFX36,GJFX38
OKGJXZ==<.-OKGJXL>*2
;HERE WHEN FIRST FILSPEC TYPED, BUT WAS IN ERROR.
;CHECK FOR "OK" GTJFN ERROR: ALL POSSIBLE "FILE NOT FOUND" CODES.
;ERROR CODE IN B, COMND FLAGS IN A
DUMP2: JXN A,CM%ESC,DUMP22 ;GIVE ERROR NOW IF RECOGNITION ATTEMPTED
MOVE C,[POINT 18,OKGJXL] ;GET POINTER TO LIST OF OK CODES
MOVEI D,OKGJXZ ;GET SIZE OF LIST
DUMP21: ILDB A,C ;GET A CODE FROM TABLE
CAME A,B ;MATCH ERROR GIVEN?
SOJG D,DUMP21 ;NO-- LOOP FOR ALL POSSIBLE OK ERRORS
JUMPLE D,DUMP22 ;NOT AN OK ERROR-- TYPE ERROR MESSAGE
MOVE Q2,B ;ERROR IS FILE NOT FOUND-- REMEMBER CODE TO BE
; PUT IN JF2LST AND CHECKED WHILE SCANNING
MOVX A,GJ%OFG ;SET UP TO PARSE-ONLY THE NOT-FOUND FILESPEC
HLLM A,GJBLK+.GJGEN ; . .
MOVEI A,CBLK ;GET COMMAND STATE BLOCK ADDRESS
MOVEI B,[FLDDB. .CMFIL] ;ONLY PARSE FILE-SPEC
COMND ; . .
TXNE A,CM%NOP ;THIS SHOULD ALWAYS SUCCEED!!
DUMP22: ERRORJ BMBCM1,<?NOT A SWITCH OR FILESPEC>
;HERE WHEN FIRST FILESPEC HAS BEEN TYPED
;JFN OF FILE IN B
DUMP4: CALL ADLIST ;ADD FILE TO JFNSTACK
SKIPN Q2 ;DON'T CHECK DEVICE IF FILE-NOT-FOUND
CALL CHKDVC ;DO A DVCHR FOR LEGAL DEVICE
JUMPGE Q1,[ERROR (BMBCM1,<?TOO MANY ITEMS IN FILESPEC LIST>)]
MOVEM B,JFNLST(Q1) ;SAVE JFN
MOVEM Q2,JF2LST(Q1) ;SET NO DESTINATION YET, ZERO OR ERROR CODE IF FILE-NOT-FOUND
AOBJN Q1,.+1
SKIPN ARCSW ; No user info on archive or migration tapes
SKIPE COLSW
JRST DUMP41
TXNN F,USRDAT ;"CREATE" SPECIFIED?
TXNE B,GJ%DIR ;* FOR DIRECTORY?
TXO F,SAVUSF ;YES, IMPLIES USER INFO ALSO
DUMP41: SKIPN ARCSW ; Auto unload on archive or migration
SKIPE COLSW
SETOM UNLTAP ;REQUEST AUTO-UNLOAD
;SET UP TO GET JFN ON "AS" FILESPEC
MOVX B,GJ%OFG
HLLM B,GJBLK+.GJGEN ;PARSE ONLY
CALL OFNAME ;MAKE UP OUTPUT NAME DEFAULT
;CHECK IF "AS" FILESPEC IS PROSCRIBED
SKIPN INCRSW ;INCREMENTAL?
SKIPE ARCSW ;OR ARCHIVE?
SKIPA
SKIPE COLSW ;OR COLLECT/MIGRATE?
JRST [ MOVE A,[.NULIO,,.NULIO] ;ONE OF THE ABOVE
MOVEM A,GJBLK+.GJSRC ;SET SOURCE, DEST TO NULL
MOVEI A,GJBLK ;GET ADDRESS OF GTJGN BLOCK
SETZ B, ;NO STRING
GTJFN ;SYNTHESIZE "AS" JFN
ERRORJ BMBCM1,<?INVALID FILE GROUP DESCRIPTOR>
MOVE B,A ;GET JFN IN B
JRST DUMP42] ;GO STUFF IT IN JF2LST
;PARSE "AS" FILESPEC
HRROI A,[ASCIZ/AS/]
CALL NOISE
MOVEI B,LIT1 ;PARSE FILESPEC OR COMMA OR CRLF
MOVEI A,CBLK
COMND
TXNE A,CM%NOP
ERRORJ BMBCM1,<?INVALID FILE GROUP DESCRIPTOR>
;CHECK WHAT WAS PARSED. THE FDB CHAIN CONTAINS FILESPEC,COMMA,CONFIRM.
;HOWEVER, IF COMMA OR CONFIRM IS TYPED, IT WILL PARSE AS A FILESPEC.
;THE NEXT 3 LINES ARE A CHECK FOR THAT, JUST IN CASE COMND GETS CHANGED.
LOAD C,CM%FNC,(C) ;GET CODE USED
CAIE C,.CMFIL ;DID I PARSE A FILESPEC?
ERROR BMBCM1,<?PARSE ERROR> ;NO, STRANGENESS IN COMND JSYS
DUMP42: CALL ADLIST ;OUTPUT FILE SPEC
SKIPN JF2LST-1(Q1) ;FIRST SPEC NOT FOUND?
MOVEM B,JF2LST-1(Q1) ;NO, SAVE THIS JFN AS DESTINATION
DUMP5: SKIPN ARCSW
SKIPE COLSW
JRST [ MOVEI A,CBLK ; Either archive or migration, need conf
MOVEI B,[FLDDB. .CMCFM]
COMND
TXNE A,CM%NOP
ERROR BMBCM1,<?Carriage return required.
Only one filespec allowed for archive or migration runs>
JRST DUMP6]
MOVEI A,CBLK
MOVEI B,[FLDDB. (.CMCFM,,,,,[FLDDB. (.CMCMA)])]
COMND
TXNE A,CM%NOP
ERROR BMBCM1,<?COMMA OR CARRIAGE RETURN REQUIRED>
LOAD C,CM%FNC,0(C) ;GET CODE USED
CAIE C,.CMCFM ;TERMINATOR?
JRST DUMP1 ;NO, ASSUME COMMA. TRY AGAIN
DUMP6: CALL [ SKIPE WHEEL ;WHEEL OR OPERATOR?
RETSKP ;YES, NO FURTHER CHECKS REQUIRED
SKIPN ARCSW ;NOT PRIVILEGED
SKIPE COLSW
RET ;CAN'T ARCHIVE/COLLECT/MIGRATE
SKIPE INCRSW
RET ;CAN'T DO INCREMENTAL SAVE
RETSKP] ;OK, NOT TRYING ANYTHING SPECIAL
ERROR BMBCM1,<?WHEEL or OPERATOR capability required>
CALL JFNCFM ;FIX UP JFN STACK
SETOM CEXFLG ;INDICATE INTERRUPTIBLE COMMAND
MOVEM Q1,NIJFN ;SAVE IN CASE OF ^E
MOVNI Q1,0(Q1) ;SAVE NUMBER OF JFNS SETUP
MOVEM Q1,NJFN
GTAD ;GET NOW
MOVEM A,BGNTAD ;KEEP TIME AT START OF SAVE
SETZM TOTFIL ;INIT DUMP COUNTS
SETZM TOTCNT
SETZM LSTDIR ;RESET LAST DIRECTORY NAME
SETZM INIPGN ;RESET CONTINUED FILE PAGE
TXNN F,TNSF ;SKIP IF TAPE # SET
SETZM TAPNO ; START AFTER TAPE 0
SKIPN ARCSW ; Archive
SKIPE COLSW ; Or collection/migration run?
CALL ARCINI ; Yes, set up for that
MOVX A,PA%RD!PA%WT!PA%EX!PA%PEX ;GET ALL ACCESS
MOVEM A,ACCESS ;SET UP ACCESS WORD FOR COMPATABILITY
SETZM JFN ; Make sure is 0 initially
;LOOP THROUGH JFNLST FOR ALL FILESPECS TYPED
TXZ F,DMPFLF ;INDICATE NO VALID JFNS FOUND YET
HRLZ P5,NJFN ;SET TO SCAN JFN LIST
;IF THIS JFN HAD A "FILE-NOT-FOUND", THEN PRINT WARNING
DUMPL1: MOVE B,JF2LST(P5) ;GET ERROR CODE OR OUTPUT JFN
TRNN B,1B18 ;ERROR CODE (6XXXXX) OR JFN?
JRST DUMPL2 ;JFN, IT'S OK
TMSGC <%>
MOVEI A,.PRIOU ;SET TTY
MOVE B,JF2LST(P5) ;GET ERROR CODE BACK
HRLI B,.FHSLF ;MYSELF, ERROR CODE NOW IN B
SETZ C, ;NO LIMIT
ERSTR ;TYPE ERROR MESSAGE
JFCL
JFCL
TMSG < - >
MOVEI A,.PRIOU ;OUTPUT FILESPEC THAT FAILED
MOVE B,JFNLST(P5) ;GET JFN FOR IT
SETZ C, ;DEFAULT OUTPUT
JFNS ;TYPE FILE SPEC
TMSG <
>
JRST DUMPL5 ;IGNORE THE FILE
;VALID JFN-- SEE IF OUTPUT DIRECTORY HAS CHANGED
DUMPL2: TXNE B,GJ%DIR ;SKIP IF OUTPUT DIRECTORY NOT WILD
JRST DUMPL3
HRROI A,ODRNAM ;OUTPUT DIR NAME
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS
HRROI A,DIRNAM ;OUTPUT DIR NAME
MOVE B,JFNLST(P5) ;INPUT JFN
JFNS
HRROI A,ODRNAM ;OUTPUT DIR NAME
HRROI B,DIRNAM ;INPUT DIRECTORY NAME
STCMP
SKIPN A ;SKIP IF STRINGS ARE DIFFERENT
DUMPL3: TXZA F,DIRCHG ;OUTPUT DIR SAME AS INPUT DIRECTORY
TXO F,DIRCHG ;DIRECTORY IS DIFFERENT
;SCAN THIS JFN FILE GROUP FOR ALL ITS FILES
TXON F,DMPFLF ;INDICATE A VALID JFN FOUND, FIRST ONE?
CALL DNEWV ;YES, START NEW TAPE
HRROI B,[ASCIZ/%Using INTERCHANGE mode with labeled tape
/]
TXNE F,ICMODF ;INTERCHANGE MODE
SKIPG MTTYP ; AND LABELED TAPE?
CAIA ;NOT BOTH
CALL TMSGQC ;YOU PROBABLY DON'T WANT TO DO THIS
MOVE A,JFNLST(P5) ;PICK UP JFN
SKIPE INIJFN ;SKIP IF NO INITIAL JFN
JRST [ HRR A,INIJFN ;GET INITIAL JFN
SETZM INIJFN ;USED UP NOW
SETOM ININUM ;FLAG BEGUSR CODE
JRST .+1]
CALL SCNJFG ;SCAN THIS GROUP
DUMPL5: AOBJN P5,DUMPL1 ;LOOP FOR ALL GROUPS
;ALL DONE WITH ALL FILESPECS
TXNN F,DMPFLF ;ANY VALID JFN'S FOUND?
ERROR DUMPL9,<%No files dumped>
CALL ENDTAP ; TERMINATE TAPE
SKIPE UNLTAP ; Want auto unload?
CALL UNLOAD ; Yes
CALL MTCLS ;CLOSE MAGTAPE
SKIPN COLSW ; Did we do collection/migration?
SKIPE ARCSW ; or an archive run?
JRST [ CALL ARDELF ; One of the two
TMSG <
Pass 1 completed.
Saveset complete. Tape ready for storage.
>
CALL PASS2 ; Do fixup pass
SETZM TAPNO ;GET RID OF ARCHIVE MODIFICATIONS
SETZM PAGNO ;IN RECORD HEADER
SETZM MTDSG ;REQUIRE RESPEC OF TAPE UNIT
SETZM SSNBUF ;CLEANUP SAVESET NAME BUFFER
JRST .+1]
SKIPN INCRSW ;INCREMENTAL?
JRST DUMPL8 ;NO, SKIP THIS STUFF
;INCREMENTAL SAVE - CALL PASS2 FOR ALL FILESPECS BEING SAVED
HRLZ P5,NJFN ;GET -(# OF FILESPECS),,0
DUMPL6: MOVE B,JF2LST(P5) ;GET JFN
TRNN B,1B18 ;JFN VALID?
JRST [ HRROI A,DEVNAM ;YES, GET DESTINATION
MOVE C,[111110,,1] ;DEV,DIR,NAME,EXT,GEN
JFNS ;GET FILESPEC IN DEVNAM FOR PASS2
CALL PASS2 ;FIX FDB'S
JRST .+1]
AOBJN P5,DUMPL6 ;LOOP THRU ALL FILESPECS IN LIST
DUMPL8:
;TYPE STATISTICS
BTMSG <
Total files dumped = >
MOVE B,TOTFIL
MOVEI C,12
CALL BTNOUT
BTMSG <
Total pages dumped = >
MOVE B,TOTCNT
MOVEI C,12
CALL BTNOUT
BTMSG <
>
DUMPL9: SKIPN A,LPTJFN
RET ;DONE IF NO LISTING
CLOSF
JFCL
SETZM LPTJFN ; No JFN any more
RET
;SCAN FILE GROUP DESCRIPTOR
; A/ JFN
SCNJFG: TXO A,GN%DIR+GN%NAM+GN%EXT ;NOTE ALL FIELDS CHANGED
MOVEM A,SCNJFN ;SAVE JFN AND FLAGS
HRROI A,DEVNAM ;GET CURRENT FULL FILE-SPEC,
MOVE B,SCNJFN ; INCLUDING WILDCARDS, FOR FIXBCK
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS
HRROI A,RCDSTR ;SET TO BUILD STR:<*>, FOR RCDIR
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
MOVE B,SCNJFN
JFNS ;GET STRUCTURE NAME
SETZM RCDNUM ;NONE YET
SCNLUP: MOVE A,SCNJFN
HRRZM A,JFN ;SETUP SINGLE JFN FOR ROUTINES
TXNE A,GN%DIR ;DIRECTORY CHANGED?
CALL BEGUSR ;YES
CALL DMPFIL ;DO THE FUNCTION
MOVE A,SCNJFN
GNJFN ;STEP TO NEXT FILE
JRST ENDU ;NO MORE
XOR A,SCNJFN ;SET CHANGED BITS
ANDX A,GN%DIR+GN%NAM+GN%EXT
XORB A,SCNJFN
TXNE A,GN%DIR ;DIRECTORY CHANGED?
CALL ENDUSR ;YES, CLEANUP USER
JRST SCNLUP
;END OF GROUP
ENDU: CALL ENDUSR ;CLEAN UP LAST USER
TXNN F,SAVUSF ;DOING USER DATA?
JRST ENDU2 ;NO - SKIP THIS
ENDU1: MOVX A,RC%STP!RC%AWL ;MAKE SURE WE GOT ALL DIRECTORIES
HRROI B,RCDSTR
MOVE C,RCDNUM ;LAST NUMBER
RCDIR ;STEP
TXNN A,RC%NMD ;MORE?
JRST [ MOVEM C,RCDNUM ;YES - SAVE NUMBER
CALL DMPUSR ;DUMP USER INFO
JRST ENDU1] ;LOOP TILL DONE
ENDU2: RET ; Done
PASS2: SETZM LTARDR ; No current directory
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;DEFAULT THE FILE SPEC
MOVE A,[.NULIO,,.NULIO] ;AS IN COMMAND, BUT FILE SPEC.
MOVEM A,GJBLK+.GJSRC ;NOT FROM TERMINAL THIS TIME
MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
HLLM A,GJBLK+.GJGEN
MOVEI A,GJBLK ;GTJFN BLOCK
HRROI B,DEVNAM ;GET JFN FOR ALL FILES SPEC. AT SCNJFG
GTJFN
ERRORJ BMBCMD,<?COMMAND ABORTED>
MOVEM A,P2JFN
SKIPE INCRSW ; Incremental?
JRST SCNLU1 ; Yes, skip archive/coll/mig. setup
TMSG < Pass 2 started.
>
SETZM FNDDIR ; Flag terminating directory not found
SKIPN IDIR ;INITIAL DIRECTORY SET UP?
JRST SCNLU0 ;NO--START FROM BEGINNING OF RUN
MOVEI A,GJBLK ; Same as just used
HRROI B,ISPEC ; Initial filespec on tape
GTJFN ; File still there?
JRST TRYDIR ; No, try for initial directory
TXO F,TF2 ; Yes, flag cont. (or just 1st) file
JRST XP2JFN ; Go switch RH of P2JFN
TRYDIR: MOVEI A,GJBLK ;SAME AS JUST USED
HRROI B,IDIR ;INITIAL DIRECTORY ON THIS TAPE
GTJFN
JRST SCNLU0 ;OK TO START FROM BEGINNING OF RUN
XP2JFN: MOVE B,P2JFN ;BETTER TO START FROM 1ST DIR. ON TAPE
HRRM A,P2JFN ;BY REPLACING RH OF JFN FOR GNJFN
HRRZ A,B ;FINISHED WITH 1ST P2JFN
RLJFN
JFCL
SCNLU0: MOVE A,P2JFN ; Initial P2JFN for archive/col/mig. run
TXO A,GN%DIR ; Set new directory flag bit
SCNLU1: SKIPE INCRSW ;INCREMENTAL?
JRST [ CALL FIXBCK ;NOTE INCREMENTAL DUMP COMPLETED FOR FILE
JRST SCNLU2]
MOVE D,A ; Keep bits returned by GNJFN
HRRZ A,A ; Clear bits for GTFDB
MOVE B,[1,,.FBBBT] ;GET FLAG BITS
MOVEI C,B ; INTO B
GTFDB
ERJMP [ CALL JSERR1
JRST SCNLU2] ;FAILURE: SKIP THIS FILE
MOVEM B, FDB+.FBBBT ;YES, SAVE FLAG BITS
SKIPE XSPEC ;CONT. SAVESET AT END OF THIS TAPE?
TXNN D,GN%DIR ; And new directory?
JRST DIRCHK ; No, skip dir. termination test
HRROI A,CDIR ; Place for current str:dir string
HRRZ B,P2JFN
MOVX C,1B2+1B5+1B35 ; Get structure:dir
JFNS
HRROI A,CDIR ; Test string is current dir
HRROI B,XDIR ; Base string is dir at end of tape
STCMP
JUMPE A,[SETOM FNDDIR ; Flag have found XDIR
JRST DIRCHK] ; And go on to check for XSPEC in part.
SKIPE FNDDIR ; Had previously reached XDIR?
CALLRET P2DON1 ; Yes, terminate pass 2
DIRCHK: MOVE B,FDB+.FBBBT
TXNN B,AR%1ST ;ARCH./COLL. IN PROGRESS FOR THIS FILE?
JRST SCNLU2 ;NO, NOTHING TO DO HERE
SKIPN FNDDIR ; In XDIR?
JRST TAPCHK ; No, go on to check tape ID's
HRROI A,CSPEC ; Place for current filespec
HRRZ B,P2JFN
MOVX C,1B2+1B5+1B8+1B11+1B14+1B35 ; STR: to VER
JFNS
HRROI A,CSPEC ; Test string is current filespec
HRROI B,XSPEC ; Base string is last filespec on tape
STCMP
JUMPE A,P2DON1 ; This file is XSPEC--all done
TAPCHK: MOVE A,P2JFN
MOVX B,.ARGST ;GET TAPE INFO
MOVEI C,FDBARC ;INTO FDBARC BLOCK
ARCF
ERJMP SCNLU2 ;FAILURE: SKIP THIS FILE
TXZE F,TF2 ; Cont. (or just 1st) file?
JRST DOFXBK ; Yes, known to be on this tape
MOVE B,VOLID6 ; Tape ID of current tape
CAMN B,FDBARC+.ARTP1 ; There as tape 1?
JRST DOFXBK ; Yes, do fixup
CAMN B,FDBARC+.ARTP2 ; There as tape 2?
JRST DOFXBK ; Yes, do fixup
SKIPN FNDDIR ; Have reached terminating dir (if any)?
JRST SCNLU2 ; No, skip this file and go on
LOAD B,AR%RSN,FDB+.FBBBT ; Yes, check further: get reason code
CAIN B,.AREXP ; File expired?
SKIPG COLSW ; And this is a collection run?
CAIA ; No, go on
CALLRET P2DON1 ; Yes, file was not reached, so done
CAIN B,.ARRAR ; File archived?
SKIPN ARCSW ; And this is an archive run?
CAIA ; No, go on
CALLRET P2DON1 ; Yes, file was not reached, so done
CAIN B,.ARRIR ; File was migrated?
SKIPN COLSW ; And this is a coll. or mig. run?
JRST SCNLU2 ; Not of this run--skip it
CALLRET P2DON1 ; Yes, file was not reached, so done
DOFXBK: CALL ARFXBK ;NOTE ARCHIVE RUN COMPLETED FOR FILE
SCNLU2: MOVE A,P2JFN
GNJFN ;STEP JFN
JRST [ CAIE A,GNJFX1 ;DONE?
CALL JSERR1 ;NO, SCREWUP
SKIPN COLSW ; Collection/migration?
SKIPE ARCSW ;ARCHIVAL?
CALLRET P2DONE ; Yes, tell user pass 2 done
RET] ; No, done here
JRST SCNLU1
P2DON1: HRRZ A,P2JFN
RLJFN ;Through with pass 2 JFN
JFCL
P2DONE: TMSG < Pass 2 completed.
>
SETZM IDIR ; THROUGH WITH PASS2 FILE LIMITS
SETZM ISPEC
SETZM XDIR
SETZM XSPEC
MOVEI A,SNDTO
SKIPE LTARDR ;ANY MESSAGES WAITING?
CALL SNDMSG ;YES
SETZM LTARDR ;NONE NOW
RET
;BEGIN NEW TAPE
DNEWV: CALL MTOPNW ;REOPEN MAGTAPE
DNEWV1: MOVSI A,(1B1) ;SAY MUCHO TAPE LEFT
MOVEM A,TAPLFT
CALL LPTOPN ;REOPEN LPT
MOVEI B,1
MOVEM B,LPTPAG ;INIT PAGE NUMBER
TXZN F,TNSF ;SKIP IF TAPE NUMBER SET
AOS TAPNO ;COUNT TAPES
CALL UNMAPB ;RESET BUFFERS
MOVEI B,CURFMT ;THE CURRENT FORMAT
MOVEM B,BUFF ;TO THE HEADER
MOVE B,BGNTAD ;BEGINNING TAD
MOVEM B,BUFF+BFTAD
MOVEI B,BFMSG ;OFFSET FOR MESSAGE
MOVEM B,BUFF+BFMSGP ;TO THE HEADER AS WELL
SKIPN COLSW ;COLLECTION/MIGRATION?
SKIPE ARCSW ;OR ARCHIVE?
JRST [ CALL GTVOL ;YES, GET VOLID
CALL ARCSSN ; Construct arc/col/mig header
SETZM IDIR
SKIPN B,JFN ; JFN from end of previous tape (if any)
HRRZ B,INIJFN ; Initial JFN (if any)
JUMPE B,.+1 ; Start from beginning of this tape
HRROI A,IDIR ; Dev & directory at start of tape
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS
HRROI A,ISPEC ; Full filespec at start of tape
MOVX C,1B2+1B5+1B8+1B11+1B14+1B35
JFNS
JRST .+1]
MOVE A,[POINT 7,BUFF+BFMSG] ;LOC IN HEADER FOR SSNAME
MOVE B,[POINT 7,SSNBUF]
MOVEI C,0
SOUT ;COPY SET NAME TO HEADER
SETZM PAGNO ;RESET PAGE NUMBER IN TAPE HEADER
MOVNI A,TPHDX
SKIPE INIPGN ;SKIP IF NOT CONTINUED FILE
MOVNI A,CTPHX ;CONTINUED TAPE HEADER
MOVEM A,TYP
CALL MTOUT
MOVE A,[POINT 7,LSTHDR] ;SET TO BUILD LISTING HEADER MESSAGE
CALL PRHEDR ;BUILD IT
HRROI B,LSTHDR
CALL BTMSGQ ;TYPE AND PRINT IT
BTMSG <
>
LPMSG <
Directory (number)
>
PRTHDR: MOVEI B,FLCOL
CALL TAB ;POSITION FILE COLUMN HEADING
LPMSG <file>
MOVEI B,WTCOL ;DO LIST COLUMN HEADINGS
CALL TAB
LPMSG <last write>
MOVEI B,SIZCOL
CALL TAB
LPMSG <size (pages)>
MOVEI B,CSCOL ;TAB TO CHECKSUM COLUMN
CALL TAB ;TAB OVER
LPMSG <checksum
>
SKIPN COLSW
SKIPE ARCSW
JRST [ TMSG < Pass 1 started
>
JRST .+1]
RET
;DUMP ONE FILE
DMPFIL: MOVEI A,[CALL NDMESS ;PRINT REASON FOR ERROR
CALL UNMAPB ;RESET BUFFERS
TMSG <%File skipped
>
SKIPN COLSW ; Migration/collection?
SKIPE ARCSW ; or archive?
CALL UNARC ; Yes, undo invalid tape info (if any)
JRST DMPFIX] ;SKIP TO NEXT FILE
CALL SETTRP ;SET TRAP FENCE
MOVE A,JFN
MOVE B,[.FBLN0,,0]
MOVEI C,FDB
GTFDB ;READ ENTIRE FDB
ERJMP [CALLRET JSERR1] ;FAILED
MOVE B,FDB+.FBCTL ;GET BITS
TXNE B,FB%NXF!FB%NEX!FB%DEL!FB%TMP
JRST DMPFIZ
TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
JRST DMPFI2 ;SKIP IT
HRR A,JFN ;PIC UP FILE JFN
HRLI A,.GFAUT
HRROI B,FDBAUT ;STORE AUTHOR HERE
GFUST
ERJMP [SETZM FDBAUT ;SET AS NULL
JRST .+1]
HRLI A,.GFLWR ;FUNCTION IS LAST WRITER
HRROI B,FDBLWR
GFUST ;GET LAST WRITER
ERJMP [SETZM FDBLWR
JRST .+1]
MOVE A,JFN
MOVX B,.ARGST ; Get tape info
MOVEI C,FDBARC ; Where to put the info
ARCF ; Get it
ERJMP [MOVE A,[FDBARC,,FDBARC+1]
SETZM -1(A)
BLT A,FDBARC+.ARPSZ
JRST .+1]
DMPFI2: MOVE A,[POINT 7,NAMBUF]
MOVEI C,0
HRROI B,DIRNAM ;COPY CURRENT DIRECTORY NAME
SOUT
MOVEM A,NAMPTR
MOVE B,JFN
MOVX C,1B8+1B11+1B14+1B35
JFNS
MOVE B,FDB+.FBCTL
TXNE B,FB%NOD ;IS THIS FILE NOT TO BE DUMPED?
JRST NODUMP ;YES, DONT DUMP IT
MOVE A,FDB+.FBCRE ;GET LAST MODIFICATION DATE
CAMG A,MBTAD ;NOT 'BEFORE'?
CAMGE A,MSTAD ;NOT 'SINCE'?
JRST NODUMP ;YES, DON'T DUMP
MOVE A,FDB+.FBWRT ;GET LAST WRITE DATE
CAMG A,WBTAD ;NOT 'BEFORE'?
CAMGE A,WSTAD ;NOT 'SINCE'
JRST NODUMP ;YES, DON'T DUMP
CAMGE A,FDB+.FBREF ;GET MOST RECENT OF WRITE, READ
MOVE A,FDB+.FBREF
CAMG A,ABTAD ;NOT 'BEFORE'?
CAMGE A,ASTAD ;NOT 'SINCE'?
JRST NODUMP ;YES, DON'T DUMP
; ..
; ..
SKIPLE A,INCRSW ;SKIP IF NOT INCREMENTAL OR /FULL-INCREMNTAL
JRST [ HLRZ B,FDB+.FBCNT ;GET COUNT OF WRITES
HLRE C,FDB+.FBBK0 ;GET TAPE COUNT AND FLAG
HRRZ D,FDB+.FBBK0 ;GET LAST WRITE COUNT OF SAVE
CAMN B,D ;SAME WRITE COUNT?
CAMGE C,A ;YES-- HAS IT BEEN SAVED ENOUGH TIMES?
JRST .+1 ;NO-- DUMP THE FILE
JRST NODUMP] ;YES-- DON'T DUMP IT
SKIPN COLSW ; Collection/migration?
SKIPE ARCSW ; Or archive run?
JRST [ CALL ARCTST ; Yes, check this file for inclusion
JRST NODUMP ; Don't dump on this tape
JRST .+1] ; Do dump on this tape
;FILE WILL BE DUMPED
CALL TSTEOT ;CHECK TO MAKE SURE FILE WILL FIT ON TAPE
SKIPN INIPGN ;SKIP IF CONTINUED FILE
JRST DMPF4 ;NO
LPMSG <
(File continued from previous reel)
>
DMPF4: CALL GOFNAM ;MAKE UP TAPE FILE NAME
MOVEI B,FLCOL
CALL TAB ;TAB TO FILESPEC COLUMN
MOVE B,ONMPTR ;PRINT FILE NAME
CALL LPMSGQ ;NAME TO LISTING
MOVEI B,WTCOL ;TAB TO WRITE COLUMN
CALL TAB
SKIPN NOFILS ;FIRST FILE THIS USER?
SKIPE INIPGN ; And not continued file?
CAIA
CALL TDRNAM ;TYPE DIRECTORY NAME
TXNE F,LFILF ;TYPE FILE NAMES REQUESTED?
TXNE F,LTTYF ;AND NOT LOGGING TO TTY?
JRST DMPF2 ;NO
MOVE B,NAMPTR ;YES, TYPE NAME
CALL TMSGQ
TMSG < (AS) >
MOVE B,ONMPTR
CALL TMSGQ ;TYPE OUTPUT NAME
DMPF2: MOVE A,JFN
HRLOM A,LASTID ;REMEMBER FILE IN CASE ERROR ON OPENF
MOVX 2,OF%RD+OF%PDT ;READ AND PRESERVE ACCESS DATES
OPENF
JRST [ CAIE A,OPNX2 ;NONEXISTENT (EMPTY OR...)
CAIN A,OPNX31 ; File offline?
JRST .+1 ; Yes, dump it
MOVE A,JFN
MOVX B,OF%RD+OF%THW+OF%PDT ;TRY THAW MODE
OPENF
JRST [ CALL NDMESS ;PRINT REASON
RET]
JRST .+1]
SKIPN COLSW
SKIPE ARCSW
JRST [ SKIPN INIPGN ; Info already set if cont file
CALL ARC1 ; Go set archive/collection info
JRST .+1]
MOVE A,[POINT 7,BUFF] ;SET TO PUT NAME IN FILE HEADER
HRROI B,ONMBUF
SETZ C,
SOUT ;COPY FILESPEC THROUGH VERSION
CALL GOFPAT ;GET OUTPUT PROTECTION, ACCOUNT AND ;T
MOVEI B,0
IDPB B,A
MOVE A,[FDB,,BUFF+FHFDB]
BLT A,BUFF+FHFDB+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO HEADER
TXNE F,CHKSM ;SKIP IF NOT CHECKSUMMING
CALL [ SKIPE INIPGN ;SKIP IF START OF FILE
RET ;MIDDLE OF FILE
SETZM CHKCN0 ;INITIALIZE CHECKSUM
SETZM LSTPGE ;AND PAGE #
CALL FILSZE ;FIGURE FILE SIZE
RET]
;SETUP INITIAL PAGNO AND PAGE CNTR
SKIPGE A,INIPGN ;SKIP IF NOT MIDDLE OF FILE
JRST [ MOVE B,INICNT ;SAVE SAVED COUNTER
MOVEM B,CNTR ;STORE IT
JRST DMPF3]
MOVE A,FDB+.FBBYV ;GET SIZE
HRRZM A,CNTR
AOS NOFILS
AOS TOTFIL ;BUMP TOTAL FILE COUNT
HRLZ A,TOTFIL ;GET FILE NUMBER
TXZ A,PGNCFL!PGNNFL ;CLEAR FLAG BITS
TXO A,PGNNFL ;SET FLAG TO INDICATE PAGNO HAS FILE NUMBER
DMPF3: MOVEM A,PAGNO ;STORE PAGE NUMBER WORD
SETZM INIPGN ;BE SURE INIPGN OFF
;WRITE FILE HEADER TO TAPE
MOVNI A,FLHDX
MOVEM A,TYP
CALL MTOUT
MOVX A,PGNCFL!PGNNFL ;COMPLEMENT THE CONTINUED FILE FLAGS
SKIPGE PAGNO ; IF THIS IS
XORM A,PAGNO ; A CONTINUED FILE
SKIPN LPTJFN
JRST DMPF1
HRROI A,LPTBUF ;SET TO GET WRITE TAD STRING
SKIPN B,FDB+.FBWRT ;HAVE ONE?
JRST [ LPMSG <(NEVER)> ;NO
JRST DMPF1]
MOVX C,1B10+1B12+1B17
ODTIM ;CONVERT TO STRING
HRROI B,LPTBUF
CALL LPMSGQ ;COPY TO LISTING
DMPF1: MOVEI B,SIZCOL ;TAB TO NEXT COLUMN
CALL TAB
SETZM CURBUF ;NO PAGES MAPPED YET
SKIPN CNTR ; 0 pages in file? (e.g. offline)
JRST DMPLUX ; Yes--no pages to write to tape
; ..
;LOOP FOR ALL PAGES IN FILE
DMPLUP: SKIPG TAPLFT ;ANY TAPE LEFT?
JRST DMPEOT ;NO, CLOSE OUT REEL
;MAP A WINDOW OF THE FILE INTO BUF0
DMPIT: HRRZ A,PAGNO ;FORM FILE PAGE
HRL A,JFN ; PAGE ID
SKIPN CURBUF ;FIRST TIME HERE?
JRST DMPL1 ;YES - SET UP WINDOW
HRRZ B,A ;GET PAGE DESIRED
HRRZ C,LASTID ; BASE PAGE # IN WINDOW
SUB B,C ;SEE IF INSIDE WINDOW
CAMGE B,NBUF ;...
JRST [ IMULI B,PGSIZ ;YES - CALC BUFFER ADDRS
ADDI B,BUF0 ;BASE ADDR
HRRZM B,CURBUF ;SET BUFFER ADDRS
JRST DMPL2] ;CONTINUE
DMPL1: MOVEM A,LASTID ;SAVE BASE PAGE INFO
MOVEI B,BUF0 ;SETUP CURBUF
MOVEM B,CURBUF
MOVE B,[XWD .FHSLF,BUF0PG]
MOVX C,PM%RD!PM%PLD!PM%CNT
HRR C,NBUF ;NUMBER OF PAGES TO MAP
PMAP
ERJMP DMPL4 ;IN CASE NON-EX PT
;MAKE SURE THE PAGE WE ARE ABOUT TO DUMP EXISTS
DMPL2: SKIP @CURBUF ;TEST READABILITY
ERJMP DMPL4 ;CAN'T ACCESS PAGE-- FIND OUT WHY
;WRITE THE PAGE OUT TO TAPE
DMPL3: SETZM TYP
TXNE F,CHKSM ;SKIP IF NOT CHECKSUMMING
CALL [ HRRZ A,CURBUF ;CURRENT BUFFER
LSH A,-11 ;PAGE #
HRLI A,.FHSLF
MOVE B,[XWD .FHSLF,BUFPAG]
MOVX C,PM%RD
PMAP ;POINT TO CURRENT BUFFER
CALLRET PGECSM]
CALL MTOUT
SOS CNTR
AOS A,PAGNO ;INCREMENT PAGE #
TRNE A,777777 ;WRAP AROUND TO ZERO??
JRST DMPLUP ;NO-- KEEP ON GOING
MOVX A,-<XWD 1,0> ;YES-- MUST UNDO
ADDB A,PAGNO ; CARRY INTO LH
JRST DMPLUX ;AND NOW DONE WITH FILE
;HERE WHEN CURRENT PAGE CANNOT BE ACCESSED (SKIP ERJMP'ED)
DMPL4: HRRZ B,CURBUF ;GET PAGE
LSH B,-^D9 ; NUMBER
HRLI B,.FHSLF ; IN OUR PROCESS
SETO A, ;UNMAP
SETZ C, ; FILE PAGE FROM
PMAP ; THIS PROCESS
MOVE D,B ;SAVE PROCESS PAGE ID
HRRZ A,PAGNO ;FIND OUT
HRL A,JFN ; WHAT FILE PAGE'S ACCESS IS
RPACS ; . . .
TXNE B,PA%PEX ;PAGE EXIST?
JRST [ MOVE B,D ;YES-- GET BACK PROCESS PAGE ID
MOVX C,PM%RD!PM%PLD ; . .
PMAP ;MAP THE FILE PAGE BACK AGAIN
ERJMP DMPL3 ; . .
JRST DMPL3] ; AND TRY TO ACCESS PAGE ANYWAY
FFUFP ;NO-- FIND NEXT PAGE WHICH DOES EXIST
JRST DMPLUX ;NO MORE PAGES IN FILE-- ALL DONE
HRRM A,PAGNO ;FOUND A PAGE-- REMEMBER IT
JRST DMPIT ; AND TRY TO WRITE IT
;DONE WITH FILE-- FINISH UP AND WRITE TRAILERS
DMPLUX: TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
TRNE A,777777 ;ZERO LENGTH FILE ?
JRST DMPLX2 ;NOT INTERCHANGE OR NOT ZERO
;LENGTH FILE
MOVEI A,BUFF ;USE THIS BUFFER
MOVEM A,CURBUF ;...
SETZM TYP ;DATA TYPE PAGE
CALL MTOUT
DMPLX2: SKIPG CNTR
JRST DMPLX1
BTMSGC <%Cannot find all the pages of file >
HRROI B,NAMBUF
CALL BTMSGQ ;TYPE FILESPEC
BTMSG <
>
; ..
DMPLX1: CALL UNMAPB ;RESET BUFFERS
MOVE A,[FDB,,BUFF]
BLT A,BUFF+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO TRAILER BLOCK
MOVNI 1,FLTRX
MOVEM 1,TYP
SKIPE INCRSW ;INCREMENTAL?
JRST [ HLRZ B,BUFF+.FBCNT ;GET COUNT OF WRITES
MOVE C,BUFF+.FBBK0 ;GET LAST BACKUP WORD
CAIN B,(C) ;SAME WRITE COUNT AS LAST SAVE?
SKIPGE INCRSW ;YES-- BUT FULL-INCREMENTAL?
HRRZ C,B ;FULL OR NEW WRITE-- SET TAPE COUNT TO 0
; AND WRITE COUNT TO NEW WRITE COUNT
TXO C,1B0 ;INDICATE INCOMPLETE DUMP
MOVE A,JFN
HRLI A,.FBBK0
TXO A,CF%NUD ;SUPPRESS DIRECTORY UPDATE
MOVNI B,1 ;CHANGE ALL BITS
CHFDB ;NOTE DUMP PARTIALLY DONE
TXZ C,1B0 ;STORE FDB ON TAPE
ADD C,[XWD 1,0] ; AS IF
MOVEM C,BUFF+.FBBK0 ; DUMP COMPLETED SUCCESSFULLY
JRST .+1]
CALL MTOUT ;OUTPUT TRAILER RECORD
TXNE F,LFILF ;TYPE FILE NAMES ?
TXNE F,LTTYF ;AND NOT LOGGINT TO TTY?
JRST DMPLX3
TMSG < [OK]
>
DMPLX3: HRRZ B,FDB+.FBBYV ;GET SIZE
ADDM B,USRCNT ;COUNT PAGES FOR THIS DIR
MOVEI C,^D10
CALL LPNOUT ;OUTPUT SIZE TO LISTING
TXNE F,CHKSM ;SKIP IF NOT CHECKSUMMING
CALL PRTCSM ;PRINT CHECKSUM
LPMSG <
>
DMPFIX: MOVE A,JFN
TXO A,CO%NRJ ;NO RELEASE JFN
CLOSF ;CLOSE FILE
JFCL
NODUMP:
DMPFIZ: RET ;DONE WITH FILE
;FILE NOT DUMPED
NDMESS: TMSGC <%File >
HRROI B,NAMBUF
CALL TMSGQ ;TYPE FILESPEC
TMSG < not dumped because:
>
CALL JSERRM ;PRINT REASON SYSTEM GAVE
HRROI B,[ASCIZ /not dumped
/]
CALL LPMSGQ
RET ;RETURN
;ENCOUNTERED END OF TAPE IN THE MIDDLE OF FILE.
;REMEMBER CURRENT FILE POSITION FOR NEXT REEL.
DMPEOT: CALL UNMAPB ;RESET BUFFERS
MOVE A,[FDB,,BUFF]
BLT A,BUFF+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO FILE TRAILER
MOVNI 1,FLTRX
MOVEM 1,TYP ;SET RECORD TYPE TO FILE TRAILER
MOVX B,PGNCFL!PGNNFL ;SET CONTINUED FILE FLAG
XORB B,PAGNO ;SET IN PAGE NUMBER WORD
MOVEM B,INIPGN ;MARK TO CONTINUE FILE ON NEXT REEL
MOVE B,CNTR ;SAVE COUNTER
MOVEM B,INICNT ;...
CALL MTOUT ;WRAP UP FILE IN USUAL WAY
LPMSG <
(File continued on next reel)
>
MOVE A,JFN
HRLI A,(1B0) ;SAY DON'T RELEASE JFN
CLOSF ;CLOSE THE FILE
JFCL
CALL TSTEOT ;START NEW TAPE
JRST DMPFIL ;RESTART THIS FILE
;ROUTINE TO CONTINUE SAVE ON NEXT TAPE IF NO TAPE LEFT
TSTEOT: SKIPLE TAPLFT ;ANY TAPE LEFT?
RET ;YES, ALL OK
SKIPN COLSW ;Collection/migration run?
SKIPE ARCSW ;Archive run?
CALL XINFO ;Yes, get new tape #, file spec later
SETOM PAGNO ;INDICATE CONTINUED TAPE TRAILER
CALL ENDTAP
CALL UNLOAD
SKIPG MTTYP ;UNLABELED TAPE?
CALL MTCLS ;YES, CLOSE IT
SKIPN COLSW ;Collection or migration run?
SKIPE ARCSW ;ARCHIVAL?
JRST [ CALL ARDELF ;DELETE AND EXPUNGE OLD RESTART FILE
TMSG < Pass 1 completed.
Tape >
HRROI B,VOLID
CALL TMSGQ ;DISPLAY VOLID
TMSG < is complete and ready for storage.
Please mark it full.
>
CALL PASS2 ;FIX UP FOR FILES ON THIS TAPE
MOVEI A,1 ;1 FOR CONT. SAVESET#
MOVEM A,ARCTSN
MOVEI B,XBUFF
STOR A,SSNO,(B) ; Put in record header too
JRST .+1]
SKIPN A,LPTJFN ;SKIP IF LISTING
JRST TSTET1
CLOSF ;CLOSE LISTING FILE
JFCL
TSTET1: SKIPLE A,MTTYP ;LABELED TAPE?
JRST [ MOVE A,MTJFN ;YES, GET TAPE JFN
MOVEI B,.MOVLS
MOVEI C,[EXP 2,.VSFLS]
MTOPR ;FORCE VOLUME SWITCH
ERJMP [ERRORJ BMBCMD,<?ERROR SWITCHING VOLUMES>]
CALL DNEWV1 ;WRITE STUFF AT BEGINNING OF TAPE
JRST TSTET2]
JUMPL A,[TMSGC <$ End of tape, continue save on
> ;MTA, WE'LL HAVE TO ASK THE USER
JRST .+1]
CALL NTAPER ;GET NEW TAPE SPEC
JRST BMBCMD ;CAN'T
CALL DNEWV ;START NEXT TAPE
TSTET2: SKIPN COLSW ; Collection/migration?
SKIPE ARCSW ;ARCHIVAL?
JRST [ SETZM SPSEQ ;RESTART AT BEGINNING OF TAPE
CALL SETRF ;SET RESTART FILE SPEC W/ NEW TAPE ID
CALL WRARFL ;WRITE RESTART FILE--TAPE HEADER EXISTS
JRST .+1]
RET
;ROUTINE TO RESET FILE WINDOW AND CURBUF
UNMAPB: SETO A,
MOVE B,[.FHSLF,,BUF0PG]
MOVX C,PM%CNT ;SET NUMBER OF PAGES
HRR C,NBUF
PMAP ;REMOVE THEM
HRRI B,BUFPAG
SETZ C, ;ONLY ONE PAGE
PMAP
MOVEI A,BUFF ;SET THIS TO BE CURRENT BUFFER
MOVEM A,CURBUF
RET ;RETURN
BEGUSR: TXNE F,DIRCHG ;SKIP IF SAVING AS SAME DIRECTORY
JRST BEGUS1
HRROI A,DIRNAM
HRRZ B,JFN ;GET CURRENT DIRECTORY NAME STRING
MOVX C,1B2+1B5+1B35
JFNS
HRROI B,DIRNAM
MOVX A,RC%EMO ;EXACT MATCH ONLY
RCDIR
ERJMP BEGUS3 ;RCDIR FAILURE
TXNE A,RC%NOM!RC%AMB
JRST BEGUS3 ;REPORT ERROR
MOVEM C,DIRNUM ;SAVE DIRECTORY NUMBER
TXNN F,SAVUSF ;WANT USER DATA?
JRST BEGU2 ;NO - SKIP THIS
BEGU1: MOVX A,RC%AWL ;ALLOW WILDCARDS
SKIPE C,RCDNUM ;FIRST TIME HERE?
TXO A,RC%STP ;NO - STEP DIRECTORIES
HRROI B,RCDSTR
RCDIR
TXNE A,RC%NMD
JRST [ TMSGC <?RCDIR out of sync on directories
>
TXZ F,SAVUSF ;TURN THIS OFF
JRST BEGU2]
MOVEM C,RCDNUM ;SAVE WHERE WE ARE
SKIPE ININUM ;HAD INITIAL FILESPEC
JRST [ CAME C,DIRNUM ;CAUGHT UP?
JRST BEGU1 ;NO - CONTINUE
SETZM ININUM ;DONE WITH INITIAL DDB
JRST BEGU1A] ;DUMP THIS DIRECTORY
CAME C,DIRNUM ;THE ONE WE WANT?
JRST [CALL DMPUSR ;NO - DUMP A DIR
JRST BEGU1] ;LOOP TO CATCH UP
BEGU1A: CALL DMPUSR ;YES - DUMP USER INFO AND PROCEED
BEGU2: LPMSG <
>
SETZM USRCNT
SETZM NOFILS
HRROI B,DIRNAM
CALL LPMSGQ ;PRINT DIR NAME
LPMSG < (>
HRRZ B,DIRNUM
MOVEI C,^D8
CALL LPNOUT ;PRINT DIR NUM FOR INFO
LPMSG <)
>
RET
;HERE IF DIRECTORY NAME ON DISK .NE. DIRECTORY NAME ON TAPE
BEGUS1: HRROI A,ODRNAM ;CURRENT DIRECTORY NAME
HRROI B,LSTDIR ;LAST DIRECTORY NAME
STCMP
JXE A,SC%LSS+SC%SUB+SC%GTR,BEGUS2
CALL TSTEOT ;SEE IF ROOM ON TAPE FOR THIS DDB
HRROI B,ODRNAM ;NEW DIRECTORY
HRROI A,LSTDIR
SETZ C,
SOUT
SETZM USRCNT
SETZM NOFILS ;RESET # FILES
HRROI B,ODRNAM ;NAME OF DIRECTORY
CALL LPMSGQ
LPMSG <
>
SETZM BUFF
MOVE B,[XWD BUFF,BUFF+1]
BLT B,BUFF+777
MOVE B,[XWD ODRNAM,BUFF+UHNAM]
BLT B,BUFF+UHNAM+17
MOVNI A,USRX
MOVEM A,TYP ;STORE RECORD TYPE
CALL MTOUT
BEGUS2: RET
;RCDIR FAILURE - PRINT MESSAGE
BEGUS3: TMSGC <?RCDIR failure for - >
HRROI A,DIRNAM ;TELL ON DIRECTORY
PSOUT
TMSG <
>
RET ;RETURN
;DUMP USER INFORMATION
DMPUSR: STKVAR <DMPNUM>
MOVEM C,DMPNUM ;SAVE NUMBER OF DIRECTORY
CALL TSTEOT ;MAKE SURE WE HAVE SOME TAPE FOR DDB
SETZM BUFF
MOVE B,[XWD BUFF,BUFF+1]
BLT B,BUFF+777
TXNE F,SAVUSF ;NOT WHEEL OR USER DATA NOT WANTED?
SKIPN WHEEL
JRST DMPUS1 ;YES, DON'T DUMPER DIR INFO
MOVEI A,BUFF+CDSG ;SET UP BUFFER TO RECEIVE SUB GROUPS
MOVEM A,BUFF+.CDCUG
MOVEI A,BUFF+CDUG ;SET UP BUFFER TO RECEIVE USER GROUPS
MOVEM A,BUFF+.CDUGP
MOVEI A,BUFF+CDDG ;SET UP BUFFER TO RECEIVE DIR GROUPS
MOVEM A,BUFF+.CDDGP
MOVEI A,UGLEN ;LENGTH OF BUFFERS FOR GROUPS
MOVEM A,BUFF+CDUG
MOVEM A,BUFF+CDDG
MOVEM A,BUFF+CDSG
HRROI A,BUFF+UHACT ;POINT TO ACCOUNT STRING SPACE
MOVEM A,BUFF+.CDDAC
MOVEI A,.CDDAC+1 ;CURRENT MAX SIZE
MOVEM A,BUFF+.CDLEN
MOVE A,DMPNUM
MOVEI B,BUFF
MOVE C,[POINT 7,BUFF+UHPSW]
GTDIR
ERJMP [JSERR]
MOVEI B,UHPSW ;SET PASSWORD OFFSET
MOVEM B,BUFF+.CDPSW
MOVEI B,UHACT ;SET POINTER TO ACCOUNT STRING
MOVEM B,BUFF+.CDDAC
DMPUS1: HRROI A,BUFF+UHNAM ;POINT TO NAME BUFFER
MOVE B,DMPNUM ;THIS DIRECTORY NUMBER
DIRST ;CONVERT TO STRING
JSHLT ;CANT HAPPEN
MOVNI A,USRX
MOVEM A,TYP
CALL MTOUT
RET
ENDUSR: LPMSG <
>
MOVEI B,FLCOL
CALL TAB ;INDENT TOTAL
SKIPN NOFILS
JRST [ LPMSG <No files
>
RET]
LPMSG <Total >
MOVEI C,^D10
MOVE B,NOFILS
CALL LPNOUT
LPMSG < files, >
MOVEI C,^D10
MOVE B,USRCNT
ADDM B,TOTCNT
CALL LPNOUT
LPMSG < pages
>
SKIPN NOFILS ;SKIP IF FILES THIS DIRECTORY
RET
TXNN F,LFDSK ;SKIP IF LOGGING TO NON-SPOOLED
;DISK FILE
RET
SKIPN A,LPTJFN ;GET LISTING JFN
JRST ENDUS1 ;NONE - RETURN
TXO A,CO%NRJ ;KEEP JFN
CLOSF ;UPDATE FILE
ERROR ENDUS1,<?CANNOT CLOSE LOG FILE>
HRRZ A,LPTJFN ;LOG FILE JFN
MOVX B,<FLD (7,OF%BSZ)+OF%APP>
OPENF
SKIPA
ENDUS1: RET
MOVE A,LPTJFN
RLJFN
JFCL
JRST LPTNAV
;OPEN LPT FOR LISTING FILE. DONE AT BEGINNING OF EACH TAPE
LPTOPN: SKIPN LSTFIL ;HAVE LOG FILE SPEC?
JRST LPTOP1 ;NO
MOVX A,GJ%MSG+GJ%SHT ;MESSAGE AND SHORT FORM
HRROI B,LSTFIL
GTJFN
JRST LPTNAV
LPTOP0: MOVEM A,LPTJFN
DVCHR ;SEE WHAT DEVICE
LOAD C,DV%TYP,A
CAIN C,.DVTTY ;TTY?
TXOA F,LTTYF ;YES
TXZ F,LTTYF ;NO
CAIE C,.DVDSK ;DISK?
TXZA F,LFDSK ;LOG FILE NOT TO DISK
TXO F,LFDSK ;IS DISK
MOVE A,LPTJFN
MOVX B,<FLD(7,OF%BSZ)+OF%APP>
TXNN F,LFDSK ;OPENING A DISK?
MOVX B,<FLD(7,OF%BSZ)+OF%WR> ;NO, THEN OPEN JUST FOR WRITE
OPENF
JRST [ MOVE A,LPTJFN
RLJFN
JFCL
JRST LPTNAV]
SETZM LPTPOS ;INIT LIST VARIABLES
SETZM LPTLIN
RET
LPTNAV: TMSGC <%Log file not available, >
CALL JSERRM
LPTOP1: TXZ F,LFDSK+LTTYF ;NOT DISK OR TTY
SETZM LPTJFN ;SAY NO LISTING
RET
;FIXUP FDB BACKUP WORD AFTER DUMP COMPLETED SUCCESSFULLY
FIXBCK: HRRZ A,P2JFN
MOVE B,[XWD 1,.FBBK0]
MOVEI C,C
GTFDB
JUMPGE C,R
TLZ C,(1B0) ;CLEAR DUMP-IN-PROGRESS FLAG
ADD C,[XWD 1,0] ;INCREMENT TAPE COUNT
MOVSI B,-1 ;GET MASK FOR BITS TO CHANGE
HRLI A,.FBBK0+CF%NUD_-^D18 ;NO UPDATE DIRECTORY
CHFDB
RET
;INITIALIZATION FOR ARCHIVE/COLLECTION/MIGRATION RUN: DETERMINE TAPE NO., SAVESET NO.,
;STARTING POSITION FROM OLD TAPE OR FROM USER FOR NEW TAPE
ARCINI: SETZM INIPGN ;NON-0 FOR CONT. FILE
SETZM ARCTSN ;SAVE SET #
CALL GTVOL ;GET VOLID
CALL SETRF ;SET RESTART FILE SPEC. (EXT.=TAPE ID)
SKIPE ARCSW ; Determine SS type: archival?
MOVEI A,SSARC ; Yes, load code for archive saveset
SKIPLE COLSW ; Collection run?
MOVEI A,SSCOL ; Yes, code for collection saveset
SKIPGE COLSW ; Migration run?
MOVEI A,SSMIG ; Yes, code for migration saveset
MOVEM A,SSTYP ; Saveset type is determined
HRROI A,[ASCIZ /$Is this a new tape? /]
CALL YESNO
JUMPN A, [HRROI A,[ASCIZ /$Are you sure? /]
CALL YESNO
JUMPE A,[ERROR BMBCMD,<COMMAND ABORTED>]
MOVEI B,2 ;FIRST TSN ON A NEW TAPE TO BE 2
MOVEM B,ARCTSN ;TO RESERVE 1 FOR CONT. SAVESET
SETZM SPSEQ ;INIT. SEQUENCE NO.
CALL MTOPNX
CALL REWCV ;REWIND THE TAPE
CALL MTCLS
JRST ARINI1]
;OLD TAPE:
CALL SCNTAP ;GET TAPNO=SSTYP!SS#,,TAPE# FROM 1ST REC ON TAPE
MOVEI C,XBUFF ; Address of record header
; LOAD B,TPNO,(C) ; Tape # from tape
; CAME B,ARCTN ;=SUPPLIED TAPE #?
; JRST [ TMSG <?TAPE # INPUT DISAGREES WITH TAPE # ON TAPE.
;THE FIRST TAPE HEADER ON THIS TAPE FOLLOWS:
;>
; CALL TYHEDR
; ERROR BMBCMD, <COMMAND ABORTED>]
LOAD B,SSCOD,(C) ; SS type from tape
CAME B,SSTYP ; Matches type for this run?
JRST [ TMSG <?This tape has been previously used for a different DUMPER purpose.
Continuation of this run will cause a mixture of saveset types
on this tape.
The first tape header on this tape follows:>
CALL TYHEDR
HRROI A,[ASCIZ /$Do you wish to continue this run? /]
CALL YESNO
JUMPE A,[ERROR BMBCMD,<COMMAND ABORTED>]
JRST .+1]
CALL RDARFL ;READ RESTART FILE, IF ANY. EXISTS?
JRST [ CALL SEQFND ;YES, FIND START POS. BY SEQ. NO.
JRST ARINI1]
CALL SCNTAP ;NO,SCAN TO TRAILER REC.
SOS TAPNO ;GETS AOS'ED IN DNEWV
;NOW ARCTN, ARCTSN, SSTYP, SPSEQ, INIPGN, INICNT, AND XSPEC ARE
; DETERMINED FOR NEW SAVESET AND TAPE IS POSITIONED TO START
ARINI1: MOVEI B,XBUFF ; Address of tape header block
SKIPE A,SPSEQ ; 1st seq. # on last phys. rec.
JRST [ ADD A,TAPBKF ; 1st seq. # of new SS
SOS A ; But will be incremented before write
JRST .+1]
MOVEM A,SEQ ;SEQ NO. FOR TAPE
MOVEM A,RSEQ ;EXPECTED SEQUENCE NO.
MOVE A,ARCTSN ;SAVESET#
STOR A,SSNO,(B) ; In LH of TAPNO for record header
MOVE A,SSTYP ; Saveset type (archive, coll., mig.)
STOR A,SSCOD,(B) ; Put in 1st 3 bits of TAPNO
CALL WRARFL ;WRITE RESTART FILE
MOVE A,INIPGN ;=0 EXCEPT FOR CONT. FILE
MOVEM A,PAGNO ;INIT. PAGNO=TFN,,PAGE# FOR TAPE, EXCEPT
RET ; =PGNCFL!PGNNFL,,PAGE# INITIALLY FOR CONT. FILE
; ROUTINE TO CONSTRUCT RESTART FILE NAME FOR ARCHIVING
SETRF: HRROI A,RFSPEC ;SET UP RESTART FILE NAME, EXT.
HRROI B,[ASCIZ /SYSTEM:DUMPER-TAPE-IN-PROGRESS./]
SETZ C,
SOUT ;RESTART FILE NAME
HRROI B,VOLID
SOUT ;FILE TYPE IS TAPE VOLID
RET
; GTVOL - GET VOLUME-ID FOR ARCHIVING RUNS
; RETURNS +1: ALWAYS, IDENTIFIER IN VOLID (ASCIZ) AND VOLID6 (SIXBIT)
GTVOL: SKIPN MTDSG ;USER GIVE ME A TAPE YET?
CALL NTAPE ;NO, GET TAPE SPEC
JFCL ;WON'T FAIL
SKIPE VOLID6 ;DO I KNOW THE VOLID?
RET ;YES, RETURN
SKIPL MTTYP ;MT DEVICE?
JRST [ MOVX A,GJ%SHT ;YES
HRROI B,MTDEV
GTJFN ;GET JFN ON MT
JRST .+1 ;SHOULD NEVER FAIL
PUSH P,A
CALL GMTINF ;GET VOLID FROM MONITOR
POP P,A
RLJFN ;DUMP JFN
JFCL
RET]
GTVOLA: MOVEM P,TPDLP ;DON'T FEAR THE REPARSE
GTVOL0: MOVE A,[CM%RAI+GTVOL1] ;RAISE LOWER CASE, REPARSE ADDRESS
HRROI B,[ASCIZ/$ Enter tape ID /]
CALL CMDINI
GTVOL1: MOVE P,TPDLP ;RESTORE P IN CASE OF REPARSE
MOVEI B,[FLDDB. .CMFLD,,,<tape serial number or volume identifier,
1 to 6 alphanumeric characters long>]
CALL COMNDN ;PARSE FIELD
JRST GTVOL0 ;ERROR, TRY AGAIN
MOVEI B,[FLDDB. .CMCFM]
CALL COMNDN ;GET CONFIRMATION
JRST GTVOL0
DMOVE A,ACBFR
DMOVEM A,VOLID ;SAVE ASCIZ VERSION OF VOLID
SETZM VOLID6 ;CLEAR SIXBIT VOLID
MOVE A,[POINT 6,VOLID6]
MOVE B,[POINT 7,ACBFR]
MOVEI C,6
GTVOL3: ILDB D,B ;GET CHARACTER FROM ATOM BUFFER
JUMPN D,[SOJL C,GTVOL2 ;GIVE ERROR IF TOO LONG
SUBI D,40 ;CONVERT TO SIXBIT CODE
JUMPL D,GTVOL2
IDPB D,A ;STORE SIXBIT CHAR
JRST GTVOL3] ;CONTINUE SCAN
CAIE C,6 ;VACUOUS VOLID?
RET ;NO, ALL'S WELL
GTVOL2: TMSGC <?BAD VOLUME IDENTIFIER>
JRST GTVOL0 ;LET HIM TRY AGAIN
;SUBROUTINE TO READ RESTART FILE, DUMPER-TAPE-IN-PROGRESS, IF ANY
;RETURNS +1 IF RESTART FILE EXISTS
; +2 IF NO RESTART FILE EXISTS
RDARFL: MOVX A,GJ%OLD+GJ%SHT
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
GTJFN
JRST [ CAIE A,GJFX19 ;NO SUCH FILE TYPE ERROR?, OR
CAIN A,GJFX24 ;FILE NOT FOUND ERROR?
RETSKP ;SKIP RETURN FOR NO RESTART FILE
CAIE A,GJFX18 ;NO SUCH FILENAME ERROR?
CAIN A,GJFX20 ;OR NO SUCH GENERATION ERROR?
RETSKP ;SKIP RETURN FOR NO RESTART FILE
JRST BDARFL] ;BAD RESTART FILE
MOVE B,[FLD(^D36,OF%BSZ)+OF%RD] ;36-BIT BYTE, READ ACCESS
OPENF
JRST BDARFL ;BAD RESTART FILE
HRLI A,0 ;CLEAR LH
BIN ;1ST WORD IN FILE IS TAPE#
CAME B,VOLID6 ;CHECK AGAINST REQUESTED TAPE#
JRST BDARFL ;BAD RESTART FILE
BIN ;2ND WORD IN FILE IS SAVESET NO.
MOVEM B,ARCTSN ;(1 IF CONT., 2 AT START OF NEW TAPE)
BIN ; 1st seq. no. of physical record
; just before new SS
MOVEM B,SPSEQ ;SAVED IN SPSEQ
PUSH P,A ;SAVE FOR CLOSE BELOW
MOVE B,ARCTSN
CAIE B,1 ;SAVESET 1 FOR CONT. SAVESET, READ ON...
JRST CLSAFL ;OTHERWISE, DONE
BIN
MOVEM B,INIPGN ;INITIAL PAGE NO. IN CONT. FILE
BIN
MOVEM B,INICNT ;INITIAL PAGES REMAINING IN CONT. FILE
HRROI B,XSPEC ;FILE SPEC FOR CONT. SAVESET
SETZ C, ; I.E., SPEC OF CONT. FILE
SIN ; OR 1ST FILE FOR NEW TAPE
MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD] ;POINT TO ROUTINES
CALL FILDFI ;SET UP FILE DEFAULTS
MOVE A,[.NULIO,,.NULIO] ;AS IN COMMAND, BUT FILESPEC
MOVEM A,GJBLK+.GJSRC ;IS XSPEC
MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
HLLM A,GJBLK+.GJGEN
MOVEI A,GJBLK ;GTJFN BLOCK
HRROI B,XSPEC
GTJFN
JRST [ SETZM INIPGN ;START OVER ON FILESPEC
SETZM INICNT ; GIVEN IN SAVE COMMAND
SETZM XSPEC
JRST CLSAFL]
MOVEM A,INIJFN ;INITIAL JFN SET
HRRZ B,A ;JFN IN B FOR ADFILE
CALL ADFILE ;ADD JFN TO JFN STACK
CLSAFL: POP P,A
CLOSF
CALL JSERRM
RET
BDARFL: ERROR BMBCMD, <?BAD RESTART FILE. MARK THIS TAPE AS FULL
AND USE NEW TAPE FOR FURTHER ARCHIVALS.>
SEQFND: CALL MTOPNR
PUSH P,TAPBKF ; Preserve blocking factor thru REWIND
CALL REWCV ;INITIALIZES SEQ AND RSEQ
POP P,TAPBKF
SKIPG SPSEQ ;DONE IF SPEC. SEQUENCE NO.=0
JRST [ CALL ARDELF ; Expunge restart file
CALL MTCLS
RET]
SEQFN1: CALL TSTINT
CALL MTRED ;READ A RECORD
JRST [TMSG <, Record ignored
>
JRST SEQFN1]
MOVN A,TYP
CAIN A,TPTRX
SKIPL PAGNO ;TAPE FULL?
SKIPA ;NO
JRST [ CALL ARDELF ;YES, Expunge restart file
CALL REWCV
CALL MTCLS
ERROR BMBCMD, <?TAPE FULL. PLEASE MARK IT.>]
MOVE A,SEQ ;SEQ NO. FROM TAPE
CAMGE A,SPSEQ ; At or past SPSEQ yet?
JRST SEQFN1 ; No, keep scanning
CAME A,SPSEQ ; At SPSEQ?
JRST [ CALL MTCLS
ERROR BMBCMD,<?Tape error prevents proper positioning of tape
for new saveset.
$Mark this tape as full.>]
CALL BACKSP ;BACKSPACE ONE RECORD
CALL FWRSP ;THEN ADVANCE ONE RECORD
; TO BE GOING IN RIGHT DIRECTION
CALL MTCLS
RET
SCNTAP: CALL MTOPNR
PUSH P,TAPBKF ;Preserve blocking factor thru REWIND
CALL REWCV ;INITIALIZES SEQ AND RSEQ
POP P,TAPBKF
SCNTP1: CALL TSTINT
CALL MTRED ;READ A RECORD
JRST [TMSG <, RECORD IGNORED
>
JRST SCNTP1]
MOVE A,TAPBKF ;Blocking factor determined from tape
MOVEM A,SETBKF ;Set as blocking factor for tape write
MOVN A,TYP
CAIN A,TPTRX
SKIPL PAGNO ;TAPE FULL?
SKIPA ;NO
JRST [ CALL REWCV ;YES
CALL MTCLS
ERROR BMBCMD, <?TAPE FULL. PLEASE MARK IT.>]
CAIE A,CTPHX ;CONTINUED SAVE SET?
CAIN A,TPHDX ;OR TAPE HEADER?
JRST [ MOVE A,ARCTSN ;YES, AND ARCTSN=0 IF 1ST TAPE SCAN
MOVEI C,XBUFF
LOAD B,SSNO,(C) ; Saveset no. from record header
MOVEM B,ARCTSN ;UPDATE SAVESET#
JUMPN A,SCNTP1 ;2ND SCAN: SCAN TO TRAILER REC
CALL MTCLS ;1ST SCAN: TAPNO SET FROM 1ST REC
RET]
CAIE A,TPTRX ;TAPE TRAILER?
JRST SCNTP1 ;NO, KEEP SCANNING
SKIPG MTTYP ;TRAILER FOUND, UNLABELED TAPE?
CALL [ CALL BACKSP ;YES, BACK OVER TRAILER
CALLRET BACKSP] ;BACKSPACE ONE RECORD
MOVE B,SEQ ; Seq. no. just before last physical
; record before new savest
SKIPG MTTYP ;DON'T INCREMENT IF LABELED
ADDI B,1 ; Calc. 1st seq. no. on last physical
; record before new SS
MOVEM B,SPSEQ ; Save for restart file
SKIPG MTTYP ;UNLABELED TAPE?
CALL FWRSP ;YES, THEN ADVANCE ONE RECORD
; Now positioned for new SS
AOS ARCTSN ;NEW SAVESET NO.
CALLRET MTCLS
ARCSSN: HRROI A,SSNBUF
HRROI B,[ASCII /Save set# /]
MOVNI C,^D10 ;10 CHARACTERS ONLY
SOUT
MOVE B,ARCTSN ;SAVESET#
MOVEI C,^D10 ;RADIX
NOUT
JFCL
HRROI B,[ASCIZ /, Archive Tape/]
MOVE C,COLSW
CAIN C,1 ; Collection?
HRROI B,[ASCIZ /, Collection Tape/]
CAMN C,[-1] ; Or migration?
HRROI B,[ASCIZ /, Migration Tape/]
SETZ C,
SOUT
RET
WRARFL: MOVX A,GJ%SHT
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
GTJFN
JRST BDWRFL
MOVX B,<FLD (^D36,OF%BSZ)>+OF%WR
OPENF
JRST BDWRFL
HRLI A,0 ;CLEAR LH
MOVE B,VOLID6 ;1ST WORD OF FILE IS TAPE NO.
BOUT
MOVE B,ARCTSN ;2ND WORD IS SAVESET NO.
BOUT
MOVE B,SPSEQ ; 1st seq. no. of last physical
BOUT ; record before new saveset
PUSH P,A ;SAVE FOR CLOSF BELOW
SKIPN XSPEC ;CONTINUED SAVESET?
JRST CLSWFL ;NO, WRITE IS COMPLETE
MOVE B,INIPGN ;REMAINING PAGES IN CONT. FILE
BOUT
MOVE B,INICNT ;PAGE LOC. IN CONT. FILE
BOUT
HRROI B,XSPEC ;FILESPEC OF CONT. SAVESET
SETZ C,
SOUT
CLSWFL: POP P,A
CLOSF
JRST BDWRFL
RET
BDWRFL: ERROR BMBCMD, <?CANNOT CREATE RESTART FILE>
;FOR ARCHIVE/MIGRATION/COLLECTION RUN, TEST FILE FOR INCLUSION ON THIS TAPE
;RETURNS +1 FOR NO DUMP
; +2 FOR OK TO DUMP
ARCTST: SKIPE INIPGN ;CONT. FILE?
RETSKP ;YES, GO ON WITH DUMP
MOVE B,FDB+.FBCTL
TXNE B,FB%OFF ; File offline?
RET ; Yes, skip it
SKIPE ARCSW ; Archive run?
JRST [ MOVE B,FDB+.FBBBT
TXNN B,AR%RAR ; Archive requested?
RET ; No, skip it
JRST .+1] ; Yes, go on with check
SKIPE COLSW ; Colletcion/migration?
JRST [ MOVE B,FDB+.FBBBT
TXNE B,AR%RIV ; Migration request?
JRST .+1 ; Explict request, cont. with test
SKIPG COLSW ; We taking expired files? (collection)
RET ; No, bypass the file
REPEAT 0,< HLRZ B,FDB+.FBNET ; Get online expiration
GTAD ; Get now
HLRZS A
CAIGE A,(B) ; File expired?
RET ; No (& does have exp. date)
JUMPN B,.+1 ; Expired date if non-zero--dump it
MOVE A,FDB+.FBCRE ; Interval, find most recent date
CAMG A,FDB+.FBCRV
MOVE A,FDB+.FBCRV
CAMG A,FDB+.FBWRT
MOVE A,FDB+.FBWRT
CAMG A,FDB+.FBREF
MOVE A,FDB+.FBREF
HRRZ B,FDB+.FBNET ; Get the interval
HLRZS A
ADD B,A ; Form expiration date
GTAD
HLRZS A
CAIG A,(B) ; Expired?
RET ; No, skip it
> ; End REPEAT 0
JRST .+1] ; Yes, dump it
CALL NSETS ;DETERMINE ARSETS=NO. SETS TAPE INFO
MOVE B,FDB+.FBBBT
TXNE B,AR%1ST ;IF AR%1ST ON, IGNORE INVALID TAPE INFO
JRST [ SOS A,ARSETS ;CORRECT ARSETS FOR IGNORED SET
SKIPGE ARSETS
SETZB A,ARSETS ;ENSURE ARSETS>=0
JRST .+1]
CAIN A,2 ;ARSETS=2,I.E., 2 SETS TAPE INFO?
JRST [ MOVE B,FDB+.FBCTL
TXNE B,FB%ARC ; File archived?
SKIPN ARCSW ; And during archive run?
RET ; No, just skip it (REAPER will take it)
CALLRET OLDARC] ; Yes, complain and skip it
CAIE A,1 ;NOW ARSETS=0 FOR 1ST RUN,=1 FOR SECOND
RETSKP ;FINISHED IF 1ST RUN
MOVE B,FDBARC+.ARTP1 ;FOR 2ND RUN, CHECK FIRST TAPE NO.
CAME B,VOLID6 ;1ST TAPE # = 2ND TAPE #?
RETSKP ;NO, OK TO DUMP
RET ;YES, DEFER DUMP TILL ANOTHER TAPE
OLDARC: CALL GOFNAM ;GET TAPE FILE NAME SET
TMSG <%FILE >
MOVE B,ONMPTR ;POINTER TO FILENAME INCL. DIR.
CALL TMSGQ
TMSG < SKIPPED BECAUSE
ALREADY MARKED AS HAVING TWO VALID TAPE COPIES.
>
RET
;FOR ARCHIVE/COLL./MIG. RUN, SET TAPE INFO AND AR%1ST
ARC1: CALL ARSST0 ;SET UP ARG BLOCK FOR .ARSST
MOVE A,JFN
HRLI A,.FBBBT ;SET AR%1ST IN .FBBBT
MOVX B,AR%1ST ;TO MARK 1ST PASS OF ARC./COL./MIG. RUN
MOVE C,B ;IN PROGRESS
CHFDB
MOVX B,.ARSST ;CODE FOR SET ARCHIVE STATUS
MOVEI C,ARSSTB ;ARG BLOCK FOR .ARSST
ARCF ;SET ARCHIVE STATUS
MOVX B,.ARGST ;READ TAPE INFO JUST SET
MOVEI C,FDBARC ;INTO FDBARC FOR USE IN TAPE WRITE
ARCF
MOVX B,AR%1ST+AR%RAR+AR%RIV ;WRITE FDB ON TAPE AS IF THE ARCHIVE
ANDCAM B,FDB+.FBBBT ;RUN HAD COMPLETED SUCCESSFULLY
RET
NSETS: SETZB A,ARSETS ; Assume none
SKIPE FDBARC+.ARTP1 ; First one there?
AOS A,ARSETS ; Yes, note that
SKIPE FDBARC+.ARTP2 ; How about the 2nd tape?
AOS A,ARSETS ; That one too
RET
ARSST0: SETZM ARSSTB+.AROFL ; Set up blk - use not for tape write
SETZM ARSSTB+.ARODT
MOVX B,AR%ARC ; Flag archive?
SKIPE ARCSW
MOVEM B,ARSSTB+.AROFL ; Yes
SKIPE ARSETS ;FIRST ARCHIVE RUN?
JRST ARCP2 ;NO
MOVX B,AR%O1 ;YES, IN 1ST TAPE SLOTS
IORM B,ARSSTB+.AROFL ;FLAG FIRST RUN
MOVE B,TOTFIL ;TAPE FILE NUMBER
ADDI B,1 ; TOTFIL WILL BE INC'D BY TIME IS WRITTEN
HRRM B,ARSSTB+.ARSF1
MOVE B,ARCTSN ;TAPE SAVE SET NUMBER
HRLM B,ARSSTB+.ARSF1
MOVE B,VOLID6 ;TAPE NUMBER
MOVEM B,ARSSTB+.ARTP1
RET
ARCP2: MOVX B,AR%O2
IORM B,ARSSTB+.AROFL ;FLAG SECOND RUN
MOVE B,TOTFIL ;TAPE FILE NUMBER
ADDI B,1 ; TOTFIL WILL HAVE BEEN INC'D BY TIME WRITTEN
HRRM B,ARSSTB+.ARSF2
MOVE B,ARCTSN ;TAPE SAVE SET NUMBER
HRLM B,ARSSTB+.ARSF2
MOVE B,VOLID6 ;TAPE NUMBER
MOVEM B,ARSSTB+.ARTP2
RET
;REMOVE ONE SET TAPE INFO FROM FDB IF AR%1ST IS SET
;DOES NOT UPDATE TAPE INFO IN MEMORY AFTER REMOVAL FROM FDB
UNARC: MOVE A,JFN
MOVE B,[1,,.FBBBT] ;GET CURRENT FLAG BITS
MOVEI C,B ; INTO B
GTFDB
ERJMP [CALLRET JSERR1]
TXNN B,AR%1ST ;TAPE INFO VALID?
RET ;YES
MOVX B,.ARGST ; Get the tape info
MOVEI C,FDBARC ; Put with other FDB info
ARCF
CALL NSETS ;NO. OF SETS TAPE INFO IN A
JUMPE A,R ; None?
MOVX C,AR%CR1 ;RUN 1:CLEAR THAT INFO
CAIN A,2 ;RUN 2?
MOVX C,AR%CR2 ;YES: CLEAR ONLY RUN 2 INFO
MOVX B,.ARDIS ;DISCARD TAPE INFO
MOVE A,JFN
ARCF
ERJMP [TMSG <Unable to discard invalid tape backup information.
>
RET]
HRLI A,.FBBBT ;DISCARD SUCCEEDED: TURN OFF AR%1ST
MOVX B,AR%1ST
SETZ C,
CHFDB
ERJMP [TMSG <?Unable to clear AR%1ST after discarding tape information
>
RET]
RET
ARFXBK: MOVE A,P2JFN
HRLI A,.FBBBT ;SET AR%1ST TO ZERO
MOVX B,AR%1ST ;CHANGE JUST THIS BIT
SETZ C, ;TO 0
CHFDB
ERJMP R ;FAILURE: SKIP THIS FILE
ANDCAM B,FDB+.FBBBT
CALL NSETS ;DETERMINE ARSETS= #SETS ARCH INFO
CAIE A,2 ;2ND RUN?
RET ;NO, DONE
MOVE C,FDB+.FBBBT ; Get backup bits
TXNE C,AR%NDL ; Delete on disk not allowed?
JRST ARFXB1 ; Right, skip delete
MOVX A,DF%CNO!DF%NRJ ;Delete disk contents only
HRR A,P2JFN
DELF
JRST [ MOVX B,AR%NDL
IORM B, FDB+.FBBBT
JRST .+1]
ARFXB1: MOVE A,P2JFN ;GET JFN
MOVX B,.ARRAR ;CODE FOR SET/CLEAR ARCH REQUESTS
MOVE C,FDB+.FBBBT
TXNE C,AR%RIV
MOVX B,.ARRIV ; Migration request
MOVX C,.ARCLR ; Clear it
ARCF
ERJMP [TMSG <?Unable to clear archive/migration request bit after migration to tape complete.
>
JRST .+1]
MOVE D,FDB+.FBBBT ; Get who archived it
HRLI A,.FBCTL
MOVX B,FB%INV ; Change invisible bit
MOVE C,B
TXNN D,AR%NDL ;FLUSH NOT ALLOWED?
TXNN D,AR%RAR ; User request the archive?
CAIA ;FILE MADE INVISIBLE ONLY IF
CHFDB ;FLUSHED & USER REQUESTED ARCHIVE
ERJMP .+1 ;FAILURE SHOULD NOT BE DISASTROUS
HRRZ A,P2JFN ; JFN for file being messed with
MOVE B,FDB+.FBBBT ; Get old back up words
ANDX B,AR%NDL ; Save only that bit (flag for ARMSUS)
CALL ARMSUS ; Message to user about this file
CALL USAINI ; Init USAGE block here
MOVX A,.UTARC
SKIPGE COLSW ; -1=migration
MOVX A,.UTMIG
SKIPLE COLSW ; 1=collection
MOVX A,.UTCOL
HRRM A,USABLK ; Store entry type
LOAD A,FB%PGC,FDB+.FBBYV ; Get # pages that were in the file
MOVEM A,USABLK+10
MOVEI A,FDBARC ; Point to tape info blk
CALL USATAP ; And spray it into the USAGE blk
LOAD B,AR%RSN,FDB+.FBBBT ; Get reason off-line code
MOVEM B,USABLK+26 ; Add reason code to blk
HRRZ B,P2JFN ; JFN of file in question
HRROI A,USASTR ; Structure of the file
MOVX C,<FLD(.JSAOF,JS%DEV)>
JFNS
HRROI A,USADIR
MOVX C,<FLD(.JSAOF,JS%DIR)>
JFNS
MOVE A,B ; JFN
HRROI B,USAACT ; Account of the file
GACTF
CAIA ; Error, ignore it
JRST [ MOVEM B,USABLK+6 ; We somehow got a numeric account
MOVX B,US%IMM
IORM B,USABLK+5 ; Mark as an immediate quanity
JRST .+1]
MOVEI A,USASTR ;GET ASCIZ STRUCTURE NAME
HLL A,[POINT 7,0]
MOVEI B,USASSI ;PUT SIXBIT STRUCTURE NAME INTO
CALL SEVSIX ; USASSI
MOVX A,.USENT
MOVEI B,USABLK
USAGE
ERJMP [TMSG <%USAGE entry failed in ARFXBK
>
JRST .+1]
RET
;FOR ARCHIVE RUN, END-OF-TAPE FUNCTIONS
XINFO: TMSG < This >
CALL PRTTYP ; Print archive/collection/migration
TMSG < run will be continued onto another tape.
>
HRROI A,XSPEC ;FILESPEC AT TAPE SWITCH
MOVE B,JFN ;CURRENT FILE, TO BE CONT.
MOVX C,1B2+1B5+1B8+1B11+1B14+1B35
JFNS
HRROI A,XDIR ;STR:DIRECTORY AT TAPE SWITCH
MOVX C,1B2+1B5+1B35
JFNS
RET
PRTTYP: HRROI B,[ASCIZ/archive/]
SKIPE ARCSW
JRST TMSGQ
HRROI B,[ASCIZ/collection/]
SKIPL COLSW
JRST TMSGQ
HRROI B,[ASCIZ/migration/]
JRST TMSGQ
ARDELF: MOVX A,GJ%SHT
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
GTJFN
CALLRET DELBMB
HRLI A,0
TXO A,DF%EXP ;DELETE AND EXP
DELF ;OLD RESTART FILE
CALLRET DELBMB
RET
DELBMB: TMSG <%FAILED IN ATTEMPT TO DELETE RESTART FILE
>
HRROI B,RFSPEC ;RESTART FILE SPEC. (EXT.=TAPE ID)
CALL TMSGQ
TMSG <
IMPORTANT: MAKE SURE THIS FILE DOES NOT REMAIN ON THE SYSTEM.
>
RET
SUBTTL PSEUDO INTERRUPT ROUTINES
CHNMSK: 1B<CECHN>+1B<QSRCHN>+1B<VSCHN>+1B<.ICPOV>+1B<.ICDAE>+17B<.ICIEX>+1B<.ICMSE>+1B<.ICQTA> ;CHANNELS USED
;TERMINAL INTERRUPT - ^E
CEINT: MOVEM 17,INT3AC+17 ;SAVE ACS
MOVEI 17,INT3AC
BLT 17,INT3AC+16
MOVE P,[IOWD NINTPD,INT3PD]
SKIPN CEXFLG ;EXECUTING COMMAND?
JRST [ TMSGC <%No interruptible command in progress
>
JRST CEINT1]
SKIPE INTRQ ;ALREADY REQUEST PENDING?
JRST [ TMSGC <%Interrupt request already in progress.
>
JRST CEINT1]
TMSG <
Interrupting...
>
SETOM INTRQ ;REQUEST INTERRUPT
CEINT1: MOVSI 17,INT3AC ;RESTORE ACS
BLT 17,17
DEBRK
;TEST FOR INTERRUPT REQUEST, RETURN IMMEDIATELY IF NONE.
;OTHERWISE, ENTER COMMAND INPUT AND RETURN WHEN 'CONTINUE' GIVEN
TSTINT: SKIPN INTRQ ;INT REQUEST?
RET ;NO
POP P,INTPC ;YES, SAVE PC AND NOTE INTERRUPTED
MOVE A,CMDTYP ;GET CURRENT COMMAND TYPE
TXNN A,TY%DBL ;SKIP IF SAVE OR RESTORE COMMAND
SETZM NIJFN ;DON'T SAVE JFNLST POINTER
MOVEM A,ICMDTY ;SAVE AS INTERRUPTED COMMAND TYPE
MOVEM P,IPDLP ;SAVE PUSH DOWN POINTER
SETZM INTRQ ;CLEAR INTERRUPT REQUEST
MOVE A,CURPTR
MOVEM A,CMDPTR
SETZM CEXFLG ;COMMAND NO LONGER IN PROGRESS
MOVE A,TRAPJ ;GET TRAP STUFF
MOVEM A,ITRAPJ ;SAVE TRAP STUFF
MOVE A,TRAPSP ;..
MOVEM A,ITRAPS ;..
JRST RESTRT ;GO TO COMMAND LEVEL
;'CONTINUE' COMMAND
$CONT: CALL CONFRM
SKIPN INTPC ;WERE INTERRUPTED?
ERROR RESTRT,<?CANNOT CONTINUE>
MOVE A,ICMDTY ;GET INTERRUPTED COMMAND TYPE
MOVEM A,CMDTYP ;AND RESTORE
SETZM ICMDTY ;INDICATE NO INTERRUPTED COMMAND
MOVE A,ITRAPJ ;RESTORE TRAP STUFF
MOVEM A,TRAPJ ;...
MOVE A,ITRAPS ;...
MOVEM A,TRAPSP ;...
MOVE A,INIPTR ;RESET CMDPTR
MOVEM A,CMDPTR ;...
MOVE P,IPDLP ;RESTORE PDL
SETOM CEXFLG ;YES, NOTE RESUMING EXECUTION
MOVE A,INTPC ;GET PC
SETZM INTPC ;ZERO INTERRUPT PC
JRST 0(A) ;RETURN TO POINT OF INTERRUPTION
;LABELED-TAPE VOLUME-SWITCH INTERRUPT
VSINT: MOVEM 17,INT3AC+17 ;SAVE ACS
MOVEI 17,INT3AC
BLT 17,INT3AC+16
MOVE P,[IOWD NINTPD,INT3PD]
MOVE A,MTJFN ;GET JFN
CALL GMTINF ;UPDATE VOLID
SETZM RSEQ ;RESET RECORD SEQUENCE NUMBER
JRST CEINT1
;UNEXPECTED TRAP LOGIC
;SET FENCE FOR TRAPS
; A/ WHERE TO GO IF UNEXPECTED TRAP
SETTRP: POP P,CX ;GET LOCAL PC OFF STACK
PUSH P,TRAPJ ;SAVE PREVIOUS FENCE
PUSH P,TRAPSP
MOVEM A,TRAPJ ;SAVE DISPATCH
MOVEM P,TRAPSP ;SAVE STACK FENCE
SETTR1: PUSHJ P,0(CX) ;CONTINUE ROUTINE
SKIPA ;NO SKIP RETURN
AOS -2(P)
POP P,TRAPSP ;RESTORE PREVIOUS FENCE
POP P,TRAPJ
RET
;UNEXPECTED TRAP HANDLERS
;ILLEG INSTRUCTION
ITRAP: JSR EINT1 ;SWITCH CONTEXT
SKIPE TRAPJ ;TRAP FENCE?
JRST ITRAP1 ;YES - SKIP SYSTEM MESSAGE
TMSGC <?>
CALL JSERRM ;DO JSYS ERROR MESSAGE
ITRAP1: SKIPE A,TRAPJ ;HAVE TRAP FENCE?
JRST [ MOVEM A,INT1AC+CX ;YES, SETUP DISPATCH ADDRESS
TMSG <
>
MOVE A,TRAPSP ;AND RESET STACK TO FENCE
MOVEM A,INT1AC+P
MOVEI A,SETTR1 ;DEBREAK ADDRESS
JRST BADIXP]
TMSG < Command aborted
>
MOVEI A,BMBCMD ;DEBREAK TO BOMB COMMAND
BADIXP: MOVEM A,LPC1 ;SET DEBREAK ADDRESS
BADIX: MOVSI 17,INT1AC ;RESTORE ACS
BLT 17,17
DEBRK
BADINT: TMSG <?PC = >
HRRZ B,LPC1
MOVEI C,^D8
CALL TTNOUT ;PRINT PC
TMSG <
>
JRST ITRAP1
;HERE IF NO RECOVERY
BADEX: HALTF
JRST .-1 ;CANT CONTINUE
;MEMORY READ TRAP
MEMRTP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Unexpected memory read trap in DUMPER
>
BADIVA: TMSG <?VA = >
MOVEI A,.FHSLF ;GET ADDRESS OF BAD REFERENCE
GTRPW
HRRZ B,A
MOVEI C,^D8
CALL TTNOUT ;REPORT IT
TMSG <
>
JRST BADINT ;CONTINUE AS FOR ITRAP
;MEMORY WRITE, EXECUTE TRAPS
MEMWTP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Unexpected memory write trap in DUMPER
>
JRST BADIVA
MEMXTP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Unexpected memory execute trap in DUMPER
>
JRST BADIVA
;MACHINE SIZE EXCEEDED OR DISK QUOTA EXCEEDED
MSETRP: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?Disk full or quota exceeded.>
SKIPE RETSW ;RETRIEVING?
JRST ITRAP1 ;YES, TAKE TRAP
TMSG < Type <CR> to attempt to continue >
CALL RDLIN
MOVE A,LPC1 ;GET FAILING PC
TLNE A,(PC%USR) ;FAILED IN JSYS?
JRST BADIX ;NO, DEBREAK
MOVE A,-1(A) ;GET FAILING JSYS
CAMN A,[PMAP] ;FAILED IN PMAP?
SOS LPC1 ;YES, CHANGE PC TO RETRY PMAP FROM START
JRST BADIX ;DEBREAK WITHOUT CHANGING PC
;PDL OVERFLOW
PDLOV: JSR EINT1 ;SWITCH CONTEXT
TMSGC <?PDL overflow trap in DUMPER
>
JRST BADINT
;SETUP LEVEL 1 PSI CONTEXT
; JSR EINT1
EINT1A: MOVEM 17,INT1AC+17 ;SAVE ACS
MOVEI 17,INT1AC
BLT 17,INT1AC+16
MOVE P,[IOWD NINTPD,INT1PD] ;SETUP LOCAL STACK
JRST @EINT1
LEVTAB: LPC1
LPC2
LPC3
CHNTAB: PHASE 0
0
CECHN:! 3,,CEINT ;^E
QSRCHN:!3,,QSRINT ;IPCF Msg from QUASAR recv'd
VSCHN:! 3,,VSINT ;LABELED TAPE VOLUME SWITCH
0
0
0
0
0
1,,PDLOV ;STACK OVERFLOW
0
2,,MEMERR ;FILE DATA ERROR
1,,MSETRP ;QUOTA EXCEEDED
0
0
1,,ITRAP ;ILLEG INSTRUCTION TRAP
1,,MEMRTP ;MEM READ
1,,MEMWTP ;MEM WRITE
1,,MEMXTP ;MEM XCT
0
1,,MSETRP ;MACHINE SIZE EXCEEDED
REPEAT ^D35-.ICMSE,<0>
DEPHASE
;PSI RECEIVED ON IO ERROR CHANNEL
MEMERR: MOVEM 17,INT2AC+17
MOVEI 17,INT2AC
BLT 17,INT2AC+16
MOVE P,[IOWD NINTPD,INT2PD] ;SETUP LOCAL STACK
PUSH P,40
MOVE 1,LASTID
CAMN 1,LSTERO
JRST MEMXIT
MOVEM 1,LSTERO
BTMSGC <?Disk error in file >
HLRZ 1,LASTID
GTSTS
TLNN 2,(1B10)
JRST [ BTMSG <(Unknown file name)>
JRST MEMERZ]
HRROI B,NAMBUF
CALL BTMSGQ ;TYPE FILE NAME
HRRZ 2,LASTID ;GET PAGE NUMBER
CAIN 2,-1 ;ON OPENF?
JRST [ BTMSG <, page table>
JRST MEMERZ]
BTMSG <, page >
HRRZ 2,LASTID
MOVEI 3,^D10
CALL TTNOUT ;TYPE PAGE NUMBER
CALL LPNOUT ;PRINT "
MEMERZ: BTMSG <
>
MEMXIT: POP P,40
MOVSI 17,INT2AC
BLT 17,17
DEBRK
SUBTTL LOAD AND CHECK
LIT1: FLDDB. (.CMFIL,CM%SDH,,<file group descriptor>,,LIT2)
LIT2: FLDDB. (.CMCMA,,,,,LIT3)
LIT3: FLDDB. (.CMCFM)
CHCK: SETOM CHECK ;CHECK command
SETZM RETSW ;NOT RETRIEVING
SETOM NJFN1 ;FAKE ACTIVE JFN
HRROI A,[ASCIZ/ALL TAPE FILES/]
CALL NOISE
JRST LOAD2
$RETRI: SKIPN WHEEL
ERROR BMBCM1,<?RETRIEVE requires WHEEL or OPERATOR capabilities enabled>
SETOM RETSW ; Flag we're doing retrievals
TXZ F,USRDAT ; No user data from arc/col/mig tapes
TXOA F,LFILF ; Cause file names to print AND SKIP
$LOAD: SETZM RETSW ;NOT RETRIEVING
SETZM CHECK
SETOM LODARC ;Default is to load archive info
HRROI A,[ASCIZ/TAPE FILES/]
SKIPE RETSW ;Doing retrievals?
HRROI A,[ASCIZ/FILES/] ;YES
CALL NOISE
CALL GETCON ;SAVE CONNECTED DIRECTORY
SKIPE ICMDTY ;SKIP IF NOT UNDER ^E
SKIPN Q1,NIJFN ;PICK UP OLD POINTER, IF ANY
MOVSI Q1,-NJFNL+1 ;INIT PTR TO JFN LIST
LOAD1: MOVEI A,[EXP CSCD,CSWD,WSWD,WSWD] ;POINT TO ROUTINES
CALL FILDFI ;SETUP DEFAULT FILE SPEC
HRROI A,[ASCIZ/DSK*/]
SKIPE RETSW ;RETRIEVING?
MOVEM A,GJBLK+.GJDEV ;YES, DEFAULT STRUCTURE TO DSK*:
MOVX A,GJ%OFG ;SET PARSE-ONLY FOR GTJFN
HLLM A,GJBLK+.GJGEN
MOVEI A,CBLK
MOVEI B,[FLDDB. .CMSWI,,LSWTB,,,FILCDB]
SKIPE RETSW ;RETRIEVING?
MOVEI B,FILCDB ;YES, DON'T ALLOW SWITCHES
COMND
TXNE A,CM%NOP
ERRORJ BMBCM1,<?NOT A SWITCH OR FILESPEC>
LOAD C,CM%FNC,0(C) ; Get code of block used
CAIE C,.CMSWI ; A switch?
JRST LOADF ; No, must be a file name
HRRZ B,0(B) ; Get dispatch
JRST 0(B) ; Do it
; Switch table
LSWTB: NLSWTB,,NLSWTB
TB $NOARC,<NOTAPE-INFORMATION>
TB $LOARC,<TAPE-INFORMATION>
NLSWTB==.-LSWTB-1
$LOARC: SETOM LODARC ; Do load tape info
JRST LOAD1
$NOARC: SKIPE RETSW ; Doing a retrieval?
ERROR BMBCM1,<?Cannot suppress tape information for a retrieval>
SETZM LODARC ; Flag NO tape info
JRST LOAD1
LOADF: CALL ADLIST ;ADD FILE TO JFNSTACK
JUMPGE Q1,[ERROR (BMBCM1,<?TOO MANY ITEMS IN FILESPEC LIST>)]
MOVEM B,JFNLST(Q1) ;SAVE A JFN
SETZM JF2LST(Q1)
AOBJN Q1,.+1
SKIPE RETSW ; Doing retrievals?
JRST LOAD2 ; Yes, we already have output names
HRROI A,[ASCIZ/TO/]
CALL NOISE
CALL OFNAME ;SETUP OUTPUT DEFAULTS
MOVX B,GJ%OFG
HLLM B,GJBLK+.GJGEN
MOVX B,.GJNHG
TXNE F,SSA ;SUPERSEDE ALWAYS?
HRRM B,GJBLK+.GJGEN ;YES, DEFAULT GEN IS NEXT HIGHER
MOVEI B,LIT1
MOVEI A,CBLK ;POINT TO COMMAND BLOCK
COMND ;GET MORE FILESPECS OR TERMINATOR
TXNE A,CM%NOP
ERRORJ BMBCM1,<?INVALID FILE GROUP DESCRIPTOR>
LOAD C,CM%FNC,0(C) ;GET CODE USED
CAIN C,.CMCMA ;COMMA?
JRST LOAD1 ;YES, ANOTHER SOURCE SPEC
CAIE C,.CMCFM ;TERMINATED?
JRST [ CALL ADFILE ;ADD JFN TO JFN STACK
MOVEM B,JF2LST-1(Q1) ;NO, OUTPUT FILESPEC. SAVE JFN
MOVEI B,[FLDDB. (.CMCMA,,,,,[FLDDB. .CMCFM])]
COMND
TXNE A,CM%NOP ;COMMA OR CR?
ERROR BMBCM1,<?NOT A COMMA OR CR>
LOAD C,CM%FNC,0(C) ;YES, SEE WHICH
CAIE C,.CMCFM
JRST LOAD1 ;COMMA, DO MORE
JRST .+1] ;CR, DONE
CALL JFNCFM ;FIX UP JFN STACK FOR CONFIRM
MOVEM Q1,NIJFN ;SAVE IN CASE OF ^E
HRRZM Q1,NJFN1 ;SAVE NUMBER ACTIVE JFNS
MOVNI Q1,0(Q1) ;SAVE NUMBER OF JFNS SETUP
MOVEM Q1,NJFN
JRST LOAD3
LOAD2: CALL CONFRM
LOAD3: TXNN F,TNSF ;SKIP IF TAPE NUMBER SET
SETZM RTAPNO
MOVSI B,-1 ;GET LARGE NEGATIVE NUMBER
MOVEM B,TOTFIL ;INDICATE DON'T HAVE FILE NUMBER YET
SETZM LSTDIR ;NO LAST DIRECTORY
SETOM CDIRN ;NO CONNECTED DIR NOW
TXZ F,TF2 ;CLEAR THIS (NO FILE YET)
SKIPN RETSW ; Some more special code for retrieves?
JRST LODFI1 ; No, go on with the load
CALL QSRINI
ERROR (CDONE,<Retrievals cannot be processed at this time>)
CALL NXTRET ; Get the first of them
ERROR (CDONE,<No retrievals match the specified file descriptor>)
LOAD21: JUMPE P6,LDFLND ; Done?
CALL RETTAP ; Ask for the tape to be mounted
JUMPE P6,LDFLND ; May have been unavailable
; ..
;BEGIN LOADING OF A TAPE
LODFI1: CALL MTOPNR
LODFI2: SETOM CEXFLG ;ALLOW INTERRUPT
TXZN F,TNSF ;SKIP IF TAPE NUMBER SET
AOS RTAPNO ;COUNT TAPES
TMSG <
>
CALL MTRED
JRST [ TMSG < in tape header, record skipped
>
JRST LODHX1]
MOVN A,TYP ;GET RECORD TYPE
CAIE A,TPHDX ;TAPE HEADER?
CAIN A,CTPHX ; OR CONTINUATION
CAIA ;YES, PROCEED
ERROR LODHX2,<%Tape does not start with header, continuing...>
SKIPN RETSW ; Retrievals are quiet
CALL TYHEDR ;TYPE HEADER INFO
MOVEI B,XBUFF
LOAD A,SSNO,(B) ; Saveset # non-0 for arch./col. tape
JUMPN A,[ SKIPN WHEEL ; Must be an enabled WHEEL
ERROR BMBCMD,<?WHEEL or OPERATOR capabilities required to
restore from an archive or virtual disk tape>
SKIPE RETSW ; Doing a retrieval?
JRST .+1 ; Yes, proceed
TMSG <%This tape is an archive or virtual disk tape. It should
%not be used to restore files. This action may breach the security of the
%system.
>
HRROI A,[ASCIZ /$Are you sure you should do this? /]
CALL YESNO
JUMPE A,BMBCM1 ; Said no, exit
SETZM LODARC ; No archive info from the tape
TMSG <%Files being restored without tape information
>
JRST .+1]
HRRZ A,TAPNO ; Tape # in RH on tape
SKIPN RTAPNO ;TAPE # KNOWN?
MOVEM A,RTAPNO ;NO, THEN THIS IS IT
SKIPN RETSW ;NO TAPE# CHECK IF RETRIEVING
CAMN A,RTAPNO ;RIGHT TAPE # MOUNTED?
JRST LODHX1 ;YES, PROCEED WITH LOAD
TXNN F,TF2 ;WRONG TAPE #, IN MIDDLE OF FILE?
JRST LODHX5 ;NO
TMSGC <?Tapes not in order, cannot restore continued file >
HRROI B,TFNAME ;FILE NAME
CALL TMSGQ ;TYPE FILE NAME
CALL MTCLS ;CLOSE MTA
TMSGC <%Mount correct tape>
SKIPL MTTYP ;MT DEVICE?
JRST [ TMSG < and type CONTINUE> ;YES
HALTF ;WAIT FOR USER TO MOUNT TAPE
JRST .+1]
SETZM MTDSG ;FORCE NTAPE TO PROMPT FOR TAPE SPEC
CALL NTAPER ;GET SPEC
JRST BMBCMD ;CAN'T
JRST LODFI1 ;TRY AGAIN
LODHX5: TMSGC <%Tapes not in order, continuing
>
MOVE A,TAPNO
MOVEM A,RTAPNO
LODHX1: MOVSI A,-1
SKIPE RETSW ;RETRIEVING?
TXNE F,TF2 ; AND NOT IN THE MIDDLE OF A FILE?
CAIA
MOVEM A,TOTFIL ;YES TO BOTH, DON'T KNOW FILE# YET
; ..
;LOAD THE NEXT FILE
LODFIL: SKIPE ABTFLG ; QUASAR say to abort this retrieve?
CALL ABTRET ; Yes, do that
JFCL
TXNN F,TF2 ;SKIP TAPE CHECK IF CONTINUED FILE
SKIPN RETSW ; In a RETRIEVE?
JRST LDFIL1 ; No, skip tape check
LOAD A,TPNM2,(P6) ; Get desired tape #
SKIPGE .ARODT(P6) ; Use alternate set?
LOAD A,TPNM1,(P6)
CALL NSVOL ;CONVERT POSSIBLE INTEGER VOLID TO 6BIT
CAME A,VOLID6 ; This the tape?
JRST LOAD21 ; No, next request on another tape
LDFIL1: SKIPN NJFN1 ;ANY ACTIVE JFNS LEFT?
TXNE F,TF2 ; OR CONTINUED FILE?
CAIA ;YES TO EITHER
JRST LDFLND ;NO, ALL DONE
CALL MTRED
JRST [ TMSG < while searching for file
>
JRST LODFIL]
;LOOK FOR BEGINNING OF NEXT FILE OR END OF TAPE
LODHX2: MOVN A,TYP ;GET TYPE CODE
CAIN A,TPTRX ;TAPE TRAILER?
JRST LODEND ;YES
CAIE A,CTPHX
CAIN A,TPHDX ;HEADER?
JRST [ SKIPE RETSW ;YES, DOING RETRIEVALS?
JRST [ MOVSI B,-1 ; Yes, use large neg # to cause
MOVEM B,TOTFIL ; of file numbers
JRST LODFIL] ; Otherwise just keep going
TMSG <
End of saveset
>
CALL BKTPHD ;BACK OVER SAVESET HEADER & CLOSE TAPE
JRST CDONE]
CAIN A,USRX ;USER BLOCK?
JRST LODUSR ;YES
CAIN A,FLTRX ;FILE TRAILER?
JRST [ SKIPGE PAGNO ;YES, FILE CONTINUED ON NEXT VOLUME?
SOS TOTFIL ;YES, IT WILL HAVE THE SAME SEQ# THERE
JRST LODFIL]
CAIE A,CTPHX ;GO ON IF CONTINUED SAVE
CAIE A,FLHDX ;FILE HEADER?
JRST LODFIL ;NO, ASSUME DATA RECORD BEING SKIPPED
CALL LODSBR ;YES, LOAD IT
JRST LODFIL ;LOADED OK - GET NEXT FILE
JRST LODHX2 ;TRAILER RECORD MISSING - ANALYZE THIS RECORD
;HERE WHEN RESTORE/RETRIEVE IS COMPLETED
LDFLND: SKIPE MTJFN ;HAVE JFN ON TAPE?
JRST [ SKIPE NWTBIT ;YES, OVERLAPPING?
SKIPLE MTTYP ; AND UNLABELED?
SKIPA ;NOT BOTH
CALL BACKSP ;YES, UNDO ONE READ AHEAD
SKIPE RETSW ; Retrieval?
CALL UNLOAD ; Yes, spin off the tape
CALL MTCLS
JRST .+1]
SETZ A,
CALL SETMNT ;DISMOUNT MT IF I MOUNTED ONE
JRST CDONE
;HERE WHEN TAPE TRAILER RECORD HAS BEEN READ
LODEND: SETOM CDIRN
SKIPL PAGNO ;SKIP IF TRAILER NOT END OF SAVESET
SKIPE RETSW ; Retrieval?
CAIA ; Cont. saveset or retrieval--go on
JRST [ TMSGC <
End of saveset
>
SKIPG MTTYP ;UNLABELED?
CALL BACKSP ;YES, BACK OVER TAPE TRAILER
CALL MTCLS
JRST CDONE]
TXNN F,TF2 ; File completed?
SKIPN RETSW ; And doing retrieval?
CAIA
JRST [ JUMPN P6,LODENX ; Yes, done with this tape--more ret's?
JRST LDFLND] ; No, all done
MOVEI B,XBUFF
LOAD B,SSNO,(B) ; Saveset #, non-0 for arch/col tape
JUMPN B,[HRROI B,[ASCIZ /%Saveset/]
TXNE F,TF2
HRROI B,[ASCIZ /%File/]
CALL TMSGQC
TMSG < continued on next tape.
>
SKIPN RETSW ; Retrieval run?
JRST LODEN1 ; No, skip retrieval block update
MOVE C,FORMAT ; To identify old arch. tapes
MOVEI B,1 ; Cont'd on saveset 1,TFN n
SKIPGE .ARODT(P6)
JRST [ STOR B,TSN1,(P6) ; Using alternate set
CAIL C,FMTV4 ; Old archive tape?
JRST LODEN1 ; No
SETONE TFN1,(P6) ; Yes, TFN=-1
JRST LODEN1]
STOR B,TSN2,(P6) ; Using alternate set
CAIL C,FMTV4 ; Old archive tape?
JRST LODEN1 ; No
SETONE TFN2,(P6); Yes, TFN=-1
JRST LODEN1]
HRROI B,[ASCIZ/$ End of tape, mount next reel /]
SKIPGE MTTYP ;MTA?
CALL TMSGQC ;YES, PROMPT FOR NEXT TAPE SPEC
TXNN F,TF2 ;SKIP IF FILE BEING RESTORED
;IS CONTINUED ON NEXT REEL
JRST LODEN1
TMSGC <%File >
HRROI B,TFNAME ;FILE NAME
CALL TMSGQ
TMSG < continued on next reel
>
LODEN1: SKIPLE MTTYP ;LABELED TAPE?
JRST LODFI2 ;YES, VOLUME-SWITCH IS AUTOMATIC
SKIPE RETSW ;RETRIEVING
SKIPN MNTDSG ; FROM MOUNTED TAPE?
JRST [ CALL UNLOAD ;NO
CALL MTCLS ;CLOSE MTA
CALL NTAPER ;GET NEXT VOLUME
JRST BMBCMD ;CAN'T
JRST LODFI1] ;OPEN MTA AND CONTINUE
TMSGC <Key in the ID of the next retrieval tape in the set>
CALL GTVOLA ;PROMPT AND GET VOLID
LODEN2: MOVE A,VOLID6 ;GET VOLID
CALL MREQ ;TRY TO MOUNT IT
JRST [ HRROI A,[ASCIZ/Try again? /] ;ERROR
CALL YESNO
JUMPN A,LODEN2 ;TRY AGAIN
HRROI P1,[ASCIZ/Tape currently unavailable
/] ;DON'T TRY AGAIN
CALL RETFAI ;RETRIEVE FAILED FOR THIS FILE
JRST LOAD21] ;GO CHECK FOR MORE RETRIEVALS
CALL MTBOT ;RESET RECORD#
JRST LODFI1 ;TAPE MOUNTED, CONTINUE RESTORE
LODENX: LOAD A,TPNM2,(P6) ; Get desired tape #
SKIPGE .ARODT(P6) ; Should we use alternate set?
LOAD A,TPNM1,(P6) ; Yes
CAME A,VOLID6 ; MATCH THE CURRENT VOLUME?
JRST LOAD21 ; No, go ask for the proper one
TMSG <%End of tape reached and requested file not found
>
HRROI P1,[ASCIZ /End of tape reached and requested file not found/]
CALL RETFAI
JRST LOAD21
;HAVE USER INFO BLOCK
LODUSR: SKIPE WHEEL ;WHEEL LOADING?
SKIPE CHECK
JRST LODFIL ;NO, DON'T CREATE DIRECTORIES
SKIPE BUFF+.CDNUM ;INFORMATION PRESENT?
TXNN F,USRDAT ;LOAD DDB REQUESTED?
JRST LODFIL ;NO, IGNORE
SKIPG FORMAT ; TENEX tape?
ERROR (LODFIL,<?ATTEMPT TO CREATE DIRECTORIES FROM A TENEX TAPE>)
SKIPN B,JF2LST ;HAVE OUTPUT DEFAULT?
JRST LODUSD ;GET NAME FROM TAPE (OR DSK:)
HRROI A,DIRNAM
HRRZS B ;JFN ONLY
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF>
JFNS ;GET DEVICE NAME:
LODUSA: MOVEI B,"<" ;OPEN BRACKET
IDPB B,A ;STASH
MOVE B,A ;SETUP OUTPUT PNTR IN B
MOVE A,[POINT 7,BUFF+UHNAM] ;BEG OF NAME ON TAPE
MOVE C,FORMAT ;SEE WHICH FORMAT
CAIGE C,FMTV3 ;HAVE FULL DIR SPEC?
JRST LODUS2 ;NO - JUST COPY NAME
LODUS1: ILDB C,A ;YES - LOCATE DIRECTORY NAME
CAIE C,"<"
JRST LODUS1 ;LOOP TILL OPEN BRACKET FOUND
LODUS2: ILDB C,A ;GET CHAR IN NAME
CAIE C,">" ;LOOK FOR CLOSE BRACKET OR NULL
JUMPN C,[IDPB C,B ;COPY CHAR IN NOT NULL
JRST LODUS2]
MOVEI C,">" ;TERMINATE DIRECTORY NAME
IDPB C,B
MOVEI C,0 ;ADD NULL TO STRING
IDPB C,B ;...
HRROI B,BUFF
ADDM B,BUFF+.CDPSW ;SET PASSWORD STRING ADDRESS
SKIPE BUFF+.CDLEN ;CHECK FOR LENGTH
ADDM B,BUFF+.CDDAC ;SET DEFAULT ACCOUNT ADDRS
MOVX A,RC%EMO ;CHECK FOR ALREADY EXISTING DIR
HRROI B,DIRNAM ;...
RCDIR
ERJMP .+3 ;ERROR, ASSUME DOESN'T EXIST
TXNN A,RC%NOM!RC%AMB ;EXISTS?
HRRM C,BUFF+.CDNUM ;YES - USE EXISTING NUMBER
MOVE B,CRDWRD ;CRDIR FLAG WORD
LODUST: SKIPE BUFF+.CDLEN ;OLD FORMAT?
TXO B,CD%SDQ!CD%DAC!CD%CUG ;NEW BITS
MOVX A,CD%NSQ ;DO NOT UPDATE SUPERIOR'S QUOTA
IORM A,BUFF+.CDLEN ; NOR CHANGE THE SUPERIOR DIR'S QUOTA
HRROI A,DIRNAM ;LOCATION OF DIRECTORY TO CREATE
CRDIR
ERJMP LODUS9 ;CHECK LOSAGE
HRROI B,DIRNAM
CALL TMSGQ ;TYPE NAME
TMSG < created
>
JRST LODFIL
LODUSD: MOVE C,FORMAT ;SEE IF DEVICE NAME ON TAPE
CAIGE C,FMTV3 ;...
JRST LODUSF ;USE DSK:
MOVE A,[POINT 7,DIRNAM] ;INIT POINTER
MOVE B,[POINT 7,BUFF+UHNAM]
LODUSE: ILDB C,B ;GET A CHAR
JUMPE C,LODUSF ;NO DEVICE - USE DSK:
IDPB C,A ;COPY CHARACTER
CAIE C,":" ;COLON?
JRST LODUSE ;NO - GET MORE
JRST LODUSA ;YES - DONE
LODUSF: MOVE C,[ASCII "DSK:"]
MOVEM C,DIRNAM ;V2 OR EARLIER - USE DSK:
MOVE A,[POINT 7,DIRNAM,27]
JRST LODUSA ;PROCEED
;HERE ON CRDIR FAILURE - CHECK REASON AND TRY AGAIN IF INCORRECT
;DIRECTORY NUMBER
LODUS9: SKIPN BUFF+.CDNUM ;HERE BEFORE?
JRST LODU91 ;YES - FAIL NOW
MOVEI A,.FHSLF ;GET ERROR
GETER
HRRZS B ;ERROR ONLY
CAIE B,CRDIX2 ;ILLEGAL NUMBER?
CAIN B,CRDIX8
SKIPA B,CRDWRD ;GET CRDIR FLAG WORD
JRST LODU91 ;REAL ERROR
TXZ B,CD%NUM ;TRY TO NOT SPECIFY NUMBER
SETZM BUFF+.CDNUM
HRRZS BUFF+.CDLEN ;RESET HEADER
JRST LODUST ;TRY AGAIN
LODU91: TMSG <?Directory >
HRROI B,DIRNAM
CALL TMSGQ
TMSG < not created because,
>
CALL JSERRM
JRST LODFIL ;TRY TO CONTINUE
CRDWRD: 777740,,BUFF ;CRDIR FLAGS AND BUFFER ADDRS
LODSBR: MOVEI A,[CALL CANTLD ;PRINT MESSAGE
TMSG <%File skipped
>
SKIPN RETSW ; Retrieval?
JRST LODCLZ ; No, normal way out
CALL REFUSE ;TELL QUASAR TO HOLD ONTO THIS ONE
CALL NXTRET ; Get the next one
SETOM VOLID6
JRST LODCLZ] ;TRAP ACTION
CALL SETTRP ;SET TRAP FENCE
TXNN F,TF2 ;IF THIS IS NOT A CONTINUED FILE,
AOS TOTFIL ; COUNT THIS FILE
CALL NOFCHK ;CHECK FILE NUMBER
TXZ F,TF2 ;MISSING FILES-- CAN'T BE CONTINUED
TXNE F,TF2 ;SKIP IF FILE NOT CONTINUED
JRST [ SKIPGE A,PAGNO ;GET PAGE NO
CAME A,INIPGN ;SHOULD MATCH
CALL MISFPG ;MISSING PAGES IN FILE
MOVE A,INICNT ;GET SAVED PAGE COUNT
JRST LODSB1 ]
SKIPGE PAGNO ;CONTINUED FILE-DONT LOAD
JRST [ SKIPE RETSW ; Retrieval?
RET ; Yes, skip it quietly
TMSGC <%Partial file >
HRROI B,BUFF
CALL TMSGQ
TMSG < skipped
>
RET] ;GO BACK, SKIP THIS FILE
HRRZ A,BUFF+FHFDB+.FBBYV ;GET PAGE COUNT FOR FILE
LODSB1: MOVEM A,CNTR ;KEEP TRACK OF PAGES WRITTEN
CALL LODTST ;SEE IF THIS FILE SHOULD BE LOADED, GET JFN
JRST [ TXNN F,TF2 ;NO LOAD, IN MIDDLE OF FILE?
RET ;NO, RETURN NOW
SKIPN RETSW ;RETRIEVING?
CALLRET MISFPG ;NO, TELL USER ABOUT MISSING FILE PAGES
CALL REQUE ;REQUEUE REQUEST
ERROR BMBCMD,<?Wrong tape mounted, cannot retrieve continued file
>]
MOVE A,JFN ;PICK UP JFN
MOVX B,OF%WR
TXNE F,TF2 ; Continued file?
TXO B,OF%RD ; Yes, update it
SKIPE CHECK
MOVX B,OF%RD+OF%PDT
OPENF
JRST [ SKIPE CHECK ; On CHECK
CAIE A,OPNX31 ; OFFLINE files are ok
CAIA
JRST .+1
CALL CANTOP
SKIPN RETSW ;RETRIEVING?
RET ;NO
CALL REFUSE ;YES, TELL QUASAR TO HOLD ONTO THIS ONE
CALL NXTRET ;GET NEXT REQUEST
SETOM VOLID6 ;NONE
RET]
;MAIN LOAD LOOP - READ RECORD, MAP PAGE INTO FILE
LODLUP: SKIPE ABTFLG ; QUASAR say to abort?
JRST [ MOVE A,JFN ; Abort this file
TXO A,CZ%ABT
CLOSF ; Do that
JFCL
SETZM JFN
RET] ; Done here
CALL MTRED
JRST [ TMSG < in data or trailer of file >
MOVEI A,.PRIOU
MOVE B,JFN
MOVE C,[1B2+1B5+1B8+1B11+1B14+1B21+1B35]
JFNS
TMSG <
>
JRST LODLUP]
CALL NOFCHK ;CHECK OUT FILE NUMBER
JRST LODEOF ;NO GOOD-- GIVE UP ON THIS FILE
SKIPE TYP ;DATA RECORD?
JRST LODEFL ;NO
SOS CNTR ;COUNT DOWN THIS PAGE
HRLZ B,JFN ;CONSTRUCT IDENT FOR PAGE
HRR B,PAGNO
SKIPE CHECK ;CHECKING?
JRST CHKLUP ;YES
MOVE A,[.FHSLF,,BUFPAG] ;PUT PAGE INTO FILE
MOVX C,PM%RD!PM%WR!PM%EX
PMAP
JRST LODLUP
;HERE WHEN ENCOUNTERED NON-DATA RECORD, LOOK FOR FILE TRAILER
LODEFL: MOVNI A,FLTRX
CAME A,TYP
JRST LODEOF
SETZM INIPGN
SKIPL A,PAGNO ;SKIP IF FILE NOT COMPLETE
TXZA F,TF2 ;BE SURE BIT OFF
JRST [ TXO F,TF2 ;NOTE FILE IS CONTINUED
MOVEM A,INIPGN ;REMEMBER PAGE #
MOVE A,CNTR ;GET CURRENT PAGE COUNTER
MOVEM A,INICNT ;REMEMBER IT FOR SECOND PART
JRST .+1]
SKIPE CHECK ;ONLY CHECKING FILES?
JRST CHKFDB ;YES, GO DO IT
;LOOP TO TRANSFER FDB INFORMATION FROM TAPE TO FILE
MOVSI P1,-.FBLN0
FIXFDB: MOVE A,JFN ;SETUP FDB PROPERLY
MOVE 3,BUFF(P1)
SKIPN WHEEL
SKIPA 2,NWMASK(P1)
MOVE 2,MASK(P1)
TXNE F,ICMODF ;INTERCHANGE MODE?
MOVE B,ICMASK(P1) ;YES, DIFFERENT MASK
HRL A,P1
TXO A,CF%NUD ;NO UPDATE DIRECTORY
TXNE F,ICMODF ; Interchange?
JRST FIXFD0 ; Yes, bypass TENEX stuff
SKIPG FORMAT ; TENEX format tape?
CALL @MSK10X(P1) ; Do any necessary conversion
FIXFD0: SKIPE B
CHFDB
ERJMP [ERRORJ (.+1,<%CHFDB failure>)]
AOBJN P1,FIXFDB
;MAKE FILE INVISIBLE IF NECESSARY
HRLI A,.FBCTL
MOVX B,FB%INV ;GET MASK FOR INVISIBLE BIT
MOVE C,BUFF+.FBCTL ;GET .FBCTL WORD FROM FDB ON TAPE
MOVE D,FORMAT
CAIG D,2 ;OLD-FORMAT TAPE?
JRST [ TLNN C,(1B11) ;YES, OLD INVISIBLE BIT SET?
TDZA C,C ;NO, RESET FB%INV
MOVX C,FB%INV ;YES, SET FB%INV
JRST .+1]
SKIPE RETSW ;RETRIEVING?
SETZ C, ;YES, MAKE SURE FILE IS VISIBLE
CHFDB ;SET FILE VISIBLE
ERJMP .+1 ;IGNORE ERROR (MIGHT BE ON TOPS-20 V3A)
;SET AUTHOR, WRITER STRINGS
TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
JRST FIXFD1 ;DON'T SET AUTHOR OR WRITER
MOVE A,FORMAT ;GET TAPE FORMAT
CAIGE A,FMTV3 ;SKIP IF FMTV3 OR LATER
CALL GTUNS ;CONVERT DIRECTORY #'S TO
;STRINGS FOR OLD TAPES
MOVE A,JFN ;GET FILE'S JFN
HRLI A,.SFAUT ;SET AUTHOR IS FUNCTIN
HRROI B,BUFF+.FBLN0 ;PONT TO NAME
SFUST
ERJMP .+1 ;IGNORE ERROR (MAYBE WRONG SYSTEM)
SKIPN WHEEL ;SET LAST WRITER ONLY IF
;PRIVELEGED OR OPERATOR
JRST FIXFD1
HRLI A,.SFLWR ;SET LAST WRITER IS FUNCTION
HRROI B,BUFF+.FBLN0+10 ;POINT TO NAME
SFUST
ERJMP .+1
FIXFD1: TXNN F,TF2 ;FILE COMPLETELY RESTORED?
CALL ARCFIX ;YES, PUT ARCHIVE INFO IN FDB
TXNE F,TF2 ;SKIP IF FILE COMPLETE
JRST LODCLZ ;NOT FINISHED
;C(P5) := INDEX INTO JFNLST
; SETUP IN LODTST
MOVE A,JFNLST(P5) ;THE SOURCE FILESPEC WHICH MATCHED
TXNN A,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;ANY STARS IN IT?
JRST [ SETZ A, ;NO, THEN DONE WITH IT
EXCH A,JFNLST(P5)
RLJFN
JFCL
SOS NJFN1 ;NOTE ONE LESS ACTIVE JFN IN LIST
JRST .+1]
SKIPN RETSW ; Doing a retrieval?
JRST FIXFD3 ; No, by pass following
MOVX A,GJ%OLD+GJ%XTN ;GET DESIRED FLAGS
MOVEM A,RETBLK+.GJGEN ;SET IN GTJFN BLOCK
MOVEI A,RETBLK ; Point to special blk to restore these
HRROI B,FILNM(P6) ; Point to file name
GTJFN ; Get a handle on the file
JRST [ CALL BADOFP ;BUILD ERROR MESSAGE
CALL WASHOU ; Say it failed & why
CALL NXTRET
SETOM VOLID6 ;CASE OF NO MORE RET'S
JRST LODCLZ]
PUSH P,A ; Save JFN
MOVE A,JFN ; File pages are currently in
TXO A,CO%NRJ ; Save JFN
CLOSF
JFCL
POP P,A
MOVE C,JFN
MOVX B,.ARRST ; Want to restore the file please
ARCF ; Do it
ERJMP [MOVX A,.FHSLF
GETER ; Get the error #
HRRZS B
CAIN B,ARCFX9 ; File already online?
JRST [ HRROI P1,[ASCIZ/ File was already online.
/]
CALL WASHOU ; Delete request & tell user
CALL NXTRET
SETOM VOLID6 ;CASE OF NO MORE RET'S
JRST LODCLZ]
HRLI B,.FHSLF
SETZ C,
HRROI A,TEMPS
ERSTR
JFCL
JFCL
HRROI P1,TEMPS
CALL RETFAI
JRST LODCLZ]
PUSH P,A ; Save JFN
GTAD
MOVE C,A ; Make the file look just read
POP P,A ; Recover JFN
HRLI A,.FBREF
SETO B, ; Entire word
CHFDB
ERJMP .+1 ; If it fails, no worse than never trying
HRRZS A
RLJFN
JFCL
SETZM JFN ;DONE WITH THIS JFN
CALL RETOK ; Tell the user file is back
CALL USAINI ; Init USAGE block
MOVX A,.UTRET ; Is a retrieval
HRRM A,USABLK ; Insert type
LOAD A,AR%PSZ,BUFF+.FBBBT ; Get # pages returned online
MOVEM A,USABLK+10 ; Put it in the blk
LOAD A,AR%RSN,BUFF+.FBBBT
MOVEM A,USABLK+26 ; Put reason it was offline in blk
MOVEI A,BUFF+.FBLN0+10+10 ; Point to ARCF blk
CALL USATAP ; Do tape info
HRROI A,USADIR ; User who requested retrieval
MOVE B,TPRQUS
DIRST
JRST [ TMSG <?DIRST failed while building USAGE block
>
JRST .+1]
MOVEI A,TPACT ; Account for this
MOVEM A,USABLK+6 ; Point to the account
HRROI A,TAPNAM
HRROI B,USASTR
MOVEI C,^D12 ; Max # of characters
MOVEI D,":" ; End on colon
SOUT ; Get structure file was on
SETZ C,
DPB C,B ; End string & get rid of colon
MOVEI A,USASTR ;GET ASCIZ STRUCTURE NAME
HLL A,[POINT 7,0]
MOVEI B,USASSI ;PUT SIXBIT STRUCTURE NAME INTO
CALL SEVSIX ; USASSI
MOVX A,.USENT ; Make an entry
MOVEI B,USABLK
USAGE
ERJMP [ TMSG <%USAGE entry failed in FIXFDB
>
JRST .+1]
CALL NXTRET ; Get the next one
SETOM VOLID6 ; Say no next
FIXFD3: SKIPE RETSW
SOS NJFN1 ; One more completed
TXNE F,LFILF ;TYPE FILE NAMES ?
TXNE F,LTTYF ;AND NOT LOGGINT TO TTY?
JRST LODCLZ
TMSG < [OK]
>
LODCLZ: SKIPN A,JFN ;JFN STILL ACTIVE?
RET ;NO
SKIPLE CNTR ;DID WE FIND ALL THE PAGES?
TXNE F,TF2 ;NO-- BUT IS IT A CONTINUED FILE?
JRST LODCZ1 ;YES, YES-- ALL PAGES OR CONTINUED FILE
TMSGC <%File >
MOVEI A,.PRIOU
MOVE B,JFN ;JFN OF FILE
SETZ C,
JFNS ;NAME OF FILE
TMSG < has page(s) missing
>
LODCZ1:
CLOSF
JRST [ SKIPN CHECK ;CHECK?
CALL JSERR1 ;NO--SHOULD HAVE HAD OPEN FILE
MOVE A,JFN
RLJFN ;COULD BE OFF-LINE FILE FOR CHECK
CALL JSERR1 ;NO, SOMETHING WRONG
JRST .+1]
SETZM JFN
RET
LODEOF: TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE MODE
JRST LODEO1
TMSG <
%File trailer missing for file >
HRROI P1,[ASCIZ/ File trailer missing for file
/]
MOVEI A,.PRIOU
MOVE B,JFN ;JFN OF FILE
SETZ C,
SKIPN RETSW ; Doing a retrieval?
JFNS ;NAME OF FILE
SKIPE RETSW
CALL PRRTFL ; If a retrieve, print ret blk name
TMSG <
>
SKIPE RETSW
CALL RETFAI ; This one failed
LODEO1: CALL LODCLZ ;CLOSE FILE
RETSKP ;SKIP RETURN TO INDICATE TRAILER MISSED
; Routines for TENEX FDB conversion
TIM10X: PUSH P,C
PUSH P,D
HRRZS C ; Need to convert time
MULI C,-1
DIVI C,^D60*^D60*^D24
HRRM C,-1(P) ; Save with old date
POP P,D
POP P,C
RET
CLRMSK: SETZB B,C ; Clear the mask word
RET
ARCFIX: SKIPE LODARC ;SUPPRESS ARCHIVE INFO, OR
SKIPE RETSW ; Doing a retrieval?
RET ; Yes, don't do this stuff then
MOVE A,JFN ; Must close file for FLUSH to work
TXO A,CO%NRJ ; But need the JFN
CLOSF
CALL JSERR1 ; Should work ok
MOVE B,FORMAT ; What style tape is this?
CAIGE B,FMTV4 ; Greater than release 3?
JRST OLDAFX ; No, fixup from old style
SKIPN WHEEL ;PRIVILEGED?
JRST ARCFI2 ;NO, CAN'T DO ARCF STUFF SO DON'T TRY
HLLZ D,BUFF+.FBBBT ; Get archive bits
TXZ D,AR%1ST ; This has been done already
JUMPE D,ARCFI1 ; None set, skip this part
HRRZ A,JFN ; JFN for this file
MOVX B,.ARRAR ; Request for archive
MOVX C,.ARSET ; Set it
TXNE D,AR%NDL ; No flush please?
TXO C,AR%NDL ; Yes, flag that
TXNE D,AR%RAR ; Was it requested?
ARCF ; Yes, reset that
ERCAL ARCFF
MOVX B,.ARRIV
MOVX C,.ARSET
TXNE D,AR%RIV ; Involuntary request?
ARCF ; Yes
ERCAL ARCFF
MOVX B,.ARNAR
MOVX C,.ARSET
TXNE D,AR%NAR ; Resist archive?
ARCF ; Yes,
ERCAL ARCFF
MOVX B,.AREXM
TXNE D,AR%EXM ; Exempt from archiving?
ARCF ; Yes, set that
ERCAL ARCFF
ARCFI1: MOVE A,[BUFF+.FBLN0+20,,ARSSTB]
BLT A,ARSSTB+.ARPSZ ; Copy tape info
SETZ B, ; No flags yet
SKIPE ARSSTB+.ARTP1 ; 1st tape exist?
TXO B,AR%O1 ; Yes, set that
SKIPE ARSSTB+.ARTP2 ; 2nd tape exist?
TXO B,AR%O2 ; 2nd exists
JUMPE B,ARCFI2 ; Neither tape there, skip this
MOVE C,BUFF+.FBCTL
TXNE C,FB%OFF ; Was it offline?
TXO B,AR%OFL ; Yes, do that too
TXNE C,FB%ARC ; Was it archived?
TXO B,AR%ARC ; Yes, do that too
MOVEM B,ARSSTB+.AROFL ; Put bits into block
HRRZ A,JFN
MOVX B,.ARSST ; Set the status
MOVEI C,ARSSTB
ARCF ; Set it
ERCAL ARCFF
ARCFI2: MOVE A,JFN
RLJFN ; Done with it & CLOSF in LODCLZ will lose
JFCL
SETZM JFN ; No longer valid
RET ; Done here
ARCFF: TMSGC <%ARCF failure, >
CALLRET JSERRM
;CONVERT DIRECTORY NUMBER TO STRING FOR OLD TAPES
GTUNS: HLRZ B,BUFF+.FBUSE ;LAST WRITER FIELD OF OLD .FBUSE
;WORD OF FDB
HRLI B,USRLH ;SAY IT IS A USER #
HRROI A,BUFF+.FBLN0+10 ;STORE IN LAST WRITER FIELD
SETZM 0(A) ;IN CASE FAILURE - USE NULL
DIRST
ERJMP .+1
HRRZ B,BUFF+.FBUSE ;AUTHOR FIELD OF OLD .FBUSE
;WORD OF FDB
HRLI B,USRLH ;SAY IT IS A USER NUMBER
HRROI A,BUFF+.FBLN0 ;STORE IN AUTHOR FIELD
SETZM 0(A) ;USE NULL IF FAILURE
DIRST
ERJMP .+1
RET
; NOFCHK -- CHECK FILE NUMBER FOR PROPER SEQUENCE
NOFCHK: HLLZ A,PAGNO ;GET PAGE NUMBER/FILE NUMBER WORD
TXCE A,PGNCFL!PGNNFL ;OLD FORMAT TAPE (WITH JFN IN LH!)?
TXZN A,PGNCFL!PGNNFL ; OR WITH -1 IN LH?
RETSKP ;OLD TAPE-- MUST ASSUME OK
SKIPGE TOTFIL ;FIRST TIME HERE?
JRST [ HLRZM A,TOTFIL ;YES, INITIALIZE FILE COUNTER
MOVEI A,1 ;GET NUMBER FOR FIRST FILE AND TAPE
CAMN A,RTAPNO ;IF NOT THE FIRST TAPE IN SEQUENCE
CAMN A,TOTFIL ;OR IF THIS IS REALLY THE FIRST FILE
RETSKP ;THEN EVERYTHING IS FINE
JRST NOFCHE] ;OTHERWISE FILES REALLY MISSING
HRLZ B,TOTFIL ;GET FILE COUNT TO LH
TXZ B,PGNCFL!PGNNFL ;CLEAR FLAG BIT PART
CAMN A,B ;FILE COUNT MATCH TAPE FILE NUMBER?
RETSKP ;YES-- ALL OK
HLRZM A,TOTFIL ;NO-- ADJUST COUNTER
NOFCHE: TMSGC <%Tape has file(s) missing
>
RET ;RETURN +1 FROM NOFCHK TO INDICATE FILE
; SEQUENCING ERROR
; Here to do archive info if old style archive tape (only BBN should
; have this kind of tape)
OLDAFX: SKIPN WHEEL ;ENABLED?
JRST ARCFI2 ;NO, SKIP ARCF'S
HLLZ D,BUFF+.BBNBT ; Get bits etc, were in BK0
TXZ D,1B0 ; Partially dumped flag already done
JUMPE D,OLDAF1 ; No bits to handle
TXZE D,1B6 ; Old AR%1ST
JRST [ HRLI A,.FBBBT ; Must set it
MOVX B,AR%1ST
MOVE C,B
CHFDB
ERJMP [ERRORJ (.+1,<%CHFDB failure in OLDAFX>)]
JRST .+1]
HRRZ A,JFN
MOVX B,.ARRAR ; Put in the request
MOVX C,.ARSET
TXNE D,1B3 ; Old AR%NDL (was AR%NFH)
TXO C,AR%NDL ; Was on, restore it
TXNE D,1B1 ; Old AR%RAR bit
ARCF ; Set it
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
MOVX B,.ARRIV ; Migration request?
MOVX C,.ARSET
TXNE D,1B2 ; Old AR%RIV
ARCF ; Do it if necessary
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
MOVX B,.ARNAR ; Do resist
MOVX C,.ARSET
TXNE D,1B4 ; Old AR%NAR
ARCF ; Set if necessary
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
MOVX B,.AREXM ; File exempt
TXNE D,1B5 ; Old AR%EXM
ARCF
ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
; Now convert tape info to correct form for new style ARCF
OLDAF1: MOVEI C,ARSSTB ; Where the data will be
MOVX A,AR%O1+AR%O2+AR%ARC ; Do both tapes & will be archived
MOVEM A,.AROFL(C) ; Into flags word
SKIPN A,BUFF+.BBNTP ; Get old tape #'s
JRST ARCFI2 ; No tape #'s to do
HLRZM A,.ARTP1(C) ; Tape 1 ID
HRRZM A,.ARTP2(C) ; Tape 2 ID
MOVE A,BUFF+.BBNTS ; Get Save Set Numbers
HLLM A,.ARSF1(C) ; Save set # 1
HRLM A,.ARSF2(C) ; Save set # 2
MOVE A,BUFF+.BBNTF ; (old .FBBK3) Get TFN's
HLRM A,.ARSF1(C) ; Tape file # 1
HRRM A,.ARSF2(C)
MOVE A,BUFF+.FBNET ; (old .FBBK4) Get tape date & time
MOVEM A,.ARODT(C)
MOVX A,AR%OFL
MOVE B,BUFF+.FBCTL
TXNE B,1B12 ; Old FB%OFF
IORM A,.AROFL(C) ; Should be flushed too
HRRZ A,JFN
MOVX B,.ARSST ; Set archive status
ARCF
ERJMP [TMSG <%ARCF failed to set tape information in OLDAFX
>
JRST ARCFI2]
JRST ARCFI2 ; Done here
;TEST NEXT FILE ON TAPE FOR INCLUSION IN CURRENT LOAD SPEC
; RETURN +1: DON'T LOAD
; RETURN +2: LOAD
LODTST: SKIPG FORMAT ;NEW FORMAT VERSION PUNCTUATION?
CALL FIXFMM ;NO, FIXUP FIRST
SKIPE CHECK ;check?
JRST [ HRROI A,ONMBUF ;YES-- COPY FILE NAME
HRROI B,BUFF ; FROM TAPE BUFFER
SETZ C,
SOUT
MOVX A,GJ%OLD+GJ%XTN ;GET FLAGS
MOVEM A,RETBLK+.GJGEN ;SET IN GTJFN BLOCK
MOVEI A,RETBLK ;POINT AT USEFUL EXTENDED BLOCK
HRROI B,ONMBUF ;LOOKUP EXACTLY AS ON TAPE
GTJFN
JRST CANNOT
MOVEM A,JFN
HRROI A,TFNAME ;GET READY
MOVE B,JFN ;TO COPY FILE SPEC
SETZ C, ;SO CAN TYPE IT OUT
JFNS ;IN CASE OF ERRORS
CALL FILSZE ;COMPUTE FILE SIZE
JRST LODCHK]
SKIPE RETSW ;RETRIEVING?
JRST LODRET ;YES, SPECIAL HANDLING
HRROI B,BUFF
CALL TSTNAM ; See name matches specs given
JRST [ MOVEM A,JFN ; Save it for
JRST LODTNO] ; fail path
MOVEM A,JFN ;TSTNAM RETURNS JFN IN A
;MATCHED ALL FIELDS, THIS FILENAME OK TO LOAD. NOW CHECK DATES
MOVE A,BUFF+FHFDB+.FBCRE ;GET MODIFIED DATE
CAMG A,MBTAD ;NOT 'BEFORE'?
CAMGE A,MSTAD ;NOT 'AFTER'?
JRST LODTNO
MOVE A,BUFF+FHFDB+.FBWRT ;GET WRITE TAD
CAMG A,WBTAD ;NOT 'BEFORE'?
CAMGE A,WSTAD ;NOT 'SINCE'
JRST LODTNO ;YES, FAIL
CAMGE A,BUFF+FHFDB+.FBREF ;GET MOST RECENT OF WRITE, READ
MOVE A,BUFF+FHFDB+.FBREF
CAMG A,ABTAD ;NOT 'BEFORE'
CAMGE A,ASTAD ;NOT 'SINCE'
JRST LODTNO ;YES, FAIL
;NOW COOK UP APPROPRIATE OUTPUT NAME
; P5/ INDEX TO JFNLST AND JF2LST TABLES
CALL GOFNAM ;GET OUTPUT NAME INTO ONMBUF
TXNN F,TF2 ;CONTINUED FILE?
JRST LODNM6 ;NO-- ALL OK
PUSH P,A ;SAVE CURRENT POINTER
MOVE A,OGNPTR ;YES-- GET GENERATION POINTER
ILDB B,A ;GET START OF GENERATION
CAIE B,"." ;SPECIFIED?
JRST LODNM5 ;NO-- SKIP CHECK FOR NEXT HIGHEST VERSION
MOVEI C,^D10 ;YES, GET IT
NIN ;IN DECIMAL
JRST LODNM5 ;NO SUCH LUCK
AOJN B,LODNM5 ;IF NOT -1, DON'T CHANGE IT
MOVE A,OGNPTR ;GEN IS -1 (NEXT HIGHEST): MUST USE HIGHEST SO
MOVEM A,(P) ; DON'T SPECIFY GEN, GTJFN WILL GET HIGHEST
IDPB B,A ;MARK END OF FILENAME WITHOUT GENERATION
LODNM5: POP P,A ;RESTORE POINTER TO FILE STRING
LODNM6: CALL GOFPAT ;GET PROTECTION, ACCOUNT, ;T
; ..
; ..
LODNM7: HRROI A,TFNAME ;TAPE FILE NAME BUFFER
MOVE B,JFN
SETZ C,
JFNS ;STORE FILE NAME FOR LATER
MOVE A,JFN ;DONE WITH LOCAL JFN ON NAME FROM TAPE
RLJFN
JFCL
;CHECK SUPERSEDE RULE
TXNE F,SSA!TF2 ;SUPERCEDE ALWAYS OR MIDDLE OF FILE?
JRST LODNM3 ;YES, NO CHECK
LODNM8: ILDB D,OGNPTR ;GET FIRST BYTE OF GENERATION
SETZ A, ;STORE A NULL
DPB A,OGNPTR ; SO WE LOOKUP HIGHEST EXISTING GENERATION
MOVX A,GJ%OLD+GJ%XTN ;GET DESIRED FLAGS
MOVEM A,RETBLK+.GJGEN ;AND SET IN GTJFN BLOCK
MOVEI A,RETBLK ;POINT AT BLOCK WITH G1%IIN FLAG SET
HRROI B,ONMBUF ; . .
GTJFN ;GET MOST RECENT VERSION
JRST [ DPB D,OGNPTR ;ISN'T ONE, RESTORE BYTE OF GENERATION
JRST LODNM3] ; AND GO LOAD FILE
DPB D,OGNPTR ;RESTORE THE BYTE WE BIT
MOVEM A,JFN
TXNE F,SSN ;SUPERSEDE NEVER?
JRST LODTNO
MOVSI B,.FBLN0
MOVEI C,FDB
GTFDB ;GET FDB OF EXISTING FILE
ERJMP [CALL JSERR1 ;SCREWUP...
JRST .+1]
MOVE B,FDB+.FBWRT ;GET WRITE DATE OF EXISTING FILE
CAML B,BUFF+FHFDB+.FBWRT ;WHICH FILE IS NEWER?
JRST LODTNO ;DISK FILE IS NEWER, DON'T LOAD FROM TAPE
LOAD B,FB%GEN,BUFF+FHFDB+.FBGEN ;GET GEN NUMBER OF TAPE FILE
LOAD C,FB%GEN,FDB+.FBGEN ;GET GEN NUMBER OF EXISTING DISK FILE
CAML B,C ;NEWER (TAPE) FILE HAS HIGHER GEN NO?
JRST LODNM9 ;YES, OK
TMSG <%File > ;No, must delete disk file to prevent
MOVEI A,.PRIOU ; GENERATION MIS-ORDERING
MOVE B,JFN
MOVX C,1B2+1B5+1B8+1B11+1B14+1B35
JFNS ;TYPE WARNING MESSAGE
TMSG < deleted while superseding
>
MOVE A,JFN
DELF ;DELETE (NO EXPUNGE) DISK FILE
CALL JSERR1
JRST LODNM8 ;SEE IF OTHER DISK FILES NEED DELETING
LODNM9: MOVE A,JFN ;NOW DONE WITH LOCAL JFN
RLJFN
JFCL
;NOW GET JFN FOR ACTUAL DISK FILE TO BE WRITTEN
LODNM3: MOVX A,GJ%XTN ;SET TO GET JFN FOR FILE TO BE WRITTEN
TXNN F,TF2 ;CONTINUED FILE?
TXO A,GJ%FOU ;NO-- USE NEXT HIGHEST GEN IF 0 SUPPLIED
MOVEM A,RETBLK+.GJGEN ;SET IN BLOCK
MOVEI A,RETBLK
HRROI B,ONMBUF ;POINT TO FILENAME STRING
LODN31: GTJFN
SKIPA ;ERROR-- CHECK IT OUT
JRST LODN39 ;GOT IT-- GO ON
;ERROR FROM GTJFN-- SEE IF BECAUSE OF INVALID ACCOUNT
CAIE A,VACCX0 ;FAILED-- INVALID ACCT?
JRST CANNOT ;NO-- GIVE UP
MOVE D,OACPTR ;YES-- GET POINTER TO ACCT
ILDB A,D ;GET FIRST CHARACTER OF ACCT
CAIE A,";" ;IS ACCT SPECIFIED?
JRST CANNOT ;NO-- GIVE UP
TMSG <%Invalid account for file >
HRROI B,ONMBUF ;POINT TO FILE SPEC
CALL TMSGQ ;TYPE FILE SPEC
TMSG <, system default used
>
SETZ A, ;USE
DPB A,D ; SYSTEM DEFAULT
JRST LODNM3 ; AND TRY AGAIN
LODN39: MOVEM A,JFN
;SEE IF THIS FILE GOING TO DIFFERENT DIRECTORY THAN LAST FILE
LODNMA: SKIPE RETSW ; Doing retrievals?
JRST LODNM4 ; Yes, forget this message
HRROI A,DIRNAM
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS
HRROI A,DIRNAM
HRROI B,LSTDIR
STCMP ;CHECK DIR NAME STRINGS
JXE A,SC%LSS+SC%SUB+SC%GTR,LODNM4
HRROI B,DIRNAM ;STRINGS DIFFERENT, SET NEW CURRENT DIR
HRROI A,LSTDIR
SETZ C,
SOUT
TMSG <Loading file(s) into >
MOVEI A,.PRIOU
MOVE B,JFN
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS ;TYPE NEW DIRECTORY
TMSG <
>
;type file name if requested
LODNM4: TXNN F,LFILF ;TYPE FILE NAMES?
JRST LODNMX ;NO
HRROI B,BUFF ;YES, SOURCE
CALL TMSGQ
TMSG < (TO) >
SKIPE RETSW
JRST [ HRROI B,FILNM(P6)
SETZB C,D
SOUT
JRST LODNMX]
MOVE B,JFN
MOVEI A,.PRIOU
MOVX C,2B2+2B5+1B8+1B11+1B14+1B35
JFNS ;DESTINATION
JRST LODNMX
; SPECIAL LODTST CODE FOR RETRIEVALS
LODRET: LOAD A,TPNM2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TPNM1,(P6) ; Use alternate tape
CALL NSVOL ;CONVERT TO SIXBIT
CAME A,VOLID6 ;DOES VOLID MATCH CURRENT TAPE?
TXNE F,TF2 ;MISMATCH OK IF CONTINUED FILE
CAIA
RET ; No, skip it
LOAD A,TSN2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TSN1,(P6)
MOVEI C,XBUFF
LOAD B,SSNO,(C) ; Get saveset # from tape
CAIE A,0(B) ; Savesets match?
RET ; No, skip it
LOAD A,TFN2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TFN1,(P6) ; Use alternate
HLRZ B,PAGNO
TXZ B,(1B0+1B1) ; Clear info bits
CAIE A,0(B) ; Tape file #'s match?
RET ; No, skip file
HRROI A,TEMPS ; Place to build a string
HRROI B,FILNM(P6) ; Point to file name we want
MOVEI C,6+1+1+^D39+1 ; Maximum device size
MOVEI D,">" ; Stop at the directory field
SOUT
HRROI B,[ASCIZ/RETRIEVE.TEMP-FILE;T/]
SETZB C,D
SOUT
TXNN F,TF2 ; Continued file?
JRST LODRE1 ; No, just make the temp file
MOVX A,GJ%OLD+GJ%SHT
HRROI B,TEMPS
GTJFN ; Exist?
JRST LODRE1 ; No, just create it
MOVEM A,JFN ; Save the JFN
JRST LODNMA
LODRE1: MOVX A,GJ%FOU+GJ%SHT
HRROI B,TEMPS
JRST LODN31
LODCHK: TXNN F,LFILF ;SKIP IF WANT FILE NAMES
JRST LODNMX ;NOPE
HRROI B,BUFF ;SOURCE
CALL TMSGQ ;TYPE NAME
TMSG <
>
LODNMX: MOVE A,JFN ;RETURN THE OUT JFN
RETSKP ;PASSES ALL TESTS, LOAD IT
;RETURN NO-LOAD AND RELEASE LOCAL JFN
LODTNO: MOVE A,JFN
RLJFN
JFCL
RET
;ROUTINE TO CHANGE ";" TO "."
FIXFMM: PUSH P,A ;SAVE REGS
PUSH P,B ;""
PUSH P,C
PUSH P,D
PUSH P,D+1
TXZ F,FST%PN ; Clear first seen flag
MOVE A,[POINT 7,BUFF] ;WHERE THE NAME IS
MOVE B,[POINT 7,TEMPS] ; Where to build temp
FIXF1: ILDB C,A ;GET BYTE
JUMPE C,FIXF2 ;JUMP IF END
CAIN C,"V"-100 ;QUOTE?
JRST [ ; Quoted, force into line
IDPB C,B
ILDB C,A
IDPB C,B
JRST FIXF1] ; Loop for more
IDIVI C,^D36 ; Find which word&bit to check
MOVSI D+1,(1B0)
MOVNS D
ROT D+1,0(D) ; Put in correct position
TDNN D+1,QUTBIT(C) ; Special character?
JRST FIXNO ; No, just copy it
MOVEI C,"V"-100
IDPB C,B
LDB C,A
IDPB C,B ; And special character
JRST FIXF1
FIXNO: LDB C,A ; Retrieve character
CAIN C,";"
TXOE F,FST%PN ; Set ";" seen flag, skip if done once
CAIA
MOVEI C,"." ; Replace first with "."
IDPB C,B
JRST FIXF1
FIXF2: SETZ C,
IDPB C,B ; End new string
MOVE A,[POINT 7,BUFF]
MOVE B,[POINT 7,TEMPS]
FIXF21: ILDB C,B
IDPB C,A
JUMPN C,FIXF21
POP P,D+1
POP P,D
POP P,C
POP P,B
POP P,A
RET
; Special character table; if bit is on, character needs to be quoted for
; use on TOPS20
QUTBIT: EXP 377777777777 ; ^@ to #
EXP 777100022600 ; $ to G
EXP 000000377777 ; H to k
EXP 777777600000 ; l to rubout
CHKLUP: MOVE A,B
MOVE B,[XWD 400000,BF2PAG]
MOVSI 3,100000
PMAP
TXNN F,ICMODF ;SKIP IF INTER CHANGE FORMAT
JRST CHKLP1 ;CHECK EVERYTHING
SOSGE FPGCNT ;DECREMENT PAGE COUNT
JRST CHKLP2 ;DONE WITH ALL FULL PAGES
CHKLP1: MOVSI P1,-1000
CMPLUP: MOVE A,BUFF(P1)
SKIPA B,BUFF2(P1) ;GET FILE WORD
ERJMP CMPERR ;IF PAGE NONEXISTANT, COMPARE ERROR
CAME A,B
JRST CMPERR
AOBJN P1,CMPLUP
CMPLP2: JRST LODLUP
CMPERR: TMSG <%Compare error>
CMPER1: TMSG <, page >
HRRZ B,PAGNO
MOVEI C,12
CALL TTNOUT
TMSG <, file >
MOVE B,JFN
MOVEI C,0
JFNS
TMSG <
>
JRST LODLUP
CHKLP2: SKIPN P1,RMRPGE ;SKIP IF PARTIAL PAGE
JRST CMPLP2 ;ALL DONE
MOVNS P1 ;SET UP FOR AOBJN LOOP
HRLZS P1
SETZM RMRPGE ;DONT TRY AGAIN
JRST CMPLUP ;CHECK PARTIAL PAGE
CHKFDB: MOVNI A,1
MOVE B,[.FHSLF,,BF2PAG]
SETZ C,
PMAP
TXNE F,TF2 ;CONTINUED FILE?
JRST LODCLZ ;YES, ONLY CHECK AUTHORS WHEN ALL DONE
MOVE A,JFN
MOVE B,[XWD 25,0]
MOVEI 3,BUFF2
GTFDB
MOVSI P1,-25
CHKFDL: MOVE A,BUFF(P1)
XOR A,BUFF2(P1) ;COMPARE WORDS
AND A,CKMASK(P1) ;BUT CHECK ONLY CERTAIN BITS
TXNE F,ICMODF ;INTERCHANGE MODE?
AND A,ICMASK(P1) ;YES, FEWER BITS PERTINENT
JUMPN A,FDBERR ;JUMP IF COMPARED BITS DIFFERENT
CHKFD0: AOBJN P1,CHKFDL
MOVE A,FORMAT ;GET CURRENT FORMAT
CAIL A,FMTV3 ;SKIP IF OLD TAPE
TXNE F,ICMODF ;SKIP IF NOT INTERCHANGE FORMAT
JRST LODCLZ ;DON'T CHECK AUTHER &LAST WRITER
HRR A,JFN ;JFN OF FILE
HRLI A,.GFAUT ;FUNTCION IS GET AUTHOR
HRROI B,FBUF1 ;STORE STRING HERE
GFUST
ERJMP [SETZM FBUF1
JRST .+1]
HRROI A,FBUF1 ;AUTHOR
HRROI B,BUFF+.FBLN0 ;COMPARE TO TAPE
STCMP
SKIPE A ;SKIP IF STRINGS ARE SAME
CALL [ TMSG <%File author differs for file >
MOVE B,JFN
MOVEI A,101
MOVEI C,0
JFNS
TMSG <
>
RET ]
HRR A,JFN
HRLI A,.GFLWR ;GET LAST WRITER
HRROI B,FBUF1
GFUST
ERJMP [SETZM FBUF1
JRST .+1]
HRROI A,FBUF1 ;LAST WRITER
HRROI B,BUFF+.FBLN0+10 ;CHECK AGAINST TAPE
STCMP
SKIPE A ;SKIP IF SAME
CALL [ TMSG <%File last-writer differs for file >
MOVE B,JFN
MOVEI A,101
MOVEI C,0
JFNS
TMSG <
>
RET ]
JRST LODCLZ
FDBERR: TMSG <%Difference in >
MOVE B,FDBNAM(P1)
MOVEI A,0
ROTC A,6
JUMPE A,FDBER9
ADDI A,40
PBOUT
JRST .-5
FDBER9: TMSG < of file >
MOVE B,JFN
MOVEI 1,101
MOVEI C,0
JFNS
TMSG <
>
JRST CHKFD0
;FAILED TO GTJFN FOR FILE TO BE LOADED
CANNOT: TMSGC <%Cannot get JFN for file >
JRST CANT1
CANTOP: MOVE A,JFN
RLJFN
JFCL
TMSGC <%Cannot open file >
JRST CANT1
CANTLD: TMSGC <%Cannot load file >
CANT1: HRROI B,ONMBUF ;FILESPEC STRING
SKIPE RETSW ; %%% Repair when QUASAR interface ready
HRROI B,TAPNAM
CALL TMSGQ
TMSG < because:
>
CALL JSERRM
RET
PRRTFL: HRROI B,FILNM(P6) ; Point into retrieve blk
SETZB C,D ; %%% Repair
SOUT
RET
;TYPE HEADER INFORMATION
TYHEDR: MOVEI A,.PRIOU
CALL PRHEDR ;HEADER TO PRIMARY OUT
TMSG <
>
MOVE B,FORMAT
CAIN B,CURFMT ;CURRENT FORMAT?
JRST TYH1 ;YES
TMSG <%Tape is format version >
MOVE B,FORMAT
MOVEI C,^D10
CALL TTNOUT
TMSG <, not current
>
TYH1: RET
;CONSTRUCT HEADER INFORMATION
; A/ OUT DESIGNATOR
PRHEDR: STKVAR <OUTD>
MOVEM A,OUTD ;SAVE DESIGNATOR
SKIPL MTTYP ;MT DEVICE?
CALL GTVOL ;YES, GET VOLID IN VOLID6
MOVE A,OUTD ;RESTORE DESIGNATOR
HRROI B,[ASCIZ /
DUMPER tape/]
SETZ C,
SOUT
MOVEI B,XBUFF ;VIRTUAL DISK TAPE?
JE SSCOD,(B),[HRROI B,[ASCIZ/ # /] ;NO, DISPLAY TAPE #
SOUT
HRRZ B,TAPNO
MOVEI C,^D10
NOUT ;PUT TAPE # IN MESSAGE
JFCL
SETZ C,
JRST .+1]
SKIPE VOLID6 ;KNOW VOLID?
JRST [ HRROI B,[ASCIZ/ Volid /] ;YES
SOUT
HRROI B,VOLID ;DISPLAY VOLID
SOUT
JRST .+1]
HRROI B,[ASCIZ /, /]
SOUT
MOVEM A,OUTD ;SAVE OUT DESIG
CALL SETHDR ;CHECK FORMAT TYPE AND GET TEXT ADR
HRROI B,BUFF(A)
MOVE A,OUTD
SOUT ;INCLUDE SAVE SET NAME
SKIPN FORMAT ;BBN FORMAT?
RET ;YES, NO MORE INFORMATION
HRRZ B,BUFF+BFMSGP ;NO, GET MSG OFFSET
CAIG B,BFTAD ;BEYOND TAD WORD?
RET ;NO, THEREFORE NO TAD WORD
HRROI B,[ASCIZ /, /]
SOUT
MOVE B,BUFF+BFTAD ;GET BEGINNING TAD
MOVX C,3B2+1B10+1B12
ODTIM ;PUT IT IN MESSAGE
RET
;ROUTINE TO LOOK AT TAPE HEADER AND DETERMINE FORMAT TYPE
;RETURN +1 ALWAYS, A/ OFFSET ADR TO TITLE STRING
SETHDR: MOVE B,BUFF ;GET FIRST WORD OF BUFFER
SETZ A, ;ASSUME OLD FORMAT
SETZM FORMAT ;""
TLNE B,(177B6) ;IS IT ASCII?
RET ;YES
MOVEM B,FORMAT ;SAVE DATA FORMAT
MOVE A,BUFF+BFMSGP ;GET OFFSET FOR THE TITLE
RET ;RETURN
SUBTTL MAGTAPE BUFFERED IO ROUTINES
; MTOPNR - OPEN MAGTAPE FOR READING OR SKIPPING RECORDS
; MTOPNW - OPEN MAGTAPE FOR WRITING RECORDS
; MTOPNX - OPEN MAGTAPE FOR REWIND OR STATUS-GATHERING OPERATION
; RETURNS +1: ALWAYS
MTOPNX: MOVEI A,OF%RD ;OPEN FOR READ
JRST MTOP0 ;DON'T HAVE TO SET DATA MODE
MTOPNR: SKIPA A,[OF%RD] ;OPEN FOR READ ACCESS
MTOPNW: MOVEI A,OF%WR ;OPEN FOR WRITE ACCESS
TLO A,(1B0) ;INDICATE NEED TO SET DATA MODE
MTOP0: MOVEM A,TMODE ;SAVE MODE REQUEST
MTOP1: SKIPE A,MTJFN ;HAVE JFN?
JRST [ GTSTS ;YES
TXNE B,GS%OPN ;IS IT OPEN?
CALL MTCLS ;YES, CLOSE AND DISCARD
JRST .+1]
SKIPE A,MTJFN ;SKIP IF NO JFN ASSIGNED
CALL RLSJFN ;RELEASE JFN
MOVE A,MTDSG ;GET LAST MTA DESIGNATOR
JUMPE A,MTOP4 ;NO TAPE COMMAND GIVEN SO FAR
MOUNT
ERROR MTOFAI,<?FAILED TO MOUNT MTA, >
HRROI B,MTDEV
MOVX A,GJ%SHT
GTJFN
ERROR MTOFAI,<?FAILED TO FIND MAGTAPE, >
MOVEM A,MTJFN ;SAVE JFN
MOVX B,<FLD 17,OF%MOD> ;REQUEST DUMP MODE
HRR B,TMODE ;READ/WRITE AS SPECIFIED BY CALLER
IFN DSKDMP, <MOVX B,OF%RD+OF%WR> ;ALLOW UPDATE
OPENF
ERROR MTOFAI,<?FAILED TO OPEN MAGTAPE, > ;NO
IFN DSKDMP, <MOVE B,SEQ ;# RECORDS DOWN "TAPE"
IMULI B,NHEAD+PGSIZ ;RECORD SIZE
SFPTR ;SET PTR BACK THERE
CALL JSERRM>
SKIPLE MTTYP ;LABELED TAPE?
JRST [ MOVEI B,.MOPST ;YES
MOVEI C,VSCHN
MTOPR ;SET UP TO GET VOLUME-SWITCH INTERRUPTS
ERCAL R ;IGNORE FAILURE
MOVEI B,.MOSDS
MOVE C,TMODE
TXNE C,OF%WR ;OPEN FOR WRITE?
MTOPR ;YES, SET DEFERRED VOLUME-SWITCH
ERCAL R ;IGNORE FAILURE
JRST .+1]
SKIPG MTTYP ;UNLABELED?
JRST [ MOVEI B,.MOSDN ;YES, SET DENSITY PER REQUEST
MOVE C,DENSIT
MTOPR
ERJMP [TMSGC <%UNABLE TO SET DENSITY, JOB DEFAULT USED
>
JRST .+1]
MOVEI B,.MOSPR ;SET PARITY PER REQUEST
MOVE C,PARITY
MTOPR
ERJMP .+1
JRST .+1]
SKIPGE TMODE ;WANT TO SET DATA MODE?
CALL SETMOD ;YES, DO IT
;SET BLOCKING-FACTOR
TXNE F,ICMODF ;FOR INTERCHANGE FORMAT,
JRST [ MOVEI A,1 ; USE BLOCKING FACTOR
MOVEM A,TAPBKF ; OF 1 ALWAYS
JRST MTOPB9]
MOVE A,TMODE ;GET I/O MODE
TXNE A,OF%WR ;WRITE?
SKIPE TAPBKF ;YES-- TAPE BLOCKING FACTOR ALREADY KNOWN?
JRST MTOPB9 ;YES-- (OR READ) USE EXISTING TAPBKF
MOVE A,MTJFN ;GET TAPE JFN
MOVX B,.MORDN ;READ DENSITY
MTOPR ; THAT HAS BEEN SET
ERJMP MTOPB4 ;NOT AVAILABLE-- DON'T CHECK BLOCKING-FACTOR LIMITS
MOVSI B,-DNBKTZ ;AOBJN POINTER TO DNBKTB (DENSITY/BLOCKING-FACTOR
; LIMIT TABLE)
MTOPB3: HRRZ A,DNBKTB(B) ;GET A DENSITY
CAMN A,C ;MATCH TAPE DENSITY?
JRST [ HLRZ A,DNBKTB(B) ;YES-- USE LIMIT FOR THIS DENSITY
JRST MTOPB6]
AOJN B,MTOPB3 ;NO-- LOOP THROUGH TABLE FOR TAPE DENSITY
;TAPE DENSITY NOT FOUND IN TABLE
MTOPB4: MOVE A,SETBKF ;USE BLOCKING FACTOR SET BY USER (OR DEFAULT)
MTOPB6: CAMLE A,SETBKF ;USER SET A LOWER BLOCKING-FACTOR?
MOVE A,SETBKF ;YES-- USE USER'S VALUE
MOVEM A,TAPBKF ;REMEMBER THE BLOCKING-FACTOR
CAME A,SETBKF ;ARE WE USING USER'S VALUE?
CALL [ TMSG <%BLOCKING-FACTOR too high for current tape density
%Tape will be written with BLOCKING-FACTOR of >
MOVE B,TAPBKF ;NO-- TELL USER WHAT WE WILL USE
MOVEI C,^D10 ; IN DECIMAL
CALL TTNOUT
TMSG <
>
RET]
MTOPB9:
;INITIALIZE FLAGS AND VARIABLES
TXZ F,LREOF+LRERR+ICMT1 ;CLEAR FLAGS
SETZM MTRACT
SETZM MTBUFF ;INIT VARIABLES
SETZM BLKCNT ;INDICATE MTBUF EMPTY
MOVE B,NWTBT0 ;INIT NORMAL OVERLAP MODE
IFN DSKDMP, < MOVEI B,1 ;1 RECORD AT TIME
MOVEM B,TAPBKF ; FOR DUMP TO DISK
SETZ B,> ; AND NO OVERLAPPING
MOVEM B,NWTBIT
CALLRET SETIOW ;SETUP DUMPI/O COMMAND LIST AND RETURN
;SETMOD - SET MTA DATA MODE
; F/ T36MOD - IF SET, USE 36-BIT MODE; IF RESET, USE CORE-DUMP MODE
; MTJFN/ MAGTAPE JFN
;RETURNS +1: ALWAYS
;NOTE: IN SOME INSTANCES INVOLVING LABELED TAPES, IT IS NOT POSSIBLE
;TO SET THE DATA MODE WITH THE .MOSDM MTOPR. THE ACTION TAKEN HERE
;IS TO ISSUE AN ERROR MESSAGE IF THE DATA MODE REQUESTED DOESN'T MATCH
;THE JOB DEFAULT DATA MODE.
SETMOD: SETO A, ;SPECIFY THIS JOB
HRROI B,D ;-# OF WORDS ,, ADDR OF 1ST WORD
MOVEI C,.JIDM ;OFFSET TO JOB DEFAULT DATA MODE
GETJI ;FIND OUT JOB DEFAULT DATA MODE
SETO D, ;CAN'T GET IT (SHOULDN'T HAPPEN)
CAIN D,.SJDDM ;IS MODE "SYSTEM DEFAULT" ?
MOVEI D,.SJDMC ;YES, EVERYONE KNOWS THAT'S CORE DUMP
MOVEI C,.SJDMC ;ASSUME USER WANTS CORE-DUMP
TXNE F,T36MOD ;WANTS INDUSTY-COMPATIBLE?
MOVEI C,.SJDM8 ;YES
CAMN C,D ;DOES REQUEST MATCH JOB DEFAULT?
RET ;YES, DON'T HAVE TO CHANGE ANYTHING
;REQUESTED DATA MODE DOESN'T MATCH JOB DEFAULT - MUST ISSUE MTOPR
MOVE A,MTJFN ;GET TAPE JFN
MOVEI B,.MOSDM ;FUNCTION = SET DATA MODE
MTOPR ;DO IT
ERJMP [TMSGC <%UNABLE TO SET TAPE DATA MODE, JOB DEFAULT USED
> ;FAILED
JRST .+1]
RET
;OPEN FAILURE
MTOFAI: CALL JSERRM ;SAY WHY
HRROI A,[ASCIZ\Try again? \]
CALL YESNO
JUMPN A,MTOP1 ;YES
JRST CLRST ;NO
MTOP4: MOVX A,GJ%SHT
HRROI B,[ASCIZ /MTA-DUMPER:/]
GTJFN ;TRY DEFAULT LOGICAL NAME
JRST MTOP3 ;N.G.
CALL CHKMTJ ;SETUP
JRST MTOP3 ;NOT A MAGTAPE
JRST MTOP1 ;TRY AGAIN
MTOP3: TMSG <Tape specification needed,
>
PUSH P,TMODE ;SAVE MODE (NTAPE CALLS MTOPNX)
CALL NTAPE
JRST BMBCMD ;CAN'T
POP P,TMODE
JRST MTOP1
;DENSITY/BLOCKING-FACTOR LIMIT TABLE
; *** THESE LIMITS WERE ESTABLISHED UNDER THE FOLLOWING ASSUMPTIONS:
; 1) 2 RECORDS NEED TO BE WRITTEN AFTER EOT (REFLECTIVE STRIP).
; 2) 14 RETRYS OF EACH RECORD MAY BE NEEDED.
; 3) EACH RETRY ERASES (3 INCHES) RECORD IN ERROR, THEN REWITES RECORD.
; 4) 500 INCHES OF TAPE ARE AVAILABLE AFTER REFLECTIVE STRIP.
; (THIS IS NOT TRUE. ONLY 300 INCHES (25 FEET) AVAILABLE,
; BUT ALL THOSE RETRIES ARE WORST CASE. 300 INCH LIMITS
; ARE IN PARENTHESES.)
DNBKTB: XWD ^D1,.SJDN2 ;200 BPI: LIMIT 1 (1)
XWD ^D3,.SJDN5 ;556: 3 (1)
XWD ^D4,.SJDN8 ;800: 4 (2)
XWD ^D8,.SJD16 ;1600: 8 (4)
XWD ^D35,.SJD62 ;6250: 35 (17)
DNBKTZ==.-DNBKTB
;CLOSE MAGTAPE JFN
; CALL MTCLS
; RETURN +1 ALWAYS
MTCLS: SKIPN A,MTJFN ;HAVE JFN?
RET ;NO, RETURN
CLOSF ;YES, CLOSE AND DISCARD
JRST [ MOVE A,MTJFN ;WON'T CLOSE
TXO A,CZ%ABT ;SO FORCE IT!
CLOSF
JFCL
JRST .+1]
SETZM MTJFN
RET
;REWIND, UNLOAD FUNCTIONS
REWCV: SKIPG MTTYP ;REWIND CURRENT VOLUME
JRST REWVS ;UNLABELED, DO .MOREW
MOVEI B,.MORVL ;LABELED, SPECIAL MTOPR
JRST REWU1
UNLOAD: SKIPL MTTYP ;MT DEVICE?
RET ;YES, DON'T UNLOAD
SKIPA B,[EXP .MORUL] ;UNLOAD FUNCTION
REWVS: MOVEI B,.MOREW ;REWIND VOLUME-SET
REWU1: SKIPE A,MTJFN
MTOPR
ERJMP [CAIN B,.MORUL ;ERROR, UNLOADING?
JRST .+1 ;YES, IGNORE
TMSGC <%Error rewinding tape, >
CALL JSERRM ;TELL USER
JRST .+1]
; CALLRET MTBOT ;SAY NOW AT BOT AND RETURN
;SET PARAMETERS FOR BOT OR NEW TAPE
MTBOT: SETZM TAPBKF ;INDICATE NO BLOCKING-FACTOR FOR TAPE YET
SETZM RSEQ ;RESET SEQUENCE NUMBERS
SETZM SEQ
RET ;RETURN FROM MTBOT
;MARK END OF TAPE
ENDTAP: CALL MTFILL ;FILL LAST PHYSICAL RECORD OUT SO THAT
;TAPE TRAILER IS A SINGLE PHYS RECORD
MOVNI A,TPTRX
MOVEM A,TYP ;BUILD TAPE-TRAILER RECORD
SKIPLE MTTYP ;LABELED TAPE?
JRST [ SKIPL PAGNO ;YES, CONTINUED SAVESET?
RET ;NO, ALL DONE
CALL MTOUT ;WRITE TRAILER
CALLRET MTFILL] ;FORCE IT OUT AND RETURN
CALL MTOUT ;WRITE TRAILER RECORD
TXNE F,ICMODF ;INTERCHANGE MODE?
CALL ICOFIN ;YES, FINISH BUFFERS
CALL MTFILL ;FORCE TRAILER RECORD TO BE WHOLE PHYSICAL RECORD
CALL ENDFIL
CALL ENDFIL ;WRITE 2 EOF'S
MOVEI D,3
TXNE F,ICMODF ;INTERCHANGE?
MOVEI D,2 ;YES, BACK OVER EOF'S ONLY
ENDTA1: CALL BACKSP ;BACK OVER 2 EOF'S AND TRAILER RECORD
SOJG D,ENDTA1
RET
;WRITE FILE MARK
ENDFIL: PUSH P,A
PUSH P,B
MOVEI B,.MOEOF ;REQUEST WRITE EOF
CALL XMTOPR
MOVE A,TAPBKF ;COUNT EOF AS PHYSICAL RECORD
ADDB A,RSEQ ; . .
MOVEM A,SEQ ;KEEP READ SEQ UP TO DATE
POP P,B
POP P,A
RET
;FORWARD SPACE ONE RECORD (NO CHECK FOR EOT)
FWRSP: MOVEI B,.MOFWR ;MTOPR CODE FOR FORWARD SPACE REC
CALL XMTOPR
SKIPN A,BLKCNT ; Read part of a record
MOVE A,TAPBKF ; No, # seq's per record
SKIPE BLKCNT ;READ PART OF A RECORD?
SUBI A,1 ;YES-- ACCOUNT FOR PART OF
ADD A,BLKCNT ; RECORD LEFT UNREAD
ADDB A,RSEQ ;UPDATE RECORD NUMBER
SETZM BLKCNT ;NOW AT BEGINNING OF RECORD
MOVEM A,SEQ ; Keep tape seq uptodate
RET
;BACKSPACE ONE RECORD
BACKSP: MOVEI B,.MOBKR
CALL XMTOPR ;DO BACKSPACE
MOVE A,MTJFN
GDSTS
TXNE B,MT%BOT ;NOW AT BOT?
ERROR MTBOT,<%BEGINNING OF TAPE ENCOUNTERED>
;YES-- GIVE WARNING, RESET SEQ #'S, AND RETURN FROM BACKSP
MOVN A,TAPBKF ;GET NEGATIVE BLOCKING FACTOR, A RECORD'S
; WORTH OF SEQUENCE NUMBERS
SKIPE BLKCNT ;READ PART OF A RECORD?
SUBI A,1 ;YES-- ACCOUNT FOR PART OF RECORD ALREADY READ
ADD A,BLKCNT ; . . .
ADDB A,RSEQ ;UPDATE RECORD NUMBER
SETZM BLKCNT ;NOW AT BEGINNING OF RECORD
MOVEM A,SEQ ;KEEP TAPE SEQ UP TO DATE
RET
;MTOPR FUNCTION - CHECK PREVIOUS OPERATION FIRST
; B/ FUNCTION FOR MTOPR
XMTOPR: PUSH P,B ;SAVE FUNCTION CODE
MOVE A,MTJFN
SKIPN NWTBIT
JRST XMTOP1 ;NOT OVERLAPPING
MOVE B,TMODE ;CHECK CURRENT MODE
TXNN B,OF%WR ;WRITE?
JRST [ CALL MTBKRA ;NO, READ-- BACK OVER READ-AHEAD
JRST XMTOP1]
CALL WFERR ;WRITE-- RECOVER FROM ANY ERRORS THAT HAVE OCCURED
XMTOP1: POP P,B ;RECOVER FUNCTION CODE
MOVE A,MTJFN
MTOPR ;DO FUNCTION
RET
;FILL REST OF PHYSICAL RECORD WITH FILLER RECORDS
MTFILL: SKIPN BLKCNT ;JUST WROTE A PHYSICAL RECORD?
RET ;YES-- RETURN NOW FROM MTFILL
MOVNI A,FILLX ;GET FILLER TYPE
MOVEM A,TYP ;SET RECORD TYPE
CALL MTOUT ;WRITE FILLER RECORD
JRST MTFILL ;SEE IF DONE YET
;MAGTAPE OUTPUT ROUTINE. REQUESTS ONE TRANSFER AHEAD
MTOUT: SAVEAC <A,B>
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
SKIPG BLKCNT ;TIME FOR A NEW BUFFER?
CALL SETNXB ;YES, SET UP ADDRESS AND BLOCK COUNT
JXN F,ICMODF,[MOVE A,MTBPTR ;GET POINTER TO CURRENT BUFFER
CALL ICOCNV ;INTERCHANGE MODE, DO CONVERSION
RET ;NO OUTPUT
JRST MTOUT1] ;DATA NOW IN BUFFER, GO WRITE IT
AOS A,RSEQ
MOVEM A,SEQ ;KEEP READ SEQ UP TO DATE
SETZM CHKSUM
HRRZ B,CURBUF ;POINT TO CURRENT BUFFER
CALL COMCKB ;CHECKSUM IT
SETCAM A,CHKSUM
MOVE A,MTBPTR ;GET CURRENT BUFFER POINTER
HRLI A,XBUFF ;COPY HEADER FIRST
MOVEI B,NHEAD(A)
BLT A,-1(B) ;...
HRL B,CURBUF ;SET UP BLT PNTR
MOVEI A,PGSIZ(B) ;LAST ADDRS
BLT B,-1(A) ;MOVE IT
MTOUT1: MOVEI A,NHEAD+PGSIZ ;ADVANCE BUFFER POINTER
ADDM A,MTBPTR ; TO NEXT RECORD
SOSLE BLKCNT ;FILLED THIS PHYSICAL RECORD?
RET ;NO, ALL DONE FOR NOW
MTOUT2: MOVEI A,MTBUF1-1 ;SETUP DUMPO START ADDRESS
SKIPE MTBUFF
MOVEI A,MTBUF2-1
HRRM A,MTCOMS
MOVEI B,MTCOMS
TDO B,NWTBIT ;SET OVERLAP IO BIT OR 0
MOVE A,MTJFN
DUMPO
JRST [ CALL WFERR ;WRITE ERROR, RECOVER IT
SKIPE NWTBIT ;OVERLAPPING?
JRST MTOUT2 ;YES, TRY TRANSFER AGAIN
JRST .+1] ;NO, ACTUAL TRANSFER RECOVERED
RET
;WRITE ERROR HANDLER. ANY DATA ERROR IS HANDLED BY RE-WRITING THE
;SAME RECORD. CERTAIN OTHER FLAG CONDITIONS (E.G. EOT) ARE
;IGNORED EXCEPT FOR PASSING STATUS BACK TO MAIN FORK. TAPE
;IS *NEVER* BACKSPACED.
;IF NO ERRORS ARE DETECTED, THEN NO ACTION IS TAKEN.
WFERR: CAIN A,DUMPX3 ;BUFFER TOO BIG?
ERROR CLRST,<?Not enough monitor table space for current BLOCKING-FACTOR>
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
CALL XGDSTS ;GET AND CLEAR ERROR FLAGS
TXNE B,MT%ILW ;ILLEG WRITE?
JRST [ HRROI A,[ASCIZ /?Tape is write-protected, type <CR> when ready to try again. /]
SKIPGE MTTYP ;MTA DEVICE?
JRST WFTRYM ;YES, ASK TO TRY AGAIN
TMSGC <?Tape is write-protected
?DISMOUNT tape, then MOUNT it with /WRITE-ENABLED switch>
JRST CLRST]
TXNE B,MT%DVE ;DRIVE OFF-LINE?
JRST [ HRROI A,[ASCIZ /?Drive probably off-line, type <CR> when ready to try again. /]
CALLRET WFTRYM]
TXNE B,MT%EOT ;EOT?
SETZM TAPLFT ;YES, FLAG MAIN FORK
SKIPN COLSW ;COLLECTION/MIGRATION?
SKIPE ARCSW ;ARCHIVAL?
JRST[ SKIPE NWTBIT ;GET TYPE FROM OTHER BUFFER UNLESS
SKIPE MTBUFF ;NOT OVERLAPPING
SKIPA C,MTBUF1+XTYP
MOVE C,MTBUF2+XTYP
CAME C,[-TPTRX] ;TRAILER RECORD?
JRST .+1 ;NO, PROCEED AS USUAL
TMSG <?WRITE ERROR ON TRAILER RECORD!
?This >
CALL PRTTYP
TMSG < tape is valid for the current and all previous runs
?BUT, it should NOT be used for any future runs!!!
?****** MARK THIS TAPE AS FULL *********
>
RET]
TXNE B,MT%DAE ;DATA ERROR?
JRST [ TMSGC <%Write error on tape, record >
MOVEI B,XSEQ ;SEQ WORD IN RECORD
TXNE F,ICMODF ;UNLESS INTERCHANGE MODE
MOVEI B,G$SEQ ;IN WHICH CASE IT IS THIS
SKIPE NWTBIT ;GET SEQ FROM OTHER BUFFER UNLESS
SKIPE MTBUFF ;NOT OVERLAPPING
SKIPA B,MTBUF1(B)
MOVE B,MTBUF2(B)
MOVEI C,^D10
CALL TTNOUT ;REPORT IT
TMSG <, writing duplicate record.
>
CALLRET WFTRY]
RET ;UNKNOWN ERROR, IGNORE
;TRY ERRONEOUS TRANSFER AGAIN. THIS WILL BE A DUPLICATE RECORD IF
;PREVIOUS ATTEMPT FAILED BECAUSE OF DATA ERROR.
WFTRYM: PUSH P,A ;HERE IF MSG IN A TO TYPE FIRST
MOVEI A,101
DOBE ;WAIT FOR ANY MAIN FORK OUTPUT TO FINISH
POP P,B
CALL TMSGQC
CALL RDLIN ;GET CR FROM USER
;HERE TO TRY AGAIN WITHOUT MSG
WFTRY: SKIPE NWTBIT ;WRITE FROM OTHER BUFFER UNLESS
SKIPE MTBUFF ;NOT OVERLAPPING
SKIPA A,[MTBUF1-1]
MOVEI A,MTBUF2-1
HRRM A,MTCOMS
MOVEI B,MTCOMS
TDO B,NWTBIT ;SET BIT IF OVERLAPPING
MOVE A,MTJFN
DUMPO
JRST WFERR ;FAILED AGAIN
RET ;RETRY REQUESTED OK
;MAG TAPE READ - REQUESTS ONE BUFFER IN ADVANCE
MTRED: PUSH P,A
PUSH P,B
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
TXZE F,ICMT1 ;INTERCHANGE MODE REPEAT RECORD?
JRST [ CALL ICICN1 ;YES
JRST MTRED5 ;GET ANOTHER RECORD
JRST MTRED2] ;DATA NOW IN BUFF
MTRED5: TXZE F,LRERR ;LAST RECORD HAD ERROR?
JRST MTRED3 ;YES, CURRENT RECORD WAITING IN BUFF
MOVEI A,NHEAD+PGSIZ ;BUMP ADDRESS
ADDM A,MTBPTR ; OF CURRENT RECORD
SOSLE BLKCNT ;ANY RECORDS LEFT IN THIS PHYSICAL RECORD?
JRST MTRED4 ;YES-- USE IT
;READ NEXT RECORD FROM TAPE
CALL SETNXB ;SET NEXT BUFFER ADDRESS
TXZ F,LREOF ;NO EOF
MOVEI P1,NRETRY ;INIT RETRY COUNT
MTRED1: MOVEI B,MTBUF1-1 ;SELECT BUFFER
SKIPE MTRACT ;NOW TO DO READ-AHEAD?
JRST [ SKIPN MTBUFF ;YES-- USE OTHER BUFFER
MOVEI B,MTBUF2-1
JRST MTRD12]
SKIPE MTBUFF
MOVEI B,MTBUF2-1
MTRD12: HRRM B,MTCOMS
MOVEI B,MTCOMS
SKIPE TAPBKF ;DON'T OVERLAP IF RECORD LENGTH NOT YET KNOWN
TDO B,NWTBIT
MOVE A,MTJFN
DUMPI ;REQUEST INPUT
JRST MTRERR ;READ ERROR
SKIPE NWTBIT ;OVERLAPPING?
SKIPE MTRACT ;YES-- NO READ-AHEAD YET?
JRST MTRED4 ;NO-- NOW RETURN DATA TO BUFF
SKIPN TAPBKF ;BLOCKING-FACTOR KNOWN?
JRST MTRED4 ;NO-- DON'T READ-AHEAD UNTIL WE FIND IT
SETOM MTRACT ;YES-- TIME TO DO READ-AHEAD
JRST MTRED1 ; SO GO BACK AND DO IT
MTRED4: HRLZ A,MTBPTR ;POINT TO CURRENT RECORD
TXNE F,T36MOD ;36-BIT MODE?
CALL W36CNV
TXNE F,ICMODF ;INTERCHANGE MODE?
JRST [ CALL ICICNV ;YES, REFORMAT RECORD
AOSA RSEQ ;RECORD BEING SKIPPED, ADJUST SEQ
JRST MTRED2 ;DATA NOW IN BUFF
JRST MTRED5] ;GET ANOTHER RECORD
HRRI A,BUFF-NHEAD ;COPY BUFFER
BLT A,BUFF+PGSIZ-1
CALL COMCHK ;CHECK CHECKSUM
JUMPN A,MTRCSE ;JUMP IF CHECKSUM ERROR
MTRED2: AOSGE A,RSEQ ;BUMP RECORD NUMBER, IN SEQUENCE RECOVERY?
JRST [ CALL MTRRCK ;YES
JRST MTRERX ;FAILURE, RETURN ERROR
JRST MTRED3] ;OK
CAMN A,SEQ ;SAME AS TAPE?
JRST MTRED3 ;YES-- OK
CALL MTRSQE ;NO-- CHECK IT OUT
JRST [ SETZM BLKCNT ;DUPLICATE RECORD--
JRST MTRED5] ; IGNORE IT
MTRED3: MOVN A,TYP ;GET CURRENT RECORD TYPE
CAIN A,FILLX ;FILLER?
JRST MTRED5 ;YES-- IGNORE IT
POP P,B
POP P,A
RETSKP
;ERROR RETURN
MTRERX: TXO F,LRERR ;NOTE BUFFER NOT RETURNED, DATA IN BUFF IS NEXT RECORD
POP P,B
POP P,A
RET
;CONVERT FROM 36-BIT TAPE FORMAT
W36CNV: SAVEQ
HLRZ B,A ;CONVERT BUFFER IN PLACE
HRLI B,(POINT 8,0)
HLRZ C,A
HRLI C,(POINT 4,0)
MOVEI Q1,^D<<NHEAD+PGSIZ>*9/2> ;SOURCE BYTE COUNT
W36C1: ILDB D,B ;ONE SOURCE BYTE...
ROT D,-4 ; ... BECOMES TWO DEST BYTES
IDPB D,C
ROT D,4
IDPB D,C
SOJG Q1,W36C1
RET
;ERROR HANDLING STRATEGY:
;1. DEVICE ERRORS WHICH DO NOT READ ANY DATA (E.G. OFF-LINE) WAIT
; FOR CONFIRMATION FROM USER THEN TRY AGAIN.
;2. DEVICE DATA ERRORS ARE RETRIED HERE BECAUSE WE HAVE
; SUPPRESSED THE MONITOR ERROR CORRECTION LOGIC.
;3. CHECKSUM IS CHECKED ONLY IF DEVICE REPORTS NO ERRORS IN DATA.
; CHECKSUM ERROR PRODUCES LOCAL RETRY SINCE THE MONITOR DID NOT
; KNOW OF THE ERROR.
;4. ANY HARD DATA ERROR WILL SET A FLAG WHICH CAUSES THE NEXT RECORD
; TO BE READ AND ITS SEQUENCE NUMBER CHECKED. IF IT IS THE
; SAME AS THE EXPECTED SEQUENCE NUMBER OF THE ERRONEOUS RECORD,
; THEN THE ERROR WAS ALSO DETECTED ON WRITE AND A DUPLICATE
; RECORD WAS THEN WRITTEN. THIS CONSTITUTES FULL
; RECOVERY AND IS SO REPORTED.
;ERROR REPORTED BY MAGTAPE
MTRERR: CAIN A,DUMPX3 ;BUFFER TOO BIG?
JRST [ HLRE A,MTCOMS ;YES, GET CURRENT WORD COUNT
ADDI A,PGSIZ+NHEAD ;COUNT DOWN A BUFFER'S WORTH
HRLM A,MTCOMS ;PUT IT BACK
CAMGE A,[EXP -<PGSIZ+NHEAD>] ;CAN WE STILL READ A WHOLE RECORD?
SKIPE TAPBKF ;YES, ALSO LOOKING FOR BLOCKING-FACTOR?
ERROR CLRST,<?Not enough monitor table space> ;NO
JRST MTRED1] ;YES, TRY DUMPI AGAIN
CAIE A,GJFX52 ;END OF LABELED TAPE?
CAIN A,IOX24 ;END OF LABELED TAPE?
JRST [ CALL XGDSTS ;YES, CLEAR ERROR STATUS
JRST MTREOF] ;TREAT LIKE END-OF-FILE
CAIE A,IOX4 ;EOF
;*** THE NEXT 4 LINES ARE A HACK UNTIL MONITOR SETS MT%EOF WITH IOX4
CAIA ;*
JRST [ CALL XGDSTS ;*
SETZM MTRACT ;*
JRST MTREOF] ;*
CAIN A,IOX5 ; OR ERROR ?
SKIPA ;ONE OF THE ABOVE
JRST [ TMSGC <?Unexpected error reading tape
?>
CALL JSERRM ;CAN'T HANDLE THIS ONE
TMSGC <Type <CR> to try again. >
CALL RDLIN ;GET CR FROM USER
JRST MTRED1]
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
CALL XGDSTS ;GET AND CLEAR ERROR FLAGS
TXNE B,MT%DVE!MT%DAE!MT%EOF ;ANY TRANSFER-ABORT CONDITIONS?
SETZM MTRACT ;YES, NOTE NO OUTSTANDING REQUEST
TXNE B,MT%DVE ;OFF-LINE?
JRST [ CALL MTRSQR ;MAKE SURE SEQ RECOVERY FINISHED
TMSGC <?Device error, possible incorrect density.
Type <CR> to try again. >
CALL RDLIN ;GET CR FROM USER
JRST MTRED1]
TXNE B,MT%DAE ;DATA ERROR?
JRST [ CALL MTRSQR ;MAKE SURE SEQ RECOVERY FINISHED
TMSGC <?MAGTAPE data error>
CALL TSEQN ;REPORT SEQ NUMBER
JRST MTREX1] ;YES, GO SETUP RETRY
TXNE B,MT%EOF ;EOF?
MTREOF: JRST [ MOVE B,TAPBKF ;YES
SKIPG MTTYP ;LABELED, IGNORE INTER-FILE GAP
ADDM B,RSEQ ;UNLABELED, COUNT EOF AS PHYSICAL RECORD
TXON F,LREOF ;SET EOF AND CHECK FOR TWO SEQUENTIAL
JRST MTRED1 ;IGNORE
MOVX B,-TPTRX ;TWO EOF'S, SIMULATE EOT RECORD
MOVEM B,TYP
MOVE B,RSEQ
MOVEM B,SEQ
JRST MTRED3] ;AND EXIT
TXNE B,MT%IRL ;RECORD LENGTH DISAGREES?
JRST MTRERL ;YES
CALL MTRSQR ;FINISH SEQ RECOVERY
TMSGC <?MAGTAPE unknown error>
CALL TSEQN ;REPORT SEQ NUMBER
;ATTEMPT TO RECOVER ASSUMING ERROR WAS ALSO SEEN ON WRITE AND
;THAT DUPLICATE RECORD WAS WRITTEN. IF NEXT RECORD HAS SAME
;SEQUENCE NUMBER AS WAS EXPECTED FOR BAD RECORD, THEN PROBLEM
;HAS BEEN RECOVERED.
MTREX1: SKIPN RSEQ ;AT BOT?
JRST [ TMSG <
%Tape may be wrong format>
JRST .+1]
MOVSI A,(1B0) ;SET FLAG IN SEQ
IORM A,RSEQ
MOVEI P1,NRETRY ;REINIT RETRY COUNT
JRST MTRED1 ;GO READ NEXT RECORD
;RECORD LENGTH ERROR REPORTED. MONITOR DOES NOT RETRY ON THIS
;BECAUSE SOME PROGRAMS DON'T KNOW HOW LONG THEIR RECORDS ARE.
;WE DON'T KNOW WHAT THE BLOCKING FACTOR WILL BE, SO THE MAXIMUM SIZE
;RECORD IS READ THE FIRST TIME AND WILL COME THROUGH HERE.
;IF WE HAVE ALREADY READ AT LEAST ONE RECORD, WE KNOW THE BLOCKING
;FACTOR AND THE RECORD LENGTH, SO ANY A RECORD LENGTH ERROR
;IS A GENUINE ERROR AND WE WILL TRY TO RE-READ THE RECORD.
;AC C/ XWD # FRAMES READ, 0 (FROM GDSTS)
MTRERL: SKIPE TAPBKF ;BLOCKING-FACTOR KNOWN?
JRST MTRRL1 ;YES-- MUST BE REAL ERROR
HLRZ A,C ;GET WORDS ACTUALLY READ
IDIVI A,NHEAD+PGSIZ ;COMPUTE NUMBER OF RECORDS READ
JUMPN B,MTRRL1 ;NOT AN INTEGRAL NUMBER OF RECORDS-- REAL ERROR
MOVEM A,TAPBKF ;SAVE RECORD BLOCKING FACTOR
MOVEM A,BLKCNT ;ALSO SET AS CURRENT BLOCK COUNT IN BUFFER
CALL SETIOW ;SET DUMPI COMMAND LIST FOR RIGHT SIZE
JRST MTRED4 ;IGNORE THE ERROR, PROCESS RECORD
;HERE WITH REAL RECORD LENGTH ERROR
MTRRL1: HRRZ A,MTCOMS
MOVE A,1(A) ;GET FIRST WORD READ FROM TAPE
TDZ A,[1B0+1B8+1B16+1B24+17] ;CLEAR TRASH
CAMN A,[BYTE (8) "V","O","L","1"] ;IS IT A VOL1?
JRST [ HRROI B,[ASCIZ/?Labeled tapes must be MOUNTed/] ;YES
SKIPL MTTYP ;SELECT APPROPRIATE DIAGNOSTIC
HRROI B,[ASCIZ/?Cannot read labeled tapes in BYPASS mode/]
CALL TMSGQC
CALL MTCLS ;CLOSE THE TAPE
JRST BMBCMD]
SOJG P1,MTRTRY ;COUNT ATTEMPTS AND TRY AGAIN
CALL MTRSQR ;FINISH SEQ RECOVERY
TMSGC <?MAGTAPE record length error>
CALL TSEQN ;REPORT SEQ NUMBER
JRST MTREX1 ;TRY TO RECOVER BY SEQ NUMBER
;HERE WHEN TRYING TO RECOVER ERROR BY SEQUENCE NUMBER
;AFTER NEXT RECORD HAS BEEN READ. THIS RECORD WILL BE USED IN ANY CASE.
MTRRCK: MOVSI C,(1B0)
ANDCAB C,RSEQ ;CLEAR RETRY FLAG
MOVE B,SEQ ;GET SEQ NUM OF RECORD JUST READ
CAME B,C ;DESIRED NUMBER?
JRST [ MOVEM B,RSEQ ;NO, RESET NUMBER
RET]
TMSG <, recovered.
>
RETSKP
;HERE WHEN WE WANT TO REPORT ANOTHER ERROR.
;IF ALREADY IN SEQUENCE RECOVERY, TYPE ", RECORD IGNORED." TO
;COMPLETE LAST ERROR MESSAGE.
MTRSQR: SKIPL RSEQ ;IN SEQUENCE RECOVERY?
RET ;NO-- ALL OK
TMSG <, record ignored.
>
RET ;RETURN FROM MTRSQR
;HERE IF SEQUENCE NUMBERS DISAGREE UNEXPECTEDLY.
;IF ACTUAL IS BLOCKING-FACTOR LESS THAN EXPECTED, PROBABLY GOT ERROR ON WRITE
;WHICH DIDN'T APPEAR ON READ, SO DUPLICATE RECORD WAS WRITTEN.
;THE DUPLICATE RECORD IS IGNORED (+1 RETURN).
;IF ACTUAL IS 1 AND EOF JUST READ, PROBABLY NEW SAVESET. PROCEED QUIETLY.
;ANYTHING ELSE IS AN ERROR.
MTRSQE: MOVE C,RSEQ
MOVE B,SEQ ;GET NUMBER JUST READ
MOVEM B,RSEQ ;RESET NUMBERS
SUB C,B ;COMPUTE DIFFERENCE
CAMN C,TAPBKF ;ACTUAL 1 LESS THAN EXPECTED?
JRST [ TMSGC <%Duplicate record encountered, record >
MOVE B,RSEQ ;REPORT NUMBER
MOVEI C,^D10
CALL TTNOUT
TMSG <, ignored.
>
RET] ;RETURN +1 FROM MTRSQE TO IGNORE RECORD
TXNE F,LREOF ;LAST RECORD FILE MARK?
JRST [ CAIN B,1 ;YES-- NEW SAVESET?
RETSKP ;YES-- ASSUME OK
JRST .+1] ;NO-- REAL SEQUENCE ERROR
TMSGC <?Sequence error, record >
MOVE B,RSEQ ;REPORT NUMBER
MOVEI C,^D10
CALL TTNOUT
TMSG <, continuing.
>
RETSKP
;BKTPHD - BACK UP OVER TAPE HEADER THAT WAS JUST READ AND CLOSE TAPE
;LABELED TAPES ARE BACKSPACED 1 FILE TO PREVENT REPOSITIONING AT CLOSE
BKTPHD: SKIPG MTTYP ;WHAT LABEL TYPE?
JRST [ CALL BACKSP ;UNLABELED, JUST BACKSPACE
CALLRET MTCLS] ;CLOSE TAPE AND RETURN
CALL XGDSTS ;LABELED, CLEAR ERRORS
MOVE A,MTJFN
MOVEI B,.MOBKF ;BACKSPACE-FILE FUNCTION
MTOPR ;GET TO START OF PREVIOUS FILE
ERJMP BKTPHX
MOVEI B,.MOFWF ;THIS IS A CROCK BUT IT DOES WORK
MTOPR
ERJMP BKTPHX
SOS RSEQ ;COUNT THE RECORD I JUST BACKED UP OVER
CALLRET MTCLS ;CLOSE TAPE AND RETURN
BKTPHX: TMSGC <?ERROR POSITIONING TAPE: >
CALL JSERRM
JRST BMBCMD
;HERE ON CHECKSUM ERROR. CHECKSUM ERROR MAY ARISE ONLY WITHOUT
;CONCURRENT DEVICE DATA ERROR. SINCE NO DEVICE ERROR APPEARED, THEN
;DEVICE HAS GONE AHEAD TO READ NEXT RECORD AND WE WILL HAVE TO
;BACKSPACE 2.
MTRCSE: CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
CALL XGDSTS ;WAIT FOR BACKUP OPERATION
SOJG P1,MTRTRY ;TRY AGAIN WITH 2-RECORD BACKSPACE
TMSGC <?Checksum error>
CALL TSEQN
CALL MTBKRA ;BACK UP OVER READ-AHEAD (IF ANY)
JRST MTREX1 ;TRY SEQ NUMBER RECOVERY
;HERE TO BACKSPACE BEFORE RETRY
MTRTRY: CALL MTBKRA ;BACK OVER READ-AHEAD, IF ANY
CALL MTRBKR ;BACK FOR RETRY
JRST MTRED1 ;START FROM TOP
;BACK OVER READ-AHEAD, IF ANY
MTBKRA: SKIPN MTRACT ;READ-AHEAD OUTSTANDING?
RET ;NO, DO NOTHING
SETZM MTRACT ;RESET FLAG
CALL XGDSTS ;WAIT FOR THINGS TO SETTLE DOWN
; CALLRET MTRBKR ;BACK OVER RECORD AND RETURN FROM MTBKRA
;BACKSPACE A RECORD
MTRBKR: MOVE A,MTJFN ;GET MTA JFN
MOVX B,.MOBKR ;BACKSPACE RECORD FUNCTION
MTOPR ; . . .
RET ;RETURN FROM MTRBKR
;REPORT SEQUENCE NUMBER
TSEQN: TMSG < record >
MOVE B,RSEQ
TXZ B,1B0 ;CLEAR FLAG IF ANY
AOS B ;COMPUTE EXPECTED SEQ NUMBER
MOVEI C,^D10
CALLRET TTNOUT
;COMPUTE CHECKSUM FOR RECORD. CHECKSUM WORD IS INCLUDED IN
;COMPUTATION. ON WRITE, IT IS SET TO 0 BEFORE THE CHECKSUM IS
;COMPUTED, THEN THE CHECKSUM IS STORED COMPLEMENTED. HENCE ON
;READ, THE CHECKSUM COMPUTATION SHOULD PRODUCE 0.
COMCHK: MOVEI B,BUFF-NHEAD ;ENTER HERE FOR STANDARD BUFFER
HRLI B,-1000-NHEAD
MOVEI A,0
COMCHA: JCRY0 COMCH1
COMCH1: ADD A,0(B)
JCRY0 [AOJA A,.+1]
AOBJN B,COMCH1
CAMN A,[EXP -1]
AOS A
RET
;ROUTINE TO CHECKSUM DISJOINT BUFFER (PAGE ADDRS IN B)
COMCKB: MOVE C,[-NHEAD,,XBUFF]
MOVEI A,0 ;INIT CHECKSUM
JCRY0 COMCB1
COMCB1: ADD A,0(C)
JCRY0 [AOJA A,.+1]
AOBJN C,COMCB1
HRLI B,-PGSIZ ;SET UP FOR REMAINDER OF RECORD
JRST COMCHA
;GET ERROR FLAGS AND THEN CLEAR SYSTEM COPY OF THEM
XGDSTS: MOVE A,MTJFN
GDSTS ;GET ERROR BITS
PUSH P,B ;SAVE STATUS BITS
MOVEI B,.MOCLE
MTOPR ;CLEAR ERROR FLAGS
POP P,B
RET
;SETUP DUMPI/O COMMAND LIST
SETIOW: MOVSI A,-PGSIZ-NHEAD ;SETUP BLOCK SIZE
TXNE F,ICMODF ;INTERCHANGE MODE?
MOVSI A,-PGSIZ-NIHEAD ;YES
SKIPN B,TAPBKF ;GET BLOCKING-FACTOR
JRST [ MOVSI A,-MTBFSZ ;NONE SET YET, USE MAX BUFFER SIZE
JRST SETIO1]
IMUL A,B ;RECORD-SIZE TIMES BLOCKING-FACTOR
JXN F,T36MOD,<[IMULI A,^D9 ;ADJUST FOR TAPE FORMAT
IDIVI A,^D8
JRST .+1]>
SETIO1: MOVEM A,MTCOMS ;CONSTRUCT DUMPI/O COMMAND LIST
SETZM MTCOMS+1
RET ;RETURN FROM SETIOW
;SET NEXT BUFFER ADDRESS AND BLOCK COUNT
SETNXB: SKIPE NWTBIT ;OVERLAPPING I/O?
SETCMM MTBUFF ;YES, SWITCH BUFFERS
MOVEI A,MTBUF1 ;SELECT BUFFER
SKIPE MTBUFF ; . . .
MOVEI A,MTBUF2 ; . . .
MOVEM A,MTBPTR ;SAVE AS CURRENT BUFFER POINTER
MOVE A,TAPBKF ;SET BLOCK COUNT
MOVEM A,BLKCNT ; FOR THIS PHYSICAL RECORD
RET ;RETURN FROM SETNXB
SUBTTL INTERCHANGE CONVERSION
;ROUTINES TO CONVERT BACKUP/INTERCHANGE FORMAT RECORD INTO DUMPER
;FORMAT.
; A/ SOURCE BUFFER ADR,,0
ICICNV: ACVAR <Q1,Q2>
HLRZ Q1,A ;KEEP SOURCE BUFFER ADR
MOVE A,[BUFF-NHEAD,,BUFF-NHEAD+1]
SETZM -1(A) ;CLEAR DEST BUFFER FIRST
BLT A,BUFF+PGSIZ-1
MOVE A,G$SEQ(Q1) ;MOVE COMMON ITEMS - SEQ NUMBER
MOVEM A,SEQ
MOVE A,G$RTNM(Q1) ;TAPE NUMBER
MOVEM A,TAPNO
MOVE A,G$TYPE(Q1) ;DISPATCH ON TYPE
CAIN A,T$LBL
JRST T.LBL ;LABEL
CAIN A,T$BEG
JRST T.BEG ;BEGINNING OF SAVE SET
CAIN A,T$END
JRST T.END ;END OF SAVE SET
CAIN A,T$FIL
JRST T.FIL ;FILE DATA
CAIN A,T$UFD
JRST T.UFD ;DIRECTORY INFO
CAIN A,T$CON
JRST T.CON ;CONTINUATION
TMSG <%UNRECOGNIZED RECORD TYPE ON INTERCHANGE TAPE, RECORD SKIPPED
>
RET
;HERE FOR SECOND AND SUBSEQUENT PROCESSING OF SAME SOURCE RECORD
ICICN1: ACVAR <Q1,Q2>
SOS RSEQ ;KEEP SAME SEQ NUM
MOVEI Q1,MTBUF1 ;SETUP BFR ADR AGAIN
SKIPE MTBUFF
MOVEI Q1,MTBUF2
MOVE A,[BUFF,BUFF+1]
SETZM -1(A) ;CLEAR DATA AREA
BLT A,BUFF+PGSIZ-1
MOVE A,G$TYPE(Q1) ;GET TYPE
CAIE A,T$FIL ;FILE?
RET ;NO, ???
MOVE A,G$FLAG(Q1)
TXNE A,GF$SOF ;START OF SHORT FILE?
JRST TFIL0 ;YES, GET DATA
TXNE A,GF$EOF ;LAST RECORD?
JRST TFIL8 ;YES
RET ;UNKNOWN, ???
;RECORD TYPES IGNORED, LBL, UFD, END
T.END:
T.UFD:
T.LBL: RET
;BEGINNING, END, OR CONTINUATION OF SAVESET
T.CON:
T.BEG: MOVX A,-TPHDX ;MEANS TAPE HEADER
MOVEM A,TYP
MOVE A,S$DATE(Q1) ;TAD OF SAVE
MOVEM A,BUFF+BFTAD
MOVEI A,BFMSG ;USUAL MESSAGE PTR
MOVEM A,BUFF+BFMSGP
MOVEI A,CURFMT ;USUAL FORMAT
MOVEM A,BUFF
MOVEI D,NIHEAD(Q1) ;SET TO SCAN DATA AREA
TBEG1: SKIPN 0(D) ;MORE TO COME?
JRST TBEG2 ;NO
HLRZ A,0(D) ;GET BLOCK TYPE
CAIN A,O$SSNM ;SAVESET NAME?
JRST TBEG3 ;YES
HRRZ A,0(D) ;NO, STEP TO NEXT BLOCK
ADDM A,D
JRST TBEG1
TBEG3: HRROI A,BUFF+BFMSG
HRROI B,1(D) ;COPY SAVESET NAME STRING
SETZ C,
SOUT
TBEG2: RETSKP
;FILE DATA RECORD
T.FIL: MOVE A,G$FLAG(Q1)
TXNE A,GF$SOF ;FIRST RECORD?
JRST TFIL1 ;YES
TFIL0: MOVX A,GF$SOF
ANDCAB A,G$FLAG(Q1) ;NOTE NOT FIRST RECORD NOW
SKIPG G$SIZ(Q1) ;ANY DATA IN RECORD?
JRST [ TXNN A,GF$EOF ;NO, EOF?
RET ;NO, IGNORE RECORD
JRST TFIL8] ;YES, HANDLE EOF
MOVEI A,NIHEAD(Q1) ;LOCATION OF DATA
ADD A,G$LND(Q1) ;PLUS OFFSET IF ANY
HRLZ A,A ;SOURCE FOR BLT
HRRI A,BUFF ;DEST FOR BLT
MOVEI B,BUFF
ADD B,G$SIZ(Q1) ;NUMBER OF WORDS TO TRANSFER
BLT A,-1(B) ;COPY DATA
SETZM TYP ;DUMPER FILE TYPE
MOVE A,F$RDW(Q1) ;WORD NUMBER
IDIVI A,PGSIZ ;CONVERT TO PAGE NUMBER
MOVEM A,PAGNO
MOVX A,PM%RD+PM%WT
MOVEM A,ACCESS ;USUAL ACCESS
TFIL9: MOVE A,G$FLAG(Q1)
TXNE A,GF$EOF ;LAST RECORD?
TXO F,ICMT1 ;YES, REPEAT IT
RETSKP
;FIRST RECORD OF FILE
TFIL1: MOVX A,-FLHDX ;SAY DUMPER FILE HEADER
MOVEM A,TYP
MOVEI D,NIHEAD(Q1) ;SET TO SCAN DATA
HRLI D,-F$NND ;SIZE OF NON-DATA AREA
TFIL2: HLRZ A,0(D) ;GET BLOCK TYPE
CAIN A,O$NAME ;NAME?
JRST TFIL2N ;YES
CAIN A,O$FILE ;ATTRIBUTES?
JRST TFIL2F ;YES
TFIL7: HRRZ A,0(D) ;STEP BLOCK
HRL A,A
ADDM A,D
SKIPE 0(D) ;END OF DATA?
JUMPL D,TFIL2 ;OR END OF BLOCK?
SKIPLE G$SIZ(Q1) ;YES, DATA IN THIS BLOCK ALSO?
TXO F,ICMT1 ;YES, REPEAT IT
JRST TFIL9 ;CHECK FOR LAST REC AND RETURN
;FILE NAME BLOCK
TFIL2N: MOVE A,[POINT 7,BUFF+FHNAM] ;SET TO CONSTRUCT NAME IN BUFF
MOVEI B,.FCDIR
CALL SCNBF ;FIND DIRECTORY BLOCK
JRST TFIL3 ;NONE
MOVEM B,Q2 ;SAVE PTR TO IT
MOVEI B,DIRBP ;DO DIR PUNCTUATION
IDPB B,A
HRLI Q2,(POINT 7,0) ;SET TO COPY STRING
TFIL32: ILDB B,Q2
JUMPE B,TFIL31 ;END ON NULL
CAIN B,"," ;PPN SEPARATOR?
MOVEI B,"-" ;YES, TRANSLATE
IDPB B,A
JRST TFIL32
TFIL31: MOVEI B,DIREP
IDPB B,A ;CLOSE DIR PUNCT
TFIL3: MOVEI B,.FCNAM
CALL SCNBF ;FIND NAME BLOCK
JRST TFIL4 ;NONE
HRROI B,0(B)
SETZ C,
SOUT ;COPY IT
TFIL4: MOVEI B,EXTPCT
IDPB B,A ;PUNCTUATE EXTENSION
MOVEI B,.FCEXT
CALL SCNBF ;FIND EXTENSION BLOCK
JRST TFIL5 ;NONE
HRROI B,0(B)
SETZ C,
SOUT ;COPY IT
TFIL5: MOVEI B,GENPCT
IDPB B,A ;PUNCTUATE GENERATION
MOVEI B,.FCGEN
CALL SCNBF ;FIND GEN
JRST TFIL6 ;NONE
HRROI B,0(B)
MOVEM B,Q2 ;SAVE PTR TO GEN STRING
SETZ C,
SOUT ;COPY IT
MOVE A,Q2 ;GET PTR TO GEN STRING
MOVEI C,^D10
NIN ;CONVERT GEN TO NUMBER
CALL JSERR1
STOR B,FB%GEN,BUFF+FHFDB+.FBGEN ;PUT IN FDB
TFIL6: JRST TFIL7 ;DONE WITH NAME
;ROUTINE TO SCAN NAME BLOCK LOOKING FOR SPECIFIED SUB-BLOCK
; B/ DESIRED BLOCK TYPE
; D/ PTR TO BLOCK
;RETURN +1,
; B/ PTR TO DATA
SCNBF: STKVAR <TT1>
MOVEM D,TT1 ;SAVE MAIN PTR
MOVN C,0(D) ;GET LENGTH OF BLOCK
HRL D,C ;SET LIMIT
AOBJN D,.+1 ;STEP PAST HEADER
SCNBF1: HLRZ C,0(D) ;GET SUB-BLOCK TYPE
CAMN C,B ;REQUESTED ONE?
JRST [ MOVEI B,1(D) ;YES, RETURN PTR TO DATA
MOVE D,TT1 ;RESTORE D
RETSKP]
HRRZ C,0(D) ;BUMP SUB-BLOCK
HRL C,C
ADDM C,D
SKIPE 0(D) ;END OF DATA?
JUMPL D,SCNBF1 ;JUMP UNLESS END OF BLOCK
MOVE D,TT1 ;RESTORE D
RET ;TYPE NOT FOUND
;ATTRIBUTE BLOCK
TFIL2F: MOVEI C,1(D) ;POINT TO DATA PORTION
MOVE A,A$WRIT(C) ;COPY ITEMS - WRITE DATE
MOVEM A,BUFF+FHFDB+.FBWRT
MOVE A,A$BSIZ(C)
STOR A,FB%BSZ,BUFF+FHFDB+.FBBYV
PUSH P,C ;SAVE C
SKIPN A ;IS BYTE SIZE ZERO?
MOVEI A,^D36 ;YES-- ASSUME 36 BIT BYTES
MOVEI B,^D36 ;BITS IN A WORD
IDIV B,A ;BYTES IN A WORD
POP P,C ;RESTOR C
MOVE A,A$LENG(C)
MOVEM A,BUFF+FHFDB+.FBSIZ
ADDI A,-1(B) ;ROUND UP
IDIV A,B ;WORDS IN FILE
ADDI A,PGSIZ-1 ;ROUND UP
IDIVI A,PGSIZ ;FULL PAGES IN FILE
STOR A,FB%PGC,BUFF+FHFDB+.FBBYV
MOVE A,[BUFF+FHFDB,,ICFDB]
BLT A,ICFDB+.FBLN0-1 ;SAVE FDB FOR EOF
JRST TFIL7
;LAST RECORD OF FILE, DATA ALREADY COPIED
TFIL8: MOVE A,[ICFDB,,BUFF] ;COPY FDB SAVED FROM FIRST RECORD
BLT A,BUFF+.FBLN0
MOVX A,-FLTRX ;FILE TRAILER
MOVEM A,TYP
RETSKP
;DUMPER FORMAT TO INTERCHANGE FORMAT CONVERSION ON OUTPUT
; A/ DUMP BUFFER ADDRESS
ICXBUF=ICOBUF+NHEAD ;DATA AREA OF LOCAL BUFFER
ICOCNV: ACVAR <Q1>
MOVEM A,Q1 ;SAVE BUFFER ADDRESS
TXZ F,TF1 ;NOTE NO OUTPUT DATA YET
TXZN F,ICMT1 ;HAVE PREVIOUS BUFFER?
JRST ICOCNX ;NO, RETURN IMMEDIATELY
MOVEI A,1(Q1) ;CLEAR DEST BUFFER
HRL A,Q1
SETZM -1(A)
BLT A,NIHEAD+PGSIZ-1(Q1)
MOVE A,ICOBUF+XTAPNO ;COPY STANDARD ITEMS - TAPE NUMBER
MOVEM A,G$RTNM(Q1)
MOVX A,GF$NCH ; - FLAGS, NO CHECKSUM
MOVEM A,G$FLAG(Q1)
MOVN A,ICOBUF+XTYP ;DISPATCH ON TYPE
CAIN A,DATAX ;DATA RECORD?
JRST ICODAT
CAIE A,CTPHX
CAIN A,TPHDX ;TAPE HEADER?
JRST ICOTPH
CAIN A,FLHDX ;FILE HEADER?
JRST ICOFLH
CAIN A,FLTRX ;FILE TRAILER?
JRST ICOFLT
CAIN A,TPTRX ;TAPE TRAILER?
JRST ICOTPT
CAIN A,USRX ;USER DATA?
JRST ICOUSR
JRST ICOCNX ;(IMPOSSIBLE)
;STANDARD RETURNS, VALID DATA IN DEST BUFFER
ICOCNY: TXO F,TF1 ;NOTE DATA IN BUFFER
AOS A,RSEQ ;COMPUTE NEXT SEQ NUMBER
MOVEM A,G$SEQ(Q1) ;LEAVE IT IN BUFFER
;NO DATA IN DEST BUFFER
ICOCNX: HRLZ A,CURBUF ;CURRENT DATA BUFFER
HRRI A,ICOBUF+NHEAD ; TO TEMP BUFFER
BLT A,ICOBUF+NHEAD+PGSIZ-1 ;COPY BUFFER
MOVE A,[XBUFF,,ICOBUF] ;NOW COPY HEADER
BLT A,ICOBUF+NHEAD-1
TXO F,ICMT1 ;NOTE ICOBUF VALID
TXNN F,TF1 ;DEST BUFFER VALID?
RET ;NO
RETSKP ;YES
;FINISH PENDING OUTPUT - DONE AT END OF TAPE
ICOFIN: CALL MTOUT ;CAUSE PENDING RECORD TO BE WRITTEN
TXZ F,ICMT1 ;NO PENDING RECORD NOW
RET
;FILE TRAILER, USER DATA - PRODUCE NO OUTPUT
ICOFLT:
ICOUSR: JRST ICOCNX
;TAPE HEADER
ICOTPH: MOVX A,T$BEG ;SAVESET BEGIN
ICOTP1: MOVEM A,G$TYPE(Q1)
MOVE A,ICXBUF+BFTAD ;TAD
MOVEM A,S$DATE(Q1)
MOVX A,BKFMT ;BACKUP FORMAT VERSION
MOVEM A,S$FMT(Q1)
;S$BVER, S$MON, S$SVER, S$APR, S$DEV, S$MTCH NOT PROVIDED
HRROI A,NIHEAD+1(Q1) ;DEST FOR SAVESET NAME
HRROI B,ICXBUF+BFMSG ;SOURCE OF SAVESET NAME
SETZ C,
SOUT ;COPY SAVESET NAME TO DEST BFR
SUBI A,NIHEAD-1(Q1) ;COMPUTE NUMBER WORDS USED
MOVEM A,NIHEAD(Q1) ;SETUP ONE-WORD HEADER
MOVEM A,G$LND(Q1) ;NOTE SIZE OF NON-DATA AREA
MOVX A,O$SSNM ;INCLUDE CODE
HRLM A,NIHEAD(Q1)
JRST ICOCNY ;RETURN VALID BUFFER
;TAPE TRAILER
ICOTPT: MOVX A,T$END ;SAVESET END
JRST ICOTP1 ;SAME AS HEADER
;DATA RECORD
ICODAT: MOVX A,T$FIL ;TYPE CODE
MOVEM A,G$TYPE(Q1)
MOVEI A,PGSIZ ;ASSUME FULL PAGE OF DATA HERE UNLESS...
CAMLE A,ICOLEN ;NOT THAT MUCH LEFT IN FILE
MOVE A,ICOLEN ;USE WHATEVER IS LEFT
MOVEM A,G$SIZ(Q1) ;SET DATA WORD COUNT THIS RECORD
MOVN A,A
ADDM A,ICOLEN ;UPDATE REMAINING COUNT
MOVX A,GF$EOF
MOVN B,TYP ;CHECK TYPE OF NEXT RECORD
CAIN B,FLTRX ;IS IT FILE TRAILER?
IORM A,G$FLAG(Q1) ;YES, NOTE THIS LAST RECORD OF FILE
HRRZ A,ICOBUF+XPAGNO ;COMPUTE RELATIVE WORD NUMBER
IMULI A,PGSIZ
MOVEM A,F$RDW(Q1)
MOVSI A,ICXBUF ;COPY DATA TO DEST BUFFER
HRRI A,NIHEAD(Q1)
BLT A,NIHEAD+PGSIZ-1(Q1)
JRST ICOCNY ;RETURN BUFFER
;FILE HEADER
ICOFLH: MOVX A,T$FIL ;RECORD TYPE
MOVEM A,G$TYPE(Q1)
MOVEI A,F$NND ;NOTE SIZE OF NON-DATA AREA THIS RECORD
MOVEM A,G$LND(Q1)
MOVX A,GF$SOF ;FLAGS - START OF FILE
IORM A,G$FLAG(Q1)
MOVEI D,NIHEAD+1(Q1) ;BEG OF AREA FOR FILENAME
MOVX A,O$NAME ;INDICATE NAME BLOCK
HRLM A,-1(D)
MOVX A,F$NND/2 ;STANDARD SIZE
HRRM A,-1(D)
MOVE B,[POINT 7,ICXBUF+FHNAM] ;PTR TO NAME
ICOFH1: ILDB C,B ;FIND START OF DIRECTORY
CAIE C,DIRBP
JRST ICOFH1
MOVX A,.FCDIR ;INDICATE DIR BLOCK
HRLM A,0(D)
MOVEI A,DIREP
CALL ICOFHC ;COPY DIRECTORY STRING
MOVX A,.FCNAM ;INDICATE NAME BLOCK
HRLM A,0(D)
MOVEI A,EXTPCT
CALL ICOFHC ;COPY NAME STRING
MOVX A,.FCEXT
HRLM A,0(D) ;INDICATE EXT BLOCK
MOVEI A,GENPCT
CALL ICOFHC ;COPY EXT STRING
MOVX A,.FCGEN ;INDICATE GENERATION BLOCK
HRLM A,0(D)
MOVEI A,ATTPCT
CALL ICOFHC ;COPY GENERATION STRING
MOVEI D,NIHEAD+F$NND/2+1(Q1) ;BEG OF AREA FOR ATTRIBUTES
MOVX A,O$FILE ;INDICATE ATTRIBUTE BLOCK
HRLM A,-1(D)
MOVX A,F$NND/2 ;STANDARD SIZE
HRRM A,-1(D)
MOVE A,ICXBUF+FHFDB+.FBWRT
MOVEM A,A$WRIT(D) ;COPY WRITE DATE
LOAD B,FB%BSZ,ICXBUF+FHFDB+.FBBYV ;GET FILE BYTE SIZE
JUMPE B,[ ;IF BYTE SIZE IS ZERO, USE 36
LOAD A,FB%PGC,ICXBUF+FHFDB+.FBBYV ;GET PAGE COUNT
IMULI A,PGSIZ ;GET ACTUAL SIZE IN WORDS
MOVEM A,ICXBUF+FHFDB+.FBSIZ ;AND USE AS FILE BYTE COUNT
MOVEI B,^D36 ;GET BYTE SIZE
JRST .+1]
MOVEM B,A$BSIZ(D)
MOVEI A,^D36
IDIV A,B ;COMPUTE ACTUAL BYTES/WD
MOVE B,ICXBUF+FHFDB+.FBSIZ ;GET FILE BYTE COUNT
MOVEM B,A$LENG(D) ;SET BYTE COUNT
IDIV B,A ;CONVERT BYTE COUNT TO 36-BIT BYTES
SKIPE C ;REMAINDER?
AOS B ;YES, ACCOUNT FOR PARTIAL WORD
MOVEM B,ICOLEN ;KEEP LOCAL COUNT
MOVEM B,A$ALLS(D) ;USE IT AS ALLOCATION ALSO
MOVX A,.DMIMG ;USE STANDARD MODE
MOVEM A,A$MODE(D)
JRST ICOCNY
;LOCAL ROUTINE TO COPY FILESPEC STRING
; A/ TERMINATING CHARACTER FOR CURRENT FIELD
; B/ SOURCE STRING PTR
; D/ DEST ADDRESS
ICOFHC: ACVAR <Q1>
MOVEM A,Q1 ;SAVE TERMINATOR
MOVEI A,1(D) ;CONSTRUCT STRING PTR
HRLI A,(POINT 7,0)
ICOFC1: ILDB C,B ;GET CHAR
CAME C,Q1 ;TERMINATOR?
JUMPN C,[IDPB C,A ;NO, APPEND IT TO DEST
JRST ICOFC1]
SUBI A,-1(D) ;YES, COMPUTE WORDS IN BLOCK
HRRM A,0(D) ;PUT COUNT IN BLOCK HEADER
ADDI D,0(A) ;BUMP DEST PTR
RET
SUBTTL UTILITY SUBROUTINES
;READ LINE INTO LINBUF
; CALL RDLIN
; RETURN +1 ALWAYS
RDLIN: CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
HRROI A,LINBUF
MOVE B,[RD%BRK+RD%BEL+RD%RAI+NLINB*5]
SETZ C,
RDTTY
JSERR
MOVEI B,.CHCRT ;TIE OFF LINE IN CASE ESC OR ^Z
IDPB B,A
MOVEI B,.CHLFD
IDPB B,A
RET
;ROUTINE TO ACCEPT YES/NO ANSWER FROM USER. REQUIRES USER TO
;TYPE Y OR N. RETURNS "TRUE" (NON-0) ON Y, "FALSE" (0) ON N IN AC1.
;CALL WITH PROMPT STRING IN A
YESNO: MOVEM A,CBLK+.CMRTY ;SAVE PROMPT STRING
YESNO0: PUSH P,CBLK+.CMRTY ;SAVE PROMPT STRING
CALL TSTINT ;CHECK FOR INTERRUPT REQUEST
POP P,B ;GET POINTER TO PROMPT
MOVEI A,YESNO1 ;REPARSE ADDRESS
CALL CMDINI ;INIT FOR COMND JSYS
YESNO1: MOVEI B,[FLDDB. .CMKEY,,YNTBL]
COMND
TXNE A,CM%NOP
ERROR YESNO0,<?YES or NO only>
HRRZ D,0(B) ;GET DATA
MOVEI B,[FLDDB. .CMCFM]
COMND
TXNE A,CM%NOP ;CONFIRMED?
ERROR YESNO0,<?NOT CONFIRMED>
MOVE A,D ;GET DATA BACK
RET ;RETURN FROM YESNO, 1= YES, 0= NO IN A
YNTBL: XWD YNTBLZ,YNTBLZ
TB 0,<NO>
TB 1,<YES>
YNTBLZ==.-YNTBL-1
TDRNAM: TXNE F,LDIRF ;YES, TYPE DIR NAMES REQUESTED?
TXNE F,LTTYF ;AND NOT LOGGING TO TTY?
RET ;NO
HRROI B,DIRNAM ;YES, TYPE DIR NAME
CALL TMSGQ
TXNN F,DIRCHG ;SKIP IF DIRECTORY NAMES CHANGE
JRST TDRNA1 ;NO
TMSG < (AS) >
HRROI B,ODRNAM ;OUTPUT DIRECTORY NAME
CALL TMSGQ
TDRNA1: TMSG <
>
RET
; NSVOL - CONVERT INTEGER ARCHIVE TAPE NUMBERS TO SIXBIT
; A/ INTEGER TAPE NUMBER OR SIXBIT VOLID
; RETURNS +1: ALWAYS, A/ SIXBIT VOLID
NSVOL: TLNE A,-1 ;IS IT SIXBIT ALREADY?
RET ;YES, RETURN
MOVE B,A ;COPY INTEGER TO B
SETZ A,
NSVOL1: IDIVI B,12 ;DIVIDE BY 10
ADDI C,20 ;CONVERT REMAINDER TO SIXBIT DIGIT
LSH A,-6 ;MAKE ROOM
DPB C,[POINT 6,A,5] ;STORE IT
JUMPN B,NSVOL1 ;LOOP UNTIL NO DIGITS LEFT
RET
; TYP6 - TYPE SIXBIT QUANTITY IN A
TYP6: MOVE B,A
TYP61: SETZ A,
LSHC A,6 ;GET SIXBIT CHAR
ADDI A,40 ;CONVERT TO ASCII
PBOUT ;TYPE IT
JUMPN B,TYP61 ;LOOP IF MORE CHARACTERS TO TYPE
RET
;PRINT STANDARD ERROR MSG AND RETURN
JSERR1: PUSH P,A
CALL NOCTRO ;TURN OFF CONTROL O
HRROI A,[ASCIZ /
?JSYS error: /]
PSOUT
JRST JSERM1
;ENTRY TO PRINT ERROR MESSAGE ONLY
JSERRM: PUSH P,A
JSERM1: PUSH P,B
PUSH P,C
MOVEI A,101
HRLOI B,400000 ;SAY THIS FORK,,LAST ERROR
SETZ C,
ERSTR
JFCL
JFCL
HRROI A,[ASCIZ /
/]
PSOUT
POP P,C
POP P,B
POP P,A
RET
;TURN OFF CONTROL O (IN CASE IT IS ON) FOR ERROR MESSAGE
NOCTRO: PUSH P,A
PUSH P,B
MOVEI A,.PRIOU ;PRIMARY OUTPUT
RFMOD
TLZ B,(TT%OSP) ;TURN OFF
SFMOD
POP P,B
POP P,A
RET
;HERE IF CHANGED REELS IN MIDDLE OF RESTORING FILE AND PAGE #'S
;MISSING OR DON'T MATCH
MISFPG: TMSGC <%File >
HRROI B,TFNAME ;FILE NAME
CALL TMSGQ
TMSG < continued from previous reel has missing page(s)
>
RET
;SUBROUTINE TO SET UP DEFAULT FILE SPECS FOR THE SOURCE FILE SPECS IN
;THE SAVE AND RESTORE COMMANDS. THE CALLER SUPPLIES IN T1 THE ADDRESS
;OF A LIST OF FOUR ROUTINES TO BE CALLED DEPENDING ON WHETHER OR NOT
;WE ARE IN INTERCHANGE MODE, OR A WHEEL. THE ROUTINES ARE ONE OF:
;
; CSCD SET UP CONNECTED STRUCTURE AND DIRECTORY AS DEFAULTS
; CSWD SET UP CONNECTED STRUCTURE, BUT WILD DIRECTORY
; WSCD SET UP WILD STRUCTURE, BUT CONNECTED DIRECTORY
; WSWD SET UP WILD STRUCTURE AND DIRECTORY AS DEFAULTS
;
;THE BLOCK POINTED TO BY AC T1 GIVES WHICH ROUTINE TO CALL. THE OFFSETS
;INTO THE BLOCK CORRESPOND TO THE FOLLOWING CASES:
;
; 0 NOT WHEEL, NOT INTERCHANGE MODE
; 1 WHEEL, NOT INTERCHANGE MODE
; 2 NOT WHEEL, INTERCHANGE MODE
; 3 WHEEL, INTERCHANGE MODE
FILDFI: SKIPE WHEEL ;PRIVILEGED?
ADDI T1,1 ;YES, CHANGE POINTER TO RIGHT ROUTINE
TXNE F,ICMODF ;INTERCHANGE MODE?
ADDI T1,2 ;YES, CHANGE POINTER SOME MORE
CALL @(T1) ;SET UP STRUCTURE AND DIRECTORY POINTERS
HRROI A,[ASCIZ/*/] ;GET WILDCARD STRING
MOVEM A,GJBLK+.GJNAM ;DEFAULT NAME TO FULL WILDCARD
MOVEM A,GJBLK+.GJEXT ;AND EXTENSION
MOVEI A,.GJALL ;DEFAULT VERSION TO *
HRRM A,GJBLK+.GJGEN
MOVE A,[.PRIIN,,.PRIOU] ;PRIMARY INPUT AND OUTPUT
MOVEM A,GJBLK+.GJSRC
MOVX A,G1%IIN ;FIND INVISABLE FILES
MOVEM A,GJBLK+.GJF2
RET
;ROUTINE TO SET UP DEFAULTS TO BE MY CONNECTED DIRECTORY AND STRUCTURE.
CSCD: MOVE A,CONSTR ;GET POINTER TO CONNECTED STRUCTURE
MOVEM A,GJBLK+.GJDEV ;STORE IT
MOVE A,CONDIR ;AND POINTER TO CONNECTED DIRECTORY
MOVEM A,GJBLK+.GJDIR ;STORE IT TOO
RET ;DONE
;ROUTINE TO SET DEFAULT TO CONNECTED STRUCTURE, BUT WILD DIRECTORY
CSWD: MOVE A,CONSTR ;GET POINTER TO CONNECTED STRUCTURE
MOVEM A,GJBLK+.GJDEV ;SET IT
HRROI A,[ASCIZ/*/] ;THEN GET WILD DIRECTORY STRING
MOVEM A,GJBLK+.GJDIR ;AND SET IT
RET ;DONE
;ROUTINE TO SET DEFAULT TO WILD STRUCTURE, CONNECTED DIRECTORY
WSCD: HRROI A,[ASCIZ/DSK*/] ;POINT TO WILD STRUCTURE STRING
MOVEM A,GJBLK+.GJDEV ;SET IT
MOVE A,CONDIR ;GET POINTER TO CONNECTED DIRECTORY
MOVEM A,GJBLK+.GJDIR ;SET IT TOO
RET ;DONE
;ROUTINE TO SET DEFAULT TO WILD STRUCTURE AND DIRECTORY
WSWD: HRROI A,[ASCIZ/DSK*/] ;POINT TO WILD STRUCTURE
MOVEM A,GJBLK+.GJDEV ;SET IT
HRROI A,[ASCIZ/*/] ;POINT TO WILD DIRECTORY TOO
MOVEM A,GJBLK+.GJDIR ;SET IT
RET ;DONE
;SUBROUTINE TO OBTAIN THE CURRENTLY CONNECTED STRUCTURE AND DIRECTORY.
;POINTERS TO THE STRINGS ARE RETURNED IN LOCATIONS CONSTR AND CONDIR,
;OR ZERO IF WE FAIL. ALWAYS RETURNS +1.
GETCON: SETZM CONSTR ;CLEAR THIS IN CASE OF FAILURE
SETZM CONDIR ;AND THIS TOO
GJINF ;READ INFORMATION ABOUT THIS JOB
HRROI A,CONBUF ;POINT TO STORAGE
DIRST ;STORE CONNECTED STRUCTURE AND DIRECTORY
ERJMP JSERR1 ;FAILED
MOVE A,[POINT 7,CONBUF] ;GET POINTER TO THE STRING
GETCN1: ILDB B,A ;READ NEXT CHARACTER
JUMPE B,R ;RETURN IF STRING ENDS TOO EARLY
CAIE B,DEVPCT ;END OF DEVICE?
JRST GETCN1 ;NO, KEEP GOING
SETZ C, ;YES, GET A NULL
DPB C,A ;OVERWRITE COLON TO TERMINATE DEVICE
HRROI B,CONBUF ;GET POINTER TO DEVICE STRING
MOVEM B,CONSTR ;AND REMEMBER IT
ILDB B,A ;GET NEXT CHARACTER
CAIE B,DIRBP ;DIRECTORY COMING UP?
RET ;NO, RETURN
MOVEM A,CONDIR ;YES, REMEMBER POINTER TO IT
GETCN2: ILDB B,A ;SEARCH FOR END OF DIRECTORY
JUMPE B,R ;DONE IF STRING ENDS
CAIE B,DIREP ;FOUND ENDING PUNCTUATION?
JRST GETCN2 ;NO, KEEP GOING
DPB C,A ;REPLACE BRACKET WITH NULL
RET ;DONE
;USE INPUT FIELDS AS DEFAULTS FOR OUTPUT SIDE
; Q1-1/ INDEX TO JFNLST AND JF2LST TABLES
OFNAME: MOVSI D,-NFFLD ;SETUP NUMBER OF FIELDS TO CONSTRUCT
OFNAM1: MOVE B,JFNLST-1(Q1) ;GET INPUT JFN
HRRO A,FSTRT(D) ;SETUP ADR OF DEFAULT STRING
MOVEM A,GJBLK+.GJDEV(D) ;IN GTJFN BLOCK ALSO
MOVE C,FFLDT(D) ;REQUEST FIELD FROM JFNS
JFNS ;SETUP DEFAULT STRING
OFNAM2: AOBJN D,OFNAM1 ;DO ALL FIELDS
SETZM GJBLK+.GJPRO ;CLEAR PROTECTION WORD WRONGLY SET ABOVE
RET ;HAVE DEFAULT OUTPUT NAME
;NOW COOK UP APPROPRIATE OUTPUT NAME
; P5/ INDEX TO JFNLST AND JF2LST TABLES
OUTFIL: MOVSI Q1,-NFFLD ;SETUP NUMBER OF FIELDS TO CONSTRUCT
SKIPN D,JF2LST(P5) ;HAVE AN OUTPUT SPEC?
JRST [ SETZM GJBLK+.GJDEV ;NO, USE DEFAULT DEVICE
MOVX D,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;ASSUME ALL STARS
JRST .+1]
OUTFI1: MOVE B,D ;USE OUTPUT JFN UNLESS...
HLLZ A,FSTRT(Q1) ;GET STAR BIT FOR THIS FIELD
TDNE D,A ;OUTPUT STAR HERE?
HRRZ B,JFN ;YES, USE INPUT FIELD
HRRO A,FSTRT(Q1) ;SETUP ADR OF DEFAULT STRING
MOVEM A,GJBLK+.GJDEV(Q1) ;IN GTJFN BLOCK ALSO
MOVE C,FFLDT(Q1) ;REQUEST FIELD FROM JFNS
JFNS ;SETUP DEFAULT STRING
OUTFI2: AOBJN Q1,OUTFI1 ;DO ALL FIELDS
SETZM GJBLK+.GJPRO ;CLEAR PROTECTION WORD WRONGLY SET ABOVE
RET
;HERE GET FULL OUTPUT FILE SPEC, DEVICE THROUGH GENERATION
;STORE IN ONMBUF
GOFNAM: HRROI A,ONMBUF ;STORE NAME HERE
MOVX D,GJ%DEV+GJ%UNT ;DEVICE
MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF>
CALL .JFNS ;DO JFNS
MOVX D,GJ%DIR ;DIRECTORY
MOVX C,<FLD(.JSAOF,JS%DIR)+JS%PAF>
CALL .JFNS
MOVX D,GJ%NAM ;NAME
MOVX C,<FLD(.JSAOF,JS%NAM)+JS%PAF>
MOVEM A,ONMPTR ;SAVE NAME POINTER
CALL .JFNS
MOVX D,GJ%EXT ;EXTENSION
MOVX C,<FLD(.JSAOF,JS%TYP)+JS%PAF>
CALL .JFNS
MOVX D,GJ%VER ;GENERATION #
MOVX C,<FLD(.JSAOF,JS%GEN)+JS%PAF>
MOVEM A,OGNPTR ;SAVE GENERATION POINTER
; CALLRET .JFNS ;GET GEN # AND RETURN FROM GOFNAM
.JFNS: TDNN D,JF2LST(P5) ;OUTPUT * HERE?
SKIPN B,JF2LST(P5) ;NO, USE OUTPUT FIELD
HRRZ B,JFN ;PICKUP INPUT FIELD
JFNS
RET
;GET REST OF OUTPUT FILE NAME: PROTECTION, ACCOUNT, AND ;T
GOFPAT: TXNE F,ICMODF ;INTERCHANGE MODE?
JRST GOFPT1 ;YES, DON'T USE TAPE PROTECTION
MOVX D,GJ%PRO ;PROTECTION
MOVX C,<FLD(.JSAOF,JS%PRO)+JS%PAF>
TXNE F,RESPRO ;USE SYSTEM DEFAULT?
CALL .JFNSX ;NO-- GET SPECIFIED VALUE
GOFPT1: MOVX D,GJ%TFS ; ;T
MOVX C,<JS%TMP+JS%PAF>
CALL .JFNSX ;GET ;T
MOVEM A,OACPTR ;REMEMBER WHERE ACCOUNT STARTS
MOVX D,GJ%ACT ;ACCOUNT
MOVX C,<FLD(.JSAOF,JS%ACT)+JS%PAF>
TXNE F,RESACC ;USE SYSTEM DEFAULT?
CALL .JFNSX ;NO-- GET SPECIFIED VALUE
RET ;RETURN FROM GOFPAT
.JFNSX: TXNE F,ICMODF ;INTERCHANGE MODE?
TDNE D,JF2LST(P5) ;YES-- BUT IS OUTPUT SPECIFIED?
SKIPA ;OUTPUT SPECIFIED OR NOT INTERCHANGE-- OK
RET ;INTERCHANGE MODE AND NO OUTPUT SPEC-- USE SYSTEM DEFAULT
TDNE D,JF2LST(P5) ;OUTPUT SPECIFIED HERE?
SKIPN B,JF2LST(P5) ;YES, USE OUTPUT FIELD
HRRZ B,JFN ;PICKUP INPUT FIELD
JFNS
RET
;FILESPEC FIELD TABLES
FSTRT: GJ%DEV+GJ%UNT+DEFDEV ;STAR FOR DEVICE ,, DEFAULT DEVICE STRING
GJ%DIR+DEFDIR ;STAR FOR DIRECTORY
GJ%NAM+DEFNAM ; " NAME
GJ%EXT+DEFEXT ; " EXTENSION
GJ%VER+DEFVER ; " VERSION
FFLDT: 1B2 ;JFNS PRINT DEVICE
1B5 ;JFNS PRINT DIRECTORY
1B8 ; " NAME
1B11 ; " EXTENSION
1B14 ; " VERSION
NFFLD==.-FFLDT
;HERE TO FIGURE FILE SIZE IN PAGES AND REMAINDER
FILSZE: LOAD A,FB%BSZ,BUFF+FHFDB+.FBBYV
MOVEI B,44 ;BITS IN A WORD
IDIV B,A ;BYTES IN A WORD
MOVE C,BUFF+FHFDB+.FBSIZ ;BYTES IN FILE
IDIV C,B ;WORDS IN FILE
SKIPE D ;SKIP IF NO REMAINDER
AOS C
IDIVI C,PGSIZ ;PAGES IN FILE
MOVEM C,FPGCNT ;FILE PAGE COUNT
MOVEM D,RMRPGE ;REMAINDER PAGE
RET
;HERE FOR CHECKSUM OF PAGE
PGECSM: TXNE F,CS%SEQ ;SKIP IF NOT SEQUENTIAL CHECKSUM
JRST SEQCSM ;DO SEQUENTIAL CHECKSUM
HRRZ D,PAGNO ;GET PAGE #
SUB D,LSTPGE ;SEE IF HOLE
SOJLE D,PCHKS1 ;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,-BUFF(P) ;ARRANGE TO POINT AT IT
CALL CHKSOM ;CHECKSUM 1 WORD
POP P,(P) ;RESTORE STACK
PCHKS1: MOVSI C,-1000 ;SETUP AOBJN POINTER TO WHOLE PAGE
CALL CHKSOM ;CHECKSUM IT
MOVE A,PAGNO ;GET PAGE #
HRRZM A,LSTPGE ;STORE
RET ;DONE WITH PAGE
;HERE FOR SEQUENTIAL CHECKSUM
SEQCSM: SOSGE FPGCNT ;DECREMENT WHOLE PAGE CONT
JRST SEQCS1 ;NO WHOLE PAGES LEFT
MOVSI C,-1000 ;WORDS TO CHECKSUM
CALLRET CHKSOM ;CHECKSUM PAGE
SEQCS1: SKIPN C,RMRPGE ;GET REMAINDER TO CHECK
RET ;NOTHING TO CHECK
MOVNS C ;NEGATE WORDS TO CHECK
HRLZS C ;...
SETZM RMRPGE ;DON'T CHECK AGAIN
CALLRET CHKSOM ;CHECK SUM PAGE
;HERE TO CHECKSUM COUNT OF WORDS IN C
CHKSOM: MOVE D,CHKCN0
CHKSM1: ROT D,1
ADD D,BUFF(C)
AOBJN C,CHKSM1 ;LOOP ON WORD COUNT
MOVEM D,CHKCN0
RET
;ROUTINES TO MANIPULATE JFN STACK
;ADD JFN TO JFN STACK
;ALL AC'S PRESERVED
; B HAS JFN IN RIGHT HALF
ADLIST: PUSH P,D ;SAVE AC
HLRZ D,CURPTR ;CHECK FOR STACK OVERFLOW
CAIN D,-1 ;SKIP IF NOT FULL
ERROR START,<?JFN STACK OVERFLOW>
MOVE D,CURPTR ;PICK UP STACK POINTER
PUSH D,B ;PUT JFN ON STACK
MOVEM D,CURPTR ;STORE UPDATED STACK POINTER
POP P,D ;RESTORE D
RET ;RETURN
;HERE TO RELEASE JFN STORED ON STACK
; A HAS JFN IN RH
RLSJFN: HRRZS A ;CLEAR LEFT HALF
GTSTS ;GET JFN STATUS
TXNN B,GS%NAM ;SKIP IF JFN OWNED
RET ;NOTHING TO DO
TXNN B,GS%OPN ;SKIP IF JFN IS OPEN
JRST [RLJFN ;RELEASE IT IF NOT
ERROR START,<?CANNOT RELEASE JFN>
RET]
CLOSF ;CLOSE AND RELEASE JFN
ERROR START,<?CANNOT CLOSE AND RELEASE JFN>
RET
;HERE TO ADD A FILE--BE SURE IT IS A DISK FILE
ADFILE: CALL ADLIST ;ADD TO JFN STACK
CALL CHKDVC ;CHECK FOR DEVICE DISK
RET
;ROUTINE TO TAKE JFN'S OFF STACK
; D HAS FINAL DESIRED POINTER
; RETURNS FINAL DESIRED POINTER IN D
;ASSUMES A,B,C,D ARE FREE
RSTSTK: CAMN D,CURPTR ;SEE IF ANYTHING THERE
RET ;NOPE
PUSH P,D ;SAVE FINAL POINTER
MOVE D,CURPTR ;CURRENT POINTER
RSTST1: POP D,A ;GET JFN OFF STACK
CALL RLSJFN ;RELEASE JFN
CAME D,(P) ;COMPARE POINTERS
JRST RSTST1 ;NOT DONE
POP P,D ;GET FINAL POINTER
MOVEM D,CURPTR ;USE AS CURRENT POINTER
RET ;RETURN
;CHKDVC - CHECK THAT JFN IN B SPECIFIES A DISK FILE
CHKDVC: PUSH P,A ;SAVE AC'S
PUSH P,B
HRRZ A,B ;GET JFN TO CHECK
DVCHR
ERJMP CHKDV1 ;PROBABLY STDVX1 (NO SUCH DEVICE)
LOAD A,DV%TYP,B
CAIE A,.DVDSK ;SHOULD ALWAYS BE A DISK FILE TYPE
CHKDV1: ERROR BMBCM1,<?DEVICE MUST BE DISK>
POP P,B
POP P,A
RET
;HERE TO RESET BACK TO INIPTR
INIRST: MOVE D,INIPTR ;FINAL POINTER
CALL RSTSTK ;RESET STACK TO START OF WORLD
MOVEM D,RPSPTR ;RESET REPARSE POINTER
MOVEM D,CMDPTR ;COMMAND POINTER
RET
TTNOUT: MOVEI A,.PRIOU
NOUT
JSERR
RET
BTNOUT: TXNN F,LTTYF ;LISTING TO TTY?
CALL TTNOUT ;NO, DO TTY FIRST
LPNOUT: SKIPN LPTJFN ;SKIP IF LISTING
RET
HRROI A,LPTBUF ;PUT NUMBER IN LOCAL BUFFER FIRST
NOUT
JSERR
PUSH P,B
PUSH P,C
MOVE B,[POINT 7,LPTBUF]
CALL LPMSGQ ;TRANSMIT TO LPT
POP P,C
POP P,B
RET
TMSGQC: PUSH P,B
MOVEI 1,.PRIOU
DOBE
RFPOS
TRNN B,-1
JRST TMSGC1
TMSG <
>
TMSGC1: POP P,B
TMSGQ: MOVEI 1,.PRIOU
MOVEI C,0
SOUT
RET
BTMSQC: PUSH P,B
TXNE F,LTTYF
SKIPN A,LPTJFN
JRST BTMSC1
DOBE
RFPOS
TRNN B,-1
JRST BTMSC2
BTMSC1: LPMSG <
>
BTMSC2: MOVE B,(P)
TXNN F,LTTYF
CALL TMSGQC
POP P,B
CALLRET LPMSGQ
BTMSGQ: PUSH P,B
TXNN F,LTTYF ;NOT TO TTY IF LOGGING IS TO TTY
CALL TMSGQ
POP P,B
LPMSGQ: SKIPN LPTJFN
RET
MOVE A,LPTLIN
CAIL A,PAGLEN ;AT END OF LISTING PAGE?
CALL LNEWPG ;YES, START A NEW ONE
MOVE A,LPTJFN
MOVEI C,0
PUSH P,B ;SAVE PTR
SOUT
POP P,B ;RECOVER PTR
HLRZ A,B ;NORMALIZE IT
CAIN A,-1
HRLI B,(POINT 7,0)
LPTM1: ILDB A,B ;ACCOUNT LINE POSITION
JUMPE A,R ;NULL, DONE
CAIN A,.CHLFD ;EOL
JRST [ SETZM LPTPOS ;RESET
AOS LPTLIN ;COUNT LINES
JRST LPTM1]
CAIN A,.CHTAB ;TAB?
JRST [ MOVEI A,7 ;YES, BUMP
IORM A,LPTPOS
JRST .+1]
AOS LPTPOS ;COUNT ONE SPACE
JRST LPTM1
;START NEW LISTING PAGE
LNEWPG: SKIPE LPTJFN
SKIPE LPTPOS ;DON'T OUTPUT HEADER UNLESS AT START OF LINE!
RET
PUSH P,B
MOVE A,LPTJFN
MOVEI B,.CHFFD ;SEND A FORMFEED
BOUT
HRROI B,LSTHDR ;SEND PAGE HEADER
SETZ C,
SOUT
HRROI B,[ASCIZ / Page /]
SOUT ;SEND PAGE NUMBER
AOS B,LPTPAG
MOVEI C,^D10
NOUT
JSERR
HRROI B,[ASCIZ /
/]
SETZ C,
SOUT ;FINISH HEADER
MOVEI B,2 ;INIT LINE COUNT TO NUMBER LINES
MOVEM B,LPTLIN ; PRINTED ABOVE
POP P,B
RET
;TAB TO SPECIFIED COLUMN IN LISTING FILE
; B/ COLUMN
TAB: SKIPN LPTJFN
RET
MOVE A,LPTLIN
CAIL A,PAGLEN ;AT END OF LISTING PAGE?
CALL LNEWPG ;YES, START A NEW ONE
SUB B,LPTPOS ;COMPUTE NUMBER SPACES NEEDED
JUMPLE B,R ;MAYBE NONE
ADDM B,LPTPOS ;UPDATE POSITION
MOVE A,LPTJFN
MOVN C,B
HRROI B,SPACES
SOUT ;OUTPUT THEM
RET
SPACES: ASCII / /
ASCII / /
;HERE TO PRINT CHECKSUM OF FILE
PRTCSM: MOVEI B,CSCOL ;CHECKSUM COLUMN
CALL TAB ;TAB TO CHECKSUM
HLRZ B,CHKCN0
HRRZ C,CHKCN0
ADD C,B ;MAKE IT 18-BITS WORTH
HLRZ B,C ;...
ADDI B,(C) ;...
MOVEI C,^D8 ;OCTAL RADIX
TXO C,NO%LFL+NO%ZRO
TLO C,6 ;6 COLUMNS
CALL LPNOUT
TXNN F,CS%SEQ ;SKIP IF SEQUENTIAL CHECKSUM
LPMSG < P> ;FLAG AS BY-PAGES CHECKSUM
RET
; Here to say HELLO to QUASAR, get our PID etc.
QSRINI: SAVEQ
SETZM NXTRTP ; No next
CALL GQPID ;GET QUASAR'S PID IN QSRPID
RET ;FAILED
GJINF ; GET JOB #
MOVE D,C ; SAVE THE JOB #
MOVEI A,3 ; LENGTH OF BLK
MOVEI B,C ; LOCATION OF BLK
MOVEI C,.MUSPQ ; SET PID QUOTA
MOVEI D+1,^D15 ; MAX NUMBER OF PIDS
MUTIL
JRST [ TMSG <%FAILED TO SET PID QUOTA FOR DUMPER
>
JRST .+1]
MOVEI A,3
MOVEI B,C
MOVEI C,.MUCRE ; Create a PID for me
MOVEI D,.FHSLF ; No flags etc
MUTIL
JRST [ SETZM MYPID
TMSG <?Unable to create a PID for DUMPER
>
RET]
MOVEM Q1,MYPID ; Remember mine too
MOVEI A,3
MOVEI B,C
MOVEI C,.MUPIC ; Set my PID on an interrupt channel
MOVE D,MYPID
MOVEI Q1,QSRCHN
MUTIL
JRST [ TMSG <?Unable to set DUMPER PID on interrupt channel
>
RET]
MOVEI A,3
MOVEI B,C
MOVEI C,.MUSSQ ; Set recieve/send quotas
MOVE D,MYPID
MOVEI Q1,777777 ; 777 For each
MUTIL
JRST [ TMSG <%Unable to set send/recieve quotas to maximum
>
JRST .+1]
SETZ A, ; No bits
CALL HELLO ; Say we are here
RET ; SAY INIT FAILED
RETSKP
RETCLN: CALL GDBYE ; Say good-bye to QUASAR
JFCL ; UNABLE TO TELL QUASAR GOODBYE
CALL RELPID ; PID IS NO LONGER NEEDED
; Now process all built up retrieval message files
RETCL1: MOVX A,GJ%OLD+GJ%IFG+GJ%SHT
HRROI B,[ASCIZ/SYSTEM:*.RET-MSGS.*/]
GTJFN
RET
PUSH P,A ; Save the JFN
HRRZS A ; Ditch the bits
MOVE B,[FLD(7,OF%BSZ)+OF%RD]
OPENF
FATAL <RETCLN: Failed to open retrieval msg file>
MOVE B,[1,,.FBSIZ]
MOVEI C,C
GTFDB ; Get # of bytes in the file
MOVNS C ; Faster with neg count
PUSH P,C ; Save file count
MOVE B,[SNDBDY,,SNDBDY+1]
SETZM -1(B)
BLT B,SNDBDY+NSNDBD-1 ; Clear the space
MOVE A,[POINT 7,SNDBDY]
MOVEM A,SNDTXT
HRROI B,[ASCIZ/ The following files have been restored/]
SETZB C,D
SOUT
CALL IFHOST ; Output a host name if applicable
HRROI B,[ASCIZ/:
/]
SOUT
POP P,C ; Recover file count
MOVE B,A ; Move pointer
HRRZ A,0(P) ; And JFN
SIN ; Eat the file
HRROI A,TOLST
MOVEM A,SNDTO
HRRZ B,0(P)
MOVX C,<FLD(.JSAOF,JS%NAM)>
JFNS ; Who gets this msg
HRROI B,[ASCIZ/Files restored to disk/]
MOVEM B,SNDSUB
MOVEI A,SNDTO ; Point to the sndmsg blk
CALL MLTLST
HRRZ A,0(P)
TXO A,CO%NRJ
CLOSF
JFCL
TXZ A,CO%NRJ
DELF
CALL JSERR1 ; Report error
ADJSP P,-1
JRST RETCL1 ; Do all there are
; Here to get ptr to next file to restore
; Returns: +1 no more retrievals; +2 1/ Ptr to retrieval blk
; **** Note **** RETWAT is a tag that QSRINT looks for - if DUMPER is
; in the WAIT JSYS at RETWAT-1, then QSRINT bumps the PC by one to cause
; the WAIT to terminate when the DEBRK in QSRINT is done. This skips over
; the JRST NXTRE1
NXTRET: SKIPN P6,NXTRTP ; Next request ready for us?
WAIT ; No, wait until QUASAR gets to us
RETWAT: JRST NXTRE1 ; If here, we have a ptr in C
JFCL ; Is this needed????
SETZ A, ; In case we get none
SKIPN P6,NXTRTP ; Make sure we've a copy of the ptr
RET ; No more to do
NXTRE1: HRROI B,FILNM(P6) ; Point to file name
CALL TSTNAM ; Ok?
JRST [ RLJFN
JFCL
CALL REFUSE ; Don't want this one
JRST NXTRET] ; Try again
RLJFN
JFCL
MOVX A,GJ%OLD+GJ%XTN ;GET FLAGS
MOVEM A,RETBLK+.GJGEN ;SET IN BLOCK
MOVEI A,RETBLK ; Use blk with invisible etc.
HRROI B,FILNM(P6) ; Point to name
GTJFN
JRST NXTRE2 ;GTJFN FAILED
MOVE B,[1,,.FBCTL] ; Get CTL word
MOVEI C,C
GTFDB
RLJFN ;DUMP JFN
JFCL
TXNN C,FB%OFF ; File offline?
JRST [ CALL RETOK ;YES, RELEASE RETRIEVAL REQUEST
JRST NXTRET] ; Try again
MOVE A,P6 ; Hand the pointer back
RETSKP ; Return with ptr
NXTRE2: CAIN A,GJFX16 ;INVALID DEVICE?
JRST [ TMSGC <%Structure not mounted, skipping file > ;YES
HRROI A,FILNM(P6)
PSOUT ;DISPLAY FILENAME
CALL TCRLF ;CRLF
CALL REFUSE ;REQUEUE THE REQUEST
JRST NXTRET] ;GET NEXT RETRIEVAL REQUEST
CALL BADOFP ;SOME OTHER ERROR, COMPOSE MESSAGE
CALL WASHOU ;TELL USER AND REQUESTOR
CALL RELQSR ;RELEASE THE RETRIEVAL REQUEST
JFCL
JRST NXTRET
; RETTAP - GET RETRIEVAL TAPE MOUNTED
; P6/ ADDRESS OF INFORMATION BLOCK OF FILE TO BE RETRIEVED
RETTAP: SAVEQ
CALL UNLOAD
CALL MTCLS
RETTA1: LOAD A,TPNM2,(P6)
SKIPGE .ARODT(P6)
LOAD A,TPNM1,(P6) ; Use alternate tape #
CALL NSVOL ;CONVERT TO SIXBIT IF NECESSARY
MOVE Q1,A ;COPY VOLID TO A SAFE PLACE
MOVEI A,.SFMTA
TMON ;TAPE DRIVE ALLOCATION ENABLED?
JUMPN B,RETTA3 ;YES, CALL FOR TAPE MOUNT THRU QUASAR
TMSGC <%Please mount tape >
MOVE A,Q1 ;GET VOLID
CALL TYP6 ;TYPE VOLID
HRROI A,[ASCIZ \ Is this tape available? \]
CALL YESNO ; Tape may be broken, lost, etc.
JUMPN A,[CALL NTAPER ;SAID YES, GET TAPE SPEC
JRST BMBCMD ;CAN'T
MOVEM Q1,VOLID6 ;SET CURRENT VOLID
JRST RETTA4]
RETTA2: HRROI P1,[ASCIZ/Tape currently unavailable
/]
CALL RETFAI ; Say that failed
JUMPE P6,R ; None left in Q
LOAD A,TPNM2,(P6) ; Get tape # on this one
SKIPGE .ARODT(P6)
LOAD A,TPNM1,(P6)
CALL NSVOL ;CONVERT TO SIXBIT IF NECESSARY
CAMN A,Q1 ; Same as last one?
JRST RETTA2 ; Yes, assume tape still unavailable
JRST RETTA1 ; Try this tape
RETTA3: MOVE A,Q1 ;GET VOLID
CALL MREQ ;SEND MOUNT REQUEST AND GET ANSWER
JRST [ HRROI A,[ASCIZ/Try again? /] ;FAILED
CALL YESNO
JUMPN A,RETTA3 ;WANTS TO TRY AGAIN
JRST RETTA2] ;DON'T TRY AGAIN
RETTA4: SETOM RTAPNO ;TAPE IS READY, SET TAPE # UNKNOWN
CALL MTOPNX
CALL REWCV ;REWIND IT
CALLRET MTCLS ;CLOSE AND RETURN TO CALLER
; Here to report file retrieved (to user)
RETOK: HRROI A,TOLST
MOVE B,TPRQUS ; Get requesting user
DIRST
RET ; ? No such user?
MOVEI A,[0,,0 ; Either use old or create one
.NULIO,,.NULIO ; No I/O
-1,,[ASCIZ /SYSTEM/]
0
-1,,TOLST ; User name
-1,,[ASCIZ/RET-MSGS/] ; Type
0
0
0]
HRROI B,CRLF ; Use defaults
GTJFN
FATAL <RETOK: Failed to get user retrieval file>
MOVX B,<FLD(7,OF%BSZ)+OF%APP>
OPENF
FATAL <RETOK: Failed open retrieval msg file>
HRROI B,FILNM(P6) ; Point to the file
SETZB C,D
SOUT
movei b," "
bout
seto b, ; time stamp it
setz c,
odtim
HRROI B,CRLF
SOUT
CLOSF
JRST [ TMSG <%Failed to close retrieval msg file
>
JRST .+1]
CALL RELQSR ; Release the ret request
JFCL
RET
; Here to say we're done with a request block
RELQSR: SETZM NXTRTP ; Nothing there now
CALL ZIPMSS ; Setup to send
MOVE B,[REL.SZ,,.QOREL] ; Set to release the one we've done
MOVEM B,.MSTYP(P1) ; Length and type
MOVE B,TPTSK ; Include the task name
MOVEM B,REL.IT(P1) ; Internal task name
MOVE P1,[REL.SZ,,QSRMSS]
CALL SNDQSR ; Send the release
JRST [ TMSG <%Failed to release task
>
RET] ; Just abort now
RETSKP
; Here to say "no thanks" to QUASAR's choice of retrieve requests
REFUSE: GTAD ; Get timestamp
MOVE B,TPBLK+.ARODT
TXNE B,%EQUFT ; Using alternate tape?
TXO A,%EQUFT ; Yes, send it back that way
CALL REQUE
JFCL
RET
; Here to abort current retrieval; Assumes retrieval described by
; info in TPBLK
ABTRET: TMSG <%Retrieve aborted
>
CALL RELQSR ; Tell QUASAR we're "done"
JFCL
CALL NXTRET ; Step to the next retrieval
SETOM VOLID6 ; None left
RETSKP
; Here when a retrieval failed; P1 has string ptr to error message
; Assumes current blk
RETFAI: SKIPGE .ARODT(P6) ; Already on 2nd set of tapes?
JRST [ CALL WASHOU ; Yes, Bomb this retrieve request
CALL RELQSR ; Release the task
JFCL
CALL NXTRET ; Get the next one
SETOM VOLID6 ; No next
RET]
MOVX A,%EQUFT ; Flag we want alternate tapes
CALL REQUE ; And requeue the request
JFCL
CALL NXTRET ; Get the next one
SETOM VOLID6 ; No next
RET
; BADOFP - COMPOSE ERROR MESSAGE FOR BAD OFFLINE FILE POINTER
; A/ ERROR CODE
; RETURNS +1: ALWAYS, P1/ -1 ,, ADDRESS OF ERROR MESSAGE
BADOFP: MOVE D,A ;SAVE ERROR CODE
HRROI A,TEMP ;BUILD MESSAGE HERE
HRROI B,[ASCIZ/ CANNOT ACCESS OFFLINE FILE POINTER: /]
SETZ C,
SOUT
MOVSI B,.FHSLF ;GET DUMMY HANDLE
HRR B,D ; ,, ERRORCODE
ERSTR ;TACK ON ERROR STRING
JFCL
JFCL
HRROI P1,TEMP ;RETURN ADDRESS OF TEXT TO CALLER
RET
; Here to report terrible failure to requestor
; Error message ptr in P1
WASHOU: TMSG <%Failed to restore >
MOVE Q1,P6
HRROI A,FILNM(Q1) ; Point to file name
PSOUT
TMSGC < Because >
MOVE B,P1
CALL TMSGQ
HRROI A,CRLF
PSOUT
HRROI A,TOLST
MOVEM A,SNDTO ; Pointer to TO list
HRROI B,[ASCIZ /PS:</]
SETZB C,D
SOUT
MOVE B,TPRQUS ; Get user that requested it
DIRST
JRST [ MOVE A,SNDTO
HRROI B,[ASCIZ/*SYSTEM:RETRIEVAL.FAILURES/]
SETZB C,D
SOUT
JRST WASHO1]
MOVEI C,">"
IDPB C,A
IDPB D,A ; End the thing
WASHO1: HRROI B,[ASCIZ/Files not retrieved/]
MOVEM B,SNDSUB ; Subject
HRROI A,SNDBDY
MOVEM A,SNDTXT ; Ptr to text part
HRROI B,FILNM(Q1) ; Point to file name
SETZB C,D
SOUT
CALL IFHOST ; Host name (maybe)
HRROI B,[ASCIZ/ was not retrieved because:
/]
SOUT
MOVE B,P1 ; Error message
SOUT
MOVEI A,SNDTO ; Point to blk
CALL SNDMSG ; Send the failure message off
SOS NJFN1 ; Discount one of them
; SET THE BIT IN THE FILE'S FDB SAYING THAT THE RETRIEVAL FAILED
SETZM GJBLK ;ZERO GTJFN ARG BLOCK
MOVE A,[GJBLK,,GJBLK+1]
BLT A,GJBLK+.GJBFP
MOVX A,GJ%OLD+GJ%XTN
MOVEM A,GJBLK+.GJGEN ;OLD FILE, LONG GTJFN BLOCK
MOVX A,G1%IIN
MOVEM A,GJBLK+.GJF2 ;INCLUDE INVISIBLE FILES
MOVE A,[.NULIO,,.NULIO]
MOVEM A,GJBLK+.GJSRC ;JUST USE STRING
MOVEI A,GJBLK ;GET ARG BLOCK ADDRESS
HRROI B,FILNM(Q1) ;GET POINTER TO FILESPEC
GTJFN ;GET JFN ON FILE
JRST WASHO2
MOVEI B,.ARRFL
ARCF ;SET AR%RFL (RETRIEVE FAILED) IN FDB
ERJMP .+1
RLJFN ;DUMP JFN
JFCL
WASHO2: RET
; Here to build message to user about files which have been archived
; JFN to current file in A
ARMSUS: PUSH P,B ; Save flag (0=> file flushed)
TLC A,-1
TLCN A,-1 ; Make sure of good ptr
HRLI A,(POINT 7)
PUSH P,A
SKIPN LTARDR ; Have a previous one?
JRST ARMSU2 ; No, start things going
HRROI B,TEMP
EXCH A,B
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS
MOVE A,[POINT 7,LTARDR]
MOVE B,[POINT 7,TEMP]
STCMP ; Compare them
JXE A,SC%LSS+SC%SUB+SC%GTR,ARMSU1
MOVEI A,SNDTO
CALL SNDMSG ; Send it off
ARMSU2: MOVE A,[POINT 7,LTARDR] ; Pointer to dir name for msg
MOVEM A,SNDTO
MOVE B,0(P) ; JFN of current file
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
JFNS ; Save this directory
HRROI A,[ASCIZ /Collected files/]
SKIPG COLSW
HRROI A,[ASCIZ /Migrated files/]
SKIPE ARCSW
HRROI A,[ASCIZ /Archived files/]
MOVEM A,SNDSUB
HRROI A,SNDBDY ; Set up things
MOVEM A,SNDTXT ; Point to where text starts
HRROI B,[ASCIZ / The following files have been collected/]
SKIPG COLSW
HRROI B,[ASCIZ / The following files have been migrated/]
SKIPE ARCSW
HRROI B,[ASCIZ/ The following files have been archived/]
SETZB C,D
SOUT
CALL IFHOST ; Do host name (maybe)
HRROI B,[ASCIZ/:
/]
SOUT
MOVEM A,CURSNP ; Save the pointer
ARMSU1: MOVE A,CURSNP
MOVE B,0(P)
MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
JFNS
SKIPN ARCSW ; The following only on archive runs
JRST ARMSU3
HRROI B,[ASCIZ/ File archived/]
SKIPN -1(P)
HRROI B,[ASCIZ/ File archived, contents deleted/]
SETZB C,D
SOUT
ARMSU3: HRROI B,CRLF
SETZB C,D
SOUT
MOVEM A,CURSNP ; Update the ptr
POP P,A
POP P,B ; Flag
RET
;SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT
; A/ POINTER TO ASCIZ STRING
; B/ ADDRESS OF WORD IN WHICH TO STORE 6-BIT STRING
;RETURNS: +1, ALWAYS
SEVSIX: SETZM (B) ;ZERO WORD FIRST
HRLI B,(POINT 6,0) ;SET UP SIXBIT POINTER
MOVEI D,6 ;MAXIMUM OF 6 CHARACTERS
SEVLOP: ILDB C,A ;GET 7-BIT CHARACTER
JUMPE C,R ;RETURN IF END OF STRING
CAIL C,"a" ;LOWER CASE ALPHA?
TRZ C,40 ;YES, CHANGE TO UPPER CASE
SUBI C,40 ;CONVERT TO 6-BIT
IDPB C,B ;STORE CHARACTER
SOJG D,SEVLOP ;JUMP IF MORE CHARACTERS
RET
; Here to build scratch file to give to SND (actually do the SNDMSG)
; A has location of pointer to to SNDMSG block
; Which is 0: TO list ptr to be converted to directory # for MLTOWN
; 1: Subject ptr
; 2: Text body ptr
SNDMSG: PUSH P,A ; Save location of blk ptr
MOVX A,RC%EMO ; Exact match only
MOVE B,@0(P) ; Get pointer to directory string
SETZ C,
RCDIR
TXNE A,RC%NOM+RC%AMB+RC%NMD ; Any form of failure?
JRST [ TMSG <%RCDIR in SNDMSG failed
>
RET]
POP P,B ; Blk ptr location
MOVEM C,0(B) ; Directory #
MOVE A,B
CALL MLTOWN ; Do the work
RET
; Here to output a host name if applicable - A setup with output
; designator
IFHOST: PUSH P,A ; Save state of byte ptr
SKIPLE LHOSTN ; Any host #?
JRST [ HRROI B,[ASCIZ/ on /]
SOUT ; Yes, add it
MOVE B,LHOSTN
CVHST
ERJMP [MOVE A,0(P) ; Take back the " on "
JRST .+1]
CAIL A,600000 ; Did we get an error of some kind?
CAILE A,677777
JRST .+1 ; No, all is fine
MOVE A,0(P) ; Yes, an error, take back " on "
JRST .+1]
POP P,0(P) ; Byte ptr no longer needed
RET
; Here to see if a file name matches specs given by user
; Accepts pointer to file name on tape in B
; Returns JFN for file on tape in A
TSTNAM: MOVX A,GJ%OFG+GJ%SHT ;SET TO PARSE NAME
GTJFN
JRST [ CALLRET JSERR1] ;SHOULDN'T FAIL
PUSH P,A
HRLZ P5,NJFN ;SCAN ALL SPECS GIVEN TO LOAD
TSTNA3: SKIPN B,JFNLST(P5) ;JFN STILL HERE?
JRST [ AOBJN P5,TSTNA3 ;NO, IT WAS COMPLETED
POP P,A ;RETURN JFN IN A
RET] ;DONE ALL FILESPECS, FAILED TO MATCH
MOVEI A,.WLJFN ;WANT TO COMPARE FILE SPECS
HRRZ C,0(P) ;GET CURRENT FILE JFN
WILD% ;FIND DIFFERENCES BETWEEN THE SPECS
ERJMP TSTN3A ;FAILED
TXNE A,WL%DEV!WL%DIR!WL%NAM!WL%EXT!WL%GEN ;ANY MISMATCHES?
JRST [ AOBJN P5,TSTNA3 ;YES, STEP TO NEXT FILESPEC
POP P,A ;DONE ALL FILESPECS, FAILED TO MATCH ANY
RET]
POP P,A ; Return JFN in A
RETSKP ; Is OK
;********TEMPORARY FOR REL 3A RUNNABILITY (several pages)
TSTN3A:MOVSI Q1,-NFFLD ;SCAN ALL FIELDS OF FILESPEC
AOBJN Q1,.+1 ;SKIP DEVICE FIELD
TSTNA2: HRROI A,FBUF1 ;GET STRINGS FOR NEXT FIELD
MOVE B,0(P) ;JFN FOR FILE ON TAPE
MOVE C,FFLDT(Q1)
JFNS ;FOR FILE ON TAPE...
HRROI A,FBUF2
MOVE B,JFNLST(P5)
MOVE C,FFLDT(Q1)
JFNS ;FOR LOAD FILESPEC
MOVE A,[POINT 7,FBUF1]
MOVE B,[POINT 7,FBUF2]
CALL CHKWLD ;SEE IF THIS FILE SPEC MATCHES
JRST [ AOBJN P5,TSTNA3 ;NOT EQUAL, STEP TO NEXT FILESPEC
POP P,A
RET] ;DONE ALL FILESPECS, FAILED TO MATCH ANY
TSTNA1: AOBJN Q1,TSTNA2 ;STEP TO NEXT FIELD
POP P,A
RETSKP ; Is ok
; GMTINF - GET INFO ABOUT MT DEVICE
; A/ MT JFN
; RETURNS +1: ALWAYS
; A/ LABEL TYPE, VOLID/ ASCIZ VOLID, VOLID6/ SIXBIT VOLID
GMTINF: STKVAR <<MTIAB,3>>
MOVEI B,2
MOVEM B,MTIAB ;SET SIZE IN ARG BLOCK
MOVEI B,.MORLI ;FUNCTION CODE
MOVEI C,MTIAB ;ARG BLOCK ADDRESS
MTOPR ;GET LABEL INFORMATION IN ARG BLOCK
MOVE D,1+MTIAB ;GET LABEL TYPE
; GET VOLID OF TAPE USING .MOINF MTOPR
MOVEI B,2
MOVEM B,MTIAB ;SET # OF ARGS TO RETURN
MOVEI B,.MOINF ;FUNCTION CODE
MTOPR
MOVE A,.MOIID+MTIAB ;GET SIXBIT VOLID
MOVEM A,VOLID6 ;SAVE IT
MOVE B,[POINT 7,VOLID] ;GET DESTINATION POINTER
GMTIN1: JUMPN A,[LDB C,[POINT 6,A,5] ;GET CHARACTER FROM VOLID
LSH A,6 ;SHIFT THE REST OVER
ADDI C,40 ;CONVERT SIXBIT CHARACTER TO ASCII
IDPB C,B ;STORE ASCII CHAR
JRST GMTIN1] ;LOOP UNTIL LAST NON-BLANK
IDPB A,B ;TERMINATE WITH A NULL
MOVE A,D ;GET LABEL TYPE
RET
SUBTTL ROUTINE TO CHECK SPECS AGAINST A WILDCARD STRING
;THE FOLLOWING ROUTINE WAS RIPPED OUT FROM THE MONITOR MODULE
;LOOKUP. WHENEVER A JSYS IS WRITTEN TO DO THIS FUNCTION, THIS
;ROUTINE SHOULD BE REPLACED WITH THAT JSYS CALL.
; THIS SUBROUTINE COMPARES A STRING TO A GENERALIZED WILD-CARD
;MASK. A IS A POINTER TO THE STRING AND B IS A POINTER TO THE
;MASK.
; RETURNS +1 IF THE MASK CANNOT MATCH THE STRING. RETURNS +2
;IF IT DOES MATCH
CHKWLD: SAVEQ ;SAVE PERMANENT ACS
STKVAR <SVPTR,SVMSK> ;POINTERS TO LAST STAR POSITION
SETZ Q2, ;NO PREVIOUS ON THE FIRST BYTE
SETZM SVMSK ;NO PREVIOUS
MRTEST: MOVE Q3,Q2 ;SAVE PREVIOUS CHARACTER
ILDB Q2,B ;GET NEXT MASK CHARACTER
JUMPE Q2,EMASK ;END OF MASK
CAIN Q2,"%" ;A SINGLE CHARACTER WILD CARD?
JRST SNGL ;YES
CAIN Q2,"*" ;ANY WILD MATCH?
JRST ANY ;YES
CALL GETSRC ;GET NEXT STRING BYTE
RET ;END OF STRING AND FAILURE
CAIN Q2,(C) ;MATCH?
JRST MRTEST ;YES. GO ON
FAIL: SKIPN B,SVMSK ;NO. HAVE A PREVIOUS "*" ?
RET ;NO. CANT MATCH THESE TWO
IBP SVPTR ;STRETCH THE MASK
MOVE A,SVPTR ;MAKE IT CURRENT POINTER
JRST MRTEST ;AND TRY AGAIN
;GET SOURCE BYTE
GETSRC: ILDB C,A ;GET IT
JUMPE C,R ;IF END OF STRING, FAIL RETURN
RETSKP ;GOT ONE
;END OF MASK ROUTINE
EMASK: CAIN Q3,"*" ;DID MASK END IN A "*"
RETSKP ;YES. IT IS A MATCH
CALL GETSRC ;NO. AT END OF SOURCE TOO?
RETSKP ;YES. A MATCH
JRST FAIL ;NO. TRY TO STRETCH THE MASK
;FOUND A "%" IN THE MASK
SNGL: CALL GETSRC ;GET A SOURCE BYTE
RET ;NO MORE BYTES
JRST MRTEST ;GO GET MORE
;FOUND A "*" IN THE STRING
ANY: MOVEM A,SVPTR ;SAVE POINTER TO STRING
MOVEM B,SVMSK ;SAVE MASK POINTER
JRST MRTEST ;GO DO THE REST
;******END OF TEMP
SUBTTL TAPE MOUNT/DISMOUNT LOGIC
; MREQ - PERFORM MOUNT DIALOGUE WITH QUASAR
; A/ SIXBIT VOLID
; RETURNS +1: ERROR, MESSAGE TYPED
; +2: SUCCESS, MTDSG/ MT DEVICE DESIGNATOR
MREQ: SAVEQ
MOVE Q1,A ;SAVE VOLID
SETZB A,MTDSG
CALL SETMNT ;DUMP CURRENTLY-MOUNTED TAPE
TMSGC <[Mounting tape volume >
MOVE A,Q1
CALL TYP6 ;TYPE VOLID
TMSG <]
>
DMOVE A,[EXP .MURSP,.SPQSR] ;GET PID OF REAL QUASAR
DMOVEM A,MPDB
MOVEI A,3 ;ARG BLOCK LENGTH
MOVEI B,MPDB ;ARG BLOCK ADDRESS
MUTIL ;GET PID INTO MPDB+.IPCFR
ERJMP [HRROI B,[ASCIZ/?Cannot get PID for QUASAR/]
CALLRET TMSGQC]
; BUILD IPCF MOUNT MESSAGE FOR QUASAR
; (MESSAGE LENGTH AND MOUNT-REQUEST ENTRY LENGTH FILLED IN LATER)
MOVE Q3,[IOWD 1000,MBUF] ;GET STACK POINTER
MOVSI B,-TMSKSZ ;GET AOBJN POINTER TO SKELETON
PUSH Q3,TMSKEL(B) ;TRANSFER SKELETON WORD TO MESSAGE
AOBJN B,.-1 ;LOOP UNTIL ALL OF SKELETON IS MOVED
SKIPE DENSIT ;ANY DENSITY SPECIFIED?
JRST [ PUSH Q3,[2,,.TMDEN] ;YES, CREATE DENSITY SUBENTRY
PUSH Q3,DENSIT
JRST .+1]
PUSH Q3,[2,,.TMVOL]
PUSH Q3,Q1 ;CREATE VOLID ENTRY IN IPCF MESSAGE
; NOW FIX UP THE COUNT FIELDS IN THE IPCF MESSAGE
HRRZ A,Q3 ;GET ADDRESS OF LAST WORD OF MESSAGE
SUBI A,MBUF-1 ;COMPUTE SIZE OF MESSAGE
STOR A,MS.CNT,MBUF+.MSTYP ;STORE IN GALAXY HEADER
SUBI A,.MMHSZ ;COMPUTE SIZE OF MOUNT ENTRY
STOR A,AR.LEN,MBUF+.MMHSZ ;STORE IN MOUNT ENTRY LENGTH FIELD
MOVEI A,MBUF+.MMHSZ+.MEHSZ ;POINT AT FIRST SUBENTRY
TMX2: AOS MBUF+.MMHSZ+.MECNT ;COUNT THIS SUBENTRY
LOAD B,AR.LEN,(A) ;GET SIZE OF SUBENTRY
ADD A,B ;POINT AT NEXT SUBENTRY
CAIGE A,(Q3) ;ANOTHER SUBENTRY?
JRST TMX2 ;YES, CONTINUE SCAN
; SEND IPCF MESSAGE TO QUASAR
MOVEI B,MPDB-1 ;SET UP PDB FOR MSEND
PUSH B,[IP%CPD+IP%CFV] ;FLAGS
PUSH B,[0] ;SENDER'S PID (WILL BE CREATED)
ADJSP B,1 ;RECEIVER'S PID FILLED IN ALREADY
PUSH B,[1000,,<MBUF_-9>] ;PACKET DESCRIPTOR
MOVEI A,4 ;GET SIZE OF PDB
MOVEI B,MPDB ;GET ADDRESS OF PDB
MSEND ;SEND REQUEST TO QUASAR
ERRORJ TCRLF,<?COULD NOT SEND IPCF MOUNT REQUEST>
; MOUNT MESSAGE HAS BEEN SENT, NOW RECEIVE THE REPLY
MOVE A,MPDB+.IPCFS
MOVEM A,MPDB+.IPCFR ;SET RECEIVER'S PID
MREQ2: MOVX A,IP%CFV
MOVEM A,MPDB+.IPCFL ;STORE FLAGS
MOVE A,[1000,,<MBUF/1000>]
MREQ3: MOVEM A,MPDB+.IPCFP ;POINTER TO MESSAGE BUFFER
MOVEI A,.IPCFC+1 ;PDB LENGTH
MOVEI B,MPDB ;PDB ADDRESS
MRECV ;RECEIVE MESSAGE
JRST [ CAIE A,IPCF16 ;ERROR BECAUSE OF WRONG DATA MODE?
ERRORJ TCRLF,<?ERROR RECEIVING MOUNT RESPONSE> ;NO
SETZM MPDB+.IPCFL ;YES, CLEAR IP%CFV
MOVE A,[1000,,MBUF] ;GET POINTER FOR NON-PAGE-MODE
JRST MREQ3] ;TRY AGAIN
MOVE A,MPDB+.IPCFC
TXNN A,SC%WHL+SC%OPR ;IS SENDER LEGIT?
JRST MREQ2 ;NO, TRY AGAIN
LOAD Q3,MS.TYP,MBUF+.MSTYP ;GET MESSAGE TYPE
JN MF.FAT,MBUF+.MSFLG,CKMNT1 ;JUMP IF MOUNT FAILED
CAIE Q3,.QOMNA ;IS IT A RESPONSE TO MOUNT REQUEST?
JRST MREQ2 ;NO, IGNORE IT
CALL MRKPID ;DELETE MOUNTING PID
MOVEI A,[1
.MNRDV,,CKMDV]
CALL SCNMBK ;SUCCESSFUL MOUNT, GET DESIGNATOR
MOVE A,MTDSG
CALL SETMNT ;REMEMBER I HAVE MOUNTED A TAPE
HRROI A,MTDEV ;DESTINATION STRING POINTER
MOVE B,MTDSG
DEVST ;CONVERT DESIGNATOR TO STRING
JRST JSERR1
MOVEI B,":"
IDPB B,A ;BUILD FILESPEC
SETZ B,
IDPB B,A
MOVX A,GJ%SHT
HRROI B,MTDEV ;GET POINTER TO FILESPEC
GTJFN ;GET JFN ON MT DEVICE
JRST JSERR1
CALL CHKMTJ ;CHECK OUT MT DEVICE
JRST [ SETZ A, ;MT DEVICE IS BAD (SHOULDN'T HAPPEN)
CALLRET SETMNT] ;DISMOUNT AND TRY AGAIN
TMSGC <[Volume >
MOVE A,Q1 ;GET VOLID
CALL TYP6 ;TYPE IT
TMSG < mounted]
>
RETSKP ;EVERYTHING OK, RETURN +2
CKMDV: MOVE A,1(A) ;GET DESIGNATOR
MOVEM A,MTDSG ;STORE IT
ASND ;ASSIGN MT DEVICE TO THIS JOB
JFCL
RET
; MOUNT FAILED
CKMNT1: CALL MRKPID ;DELETE MOUNTING PID
CAIN Q3,MT.TXT ;TEXT MESSAGE?
JRST [ MOVEI A,MBUF+.OHDRS+ARG.DA ;YES, GET ADDRESS OF TEXT
CALLRET CKMTX] ;TYPE ERROR MESSAGE AND TAKE +1 RETURN
MOVEI A,[2
.MNREC,,CKMEC
.MNRTX,,CKMTX]
CALLRET SCNMBK ;ANALYZE REPLY AND RETURN +1
CKMTX: HRRO Q1,A ;GET STRING POINTER TO TEXT
TMSG <?>
MOVE B,Q1 ;GET STRING POINTER IN B FOR TMSGQ
CALL TMSGQ ;DISPLAY IT
CALLRET TCRLF ;TYPE CRLF AND RETURN
CKMEC: MOVE Q1,(A) ;GET ERROR CODE
TMSGC <?Cannot mount tape, >
MOVEI A,.PRIOU
MOVE B,Q1 ;GET ERROR CODE
HRLI B,.FHSLF ;APPEASE ERSTR WITH FORKHANDLE
SETZ C, ;NO LIMIT
ERSTR ;TYPE ERROR MESSAGE
JFCL
JFCL
TCRLF: TMSG <
>
RET
; ROUTINE TO DELETE MOUNTING PID IN MPDB+.IPCFR
MRKPID: MOVEI A,.MUDES
MOVEM A,MPDB+1 ;BUILD MUTIL ARGUMENT BLOCK
MOVEI A,2 ;ARG BLOCK LENGTH
MOVEI B,MPDB+1 ;ARG BLOCK ADDRESS
MUTIL ;DESTROY THE PID I USED TO DO THE MOUNT
JFCL
RET
; SKELETON IPCF MESSAGE FOR TAPE MOUNT
TMSKEL: 0,,.QOMNT ;GLX HEADER - LENGTH,,TYPE
0 ;GLX HEADER - FLAGS
0 ;GLX HEADER - ACK CODE
0 ;MOUNT MESSAGE FLAGS
SIXBIT/RETRVL/ ;MOUNT REQUEST NAME
1 ;MOUNT ENTRY COUNT
0,,.MNTTP ;MOUNT ENTRY LENGTH,,TYPE
0 ;MOUNT ENTRY FLAGS
0 ;SUBENTRY COUNT (FILLED IN LATER)
2,,.TMSET ;SETNAME SUBENTRY
SIXBIT/RETRVL/
2,,.TMDRV ;DRIVE-TYPE SUBENTRY
.TMDR9
4,,.TMRMK
ASCIZ/RETRIEVAL TAPE/
TMSKSZ==.-TMSKEL ;LENGTH OF SKELETON
; SCNMBK - SCAN REPLY TO MOUNT REQUEST AND CALL BLOCK-PROCESSORS
; A/ ADDRESS OF BLOCK-TYPE/PROCESSOR-ADDRESS LIST
; RETURNS +1: ALWAYS
SCNMBK: SAVEQ
MOVE Q1,MBUF+.OARGC ;GET # OF BLOCKS IN LIST
MOVEI Q2,MBUF+.OHDRS ;GET ADDRESS OF FIRST BLOCK
MOVE Q3,A ;COPY CALLER'S LIST ADDRESS
SCNMB1: SOJL Q1,R ;EXIT IF NO MORE BLOCKS TO SCAN
MOVEI A,1(Q2) ;GET ADDRESS OF DATA IN BLOCK
HRRZ B,(Q2) ;GET BLOCK TYPE CODE
HLRZ C,(Q2) ;GET BLOCK LENGTH
ADD Q2,C ;POINT Q2 AT NEXT BLOCK
MOVN C,(Q3) ;GET NEGATIVE # OF LIST ENTRIES
MOVSS C ;MOVE TO LEFT HALF FOR AOBJN POINTER
HRRI C,1(Q3) ;MAKE POINTER TO CALLER'S LIST
SCNMB2: HLRZ D,(C) ;GET TYPE CODE FROM LIST
CAMN B,D ;DOES IT MATCH THE CODE FOR THIS BLOCK?
JRST [ HRRZ D,(C) ;YES, GET PROCESSOR ROUTINE ADDRESS
CALL (D) ;INVOKE PROCESSOR
JRST SCNMB1] ;GO SCAN NEXT BLOCK
AOBJN C,SCNMB2 ;CONTINUE LIST SCAN
JRST SCNMB1 ;UNRECOGNIZED BLOCK TYPE, IGNORE IT
; GQPID - GET QUASAR'S PID IN "QSRPID"
; RETURNS +1: FAILED, MESSAGE TYPED
; +2: SUCCESS
GQPID: SKIPN .JBOPS ;PRIVATE GALAXY?
JRST [ SAVEQ ;NO
MOVEI Q1,.MURSP ;MUTIL FUNCTION CODE
MOVEI Q2,.SPQSR ;INDEX INTO SYSTEM PID TABLE
MOVEI A,3 ;ARG BLOCK LENGTH
MOVEI B,Q1 ;ARG BLOCK ADDRESS
MUTIL
ERROR R,<?CANNOT GET PID FOR QUASAR>
MOVEM Q3,QSRPID ;STORE QUASAR'S PID
RETSKP]
MOVE B,[[EXP IP%CPD,0,0,<20,,PDB+4>,.IPCIW,0],,PDB]
BLT B,PDB+5 ;MOVE PDB AND PART OF MESSAGE TO BUF
GJINF ;GET USER# IN A
MOVE B,A ;COPY INTO B
MOVE A,[POINT 7,PDB+6] ;GET POINTER
MOVEI C,"["
IDPB C,A
DIRST ;ADD USER NAME
JFCL
HRROI B,[ASCIZ/]QUASAR/]
SETZ C, ;STOP ON NULL
SOUT ;ADD PID NAME
MOVEI A,4
MOVEI B,PDB
MSEND ;SHIP OFF QUESTION TO INFO
JSHLT
SETZM PDB ;CLEAR FLAGS WORD FOR RECEIVE
MOVE C,PDB+1 ;GET MY PID SO I CAN RECEIVE
MOVE D,[20,,PDB+4] ;SIZE,,MSGADDR
DMOVEM C,PDB+2 ;SET WORDS 2 & 3 OF PDB
MRECV ;RECEIVE INFO'S REPLY
JSHLT
MOVEI A,2 ;ARG BLOCK LENGTH
MOVEI B,C ;ARG BLOCK ADDRESS
MOVEI C,.MUDES ;MUTIL FUNCTION CODE
MOVE D,PDB+.IPCFR ;PID
MUTIL ;DELETE PID USED FOR TALKING TO INFO
JFCL
LOAD A,IP%CFE,PDB+.IPCFL ;ERROR FROM INFO?
JUMPN A,[TMSGC <?CAN'T GET PID FOR > ;YES
HRROI A,PDB+6
PSOUT ;DISPLAY PID NAME
RET]
MOVE A,PDB+5 ;GET PRIVATE QUASAR'S PID
MOVEM A,QSRPID ;STORE IT
RETSKP
; SETMNT - SET OR CLEAR CURRENTLY-MOUNTED TAPE
; THIS APPLIES ONLY TO TAPES THAT DUMPER HAS MOUNTED VIA QUASAR
; A/ MT DEVICE DESIGNATOR OR 0 TO CLEAR
SETMNT: PUSH P,A ;SAVE NEW DESIGNATOR
CALL MTCLS
SKIPE A,MNTDSG ;HAVE DESIGNATOR CURRENTLY?
RELD ;YES, DUMP IT
JFCL
POP P,MNTDSG ;SET NEW DESIGNATOR
; CREATE OR DELETE LOGICAL NAME FOR MOUNTED TAPE
MOVEI A,.CLNJ1 ;ASSUME DELETING LOGICAL NAME
SKIPE B,MNTDSG ;SETTING NEW DEVICE?
JRST [ HRROI A,MTDEV ;YES
DEVST ;COMPOSE LOGICAL NAME
JFCL ; DEFINITION STRING
MOVEI B,":"
IDPB B,A
SETZ B,
IDPB B,A
MOVEI A,.CLNJB ;SET TO CREATE LOGICAL NAME
JRST .+1]
HRROI B,[ASCIZ/RETRVL/] ;LOGICAL NAME = RETRVL:
HRROI C,MTDEV ;POINTER TO DEFINITION, MTn:
CRLNM ;CREATE OR DELETE LOGICAL NAME
JFCL
RET
SUBTTL Routines to communicate with QUASAR
; Here on PSI for IPCF message arrived
QSRINT: MOVEM 17,INT3AC+17
MOVEI 17,INT3AC
BLT 17,INT3AC+16
MOVE P,[IOWD NINTPD,INT3PD]
PUSH P,40
CALL RCVQSR ; Read the message
JRST QSRRET ; Nothing there for us
MOVE A,.MSFLG(P1) ; Get flags
MOVE B,.MSCOD(P1) ; Get ack code
TXNE A,MF.ACK ; Guy want an ACK?
CALL DOACK ; Ack him now
TXNE A,MF.NOM ; No message?
JRST QSRRET ; Yes, just eat that
TXNN A,MF.WRN ; Warning message?
TXNE A,MF.FAT ; Fatal message
JRST QSTEXT ; Is a message, print it
LOAD A,MS.TYP,.MSTYP(P1), ; Get type code
CAIN A,.QONEX ; Next job msg?
JRST QSNXT ; Yes
CAIN A,.QOABO ; Abort msg?
JRST QSABT ; Yes
CAIN A,.QORCK ; Checkpoint?
JRST QSCKPT ; Yes
CAIN A,.QOSUP ; Setup message?
JRST QSSETU ; Yes
TMSG <%Unknown message type recieved from QUASAR>
QSRRET: POP P,40
MOVSI 17,INT3AC
BLT 17,17
DEBRK ; Done here
QSNXT: MOVE A,.EQITN(P1) ; Get task name
MOVEM A,TPTSK ; And remember it
MOVX A,RC%EMO ; Exact match pls
HRROI B,.EQOWN(P1) ; Point to owner of request
SETZ C, ; No stepping info
RCUSR
ERJMP .+2 ; Bombed
TXNE A,RC%NOM+RC%AMB+RC%NMD+RC%WLD ; Failure or wild?
JRST [ TMSG <%RCUSR failed in QSNXT
>
JRST QSRRET] ; Leave it
MOVEM C,TPRQUS ; Remember who
HRLI A,.EQLIM+1(P1) ; From there
HRRI A,.ARTP1+TPBLK ; To there
BLT A,TPBLK+.ARSF2 ; Move tape info
MOVE A,.EQLIM(P1) ; Get time & flag
MOVEM A,.ARODT+TPBLK
MOVEI P1,QSRMSR
HRROI A,TAPNAM ; Move file name to there
LOAD B,EQ.LOH,.EQLEN(P1)
ADD B,P1 ;POINT TO THE FP
LOAD C,FP.LEN,(B) ;GET FP LENGTH
ADD B,C ;POINT TO FD
MOVEI B,.FDFIL(B) ;POINT TO FILESPEC
HRLI B,(POINT 7)
SETZB C,D
SOUT ; Move file name
HRROI A,TPACT ; Where account should be
HRROI B,.EQACT(P1) ; Where it is now
SETZB C,D
SOUT ; Move account too
MOVEI A,TPBLK
MOVEM A,NXTRTP
AOS NJFN1 ; We have something to do now
QSNXT1: HLRZ A,CHNTAB+QSRCHN ; Get level we're at
HRRZ B,@LEVTAB-1(A) ; Get return PC
CAIN B,RETWAT ; Waiting on us?
AOS @LEVTAB-1(A) ; Yes, make him go again
JRST QSRRET
QSSETU: MOVE A,SUP.TY(P1) ; Get object type
CAIE A,.OTRET ; Of type we expect?
JRST [ TMSG <%Recieved invalid object type in SETUP message
>
JRST QSRRET]
MOVE A,SUP.FL(P1) ; Get flags
TXNE A,SUFSHT ; Shutdown rather than start up?
JRST QSNXT1 ; Right, leave as though we got a null
; request
MOVE B,SUP.UN(P1) ; Get the unit #
MOVE C,SUP.NO(P1) ; And NODE name
CALL ZIPMSS ; Setup to send
MOVE A,[RSU.SZ,,.QORSU] ; Respond to setup
MOVEM A,.MSTYP(P1) ; Length and type
MOVE A,[.OTRET] ; Object type
MOVEM A,RSU.TY(P1)
MOVEM B,RSU.UN(P1) ; Unit number
MOVEM C,RSU.NO(P1) ; Node name
MOVX A,%RSUOK ; Say SETUO KO
MOVEM A,RSU.CO(P1) ; Response code
SETZM RSU.DA(P1) ; No attributes
MOVE P1,[RSU.SZ,,QSRMSS]
CALL SNDQSR ; Send it
JRST [ TMSG <%SETUP REPLY message send failed
>
JRST QSRRET]
JRST QSRRET
QSABT: TMSG <%Abort recieved
>
AOS ABTFLG ; Note we got the abort poke
JRST QSRRET
QSCKPT: JRST QSRRET ;TAKE NO ACTION
QSTEXT: TXNE A,MF.FAT ; Fatal msg?
JRST [ PUSH P,A
TMSG <?Fatal: >
POP P,A
JRST .+1]
TXNE A,MF.WRN ; Warning?
JRST [ PUSH P,A
TMSG <%Warning: >
POP P,A
JRST .+1]
HRROI B,.OHDRS+ARG.DA(P1) ;GET ADDRESS OF TEXT
CALL TMSGQ ;PRINT IT
HRROI B,CRLF
CALL TMSGQ
JRST QSRRET ; Done here
; Here to send a message ; P1 HAS LENGTH,,MSG ADDR
SNDQSR: MOVEI B,PDB-1 ; WHERE TO BUILD PDB
PUSH B,[0] ; PID's are known
PUSH B,MYPID ; SENDER'S PID
PUSH B,QSRPID ; RECIEVER'S PID
PUSH B,P1 ; WHERE ACTUAL MSG IS
MOVEI A,.IPCFP+1 ; PDB LENGTH
MOVEI B,PDB
MSEND ; SEND MSG
RET ; FAILED, TELL CALLER
RETSKP
; Here to receive a message; P1 HAS ADDR OF DATA
RCVQSR: MOVEI B,PDB-1
PUSH B,[0]
PUSH B,[0] ; SENDER'S PID
PUSH B,MYPID
PUSH B,[NQSRML,,QSRMSR]
RCVQS1: MOVEI A,4
MOVEI B,PDB
MRECV ; READ IT
JRST [ CAIE A,IPCF16 ; SENT IN PAGE MODE?
JRST JSERR1 ;NO, ERROR
MOVX A,IP%CFV ; SAY PAGE MODE
MOVEM A,PDB+.IPCFL
MOVE A,[1000,,<QSRMSR/PGSIZ>]
MOVEM A,PDB+.IPCFP
JRST RCVQS1]
MOVEI P1,QSRMSR ; Point to RECEIVed message
MOVE A,PDB+.IPCFS ; GET SENDER'S PID
CAMN A,QSRPID ; MATCH QUASAR'S?
RETSKP ; YES, RETURN WITH MSG IN HAND
TMSG <%Message received not from QUASAR
>
JRST RCVQSR ; TRY AGAIN
; Here to reque a retrieval request
REQUE: SETZM NXTRTP ; Current block now invalid
PUSH P,P1
CALL ZIPMSS ; Setup to send
MOVE B,[REQ.SZ,,.QOREQ]
MOVEM B,.MSTYP(P1) ; Length, type
MOVE B,TPTSK ; External task
MOVEM B,REQ.IT(P1) ; Internal task name
MOVEM A,REQ.IN(P1) ; Timestamp
HRLI B,.ARTP1(P6) ; COPY TAPE INFO FROM
HRRI B,REQ.IN+1(P1) ; TO
BLT B,REQ.IN+1+.ARSF2(P1) ; Copy in tape info
MOVE P1,[REQ.SZ,,QSRMSS]
CALL SNDQSR ; Send it to QUASAR
JRST [ TMSG <?SNDQSR failed in REQUE
>
POP P,P1
RET]
POP P,P1
RETSKP
; Here to send goodbye message
GDBYE: MOVX A,HEFBYE ; SAY GOOD-BYE
CALL HELLO ; AND DISSAPPEAR
RET
RETSKP
; Here to ACK a message
DOACK: MOVE B,.MSCOD(P1) ; Get ack code
MOVEM B,.MSCOD+ACKBLK
PUSH P,P1
MOVE P1,[MSHSIZ,,ACKBLK]
CALL SNDQSR ; Send it
JRST [ TMSG <%ACK send failed
>
POP P,P1
RET]
POP P,P1
RET
; Here to release MYPID
RELPID: SKIPN A,MYPID ; Have PID?
RET ; No, done
MOVEM A,PDB+1
MOVEI A,.MUDES ; Delete the PID
MOVEM A,PDB
MOVEI A,2
MOVEI B,PDB
MUTIL
ERROR R,<%Failed to release PID>
SETZM MYPID
SETZM QSRPID ; Forget about QUASAR too
RET
; Here to send hello message; A Has flags desired to be on
HELLO: HRRZS A ; No LH flags
PUSH P,P1 ; SAVE THIS
CALL ZIPMSS ; Setup for sending
MOVE B,[HEL.SZ,,.QOHEL] ; HELLO MSG
MOVEM B,.MSTYP(P1) ; Drop in length & type
MOVE B,[SIXBIT /DUMPER/]
MOVEM B,HEL.NM(P1) ; Program name
HRLI A,%%.QSR ; Internal version,,flags
MOVEM A,HEL.FL(P1) ; Version and flags
MOVE B,[1,,1] ; 1 object type, 1 concurrent job
MOVEM B,HEL.NO(P1)
MOVE B,[.OTRET] ; Which is a retrieval
MOVEM B,HEL.OB(P1) ; Object type
MOVE P1,[HEL.SZ,,QSRMSS]
CALL SNDQSR ; SEND IT
JRST [ PUSH P,A
TMSG <%SNDQSR failed in HELLO
>
POP P,A
CALL JSERR1 ; REPORT ERROR
POP P,P1
RET]
POP P,P1
RETSKP
; Here to clear send page & set up P1 pointing to it
ZIPMSS: SETZM QSRMSS
MOVE P1,[QSRMSS,,QSRMSS+1]
BLT P1,QSRMSS+777 ; Clear the entire page
MOVEI P1,QSRMSS
RET
; Here to initialize the USAGE block before making an entry
USAINI: MOVE A,[VUSABL,,USABLK]
BLT A,USABLK+NUSABL-1
RET
; drop tape info into USAGE blk, A should point to ARCF style blk
USATAP: LOAD B,TPNM1,(A) ; Get Tape 1 ID
MOVEM B,USABLK+12
LOAD B,TSN1,(A)
MOVEM B,USABLK+14 ; Saveset 1
LOAD B,TFN1,(A)
MOVEM B,USABLK+16 ; Tapefile 1
LOAD B,TPNM2,(A) ; Get tape 2 ID
MOVEM B,USABLK+20
LOAD B,TSN2,(A)
MOVEM B,USABLK+22 ; Saveset # 2
LOAD B,TFN2,(A)
MOVEM B,USABLK+24
RET
VUSABL: USENT. (.-.,1,0) ; Type to be filled in, version
USSSI. (USASSI) ; Structure name
USDIR. (USADIR,,^D39) ; Directory name
USACT. (USAACT,,^D39) ; Account string
USUSG. (.-.,US%IMM,6) ; # pages 000000-999999
USTP1. (.-.,US%IMM,6) ; Tape 1 ID
USTS1. (.-.,US%IMM,4) ; Tape 1 saveset #
USTF1. (.-.,US%IMM,6) ; Tape 1 tape file #
USTP2. (.-.,US%IMM,6) ; Tape 2 ID
USTS2. (.-.,US%IMM,4) ; Tape 2 saveset #
USTF2. (.-.,US%IMM,6) ; Tape 2 tape file #
USRSN. (.-.,US%IMM,1) ; Reason offline line code
MASK: 0
FB%PRM+FB%NOD+FB%FCF ; CTL (FB%INV IS SPECIAL-CASED)
0 ; EXL
0 ; ADR
0 ; PRT
777777777777 ; CRE
0 ;OLD AUTHOR WRITER WORD
0 ; GEN
0 ; ACT
777717000000 ; BYV
777777777777 ; SIZ
777777777777 ; CRV
777777777777 ; WRT
777777777777 ; REF
777777777777 ; CNT
1B0+777777 ; BK0
0 ; BK1
0 ; BK2
AR%1ST+AR%WRN ; BBT
0 ; NET
777777777777 ; USW
0 ; GNL
0 ; NAM
0 ; EXT
0 ;.FBLWR POINTER
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-MASK-.FBLEN,<PRINTX ** FDB MASK ARRAY SIZE WRONG **>
NWMASK: 0
FB%TMP+FB%PRM+FB%NOD+FB%FCF ;(FB%INV IS SPECIAL-CASED)
0
0
0
0
0
0
0
777717000000
777777777777
777777777777
777777777777
777777777777
0
0
0
0
0
0
777777777777
0
0
0
0 ;.FBLWR POINTER WORD
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-NWMASK-.FBLEN,<PRINTX ** FDB NWMASK ARRAY SIZE WRONG **>
;FDB MASK FOR INTERCHANGE MODE RESTORE
ICMASK: 0 ;FBHDR
0 ;FBCTL
0 ;FBEXL
0 ;FBADR
0 ;FBPRT
0 ;FBCRE
0 ;FBAUT
0 ;FBGEN/FBDRN
0 ;FBACT
007700,,0 ;FBBYV
-1 ;FBSIZ
0 ;FBCRV
-1 ;FBWRT
0 ;FBREF
0 ;FBCNT
REPEAT 3,<0> ;FBBK0-FBBK2
0 ; BBT
0 ; NET
0 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ; TDT
0 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-ICMASK-.FBLEN,<PRINTX ** FDB ICMASK ARRAY SIZE WRONG **>
;FDB MASK FOR CHECK
CKMASK: 0 ;FBHDR
FB%TMP+FB%PRM+FB%NOD+FB%INV+FB%FCF ;FBCTL
0 ;FBEXL
0 ;FBADR
0,,777777 ;FBPRT
-1 ;FBCRE
0 ;FBAUT
0 ;FBGEN/FBDRN
0 ;FBACT
777717,,0 ;FBBYV
-1 ;FBSIZ
-1 ;FBCRV
-1 ;FBWRT
-1 ;FBREF
-1 ;FBCNT
REPEAT 3,<0> ;FBBK0-FBBK2
0 ; BBT
-1 ; NET
-1 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ; TDT
-1 ; FET
0 ; TP1
0 ; SS1
0 ; TP2
0 ; SS2
IFN .-CKMASK-.FBLEN,<PRINTX ** FDB CKMASK ARRAY SIZE WRONG **>
MSK10X: R ; Header
R ; FDBCTL
R ; FDBEXT
R ; FDBADR
R ; FDBPRT
TIM10X ; FDBCRE (time format)
R ; FDBUSE
R ; FDBVER
R ; FDBACT
R ; FDBBYV
R ; FDBSIZ
TIM10X ; FDBCRV (time)
TIM10X ; FDBWRT (time)
TIM10X ; FDBREF (time)
R ; FDBCNT
CLRMSK ; FDBBK0
REPEAT 4,<R> ; FDBBK1-FDBBK4
R ; FDBUSE
REPEAT <.FBLEN-<.-MSK10X>>,<R> ; Pad out rest of table
FDBNAM: SIXBIT /HEADER/
SIXBIT /.FBCTL/
SIXBIT /.FBEXT/
SIXBIT /.FBADR/
SIXBIT /.FBPRT/
SIXBIT /.FBCRE/
SIXBIT /.FBAUT/
SIXBIT /.FBVER/
SIXBIT /.FBACT/
SIXBIT /.FBBYV/
SIXBIT /.FBSIZ/
SIXBIT /.FBCRV/
SIXBIT /.FBWRT/
SIXBIT /.FBREF/
SIXBIT /.FBCNT/
SIXBIT /.FBBK0/
SIXBIT /.FBBK1/
SIXBIT /.FBBK2/
SIXBIT /.FBBBT/
SIXBIT /.FBNET/
SIXBIT /.FBUSW/
SIXBIT /.FBGNL/
SIXBIT /.FBNAM/
SIXBIT /.FBEXT/
SIXBIT /.FBLWR/
SIXBIT /.FBTDT/
SIXBIT /.FBFET/
SIXBIT /.FBTP1/
SIXBIT /.FBSS1/
SIXBIT /.FBTP2/
SIXBIT /.FBSS2/
END <3,,ENTVEC>