Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50230/ripoff.mac
There are no other files named ripoff.mac in the archive.
TITLE RIPOFF V.5 CUSP level disk management program
SUBTTL Assembly and loading instructions
; Created at Southern Methodist University
; Supported by Alpha Systems Inc, Dallas Texas
; by Steve Bush begun 13-Jul-71
;
; Highly modified at the University of Arizona,
; Tucson, Arizona 1-Nov-77
LOGIC==0 ; For REPEAT LOGIC,<comments>
REPEAT LOGIC,<
For loading , without DDT do:
.LOAD RIPOFF
.[N]SSAVE
For loading with DDT, gets a little more difficult. The last location
in RIPOFF's low seg (whether pure or not) is called LOWSIZ:. Only
reference to this symbol is at RIPSIZ:, which is on the first page
of code in this listing, and reads approximately
RIPSIZ: MOVEI T,LOWSIZ
MOVEM T,.JBFF
CORE T,
This fixes core, which RIPOFF dynamically allocates for tables after
LOWSIZ. To keep DDT and symbols from getting wiped out in the process,
simply enter DDT after loading and examine .JBFF to determine full size
of low segment and patch RIPSIZ: to correspond. That is,
.R LINK
*RIPOFF/LOCALS,SYS:DDT.REL/GO ; DDT must load after RIPOFF.
.DDT
RIPOFF$: .JBFF/ 14206
RIPSIZ/ MOVEI T,LOWSIZ MOVEI T,14206 <CR>
^C
.[N]SSAVE RIPDDT
To make patches at any time, simply make them starting at 14206 (which
you may define symbolically to DDT as PATCH:) and retype instruction at RIPSIZ
to refer to the location just beyond your patch. Note that I use 14206
only as an example. The actual number you find there will change.
>
SUBTTL Revision history
COMMENT `
Revision history since version 4 1-Jan-74
[1] 15-Apr-74 Fixed SYSINI and %RP10 to know about RP03's
[2] 10-Jun-74 Added KISW and fixed PNTCOR to print pages
on KI-10. Also changed LOCK to %LOCK so no
confusion with UUO.
[3] 02-Jul-74 Fixed /P bug wasnt zeroing WASTEB and TFILCT.
Added 'Error summary for DSKx' message
in /PE code.
[4] 25-Jul-74 Corrected table %RP10 - had 400 blocks/cylinder
for RP03's. They are 200 blocks/cylinder.
[5] 01-Jan-75 Corrected access date byte pointer (DATE75)
[6] 15-Sep-75 Added /DT function to delete files meeting access and
creation data criteria.
[7] 16-Sep-75 Redid logic at SYSIN2 (which determined type of disk
pack) to be more general. Also added RP04's to tables.
[10] Redid patching logic. Added LOWSIZ: and took out use of
external symbol PAT. See assembly instructions at the
beginning of this listing.
[11] Fix DSKLST code. Remove tape label and version. Add
number of RIB ptrs and extended RIB flag. Histogram
number of RIB ptrs. Remove logic to provide different
format for TTY than for hard copy. One format only.
[12] Changed a bunch of OCTPRT's to DECPRT's. All block numbers,
cluster addresses, etc in decimal now. No more dot to
indicate decimal numbers. Context should be clear.
[13] Added SUSET. UUO's under assembly switch SUPSW,
normally on.
[14] 14-Jun-76 Preparing to submit to DECUS. Removed all assembly
switches except PURESW. Have RIPOFF determine KA/KI/KL
rather than assembly switch. Have it determine
if SUSET. UUO exists instead of assembly option.
Clean up disk code and fix RP04 in tables.
Revision history continued
[15] 15-Jul-76 Incorporate edits from suggestions from LUG users.
Treat *.*[*,*]/D as a special case, issue warning.
Add [10,1] to VIPS.
Round KA core size to K not pages.
Fix incorrect block number printout in SAT listing.
Change default output to TTY:
Make = work like left arrow, replace = as used in
/EC with == double equal.
Make "K for swapping" print right.
[16] 27-Oct-76 Add RP06 table.
University of Arizona local modifications
Start version 5 here
[17] 14-Mar-77 Add SFD support
[20] Clean up the convoluted and poor code.
[21] Get standard symbols from JOBDAT, UUOSYM, and MACTEN.
[22] Add support for DPC.
[23] Change block numbers back to octal, thus removing
part of edit 12.
[24] Add the /ETS, /ETL, and /ETN switch options.
[25] Add the /F switch
[26] Make the /V code a little more careful about
writing the listing to the same structure
being DSKRATed.
[27] Add new words to RIB for 603
[30] Print the checksum from the pointer in the /PR code
[31] Allow a range and increment [m<n(i)] to be specified
in the /ET command
[32] We normally run with several of our configured disks
off line and the RIPOFF initialization questions for
such disks are a real pain most of the time. Invent
a startup option question similar to TWICE and don't
bother the user unless LONG is selected.
[33] Remove the /SU option since it really doesn't
accomplish much.
[34] Fix RDNUMR to accept two commas between halfwords
in addition to just one (ala DDT). Also fix HALF8
to print two commas between halfwords.
[35] RIPOFF sometimes Ill Mem Ref's at SYSIN5 trying to
set up STRTAB. It wasn't allocating enough core
for the table.
[36] STRTAB before compression would only hold units
in the range 0-6. Incorrect index increment was
being used.
Revision history continued
[37] If MAXSTR and MAXUNI differed, LNKDON was destroying
information outside of STRUNI. Fix typo in BLT.
[40] Second pass of the /V code jumped off into the
middle of the /A code. Jump to the correct place.
[41] If SUSET. failed in the check for privs, the
USETI will fail also because the code assumes that
an error return exists. Remove the erroneous
error return.
[42] The monitor won't let a user write UFD's or SFD's
so remove the OUTPUT UUO from MAKUFD.
[43] Add error reporting for RP04's and RP06's.
[44] The routine BATB used by the /PB command only
printed the last of the bad regions. Restructure
the routine so that it works correctly.
[45] Unless the P option was selected with the /PF
command, the number of RIB pointers and the
extended RIB flag were garbage. If /PF is specified,
always do the pointer calculations.
[46] The flag F.DERR in the right half of F was doubly
defined and used for two different things. Change
the DELFIL flag to F.DBAD.
[47] If the user typed an invalid response in GTDATE,
this routine would finally return to the location
specified by the current radix. Solution is to
pop the radix off the stack at GTDT5.
[50] The /ST code was typing the block number but
calling it the cluster number. Put out the
cluster number instead.
[51] The routine GETCLS was only checking for errors
in the first SAT for each unit. This meant that
errors occurring in the 2nd thru Nth SATs were
never reported by the /V code. In the next level
routine up, call GETCLS once for each SAT with
an index indicating which SAT to process.
[52] The computation of the folded checksum in BLKRED
compares the wrong register against what it thinks
is the checksum from the retrieval pointer. However,
this value is incorrect also so that the routine
seems to always compare zero with zero. A more
serious problem is that the routines that call
BLKRED with F.CSUM set do not always set up P1,
the register that is supposed to contain the
retrieval pointer from the RIB. Rework all the
code involved in computing checksums and insure
that the code is called with the proper registers
setup.
[53] The routine SEARCH was adding the increment to
the starting block number immediately thereby
skiping the starting block. Change all callers
of SEARCH to take this into account.
Revision history continued
[54] While transfering pointers to the core block,
the routine PTRCPY would transfer information
outside of the RIB. This is because the code
assumes that the last word before the retrieval
pointers begin is RIBUFD. Use RIBENT instead.
[55] RIPOFF determined if a user was privledged by
attempting a super USETI on the physical unit
returned by the SYSPHY UUO. However, if this
drive was not functioning correctly for some
reason, RIPOFF would conclude that the user
was not privledged and blow him off. Make the
check for privs in a more usual manner.
[56] 17-Nov-77 Even though there was lots of code to use the
SUSET. UUO instead on USETI/Os, RIPOFF was always
using USETI/Os because the location %SUSET was
getting zeroed by the BLT at ROLL. Same was
true of all cells initialized between RIPOFF and
ROLL. Move the affected locations to after the
label ZROEND.
[57] 03-Dec-77 The RIPOFF /VF code cleared all the bits in the last
word of each SAT that did not correspond to actual
clusters on the disk as a byproduct of the way it
built it's SATs. However, the monitor hole search
algorithm depends on these bits being set. The
result was that files were being written on top
of the SAT blocks themselves and the disk would
go right into the pits. Make sure that the "unused"
bits in the last word of every SAT are set before
writing the SATs back out
[60] 07-Dec-77 Add the /W command to do word searches for specified
patterns in a file or range of blocks.
[61] 13-Dec-77 Don't allow /VF code to be performed on a mounted
structure. Also, insure that the device being /VFed
is a structure.
[62] 15-Dec-77 Add the /DA option to force RIPOFF to ask for confirmation
of every file to be deleted.
[63] 16-Dec-77 CURPOS(U) was getting bumped even though NOIO was set
in calls to BLKRED/BLKWRT. This was OK unless the next
block to be read on a unit was one plus the last block
skipped with NOIO set, in which case a required USETI/O
was not being done and the wrong block was being read/
written.
[64] 16-Dec-77 Replace all HALT instructions with jumps to a catastrophic
error routine that closes the listing file, does a reset,
issues an error message via OUTSTR and exits.
[65] 30-Jan-78 Modify /PU switch so that it no longer prints the
HOME block. If you want the block, use /PV
[66] 02-Feb-78 Add the /C switch to do conversions from one disk
value to another
Revision history continued
[67] 25-Feb-78 Add a ^C intercept to ask the user if the listing
file should be closed if the listing is being written
to a file. (No one remembered to type /X to exit)
[70] 02-Mar-79 Modify GTDATE to read the date as dd-mmm-yy instead
of yy/mm/dd.
[71] 02-Mar-78 Make the radix change stuff (^D, ^O, etc.) in the
command string strictly local to the next expresion.
[72] 02-Mar-78 Make the command DEV:(relsiz)/Pl print files >=
relsiz instead of PPNs with more than relsiz blocks.
This was more useful to us.
[73] 08-Mar-78 Add the /DM option to force the delete routines to
use the monitor RENAME only.
[74] 08-Mar-78 Don't let the /AM switch be used on a mounted STR.
[75] 26-Apr-78 Prevent /IR from messing up creation date on restored
files. (U. of Texas)
[75] 11-May-78 RIPOFF loops if the user types a ^Z at command level.
Make ^Z look like ^C. Also ignore spaces and tabs
correctly.
[76] 19-May-78 RIPOFF doesn't know about RS04's. Add support for
them
[77] 8-Aug-78 Report of files found is garbage when wildcard is used with /FD switch
[TCSAPA]3-21-80 Mark in SAT the blocks pointed to by BAT. /SMW
[TCSAPC]3-25-80 Make RIPOFF know about RPD's, per request of DEC Phoenix /SMW
`
SUBTTL Bits and pieces
SEARCH JOBDAT,MACTEN,UUOSYM ; Get standard symbols
SALL ; Clean up the listing
RIPVER==5 ; Major edit number
RIPMIN==0 ; Minor edit number
RIPEDT==77 ; Last edit number
RIPWHO==4 ; Programmer - SRB/GMU
LOC <.JBVER>
VRSN. (RIP) ;; Plug version number
RELOC
PURGE RIPVER,RIPMIN,RIPEDT,RIPWHO
; Conditional assembly switches
IFNDEF PURESW, <PURESW==-1> ; Two segment shareable program
; Set up relocation
IFN PURESW, < TWOSEG
RELOC 400000
.ZZ==.JBDA ; First low segment location
>
IFE PURESW, <RELOC>
SUBTTL Accumulator and I/O channel definitions
F=0 ; Flags and switches
T=1 ; First of 5 temp AC's
T1=2 ;
T2=3 ;
T3=4 ;
T4=5 ;
N=6 ; Numbers across I/O subroutines
N1=7 ; N+1 for remainders
CH=10 ; Characters
M=11 ; Message pointer and temp AC
U=12 ; Unit
P1=13 ; First of 4 temp pointers
P2=14 ;
P3=15 ;
P4=16 ;
SW=P3 ; Switch bits live here
P=17 ; Pushdown pointer
; Monitor I/O channels
CMD==0 ; TTY cmd channel
LST==1 ; The list device
STR==2 ; Disk channel used for all temporary disk I/O
AUX==3 ; Auxillirary channel for scratch output device
FFCHAN==4 ; First free channel
SUBTTL Flag bits
; Bits in LH of F
.DEV==1B17 ; Seen a device
.DOT==1B16 ; Seen a dot
.EXT==1B15 ; File extension has been typed
.LBRKT==1B14 ; Left bracket seen
.COLON==1B13 ; Seen a colon
.BCHR==1B12 ; AC 'CH' contains break char already.
.LBS==1B11 ; Pound sign (#) seen.
F.MFD==1B17 ; MFD has been 'LOOKED UP' on str
F.RALL==1B16 ; Read all blocks in BLDSAT
F.TMP==1B15 ; Tempory flag for any use
F.SCAN==1B14 ; Force NXTFIL to treat SFDs as directories
F.OURS==1B13 ; Mark bits in our SAT
F.TRB==1B12 ; Be on lookout for differences in above two SATS
F.MDEL==1B11 ; Use the monitor RENAME only in DELFIL/DELUFD
F.RIB==1B9 ; Used by RIBCHK
F.MULT==1B8 ; Multiply used clusters found
F.CRLF==1B7 ; No carriage returns between blocks in ASCOUT
F.1UNI==1B6 ; INIT'ed STR points to only one unit
S.SFD==1B4 ; All SFD levels are * in command string
S.NAM==1B3 ; Ditto for filename
S.EXT==1B2 ; Ditto for extension
S.PROG==1B1 ; Ditto for programmer number
S.PROJ==1B0 ; Ditto for project number
STNDRD==S.PROJ!S.PROG!S.NAM!S.EXT!S.SFD
; Default command string is ALL:*.*[*,*,*,*,*,*,*]
; Flags (In RH of F)
F.TTY==1B35 ; TTY output
F.TTY2==1B34 ; Force TTY output for all output (user assigned TTY LPT)
F.FAIL==1B33 ; Something failed
F.INI==1B32 ; DSK channell is INIT'ed.
F.IO==1B31 ; 1 if writing, 0 if reading
F.NULL==1B30 ; Null UFD
F.TRY==1B29 ; Try count for BLKRED,BLKWRT
F.CSUM==1B28 ; Tell BLKRED to checksum block
F.ERRM==1B27 ; About to print an error msg. No tab on output
F.TYPE==1B26 ; 1=DP,0=FH, Used by DEVERR
F.DBAD==1B25 ; Delete only if file is bad (/DB)
F.RIP==1B24 ; Restore in progress (/I code)
F.QUICK==1B23 ; Quick option in BLDSAT (/VQ)
F.NEWR==1B22 ; New RIB just read by GETPTR (Extended RIB)
; (Flag zeroed every call otherwize)
F.DERR==1B21 ; For SYSINI to tell BLKRED data error expected.
; BLKRED supresses printing of error message.
F.NOTB==1B20 ; Force NAMPNT to use dot instead of tab
; between filename and ext
F.NPP==1B19 ; NXTPPN called instead of NXTDIR
F.LEN==1B18 ; Force DMPIN to ignore length of the file contained
; in the RIB and give EOF return only when the
; RIB pointers are exhausted
SUBTTL Switch bit definitions
REPEAT LOGIC,<
Switches are typed to RIPOFF in the form of /AXYZ/BQRST
Where A and B are the actual switches and XYZ are the A options
and QRST are B options. E.g., to use /P (print disk listing)
and print SATS and BATS only (S and B options), one would type
STR:/PSB
The first switch character after the / is read and saved,
and all following chars up to the next / or line delimiter
are taken as the options which apply to that switch. The
options live in AC 'SW' as follows:
A-Z Set bits 35-10 respectively in SW
0-9 Sets bits 9-0 respectively.
The following macros define these bits.
Switches may be tested by TXN{E,N} SW,CH.X
where 'X' is the switch to be tested.
>
SALL
DEFINE SWMAC (X)
< IRPC X,<CH.'X==1B<^D35+<"A"-"X">>>>
SWMAC (ABCDEFGHIJKLMNOPQRSTUVWXYZ)
DEFINE SWMAC(X)
< IRPC X,< CH.'X==1B<^D9-X>>>
SWMAC (0123456789)
SUBTTL COMMOD parameter definitions
;
; The following three pages contain BAT block, HOME block,
; and RIB definitions from COMMOD. BE SURE that the following
; definitions agree with those in your version of COMMOD.
;
;
; BAT block definitions
BAFNAM==0 ; SIXBIT /BAT/
BAFFIR==1 ; -Cnt free wrds,,Rel. adr. of 1st bad region
BAFNBS==2 ; Contains BAYNBS,BAYNBR,BAYKND pointers
BAYNBS: POINT 9,BUF+BAFNBS,8 ; # Bad sectors found by map
BAYNBR: POINT 9,BUF+BAFNBS,17 ; # Bad regions found by map
BAYKDC: POINT 7,BUF+BAFNBS,24 ; Kontroler device code
BAFCNT==3 ; # Pairs added by MONITOR
BAFREG==4 ; First bad region pair goes here
BAPOTH==400,,0 ; Non-zero if blocks found by other Kontroler also
BAPNTP==40000 ; Non-zero if new-type entry
BAYNBB: POINT 9,-1(P2),8 ; Number of bad blocks in this region
BAYPUB: POINT 8,-1(P2),17 ; Physial unit within Kontroller
BAYKNM: POINT 3,-1(P2),20 ; Logical Kontroller number
BAYAPN: POINT 14,-1(P2),35 ; Processor number
BAYERR: POINT 6,(P2),8 ; Error bits on new entry
BAYELB: POINT 27,(P2),35 ; Block adr of bad region in new entry
BAFCOD==176 ; Contains unlikely code (606060)
CODBAT==606060 ; The code itself
BAFSLF==177 ; This block in unit
; HOME block definitions
HOMNAM==0 ; "HOM" in SIXBIT
HOMHID==1 ; SIXBIT unit id
HOMPHY==2 ; Physical address of this block,,other home block
HOMSRC==3 ; Position of this STR in SYS search list
HOMSNM==4 ; SIXBIT structure name
HOMNXT==5 ; ID of next unit in file structure
HOMPRV==6 ; ID of previous unit in file structure
HOMLOG==7 ; SIXBIT logical unit # within file structure
HOMLUN==10 ; Logical unit in STR
HOMPPN==11 ; Proj-prog # which refreshed STR
HOMHOM==12 ; LH==Logical block # within unit of Home block
; RH==Log. block # within unit for extra Home block
HOMGRP==13 ; # of blocks per group to try for
HOMBSC==14 ; # blocks per supercluster on this unit
HOMSCU==15 ; # of superclusters per unit
HOMCNP==16 ; Byte ptr for cluster count in RIBS
HOMCKP==17 ; Byte ptr for checksum in RIB
HOMCLP==20 ; Byte ptr for cluster address in RIB
HOMBPC==21 ; # blocks per cluster for this STR
HOMK4S==22 ; # K words for swapping on this unit
HOMREF==23 ; Non-zero if file must be refreshed
HOMSIC==24 ; # SAT blocks in core
HOMSID==25 ; Unit ID of next unit in active swapping list
HOMSUN==26 ; Logical unit # in active swapping list
HOMSLB==27 ; First log. block # for swapping on this unit
HOMCFS==30 ; Swapping class
HOMSPU==31 ; # SAT blocks per unit
HOMOVR==32 ; Overdrawn limit per user on this STR
HOMGAR==33 ; Upper bound on total reserved blocks
HOMSAT==34 ; SAT.SYS (Log. block within STR of first RIB)
HOMHMS==35 ; HOME.SYS
HOMSWP==36 ; SWAP.SYS
HOMMNT==37 ; MAINT.SYS
HOMBAD==40 ; BADBLK.SYS
HOMCRS==41 ; CRASH.SAV
HOMSNP==42 ; SNAP.SAV
HOMRCV==43 ; RECOV.SYS
HOMSUF==44 ; SYS UFD [1,4] UFD
HOMPUF==45 ; Printer UFD [3,3]
HOMMFD==46 ; MFD [1,1]
HOMPT1==47 ; First retrieval ptr for MFD
HOMUN1==50 ; Logical unit # where MFD starts
HOMLEN==51 ; Table of lengths of files created by refresh - 6 words
HOMEND==56 ; Last word kept in UDB copy of Home block
HOMUTP==57 ; Unit type on which HOM block was written
HOMRIP==60 ; Used by RIPOFF (That's not us)
HOMKLB==61 ; First of 20 words used by PDP-11 in KL10 systems
HOMKLE==104 ; Last of the 20 words
HOMK4C==105 ; K for CRASH.EXE file
HOMBTS==106 ; Bits in the HOM block
HOMPVS==1B35 ; Unit contained in a private STR
HOMVID==165 ; Volume ID (3 words, 12 PDP-11 bytes)
HOMOWN==170 ; Owner name (3 words, 12 PDP-11 bytes)
HOMVSY==173 ; System type (3 words, 12 PDP-11 bytes)
HOMCOD==176 ; Contains XWD 0 ,, 707070 (unlikely code)
CODHOM==707070 ; Unlikely code for HOMCOD
HOMSLF==177 ; This block # within unit
; RIB definitions
RIBFIR==0 ; XWD -Nr. of retrieval ptrs ,, First pointer adress
RIBPPN==1 ; XWD Project ,, Programmer number
RIBNAM==2 ; SIXBIT file name
RIBEXT==3 ; SIXBIT file extension ,, Access date
EXLHCD: POINT 3,BUF+RIBEXT,20 ; 3 high order bits of creation date
EXLACD: POINT 15,BUF+RIBEXT,35 ; Access date
RIBPRV==4 ; Priv. bits ,, mode ,, creation time ,, creation date
EXLPRV: POINT 9,BUF+RIBPRV,8 ; Protection code
EXLMOD: POINT 4,BUF+RIBPRV,12 ; Creation mode
EXLCRT: POINT 11,BUF+RIBPRV,23 ; Creation time
EXLLCD: POINT 12,BUF+RIBPRV,35 ; 12 low order bits or creation date
RIBSIZ==5 ; File length in words
RIBVER==6 ; Prog # making last change ,, octal version #
RIBSPL==7 ; Spooled device
RIBEST==10 ; Estimated length of file in blocks
RIBALC==11 ; # of blocks allocated for file
RIBPOS==12 ; Log block # in STR of last group
RIBFT1==13 ; Reserved for future use by DEC
RIBNCA==14 ; Word for customer to define
RIBMTA==15 ; Tape label if file on magtape
RIBDEV==16 ; Name of STR containing file
RIBSTS==17 ; Status bits
RIPLOG==1B0 ; User logged in
RIPDIR==1B18 ; This is a directory
RIPNDL==1B19 ; No deletion of this file by any user!
RIPNCN==1B20 ; No name change permitted
RIPNFS==1B21 ; Not to be dumped by BACKUP
RIPABC==1B22 ; Always bad checksum (SWAP.SYS, SAT.SYS)
RIPABU==1B24 ; Always backup this file
RIPPAL==1B25 ; Pre-allocated file
RIPSCE==1B27 ; File has checksum error
RIPHWE==1B28 ; File has had hard write error
RIPHRE==1B29 ; File has had hard read error
RIPBFA==1B32 ; File found bad by BACKUP during restore
RIPCRH==1B33 ; File closed after crash
RIPBDA==1B35 ; File found bad by damage assesment program
RIBELB==20 ; Log block # where bad region begins
RIBEUN==21 ; Err unit # in STR ,, Nr bad blocks in region
RIBQTF==22 ; FCFS quota for this PPN in this STR (UFD only)
RIBQTO==23 ; Logged out quota (UFD only)
RIBQTR==24 ; Reserved quota (UFD only)
RIBUSD==25 ; Nr blocks used when job was last logged out (UFD only)
RIBAUT==26 ; Author - PPN writing the file
RIBNXT==27 ; Next STR for this file (unused level D)
RIBPRD==30 ; Previous STR for file (unused level D)
RIBPCA==31 ; Privileged arg for customer definition
RIBUFD==32 ; Block # in STR of UFD data block with ptr to this RIB
RIBFLR==33 ; First logical block in file pointed to by this RIB
; (zero if first RIB)
RIBXRA==34 ; Extended rib address
DEYRBU: POINT 4,SAVXRA(P4),12 ; Unit
DEYRBA: POINT 23,SAVXRA(P4),35 ; Cluster address
DEYRBC: POINT 8,SAVXRA(P4),8 ; Count
RIBTIM==35 ; Time,,Date word in universal standard
RIBLAD==36 ; Last accounting date (UFD)
RIBDED==37 ; Directory expiration date (UFD)
RIBACT==40 ; AOBJN pointer to account string
RIBENT==RIBACT ; Last arg or value on extended lookup/enter/rename
RIPNUB==400000 ; Bit in retrieval ptr says new unit
RIBCOD==176 ; Contains 777777 (unlikely code)
CODRIB==777777 ; Unlikely code for RIBCOD
RIBSLF==177 ; This logical block number in STR
SUBTTL Internal device table definitions
REPEAT LOGIC,<
The unit data blocks (UDB's) are created as RIPOFF begins
execution, one for each unit in the system. These UDB's contain all
information about the units pertinent to RIPOFF, as defined below.
They are connected by a linked list starting in UNIDDB (RH), linking
through the right half of the first word in each UDB. AC U is reserved
for the current UNIDDB address.
To 'INIT' a structure, a call is made to NXTSTR (PUSHJ).
Here, the next (or first) structure or device is set up, in
accordance with the command string. Within NXTSTR, all physical units
involved in the current str or device are linked through the left half,
begining at UNIDDB (LH). Thus to find all units pertinint to the current
structure, transverse the LH. Transversing the right
branches finds all units in the system. In addition to the UDB's,
the following two tables are also of interest.
STRTAB - Contains the SIXBIT name of each structure in
the system, followed by the address of the UDB's for each unit in
the STR. Set up at system initialization (SYSINI). Note that this
is a compressed table, i.e., the number of entries following each
SIXBIT structure name is precisely the number of units in that structure.
STRUNI - Block of 8 words which are the addresses
(in order) of all UDB's in the present structure. Set by each
'INIT' (NXTSTR).
>
; Each UDB setup at system initialization contains the first
; 57 words of the HOM block (HOMNAM through HOMEND) as the first
; 57 words of the UDB. In addition, each UDB contains the
; following words:
;
DEFINE UUU(X,Y)
< UNIDDL=UNIDDL+Y
X=UNIDDL >
UNIDDL=HOMEND ; The first 57 words of the Home block are
; always in the UDB.
;***** Note: Do not change order here without changing order
; in UNITAB *******
UUU(UNIWPS,1) ; Words/SAT for this unit
UUU(UNICPS,1) ; Clusters/SAT for this unit
UUU(DRIVE,1) ; Physical device name pack is on (DPA3,FHA0)
UUU(DEVKON,1) ; XWD unit within controler ,, Contr. type
; (See TYPMAX)
UUU(BLKCYL,1) ; Blocks/cylinder on unit
UUU(BLKTRC,1) ; Blocks/track on unit
UUU(BLKUNI,1) ; Blocks on this unit
;**** End of dont change order (This is all the info printed...)
UUU(UNISTS,1) ; CONI word after last interrupt from unit
UUU(XCHAN,1) ; Z chan,T (Inited channel in AC field, T in adr.)
UUU(CURPOS,1) ; Last block this unit positioned to.
UUU(DSKSAT,1) ; Initial pointer to core copy of disk SATs
UUU(OURSAT,1) ; Initial ptr to our version of SATs
UUU(TRBSAT,1) ; Log of difference between above two SATs
UUU(UNIDES,1) ; DSKCHR bits for unit
UUU(PATDDB,3) ; Patching space for debugging
;**** Add new words above this line
UNIDDL==UNIDDL ; So we can see it in CREF listing
SUBTTL Miscellaneous parameters
;
; General disk parameters
BLKSIZ==200 ; Length of disk blocks
HEDNUM==3 ; Number of words in I/O header block
LHOM1==1 ; Logical address of first Home block
LHOM2==12 ; Logical address of second Home block
MAXSTR==^D13 ; Maximum number of file structure on this system
; (Used only to limit table sizes)
MAXUNI==7 ; Number of highest unit on a controller
DUFD==700000 ; Standard UFD protection
DPRT==155000 ; Standard file protection
STRQUE==SIXBIT/DSKB/ ; Structure to be assumed for queue
; if GETTAB fails
SFDLVL==5 ; Max level for SFD nesting
PDLSIZ==50 ; Size of the PDL
;
; File status bits
; RH bits in IOSTS(P4) are taken from the RIB
; LH bits in IOSTS(P4) are internally used bits
IO.FAC==1B0 ; File is active (LOOK'ed UP and not hit EOF)
IO.CKS==1B1 ; Checksum error
IO.WRT==1B2 ; 1=File being written, 0=Reading
;
; Extended LOOKUP/ENTER parameters
EXLLEN==32 ; Number of extended lookup args
EXLERC==3 ; Error code found in this word of LOOKUP/ENTER block
EXLERB: POINT 10,BUF+RIBSTS,35 ; Error bits
;
; Parameters for EOF block (on AUX device)
EOFNAM==0 ; SIXBIT /EOF/
EOFCOD==176 ; Contains unlikely code
CODEOF==506070 ; The code
EOFSLF==177 ; This word within file (not implemented yet!)
;
; Some useful opdefs
OPDEF TTYON [TRO F,F.TTY] ; Enable TTY output
OPDEF TTYOFF [TRZ F,F.TTY] ; Disable TTY output
;
; and general bits of crud
TOPHIS==^D50 ; Highest file size to look for in histogram
MAXCMD==^D60 ; Max number of ASCII command string characters
PAGSIZ==^D58 ; Number of lines per printer page
BUFNUM==0 ; Number of buffers for LPT and TTY (use monitor default)
DLPT=='LPT' ; These are the default device names
DLST=='LST' ; and also help DDT printout
DDSK=='DSK' ; More meaningful codes
DSYS=='SYS'
DTTY=='TTY'
DCTY=='CTY'
UFD6=='UFD'
SUBTTL Storage macro definitions
IFE PURESW,<
DEFINE UU(A,B)
<A: BLOCK B >
>
IFN PURESW,<
DEFINE UU(A,B)
< A=.ZZ
.ZZ=.ZZ+B >>
DEFINE U(A)
< UU(A,1) >
; Macro for generating error tables
DEFINE ERRMAC(X,Y)
< XWD [ASCIZ/X/] , [ASCIZ/Y/] >
; Some useful macro op-code definitions
DEFINE MOV (X,Y) ;; Move from memory to memory (uses T)
< MOVE T,X
XLIST
MOVEM T,Y
LIST >
DEFINE MOVI (X,Y) ;; Move immediate to memory (Uses T)
< MOVEI T,X
XLIST
MOVEM T,Y
LIST >
DEFINE MOVPTH (X,Y) ;; Move PATH. block in memory (Uses T)
< IFG SFDLVL,
< MOVE T,[X,,Y]
XLIST
BLT T,Y+.PTPPN+1+SFDLVL+1-1
LIST
>
>
SUBTTL RIPOFF main routines
RIPOFF: JFCL ; No CCL entry
RESET ; Reset everthing
MOVI SWT.X,.JBREN ; Setup reentry address
MOV <[4,,CCEXIT]>,INTBLK+.ERNPC ; Setup ^C intercept block
MOVI ER.ICC,INTBLK+.ERCLS ; contents
SETZM INTBLK+.EROPC ; and clear rest of block
SETZM INTBLK+.ERCCL
MOVI INTBLK,.JBINT ; and setup for intercept
MOVE P,PDP ; Setup pushdown list
GETPPN T, ; Get our PPN
JFCL ; Avoid stupid skip
MOVEM T,OURPPN ; and save for later
MOVX T,%LDFFA ; GETTAB for GOD PPN
GETTAB T, ; Get it
MOVE T,[1,,2] ; Assume the obvious
CAMN T,OURPPN ; Same as ours?
JRST RIP1 ; Yes, good enough
PJOB T, ; Get our job number
MOVNS T ; Negate it
JOBSTS T, ; Get our job's status
SKIPA ; Too bad
TXNN T,JB.UJC ; Job running with JACCT?
JRST BADBOY ; No, not privledged enough
RIP1: SETZB F,%SUSET ; Clear flags and assume no SUSET. UUO
MOVEI T,.IODMP ; Open dump mode channel
SETZB T1,T2 ; No buffers + setup for SYSSTR
SYSSTR T1, ; Get structure name to use
JRST RIP2 ; Can only hope the rest will work
OPEN STR,T ; Open the channel
JRST RIP2 ; What can we do?
MOVE T,[Z STR,1] ; Set to read block 1
SUSET. T, ; Try it
JRST RIP2 ; Didn't work, use USETO/I
STATO STR,IO.IMP!IO.BKT ; Any errors?
SETOM %SUSET ; Flag SUSET. as OK
RIP2: RESET ; Reset the world again
RIPSIZ: MOVEI T,LOWSIZ ; Build free core after LOWEND
; This location must be altered
; whenever patches are made
MOVEM T,.JBFF ; Tell monitor our correct field length
CORE T, ; Adjust core to this value
JFCL ; Oh well
IMULI T,^D1024 ; Compute CORMAX from 1K blocks returned
IFN PURESW, <
SUBI T,400000 ; Can't core up into high seg
>
MOVEM T,.JBMAX ; Highest loc available to low segment
SETZ T,
MOVSI T1,DTTY ; First get us a TTY
MOVE T2,[XWD WH.CMD,RH.CMD]
OPEN CMD,T
JRST NOTTY
SETZ T,
MOVSI T2,WH.LST
MOVSI P1,DLST
DEVCHR P1, ; Look for a listing device
JUMPE P1,HAVETT ; No .ASS DEV LST..Use TTY
TXNE P1,DV.TTY ; .ASS TTY LST?
JRST HAVETT ; Yes. Use it.
MOVSI T1,DLST ; No. Use device 'LST'
OPEN LST,T
JRST HAVETT ; OPEN fails? Use TTY.
OUTBUF LST,BUFNUM ; Got 'LST'. Set up buffers.
SKIPA
HAVETT: TXO F,F.TTY2 ; Use TTY as major output device.
INBUF CMD,BUFNUM
OUTBUF CMD,BUFNUM
TXNN P1,DV.DIR ; Is 'LST' a directory device?
JRST NOENTR ; No. Skip ENTER
SKIPA T,[SIXBIT .RIP0.] ; Start with RIP0.LST
MAKIT: ADDI T,010000 ; And inc to RIP1.LST , RIP2.LST etc
CAMLE T,[SIXBIT .RIP9.] ; Quit after 10 tries.
JRST EFAIL
MOVSI T1,'LST'
SETZB T2,T3
LOOKUP LST,T ; File already there?
TRNE T1,-1 ; No. This is a good name
JRST MAKIT ; Yes. Try another
HLLZS T1
SETZB T2,T3
ENTER LST,T ; ENTER it.
JRST MAKIT ; Can't. Try another name.
NOENTR: MOVX T,%CNSTS ; Get configuration status word
GETTAB T,
SKIPA
TXNN T,ST%TDS ; Must be level D
JRST BADMON
MOVEI M,IDRIP
PUSHJ P,MSGTTY ; Must also introduce ourselves
LDB N,VERPTR ; Get our major version #
PUSHJ P,OCTPRT
HRRZ N,.JBVER
JUMPE N,ROLL
PUSHJ P,LPAR
HRRZ N,.JBVER
PUSHJ P,OCTPRT ; 'RIPOFF V5(nnn)' ;Version and edit
MOVEI CH,")"
PUSHJ P,W.CMD
; Here to start the ball rolling...
ROLL: PUSHJ P,CRLF
MOVE P,PDP ; Reset the world
SETZM ZROBEG ; Clear out data area
MOVE T,[ZROBEG,,ZROBEG+1]
BLT T,ZROEND ; This will work whether pure or not.
MOV <[IOWD BLKSIZ,BUF]>,IOW ; Set up IOWD for I/O
MOVI ^D8,RADIX ; Assumed radix is octal
MOVSI T,DLST ; Get LST
DEVNAM T, ; Get physical name
SETZ T, ; No ASS DEV LST
CAME T,[SIXBIT/DSK/] ; Was it ASS DSK LST?
JRST ROLL1 ; Nope
MOVEI T,T1 ; Point to block
SETO T1, ; Return first str in search list
MOVE T2,OURPPN ; for our PPN
JOBSTR T, ; Get it
SETZ T1, ; What can we do?
MOVE T,T1 ; Get device name
ROLL1: MOVEM T,LSTDEV ; Save list device
MOVE T,[XWD 3,T1] ;
SETOM T1 ; To read default path
PATH. T, ; Do it
SKIPA T,T1 ; T unchanged if no SFD's
SETZ T, ;
SETCAM T,%FTSFD ; =-1 if SFD's, 0 otherwise
JUMPN T,ROLL2 ; If no SFD's in monitor
MOVX T,%LDSFD ;
GETTAB T, ; Get SFDLVL from monitor
SETZ T, ;
CAIE T,SFDLVL ; Better be equal to what wer're
JRST BADCFG ; configured for
ROLL2: MOVX T,%CNOPR
GETTAB T, ; Find operators TTY name
MOVSI T,DCTY ; (CTY)
MOVEM T,DEVOPR
MOVSI T,-6 ; We need 6 PPN's
GETPP: MOVE T1,[%LDMFD
%LDSYS
%LDFFA
%LDHLP
%LDQUE
%LDCRP](T) ; Pointers to necessary PPN's
GETTAB T1, ; Ask monitor
MOVE T1,[1,,1
1,,4
1,,2
2,,5
3,,3
10,,1](T)
MOVEM T1,VIPS(T) ; and remember it.
AOBJN T,GETPP ; Go for next PPN.
MOVX T,%LDSTP
GETTAB T, ; Standard protection
MOVSI T,DPRT ; (155)
MOVEM T,STNPRT
MOVX T,%LDUFP
GETTAB T, ; Standard UFD protection
MOVSI T,DUFD ; (700)
MOVEM T,UFDPRT
MOVX T,%LDQUS
GETTAB T, ; STR for QUEPPN queueing
MOVX T,STRQUE ; Assume something
MOVEM T,QUESTR
SETOM WMASK ; Start out with /W mask = -1
SETZ T1, ; Figure out what machine we have..
MOVNI T,1
AOBJN T,.+1
JUMPN T,XKA
BLT T,0
JUMPE T,XKI
XKL: AOS T1
XKI: AOS T1
XKA: MOVEM T1,CPUXX ; 0=KA,1=KI,2=KL.
MOVX T,%CNPGS
GETTAB T, ; Get unit of core allocation
MOVE T,[.SUAKA
.SUAKI
.SUAKL] (T1)
MOVEM T,COREXX
PUSHJ P,STRTUP ; Get startup option from user
PUSHJ P,SYSINI ; Now we go initialize the world of disks
SUBTTL Command scanner and dispatcher
SCAN: SETZM CMDBEG ; Zero everything
MOVE T,[CMDBEG,,CMDBEG+1]
BLT T,ZROEND
MOVE P,PDP ; Make sure PDL is clean
MOVI SFDLVL,CMDLVL ; Assume full path
ANDI F,F.TTY2 ; Start with no flags (except F.TTY2 if set)
TXO F,STNDRD ; and defaults bits (all stars)
TTYON ; and turn on TTY I/O
SETZ SW, ; No switch options seen yet
SKPINL ; Defeat ^O
JFCL
PUSHJ P,CRLF
MOVEI CH,"*"
PUSHJ P,W.CMD ; and start with the standard star
OUTPUT CMD,
PUSHJ P,GETCMD ; Get the command
PARSE: PUSHJ P,RDATOM ; Get a name from CMD string
TXZA F,.BCHR ; No break char read now
PARSE2: TXO F,.BCHR ; Enter here if 'CH' has break char
MOVSI T,-DISLEN ; Length of dispatch table
HLRZ T1,DISPTB(T) ; Search through table
CAME T1,CH ; for a match to the term char
AOBJN T,.-2
HRRZ T,DISPTB(T) ; Match found (or table exausted)
JRST (T) ; Dispatch on it
DISPTB: XWD Z ,SWIT
XWD <":"> ,FILDEV
XWD <"."> ,FILDOT
XWD <"["> ,FILPPN
XWD <"/"> ,SWIT
XWD <"_"> ,EQL
XWD <"<"> ,TWOARG
XWD <">"> ,TWOARG
XWD <"="> ,EQL
XWD <"("> ,FILREL
XWD <"!"> ,RUNUUO
DISLEN== .-DISPTB
JRST CMDERR ; Falls through to here if illegal break char.
; Here when word ends in colon.
FILDEV: TXNN F,.DOT ; Dot already seen?
TXOE F,.COLON ; No. How abot colon?
JRST CMDERR ; Yes. Illegal
MOVEM M,USRSTR ; No. Must be a device name
JRST PARSE
; Here on left arror or equal sign (equivalent).
; Single equal is an output device, double is assignment for /E cmds.
EQL: MOVE T,CMDB ; Get CMD string pointer
ILDB CH,T ; Look ahead to next char
CAIE CH,"=" ; Double equal (_= would work too...)
JRST FILDST ; No. Single. Output file preceeded.
MOVEM T,CMDB ; Yes. Skip past character
JRST NEWARG ; and get /EC args.
FILDST: PUSHJ P,WHAT
MOV USRSTR,AUXDEV ; Transfer stuff to output side..
MOV USRNAM,AUXNAM
MOV USREXT,AUXEXT
MOVI AUXPTH,AUXPPN ; Setup pointer to block
MOVPTH USRPTH,AUXPTH
MOV BARG3,AUXTRY
SETZM USRSTR
SETZM PTHFLG ; Used only for input path
ANDI F,F.TTY2
TXO F,STNDRD
JRST PARSE
; Here when name ends in a dot, must be a file.
FILDOT: TXOE F,.DOT ; Dot already seen?
JRST CMDERR ; Yes. Can't have two
MOVEM M,USRNAM ; Must be a file name
JRST PARSE
; Here when name ends in "[", find out what preceeds, and continue
; To read a project ,, programmer number (and maybe a path).
FILPPN: PUSHJ P,WHAT ; Put last word where it belongs ( file or ext)
TXO F,.LBRKT ; Remember the left bracket
TXZ F,S.SFD ; Clear all SFD's flag
SETZM CMDLVL ; Assume no SFD's typed in path
PUSH P,RADIX ; Save input radix
MOVI ^D8,RADIX ; Make it octal for now
PUSHJ P,RDNUMR ; Get an octal proj,prog number
POP P,RADIX ; Restore radix
TLNN M,400000 ; RDNUMR see a star?
TXZ F,S.PROJ ; No. No star
TRNN M,400000 ; Same question?
TXZ F,S.PROG ; Same answer
MOVEM M,USRPTH+.PTPPN ; Save PPN in block
CAIN CH,"," ; Start of SFD spec?
SKIPN %FTSFD ; and monitor has SFD's?
SKIPA ; Nope to one of the above
PUSHJ P,FILPTH ; Yep
CAIN CH,"]"
ILDB CH,CMDB ; Allow optional closing bracket
JRST PARSE2 ; Done. Now get next cmd string arg
; Here to process an SFD spec. Store the PPN at USRPTH+.PTPPN
; and the SFD names starting at USRPTH+.PTPPN+1. Insure no more
; than SFDLVL SFD's. Block is initially zero, so we
; don't have to worry about the terminator.
FILPTH: SETOM PTHFLG ; Set have path flag
MOVSI T1,-SFDLVL ; Build AOBJN word to insure no
HRRI T1,1 ; more than SFDLVL names
FLPTH1: PUSHJ P,RDWORD ; Get next atom from cmd string
SKIPN M ; Gotta be non-null
PJRST [POP P,(P) ; fixup stack
JRST CMDERR ]; and tell user
MOVEM M,USRPTH+.PTPPN(T1) ; Store in correct word in block
XOR M,['* '] ; Was it a star?
SKIPE M ; Yep, skip
SETOM M ; Nope, set M to -1 for next instr
SETCAM M,SFDFLG(T1) ; =0 if no star, -1 if star
AOS CMDLVL ; Bump path level by one
CAIN CH,"," ; More to come?
AOBJN T1,FLPTH1 ; Loop if we don't have too many
POPJ P, ; and go finish up
; Here to establish what preceeding argument was when it doesn't
; end in anything which gives automatic clue. (i.e., a colon tells
; us a dev probably predeeded, a dot says a file name, but a "[" or
; a "/" or line delimiter says nothing..
WHAT: TXNE F,.LBRKT!.BCHR ; Seen a "["
POPJ P, ; Yes. To late to be a file name or ext.
CAIE P4,$CMBLK ; Block argument?
JRST WHAT1 ; No.
MOVEM M,BARG1 ; Yes. Remember it
SETOM GOTWRD ; Also set flag for /ET
MOVEI T,1
TXZE F,.LBS ; Pound sign?
ORM T,BARGFL ; Yes. Set BARG flag
POPJ P,
WHAT1: TXNE F,.DOT ; Seen a dot?
JRST FDOT ; Yes.
MOVEM M,USRNAM ; No. Must be a file name
POPJ P,
FDOT: MOVEM M,USREXT ; Dot already seen, must be an extension here
TXO F,.EXT ; Remember it
POPJ P,
; Here when "(" recieved, input a relative block size
FILREL: PUSHJ P,WHAT ; Identify previous arg
PUSHJ P,RDATOM ; Read a number now
CAIE P4,$CMBLK ; Must be numeric
JRST CMDERR
MOVEM M,BARG3 ; Save it for relative file size
CAIN CH,")"
ILDB CH,CMDB ; Allow closing paren
JRST PARSE2
; Here if "<" typed, input two block args
TWOARG: CAIE P4,$CMBLK ; Better be a block arg
JRST CMDERR
MOVEM M,BARG1
SETOM GOTWRD ; Set flag for /ET
MOVEI T,1
TXZE F,.LBS
ORM T,BARGFL
PUSHJ P,RDATOM ; Read next arg
CAIE P4,$CMBLK
JRST CMDERR
MOVEM M,BARG2
MOVEI T,2
TXZE F,.LBS
ORM T,BARGFL
JRST PARSE2
; Here on "==", /E edit args
NEWARG: CAIE P4,$CMBLK ; First is a number and should look like block arg
JRST CMDERR
MOVEM M,BARG1
PUSHJ P,RDATOM ; Next can be any type of legal atom
MOVEM M,BARG2
JRST PARSE2
; Here when file name ended with "!" , do a RUN UUO to another program
RUNUUO: PUSHJ P,WHAT
PUSHJ P,KILL ; Fin all listing files
SKIPN T,USRSTR
MOVSI T,DSYS ; Defaults to sys
SKIPN T1,USRNAM
JRST CMDERR ; Must have a name!
HLLZ T2,USREXT
MOVE T4,USRPTH+.PTPPN
RUNCOM: SETZB T3,T4+1
MOVEI T
RUN ; and run it
HALT RIPOFF ; Should never return here
; Here to take care of our many varieties of switches
SWIT: PUSHJ P,WHAT ; Establish file or extension
MOVSI T,'* '
CAME T,USRNAM ; Is the file name a star?
SKIPN USRNAM ; Or no name at all?
SKIPA ; Yes. Leave star bit set.
TXZ F,S.NAM ; No. Zero star bit
TXNE F,.DOT ; If no dot, cant have * ext.
CAMN T,USREXT ; If dot, ext must be typed '*'
SKIPA ; If he typed a star, leave star bit
TXZ F,S.EXT ; He typed a dot and didnt follow star
TXZ F,<.COLON!.DEV!.DOT!.EXT!.LBRKT!.LBS!F.TTY>
SKIPN T,USRSTR ; If he typed a str, better check it.
JRST SWT1
PUSHJ P,DEVTYP ; See if its AOK
JUMPL T1,NOSTR ; Not a str. Cmd error..
MOVEM T1,TTYTYP ; Remember the type he typed
MOVEM U,TTYDDB ; and unit 0 address
SWT1: MOVSI T,'UFD' ; Zero above bits (no longer needed)
CAME T,USREXT ; Is extension a 'UFD'?
JRST SWT4 ; No.
MOVE T,MFDPPN ; Yes. Then make 1,1 the
SKIPN USRPTH+.PTPPN ; PPN by default
MOVEM T,USRPTH+.PTPPN
TXZ F,S.PROJ!S.PROG ; and forget we ever saw a PPN
SWT4: MOVI USRPTH,USRPPN ; Setup pointer to path block
TXOE F,S.SFD ; If flag is zero, a path
JRST SWT3 ; was typed. Loop through
MOVEI T,SFDLVL ; all levels to determine if
SWT2: SKIPN SFDFLG(T) ; they are all stars. If so,
TXZA F,S.SFD ; re-set the flag
SOJG T,SWT2
SWT3: MOV USRNAM,TTYNAM ; Set up TTYNAM,EXT,PPN
MOV USREXT,TTYEXT ; so routines can retrieve
MOV USRPPN,TTYPPN ; incase they destroy names.
MOVPTH USRPTH,TTYPTH
JRST RIPDON ; Don't try to restore core
;
;
; Return here when all done with a switch processing routine.
; RIPDN1 to restore the contents of .JBFF from .SVFF
; RIPDON in the normal case
RIPDN1: PUSHJ P,ZCORE ; Restore .JBFF from .SVFF
RIPDON: OUTPUT CMD, ; Flush the TTY buffer
TXNN F,F.TTY2 ; Writing a listing file too?
OUTPUT LST, ; Yes, flush that too
PUSHJ P,RLSDSK ; Release all channels
SETOM STRFLG ; Initialize for NXTSTR
HRRZS UNIDDB ; Kill links for current STR
; Here to read next switch char in CMD string and set options bits
; in AC "SW". NXTSWT may be called at any time
NXTSWT: AND F,[STNDRD!F.TTY2] ; Zero all but inportant bits
MOV TTYNAM,USRNAM ; Make names right so
MOV TTYEXT,USREXT ; anybody that screws them
MOV TTYPPN,USRPPN ; wont hurt next routine.
MOVPTH TTYPTH,USRPTH
SETZB SW,P1 ; Start with no options or switches
JSP M,CHRGET ; Get first switch char
MOVE P1,CH ; and save it in P1
NXTSW0: JSP M,CHRGET ; Now read options
CAIN CH,"/"
JRST SWITGO ; Done for now..
CAIL CH,"0"
CAILE CH,"9"
JRST NXTSW1
SUBI CH,"0"-^D26 ; Char is numeric, goes in bits 26-35
NXTSW2: MOVEI T,1
LSH T,(CH) ; Make T=Bit for this switch
ORM T,SW ; and add it to the list
JRST NXTSW0
NXTSW1: CAIL CH,"A" ; If not numeric, must be alphabetic
CAILE CH,"Z"
JRST BADSW ; Not either, hes a dummie
SUBI CH,"A" ; For alpha chars, A=Bit 35, B=34, etc
JRST NXTSW2
CHRGET: ILDB CH,CMDB ; Read a char
JUMPE CH,SWITGO
CAIE CH,.CHTAB ; Ignore tabs/spaces
CAIN CH," "
JRST CHRGET
CAIE CH,";" ; Ready for a comment?
JRST (M) ; No. Return
ILDB CH,CMDB ; Yes. Ignore rest of CMD string
JUMPN CH,.-1
; Here to finally go dispatch to switch routines
SWITGO: JUMPE P1,SCAN ; No switches typed, ignore CMD
CAIL P1,"A"
CAILE P1,"Z"
JRST BADSW ; Switches may be alphabetic only
SUBI P1,"A"
JUMPE SW,SWITG1 ; If no option, must be OK!
HRRZ T,SWTAB(P1) ; Address of legal options
JUMPE T,ERR001 ; Unless zero
MOVE T1,SW ; T1=switches he gave us
ANDCM T1,(T) ; Turn off all legal switches
JUMPE T1,SWITG1 ; Should leave us with nothing
JRST ERR001 ; Bad option
SWITG1: HLRZ T,SWTAB(P1) ; Address of routine
JRST (T) ; Go!
; Table of switches and their legal options
; Format is:
;
; XWD Addr of routine,,Addr of legal switch bits
;
SWTAB: SWT.A ,, [CH.X!CH.T!CH.M!CH.F!CH.E]
BADSW ,,
SWT.C ,, [CH.U!CH.T!CH.P!CH.D!CH.C!CH.B]
SWT.D ,, [CH.A!CH.U!CH.T!CH.R!CH.N!CH.M!CH.B]
SWT.E ,, [CH.7!CH.6!CH.W!CH.U!CH.T!CH.S!CH.R!CH.N!CH.L!CH.C!CH.A]
SWT.F ,, [CH.2!CH.D!CH.E]
BADSW ,,
SWT.H ,, [-1]
SWT.I ,, [CH.2!CH.X!CH.T!CH.S!CH.R!CH.P!CH.O!CH.F!CH.E!CH.D!CH.A]
BADSW ,,
BADSW ,,
SWT.L ,, [CH.U]
BADSW ,,
BADSW ,,
BADSW ,, 0
SWT.P ,, [CH.6!CH.7!CH.V!CH.U!CH.S!CH.R!CH.Q!CH.P!CH.O!CH.L!CH.F!CH.E!CH.D!CH.B!CH.A]
BADSW ,,
SWT.R ,, 0
SWT.S ,, [CH.W!CH.T!CH.R!CH.P!CH.M!CH.L!CH.F!CH.B]
BADSW ,,
SWT.U ,, 0
SWT.V ,, [CH.Q!CH.F!CH.A]
SWT.W ,, [CH.M!CH.S!CH.T!CH.W]
SWT.X ,, [CH.Q]
BADSW ,,
BADSW ,,
SUBTTL Switch processing routines
REPEAT LOGIC,<
Switches are-
/A - Alphabatize UFD's (sort them by PPN if MFD, or files)
/C - Convert disk parameters
/D - Delete
/E - Edit disk blocks
/F - Find files
/H - Help
/I - Initialize UFD or files from RIBs only
/L - Lock in core
/P - Print according to format
/R - Read verify blocks
/S - Play with SATs, STRUUO's
/U - Make a UFD/SFD
/V - Verify files and fix SATs
/W - Do word searches on disk
/X - Close listing and exit
>
SUBTTL /A -- Alphabatize UFD's/SFD's...
REPEAT LOGIC,<
/A Options include:
/AF - Sort by file names and extensions (standard)
/AE - Sort by extensions and names
/AT - Sort by creation time and date (oldest first)
/AM - Sort the MFD only (/AF,/AE,/AT will not sort MFD)
X - X option OR'ed with above suppresses printout
>
SWT.A: PUSHJ P,NONAME ; Command is *[P,PN]/A
JRST ERR002
MOVSI T,(CAMN T,0) ; On all sorts, we avoid the MFD
TXNE SW,CH.M ; except on M option, in which case
MOVSI T,(CAME T,0) ; we avoid everything but the MFD
HRRI T,MFDPPN ; Make an instruction word
MOVEM T,ATEST ; XCT ATEST to decide whether to sort this guy.
MOVEI T,0 ; Assume F option
TXNE SW,CH.E
MOVEI T,1
TXNE SW,CH.T
MOVEI T,2
MOVEM T,LHEAD+1 ; This is key for sort.
MOVEI T,2
TXNE SW,CH.T
MOVEI T,3 ; 2 word entries for all but /AT
MOVEM T,LHEAD ; which has 3. Store in LHEAD.
TXNE SW,CH.X ; Supress messages?
JRST SWT.A0 ; Yes. Supress them.
MOVEI M,[ASCIZ/
Directories sorted:
/]
PUSHJ P,MSGTTY ; Give him a heading
SWT.A0: MOV .JBFF,.SVFF ; Save core limits now
SWT.A1: PUSHJ P,NXTSTR ; Get next structure
JRST RIPDN1 ; No more, restore core and return
JRST PNOMFD ; Tell of no MFD and quit
TXNN SW,CH.M ; /AM specified for this STR?
JRST SWT.A2 ; No
PUSHJ P,STRMNT ; This STR mounted?
JRST ERR016 ; Yes, can't do this
SWT.A2: PUSHJ P,NXTDIR ; Get next directory
JRST SWT.A1 ; None left, try next STR
MOVE T,USRPTH+.PTPPN ; Get PPN of candidate
XCT ATEST ; Shall we sort him?
JRST SWT.A2 ; No
TXO F,F.NULL ; Assume directory is null
SWT.A3: PUSHJ P,NXTFIL ; Get next file.
JRST SWT.A5 ; EOF, go sort directory
TXZ F,F.NULL ; No longer null
TXNN SW,CH.T ; Need to find creation time?
JRST SWT.A4 ; No. Good.
PUSHJ P,USRLOK ; Yes. Look up file
SKIPA T3,ZERO ; Oh well, use zero
PUSHJ P,FILDAT ; Get date,,time in T3
MOVE P1,T3 ; and save time in P1
SWT.A4: MOVE T,LHEAD
PUSHJ P,CORGRB ; Get some core
MOVE T1,USRNAM
MOVEM T1,(T) ; Store name
HLLZ T1,USREXT ; Second word is EXT,,
HRR T1,USRCFP ; CPF
MOVEM T1,1(T)
TXNE SW,CH.T ; Sort by time?
MOVEM P1,2(T) ; Yes. Store time word too.
JRST SWT.A3 ; and repeat for all files
; Here when all files for the current level are in core.
;
SWT.A5: TXNE F,F.NULL ; Null directory?
JRST SWT.A7 ; Yes, sort is done
MOVE T,.SVFF ; Get address of 1st word to sort
MOVE T1,LHEAD+1 ; Key for sort.
MOVE N,.JBFF ; Add of last word +1
MOVEM N,SORTOP ; Remember this for later
SUBI N,(T) ; # of words to sort
MOVE CH,LHEAD ; Length of entries
IDIVI N,(CH) ; N=# of entries
PUSHJ P,SORT ; Go sort it all
; Here when UFD sorted. Now get ready to write it back out.
MOVE P4,CURLVL ; Get current level
MOVE P4,CORBLK(P4) ; Point to correct core block
MOVE T,FNAME(P4) ; Get filename
MOVE T1,FEXT(P4) ; and extension
MOVE T2,FCFP(P4) ; Get CFP
MOVEI T3,FPATH(P4) ; Point to path
PUSHJ P,ENTR ; Do an enter on his UFD/SFD
JRST SWT.A9 ; Shouldn't fail
; Here when the directory is sorted to write it back out
;
MOVE T,.SVFF ; Get address of first word
SWT.A6: MOVE CH,0(T) ; Get a word from new UFD
PUSHJ P,W.UFD ; and write it back over old one
JRST SWT.A9
MOVE CH,1(T)
PUSHJ P,W.UFD
JRST SWT.A9
ADD T,LHEAD
CAMGE T,SORTOP ; Done?
JRST SWT.A6 ; No. Keep writing
PUSHJ P,C.UFD ; Done. Now close the file.
MOV .SVFF,.JBFF ; Restore core
SWT.A7: TXNE SW,CH.X
JRST SWT.A2
TTYON
PUSHJ P,CRLF
SWT.A8: PUSHJ P,UFDPNT ; Print success story
JRST SWT.A2 ; and return
SWT.A9: MOVEI M,[ASCIZ/
Failure on sort of /]
PUSHJ P,MSGTTY
JRST SWT.A8
U(ATEST) ; CAMX T,MFDPPN
U(SORTOP) ; Top of core to sort
SUBTTL /C -- Convert disk parameters
;
; Accept a block, cluster, CFP, or cylinder, surface, and sector
; and convert them to other pertinent values. Options include:
;
; /CB - Convert block number in structure
; /CC - Convert cluster number in structure
; /CD - Convert CFP
; /CP - Convert cylinder, surface, and sector
; /CT - Convert universal date/time (Not exactly a disk parameter
; but a useful conversion anyway)
; /CU - Convert block number in unit
SWT.C: TTYON ; All output goes to the TTY
MOVE T,TTYTYP ; Get device type specified
CAIE T,$DVSTR ; Must be a STR
TXNE SW,CH.P!CH.U!CH.T ; unless /CP or /CU or /CT specified
SKIPA ; All ok
JRST ERR017 ; Bad device
PUSHJ P,NXTSTR ; Setup for this structure
JRST RIPDON ; Nothing there?
JFCL ; No MFD is OK
;
; Here to process the /CC option. Convert the cluster number to, and
; print the corresponding block range and CFP in the structure, and
; the unit number, block range, and physical position on the unit.
;
TXNN SW,CH.C ; /CC option specified
JRST SWT.C1 ; No
MOVEI M,[ASCIZ/Cluster /]
PUSHJ P,PREFIX ; Print prefix and cluster number
PUSHJ P,STRPFX ; Print structure line prefix
MOVE P1,BARG1 ; Get the cluster number
IMUL P1,STRBPC ; Convert to block number
MOVE N,P1
PUSHJ P,CLSBLK ; Print range of blocks
MOVE N,P1 ; Get block number back
PUSHJ P,CFPPFX ; Print CFP
MOVE P2,P1 ; Don't destroy P1
IDIV P2,STRBPU ; Convert to unit, block on unit
MOVE N,P2 ; Get unit number
PUSHJ P,UNIPFX ; Print unit
MOVE N,P3 ; Get block on unit
PUSHJ P,CLSBLK ; Print range on unit
PUSHJ P,CRLF ; End the line
PUSHJ P,TAB2 ; Followed by 2 tabs
MOVE T2,P3 ; Get block on unit
PUSHJ P,PBNPRT ; Print disk address of first block
MOVEI M,[ASCIZ/ through
/]
PUSHJ P,MSGTTY ; Put out separator
MOVE T2,P3 ; Get first block back
ADD T2,STRBPC ; Compute last block+1
SUBI T2,1 ; Compute last block
PUSHJ P,PBNPRT ; Print physical address of last block
JRST SWT.C5 ; Go finish up
;
; Here to process the /CB switch. Convert the block number to the
; cluster, relative block, and CFP in the structure, and the block,
; and cylinder, surface, and sector on the unit.
;
SWT.C1: TXNN SW,CH.B ; Was /CB specified?
JRST SWT.C2 ; No
MOVEI M,[ASCIZ/Block /]
PUSHJ P,PREFIX ; Print prefix and block number
PUSHJ P,STRPFX ; Print structure prefix
MOVE P2,BARG1 ; Get the block number
IDIV P2,STRBPC ; Convert to cluster, relative block
MOVE N,P2
PUSHJ P,CLSPFX ; Print the cluster number
MOVE N,P3 ; Get the relative block in cluster
PUSHJ P,RLBPFX ; Print that also
MOVE N,BARG1 ; Get the block number back
PUSHJ P,CFPPFX ; Print the CFP
MOVE P1,BARG1
IDIV P1,STRBPU ; Convert to unit, block on unit
MOVE N,P1
PUSHJ P,UNIPFX ; Print the unit
MOVE N,P2 ; Get the block on unit
PUSHJ P,BLKPFX ; Print that also
MOVEI M,[ASCIZ/, /]
PUSHJ P,MSGTTY ; Print separator
MOVE T2,P2 ; Get block on unit
PUSHJ P,PBNPRT ; Print physical address
JRST SWT.C5 ; Go finish up
;
; Here to process the /CD option. Convert the CFP to, and print,
; the block and cluster on the structure, and the block and
; cylinder, surface, and sector on the unit.
;
SWT.C2: TXNN SW,CH.D ; Was /CD specified?
JRST SWT.C3 ; No
MOVEI M,[ASCIZ/CFP /]
PUSHJ P,PREFIX ; Print prefix and CFP
PUSHJ P,STRPFX ; Print structure prefix
MOVE P1,BARG1 ; Get the CFP
IMUL P1,HOMBSC(U) ; Convert to block number
MOVE N,P1
PUSHJ P,BLKPFX ; Print the block number
MOVEI M,[ASCIZ/, /]
PUSHJ P,MSGTTY ; Output separator
MOVE N,P1 ; Get the block back
IDIV N,STRBPC ; Convert to cluster number
PUSHJ P,CLSPFX ; and print it
IDIV P1,STRBPU ; Convert to unit, block on unit
MOVE N,P1 ; Get the unit number
PUSHJ P,UNIPFX ; Print the unit number
MOVE N,P2 ; Get the block on the unit
PUSHJ P,BLKPFX ; Print that also
MOVEI M,[ASCIZ/, /]
PUSHJ P,MSGTTY ; Print separator
MOVE T2,P2 ; Get block on unit again
PUSHJ P,PBNPRT ; Print physical disk address
JRST SWT.C5 ; Go finish up
;
; Here to proces the /CU option. Convert the block to the cylinder,
; surface, and sector.
;
SWT.C3: TXNN SW,CH.U ; Was /CU specified?
JRST SWT.C4 ; No
MOVEI M,[ASCIZ/Block /]
PUSHJ P,PREFIX ; Print prefix and block number
MOVEI M,[ASCIZ/ on unit
Unit: /]
PUSHJ P,MSGTTY
MOVE T2,BARG1 ; Get block on unit
PUSHJ P,PBNPRT ; Print physical disk address
JRST SWT.C5 ; Go finish up
;
;
; Here to process the /CP option. Convert the cylinder, surface,
; and sector to a block on the unit
;
SWT.C4: TXNN SW,CH.P ; Was /CP specified?
JRST SWT.C6 ; No
MOVE P1,BARG1 ; Get cylinder
IMUL P1,BLKCYL(U) ; Compute offset to this cylinder
MOVE P2,BARG2 ; Get surface
IMUL P2,BLKTRC(U) ; Compute offset from last cylinder
ADD P1,P2 ; Compute address of start of surface
ADD P1,BARG3 ; Add in sector address
MOVE T2,P1
PUSHJ P,PBNPRT ; Print the address
MOVEI M,[ASCIZ/
Unit: /]
PUSHJ P,MSGTTY
MOVE N,P1 ; Get the block number
PUSHJ P,BLKPFX ; Print the block
SWT.C5: PUSHJ P,CRLF ; End with CRLF
PJRST RIPDON ; Go do next command
;
;
; Here to process the /CT option. Print the universal date/time
; in a readable format.
;
SWT.C6: TXNN SW,CH.T ; Was /CT specified?
JRST ERR001 ; No, bad option
MOVE N,BARG1 ; Get universal date/time
PUSHJ P,DATTIM ; Print it
JRST SWT.C5 ; Go finish up
SUBTTL /D -- Delete files.
; /D Options include:
;
; /D Delete specified files
; /DB Delete file only if it is bad (according to monitor)
; /DT Ask for time criteria; Only delete files created before specified
; creation date, or not accessed since specified access date.
; /DU Delete all files of given PPN and then delete UFD too
; (i.e., wipe him out)
; /DN Delete all null directories within specified PPN's
; /DR OR'ed with above options, but uses RIPOFF delete
; (RIPFIL). SATs guaranteed to be messed up.
; Much faster however.
; /DA OR'ed with above options causes RIPOFF to print filename
; and ask for confirmation of every file to be deleted.
; Does not apply to N or U options.
; /DM OR'ed with above options causes RIPOFF to use only the monitor
; RENAME when deleting files.
SWT.D: SETCM T,F
TXNN T,STNDRD ; *.*[*,*]/D ??
PUSHJ P,ASK003 ; More likely a mistake...!
TXNN SW,CH.U ; Was /DU specified?
JRST SWT.D6 ; No
SKIPG CMDLVL ; Skip if any SFD's typed in cmd string
TXO F,S.SFD ; [p,pn]/DU implies [p,pn,*,*,*,*,*]/du
TXNN F,S.SFD ; If SFD's specified, were they all "*"?
JRST ERR018 ; No, can't do that
SWT.D6: TTYON
PUSHJ P,CRLF
TXNN SW,CH.T ; Time options?
JRST SWT.D4 ; No. Skip this
MOVEI M,[ASCIZ/Delete if created before: /]
PUSHJ P,MSGTTY
OUTPUT CMD,
PUSHJ P,GTDATE ; Input time and date
MOVEM T3,BEFORE ; and save in handy place
MOVEI M,[ASCIZ/and not accessed since: /]
PUSHJ P,MSGTTY
OUTPUT CMD,
PUSHJ P,GTDATE
MOVEM T3,AFTER ; Store.
MSTIME T1, ; Get current time
DATE T2, ; and date
PUSHJ P,.CNVDT ; in 36 bits
MOVE T4,AFTER
TLNN T4,-1 ; Did he not give a date?
HLLM T3,AFTER ; Use now
MOVE T4,BEFORE
TLNN T4,-1
HLLM T3,BEFORE
SWT.D4: TXNN SW,<CH.U!CH.N> ; Can't specify filenames for /DU or /DN
JRST SW.D4A ; None of these options
PUSHJ P,NONAME ; Check it out
JRST ERR002 ; Can't do that fella
; Here to start the search for files to be deleted
SW.D4A: TXNE SW,CH.M ; /DM specified?
TXOA F,F.MDEL ; Yes, set flag for DELFIL
TXZ F,F.MDEL ; Otherwise, clear the flag
TXNN SW,CH.U ; Now decide what header to type
SKIPA M,[[ASCIZ/Files deleted:/]]
MOVEI M,[ASCIZ/Deleting all files for users:/]
TXNE SW,CH.N
MOVEI M,[ASCIZ/Deleting null directories, users:/]
PUSHJ P,MSGTTY
PUSHJ P,CRLF
SW.D0A: PUSHJ P,NXTSTR ; Get next STR
JRST RIPDON ; When through
JRST PNOMFD ; Gotta have an MFD
SWT.D0: MOVEI M,NXTDIR ; Default is to call NXTDIR
TXNE SW,CH.U ; Unlesss /DU specified
MOVEI M,NXTPPN ; In which case, use NXTPPN
PUSHJ P,(M) ; Call one or the other
JRST SW.D0A ; All done, try next STR
TXZ F,F.NULL ; Flag says first time through
SWT.D1: PUSHJ P,NXTFIL ; Get next file from directory
JRST SWT.D2 ; At end of directory
TXNN SW,CH.T ; /DT??
JRST SWT.D5 ; No, no need to LOOKUP file
PUSHJ P,USRLOK ; LOOKUP file to get dates
JRST SWT.D1 ; Ignore if cant
PUSHJ P,FILDAT ; Get T3 = creation date
CAML T3,BEFORE ; Created since input creation time
JRST SWT.D1 ; Yes. Ignore it
PUSHJ P,FILACD ; Get T3 = access date
CAML T3,AFTER ; Last access date before then?
JRST SWT.D1 ; Yes. Ignore it
SWT.D5: TXNE SW,CH.N ; Deleting null directories?
JRST SWT.D0 ; Yes. This ones not null, forget it.
TXOE F,F.NULL ; First file?
JRST SWT.D3 ; No
PUSHJ P,CHKPPN ; He important guy??
JRST SWT.D0 ; Hell yes!
TXNE SW,CH.U ; /DU??
JRST SW.D3A ; Yes. Dont print every file
MOVEI M,[ASCIZ/
From /]
PUSHJ P,MSGTTY ; /D gets a header for each user
MOVE M,USRSTR ; Get structure name
PUSHJ P,PR6BIT ; Print it
PUSHJ P,COLON ; Followed by a colon
PUSHJ P,UFDPNT ; Print directory path
PUSHJ P,CRLF
; Here when a file found that matches the command string
SWT.D3: TXNN SW,CH.U ; /DU doesn't have ask mode
TXNN SW,CH.A ; Ask mode?
JRST SW.D3A ; No
TXO F,F.NOTB ; Print name with dot, not tab
PUSHJ P,FILPNT ; Print the filename
MOVEI M,ZERO ; No message for OPER
PUSHJ P,OPER ; Ask him
JRST SWT.D1 ; Doesn't want to delete this one
SW.D3A: TXNE SW,CH.B ; Only bad files?
TXOA F,F.DBAD ; Yes. Set bit to tell DELFIL
TXZ F,F.DBAD
MOVEI T,DELFIL ; Get set to delete the file
TXNE SW,CH.R ; Super delete?
MOVEI T,RIPFIL ; Yes.
PUSHJ P,(T) ; Go delete this one.
JRST SWT.D1 ; Ignore it if cant
TXNE SW,CH.U
JRST SWT.D1
TTYON ; Print name of all files deleted
TXO F,F.NOTB ; Use dot instead of tab
PUSHJ P,FILPNT
PUSHJ P,TAB
MOVSI M,(SIXBIT .<>.)
SKIPGE UBLKCT ; Get number of blocks deleted
PUSHJ P,PR6BIT ; Print <> if dont know
SKIPL N,UBLKCT
PUSHJ P,DECPRT ; Otherwise, tell him
PUSHJ P,CRLF
JRST SWT.D1
; Here if no more files in current directory
SWT.D2: TXNN SW,<CH.U!CH.N>
JRST SWT.D0 ; Done if plain /D
PUSHJ P,CHKPPN ; Important guy again?
JRST SWT.D0 ; Yup.
PUSHJ P,DELUFD ; Otherwize, delete the UFD now.
JRST SWT.D0
TTYON
MOVE M,USRSTR ; Get structure name
PUSHJ P,PR6BIT ; Print it
PUSHJ P,COLON ; followed by a colon
PUSHJ P,UFDPNT ; and finally the directory
PUSHJ P,CRLF
JRST SWT.D0
SUBTTL /E -- Edit disk blocks
REPEAT LOGIC,<
/E options include C,L,N,R,S,W,T,A,6.
/ER - Read given block into core
/EW - Write core block out to given disk block
/EC - Change core copy of block
/ET - Type contents of given word in octal
/ETA or /ET7 - Type contents of given word in ASCII
/ET6- " " in SIXBIT code
/ETU- " " as a universal date/time word
/ERS OR
/EWS- S option OR'ed with W or R will read or write same STR
and same block number as the last /E operation.
/ETL, /ETS, /ETN -
L, S, or N option or'ed with the T option with no word
specified will type the last, same, or next word
(relative to the previous word).
>
SWT.E: SKIPE T,EBUF ; EBUF is ptr to data block
JRST SWT.E1 ; Have pointer, will process
TXNN SW,CH.R ; No ptr, better be reading
JRST ERR005 ; Write or edit what??
MOVEI T,BLKSIZ ; Need this much core for data block
PUSHJ P,CORGRB ; Grab enough core for our use
MOVEM T,EBUF ; and remember where it is.
; Here to set up things for output or input
SWT.E1: TXNN SW,<CH.W!CH.R> ; Skip if reading or writing
JRST SWT.E3 ; Go edit or type words
SKIPE USRSTR ; Did he specify a STR?
JRST SWT.E6 ; Yes. Use it.
TXNN SW,CH.S ; No. 'S' option?
JRST NOSTR1 ; No. Must specify a STR then.
MOV ESTR,USRSTR ; With S option, fake a STR:
PUSHJ P,DEVTYP ; in the command string by doing
JUMPL T1,NOSTR ; the same thing scanner does
MOVEM T1,TTYTYP ; at SWIT:
MOVEM U,TTYDDB
MOV EBLK,BARG1 ; Fake block number too
; Here to read or write the block specified by BARG1 on the structure
; specified by USRSTR.
SWT.E6: PUSHJ P,NXTSTR ; Go init device
JRST NOSTR ; Can't?
JFCL ; Don't care if MFD or not
MOVE T,USRSTR ; Get STR name
MOVE T1,BARG1 ; and block number
MOVEI P1,STRRED ; Assume reading
TXNN SW,CH.W ; Writing?
JRST SWT.E4 ; No.
MOVEI P1,STRWRT ; Yes. Set for write.
CAME T,ESTR ; Same STR as before?
PUSHJ P,ASK001 ; No. Sure?
CAME T1,EBLK ; Same block?
PUSHJ P,ASK002 ; Check again.
SWT.E4: MOVEM T1,EBLK ; Remember last block
MOVEM T,ESTR ; and last device
HRLZI T,-BLKSIZ
HRR T,EBUF ; T=IOWD to buffer for block
SOJ T,
MOVEI P4,DSK ; Read on DSK channel
TTYON ; Enable TTY output
PUSHJ P,(P1) ; Go do it now.
JFCL ; Error. Forget it.
JRST RIPDON ; and thats it..
; Here to edit the block (/EC)
SWT.E3: TXNN SW,CH.C ; Editing?
JRST SWT.E7 ; No, must be typing
MOVE N,BARG2 ; Get new contents of word
SKIPL T,BARG1 ; Make sure word to chage is in range
CAIL T,BLKSIZ ; i.e. (0-177)
JRST ERR006 ; No, tell him how big block is
MOVEM T,EWORD ; Save as last word accessed
ADD T,EBUF ; Make T pointer to word in core
MOVEM N,(T) ; Change the word
JRST RIPDON ; That's it
; Here to type the a word in the block in one of our several modes
SWT.E7: TXNN SW,CH.T ; Must be typing or bad option
JRST ERR001 ; No. Bad option
TTYON ; Enable TTY output
PUSHJ P,CRLF ; To make it look good
SKIPE GOTWRD ; Word specified in command?
JRST SWT.E8 ; Yes, ignore /ETL, /ETS, and /ETN
MOVE T,EWORD ; Pick up last word used
TXNE SW,CH.L ; Last word wanted?
MOVEI T,-1(T) ; Yes, decrement the pointer
TXNE SW,CH.N ; How about next one?
MOVEI T,1(T) ; Then add one
MOVEM T,BARG1 ; Save as word to use
SWT.E8: SKIPL T,BARG1 ; T=which word of block to change
CAIL T,BLKSIZ ; which must be 0-177
JRST ERR006 ; Ill block arg
MOVEM T,EWORD ; Make this last word used
ADD T,EBUF ; Make T a real core pointer
PUSH P,T ; Save address for later
MOVE N,BARG1 ; Get block index back
MOVEI T,6 ; Field width to use
PUSHJ P,OCTZRO ; Print index as an octal number
PUSHJ P,SLASH ; Followed by a slash
PUSHJ P,TAB ; Followed by a TAB
POP P,T ; restore T
MOVE N,(T) ; Get old contents
TXNN SW,CH.A!CH.7 ; Type in ASCII?
JRST SWT.ES ; No.
SETZ N1, ; Yes. Make ASCIZ
MOVEI M,N ; M=Address of word
PUSHJ P,MSGTTY ; Type it
JRST SWT.E5 ; Done.
SWT.ES: TXNN SW,CH.6 ; SIXBIT?
JRST SWT.EU ; No. Try universal date/time
PUSHJ P,NPR6BT ; Yes. Print it in SIXBIT.
JRST SWT.E5
SWT.EU: TXNN SW,CH.U ; universal date/time?
JRST SWT.EO ; No, just octal
PUSHJ P,DATTIM ; Print it
JRST SWT.E5 ; Go finish up
SWT.EO: PUSHJ P,OCTL12 ; Type contents in octal
SWT.E5: PUSHJ P,CRLF ; End line with CRLF
SKIPN T,BARG3 ; Have a non-zero increment?
MOVEI T,1 ; No, use default of 1
ADDB T,BARG1 ; Bump index by increment
CAMG T,BARG2 ; Larger than final value?
JRST SWT.E8 ; No, loop for more
JRST RIPDON
SUBTTL /F -- Find files
; Find and print relative and logical block numbers of
; the RIB of a file.
;
; /F options include:
;
; /F - Find files. Try directory search first then structure
; search
; /FE - Find existing files, i.e., only do directory search
; /FD - Find deleted files, i.e., only do structure search
; /F2 - When OR'ed with /FD option, enables 2nd RIB searching
SWT.F: TXNE SW,CH.D ; D switch specified?
JRST SWT.F8 ; Yes, don't do lookups
TXZ F,F.MULT ; Clear files found flag
SWT.F1: PUSHJ P,NXTSTR ; Get next str
JRST SWT.F4 ; None left, do search
JRST SWT.F1 ;
SWT.F2: PUSHJ P,NXTPPN ; Get next PPN
JRST SWT.F1 ; None left
SWT.F3: PUSHJ P,NXTFIL ; Get next file
JRST SWT.F2 ; None left
TXOE F,F.MULT ; Seen any before?
JRST SWT.F7 ; Yep, don't print heading again
MOVEI M,[ASCIZ/Files found in directories:
/]
PUSHJ P,MSG ; Print it
SWT.F7: MOVE T,USRCFP ; Get CFP for this file
PUSHJ P,CFP2BK ; Convert to blocks
PUSHJ P,PRTFND ; Print the infor
JRST SWT.F3 ; and get next one
;
; Here to do a search on the file structure looking for
; the RIBs of a file that matches the specifications.
;
SWT.F4: TXZE F,F.MULT ; See any files in directories?
JRST SWT.F8 ; Yep
MOVEI M,[ASCIZ/% No files found in directories
/]
PUSHJ P,MSG ;
SWT.F8: TXNE SW,CH.E ; E switch seen?
JRST RIPDON ; Yep, we're done
SETOM STRFLG ; To reset NXTSTR
SWT.F5: PUSHJ P,NXTSTR ; Get next str
JRST SWT.FD ; None left
JFCL ; No MFD is OK
SETZM SATFLG ; Search all blocks
MOVN T4,STRBPC ; Get negative blocks/cluster
TXNE SW,CH.2 ; Unless second RIB recovery
MOVNI T4,1 ; In which case use -1
MOVEM T4,SETBLK ; This is starting block
HLRZ U,UNIDDB ; Setup U for SEARCH
SWT.F6: MOVEI P1,RIBCOD ; Keyword
MOVEI P2,CODRIB ; Contents of keyword
MOVE T4,STRBPC ; Search every cluster
TXNE SW,CH.2 ; Unless second RIB recovery
MOVEI T4,1 ; is enabled
PUSHJ P,SEARCH ; Go find a block
JRST SWT.F5 ; None left on this str
MOVE T1,SETBLK ;
TXO F,F.RIB ; Tell RIBCHK not to check names
PUSHJ P,RIBCHK ; Is it a valid RIB?
JRST SWT.F6 ; Nope, ignore it
PUSHJ P,CHKMAT ; Is it ours?
JRST SWT.F6 ; Nope
;;[77] At SWT.F6 + 14 1/2
MOVEM T,USRNAM ;[77] Correct name in case of wildcards
MOVEM T1,USREXT ;[77] Correct extension in case of wildcards
MOV BUF+RIBPPN,USRPTH+.PTPPN;[77] Correct PPN in case of wildcards
TXOE F,F.MULT ; Seen any files yet?
JRST SWT.F9 ; Yep
MOVEI M,[ASCIZ/Files found via structure search:
/]
PUSHJ P,MSG ;
SWT.F9: MOVE T1,SETBLK ; Block in unit
MOVE T,HOMLUN(U) ; Get logical unit number
IMUL T,STRBPU ; Times blocks/unit
ADD T,T1 ; Give block in str
PUSHJ P,PRTFND ; Print info
JRST SWT.F6 ; and loop for next one
SWT.FD: TXNE F,F.MULT ; See any files on search?
JRST RIPDON ; Yep
MOVEI M,[ASCIZ/% No files found via structure search
/]
PUSHJ P,MSG ;
JRST RIPDON ;
SUBTTL /H -- Type the RIPOFF help file
SWT.H: MOVEI P1,MAXHLP-1
SWT.H1: MOVEI T,.IODMP ; Get it in dump mode
MOVE T1,HLPTAB(P1) ; on one of several devices
SETZ T2,
OPEN STR,T
JRST SWT.H3
MOVE T,['RIPOFF']
MOVSI T1,'HLP'
SETZB T2,T3
LOOKUP STR,T
JRST SWT.H3
SWT.H2: IN STR,IOW
SKIPA M,[BUF]
JRST RIPDON
PUSHJ P,MSGTTY
JRST SWT.H2
SWT.H3: SOJGE P1,SWT.H1 ; Try another device
JRST ERR014 ; or give error message
HLPTAB: SIXBIT .DSK.
SIXBIT .SYS.
SIXBIT .HLP.
MAXHLP==.-HLPTAB
SUBTTL /I -- Initialize UFD's from scratch
REPEAT LOGIC,<
SEE DOCUMENTION FOR OPERATION OF THIS SWITCH.
ONE PASS IS MADE OVER THE ENTIRE FILE STRUCTURE. THE
FIRST BLOCK OF EACH CLUSTER IS READ AND TESTED AS A RIB. ALL RIBS
FOUND MATCHING THE COMMAND STRING SPECIFICATIONS AS TO FILE NAMES AND
PPNS ARE REMEMBERED IN A CORE LINKED LIST. FOR EVERY PPN IS A
TWO WORD BLOCK WHICH CONTAINS:
WORD 0: ADDRESS NEXT PPN BLOCK ,, ADDRESS FIRST FILE BLOCK
FOR THIS PPN
WORD 1: PROJECT ,, PROGRAMMER NUMBER
FOR EACH FILE IS KEPT A FOUR WORD BLOCK:
WORD 0: FILE EXTENSION ,, ADDRESS NEXT FILE BLOCK THIS PPN
WORD 1: FILE NAME
WORD 2: CREATION DATE ,, CREATION TIME IN UNIVERSAL STANDARD
(12 OR 15 BIT FORMATS CONVERTED TO UNIVERSAL STANDARD)
WORD 3: BYTE (4) LOGICAL UNIT , BYTE (32) LOGICAL BLOCK NUMBER
WITHIN UNIT OF FIRST RIB
IF A FILE IS FOUND DUPLICATED ON THE STR (OLDER VERSIONS), THIS
LIST IS CHECKED AND TESTED AGAINST THE CREATION DATE
AND TIME. ONLY THE LATEST VERSION IS REMEMBERED.
WHEN THE ENTIRE STR IS SEARCHED, THE TABLES ARE RESCANNED,
AND THE RIB IS RE-READ. THE RIB IS OUTPUT TO A SCRATCH DEVICE (MAGTAPE,
DECTAPE, OR SCRATCH PACK). THEN THE ENTIRE FILE IS READ AND OUTPUT
TO THE SCRATCH STORAGE. ALL FILES ARE THUS TRANSMITTED TO
THE AUXILLIARY DEVICE, ALONG WITH THEIR FIRST RIBS. THE SCRATCH
AREA IS WRITTEN AS ONE CONTIGIOUS FILE. NOTE: IF A SCRATCH PACK IS
USED, WRITING WILL BEGIN ON BLOCK ONE AND CONTINUE ON SUCCESSIVE
BLOCKS. THUS, THE PACK WILL BE DESTROYED FOR USE AS A FILE STRUCTURE,
AND WILL NEED TO BE REFRESHED AFTER USE. WHEN ALL FILES ARE TRANSMITTED
TO SCRATCH, THE DEVICE MAY BE REWOUND, AND THE FILES RESTORED TO THE
ORIGINAL STR AT LEISURE.
THE COMMAND STRING *DEV:_STR:FILESPECS/IS PERFORMS THE SAVE ONLY.
LATER, A *DEV:_STR:/IR RESTORES IT FROM THE DEV TO THE STR (I KNOW THE
COMMAND STRING IS BACKWARD, SORRY PIP USERS...). /I WITH NO
OPTIONS IMPLIES BOTH, EXCEPT IN EXEC MODE OPERATION, IN WHICH CASE
ONLY A /IS IS DONE. THE RESTORE MUST BE DONE UNDER THE CONTROL
OF THE TIMESHARING MONITOR.
>
REPEAT LOGIC,<
/I OPTIONS:
R - RESTORE ONLY
S - SAVE ONLY
D - SAVE DELETED FILES ONLY (IGNORE BLOCKS MARKED IN SAT)
E - SAVE EXISTING FILES ONLY (IGNORE BLOCKS FREE FROM SAT)
A - SAME AS /IDE, SAVE ALL FILES, CHECK ALL BLOCKS.
2 - READ EVERY BLOCK EVEN IF NOT FIRST IN A CLUSTER
(ALLOWS RECOVERY FROM 2ND RIBS)
T - TIME OPTIONS. ASKS BEFORE AND AFTER. ONLY FINDS FILES BETWEEN GIVEN DATES AND TIMES
O - OVERWRITTEN DATA ALLOWED (IF THE FILE HAS BEEN PARTIALLY OVERWRITTEN,
NORMALLY, RIPOFF WILL DISCONTINUE THE RESTORE OF THAT FILE
WHERE THO OVERWRITTEN DATA BEGINS. THERE IS NO (EASY) WAY
TO TELL WHERE THE OVERWRITTEN DATA ENDS HOWEVER. IT IS
POSSIBLE, FOR INSTANCE, TO HAVE A LARGE FILE (THAT WAS DELETED),
AND HAVE A SMALL 1 BLOCK FILE OVERWRITE ONE LOUSY CLUSTER RIGHT
IN THE MIDDLE. RESULTS: YOU GET ONLY HALF YOUR FILE BACK,
BECAUSE RIPOFF MUST ASSUME THE ENTIRE REST OF THE FILE IS
OVERWRITTEN (POSSIBLY). HOWEVER, WITH THE O OPTION, RIPOFF
WILL RESTORE THE ENTIRE FILE, THAT IS ALL THOSE BLOCKS WHICH
USED TO BE IN THE FILE. OF COURSE, SOME OF THESE BLOCKS
WILL CONTAIN SOMEONE ELSES DATA. THIS IS OF COURSE, A
SECURITY VIOLATION, AND SHOULD BE USED WITH CARE. HOWEVER,
IN AN EMERGENCY SITUATION, IT IS WORTH HAVING AROUND. IT SHOULD
NOT BE USED UNTIL A /I HAS BEEN TRYED WITHOUT IT
AND COME UP WITH ONLY A PARTIAL RESTORE.
F - FAILSAFE. RIB SEARCH LOGIC NOT USED. SIMPLY READS FILES
FROM DISK, WRITES TO AUX, AND BACK FOR RESTORE.
D,E,A AND 2 OPTIONS ILLEGAL WITH F. S AND R CANNOT
BOTH BE USED AT THE SAME TIME.
X - ADDED TO RESTORE OPTION OR PRINT OPTION, XLISTS OUTPUT OF
FILE NAMES AND SIZES. ONLY UFD'S RESTORED ARE PRINTED.
P - PRINT ONLY. READS TAPE AND PRODUCES DIRECTORY.
>
SWT.I: TXNN SW,<CH.S!CH.R!CH.P> ;IF NO SWITCH OPTIONS,
TXO SW,<CH.S!CH.R> ;ASSUME ALL OPTIONS.
TXNE SW,<CH.2!CH.D!CH.E!CH.A>
TXNN SW,CH.F ;/IF CANT CO-EXIST WITH ABOVE
SKIPA
PJRST ERR011 ;TELL HIM HE IS MISTAKEN.
TXNE SW,CH.R ;HE WANT A RESTORE?
TXZ SW,CH.P ;YES. WE PRINT ANYWAY, SO KEEP ZERO.
PUSHJ P,NXTSTR ;GET A STR INIT'ED
JRST RIPDON
JRST .-2
TXNN SW,CH.S ;WANT TO SAVE?
JRST SWT.IR ;NO. JUST A RESTORE NOW.
PUSHJ P,AUXINI ;MAKE SURE OUTPUT DEVICE IS THERE
JRST ERR003 ;ELSE ALL IS LOST WHEN ITS TOO LATE.
PUSHJ P,AUXENT ;ENTER SCRATCH FILE
JRST ERR004 ;JUST TO MAKE SURE...
SETZM LHEAD ;THE LIST HEADERS
SETZM LHEAD+1
MOV .JBFF,.SVFF ;TO REDUCE CORE LATER
TXNN SW,CH.T ;TIME OPTION??
JRST SW.I30 ;NO. SKIP THIS
MOVEI M,[ASCIZ/
After:/]
PUSHJ P,MSGTTY ;ASK QUESTION
OUTPUT CMD, ;REALLY ASK IT!
PUSHJ P,GTDATE ;LET HIM ANSWER IT
MOVEM T3,AFTER ;AND STORE HIS ANSWER..
MOVEI M,[ASCIZ/
Before:/]
PUSHJ P,MSGTTY
OUTPUT CMD,
PUSHJ P,GTDATE ;LET HIM ANSWER SECOND QUESTION
MOVEM T3,BEFORE ;AND STORE
TLNE T3,-1 ;DID HE GIVE ZERO DATE?
JRST SW.I30 ;NO. AOK
MSTIME T1, ;YES. HE WANTS HERE AND NOW
DATE T2,
PUSHJ P,.CNVDT ;GET T3=NOW
HRR T3,BEFORE ;T3=NOW DATE ,, HIS TIME
TRNN T3,-1 ;DID HE GIVE ZERO TIME TOO???
AOBJP T3,.+1 ;YES. FIX T3 = TOMORROW, 1 MS. PAST MIDNIGHT
MOVEM T3,BEFORE ;STORE.
SW.I30: TXNE SW,CH.F ;FAILSAFE?
JRST FAILSA ;YES. GO DO IT NOW.
SETOB T,SATFLG ;IF HE SAYS NOTHING, ASSUME /ID
TXNE SW,CH.E ;SAVE ONLY EXISTING FILES
HRRZM T,SATFLG ;YES. SATFLG .GT. 0, LOOK ONLY IN SATS.
TXNE SW,CH.D ;SAVE ONLY DELETED FILES?
SETOM SATFLG ;YES. SATFLG .LT. 0, LOOK ONLY OUT OF SAT
TXNE SW,CH.A ;SAVE ALL?
SETZM SATFLG ;YES.
SKIPE SATFLG ;IF ALL, DONT NEED TO READ SATS
PUSHJ P,RDSAT ;READ THEM
SETZM SATFLG ;CANT, SO DONT
MOVN T4,STRBPC ; Get negative blocks/cluster
TXNE CH,CH.2 ; Unless second RIB recovery
MOVNI T4,1 ; In which case use -1
MOVEM T4,SETBLK ; This is starting block
HLRZ U,UNIDDB ;ON LOGICAL UNIT ZERO.
SWT.I1: MOVEI P1,RIBCOD ;LOOK AT WORD 176 OF BLOCK
MOVEI P2,CODRIB ;TO SEE IF IT HAS A 777777 IN IT
MOVE T4,STRBPC ;READ ONLY ONE BLOCK/CLUSTER
TXNE CH,CH.2 ;UNLESS HE SAYS OTHERWIZE.
MOVEI T4,1
PUSHJ P,SEARCH ;GO LOOK FOR IT
JRST SWT.I2 ;ALL DONE!
MOVE T1,SETBLK
TXO F,F.RIB
PUSHJ P,RIBCHK ;SEE IF ITS REALLY A RIB
JRST SWT.I1 ;NOT SO IGNORE IT
;GOT A RIB. SEE IF ITS ONE OF OURS..
PUSHJ P,CHKMAT ;SEE IF WE MATCH.
JRST SWT.I1 ;NO. FORGET THIS FILE THEN.
JRST CHKMA1 ;SKIP OVER WHAT USED TO BE INLINE CODE
CHKMAT: TXNE F,S.PROJ ;CHECKING PROJECTS?
JRST .+5 ;NO. *
HLLZ T,BUF+RIBPPN
HLLZ T4,USRPTH+.PTPPN ;
CAME T,T4 ;MATCH?
POPJ P, ;NO. FORGET FILE
TXNE F,S.PROG ;CHECKING PROGRAMMER NUMBERS?
JRST .+5 ;NOPE. *
HRRZ T,BUF+RIBPPN
HRRZ T4,USRPTH+.PTPPN ;
CAIE T,(T4) ;MATCH?
POPJ P, ;NOPE.
MOVE T,BUF+RIBNAM
TXNN F,S.NAM ;CHECKING NAMES?
CAMN T,USRNAM ;YES. MATCH?
SKIPA ;YES. GOT IT.
POPJ P, ;NO. FORGET
HLLZ T1,BUF+RIBEXT
HLLZS USREXT
TXNN F,S.EXT ;CHECKING EXTENSIONS?
CAMN T1,USREXT ;YES. MATCH?
JRST CPOPJ1 ;YEP!
POPJ P, ;NO. NO MATCH AFTER ALL.
CHKMA1:
;OK. I GOT A GOOD RIB HERE. LETS PUT HIM IN THE TABLES.
MOVE T2,BUF+RIBSTS ;LOOK AT FILE STATUS
TXNE T2,RIPNFS ;NO BACKUP BIT?
JRST SWT.I1 ;YES. IGNORE IT. (CRASH.SAV,SAT.SYS, ETC)
MOVE T2,BUF+RIBPPN
CAMN T2,MFDPPN
JRST SWT.I1 ;CANT SAVE MFDPPN!
MOVEI P1,LHEAD
PUSHJ P,FILDAT ;GET FILES CREATION DATE,,TIME IN T3
TXNN SW,CH.T ;TIME OPTION?
JRST SWT.I4 ;NO. CONTINUE.
CAML T3,AFTER ;BEFORE AFTER??
CAML T3,BEFORE ;AFTER BEFORE?
JRST SWT.I1 ;YES TO EITHER. FORGET THIS FILE
SWT.I4: HLRZ P1,(P1) ;P1=NEXT UFD BLOCK
JUMPE P1,SWT.I3 ;HIT END. MUST BE A NEW UFD
CAME T2,1(P1) ;SEEN HIM BEFORE?
JRST SWT.I4 ;NO. KEEP LOOKING
;HERE IF WE FOUND HIS UFD, NOW SEE IF THE FILE ALREADY
;BEEN SEEN TOO. P1=ADR OF PPN BLOCK.
MOVE P2,P1 ;REMEMBER PPN BLOCK IN P2
SWT.I5: HRRZ P1,(P1) ;P1:=ADR NEXT FILE BLOCK
JUMPE P1,SWT.I6 ;MUST BE A NEW FILE NAME
CAME T,1(P1) ;NAMES MATCH?
JRST SWT.I5 ;KEEP LOOKING.
HLLZ T4,(P1)
CAME T1,T4 ;EXTENSIONS MATCH?
JRST SWT.I5 ;KEEP LOOKING.
;HERE WHEN FILE OCCURED PREVIOUSLY
CAMG T3,2(P1) ;CREATED LATER THAN FIRST ONE?
JRST SWT.I1 ;NO. FORGET FILE COMPLETELY
SWT.I9: ;THIS IS A LATER COPY OF THE FILE.
MOVEM T3,2(P1) ;STORE NEW DATE,,TIME WORD
MOVE T,SETBLK ;AND NEW RIB ADDRESS WORD
MOVE T1,HOMLUN(U)
DPB T1,[POINT 4,T,3]
MOVEM T,3(P1)
JRST SWT.I1 ;AND GO BACK FOR MORE RIBS NOW.
;HERE IF A NEW UFD FOUND. CREATE HIM AN ENTRY
SWT.I3: MOVEI T,2 ;WE WILL INSERT HIS PPN BLOCK
PUSHJ P,CORGRB ;INTO THE VERY BEGINNING OF THE LIST
;SINCE THAT IS THE EASIEST WAY...
HLRZ T1,LHEAD ;T1=INITIAL PTR TO FIRST PPN
HRLZM T1,(T) ;POINT US THERE INSTEAD
HRLM T,LHEAD ;POINT INITIAL PTR TO US INSTEAD
MOVEM T2,1(T) ;REMEMBER PPN IN CORE
MOVE P2,T ;REMEMBER PPN ADDRESS IN P2
PUSHJ P,FILDAT ;GET UNIVERSAL DATE,,TIME INTO T3
;AND FALL INTO .I6 TO CREAT FILE BLOCK ENTRY
;HERE WHEN NEW FILE NAME OCCURS. CREATE AN ENTRY FOR HIM.
SWT.I6: MOVEI T,4
PUSHJ P,CORGRB
HRRZ T1,(P2) ;T1=1ST FILE POINTED TO BY PPN
HRRM T1,(T) ;POINT ME THERE INSTEAD
HRRM T,(P2) ;POINT PPN TO ME INSTEAD
MOVE P1,T ;SET P1=PTR TO FILE BLOCK TOO.
MOV BUF+RIBNAM,1(P1) ;PUT IN MY NAME
HLLZ T1,BUF+RIBEXT
HLLM T1,0(P1) ;AND MY EXTENSION
JRST SWT.I9 ;CONTINUE OVER THERE.
;HERE WHEN ALL FILES FOUND. NOW WRITE THEM TO SCRATCH AREA.
SWT.I2: TXO F,F.IO ;WE WILL BE WRITING ON SCRATCH.
PUSHJ P,AUXALC ;NOW ALLOCATE AUX BUFFERS.
MOVEI P1,LHEAD
SW.I0: HLRZ P1,(P1) ;MOVE UP TO NEXT PPN
JUMPE P1,SW.I4 ;UNTIL DONE
HRRZ P2,(P1) ;P2=ADR OF FIRST FILE BLOCK
SW.I3: JUMPE P2,SW.I0 ;IF NO MORE FILES, TRY NEXT PPN
MOVE T,1(P2) ;FILE NAME
HLLZ T1,0(P2) ;EXTENSION
LDB T2,[POINT 4,3(P2),3] ;LOGICAL UNIT # OF RIB
IMUL T2,STRBPU ;T2=BLOCK NUMBER OF FIRST BLOCK ON UNIT
LDB T3,[POINT 32,3(P2),35]
ADD T2,T3 ;AND BLOCK ON UNIT TO IT, AND YOU GET
MOVNS T2 ;-BLOCK IN STR OF FIRST RIB
MOVE T3,1(P1) ;T3=PPN
MOVEI P4,DSK
PUSH P,P1
PUSH P,P2
PUSHJ P,LOOKP ;LOOKUP FILE FILE NOW.
JRST SW.I1 ;WHAT?????
MOVE P1,IOW
MOVEM P1,XIOWD+DSK
PUSHJ P,AUXOUT ;WRITE IT TO SCRATCH
JFCL ;HMM.
JFCL ;CANT HAPPEN EITHER!
POP P,P2
POP P,P1
SW.I9: PUSHJ P,DMPIN ;READ A BLOCK OF THE FILE
MOVE T,DSK+IOSTS
TXNE T,IO.EOF ;EOF??
JRST SW.I2 ;YES. DONE
TXO F,F.RIB ;NO NAME CHECK
PUSHJ P,RIBCK0 ;READING A RIB?
JRST SW.I14 ;NO. AOK
;YES. FILE HAS BEEN OVERWRITTEN.
TXNE SW,CH.O ;OVERWRITING ALLOWED?
JRST SW.I9 ;YES. CONTINUE READING FILE, IGNORE THIS RIB
JRST SW.I2 ;NO. FILE IS DONE NOW.
SW.I14: PUSH P,P1
MOVE P1,IOW
PUSHJ P,AUXOUT ;NO. WRITE BLOCK TO SCRATCH
JFCL
JFCL
POP P,P1
JRST SW.I9
SW.I2: HRRZ P2,(P2) ;DONE. GET NEXT FILE NAME
JRST SW.I3 ;AND CONTINUE
;HERE ON LOOKUP FAILURE. (WHICH IS REALLY IMPOSSIBLE, SINCE WE
;ALREADY VERIFIED RIB..)
SW.I1: POP P,P2
POP P,P1
HRRZ P2,(P2) ;GET NEXT FILE NAME
JRST SW.I3 ;SIMPLY IGNORE THE FILE.
;HERE TO DO SIMPLE SAVES. NO LOGIC REQUIRED. JUST READ
;ALREAD EXISTING FILES AND PIP THEM TO AUX.
FAILSA: TXNE SW,CH.R ;IF SAYS R,
TXNN SW,CH.S ;THAN CANT SAY S
SKIPA
JRST ERR011 ;/IFSR. ILLEGAL
TXNE SW,CH.R ;SAY RESTORE?
JRST SWT.IR ;YES. DO IT THEN.
TXO F,F.IO
PUSHJ P,AUXALC ;GET SOME BUFFERS
FAILS0: PUSHJ P,NXTPPN
JRST SW.I4 ;DONE WHEN MFD DONE.
MOVE T2,USRPTH+.PTPPN ;
CAMN T2,MFDPPN
JRST FAILS0 ;CANT SAVE MFD.
FAILS1: PUSHJ P,NXTFIL ;GET NEXT FILE IN UFD
JRST FAILS0
PUSHJ P,USRLOK ;GET ITS RIB
JRST FAILS1
MOVE T2,BUF+RIBSTS
TXNE T2,RIPNFS
JRST FAILS1 ;DONT SAVE CRASH.SAV, ETC
TXNN SW,CH.T ;WANT TIME OPTION?
JRST FAILS2 ;NO. FORGET CHECK
PUSHJ P,FILDAT ;YES. GET FILES CREATION DATE
CAML T3,AFTER ;BEFORE AFTER?
CAML T3,BEFORE ;AFTER BEFORE?
JRST FAILS1 ;YES TO EITHER. IGNORE THIS FILE
FAILS2: MOVE P1,IOW
MOVEM P1,XIOWD+DSK
MOVEI P4,DSK
PUSHJ P,AUXOUT ;WRITE SOME,
JFCL
JFCL
PUSHJ P,DMPIN ;THEN READ SOME.
MOVE T,DSK+IOSTS
TXNN T,IO.EOF ;UNTIL EOF ON DISK
JRST FAILS2
JRST FAILS1 ;IN WHICH CASE, GET NEXT FILE.
;HERE WHEN SAVE COMPLETED. NOW RESTORE IF POSSIBLE
SW.I4: PUSHJ P,AUXEOF ;WRITE EOF
PUSHJ P,AUXRLS ;RELEASE DEVICE
PUSHJ P,ZCORE ;REDUCE CORE BACK TO MINIMUM
SWT.IR: TXNN SW,CH.R!CH.P ;WANT TO READ TAPE AGAIN NOW?
JRST RIPDON ;NO. FORGET IT.
PUSHJ P,AUXINI ;INITIALIZE SCRATCH AGAIN
JRST ERR003
PUSHJ P,AUXLUK ;LOOKUP FILE JUST WRITTEN
JRST ERR007
TXZ F,F.IO ;WE WILL BE READING ONLY
MOV .JBFF,.SVFF ;SAVE TO REDUCE LATER.
PUSHJ P,AUXALC ;NEED TO REALLOCATE BUFFERS.
TXNE SW,CH.P ;PRINTING ONLY?
JRST SW.IR1 ;YES. DONT BOTHER DISKS
MOVEI T,14 ;AND SET UP OUR OWN STR TOO.
MOVE T1,USRSTR ;I AM DOING THIS INSTEAD OF CALLING
MOVSI T2,WH.STR ;INIDSK (WHICH INITS MODE 17) SO THAT
OPEN STR,T ;OUTPUT CANN BE BUFFERED. I BELIEVE
JRST NOSTR ;THAT FASTER /IR OPERATION IS MORE
MOVE T,.JBREL ;IMPORTANT THAN EXEC MODE COMPATIBILITY
OUTBUF STR,20 ;SET UP BUFFERS FOR THE OUTPUT
CAME T,.JBREL ;INCREASE A K?
PUSHJ P,PNTCOR ;YES. TELL HIM SO.
SW.IR1: TXZ F,F.FAIL!F.RIP ;AOK SO FAR.
TXNE SW,CH.P
TXO F,F.FAIL ;JUST IN CASE..
SETOM PASS
SW.I5: MOVE P1,IOW
PUSHJ P,AUXIN ;READ A BLOCK FROM SCRATCH
JRST .-2 ;JUST BETTER NOT HAPPEN!
JRST SW.I10 ;EOF. ALL DONE!!!!!
TXO F,F.RIB
PUSHJ P,RIBCK0 ;RIB?
JRST SW.I6 ;NO. STILL READING DATA FILE
SW.I13: TXZN F,F.RIP ;WAS A RESTORE IN PROGRESS?
JRST SW.I11 ;NO.
TXNN SW,CH.P
CLOSE STR, ;YES. CLEAN UP ENDS OF LAST FILE
TXNE SW,CH.X
JRST SW.I12+1
TTYON
PUSHJ P,TAB
MOVE N,UBLKCT ;TELL HIM HOW MANY BLOCKS WE FOUND
PUSHJ P,DECPRT
MOVE N,UBLKCT ;AND ORIGINAL LENGTH
CAMN N,SETBLK ;IF DIFFERENT.
JRST SW.I12
MOVEI M,[ASCIZ/ Original had:/]
PUSHJ P,MSGTTY
MOVE N,SETBLK
PUSHJ P,DECPRT
SW.I12: PUSHJ P,CRLF
TXNN F,S.PROG!S.PROJ!S.NAM!S.EXT ;IF NO STARS, THEN WE ARE
JRST RIPDN1 ;AFTER JUST ONE FILE!
;NOW WE HAVE FINISHED OFF THE LAST FILE. START PROCESSING THE
;NEXT ONE ON THE TAPE.
SW.I11: SKIPN BUF+RIBNAM ;DO WE HAVE A NEXT ONE ON TAPE?
JRST RIPDN1 ;NO. EOF (SEE SW.I10)
PUSHJ P,CHKMAT ;YES. ONE OF OUR BOYS?
JRST NORESTORE ;NO. SKIP HIM.
MOV BUF+RIBNAM,USRNAM
HLLZ T,BUF+RIBEXT
HLLZM T,USREXT
MOVE T,BUF+RIBPPN ;GET HIS PPN
AOSE PASS ;IF NOT FIRST FILE,
CAME T,USRPTH+.PTPPN ; SAME AS LAST ONE?
TXOA F,F.TMP ;NO. OK
TXZ F,F.TMP ;YES. SUPRESS UFDPNT
MOVEM T,USRPTH+.PTPPN ;
TTYON
TXO F,F.NOTB ; Use dot instead of tab
TXNN SW,CH.X
PUSHJ P,FILPNT ;TELL HIM NEW FILE NAME
TXZN F,F.TMP ;DID UFD CHANGE?
JRST .+4 ;NO. DONT TELL HIM AGAIN.
PUSHJ P,UFDPNT ;YES. TELL HIM NEW UFD
TXNE SW,CH.X ;SUPPRESSING FILES?
PUSHJ P,CRLF ;YES. BETTER ADD A CR NOW.
OUTPUT CMD, ;MAKE SURE IT GETS OUT, MAY BE AWHILE TILL DONE.
;HERE TO DO ENTER AT LAST.
SW.I8:
;Following instruction removed to prevent the zeroing of the
;3 high-order bits of the creation date. (U. of Texas)
;[75] HLLZS BUF+RIBEXT ;SET UP UUOBLK
MOVI RIBSTS,BUF+RIBFIR
SETZM UBLKCT ;ZERO FILE SIZE.
TXO F,F.RIP ;RESTORE ABOUT TO START NOW.
MOVE T,BUF+RIBSIZ ;SIZE ACCORDING TO RIB
ADDI T,BLKSIZ-1
IDIVI T,BLKSIZ
MOVEM T,SETBLK ;UBLKCT COUNTS OUTPUTS, SETBLK HOPEFULLY.
TXNE SW,CH.P
JRST NORESTORE ;SKIP ENTER IF JUST PRINTING
ENTER STR,BUF ;USE STANDARD MONITOR ENTER
SKIPA
JRST SW.I5 ;AND CONTINUE READING FILE
;HERE ON ENTER FAILURE. DO SOMETHING FAST!
HRRZ T,BUF+EXLERC
CAIN T,ERPOA% ;PARTIAL ALLOCATION ONLY?
JRST SW.I5 ;YES. THAT'S OK. (FILE NOT CONTIGOUS)
CAIE T,ERIPP% ;GUY GOT NO UFD YET?
JRST SW.I7 ;WORSE. OY VEY!
MOVE T,[BUF,,DSK+DATBUF]
BLT T,DSK+DATBUF+RIBSTS ;SAVE UUOBLK SOMEPLACE SAFE
PUSHJ P,MAKUF1 ;GO MAKE HIM A UFD QUICK
TXOA F,F.FAIL
TXZ F,F.FAIL
MOVS T,[BUF,,DSK+DATBUF]
BLT T,BUF+RIBSTS ;RESTORE OUR FILE BLOCK
TXNN F,F.FAIL ;UFD THERE NOW?
JRST SW.I8 ;YES. TRY ENTER AGAIN..
;HERE ON HORRIBLE ERROR. CANT CREATE A FILE
SW.I7: TXZ F,F.RIP
TXNN SW,CH.X
JRST SW.I7A
TXO F,F.NOTB ; Use dot instead of tab
PUSHJ P,FILPNT ;NEED TO TELL HIM NAME IF DIDNT BEFORE
PUSHJ P,UFDPNT
SW.I7A: MOVEI M,[ASCIZ/ ENTER failure code:/]
PUSHJ P,MSGTTY
HRRZ N,BUF+EXLERC
PUSHJ P,OCTPRT
PUSHJ P,CRLF
SETSTS STR,14
NORESTORE: TXO F,F.FAIL
JRST SW.I5 ;CONTINE READING FILE FROM AUX,
;BUT F.FAIL TELLS NOT TO WRITE IT
;(JUST PASS IT)
;HERE TO ACTUALLY RESTORE THE DAMN DATA
SW.I6: AOS UBLKCT ;COUNT BLOCK LENGTH ON TAPE
TXNE F,F.FAIL ;RESTORING?
JRST SW.I5 ;NO. JUST IGNORE THIS BLOCK
MOVE T,[-200,,BUF]
SW.I21: SOSLE WH.STR+2
JRST SW.I20
OUT STR,
JRST SW.I20
MOVEI M,[ASCIZ/ OUTPUT error/]
PUSHJ P,MSGTTY
SETSTS STR,.IODMP
JRST SW.I5
SW.I20: MOVE CH,(T) ;GET A WORD
IDPB CH,WH.STR+1 ;PUT INTO BUFFER
AOBJN T,SW.I21 ;AND LOOP FOR 200 WORDS
JRST SW.I5 ;AND CONTINUE FOR REST OF FILE.
;HERE WHEN HIT EOF ON AUX DEVICE, CLOSE LAST FILE AND QUIT
SW.I10: SETZM BUF+RIBNAM ;SIMPLE FLAG TO SW.I11 CODE
JRST SW.I13 ;GO CLEAN UP ENDS
UU(WH.STR,3) ;DISK OUTPUT BUFFER HEADER FOR RESTORE CODE.
SUBTTL /L -- Lock job in core
;
; /L options include:
;
; /L - Lock job in core
; /LU - Unlock job
SWT.L: TXNE SW,CH.U ; Want to unlock or lock?
JRST UNLOCK ; Unlock
SKIPL %LOCK ; Lock. Are we already?
JRST SWT.L1 ; No. OK
JSP M,MSGDON ; Dont need to lock twice..
ASCIZ/%Job already locked/
SWT.L1: PUSHJ P,LOCKUUO ; Go lock the job
JRST NOLOCK ; Cant...
SETOM %LOCK
JSP M,MSGDON
ASCIZ/Job locked/
UNLOCK: AOSG %LOCK ; Locked already?
JRST UNLOK1
JSP M,MSGDON
ASCIZ/%Job not locked/
UNLOK1: MOVE N,ONEONE
UNLOK. N, ; Unlock us please..
JRST NOLOCK ; Hmm...
JSP M,MSGDON
ASCIZ/Job unlocked/
NOLOCK: TTYON
MOVE T,[3,,LOKERR]
PUSHJ P,ERRPNT ; Print the error code
PUSHJ P,CRLF
JRST RIPDON
LOKERR: ERRMAC ?LOCK UUO gone! , ?Job not privilleged
ERRMAC ?Another job would not be able to run, ?Can't guarantee CORMAX
SUBTTL /P -- Print according to format
SWT.P: TXNN SW,<CH.7!CH.6!CH.R!CH.Q!CH.O!CH.D!CH.A>
JRST DSKLST ; DSKLST if no print options
JRST DATLST ; Otherwise, DATLST to list blocks
SUBTTL /R -- Read verify disk blocks
; Simply reads all given blocks.
; Any which might be hardware unreadable are diagnosed by BLKRED...
; Defaults are BARG1=0, BARG2=Largest in STR, BARG3=1 block at a time
SWT.R: SKIPN BARG3 ; Zero increment?
AOS BARG3 ; Yes. Make it one
SWT.R0: PUSHJ P,NXTSTR
JRST RIPDON
JFCL
MOV BARG1,BUF ; BUF=block to start on.
MOV BARG2,BUF+1 ; BUF+1=Last block to try
MOVE T,STRHGH ; T=Highest log. block in STR
CAMG T,BARG2 ; Which should be more than he wants
JRST SWT.R2 ; Not even RIPOFF can read non-ex blocks!
SOS T
SKIPN BARG2 ; Ask for zero max?
MOVEM T,BUF+1 ; Yes. Assume maximum then
MOV BARG3,BUF+2 ; BUF+2=block to increment by
MOVE T1,BUF
SWT.R1: CAMLE T1,BUF+1 ; Done yet?
JRST SWT.R0 ; Yes. Get more disks
MOVEM T1,BUF ; Remember new block number
MOVE T,[IOWD BLKSIZ,DSK+DATBUF] ; No. T=IOWD
MOVEI P4,DSK
PUSHJ P,STRRED ; Go get it..
JFCL ; Thats one...
MOVE T1,BUF
ADD T1,BUF+2 ; Try next block
JRST SWT.R1
; Here on illegal maximum arg
SWT.R2: MOVEI M,[ASCIZ/?Only /]
PUSHJ P,MSGTTY
MOVE N,T
PUSHJ P,OCTPRT ;
MOVEI M,[ASCIZ/ Blocks on STR/]
PJRST MSGDON
SUBTTL /S -- Manipulate SAT blocks/STRUUO functions
; Options:
; /SL Lock up STR (.FSLOK, then .FSREM)
; /SR Read SATs (DSKSAT)
; /SW Write them back
; /SF Free cluster in SAT
; /SM Mark cluster in SAT
; /SP Print sat as now in core
; /ST Type a cluster, i.e., tell free or marked
SWT.S:
SWT.S0: PUSHJ P,NXTSTR ; Get next structure
JRST RIPDON ; All done
JFCL ; Don't care about MFD
TXNN SW,<CH.W!CH.T!CH.P!CH.F!CH.M>
JRST SWT.S1
PUSHJ P,SATINC ; SATs must be already be in core
JRST ERR008
SWT.S1: TXNN SW,CH.L ; Want to lock the STR?
JRST SWT.S2 ; No. Continue on
; Here to lock out a STR.
PUSHJ P,LOKSTR ; Do .FSLOK
JRST SWT.S0
MOVEI T,^D10
CAMGE T,BARG1 ; If more then 10 seconds, tell him to
PUSHJ P,MSG001 ; 'Wait plz...'
SKIPN T,BARG1 ; Sleep BARG1 seconds
MOVEI T,^D60 ; Default is 1 min
SLEEP T, ; Wait a while
PUSHJ P,REMSTR ; Do .FSREM now.
JRST SWT.S0
MOVEI T,[MOVEI T,.DCSTN ; For all units in STR, set pack-not
DPB T,[POINTR UNIDES(U),DC.STS] ; mounted status
POPJ P, ]
PUSHJ P,DOALLU ; Do for all units
JRST SWT.S0 ; Done. Try other STR's if so wanted.
SWT.S2: TXNN SW,<CH.W!CH.R!CH.P>
JRST SWT.S5
; Here to read or write SATs
TXNN SW,CH.W ; Skip if writing SATs
JRST SWT.S3
PUSHJ P,WTSAT ; Go write SATs then
JRST ERR009
JRST SWT.S0 ; Got em.
SWT.S3: TXNN SW,CH.R
JRST SWT.S4
PUSHJ P,RDSAT ; Read SATs...
JRST ERR009
JRST SWT.S0
SWT.S4: SETZM TOTSAT ; Here to print SATs.
MOVEI T,[PUSHJ P,PNTSAT ; Print each SAT
ADDM N,TOTSAT ; Accumulate STR totals
POPJ P, ; For each unit
]
PUSHJ P,DOALLU
PUSHJ P,CRLF
MOVE N,TOTSAT
PUSHJ P,DECPRT ; Print STR total blocks free
MOVEI M,BLKMSG
PUSHJ P,MSG
MOVEI M,TOTMSG
PUSHJ P,MSG
JRST SWT.S0
; Here if /SM or /SF or /ST
SWT.S5: MOVE P1,BARG1
SWT.S6: CAML P1,STRHGH
JRST SWT.S0
MOVE T,P1
IDIV T,STRBPU ; T=unit,T1=block on unit
MOVE U,STRUNI(T) ; U=UDB
MOVE T,DSKSAT(U) ; T=Addr of SAT table, T1=block within table
IDIV T1,STRBPC ; T1=Cluster within table
TXNE SW,CH.T ; Want me just to type this?
JRST SWT.S7 ; Yes. Go type
MOVEI T2,MRKZRO ; No. Set up to mark or free
TXNE SW,CH.M ; Decide to MRKONE or MRKZRO.
MOVEI T2,MRKONE
PUSHJ P,(T2) ; Do one.
JFCL
SWT.S8: ADD P1,STRBPC ; On to next cluster
CAMGE P1,BARG2 ; Within bounds?
JRST SWT.S6 ; Yes. Do it too.
JRST SWT.S0 ; No. Done
; Here to type out a bit
SWT.S7: MOVEI P2,[ASCIZ/ marked/]
PUSHJ P,TSTONE ; See if marked
MOVEI P2,[ASCIZ/ free/]
MOVEI M,[ASCIZ/Cluster /]
PUSHJ P,MSGTTY
MOVE N,P1
IDIV N,STRBPC ;
PUSHJ P,OCTPRT ;
MOVE M,P2
PUSHJ P,MSGTTY
PUSHJ P,CRLF
JRST SWT.S8 ; Continue for more clusters if he wants
SUBTTL /U -- Create new UFD/SFD
; Make a new UFD/SFD. Gives error messages if it already
; exists. Will not create over already existing one
SWT.U: TTYON
SWT.U1: PUSHJ P,NXTSTR ; Get next STR
JRST RIPDON ; until done
JRST SWT.U1 ; Gotta have a MFD
PUSHJ P,RLSDSK
PUSHJ P,INIDSK ; Get us a disk
SETOM CURLVL ; Take running start at nesting
SWT.U2: AOS CURLVL ; Bump nesting level by one
PUSHJ P,SETUFD ; Setup for this one
JRST SWT.U3 ; None found so print error
LOOKUP STR,BUF ; Go!
SKIPA P1,BUF+EXLERC ; Not there! Wonderful.
JRST SWT.U2 ; There, so loop for next in path
HRRZS P1
JUMPE P1,SWT.U4 ; Better be 0=file not found
SKIPA ;
SWT.U3: MOVEI P1,ERAEF% ; Simulate error if already there
MOVE M,USRSTR ; Get current structure
PUSHJ P,PR6BIT ; and print it too
PUSHJ P,COLON ;
PUSHJ P,UFDPNT ; and current path
HRRZ N,P1 ;
SETZ T, ;
PUSHJ P,ERRPNT ; Print error message
PUSHJ P,CRLF ; Tidy up
JRST SWT.U1 ; Give up on this str
; Here when OK to make UFD/SFD
SWT.U4: PUSHJ P,MAKUFD ; Go make a UFD
JRST SWT.U1 ; Error or done
MOVEI M,[ASCIZ/Created /] ; Tell of success
PUSHJ P,MSG ; print it
MOVE M,USRSTR ; Get current str
PUSHJ P,PR6BIT ; and print it
PUSHJ P,COLON ;
PUSHJ P,UFDPNT ; and current path
PUSHJ P,CRLF ;
AOS CURLVL ; Bump SFD nesting level
JRST SWT.U4 ; and try next level
SUBTTL /V - Verify files and rebuild SATs
; File RIBs are checked, all blocks of the file are
;read (If A option), second RIBs are found and verified, and file is
;checksummed and SAT bits are checked (DSKRAT)
;and compared against disk SATs to find multiply used, free and lost clusters
SWT.V: SETCM T,F
TXNN T,STNDRD ; Were all files specified?
TXOA F,F.TRB ; Yes, tell routines to look for trouble
TXZ F,F.TRB ; No, forget it
SETOM PASS ; Count passes
PUSHJ P,NXTSTR ; Get a STR
JRST RIPDON ; If all done
JRST .-3 ; Must have a MFD
MOVE T,USRSTR ; Get specified str
TXNE F,F.TRB ; Looking for trouble?
CAME T,LSTDEV ; and STR same as LST device?
SKIPA ; No to one
PUSHJ P,ASK005 ; Yes, question his judgement
TXNN SW,CH.F ; Going to fix SATs?
JRST SWT.VA ; Nope
MOVE T,TTYTYP ; Get original device type
CAIE T,$DVSTR ; and other than STR specified?
JRST ERR015 ; Gotta have STR to fix SATs
PUSHJ P,STRMNT ; Is this STR mounted?
JRST ERR016 ; Yes, can't do this
SWT.VA: MOV .JBFF,.SVFF ; Save current field length
TXZE F,F.TRB ; If looking for trouble,
PUSHJ P,RDSAT ; read SATs.
TXZA F,F.TRB ; Can't do it, so don't look for trouble
TXO F,F.TRB ; Got 'em, reset the flag
MOVEI T,[ PUSHJ P,SATADD ; Allocate space for trouble SAT on
MOVEM T,TRBSAT(U) ; all units
POPJ P, ]
PUSHJ P,DOALLU ; Do above code on all units
TXNN SW,CH.A ; Read all blocks?
TXZA F,F.RALL ; No, make sure it doesn't happen
TXO F,F.RALL ; Yes, tell input routines
SWT.V1: TTYOFF ; Turn off TTY output
MOV .JBFF,TEMP3 ; Remember core before OURSAT allocated
TXNE SW,CH.Q ; If quick wanted,
TXO F,F.QUICK ; Let it be so.
PUSHJ P,BLDSAT ; Now go build a SAT from file
; information, noticing troubles in TRBSAT
PUSHJ P,SETBAT ;SET BITS FOR BLOCKS POINTED TO BY BAT
AOSE PASS
JRST SWT.V4 ; Only make two passes
PUSH P,F ; Save flags for F.TRB
TXZN F,F.TRB ; Did we read SATs above??
PUSHJ P,RDSAT ; No. Read them now.
SKIPA P4,[$PRLST] ; Yes. We looked for trbl before
MOVEI P4,$PRFRE ; No. Dont look for it now!
PUSHJ P,PRALL ; Print lost, free and mult clusters
POP P,T ; Unless only did a few files (F.TRB not set)
AND T,[F.TRB] ; In which case only free and mult.
TDO F,T ; Reset state of F.TRB in F..
PUSHJ P,FORM ; Form feed to output listing
MOVEI M,[ASCIZ/
End of pass 1 on /]
PUSHJ P,MSGTTY ; Tell of event
MOVE M,USRSTR ; Get STR we've been doing
PUSHJ P,PR6BIT ; Tell him which STR.
TXNE F,F.MULT ; Any multiply used clusters?
JRST SWT.V2 ; Yes.
MOVEI M,[ASCIZ/. No need for pass 2./] ; No.
PUSHJ P,MSG
JRST SWT.V4
SWT.V2: MOVEI M,[ASCIZ/. Beginning Pass 2./]
PUSHJ P,OPER ; Make sure he wants it
JRST SWT.V4
MOV TEMP3,.JBFF ; Restore .JBFF to deallocate OURSAT
; So that BLDSAT will start all over again.
PUSHJ P,REWSTR ; Rewind the str
JRST DIE003 ; Succeeded once!
JRST DIE003
JRST SWT.V1 ; and go do it again
; Now, if /VA, read rest of str too...
SWT.V4: TXNN SW,CH.A ; Well?
JRST SWT.V5 ; Nope.
TXNN F,F.TRB ; Must have read in SATs to do this..
JRST SWT.V0 ; Forget it
SETOB P1,P2 ; Test BUF(P1)=C(P2)
SETZM BUFHED ; BUF(P1)=zero, P2=-1, match is doubtfull..
SETOM SATFLG ; Read only if not in DSKSAT
SETOM SETBLK ; Begin at block 0
MOVEI T,[ MOV OURSAT(U),DSKSAT(U) ; Move SAT pointers
POPJ P, ]; So that OURSAT becomes DSKSAT
PUSHJ P,DOALLU
HLRZ U,UNIDDB
MOVEI T4,1 ; Increment by 1 block
PUSHJ P,SEARCH ; Search for a block that cannot be found
SKIPA ; Done...
JRST .-2 ; If found, ignore it
; Now rewrite sats back out if /VF
SWT.V5: TXNN SW,CH.F ; Want it?
JRST SWT.V0 ; No. Done
TXNN F,F.TRB ; Do *.*[*,*]??
JRST ERR010 ; No. Cant do it.
TXNE CH,CH.A ; Go through /VA above?
JRST SWT.V6 ; Yes. Forget this
MOVEI T,[ MOV OURSAT(U),DSKSAT(U) ; No, Make DSKSAT=OURSAT
POPJ P, ]
PUSHJ P,DOALLU
SWT.V6: MOVEI M,[ASCIZ/
Prepared to rewrite SATS/]
PUSHJ P,OPER ; Make sure he wants it
JRST SWT.V0
TXZ F,F.TRB!F.OURS ; Dont look at bits again!
PUSHJ P,WTSAT ; Rewrite SATs then.....
JRST ERR009 ; Ohboy!
; Here when all done, deallocate core and continue
SWT.V0: MOV .SVFF,.JBFF ; Restore .JBFF
JRST SWT.V
SUBTTL /W -- Do word searches
REPEAT LOGIC, <
/W options include:
/WM - Set search mask to specified value
/WW - Set search word to specified value
/WT - Type current values of search mask and word
/WS - Start word search for specified values
>
SWT.W: TXNN SW,CH.T ; Typing values?
JRST SWT.W1 ; No
TTYON ; Enable TTY output
PUSHJ P,SWWPRT ; Type the values
PJRST RIPDON ; and finish up
SWT.W1: TXNN SW,CH.M ; Setting mask register?
JRST SWT.W2 ; No
MOV BARG1,WMASK ; Set new value
PJRST RIPDON ; and finish up
SWT.W2: TXNN SW,CH.W ; Setting search word?
JRST SWT.W3 ; No
MOVE T,BARG1 ; Assume it looked like a block number
SKIPN GOTWRD ; Are we correct?
MOVE T,USRNAM ; No, get something that looks like this
MOVEM T,WWORD ; Set new value
PJRST RIPDON ; and finish up
; Here to do the search for the specified word. Note that one
; may search files or relative blocks.
SWT.W3: TXNN SW,CH.S ; Better be start of search
JRST ERR001 ; No, bad option
PUSH P,BARG1 ; Save value for later
SETOM PASS ; Count number of matches
SWT.W4: PUSHJ P,NXTSTR ; Get next STR
JRST [POP P,BARG1 ; Restore BARG1
JRST RIPDON] ; and finish up
JFCL ; Don't care about MFD
SWT.W5: SKIPE GOTWRD ; Skip if no block arg
JRST SWT.W8 ; Go process blocks
PUSHJ P,NXTPPN ; Get next PPN
JRST SWT.W4 ; If none left
SWT.W6: PUSHJ P,NXTFIL ; Get next file
JRST SWT.W5 ; If none left
PUSHJ P,USRLOK ; Lookup the file
JRST SWT.W6 ; Not there
MOV IOW,XIOWD+DSK ; Setup IOWD to read into BUF
SWT.W7: MOVEI P4,DSK ; Setup core block pointer
PUSHJ P,DMPIN ; Get the next block of the file
MOVX T,IO.EOF ; Get EOF flag
TDNE T,IOSTS+DSK ; Hit EOF?
JRST SWT.W6 ; Yes, try next file
PUSHJ P,WRDMAT ; Search this block and print matches
JRST SWT.W7 ; and loop for rest of file
;
; Here to do block searches
SWT.W8: MOVEI P4,DSK ; Setup core block pointer
MOVE T1,BARG1 ; Get next block to read
MOVE T,IOW ; Get IOWD to use
PUSHJ P,STRRED ; Read the block
JFCL ; Oh well, do the search anyway
PUSHJ P,WRDMAT ; Search this block
AOS T,BARG1 ; Bump the block count
CAMG T,BARG2 ; Done enough?
JRST SWT.W8 ; No, loop for more
JRST SWT.W4 ; Try next structure
SUBTTL /X -- Perform cleanup and exit
; Options are:
; /XQ - Run QUEUE automatically after closing files
;
MSGXIT: PUSHJ P,MSGTTY ; Here to print msg and exit
SWT.X: PUSHJ P,KILL ; Close listing files
TXNN SW,CH.Q ; Want to run QUEUE too??
EXIT ; No. Forget everthing..
MOVSI T,DSYS ; Yes. Go get it!
MOVE T1,[SIXBIT .QUEUE.]
SETZB T2,T4
OUTSTR [ASCIZ/
.R QUEUE
/]
JRST RUNCOM ; and go run it!!
; Here to CLOSE and RELEAS all listing files and devices
KILL: OUTPUT CMD,
TXNE F,F.TTY2
JRST .+3
KILL1: OUTPUT LST,
CLOSE LST,
PUSHJ P,RLSDSK
RELEAS LST,
POPJ P,
SUBTTL ^C INTERCEPT CODE
; No one seems to be able to remember to exit with a /X command
; after writing the listing to a file. A ^C is used instead and
; if no CLOSE is done, the listing is lost. To prevent this,
; the page contains the ^C intercept code. If the user types
; a ^C when the listing is being written to a file, ask him
; if he wants to close the file. Enter at CZEXIT to process
; a ^Z instead.
CCEXIT: PUSH P,INTBLK+.EROPC ; Save interupt PC
SETZM INTBLK+.EROPC ; Reenable intercept
CZEXIT: ; [075] Control-Z entry point
TXNE F,F.TTY2 ; Output going to TTY?
JRST CCEXT2 ; Yes
CLRBFO ; Clear output buffer
PUSH P,M ; Save M and TEMP
PUSH P,TEMP ; (Used by OPER)
MOVEI M,[ASCIZ/
Close listing file before exiting?/]
PUSHJ P,OPER ; Ask user
JRST CCEXT1 ; He says no
POP P,TEMP ; Restore TEMP and
POP P,M ; M
PUSHJ P,KILL1 ; Clean up
EXIT ; and quit
CCEXT1: POP P,TEMP ; Restore TEMP and
POP P,M ; M
CCEXT2: MONRT. ; Exit quietly
POPJ P, ; Return if he says CONTINUE
SUBTTL SYSINI - RIPOFF once-only initialization code
; Subroutine to determine system disk configuration and build
; a UNIDDB for all units.
; Called only once at program startup time
SYSINI: MOVEI U,UNIDDB ; Start at beginning
SETOM CTYPE ; Current controller type
SYSIN1: AOS T,CTYPE ; 0,1,2,3,4,5=FHA,FHB,DPA,DPB,RPA,RPB
CAILE T,TYPMAX ; Done all possible types?
JRST SYSIN3 ; Yes. Continue on
SETOM CUNIT ; No. Try all units here
SYSIN2: AOS T,CUNIT ; 0-7 units
CAILE T,MAXUNI ; Skip if still in range
JRST SYSIN1 ; Not, so try another controller
MOVSS T
HRR T,CTYPE ; T=XWD unit,, controller type
PUSHJ P,INIPHY ; INIT this unit. Return with T1=Unit name
JRST SYSIN2 ; Cant so forget it
MOVEM T1,USRSTR ; Remember its physical name
PUSH P,T ; Save DSKCHR bits
MOVEI T,UNIDDL ; Length of one UDB
PUSHJ P,CORGRB ; Grab the core
MOVEM T,(U) ; Save initial ptr in last UDB for link
MOVE U,T ; U=adr of this UDB now.
POP P,UNIDES(U) ; Store DSKCHR bits in UDB
; Now determine what brand of disk pack we have here..
MOV <[Z STR,T]>,XCHAN(U) ; Tell BLKRED how to look
MOV USRSTR,DRIVE(U) ; And where to look
MOV BIGNUM,BLKUNI(U) ; Don't let IO.BKT get me
MOVEI P4,DSK ; Give it a channel data block
MOVE T,CTYPE ; Get controller type
HRRZ T4,KONADR(T) ; Get addr of AOBJN pointer
MOVE T4,(T4) ; Get pointer itself
SYSI8A: MOVEM T4,DSKPTR ; Save ptr to table
MOVE T1,1(T4) ; Get blocks / unit
SOS T1 ; Try to read next to last block
MOVE T,IOW
TXO F,F.DERR ; Suppress error msg if any.
PUSHJ P,BLKRED ; ..
JFCL
MOVE T,DSK+IOSTS ; Get I/O status
TXNN T,IO.ERR ; Errors?
JRST SYSI8B ; No. Got it
MOVE T4,DSKPTR ; Yes. Try smaller pack
ADD T4,[2,,2] ; Update pointer
AOBJN T4,SYSI8A ; and loop.
; If none of the blocks read, must have a bad pack... Forget it
SKIPA M,[[ASCIZ/Can't establish unit type for unit /]]
SYSI8C: MOVEI M,[ASCIZ/Unit type inconsistency for unit /]
PUSHJ P,MSGTTY
MOVE M,USRSTR
PUSHJ P,PR6BIT
MOVEI M,[ASCIZ/, setting status = down
/]
PUSHJ P,MSGTTY
JRST SYSIN2 ; and loop for more units
; Found unit type. Set up parameters for it
SYSI8B: MOVE T,1(T4)
MOVEM T,BLKUNI(U) ; Blocks/unit
HRRZ T,0(T4)
MOVEM T,BLKCYL(U) ; Blocks/cylinder
HLRZ T,0(T4)
MOVEM T,BLKTRC(U) ; Blocks/track
JRST SYSIN9 ; Skip tables
; Following are the tables of disk parameters used by RIPOFF in the
; initialization code.
;
; To add a new controller type, add it's SIXBIT name to the table
; KONSIX and in the same relative position in KONADR, add the
; DSKCHR controller type code and the pointer to the appropriate
; AOBJN pointer to the unit tables. To add a new type of disk
; drive, select the controller type on which it is to be used and
; determine the correct disk table from the pointer. In that table,
; add the necessary attributes for the drive. Note that the
; blocks/unit parameters in each table must be in strictly decreasing
; order.
DEFINE DSKTAB(A,B,C,D)
< XWD A,B
EXP C
EXP D >
; BLKS/TRACK , BLKS/CYL , BLKS/UNIT , DSKCHR unit type
; Table for drives on RP controller
%RH10: DSKTAB ^D20, ^D380, ^D307800, .DCUR6 ;RP06
DSKTAB ^D20, ^D380, ^D154280, .DCUR4 ;RP04
%RHLEN==.-%RH10
; Table for FS drives on an RH10
%RHS10: DSKTAB ^D32, ^D2048, ^D2048, .DCUS4 ; [076] RS04
%RSLEN==.-%RHS10 ; [076]
; Table for drives on DP controller
%RP10: DSKTAB ^D10, ^D200, ^D80000, .DCUD3 ;RP03
DSKTAB ^D10, ^D200, ^D40000, .DCUD2 ;RP02
%RPLEN==.-%RP10
; Table for drives on FH controller
%RC10: DSKTAB ^D20, ^D4000, ^D4000, .DCUFD ;RD-10
DSKTAB ^D30, ^D2700, ^D2700, .DCUFM ;RM10-B
%RCLEN==.-%RC10
; Below is a table of controller types to look for. The nth
; element of KONSIX contains the SIXBIT name of the controller
; and is indexed by CTYPE. The corresponding entry in KONADR
; contains the controller DSKCHR bits and the pointer to the
; AOBJN word for the units associated with the controller.
;
; Table of controller names
KONSIX: SIXBIT . FHA.
SIXBIT . FHB.
SIXBIT . DPA.
SIXBIT . DPB.
SIXBIT . DPC.
SIXBIT . FSA. ; [076] In KONSIX table
SIXBIT . FSB. ; [076]
SIXBIT . RPA.
SIXBIT . RPB.
SIXBIT . RPC.
SIXBIT . RPD. ;[APC]
TYPMAX==.-KONSIX-1
;
; Table of corresponding pointers to AOBJN words
KONADR: .DCCFH,,FHPTR
.DCCFH,,FHPTR
.DCCDP,,DPPTR
.DCCDP,,DPPTR
.DCCDP,,DPPTR
.DCCFS,,FSPTR ; [076] In KONADR before 1st RP entry
.DCCFS,,FSPTR ; [076]
.DCCRP,,RPPTR
.DCCRP,,RPPTR
.DCCRP,,RPPTR
.DCCRP,,RPPTR ;[APC]
;
; AOBJN pointers to associated unit types
FHPTR: -%RCLEN ,, %RC10
DPPTR: -%RPLEN ,, %RP10
RPPTR: -%RHLEN ,, %RH10
FSPTR: -%RSLEN ,, %RHS10 ; [076]
; End of disk tables
; Here when we know unit, set up home stuff
SYSIN9: SETZM (U) ; Incase this is the last UDB.
HRLZ T,CTYPE
HRR T,CUNIT
MOVEM T,DEVKON(U) ; Type,, unit
HLRZS T ; Get type in RH
HLRZ T,KONADR(T) ; Get DSKCHR controller type bits
LDB T1,[POINTR UNIDES(U),DC.CNT] ; Get type from monitor
CAME T,T1 ; Better be the same
JRST SYSI8C ; Otherwise, something's wrong
LDB T,[POINTR UNIDES(U),DC.UNT] ; Get monitor DSKCHR unit code
CAME T,2(T4) ; Better be the same as we found
JRST SYSI8C ; Otherwise error
PUSHJ P,HOMCHK ; Attempt to read it
JRST SYSIN2 ; Quit if no home blocks
SKIPN BUF+HOMHID ; or if no ID.
JRST SYSIN2
HRRZI T,1(U) ; Adr. of UDB+1
HRLI T,BUF+1 ; Adr of disk block+1
BLT T,HOMEND-1(U) ; Zap block into UDB
MOVE T,BLKUNI(U) ; Blocks/unit
IDIV T,HOMBPC(U) ; T=full clusters/unit
SUBI T,1 ; T=(clusters/unit)-1
IDIV T,HOMSPU(U) ; T=(clusters/SAT)-1
MOVEM T,UNICPS(U) ; Store it
AOS UNICPS(U) ; clusters/SAT=(((clus/unit)-1)/(SAT/unit))+1
IDIVI T,^D36 ; words/SAT=(((clus/SAT)-1)/(clus/word))+1
ADDI T,1
MOVEM T,UNIWPS(U) ; Words/SAT block
HRRZI T,P1
HRRM T,HOMCLP(U) ; Make all byte ptrs point to P1
HRRM T,HOMCNP(U)
HRRM T,HOMCKP(U)
JRST SYSIN2 ; Loop for all units
; Here to set up STRTAB
REPEAT LOGIC,<
STRTAB: BLOCK 1 ; Initial ptr to following table
SIXBIT .STR1. ; Table somewhere in core
Z,,ADR. Unit 0 UDB
Z,,ADR. Unit 1 UDB
Z,,ADR. Unit N UDB
SIXBIT .STR2. ; Note that all SIXBITs are negative
Z,,ADR. Unit 0 UDB ; While addresses are positive
Etc..
Z,,Z ; Ends the list
>
SYSIN3: MOVEI T,<MAXSTR+1>*<MAXUNI+2>+1 ;
PUSHJ P,CORGRB ; Get max core for the JOB
MOVEM T,STRTAB ; Initial ptr
MOVEI U,UNIDDB ; Adr. first UDB
SYSIN4: HRRZ U,(U) ; Adr. next UDB
JUMPE U,SYSIN7 ; Until done.
SKIPN T,HOMSNM(U) ; See what STR this unit's on
JRST SYSIN4 ; None. Forget it
SKIPL T1,HOMLUN(U) ; If negative unit,
CAILE T1,MAXUNI ; or out of normal range,
JRST SYSIN4 ; Probably just random bulsht. Forget it
SKIPA P1,STRTAB ; Begin at STRTAB
SYSIN5: ADDI P1,MAXUNI+2 ; Look at next entry
SKIPN T1,(P1) ; Is it zero?
JRST SYSIN6 ; Yes. Hit end without match.
; This is a new STR. Add it to list
CAME T,T1 ; No. Is this the same as
; STR this unit's on?
JRST SYSIN5 ; No. Keep looking
SKIPA ; Yes. STR already in table. Just
; UDB entry for this unit.
SYSIN6: MOVEM T,(P1) ; Put new STR in table
MOVEI T,1(P1) ; Adr. of entry for unit 0
ADD T,HOMLUN(U) ; Adr for unit N
MOVEM U,(T) ; Put UDB adr there
JRST SYSIN4 ; and continue for all units
; Here to compress STRTAB. Skip zero words
SYSIN7: MOVNI T,<MAXSTR+1>*<MAXUNI+2> ;
HRL T,STRTAB
MOVSS T ; IOWD to table for AOBJN
MOVSI P1,(POINT 36,0,35) ; P1=36 bit byte pointer
HRRI P1,-1(T) ; to str table
SKIPE T1,(T) ; Is it zero?
IDPB T1,P1 ; No. Put it back in table
AOBJN T,.-2 ; Loop for whole table
SETZ T,
IDPB T,P1 ; End it with a zero
ADDI P1,1
HRRZM P1,.JBFF ; Conserve core not used now
POPJ P, ; That is it. System is initialized
; Subroutine to INIT a device on channel STR
; Call T= XWD unit ,, controller type
; Ret+0 No such unit
; Ret+1 with T1=Device name.
; T = monitor DSKCHR bits
; M,T,T2 destroyed
INIPHY: PUSHJ P,PHYNAM ; Construct physical name
MOVEI T,.IODMP ; Dump mode
MOVE T1,M ; Name
SETZ T2,
OPEN STR,T
POPJ P,
MOVE T,[1,,M]
DSKCHR T, ; Do DSKCHR to see what monitor says
SETZ T, ; No bits
JSP M,TTYOUT ; Turn on TTY now
TXNE T,DC.OFL ; Is it off-line?
PUSHJ P,INI001 ; Yup. So monitor tells me.
TXNE T,DC.HWP ; Write protected?
PUSHJ P,INI002 ; Uh-huh
LDB T2,[POINTR T,DC.STS] ; Get status bits (DC.STS field)
JUMPE T2,CPOPJ1 ; Zero is OK
CAIN T2,.DCSTD
PUSHJ P,INI003 ; The unit is down
CAIN T2,.DCSTN
PUSHJ P,INI004 ; No pack mounted
CAIN T2,1
PUSHJ P,INI005 ; Reserved for future!
JRST CPOPJ1 ; Thats all folks..
; Here to type error (warning actually) messages.
; Type unit name, message, and ask to ignore monitor status.
INI001: JSP M,INI000
ASCIZ/ is off-line/
INI002: JSP M,INI000
ASCIZ/ is write protected/
INI003: JSP M,INI000
ASCIZ/ is down/
INI004: JSP M,INI000
ASCIZ/ has no pack mounted/
INI005: JSP M,INI000
ASCIZ/ has broken the time barrier/
INI000: PUSH P,M ; Save message address
MOVE M,ST$OPT ; Get the startup option
CAIE M,$OPLON ; Was it LONG?
JRST [POP P,(P) ; Get rid of message address
JRST INI047 ]; and go simulate NO answer
PUSH P,T ; Save DSKCHR bits across calls
MOVEI M,[ASCIZ/
Unit /]
PUSHJ P,MSGTTY
MOVE M,T1 ; Get unit name
PUSHJ P,PR6BIT
POP P,T ; Restore T
POP P,M ; Restore message address
PUSHJ P,MSG ; and print it
MOVEI M,[ASCIZ/
Type YES to ignore error, NO to consider pack down/]
PUSHJ P,OPER ; Ask for confirmation
SKIPA
POPJ P, ; He says ignore. Return.
INI047: POP P,(P) ; He says no. POP return to INIPHY
POPJ P, ; and make like INIT error, no such unit.
; Subroutine to construct physical device controller name.
; Call T=XWD Unit ,, Controller type
; Ret M=Name
PHYNAM: HLRZ M,T ; Unit number
ADDI M,'0' ; Make it SIXBIT
LSH M,^D12
HRL M,KONSIX(T) ; Put in controller name
POPJ P, ; and exit
SUBTTL RIPUUO - File service routines for RIPOFF
; Subroutine to find and initialize (INIT) next structure
; Ret+0 No more structures
; Ret+1 Next STR fixed up, but no MFD on STR
; Ret+2 Next STR fixed up, and MFD OK on channel MFD
NXTSTR: JSP M,SAVE3 ; Save a few AC's
SETOM CURLVL ; Set nesting level to -1 (MFD)
TXZ F,F.MFD!F.1UNI ; No MFD yet and not in pass 2
MOVE T,TTYTYP ; Get DEVTYP of original name
CAIE T,$DVCNT
CAIN T,$DVCON
JRST @NXTTAB(T)
JUMPN T,.+2
JRST @NXTTAB(T) ; If 3,4 or 0 , process now
; Here if 1,2,5 or 6 - can only be called once
AOSE STRFLG ; Been here before?
JRST NXTDON ; Yes. Clear bits and popj
CAIE T,$DVSTR ; No. Type 1?
TXO F,F.1UNI ; No. Type 2,5,6 all have only one unit
JRST @NXTTAB(T) ; and dispatch on DEVTYP
NXTTAB: NXTST0
NXTST1
NXTST2
NXTST3
NXTST4
NXTST5
NXTST6
NXTDON: SETOM STRFLG
HRRZS UNIDDB
TXZ F,F.1UNI
POPJ P,
; Here if type 0= DSK (Generic)
; Each call will return another structure in system linked in UDBs
NXTST0: SKIPE T,USRSTR ; Get last STR name
PUSHJ P,FNDSTR ; Find it in STRTAB
MOVE P1,STRTAB ; Not found so start with first one.
SKIPLE U,(P1) ; Find the next name in table
AOJA P1,.-1
JUMPE U,NXTDON ; Unless were at the end now
MOVE T,(P1)
MOVEM T,USRSTR ; OK. Got next one
; Here with U=Unit 0 UDB address, P1=Adr of STR name in STRTAB
NXTSTA: MOVEI U,UNIDDB ; Start with UNIDDB
NXTSTB: SKIPG T,1(P1) ; Look through table
JRST NXTSTC ; Until next STR name
HRLM T,(U) ; Moving UDB addresses to UDB links
MOVE U,T
AOJA P1,NXTSTB
NXTSTC: HRRZS (U) ; End it all with a zero in LH link
JRST LNKDON ; and we're done.
; Here if type 1 = specific structure name
; Return only once linking that STR
NXTST1: MOVE T,USRSTR ; Get its name
PUSHJ P,FNDSTR ; Find it in table
JRST DIE004 ; Gotta be there
SOJA P1,NXTSTA ; and go link this STR now and return
; Here if type 2 = specific unit in structure (DSKB3)
; or type 5 = specific unit on a controller (DPA3)
; or type 6 = specific home ID (PRV001)
;
; All return exactly one unit each call
NXTST2:
NXTST5:
NXTST6: MOVE U,TTYDDB ; UDB found in scanner
HRLM U,UNIDDB ; It is only link
JRST NXTSTC ; Go add a zero eol and continue
; Here if type 3 = controller type (DP)
; or type 4 = specific controller (DPB)
; Return one unit on each call
NXTST3:
NXTST4: MOVE T,TTYSTR
PUSHJ P,MSKUNI ; Make mask in T1
HLRZ U,UNIDDB ; Get adr. of last unit found
SKIPN U ; None?
HRRZ U,UNIDDB ; Well then use first unit
NXTSTD: MOVE U,(U) ; Go to next UDB in system
JUMPE U,NXTDON ; Unless no more
MOVE T2,DRIVE(U)
AND T2,T1 ; Get units name to a few chars
CAME T,T2 ; Match?
JRST NXTSTD ; No. Keep trying
HRLM U,UNIDDB ; Yes. got one
MOV DRIVE(U),USRSTR ; Remember its name
JRST NXTSTC ; Add zero ptr and go home
; Here when structure units linked
; Now initialize STRUNI table, INIT units with monitor
LNKDON: SETZM HIGHU ; Highest unit in STR
SETZM STRBPU ; Highest blocks/unit in STR
SETZM STRSIZ ; Total number of blocks in the STR
SETZM STRUNI ; Table of units in STR
MOVE T,[STRUNI,,STRUNI+1]
BLT T,STRUNI+MAXUNI ; Clear out a few things first
MOVEI U,UNIDDB
MOVEI P1,FFCHAN ; P1=Channel to INIT unit on
NXTSTE: HLRZ U,(U) ; Get next unit in STR
JUMPE U,NXTSTF ; Until done
MOVE T,HOMLUN(U)
TXNE F,F.1UNI
MOVEI T,0 ; If not a STR, make it look like unit 0
CAILE T,MAXUNI
JRST DIE004
CAMLE T,HIGHU
MOVEM T,HIGHU ; Calculate highest unit
MOVEM U,STRUNI(T) ; and make table OK
MOVE T,BLKUNI(U)
CAMLE T,STRBPU
MOVEM T,STRBPU ; Caculate highest blks/unit in STR
ADDM T,STRSIZ ; By counting total blocks in STR
MOVEM T,CURPOS(U) ; Impossible position, force positioning.
MOVEI T,T
DPB P1,[POINT 4,T,12]
MOVEM T,XCHAN(U)
TLO T,(RELEASE)
XCT T ; RELEASE CHAN,T
MOVEI T,.IODMP ; Dump mode INIT
MOVE T1,DRIVE(U) ; Physical name
SETZ T2,
MOVE T3,XCHAN(U)
TLO T3,(OPEN)
XCT T3 ; OPEN CHAN,T
JRST DIE006
AOJA P1,NXTSTE ; Loop for all units in STR
; Here when str all set up, release all channels not used
; and see if we can find the MFD
NXTSTF: MOVSI T,(RELEASE) ; Set to release
DPB P1,[POINT 4,T,12]; All still unused channels
XCT T
CAIGE P1,17
AOJA P1,NXTSTF ; Loop for 17 channels
HLRZ U,UNIDDB ; Get a unit UDB ptr back
HRLZI N,HOMGRP(U) ; Save a few structure parameters
HRRI N,STRGRP ; For each structure.
BLT N,STRBPC ; From UDB to resident core
MOVE T,HIGHU ; Highest unit
ADDI T,1 ; +1 for unit 0
IMUL T,STRBPU ; Times blks per unit
MOVEM T,STRHGH ; =highest blk on STR
MOVE T,BARGFL ; Get block arg flags
MOVE T1,STRBPC ; Blocks/cluster
TRNE T,1 ; Block arg 1 # ?
IMULM T1,BARG1 ; Yes. Fix it
TRNE T,2 ; BARG2?
IMULM T1,BARG2 ; IBID.
TRNE T,4
IMULM T1,BARG2
SETZM BARGFL ; and forget flags now
REWSTR: HLRZ U,UNIDDB
MOVE T,MFDPPN ; Get MFD now
MOVSI T1,'UFD'
MOVN T2,HOMMFD(U)
MOVE T3,MFDPPN
MOVEI P4,MFD
AOS (P) ; Set for at least single skip return
MOVE N,HOMUN1(U) ; Log unit where MFD starts
TXNE F,F.1UNI ; Only one unit 'structure'?
CAMN N,HOMLUN(U) ; Yes. Dont even try lookup if MFD not on this unit..
PUSHJ P,LOOKP ; Look for it
PJRST NOMFD ; Not there. Give non-fatal msg and skip return
TXO F,F.MFD ; Got it. Flag it.
JRST CPOPJ1 ; and give double skip ret.
; Subroutine to find the next PPN or directory in accordance with
; the command specs.
;
; RIPOFF contains two different tree search algorithms. The combination
; of NXTPPN and NXTFIL perform a post-order tree traversal by processing
; the files in each SFD before processing the SFD itself. This is
; done by enabling NXTFIL to scan for SFD's itself and dropping down
; one level when it finds one that matches the command string. The
; combination of NXTDIR and NXTFIL perform a pre-order tree traversal
; by processing all files at a given level before trying to find any
; SFD's at a lower level. In general, the NXTDIR/NXTFIL algorithm
; is used where a nice format is desired (/P), it is impossible to
; do it the other way (/A), or where speed is not important. As
; a result, one will find, for example, that the /F, /W, and /V
; code use the NXTPPN/NXTFIL combination because they do not need
; the slower NXTDIR/NXTFIL combination.
;
; Both return CPOPJ if no more directories
; CPOPJ1 with the directory setup
NXTDIR: TXZ F,F.NPP!F.SCAN ; Flag entry as NXTDIR, disable scanning
SKIPGE T,CURLVL ; Skip if not first call for this STR
JRST NXTPP1 ; On first call, do a NXTPPN
MOVE P4,CORBLK(T) ; Point to core block for this level
MOVE T,FNAME(P4) ; Setup for LOOKP by getting values
MOVE T1,FEXT(P4) ; current values from core block
MOVE T2,FCFP(P4)
MOVEI T3,FPATH(P4)
PUSHJ P,LOOKP ; LOOKUP directory, thus rewinding it
JRST DIREOF ; Can't, fake EOF
;
; Here to reread the directory at the current level looking for
; lower level directories that match the command string
;
NXTDI1: PUSHJ P,R.UFD ; Read next entry from directory
JRST DIREOF ; If no more entries
MOVE T,CH ; Save the filename
PUSHJ P,R.UFD ; Read ext,,cfp
JRST DIREOF ; If no more entries
JUMPE T,NXTDI1 ; Ignore if empty
HRRM CH,USRCFP ; Save the CFP
HLRZS CH ; Isolate extension in RH
CAIN CH,'SFD' ; This an SFD?
PUSHJ P,CHKSFD ; Yes, check for command string match
JRST NXTDI1 ; No to one, ignore it
PUSHJ P,LOOKP ; LOOKUP the directory
JRST DIREOF ; Can't, simulate EOF
MOVE T,CURLVL ; Get level back
SKIPN MATFLG(T) ; Can files be matched at this level?
JRST NXTDI1 ; No, avoid futile calls to NXTFIL
AOS (P) ; Bump return point
POPJ P, ; and return with new directory
;
; Here when the current directory runs out
;
DIREOF: SKIPN CURLVL ; Done all directories in this PPN?
JRST NXTPP1 ; Yes, call NXTPPN again
SOS P4,CURLVL ; Decrement level
MOVE P4,CORBLK(P4) ; Point to next higher core block
JRST NXTDI1 ; and continue with that one
;
; Enter here to get the next PPN as opposed to the next directory
;
NXTPPN: TXO F,F.NPP!F.SCAN ; Flag NXTPPN entry and enable scanning
NXTPP1: PUSHJ P,R.MFD ; Read one word of the MFD
JRST MFDEOF ; If MFD done, try next STR's MFD
MOVE T3,CH ; Save the word
PUSHJ P,R.MFD ; Read next entry
JRST MFDEOF
JUMPE T3,NXTPP1 ; Even MFD's have zeroes
HRRZM CH,UFDCFP ; Save CFP to the UFD
HLRZS CH
CAIE CH,'UFD'
JRST NXTPP1 ; MFD's also have files other than UFD's.
TXNE F,S.PROJ ; Looking for a particular project?
JRST NXTPP2 ; No. This one's OK. Try the programmer #
HLRZ T1,T3 ; Proj # from MFD
HLRZ T2,USRPTH+.PTPPN ; Proj # from file specs
CAME T2,T1 ; Do they match?
JRST NXTPP1 ; No. Try another entry
NXTPP2: TXNE F,S.PROG ; Looking for a particular programmer?
JRST NXTPP3 ; No. Continue on
HRRZ T1,T3 ; Yes. Compare MFD programmer #
HRRZ T2,USRPTH+.PTPPN; to user programmer #
CAME T2,T1 ; Do they match?
JRST NXTPP1 ; No. Try, try again
;
; Here when we have a PPN that matches the command string.
;
NXTPP3: MOVEM T3,USRPTH+.PTPPN; We have our number
NXTPP4: MOVEI P4,UFD ; Point to correct core block
MOV UFDCFP,FCFP(P4) ; Save CFP of this directory
SETZB T1,CURLVL ; Setup for CHKPTH and indicate top level
PUSHJ P,CHKPTH ; See if files are matchable in UFD
MOVE T,USRPTH+.PTPPN ; get our number
MOVSI T1,'UFD'
MOVE T2,UFDCFP
MOVE T3,MFDPPN
PUSHJ P,LOOKP ; LOOKUP his UFD
JRST NXTPP1 ; Ignore bad UFD's
TXNN F,F.NPP ; Enter at NXTPPN
SKIPE MATFLG+0 ; No, match files on this level?
JRST CPOPJ1 ; Yes, return success
JRST NXTDI1 ; Avoid futile calls to NXTFIL
;
; Here when the MFD runs out
;
MFDEOF: TXZ F,F.MFD ; MFD no longer looked up
POPJ P, ; Return
; Routine to return the next file from a given path in accordance
; with the command string. If F.SCAN is set, NXTFIL will process
; the files in an SFD found at the current level that matches the
; command string.
;
; Returns CPOPJ on EOF on current level if F.SCAN is not set,
; on EOF at top level if F.SCAN is set
; Returns CPOPJ1 if file found with USRNAM, USREXT, USRCFP, USRPTH,
; and P4 setup
NXTFIL: PUSHJ P,R.UFD ; Read filename from current level
JRST UFDEOF ; EOF on this level
MOVE T,CH ; Save the filename
PUSHJ P,R.UFD ; Get EXT,,CFP
JRST UFDEOF ; EOF on this level
JUMPE T,NXTFIL ; If entry is empty
HRRZM CH,USRCFP ; Save CFP of file
HLRZS CH ; Move extension to right half
CAIN CH,'SFD' ; This an SFD?
TXNN F,F.SCAN ; and scanning enabled?
JRST NXTFI2 ; Nope, try it as a file
PUSHJ P,CHKSFD ; SFD match command string?
JRST NXTFI2 ; No, process as a file
PUSHJ P,LOOKP ; Lookup this SFD
JRST UFDEOF ; Can't, simulate EOF
PJRST NXTFIL ; Go process files in SFD
;
; Here when we have a possible candidate at a given level.
; See if we match the filename and extension specified in
; the command string.
;
NXTFI2: MOVE T1,CURLVL ; Get current level
SKIPN MATFLG(T1) ; Files matchable on this level?
JRST NXTFIL ; No, continue
HRLZS CH ; Move ext back to left half
TXNE F,S.NAM ; Need to match name?
JRST NXTFI3 ; No
CAME T,USRNAM ; The same?
JRST NXTFIL ; No dice, go get next one
NXTFI3: TXNE F,S.EXT ; Need to match extension?
JRST NXTFI5 ; No
CAME CH,USREXT ; Match?
JRST NXTFIL ; Nope
NXTFI5: MOVEM T,USRNAM ; Save name and
MOVEM CH,USREXT ; extension
AOS (P) ; Set for skip return
POPJ P, ; and return
;
; Here when we reach an EOF on the current level. If scanning was
; enabled, back out one level and setup to process the SFD itself
; as a file.
;
UFDEOF: TXNE F,F.SCAN ; Scanning enabled?
SKIPN P4,CURLVL ; Yes, backed out all the way already?
POPJ P, ; Yes, really an EOF
MOVE P4,CORBLK(P4) ; Get current core block
MOV FCFP(P4),USRCFP ; Get CFP for the SFD
MOVE T,FNAME(P4) ; and the filename
MOVEI CH,'SFD' ; to process the SFD as a file
SOS P4,CURLVL ; Decrement level
MOVE P4,CORBLK(P4) ; and point to new core block
JRST NXTFI2 ; Go process SFD
; Routine to check for an SFD that matches the command string
; Call with T = SFD name
; Returns CPOPJ if no match
; CPOPJ1 if the SFD matches with
; T-T3 setup for LOOKP
; CURLVL incremented and P4 setup
; MATFLG setup for new level
; Path setup in TMPPTH
CHKSFD: SKIPN %FTSFD ; System have SFD's?
POPJ P, ; No, so can't match them
MOVE T1,CURLVL ; Get current SFD level
TXNN F,S.SFD ; All SFD's stars?
SKIPE SFDFLG+1(T1) ; or just star at next level?
JRST CHKSF1 ; Yes, this is a match
MOVE T1,USRPTH+.PTPPN+1(T1) ; Get name at next level
CAME T,T1 ; Match with this one?
POPJ P, ; No, return
;
; Here if the SFD matches the command string. Drop down one level and
; setup to process the files in the new SFD.
;
CHKSF1: AOS T1,CURLVL ; Bump current level
PUSHJ P,CHKPTH ; Setup MATFLG appropriately
MOVEM T,USRPTH+.PTPPN(T1) ; Save matching SFD name
MOVE T2,[USRPTH,,TMPPTH] ; Get BLT pointer to move path
BLT T2,TMPPTH+.PTPPN+1+SFDLVL+1-1 ; Move path to where we can diddle it
SETZM TMPPTH+.PTPPN+1(T1) ; Insure zero terminator at correct place
MOVE P4,CORBLK(T1) ; Point to new core block
MOVSI T1,'SFD' ; Extension is SFD
MOVE T2,USRCFP ; Get CFP of SFD
MOVEM T2,FCFP(P4) ; Save in core block
MOVEI T3,TMPPTH ; Point to path
AOS (P) ; Set for skip return
POPJ P, ; and return
;
;
;
; Routine to see if files can be matched at a given level of nesting
; Call with T1 = level to check
; Returns CPOPJ always with MATFLG(T1) set appropriately
;
; Preserves T1
CHKPTH: SETZM MATFLG(T1) ; Assume files cannot be matched
TXNE F,S.SFD ; Stars on all levels?
JRST CHKPT1 ; Yes, files are matchable
CAME T1,CMDLVL ; Deepest level specified in command string?
SKIPE SFDFLG+1(T1) ; or next level a star?
CHKPT1: SETOM MATFLG(T1) ; Yes, files are matchable
POPJ P, ; Return
PNOMFD: PUSHJ P,NOMFD ; Tell of no MFD on this STR
JRST RIPDON ; and continue
NOMFD: MOVEI M,[ASCIZ/
No MFD on /]
PUSHJ P,MSGTTY
MOVE M,USRSTR
PUSHJ P,PR6BIT
TXZ F,F.MFD
PUSHJ P,CRLF2
TTYOFF
POPJ P,
NOSTR: SKIPN USRSTR
JRST NOSTR1 ; Didnt type any STR
MOVEI M,[ASCIZ/
?No such STR - /]
PUSHJ P,MSGTTY
MOVE M,USRSTR
PUSHJ P,PR6BIT
JRST SCAN
NOSTR1: MOVEI M,[ASCIZ/?Must specify a STR/]
MSGDON: PUSHJ P,MSGTTY
PUSHJ P,CRLF2
JRST RIPDON
; Subroutine to find out what type of disk argument we have supplied
; in AC T.
;
; Return+0 always with T1=type code.
;
; Types are:
$DVGEN==0 ; Generic disk (D,DS,DSK,ALL, or zero arg)
$DVSTR==1 ; STR name (DSKA,DSKB)
$DVLUN==2 ; Logical unit within a STR (DSKA3)
$DVCNT==3 ; Controller type(DP,FH,MD)
$DVCON==4 ; Controller (DPA,FHB)
$DVPHD==5 ; Physical drive within controller (DPA3,FHA0)
$DVPID==6 ; Pack ID (PRV006,LIB000)
; or T1=-1 if none of the above...
;
; U = Unit UDB address (unless type 0, U unspecified)
;
;
; Note that other types may be added. Program should not check for type
; 6 by CAIGE instruction.
DEVTYP: JUMPE T,DEVTY0 ; Zero arg, return zero
CAMN T,[SIXBIT/ALL/] ; Was it ALL:?
JRST DEVTY0 ; Yes, return $DVGEN
PUSHJ P,MSKUNI ; Make T1=mask for as many chars as typed
MOVSI T2,'DSK' ; Look for generic
AND T2,T1 ; Only as exact as he wants
CAME T,T2 ; That it?
JRST DEVTY3 ; No. got to look at UDB's..
DEVTY0: MOVEI T1,$DVGEN ; Yes. Return zero code
POPJ P, ; and exit
DEVTY3: MOVEI U,UNIDDB ; Look at UDBs
DEVTY1: HRRZ U,(U) ; Get next UDB
JUMPE U,DEVTY2 ; or zero if hit end
CAME T,HOMSNM(U) ; Is it a STR?
JRST DEVTY4
MOVEI T1,$DVSTR ; Yep.
POPJ P, ; Return it
DEVTY4: CAME T,HOMLOG(U) ; How about a log unit within STR?
JRST DEVTY5
MOVEI T1,$DVLUN ; Yup
POPJ P,
CONT.
DEVTY5: CAME T,HOMHID(U) ; Would you believe a pack ID?
JRST DEVTY6 ; Nope.
MOVEI T1,$DVPID ; Uh-huh
POPJ P,
DEVTY6: MOVE T2,DRIVE(U) ; Now look at physical names
AND T2,T1 ; Mask it
CAME T,T2 ; Match?
JRST DEVTY1 ; No. No matches at all. Try next unit
MOVE T1,DRIVE(U) ; Yes. Get back drive name
CAME T,T1 ; Exact match?
JRST DEVTY7
MOVEI T1,$DVPHD ; Yes. Physical drive name
POPJ P,
DEVTY7: TRZ T1,-1 ; Get rid of drive number
CAME T,T1 ; Try again
JRST DEVTY8
MOVEI T1,$DVCON ; Match. Controller
POPJ P,
DEVTY8: TLZ T,77 ; Get rid of controller type
CAME T,T1
JRST DEVTY1 ; No match. Try another unit
MOVEI T1,$DVCNT ; Made it! Two letter cont. type
POPJ P,
; Here when done all units, and still no matches found
DEVTY2: SETO T1, ; Give error AC=-1
POPJ P,
; Subroutine to find a name in STRTAB
; Call T=SIXBIT name
; Ret+0 Not found
; Ret+1 T unaltered
; P1=Adr of match + 1
; U=(P1)= Adr of first unit UDB.
;
FNDSTR: MOVE P1,STRTAB ; Start looking at STRTTAB
FNDST1: SKIPLE U,(P1) ; Look at entry
AOJA P1,.-1 ; Wait for negative or zero
JUMPE U,CPOPJ ; If zero, hit end with no match
CAME T,U ; Minus. Must be a STR name
AOJA P1,FNDST1 ; But must be our name..
MOVE U,(P1) ; Adr unit 0 UDB
AOJA P1,CPOPJ1 ; and quit
; Subroutine to execute a given subroutine
; for U=each unit of STR.
; Call T=Address of subroutine
; Subroutine may destroy T..
; Must CPOPJ always, no skip returns please
DOALLU: MOVEI U,UNIDDB ; Start at beginning
HLRZ U,(U) ; and move up a unit
JUMPE U,DOALL1 ; Until hit the end.
PUSH P,T ; Save one valuable AC
PUSHJ P,(T) ; Go do something
POP P,T ; Restore AC
JRST DOALLU+1 ; and loop for each unit
DOALL1: HLRZ U,UNIDDB ; Set U=Unit 0
POPJ P, ; and return.
; Subroutine to determine if a structure is mounted
; Returns CPOPJ if it is,
; CPOPJ1 if it isn't
STRMNT: PUSH P,U ; Save current U
MOVEI U,UNIDDB ; Point at start of chain
STRMN1: HLRZ U,(U) ; Move to next unit
JUMPE U,UPOPJ1 ; Return not mounted at end
LDB T,[POINTR UNIDES(U),DC.STS] ; Get status for this unit
CAIE T,.DCSTN ; "Pack not mounted"?
JRST UPOPJ ; No, either mounted or down
JRST STRMN1 ; Loop for all units
; Subroutine to actually INIT a disk channel on channel STR.
; This is actually against RIPOFF philosophy, since
; we don't like to ask the monitor for UUO's when we can do them ourselfes.
; However, in some instances it pays to ask for help, such as DELFIL
; which tries monitor DELETE/RENAME first, then RIPOFF RENAME
; if that fails. Also /U code creates UFD's with monitor ENTERS.
INIDSK: TXOE F,F.INI ; Already INITed?
POPJ P, ; Yes. Forget it
MOVEI T,.IODMP
MOVE T1,USRSTR
SETZ T2,
OPEN STR,T
JRST NOSTR
POPJ P,
; Subroutine to release the STR channel INIT'ed by INIDSK
RLSDSK: TXZ F,F.INI
RELEAS STR,
POPJ P,
; Subroutine to read and verify home blocks on a unit
; Call with U=UDB address
; Ret+0 Home block error. Appropriate message typed
; on console.
; Ret+1 Home block in BUF
HOMCHK: JSP M,TTYOUT ; Turn on TTY I/O for this
MOVEI T1,LHOM1 ; Log address of first home block
MOVE T,IOW ; IOWD to buffer
MOVEI P4,DSK ; Adr. for channel core block
PUSHJ P,BLKRED ; Read 1st home block
JRST HOM3 ; Read error
MOVSI T,'HOM'
CAME T,BUF+HOMNAM
JRST HOM2 ; 1st is not SIXBIT 'HOM'
MOVEI T,CODHOM
CAME T,BUF+HOMCOD
JRST HOM2 ; 1st does not have proper code
MOVEI T,LHOM1
CAMN T,BUF+HOMSLF
JRST CPOPJ1 ; Looks OK now..
JRST HOM2 ; Not OK. Try 2nd home block
HOM3: SKIPA M,[[ASCIZ/
IOERR reading first HOME block /]]
HOM2: MOVEI M,[ASCIZ .First HOME block consistency error on .]
PUSHJ P,MSG
MOVE M,DRIVE(U)
PUSHJ P,PR6BIT ; Print unit here
PUSHJ P,CRLF
MOVEI T1,LHOM2 ; Try 2nd home block
MOVE T,IOW
PUSHJ P,BLKRED
JRST HOM4 ; IOERR
MOVSI T,'HOM'
CAME T,BUF+HOMNAM
JRST HOM5 ; 2nd fails too.
MOVEI T,CODHOM
CAME T,BUF+HOMCOD
JRST HOM5
MOVEI T,LHOM2
CAME T,BUF+HOMSLF
JRST HOM5
MOVEI M,[ASCIZ/Second HOME block is consistent. Error recovered/]
AOS (P) ; Give OK return
PJRST MSG
; Here if both home blocks in error.
HOM4: MOVEI M,[ASCIZ/IOERR 2nd HOME block/]
PJRST MSG
HOM5: MOVEI M,[ASCIZ/Second HOME block consistency error./]
PJRST MSGTTY
;Subroutine to read and verify BAT blocks on a unit
;Call with U=UDB address
;Ret+0 BAT block error. Appropriate message typed
; on console.
;Ret+1 BAT block in BUF
BATCHK: MOVEI T1,LHOM1+1 ;Log address of first BAT block
PUSHJ P,BAT9
CAIA
JRST CPOPJ1
MOVEI M,[ASCIZ /First BAT block is bad on /]
PUSHJ P,MSG
MOVE M,DRIVE(U)
PUSHJ P,PR6BIT ;Print unit here
PUSHJ P,CRLF
MOVEI T1,LHOM2+1 ;Try 2nd BAT block
PUSHJ P,BAT9
JRST BAT4
MOVEI M,[ASCIZ /Second BAT block is consistent. Error recovered/]
AOS (P) ;Give OK return
PJRST MSG
;Here if both BAT blocks in error.
BAT4: MOVEI M,[ASCIZ /Second BAT block is bad/]
PJRST MSG
;HERE TO READ BAT BLOCK
;T1 PASSES BLOCK NUMBER OF WHICH BAT TO READ
;NOSKIP IF ERROR OR INCONSISTANT
;SKIP IF OK
BAT9: TXZ F,F.CSUM+F.DERR ;JUST TO BE SURE
SETZM NOIO
MOVE T,IOW ;IOWD to buffer
MOVEI P4,DSK ;Adr. for channel core block
PUSHJ P,BLKRED ;Read BAT block
POPJ P, ;Read error
MOVS T1,BUF+BAFNAM ;Test consistency
MOVE T2,BUF+BAFCOD
CAIN T1,'BAT'
CAIE T2,CODBAT
POPJ P,
JRST CPOPJ1 ;Looks OK
; Subroutine to verify a RIB block in BUF.
; Call T1=Log block in unit of RIB
; If F.RIB not set in LH(F),
; FNAME(P4)=File name
; FEXT(P4)=Extension
; FPPN(P4)=PPN
; If F.RIB is set,
; Check on file names not made,
; name need not be set up (P4)
;
; Ret+0 RIB error
;
RIBCHK: MOVE T,T1
IDIV T,STRBPU
CAME T1,BUF+RIBSLF ; Must agree.
POPJ P,
RIBCK0: MOVEI T,CODRIB
CAME T,BUF+RIBCOD ; Code word in RIBCOD
POPJ P,
TXZE F,F.RIB ; Check file names??
JRST RIBCK2 ; No. Skip this
MOVE T,FPPN(P4)
CAME T,BUF+RIBPPN ; PPN's must match
POPJ P,
MOVE T,FNAME(P4)
CAME T,BUF+RIBNAM ; along with file names
POPJ P,
HLLZ T,FEXT(P4)
HLLZ T1,BUF+RIBEXT
CAME T,T1 ; and file extensions.
POPJ P,
RIBCK2: HRRZ T,BUF+RIBFIR ; # of retrvl ptrs. Must be valid
CAIG T,BLKSIZ-2
SKIPL BUF+RIBFIR ; and must also be negative
POPJ P,
JRST CPOPJ1 ; Yup. This looks like a real RIB!
; Subroutine to set up a search mask for a name.
; Call T=Name
; Return T unchanged,
; T1=mask
MSKUNI: SKIPN T1,T ; Get name
POPJ P, ; Not a name - Return mask=0
MOVSI T2,770000 ; Set up one char mask
UNIMS1: TDON T1,T2 ; This char zero?
JRST UNIMS2 ; Yes. Have mask
LSH T2,-6 ; No. Shift & try next char
JUMPN T2,UNIMS1
UNIMS2: TDZ T1,T2 ; Zero the last byte
POPJ P, ; and return mask in T1
SUBTTL LOCK UUO routines
; Subroutine to do LOCK UUO.
; Will try 8 times every 2 seconds...
; Ret+0 Failed in 16 seconds
; Ret+1 Made it... both segments locked
LOCKUUO: MOVEI N1,10 ; 8 tries
LOCKU1: MOVE N,ONEONE
LOCK N, ; Try to lock
SKIPA
JRST CPOPJ1 ; Got it. Return
SOJLE N1,CPOPJ ; Too many failures, forget it
HRRZS N ; Get the error code
TRNN N,777776 ; If it is 0 or 1,
POPJ P, ; Then forget it
MOVEI N,2
SLEEP N, ; Sleep a while
JRST LOCKU1 ; and try again
; Subroutines to do STRUUO functions
; Call PUSHJ P,LOKSTR ; To lock USRSTR
; PUSHJ P,REMSTR ; To remove it... zap.
;
; Ret+0 UUO error. Can't do it. Error msg typed.
; Ret+1 Got it.
LOKSTR: SKIPA T,[.FSLOK] ; Set for lock
REMSTR: MOVEI T,.FSREM ; Set for remove
UUOSTR: MOVEM T,UUOFNC
UUOST0: MOVE T,UUOFNC
MOVE T1,USRSTR
MOVEI N,T
STRUUO N, ; Attempt UUO
SKIPA
JRST CPOPJ1 ; Got it!
CAIE N,FSUNC% ; Cant complete it?
JRST .+4
MOVEI T,1 ; No, sleep a second
SLEEP T,
JRST UUOST0 ; and try again
JSP M,TTYOUT ; Other error, report failure
MOVEI M,[ASCIZ/
STRUUO error on /]
PUSHJ P,MSG
MOVE M,USRSTR
PUSHJ P,PR6BIT
MOVEI M,[ASCIZ/ function /]
PUSHJ P,MSG
MOVE N,UUOFNC
PUSHJ P,OCTPRT
SETO T,
PUSHJ P,ERRPNT
PJRST CRLF
U(UUOFNC)
SUBTTL UUO level routines
; Subroutine to do a 'LOOKUP' or 'ENTER' UUO
; Call
; T=File name
; T1=File extension
; T2= +CFP or -log. block in STR
; T3=PPN or path pointer
; P4=Channel block address
;
; Ret+0 Error code in T1 and BUF+EXLERC
; Ret+1 File found, RIB left in BUF
;
ENTR: TLOA P4,1 ; Flag entry point
LOOKP: TLZ P4,1
MOVEM T,FNAME(P4) ; Store name,
MOVEM T1,FEXT(P4) ; Extension,
MOVEM T2,RIBLBN(P4) ; RIB address
TLNN T3,-1 ; PPN or path pointer?
JRST LOOKP2 ; Path pointer
MOVEM T3,TMPPTH+.PTPPN; Save the PPN in temporary path block
SETZM TMPPTH+.PTPPN+1 ; Insure zero word terminator
MOVEI T3,TMPPTH ; and point to the block
LOOKP2: HRLZI T3,(T3) ; Move path pointer to left half
HRRI T3,FPATH(P4) ; Make BLT pointer to FPATH
BLT T3,FPATH+.PTPPN+1+SFDLVL+1-1(P4) ; Move path to core block
SKIPL T,T2 ; If RIB address positive,
PUSHJ P,CFP2BK ; must be CFP, not block
SKIPGE RIBLBN(P4) ; Block or CFP?
MOVN T,RIBLBN(P4) ; Block. Get it.
MOVEM T,RIBLBN(P4) ; and store T=log block in STR of RIB
MOVE T1,T
MOVE T,IOW ; T1=Block now, and T=IOWD
MOVX T2,IO.FAC ; Set internal bits now
MOVEM T2,IOSTS(P4)
PUSHJ P,STRRED ; Go read the block
JRST LKER6 ; Can't read RIB??
MOVE T1,RIBLBN(P4) ; Get back RIB address
PUSHJ P,RIBCHK ; Validate RIB
PJRST LKER6 ; Not a good RIB..
PUSHJ P,PTRCPY ; Copy some retrieval ptrs
SETOM RIBFLG(P4) ; Set flag for reading first RIB
MOVE T,BUF+RIBSTS ; File status bits
MOVEM T,FILSTS(P4) ; Set channel file status
PUSHJ P,SETBUF ; Go fix up data buffers
MOVE T,BUF+RIBSIZ ; Size of file
ADDI T,BLKSIZ-1 ; Pad up to next block
IDIVI T,BLKSIZ ; Convert to blocks
MOVEM T,FILEN(P4) ; and remember so we know EOF...
LOOKP1: TLZN P4,1 ; Is this an ENTER?
JRST CPOPJ1 ; No. LOOKUP is done.
MOVX T,IO.WRT ; Yes. Set writing bit
ORM T,IOSTS(P4)
MOVI BLKSIZ+1,WDCNT(P4); Change BUFRED logic a little. Blocks
; are empty after 200 words, not before.
MOVI DATBUF(P4),DATPTR(P4) ; and set up pointer
JRST CPOPJ1 ; OK. He's all set up now.
; Here on RIB error
LKER6: PUSHJ P,ECRLF
MOVEI M,[ASCIZ/File /]
PUSHJ P,MSG
PUSHJ P,CHNPNT
MOVEI M,[ASCIZ/ RIB error /]
SETZM ERRFL ; Dont need CONI bits and status
PUSHJ P,DEVER1 ; and complain
HRRI T1,ERTRN% ; Bad RIB!!
HRRM T1,BUF+EXLERC ; Ret error code in BUF too.
POPJ P,
; Subroutine to do LOOKUP UUO on USRNAM,USREXT,USRPPN
USRLOK: MOVPTH USRPTH,TMPPTH ; Move path to where we can diddle it
MOVE T,CURLVL ; Get current level of nesting
SETZM TMPPTH+.PTPPN+1(T) ; Insure zero terminator
MOVE T,USRNAM ; Get filename
HLLZ T1,USREXT ; and extension
MOVE T2,USRCFP ; and CFP
MOVEI T3,TMPPTH ; Point to path block
MOVEI P4,DSK ; Point to DSK core block
PJRST LOOKP ; Do it
; Subroutine to compute folded checksum of a word
; Call with (T) = word for which to compute checksum,
; (M) = checksum byte pointer from HOM block
; RET+0 always with (T2) = checksum
CHKSUM: HRRI M,T ; Make byte pointer point to T
LDB T1,[POINT 6,M,11] ; Get byte width from pointer
MOVNS T1 ; T1 = -byte width of checksum
TLZA M,770000 ; M = POINT width,T,35
CHKSU1: ADD T,T2 ; Add byte into remainder of word
LDB T2,M ; Get next byte
LSH T,(T1) ; and shift it out
JUMPN T,CHKSU1 ; Continue until done
POPJ P, ;
; Subroutine to try a RENAME UUO.
; Call P4=Channel adr of level to be modified
; C(BUF)= New RIB, BUF+RIBNAM=0 indicates delete, not rename
; As in monitor RENAMEs, LOOKUP must have been
; previously done to set up data..
;
; Ret+0 Couldn't delete it for some strange reason
; Ret+1 File RIPped OFF
;
; Most AC's guaranteed to be destroyed...
RENAM: SKIPN BUF+RIBNAM ; Deleting file?
JRST RENAM0 ; Yes. No need to change RIB
MOVE T,IOW ; Transfer word points to BUF
MOVE T1,RIBLBN(P4) ; Get block # of first RIB
PUSHJ P,STRWRT ; Go write over it
JFCL ; Well shit.
; Here to re-write a new UFD
RENAM0: MOVEI T,0 ; Offset into core block table
RENAM3: SKIPN CORBLK(T) ; Hit end yet?
JRST CPOPJ ; Yes, and no match, error
CAME P4,CORBLK(T) ; Pointing to this core block?
AOJA T,RENAM3 ; No, loop for rest
MOVE P1,DATPTR(P4) ; Pointer to data
SUBI P1,2 ; -2=Ptr to this UFD
SKIPE T,BUF+RIBNAM ; Skip if deleting file
JRST RENAM1
HRLI T,2(P1)
HRRI T,0(P1)
BLT T,DATBUF+BLKSIZ-3(P4) ; Move entire UFD down over this entry
SETZM DATBUF+BLKSIZ-2(P4) ; Clean up ends
SETZM DATBUF+BLKSIZ-1(P4)
JRST RENAM2 ; and go write block
RENAM1: MOVEM T,(P1) ; Put new name in UFD
HLLZ T,BUF+RIBEXT
HLLM T,1(P1) ; and new ext (leave CFP undisturbed)
SKIPA ; Done. Change DATPRT if just rename
; (not delete)
RENAM2: MOVEM P1,DATPTR(P4) ; Restore possibly changed pointer
MOVE T,XIOWD(P4) ; IOWD for transfer
MOVE T1,THISBL(P4) ; Block to overwrite
MOVE U,THISU(P4)
PJRST BLKWRT
; Subroutine to delete a file.
; Monitor LOOKUP-RENAME tried first, if anything goes wrong,
; file gets RIPped-OFF!
; Returns value of UBLKCT=number of blocks in file, unless
; LOOKUP fails or RIPOFF RENAME called in, set to -1.
; If F.DBAD set, delete only if file has monitor LOOKUP/ENTER failure
DELFIL: PUSHJ P,INIDSK ; Make sure we got a disk
MOVPTH USRPTH,TMPPTH ; Move path to where we can diddle it
MOVE P4,CURLVL ; Get current level of nesting
SETZM TMPPTH+.PTPPN+1(P4) ; Insure correct zero terminator
MOVE T,USRNAM ; Get filename
HLLZ T1,USREXT ; and ext
SETZ T2, ; Third word in LOOKUP is zero
MOVEI T3,TMPPTH ; Point to path block
MOVE P4,CORBLK(P4) ; Point to correct core block
SETZM BUF+RIBNAM ; Flag to RENAM in case of failure
LOOKUP STR,T ; First try a LOOKUP so monitor sets tables
JRST DELFI1 ; LOOKUP fails, definitely delete it
TXZE F,F.DBAD ; File OK. Delete only bad ones?
POPJ P, ; Yes. this file ok. dont delete
JRST DELFI3 ; Skip error checks
DELFI1: HRRZ T,T1 ; Get error code from LOOKUP
CAIN T,ERFNF% ; File not found?
POPJ P, ; Yes, can't delete what aint there
DELFI3: HLRE T,T3 ; Get +blocks or -words
JUMPGE T,DELFI2 ; Blocks. OK
MOVMS T ; + words
ADDI T,BLKSIZ-1 ; Round up to next block
IDIVI T,BLKSIZ ; Convert to blocks
DELFI2: MOVEM T,UBLKCT ; Remember blocks length of file.
SETZB T,T1
RENAME STR,T ; and try to delete it
SKIPA ; Can't
JRST CPOPJ1 ; Excellent, excellent.
SETOM UBLKCT ; Don't know file size
DELFI4: TXNE F,F.MDEL ; Want only monitor RENAME?
POPJ P, ; Yes, that's it
PJRST RENAM ; Go RIP it OFF
; Here to delete a UFD.. Same call as DELFIL.
DELUFD: PUSHJ P,INIDSK ; Get a disk
PUSHJ P,SETUFD ; Set up UUOBLK
POPJ P, ; Path exhausted
LOOKUP STR,BUF ; Look for it
JFCL
SETZM BUF+RIBNAM
MOVEI P4,MFD
RENAME STR,BUF
JRST DELFI4 ; Setup and then call RENAM
JRST CPOPJ1 ; Got it!
; Subroutine to delete a file. Exactly like DELFIL,
; except monitor LOOKUP/RENAME not even tried. File
; Gets RIPped OFF no matter what. SATs are not updated.
; Not really a recommended subroutine, however, much
; faster than DELFIL.. Much.
RIPFIL: PUSHJ P,USRLOK ; Look up file first
JRST RIPFI1 ; Not there. Bad.
TXZE F,F.DBAD ; OK. Only delete not OK ones?
POPJ P, ; Yes. Better leave this one alone
SKIPA T,BUF+RIBALC ; No. T=# of blocks allocated
RIPFI1: SETO T, ; or -1 on lookup failure
MOVEM T,UBLKCT
MOVE P4,CURLVL ; Get current level of nesting
MOVE P4,CORBLK(P4) ; and pointer to core block
SETZM BUF+RIBNAM
PJRST RENAM ; Go zap this file too.
; Subroutine to do buffered input, binary mode (e.g., returns one word each call)
; or allow dump mode input, IOWD in XIOWD+CHN'BLK
; Call DMPIN for dump, BUFRED for buffered
; P4=Channel adr.
; F.LEN set to ignore file length and give EOF return only
; when RIB pointers are exhausted
; Ret+0 EOF
; Ret+1 Word in AC 'CH'
;
; Note: There are no INITs and a channel doing buffered I/O
; can switch to dump at any time. If the buffered
; I/O was in the middle of a block, that block is lost
; and I/O proceeds with the next block.
BUFRED: TLZA P4,1 ; Flags dump I/O
DMPIN: TLO P4,1
JSP M,BUFSAV ; Save most AC's
TLNE P4,1 ; Dump or buffered?
JRST BUFRD5 ; Ignore word count in dump mode
SOSLE WDCNT(P4) ; Any room left in core?
JRST BUFRD2 ; Yep.
BUFRD5: SOSGE FILEN(P4) ; File still got blocks left?
TXNE F,F.LEN ; Ignore that fact?
JRST .+2 ; Yes don't give EOF return
JRST BUFEOF ; No. Give EOF ret now
TXZ F,F.CSUM ; Assume not first block in group
IGNORE: SOSLE BLKCNT(P4) ; Another contigious block in group?
JRST BUFRD3 ; Yes.
MOVE U,THISU(P4) ; Get last unit
PUSHJ P,GETPTR ; No. Get next RIB pointer
JUMPE P1,BUFEOF ; Done if no more pointers
TXZE F,F.NEWR ; GETPTR find an extended RIB?
SETOM RIBFLG(P4) ; Yes, flag it as such
MOVEM P2,CLSCNT ; Remember # of clusters here.
IMUL P2,STRBPC ; P2=# of contigious blocks
MOVEM P2,BLKCNT(P4)
LDB T1,STRCLP ; T1=cluster address
MOVE P2,T1 ; Save it in P2 for CLSCHK
IMUL T1,STRBPC ; Convert to blocks
MOVEM T1,THISBL(P4) ; Remember block #
MOVEM U,THISU(P4) ; and the unit it came from.
SKIPLE FILEN(P4) ; Don't checksum if no more blocks
TXO F,F.CSUM ; Checksum first block in group.
HRRZ T,P4
CAIN T,DSK ; On channel DSK?
TXNN F,F.OURS!F.TRB ; Yes. Need to check SATs?
JRST BUFRD1 ; No to either. Skip it.
BUFRD6: MOVE T,P2 ; T=cluster number
PUSHJ P,CLSCHK ; Check it.
JFCL
SOSLE CLSCNT ; Loop for all clusters in group
AOJA P2,BUFRD6
BUFRD1: AOSG RIBFLG(P4) ; Was this a RIB (set by LOOKP)?
JRST IGNORE ; Yes. Ignore it
MOVE T1,THISBL(P4) ; No. Get back block number
; Here with T1=block on unit, U=unit
BUFRD4: MOVE T,IOSTS(P4)
TXNE T,IO.WRT ; Writing this file?
SETOM NOIO ; Yes. Don't bother to read then
MOVX T,RIPABC
TDNE T,FILSTS(P4) ; File always have bad checksum?
TXZ F,F.CSUM ; If yes, dont try to.
MOVE T,XIOWD(P4) ; T:=IOWD for moving data into core
PUSHJ P,BLKRED ; Go read block
JFCL ; Ignore error for now.
MOVE T,IOSTS(P4) ; Are we really reading?
TXNN T,IO.WRT ; ??
JRST BUFRD7 ; Yes. Keep what we got.
PUSHJ P,REWRITE ; No. Were really writing
JFCL
; Here when data in core, reset pointers
BUFRD7: TLNE P4,1
JRST BUFRD2 ; Ignore these in dump I/O
MOVI BLKSIZ,WDCNT(P4) ; Reset # of words left counter
MOVI DATBUF(P4),DATPTR(P4) ; and pointer to data word
; Here if all ptrs OK, data in core.
BUFRD2: TLZE P4,1
POPJ P, ; Thats all for dump I/O
MOVE CH,SAVECH ; Restore CH in case writing
; (saved at entry by BUFSAV)
MOVE T,IOSTS(P4) ; Check status to see if
TXNE T,IO.WRT ; Reading or writing.
MOVEM CH,@DATPTR(P4) ; Store CH if writing
MOVE CH,@DATPTR(P4) ; Load CH if reading
AOS DATPTR(P4) ; Increment pointer
JRST CPOPJ1 ; and return to caller
; Here if next block contigious, dont need to read RIB ptrs
BUFRD3: AOS T1,THISBL(P4) ; Set to read disk block after last
MOVE U,THISU(P4) ; On same unit
JRST BUFRD4
; Here on EOF (FILEN ran out or zero pointer)
; set a few bits
BUFEOF: MOVE T,IOSTS(P4)
TXO T,IO.EOF ; Set EOF bits
TXZ T,IO.FAC ; and zero active bit
MOVEM T,IOSTS(P4)
SETZM NOIO ; In case he had set it
POPJ P, ; and give error ret
; Subroutine to output (re-write) last block just read on channel
; by DMPIN (or current block by BUFRED).
; Call P4=channel address...
;
; Ret+0 Didn't succeed...
; Ret+1 OK. Block ripped off.
;
REWRIT: JSP M,BUFSAV ; Save the AC's
MOVE T1,THISBL(P4) ; Get current (last) block
MOVE U,THISU(P4) ; and unit
MOVE T,XIOWD(P4) ; and new iowd to new data
PJRST BLKWRT ; Zap!
; Subroutine to get next real ptr from core block
; Call P4=Addr of core block
; U=Last unit (incase no change of unit pointer)
; Return+0 always with:
; P1=Retrieval ptr or 0 if no more ptrs
; P2=Cluster count
; U=UDB address
; F.NEWR set in RH(F) if RIB pointers are extended
;
GETPTR: TXZ F,F.NEWR ; Zero this flag on every entry
MOVEI P1,10 ; Number of times to retry on ill unit
MOVEM P1,TEMP
GETPT1: SETZ P1,
SKIPL P2,SAVRIB+RIBFIR(P4) ; P2:=Adr of next pointer
JRST GETPT2 ; No more pointers
MOVE P1,(P2) ; P1:=pointer
AOBJN P2,.+1
MOVEM P2,SAVRIB+RIBFIR(P4) ; Adr of next pointer for next time
GETPT2: LDB P2,STRCNP ; P2:= Cluster count
JUMPN P2,CPOPJ ; Done if non-zero
TXZN P1,RIPNUB ; Skip if new unit ptr
JRST GETPT4 ; EOF pointer. Done now.
HRRZ U,P1 ; Set U=new unit
CAMLE U,HIGHU ; Within bounds?
JRST GETPT3 ; Illegal unit
MOVE U,STRUNI(U) ; Set U:=New unit UDB
JRST GETPT1 ; and try again
; Here on EOF. All pointers done. Check for extended RIBs.
GETPT4: SKIPN SAVXRA(P4) ; Got an extended RIB?
JRST GETPT5 ; No. Set P2=0 and return
LDB U,DEYRBU ; Get unit number from RIBXRA
MOVE U,STRUNI(U) ; U=UDB for this unit
LDB T1,DEYRBA ; Get cluster address within unit
IMUL T1,STRBPC ; Convert to blocks
MOVE T,IOW ; T=IOWD to BUF, read extended RIB
PUSHJ P,BLKRED ; Go read a new RIB
JRST GETPT5 ; Hmm.
PUSHJ P,PTRCPY ; Copy them into core block
TXO F,F.NEWR ; Tell caller I extended ptrs
JRST GETPT1 ; and continue as if nothing happened.
; Here on illegal unit
GETPT3: MOVEI M,[ASCIZ/
Illegal unit in RIB pointer file /]
PUSHJ P,EMSG
PUSHJ P,CHNPNT
MOVEI M,[ASCIZ/
pointer = /]
PUSHJ P,EMSG
TXO P2,RIPNUB
MOVE N,P2
PUSHJ P,OCTL12
MOVEI M,[ASCIZ/ = unit /]
PUSHJ P,MSG
MOVE N,U
PUSHJ P,OCTPRT
SOSLE TEMP ; Tried 10 times already?
JRST GETPT1 ; No. Try to get another pointer
MOVEI M,[ASCIZ/
Too many illegal unit pointers, EOF exit taken
/]
PUSHJ P,EMSG
PUSHJ P,ECRLF
GETPT5: SETZB P1,P2 ; Clear P1 and P2 and exit
POPJ P,
; Subroutine to copy retrieval ptrs into core block
; Arg P4=Addr of core block
PTRCPY: MOVE T,BUF+RIBFIR
MOVEM T,SAVRIB+RIBFIR(P4) ; Store ptr to ptrs
HRLZI T1,BUF(T) ; T1=Address of ptrs in BUF ,, 0
HRRI T1,SAVRIB+1(P4) ; Set to transfer them to SAVRIB
BLT T1,SAVRIB+BLKSIZ-RIBENT-1(P4)
MOVEI T1,SAVRIB+1(P4) ; First ptr is now at SAVRIB+1
HRRM T1,SAVRIB+RIBFIR(P4) ; So make ptr to ptrs right
SETZM SAVXRA(P4)
HRRZS T ; First word in RIB had ptr to ptrs
CAIG T,RIBXRA ; Is this RIB old format?
POPJ P, ; Yes. Before extended ribs.
MOV BUF+RIBXRA,SAVXRA(P4) ; No. Store XRA (may still be zero)
POPJ P,
; Subroutines to read one word from disk, UFD, MFD, or SFD
; Call PUSHJ P,R.xxx
; EOF return
; Normal return here
;
R.MFD: MOVEI P4,MFD
PJRST BUFRED
R.UFD: MOVE P4,CURLVL ; Get current level
SKIPA P4,CORBLK(P4) ; Get core block to use
R.DSK: MOVEI P4,DSK
PJRST BUFRED
W.DSK==R.DSK ; To write, we use same code, but caller
W.UFD==R.UFD ; Sets IO.WRT bit first so we know.
DEFINE X (N),
< EXP SFD'N >
;
; The following table gives the core block addresses that
; correspond to each level of nesting.
;
EXP MFD
CORBLK: EXP UFD
I=1
REPEAT SFDLVL,
< X (\I)
I=I+1 >
EXP 0
; Subroutine to do CLOSE UUOs
C.DSK: MOVEI CH,0 ; Write zeroes
PUSHJ P,W.DSK
POPJ P, ; Until the EOF occurs
JRST C.DSK
C.UFD: MOVEI CH,0
PUSHJ P,W.UFD
POPJ P,
JRST C.UFD
; Subroutine to convert a CFP in AC T
; Returns logical block number in T,
; Relative block in unit in T1,
; U=Unit UDB address
; T=-1 if illegal unit.
CFP2BK: IDIV T,HOMSCU(U) ; T=Unit,T1=Supercluster in unit
CAMLE T,HIGHU ; Above top?
JRST CFP2B2
MOVE U,STRUNI(T) ; U=Unit UDB
IMUL T1,HOMBSC(U) ; T1=Block in unit
IMUL T,STRBPU ; T=# of first block on unit
ADD T,T1
POPJ P,
CFP2B2: SETO T,
POPJ P,
SUBTTL Lowest level disk I/O routines
; Subroutine to read or write one disk block
; Call T=IOWD to data, T1=block on unit, U=Unit UDB address,
; P4=Channel core block address
;
; Ret+0 I/O Errors. Full error diagnostic is printed at this level.
; Ret+1 Block read/written OK.
;
; Call with F.CSUM set to checksum block and compare to checksum
; in retrieval pointer in P1. Checksum error does not
; cause ret+0, but IO.CKS set in LH of IOSTS word.
;
; Call with F.DERR set if you expect to get hard read error. This
; causes error message to be suppressed (error flags still return
; error condition). Expressely for SYSINI to determine disk pack
; type by trying to read too large a block for various packs.
; Flag is reset to 0 every time.
;
; Call with NOIO = -1, and the actual I/O operation will be suppressed,
; (both USETI/O and INPUT/OUTPUT - CURPOS left unchanged)
;
; T,T1 destroyed, F.IO reset to 0 if reading(BLKRED), 1 if writing(BLKWRT)
BLKRED: TXZA F,F.IO ; Set reading
BLKWRT: TXO F,F.IO ; Set writing
BLKRD0: TXZ F,F.TRY ; We try all I/O twice
BLKRD1: MOVEM T,TIOW ; Get an immidiate AC and save IOWD
JUMPL T1,TOBIG ; Negative blocks not nice.
CAML T1,BLKUNI(U) ; Must be on unit..
JRST TOBIG ; Not. Fake IO.BKT...
SKIPGE NOIO ; Need real I/O?
JRST BLKRD4 ; No, skip USETX, I/O
AOS T,CURPOS(U) ; Bump last block positioned to
CAMN T,T1 ; Trying to read last block+1?
JRST BLKRD2 ; Yes. No USETI/O required
MOVEM T1,CURPOS(U) ; No. Reset new position
MOVE T,XCHAN(U) ; Get proper channel
SKIPN %SUSET ; Use SUSET.?
JRST BLKRD6 ; No. Skip this
HLLZS T ; Clear right half (was Z CHN,T)
IOR T,T1 ; Yes. Add in block number
TXNE F,F.IO ; Reading?
TXO T,SU.SOT ; Writing. Set bit
SUSET. T, ; Do UUO.
JRST DIE001 ; God!!!!
JRST BLKRD2 ; Skip USETI/O stuff
; Here to position using USETI/USETO
BLKRD6: ; Use super USETI/USETO
TXNN F,F.IO
TLOA T,(USETI) ; Set for reading or writing
TLO T,(USETO)
HRRI T,T1
XCT T ; USETx CHN,T1
;
; Here when unit in position, read block
BLKRD2: MOVE T,XCHAN(U)
TXNN F,F.IO
TLOA T,(IN) ; Prepare for IN or OUT-put
TLOA T,(OUT)
SKIPA
PUSHJ P,[ SKIPGE WENABLE
POPJ P,
MOVEI M,[ASCIZ/Write enable?/]
PUSHJ P,OPER
JRST DIE002
SETOM WENABLE
POPJ P, ]
HRRI T,TIOW
SETZM TIOW+1
XCT T ; IN CHN,TIOW
TXZA F,F.TMP ; Got it!
TXO F,F.TMP ; Bad block..
PUSHJ P,GETUST ; Get units status now
TXZN F,F.TMP ; Read succeed??
JRST BLKRD4 ; Yes. Go process data.
; Here on error in I/O transfer. Print msg, reset status and exit
; but always try twice before quitting (F.TRY)
MOVE T1,XCHAN(U)
TLO T1,(GETSTS)
XCT T1 ; GETSTS CHN,T
HRRM T,IOSTS(P4) ; Save it
TXZ T,IO.ERR!IO.EOF ; Reset error flags
HLL T,XCHAN(U)
TLO T,(SETSTS)
XCT T ; SETSTS CHN,BITS
TXON F,F.TRY ; Tried once already?
JRST BLKRD5 ; No. Try again
TXZE F,F.DERR ; Yes. Expecting this?
POPJ P, ; Yes. Return now
SETOM ERRFL ; Print entire error status and CONI
SOS ERRFL
PJRST DEVERR ; No. Go print error msg and return
BLKRD7: TXO F,F.CSUM ; Turn checksum bit back on
BLKRD5: MOVE T,TIOW ; Prepare to try again
MOVE T1,CURPOS(U) ; Set position request
JRST BLKRD1 ; and try one more time
; Here when we got the data, now process it before returning
BLKRD4: TXZ F,F.DERR ; Reset flag in case set
MOVX T,<IO.CKS!IO.ERR>
ANDCAM T,IOSTS(P4) ; Clear all error bits
AOSLE NOIO ; Supposed to read?
TXZN F,F.CSUM ; Yes. Supposed to checksum it?
JRST CPOPJ1 ; No. Return to him now.
MOVE T,TIOW
MOVE T,1(T) ; T=Word to checksum
SKIPN M,STRCKP
JRST CPOPJ1 ; Might be a unit not in a STR.
PUSHJ P,CHKSUM ; Compute checksum
LDB T1,STRCKP ; Get checksum from ptr
CAMN T1,T2 ; Equality?
JRST CPOPJ1 ; Yep. Got it now.
MOVX T,IO.CKS ; No. Light err bit
ORM T,IOSTS(P4)
TXON F,F.TRY ; Tried once already?
JRST BLKRD7 ; No. Try again
SETOM ERRFL ; Don't give CONI stuff
AOS (P) ; Yes. Give skip return anyway
PJRST DEVERR ; and give error msg
; Subroutine to read or write a disk block relative to structure
; Call Identical to BLKRED/WRT, except T1=block on STR
STRRED: TXZA F,F.IO
STRWRT: TXO F,F.IO
CAML T1,STRHGH ; Must be within STR...
JRST TOBIG
IDIV T1,STRBPU
MOVE U,STRUNI(T1) ; Unit number within STR
MOVE T1,T2 ; Remainder = block on unit
JRST BLKRD0 ; Go read it.
; Here if block too large for unit, simulate IO.BKT error
TOBIG: MOVEI T,IO.BKT
ORM T,IOSTS(P4) ; Set IO.BKT bit in IOSTS
PUSHJ P,GETUST ; Reset unit status
SETOM ERRFL ; Print entire status plus CONI
SOS ERRFL
PJRST DEVERR
; Subroutine to get a unit's CONI status
GETUST: LDB T,[POINT 4,XCHAN(U),12] ; Get channel number
DEVSTS T, ; Ask monitor for CONI
SETZ T, ; If error, use zero
MOVEM T,UNISTS(U) ; Set status
POPJ P,
SUBTTL Assorted disk support routines
; Subroutine to find a disk block.
; Call P1=Relative address in block of key word
; P2=Contents of key word
; SETBLK=Block-increment to start search with, i.e.,
; SETBLK+T4 = First block to start search with
; U=UDB first unit to begin search
; T4=Number of blocks to increment SETBLK for each read
;
; If SATFLG = 0, every T4 blocks are read.
; SATFLG >0, ignore blocks not set in DSKSAT
; i.e., read only if marked in SAT
; SATFLG <0, ignore blocks set in DSKSAT,
; i.e., read only if free blocks
;
; Ret+0 Entire STR searched, no match found
; Ret+1 SETBLK=Address of block
; U=Unit UDB
;
SEARCH: ADDM T4,SETBLK ; Increment SETBLK first thing
MOVE T1,SETBLK ; T1=New block to search
CAML T1,BLKUNI(U) ; Still in unit?
JRST SRCH3 ; No. Try next unit
SKIPN SATFLG ; Want to check SATs?
JRST SRCH2 ; No. Forget it
PUSH P,T1 ; Save T1
IDIV T1,STRBPC ; Convert to clusters
MOVE T,DSKSAT(U) ; T=Address of SAT table
PUSHJ P,TSTONE ; See if set
SKIPA T,[SKIPL SATFLG] ; Skip if want to read instn.
MOVE T,[SKIPG SATFLG] ; Also instn for skip if want to read
POP P,T1 ; Restore T1
XCT T ; Well, do we read it?
JRST SEARCH ; No. Ignore the block.
SRCH2: MOVE T,IOW ; Yes. Read it now
PUSHJ P,BLKRED ; Go read it
JRST SEARCH ; Ignore it if cant
CAMN P2,BUF(P1) ; Match?
JRST CPOPJ1 ; Yes. Got it!
JRST SEARCH ; No match, try again
SRCH3: HLRZ U,(U) ; Try the next unit
SETZM SETBLK ; Start at block zero
JUMPN U,SEARCH ; and try again.
POPJ P, ; Unless no more units, exit
; Subroutine to make a user UFD/SFD
; Call USRPPN/USRPTH=Path to create one for
;
; Special kludge - Call MAKUF1 to create UFD/SFD in buffered mode.
; Will not change channel status with release or inits.
; (this specifically for /I code to make UFD's with)
;
; Ret+0 Can't. Error message given
; Ret+1 Got it. STR INITed and not released.
MAKUFD: PUSHJ P,INIDSK ; Get a disk
MAKUF1: PUSHJ P,SETUFD ; Setup BUF for UUO
POPJ P, ; Path exhausted, return
MOV BIGNUM,BUF+RIBQTF ; Set all quotas to infinity
MOVEM T,BUF+RIBQTO
SETZM BUF+RIBUSD ; No blocks used by user yet
MOV <[RIPLOG!RIPDIR]>,BUF+RIBSTS ; This is a directory bit
MOV UFDPRT,BUF+RIBPRV ; Set UFD privelliges
CLOSE STR, ; Just in case
ENTER STR,BUF ; Do it, mac!
JRST MAKUF2 ; ENTER failed. Forget it
CLOSE STR,
STATO STR,IO.ERR ; All ok?
JRST CPOPJ1 ; Yup. Got one now.
MAKUF2: JSP M,TTYOUT
PUSHJ P,CRLF
PUSHJ P,UFDPNT
MOVEI M,[ASCIZ/ UFD creation error: /]
PUSHJ P,MSG
HRRZ N,BUF+EXLERC
PUSHJ P,OCTPRT
PJRST CRLF2
; Subroutine to setup BUF for extended LOOKUP/ENTER on UFD/SFD
; Assumes that USRPPN/USRPTH/CURLVL point to current UFD/SFD
; Ret+0 if path exhausted
; Ret+1 if path setup in BUF
SETUFD: PUSHJ P,ZROBUF ; Zero entire UUO block
MOVI EXLLEN,BUF+RIBFIR ; Set arg length
MOVE T,USRPTH+.PTPPN ; Get PPN
SKIPE CURLVL ; Still in PPN?
JRST SETUF3 ; Nope, handle path special
MOVEM T,BUF+RIBNAM ; Store PPN as name
MOVSI T,'UFD'
MOVEM T,BUF+RIBEXT ; Extension = 'UFD'
MOV MFDPPN,BUF+RIBPPN ; PPN=MFD
JRST CPOPJ1 ; Good return
SETUF3: MOVSI T,USRPTH ; Get path from here
HRRI T,TMPPTH ; and move it to here
BLT T,TMPPTH+.PTPPN+1+SFDLVL+1-1 ; Move path block
MOVEI T,TMPPTH
MOVEM T,BUF+RIBPPN ; Set up pointer to path block
MOVSI T,'SFD' ;
MOVEM T,BUF+RIBEXT ; and extension
MOVE T,CURLVL ; Get level of SFD nesting
PUSH P,TMPPTH+.PTPPN(T) ; Save current SFD name
SETZM TMPPTH+.PTPPN(T) ; and make this the last word of path
POP P,BUF+RIBNAM ; File to create
SKIPE BUF+RIBNAM ; Anything there?
AOS (P) ; Yes, give good return
POPJ P, ; and return
; Here to set up core blocks for data I/O.
; Call P4=Channel address
SETBUF: SETZM BLKFIR(P4)
MOVSI M,BLKFIR(P4)
HRRI M,BLKFIR+1(P4)
BLT M,BLKEND(P4) ; Zero entire data block
MOVSI M,-BLKSIZ
HRRI M,DATBUF-1(P4)
MOVEM M,XIOWD(P4) ; IOWD for dump
POPJ P,
; Subroutine to initialize BUF. Sets all words equal to contents
; of AC T. Ret+0 always...
ZROBUF: SETZ T, ; Here to zero BUF
BLTBUF: MOVEM T,BUF ; Set first word
MOVE T,[BUF,,BUF+1] ; Set up BLT
BLT T,BUF+BLKSIZ-1 ; Zap into entire block
POPJ P, ; and return.
SUBTTL Hard error listing
; Here on hard error. Prints summary of error.
; Call P4=channel address (for IOSTS word)
; U=UNIDDB (for unit, CURPOS, and UNISTS)
; Prints:
; File XXX.XXX [XX,XX] [Read|Write] error on DPAx, block x
; Status = NNNNNN IO.IMP+IO.DTE+...
; CONI = nnnnnn (device not ready)+(Search err)+(Etc...)+(PI channel=X)
;
; Set ERRFL to -2 to print full message
; -1 to suppress just CONI
; 0 to suppress extended status and CONI
DEVERR: PUSHJ P,CRLF
PUSHJ P,ECRLF
PUSHJ P,CHNPNT
MOVEI M,[ASCIZ/ Read/]
TXNE F,F.IO
MOVEI M,[ASCIZ/ Write/]
PUSHJ P,MSG
MOVEI M,[ASCIZ/ error on /]
DEVER1: PUSHJ P,MSG
MOVE M,DRIVE(U)
PUSHJ P,PR6BIT ; Tell him where
MOVEI M,[ASCIZ/, block /]
PUSHJ P,MSG
MOVE N,CURPOS(U)
PUSHJ P,OCTPRT ; Print block currently being read
PUSHJ P,EQUAL
MOVE T2,CURPOS(U)
PUSHJ P,PBNPRT ; Print physical address
MOVEI M,[ASCIZ/
Status = /]
PUSHJ P,EMSG
MOVE N,IOSTS(P4) ; Status of this channel at last input
PUSHJ P,HALF8
AOSLE ERRFL ; Suppress extended status and CONI?
PJRST CRLF2 ; Yes
MOVE N,IOSTS(P4)
PUSH P,ZERO ; Start stack with zero
TXZE N,IO.ACT
PUSH P,[SIXBIT /IO.ACT/]
TXZE N,IO.EOF
PUSH P,[SIXBIT /IO.EOF/]
TXZE N,IO.BKT
PUSH P,[SIXBIT /IO.BKT/]
TXZE N,IO.DTE
PUSH P,[SIXBIT /IO.DTE/]
TXZE N,IO.DER
PUSH P,[SIXBIT /IO.DER/]
TXZE N,IO.IMP
PUSH P,[SIXBIT /IO.IMP/]
TXZE N,IO.CKS
PUSH P,[SIXBIT /IO.CKS/]
MOVEI T2,SPC2
DEVER9: POP P,M
JUMPE M,DVER10
PUSHJ P,(T2)
MOVEI T2,PLUS
PUSHJ P,PR6BIT ; Print all bits set in IOSTS
JRST DEVER9
DVER10: AOSLE ERRFL ; Suppress the rest?
PJRST CRLF2 ; Yes
MOVEI M,[ASCIZ/
Coni = /]
PUSHJ P,EMSG
MOVE N,UNISTS(U) ; Get CONI word supplied by monitor
PUSHJ P,OCTPRT ; Print it
PUSH P,ZERO ; Start stack with zero word
PUSHJ P,SETKTP ; Get internal controller type
SKIPL T,EMSTBL(T) ; Get message table addr, skip for LH side
TXZA F,F.TYPE ; Flag right side of message table
TXO F,F.TYPE ; Ditto for left side
MOVE N,UNISTS(U) ; Get status back
MOVX T1,1B33 ; T1 shifts bits, first is bit 32
DEVER2: LSH T1,1 ; Increment to next bit
JUMPE T1,DEVER5 ; Done after 33
TDNN N,T1 ; This bit set in status?
AOJA T,DEVER2 ; No, try next
TXNN F,F.TYPE ; Skip if left hand table
SKIPA T2,(T) ; Get RH of table and skip
HLRZ T2,(T) ; or LH
TRNE T2,-1 ; Skip if place holder
PUSH P,T2 ; Save message address on stack
AOJA T,DEVER2 ; and loop for next
DEVER5: MOVEI M,[ASCIZ/ (/]
PUSHJ P,MSG
DEVER6: POP P,M ; Get a msg address to print
JUMPE M,DEVER7 ; Until done..
PUSHJ P,MSG
MOVEI M,[ASCIZ/)+(/]
PUSHJ P,MSG
JRST DEVER6
DEVER7: MOVEI M,[ASCIZ/PI Channel=/]
PUSHJ P,MSG
LDB N,[POINT 3,UNISTS(U),35]
PUSHJ P,OCTPRT
PUSHJ P,RPAR
PJRST CRLF2 ; CRLF & quit with EOF return
; Routine to return the internal controller type code used by
; DEVERR. This is not too hard in general, but it is quite
; difficult to tell the difference between an RH10 and an RH20
; controller. If this ever becomes easier, the following code
; should be rewritten. Internal controller types are as follows:
$FHKON==0 ; FH controller
$DPKON==1 ; DP controller
$R1KON==2 ; RH10 controller
$R2KON==3 ; RH20 controller
; In addition, the following codes are defined from COMMOD and FILIO
DIAKUN==7 ; DIAG. function to return controller type
UNIKON==6 ; UDB offset of addr of KDB
UNISYS==3 ; UDB offset of addr of next UDB in system
RPXDI2==71 ; KDB offset of DATAI for controller
R20KON==540 ; First RH20 device code
SETKTP: LDB T,[POINTR UNIDES(U),DC.CNT] ; Get monitor controller type
CAIN T,.DCCFH ; FH?
JRST SETKT5 ; Yes
CAIN T,.DCCDP ; DP?
JRST SETKT6 ; Yes
; [076] At SETKTP + 4 1/2
CAIN T,.DCCFS ; [076] FS?
JRST SETKT1 ; [076] Yes, that's on an RH10
MOVE T,CPUXX ; Get CPU type we're running on
CAIE T,2 ; If not a KL, controller must be an
JRST SETKT1 ; RH10 since RH20 requires KL
MOVE T,[2,,T1] ; Setup for DIAG. UUO
MOVEI T1,DIAKUN ; Function to return controller type
MOVE T2,DRIVE(U) ; Physical unit in question
DIAG. T, ; Do it
JRST SETKT2 ; Gotta do it the hard way
CAMGE T,[R20KON,,0] ; All RH20's are > R20KON
SETKT1: SKIPA T,[$R1KON] ; Must be an RH10
MOVEI T,$R2KON ; RH20
POPJ P, ; Return
;
; Here when the DIAG. UUO failed to tell us anything. We must now
; resort to looking around in core (GAK!!!)
;
SETKT2: MOVX T,%LDUNI ; Setup to look in the monitor
GETTAB T, ; Get address of first UDB
JRST SETKT1 ; Take a guess
SETKT3: HLRZS T1,T ; Isolate the address
JUMPE T,SETKT1 ; Guess if at end of chain without match
PEEK T, ; Get UNINAM
CAME T,DRIVE(U) ; Match with this one?
JRST SETKT4 ; No, try next
MOVEI T,UNIKON(T1) ; Point at UNIKON
PEEK T, ; Get address of KDB
MOVEI T,RPXDI2(T) ; Point at RPXDI2 in KDB
PEEK T, ; Get it
TDZ T,[DATAI 7] ; If not DATAI or DATAO, we
TDNE T,[700077,,-1] ; can only guess
JRST SETKT1
CAMGE T,[R20KON_6,,0] ; RH20?
SKIPA T,[$R1KON] ; No, RH10
MOVEI T,$R2KON ; RH20
POPJ P, ; Return
SETKT4: MOVEI T,UNISYS(T1) ; Point at UNISYS for current UDB
PEEK T, ; Get new address
JRST SETKT3 ; and look
SETKT5: SKIPA T,[$FHKON] ; An FH controller
SETKT6: MOVEI T,$DPKON ; or a DP
POPJ P, ; Return
; The CONI bit tables have one entry for every bit in the
; CONI word (minus PI assignment bits) and point to the message
; for that bit. To save space, one controller uses one half
; of the table and another uses the other half. These tables
; are in turn pointed to by entries in EMSTBL which is indexed
; by the internally defined controller type number (see SETKTP).
; If bit 0 of EMSTBL is set for an entry, the corresponding
; controller message table is in the left half.
EMSTBL: XWD 400000,FHEMS ; Pointer to FH controller CONI bits
XWD 0,DPEMS ; Pointer to DP controller CONI bits
XWD 400000,RH1EMS ; Pointer to RP (RH10) controller CONI bits
XWD 0,RH2EMS ; Pointer to RP (RH20) controller CONI bits
;
;
; Table for FH,,DP CONI bits
FHEMS:
DPEMS: EM27,,EM21 ; Bit 32
EM20,,EM20 ; Bit 31
EM19,,EM19 ; Bit 30
EM11,,EM18 ; Bit 29
EM15,,EM17 ; Bit 28
EM12,,EM16 ; Bit 27
EM26,,EM15 ; Bit 26
EM25,,EM14 ; Bit 25
EM24,,EM13 ; Bit 24
EM9 ,,EM12 ; Bit 23
EM14,,EM11 ; Bit 22
EM23,,EM10 ; Bit 21
EM22,,EM9 ; Bit 20
EM10,,EM8 ; Bit 19
EM7 ,,EM7 ; Bit 18
0,,EM3 ; Bit 17
0,,EM2 ; Bit 16
0,,EM1 ; Bit 15
0,,EM0 ; Bit 14
0,,0 ; Bit 13
0,,0 ; Bit 12
0,,0 ; Bit 11
0,,0 ; Bit 10
0,,0 ; Bit 9
0,,0 ; Bit 8
0,,0 ; Bit 7
EM6 ,,0 ; Bit 6
EM5 ,,0 ; Bit 5
EM4 ,,0 ; Bit 4
0,,0 ; Bit 3
0,,0 ; Bit 2
0,,0 ; Bit 1
0,,0 ; Bit 0
; Table for RH10,,RH20 CONI bits
RH1EMS:
RH2EMS: EM27,,EM27 ; Bit 32
EM20,,EM40 ; Bit 31
EM28,,EM41 ; Bit 30
EM29,,EM42 ; Bit 29
EM30,,EM28 ; Bit 28
0,,EM43 ; Bit 27
0,,EM44 ; Bit 26
EM9 ,,EM45 ; Bit 25
EM31,,EM29 ; Bit 24
EM32,,EM32 ; Bit 23
EM33,,EM35 ; Bit 22
EM19,,EM46 ; Bit 21
EM35,,EM47 ; Bit 20
EM36,,EM36 ; Bit 19
EM37,,EM37 ; Bit 18
EM12,,0 ; Bit 17
EM26,,0 ; Bit 16
EM2 ,,0 ; Bit 15
0,,0 ; Bit 14
0,,0 ; Bit 13
0,,0 ; Bit 12
0,,0 ; Bit 11
EM38,,0 ; Bit 10
EM39,,0 ; Bit 9
0,,0 ; Bit 8
0,,0 ; Bit 7
EM48,,0 ; Bit 6
EM49,,0 ; Bit 5
EM50,,0 ; Bit 4
EM51,,0 ; Bit 3
0,,0 ; Bit 2
EM52,,0 ; Bit 1
EM53,,0 ; Bit 0
; and the error messages themselves:
EM0: ASCIZ/*Cntrl wd par err*/
EM1: ASCIZ/*Sector par err*/
EM2: ASCIZ/*Chn data par err*/
EM3: ASCIZ/*Disk wd par err*/
EM4: ASCIZ/Unit is a drum/
EM5: ASCIZ/Sector 80/
EM6: ASCIZ/Low safe area/
EM7: ASCIZ/Search done/
EM8: ASCIZ/*End of cylinder*/
EM9: ASCIZ/*Pwr failure*/
EM10: ASCIZ/*Search err*/
EM11: ASCIZ/*Data late*/
EM12: ASCIZ/*No such memory*/
EM13: ASCIZ/*Par err*/
EM14: ASCIZ/*Not ready*/
EM15: ASCIZ/*Ill write*/
EM16: ASCIZ/Ill DATAO/
EM17: ASCIZ/*Sector addr err*/
EM18: ASCIZ/*Surface addr err*/
EM19: ASCIZ/Cntrl wd written/
EM20: ASCIZ/Busy/
EM21: ASCIZ/*Interrupt*/
EM22: ASCIZ/*Unit err*/
EM23: ASCIZ/*Track-sector err*/
EM24: ASCIZ/*Dev par err*/
EM25: ASCIZ/*Data par err*/
EM26: ASCIZ/*Cntrl wd par err*/
EM27: ASCIZ/*Done*/
EM28: ASCIZ/Attention/
EM29: ASCIZ/Reg access err/
EM30: ASCIZ/Cont bus overrun/
EM31: ASCIZ/Ill cmd/
EM32: ASCIZ/Drive response err/
EM33: ASCIZ/DTC overrun/
EM35: ASCIZ/Chn error/
EM36: ASCIZ/Exception/
EM37: ASCIZ/Data bus par err/
EM38: ASCIZ/SD reg access err/
EM39: ASCIZ/Ill fnc code/
EM40: ASCIZ/PCR full/
EM41: ASCIZ/Attention interupt enabled/
EM42: ASCIZ/SCR full/
EM43: ASCIZ/Massbus enabled/
EM44: ASCIZ/Data overrun/
EM45: ASCIZ/Chn ready/
EM46: ASCIZ/Short wd cnt/
EM47: ASCIZ/Long wd cnt/
EM48: ASCIZ/22 bit chn/
EM49: ASCIZ/Chn pulse/
EM50: ASCIZ/Chn active/
EM51: ASCIZ/CC inhibit/
EM52: ASCIZ/CB full/
EM53: ASCIZ/AR full/
SUBTTL SAT block I/O processing routines
; Subroutine to read/write disk SATs (DSKSAT)
; Ret+0 Error
; Ret+1 Got 'em
;
; Each SAT block on a unit is physically located near the clusters
; which it represents. Therefore, only the first block of each
; group of SAT.SYS contains the SAT; the rest of the blocks in each
; group are unused (and are usually -1). Furthermore, each group
; in SAT.SYS contains precisely one cluster.
;
; The SATs are read in such that the unused words in each SAT
; block are compressed, i.e., the first word of the second SAT
; is adjacent to the last word of the first SAT in core. No
; attempt is made to compress the unused bits in the last word
; of each SAT.
RDSAT: TDZA T,T
WTSAT: SETO T,
MOVEM T,WTFLAG ; 0 if reading, -1 if writing
JUMPE T,RDSAT4 ; Jump if reading
PUSHJ P,STRMNT ; Is STR mounted?
JRST ERR016 ; Yes, can't do this
RDSAT4: MOVSI T,'SAT' ; Filename to lookup
MOVSI T1,'SYS' ; and extension
HLRZ U,UNIDDB ; Point to UDB for first unit
MOVN T2,HOMSAT(U) ; Get -block number of RIB
MOVE T3,SYSPPN ; and PPN ([1,4])
MOVEI P4,DSK ; Point to core block to use
PUSHJ P,LOOKP ; LOOKUP SAT.SYS
POPJ P, ; Propagate error to caller
MOVEI U,UNIDDB ; Setup for reading SATs from each unit
RDSAT0: HLRZ U,(U) ; Get next unit in structure
JUMPE U,CPOPJ1 ; Return at end of list
SKIPE WTFLAG ; If reading, allocate core first
JRST RDSAT2
PUSHJ P,SATADD ; Allocate core for all SATs on unit
MOVEM T,DSKSAT(U) ; Remember where it starts
RDSAT2: MOVE P1,HOMSPU(U) ; P1 counts SATs on unit
MOVE T,DSKSAT(U) ; Get address of start of SATs
SOJ T,
MOVN T1,UNIWPS(U)
HRL T,T1 ; T=-WPS,,Address of SAT-1 (IOWD)
;
; Here to actually read all SATs for this unit into core.
; By setting NOIO for all but every (blocks/cluster) blocks,
; we effectively skip all but the first block in every
; group (=1 cluster) thus reading in the correct block as
; the SAT.
;
RDSAT1: MOVEM T,XIOWD+DSK ; Store for input routines
MOVE T1,HOMBPC(U) ; T1=Blocks/cluster
RDSAT3: CAIN T1,1 ; At the 1st block of next cluster yet?
SKIPE WTFLAG ; Yes. Writing??
SETOM NOIO ; No to either. Dont bother disks
PUSHJ P,DMPIN ; Read blocks
SOJG T1,RDSAT3 ; Loop until next real SAT is read
SKIPE WTFLAG ; Writing?
PUSHJ P,REWRIT ; Yes. Write over last block (the SAT..)
JFCL
SOJE P1,RDSAT0 ; For HOMSPU times, then go to next unit
ADD T,UNIWPS(U) ; Inc to next SAT on this unit
JRST RDSAT1 ; and read it.
;SUBROUTINE TO SET IN OURSAT THE BITS FOR BLOCKS POINTED TO BY BAT
SETBAT: JSP M,SAVE3 ;SAVE P1-P3
MOVEI T,SETBTU ;CALL SETBTU ONCE FOR EACH UNIT IN STR
PJRST DOALLU
;HERE WITH U=UDB
SETBTU: PUSHJ P,BATCHK ;READ BAT BLOCK
POPJ P,
LDB P1,BAYNBR ;REGIONS FOUND BY MAPPER
ADD P1,BUF+BAFCNT ;PLUS REGIONS FOUND BY MONITOR
HRRZ P2,BUF+BAFFIR ;POINT TO FIRST PAIR +1
ADDI P2,BUF+1
STBTU2: LDB P3,BAYNBB ;NUMBER OF BLOCKS IN REGION
ADDI P3,1
LDB P4,BAYELB ;GET THE BLOCK NUMBER
MOVE T1,-1(P2) ;OLD STYLE BAT OR NEW?
TRNN T1,BAPNTP
HRRZ P4,(P2) ;OLD, OOPS WE DID IT WRONG
STBTU1: MOVE T1,BLKUNI(U) ;BLOCKS ON THIS UNIT
IDIV T1,STRBPC ;CLUSTERS ON THIS UNIT
MOVE T1,BLKUNI(U) ;T2=NUMBER OF BLOCKS NOT IN ANY CLUSTER
SUBI T1,1(T2) ;T1=LAST BLOCK OF LAST REAL CLUSTER
CAMLE P4,T1 ;SKIP IF BLOCK IS WITHIN A REAL CLUSTER
JRST STBTU9 ;NO, NEVER MIND
MOVE T1,P4 ;CONVERT BLOCK TO CLUSTER
IDIV T1,STRBPC
HRRZ T,OURSAT(U) ;POINT TO IN-CORE SAT
PUSHJ P,MRKONE ;SET THE BIT
JFCL ;IGNORE IF ALREADY SET
ADDI P4,1 ;BUMP BLOCK NUMBER
SOJG P3,STBTU1 ;LOOP FOR EACH BLOCK IN REGION
STBTU9: ADDI P2,2 ;POINT TO NEXT PAIR
SOJG P1,STBTU2 ;LOOP FOR EACH PAIR
POPJ P,
; Subroutine to build a SAT in core (OURSAT)
; by reading all files on the disk.
; Call with UNIDDB INIT'ed to structure
; F.RALL set in LH(F) to read all blocks
; F.QUICK set in RH(F) to go quickly, sets NOIO to BLKRED
;
;RET+0 always
BLDSAT: MOVEI T,[PUSHJ P,SATADD ; Allocate core for units SAT
MOVEM T,OURSAT(U) ; Remember where it starts
PUSHJ P,MRKSAT ; Mark unused bits at end of SATs
POPJ P, ]
PUSHJ P,DOALLU ; Allocate all units
TXO F,F.OURS ; Tell DMPIN to be setting bits in OURSAT
; Now read all files
BLDST3: PUSHJ P,NXTPPN ; Get next PPN
JRST BLDST1 ; None left, return
BLDST4: TXZ F,F.LEN ; Use length
PUSHJ P,NXTFIL ; Get next file
JRST BLDST3 ; None left, try next PPN
PUSHJ P,USRLOK ; Lookup the file
JRST BLDST4 ; Ignore bad files
TXO F,F.LEN ; Don't trust file length; wait for last ptr
BLDST5: MOVEI P4,DSK ; Always do reads on channel DSK
TXNE F,F.QUICK ; Quick form?
SETOM NOIO ; Yes. Fix SATs, but dont actually
; read blocks or checksum them.
PUSHJ P,DMPIN ; Read a block of the file
MOVE T,IOSTS+DSK ; Get status after read
TXNE T,IO.EOF ; Hit end?
JRST BLDST4 ; Yes. Get next file
TXNN F,F.QUICK ; If quick mode,
TXNN F,F.RALL ; or if not reading all blocks
JRST .+2 ; Force another cluster group
JRST BLDST5 ; Otherwise skip it
SOSGE T1,BLKCNT+DSK ; Compute number blocks remaining
MOVEI T1,0 ; If negative, use zero
SUB T1,FILEN+DSK ; Subtract number from file length
MOVNM T1,FILEN+DSK ; But that makes it negative
SETZM BLKCNT+DSK ; Zero blocks remaining in current group
JRST BLDST5 ; and loop for rest of file
BLDST1: TXZ F,F.OURS
POPJ P,
; Routine to mark the unused bits in the last word of every SAT
; for this unit.
;
; Call with T = address of first SAT
; U = UDB address for this unit
MRKSAT: PUSHJ P,SAVALL ; Save 'em all for safety
MOVEI P1,-1(T) ; Save addr-1 of first SAT
MOVE P2,BLKUNI(U) ; Get blocks/unit
IDIV P2,HOMBPC(U) ; Compute number of full clusters on unit
SUBI P2,1 ; Compute last cluster address
SETOM P4 ; Pointer to last cluster in SAT
MRKST1: CAML P4,P2 ; Done all SATs yet?
POPJ P, ; Yes, all finished
MOVE T,P1 ; Addr-1 of this SAT for MRKEND
MOVE T1,UNICPS(U) ; Assume full SAT (not last)
ADD P4,T1 ; Compute last cluster in this SAT
CAMG P4,P2 ; Larger than last cluster?
JRST MRKST2 ; No, no correction necessary
ADD T1,P2 ; Compute real number of clusters by
SUB T1,P4 ; Subtracting difference between P2 and P4
MOVE P4,P2 ; Setup for next time around loop
MRKST2: PUSHJ P,MRKEND ; Mark bits in end of this SAT
ADD P1,UNIWPS(U) ; Point to start of next SAT
JRST MRKST1 ; and loop for next one
; Routine to mark the unused bits in the last word of a SAT
;
; Call with T = address of SAT - 1
; T1 = Actual number of clusters in this SAT
; U = UDB address of this unit
MRKEND: PUSH P,T ; Save addr of start of SAT
IDIVI T1,^D36 ; Compute word index and remainder
ADDI T,(T1) ; Point to last full word in SAT
JUMPE T2,MRKEN1 ; Done if SAT ends on a word boundary
MOVEI T,1(T) ; Partial word requires correction
MOVNI T2,-1(T2) ; Compute -number containing bits
MOVX T1,1B0 ; Set the sign bit
ASH T1,(T2) ; Form mask for used bits in last word
SETCAM T1,(T) ; Set unused bits in last word
MRKEN1: POP P,T1 ; Retrieve addr-1 of SAT
ADD T1,UNIWPS(U) ; Compute addr of last word of SAT block
MRKEN2: CAML T,T1 ; Need to fill rest of block?
POPJ P, ; No, return now
MOVEI T,1(T) ; Bump address by one
SETOM (T) ; Fill word with ones
JRST MRKEN2 ; and loop for rest of block
; Subroutine to count free blocks in a SAT
; Call U=Unit UDB
;
; Ret+0 Always, N=Number of free blocks
CNTSAT: JSP M,SAVE3
SETZB P1,P2 ; P1 counts SATs within unit
MOVN P3,UNIWPS(U) ; P2 counts free blocks
HRL P3,DSKSAT(U)
MOVSS P3 ; P3=AOBJN ptr to SAT
CNTST1: CAML P1,HOMSPU(U) ; Finished all SATs on unit?
JRST PNTST2 ; Yes. Quit
MOVE N,P3 ; Set N = AOBJN ptr
PUSHJ P,ZBITS ; Count zero bits
IMUL N,STRBPC ; 1 bit = BPC blocks
ADDM N,P2 ; Tally blocks
ADD P3,UNIWPS(U) ; Point to next SAT now
AOJA P1,CNTST1 ; To next SAT and go.
; Subroutine to see if all SATs for a STR are in core
;
; Ret+0 NOPE..
; Ret+1 Yup, I hope (at least core has been allocated for them..)
;
SATINC: MOVEI U,UNIDDB
HLRZ U,(U)
JUMPE U,CPOPJ1 ; Made it all the way through, OK
SKIPN T,DSKSAT(U)
POPJ P,
MOVE T1,UNIWPS(U)
IMUL T1,HOMSPU(U)
ADD T,T1
CAMLE T,.JBFF
POPJ P,
JRST SATINC+1 ; Loop for all SATs.
; Subroutine to allocate core for a SAT on a unit
; Ret+0 with T=Address of SAT
SATADD: MOVE T,UNIWPS(U) ; Words needed for one SAT
IMUL T,HOMSPU(U) ; Times SATs on unit
PJRST CORGRB ; Get core for unit SATs and return
; Subroutine to set a bit in a SAT table (and SAT)
; Call T=Adr of SAT table
; T1=Cluster number within unit
; U=UDB
;
; Ret+0 If bit already set
; Ret+1 If bit not already set
MRKONE: PUSHJ P,TSTONE ; Set if already set
AOS (P) ; No. Set for skip return
MOVNS T3 ; -Number of places to shift
ROT T1,(T3)
MOVEM T1,(T)
POPJ P,
; Subroutine to zero a bit in a SAT table
; Call T=Adr of SAT table
; T1=Cluster number within unit
; U=UDB
;
; Ret+0 If bit already zero
; Ret+1 If bit was one, now it is zero
MRKZRO: PUSHJ P,TSTONE ; See if already set
SKIPA ; Not, which is not what we expect
AOS (P) ; Already set. Give skip return
MOVNS T3 ; -number of places to shift
TLZ T1,400000 ; Make sure bit is zero
ROT T1,(T3) ; Rotate it back to normal position
MOVEM T1,(T) ; Put bit back into table
POPJ P, ; and return
; Subroutine to count zero bits in a table
; Call N=AOBJN pointer to table
; Ret+0 Always, N=Number of zero bits
ZBITS: JSP M,SAVE3 ; Get three AC's
SETZ P1, ; Zero one to count zero bits
ZBITS1: MOVE P2,(N) ; Get some data into P2
SETCA P2, ; Complement word
JUMPE P2,ZBITS0 ; Must have been all ones.
ZBITS2: SETCA P2, ; Back to normal
JFFO P2,.+3 ; Count leading zeroes
ADDI P1,^D36 ; Must have been all zeroes
JRST ZBITS0
SETCA P2, ; Complement word again
ADDI P1,(P3) ; Cound leading zeroes
LSH P2,(P3) ; Shift them right off the end
JFFO P2,.+2 ; Now cound leading ones
JRST ZBITS0
LSH P2,(P3) ; and shift them out too
JRST ZBITS2 ; Loop for all bits
ZBITS0: AOBJN N,ZBITS1 ; Go to next word
MOVE N,P1 ; Until done. Put answer into N
POPJ P, ; and return
; Subroutine to determine if a bit set in a SAT table
; Call T=Adr of table
; T1=Cluster within unit
; U=UDB Adr
;
; Ret+0 Bit not set
; Ret+1 Bit is set
;
; Always T1=word contining bit with bit rotated to sign bit
; T3=Number of bits rotated
TSTONE: IDIV T1,UNICPS(U) ; T1=SAT number, T2=Index of cluster in SAT
IMUL T1,UNIWPS(U) ; T1=# of words to this SAT from beg.
ADD T,T1 ; T=Beginning of the SAT we want
IDIVI T2,^D36 ; T2=Index in SAT, T3=Pos in word
ADD T,T2 ; T=Adr of word containing bit
MOVE T1,(T) ; T1=word
ROT T1,(T3) ; Rotate desired bit into sign bit
TLOE T1,400000 ; Skip if not set and set for caller
AOS (P) ; Give skip return
POPJ P,
; Subroutine to print summary of number of cluster which are
; lost, free, or multiply used.
; Call with P4 set to one of the following values:
$PRLST==2 ; Print lost, free, and multiply used clusters
$PRFRE==1 ; Print free and multiply used clusters
$PRMLT==0 ; Print only multiply used clusters
PRALL: SETOM TEMP ; TEMP counts clusters
MOVEI U,UNIDDB ; Setup for all units
PRALL1: HLRZ U,(U) ; Move to next unit in str
JUMPE U,PRALL5 ; At end of chain
MOVE T1,HOMSPU(U) ; SATs per unit
MOVEM T1,TEMP2 ; Save for later check
SETZM T1 ; T1 is cluster offset for this sat
;
; Here to setup for each SAT on a unit
;
PRALL2: PUSHJ P,BLDPTR ; Build byte pointer for this SAT
PRALL3: PUSHJ P,GETCLS ; Get cluster for this unit,SAT
JRST PRALL4 ; If no more in this SAT
PUSHJ P,PRTCLS ; Print the one we found
JRST PRALL3 ; and loop for next one
;
; Here at end of current SAT. If more on unit, do them, else
; move to next unit
;
PRALL4: ADDI T1,1 ; Bump T1 by 1
CAMGE T1,TEMP2 ; Done all SATs for this unit?
JRST PRALL2 ; Nope, loop for next one
JRST PRALL1 ; Move to next unit
;
; Here when all units done. Print totals and loop for next
; type, if any.
;
PRALL5: AOSG N,TEMP ; Increment count (start at -1)
JRST PRALL6 ; If none found
MOVEI M,[ASCIZ/
Total number = /] ;
PUSHJ P,MSG ;
PUSHJ P,DECPRT ; Print number found
JRST PRALL7 ;
PRALL6: MOVEI M,[ASCIZ/
There are no /]
PUSHJ P,MSG ;
MOVE M,HEDMSG(P4) ; Get type message
PUSHJ P,MSG ;
PRALL7: PUSHJ P,CRLF3 ;
SOJGE P4,PRALL ; Loop for next type, if any
POPJ P, ;
; Routine to setup OURPTR, DSKPTR, TRBPTR, and CLSCNT for this
; SAT. Call with (T1) = SAT number
; RET+0 always with pointers setup
BLDPTR: PUSH P,T1 ; Save T1
IMUL T1,UNIWPS(U) ; Compute word offset
MOVSI T,(POINT 1,0) ;
HRR T,OURSAT(U) ;
ADDI T,(T1) ; POINT 1,OURSAT+SAT offset
MOVEM T,OURPTR ;
HRR T,DSKSAT(U) ;
ADDI T,(T1) ; POINT 1,DSKSAT+SAT offset
MOVEM T,DSKPTR ;
HRR T,TRBSAT(U) ;
ADDI T,(T1) ; POINT 1,TRBSAT+SAT offset
MOVEM T,TRBPTR ;
MOVE T,UNICPS(U) ; Get clusters/SAT
MOVEM T,CLSCNT ; CLSCNT counts sats
MOVEM T,TEMP1 ;
SOS TEMP1 ; TEMP1 = CLSCNT-1 for comparison
POP P,T1 ; Restore T1
POPJ P, ;
; Routine to find the next cluster in error of specified type.
; Call with (P4) = type to do, (T1) = SAT number
; SAT.
; RET+0 if no more clusters in this SAT
; RET+1 with cluster in T
GETCLS: PUSH P,T1 ; Save T1 across call
PUSHJ P,@ROUTIN(P4) ; Get cluster of proper type
JRST T1POPJ ; Restore T1 and return
POP P,T1 ; Restore T1
MOVE T,TEMP1 ; # clusters/SAT - 1
SUB T,CLSCNT ; T = cluster offset in this SAT
MOVE N,T1 ;
IMUL N,UNICPS(U) ; Compute cluseter offset for this SAT
ADD T,N ; T = cluster offset in this unit
MOVE N,HOMLUN(U) ; Get logical unit
IMUL N,STRBPU ;
IDIV N,STRBPC ; N = cluster # 0 on this unit
ADD T,N ; T = cluster on this unit
JRST CPOPJ1 ; Return success
; Routine to print the cluster number in T
; Call with (T) = cluster number, (P4) =type of cluster
; RET+0 always
PRTCLS: AOSE TEMP ; Count bad clusters
JRST PRTCL1 ; If some already seen
MOVEI M,[ASCIZ/
The following are /] ;
PUSHJ P,MSG ; Print start of header
MOVE M,HEDMSG(P4) ; Get rest of message
PUSHJ P,MSG ;
PUSHJ P,CRLF2 ;
PRTCL1: MOVEI N,(T) ;
MOVEI T,6 ;
PUSHJ P,OCTZRO ; Print as zero filled octal
PUSHJ P,SPC2 ;
MOVE T2,TEMP ; Get number found so far
ADDI T2,1 ;
IDIVI T2,^D15 ; Print 15 per line
JUMPN T3,CPOPJ ;
PJRST CRLF ; Print CRLF and return
; Routines to find the next cluster of the specified type. Called
; via PUSHJ through the dispatch table ROUTIN indexed by type
; of cluster to find.
;
; Free = set in OUTSAT but not in DSKSAT
DFREE: SOSGE CLSCNT ; More left?
POPJ P, ; No. Try another unit
ILDB T,OURPTR
ILDB T1,DSKPTR
JUMPE T,DFREE ; Forget it if not in OURSAT
JUMPN T1,DFREE ; Set in DSKSAT? Should be
JRST CPOPJ1 ; Nope. Got one
; Lost = Set in DSKSAT but not in OURSAT
DLOST: SOSGE CLSCNT ; More left?
POPJ P, ; No. Try another unit
ILDB T,OURPTR
ILDB T1,DSKPTR
JUMPE T1,DLOST ; Forget it if not in DSKSAT
JUMPN T,DLOST ; Set in OURSAT? Should be
JRST CPOPJ1 ; Nope. Got one
; Mult = Set in TRBSAT
DMULT: SOSGE CLSCNT ; More left?
POPJ P, ; No. Try another unit
ILDB T,TRBPTR
JUMPE T,DMULT ; Forget it if not set in TRBSAT
JRST CPOPJ1 ; Got one
; Dispatch table to routines to find the proper type of cluster.
; Must be in the same order as the values of $PRLST, $PRFRE, $PRMLT.
ROUTIN: DMULT
DFREE
DLOST
; Table of messages associated with each type of cluster. Order is the
; same as that of ROUTIN.
HEDMSG: [ASCIZ/multiply used clusters (belonging to more than one file)/]
[ASCIZ/free clusters (not marked in use, but in some file)/]
[ASCIZ/lost clusters (marked in use, but in no file)/]
; Subroutine to set bit in our SAT and check other SATs
; Call T=Cluster within unit
; U=UDB address
; If F.TRB set in LH(F), will look for trouble, otherwise, will just
; mark bits in OURSAT and return.
;
CLSCHK: JSP M,SAVE3 ; Save P1,P2,P3
MOVE P1,T
TXNN F,F.TRB ; Looking for trouble?
JRST MARKIT ; No. Just mark OURSAT
HRRZ T,TRBSAT(U) ; T=Adr of 1st trouble SAT on this unit
MOVE T1,P1 ; T1=cluster within unit
PUSHJ P,TSTONE ; See if bit set in trouble SAT
JRST NOTRB ; No..
PUSHJ P,MULT ; Yes. Print multiply used and set trouble bit
MARKIT: HRRZ T,OURSAT(U)
MOVE T1,P1
PUSHJ P,MRKONE ; Set our SAT, but dont care if already set
JFCL
TXNN F,F.TRB ; Looking for trouble?
JRST CPOPJ1 ; No. Just marking, done.
JRST LKFREE ; See if cluster is free
NOTRB: MOVE T1,P1
HRRZ T,OURSAT(U)
PUSHJ P,MRKONE ; Set bits in our SAT
PUSHJ P,MULT ; Already set, print and set trouble bit
LKFREE: MOVE T1,P1
HRRZ T,DSKSAT(U)
PUSHJ P,TSTONE ; See if bit set in disk SAT
PUSHJ P,FREE ; No. Cluster is free
JRST CPOPJ1 ; Yes. All is ok now..
MULT: MOVE T1,P1
HRRZ T,TRBSAT(U)
PUSHJ P,MRKONE
JFCL
TXO F,F.MULT ; Remember this
SKIPA M,[[ASCIZ/multiply-used cluster/]]
FREE: MOVEI M,[ASCIZ/used but not marked in SAT/]
PUSH P,M
PUSHJ P,ECRLF
PUSHJ P,CHNPNT
MOVEI M,[ASCIZ/ cluster /]
PUSHJ P,MSG
MOVE N,HOMLUN(U)
IMUL N,STRBPU
IDIV N,STRBPC
ADD N,P1 ; N=Cluster number
PUSH P,N
PUSHJ P,OCTPRT ;
MOVEI M,[ASCIZ . = block .]
PUSHJ P,MSG
POP P,N
IMUL N,STRBPC
PUSHJ P,OCTPRT ;
PUSHJ P,SPC2
POP P,M
PUSHJ P,EMSG
PJRST CRLF
; Subroutine to print a units SAT blocks
; Just like CNTSAT, but prints them too.
; Call U=Unit
;
; Ret+0 always, N= number of blocks free on unit
;
PNTSAT: JSP M,SAVE3
PUSHJ P,FORM
MOVEI M,[ASCIZ/SAT blocks for /]
PUSHJ P,MSG
SKIPN M,HOMLOG(U)
MOVE M,DRIVE(U)
PUSHJ P,PR6BIT
PUSHJ P,CRLF
SETZB P1,P2 ; P1=Relative SAT in unit,
MOVN P3,UNIWPS(U) ; P2= Blocks free tally
HRL P3,DSKSAT(U)
MOVSS P3 ; P3=AOBJN pointer
PNTST1: CAML P1,HOMSPU(U)
JRST PNTST2
MOVEI M,SATMSG
PUSHJ P,MSG
MOVE N,P1
PUSHJ P,OCTPRT ; Print relative SAT
PUSHJ P,SPC2
MOVE N,P3
PUSHJ P,ZBITS ; Count zero bits
IMUL N,STRBPC
ADDM N,P2 ; Tally blocks
PUSHJ P,DECPRT
MOVEI M,FREMSG ; Print free blocks this SAT
PUSHJ P,MSG
PUSHJ P,CRLF
PUSHJ P,PNTST3 ; Now print SAT block itself
ADD P3,UNIWPS(U)
AOJA P1,PNTST1
PNTST2: MOVE N,P2 ; Set N=answer
POPJ P, ; Return.
PNTST3: JSP M,SAVE3 ; Otherwise BLKPNT destroys all..
MOVE P2,UNIWPS(U) ; # of words to print
MOVE P1,P3 ; Make P1=AOBJN ptr to data
PJRST BLKPN1 ; Print block and return
SUBTTL SCRATCH AREA ROUTINES
;ROUTINE TO INIT THE SCRATCH DEVICE.
;CALL OUTDEV=DEVICE NAME
AUXINI: MOVEI T,14
MOVE T1,AUXDEV
MOVE T2,[AUXOB,,AUXIB]
OPEN AUX,T
POPJ P,
MOVEI T2,T
DEVSIZ T2, ;FIND OUT HOW BIG ITS BUFFERS ARE
MOVEI T2,205 ;ASSUME 205 WORDS (DISK)
HRRZM T2,AUXSIZ ;AND REMEMBER THIS FOR ALLOCATION.
MOVE T,AUXDEV
DEVCHR T, ;GET DEVCHR WORD FOR THIS DEVICE
MOVEM T,AUXCHR ;AND REMEMBER IT TOO.
JRST CPOPJ1 ;AND EXIT+1
;SUBROUTINE TO WRITE AN END OF FILE ON AUX DEVICE
AUXEOF: PUSHJ P,ZROBUF
MOVSI T,'EOF'
MOVEM T,BUF+EOFNAM
MOVI CODEOF,BUF+EOFCOD
MOVE P1,IOW
PUSHJ P,AUXOUT ;WRITE EOF BLOCK TO DEVICE
JFCL
JFCL
CLOSE AUX,
MTWAT. AUX, ;WAIT FOR ALL TO FINISH
MTEOF. AUX, ;WRITE AN EXTRA EOF
POPJ P,
;SUBROUTINE TO RELEASE THE SCRATCH DEVICE
AUXRLS: MTREW. AUX, ;REWIND IF A TAPE.
POPJ P,
;SUBROUTINE TO DO 'ENTER' OR 'LOOKUP' ON SRCATCH DEVICE
;CALL OUTDEV=DEVICE
; AUXNAM,AUXEXT,AUXPPN=NAME.EXT[PPN]
;
;RET+0 ERROR
;RET+1 AOK
AUXLUK: TXZA F,F.IO ;0 IF READING,
AUXENT: TXO F,F.IO ;1 IF WRITING
MTREW. AUX,
MOVE T,AUXNAM
HLLZ T1,AUXEXT
SETZ T2,
MOVE T3,AUXPPN
MOVE M,[LOOKUP AUX,T]
TXZE F,F.IO
MOVE M,[ENTER AUX,T]
XCT M
POPJ P,
JRST CPOPJ1 ;AT LAST!
;SUBROUTINE TO ALLOCATE BUFFERS FOR AUX DEVICE.
;TRYS FOR 15 BUFFERS (ABOUT 2K), WILL SETTLE FOR LESS.
;IF CONTENTS OF AUXTRY NON-ZERO, WILL TRY FOR THAT MANY INSTEAD.
;SET AUXTRY TO INFINITY TO GRAB ALL OF AVAILABLE CORE...
;
;CALL WITH F.IO SET TO WRITE, ZERO TO READ
AUXALC: JSP M,SAVE3 ;SAVE SOME DATA
SKIPN P1,AUXTRY ;WANT A PARTICULAR AMOUNT?
MOVEI P1,^D15 ;NO. TRY FOR 15
MOVE P2,.JBMAX
SUB P2,.JBFF
IDIV P2,AUXSIZ ;P2=# OF BUFFERS AVAILABLE
CAILE P1,(P2) ;WANT MOREN WE GOT?
MOVEI P1,(P2) ;YES. SETTLE FOR ALL WE GOT.
OINSTN==OUTBUF AUX,0(P1)
IINSTN==INBUF AUX,0(P1)
OINSTN==OINSTN_<-^D18>
IINSTN==IINSTN_<-^D18>
MOVSI P2,OINSTN ;MACRO WONT TAKE IT DIRECTLY..
TXNN F,F.IO
MOVSI P2,IINSTN
MOVE P3,.JBREL
XCT P2 ;DO INBUF OR OUTBUF UUO
CAME P3,.JBREL ;INCREASE CORE?
PUSHJ P,PNTCOR ;YES. INFORM HIM.
POPJ P, ;********* EXIT *******
;SUBROUTINE TO OUTPUT OR INPUT FROM SCRATCH AREA
;CALL P1= IOWD TO DATA
;
;
;RET+0 HARDWARE EOF OR HORRIBLE ERROR
;RET+1 SOFTWARE EOF (THIS IS THE EOF WE LOOK FOR)
;RET+2 AOK. DATA TRANSFERRED.
;
AUXIN: TXZA F,F.IO
AUXOUT: TXO F,F.IO
JSP M,SAVE3
HRRI P1,1(P1) ;CHANGE IOWD TO AOBJN PTR
MOVE P3,P1
MOVEI P2,W.AUX
TXNN F,F.IO
MOVEI P2,R.AUX ;P2=ADDRESS OF BINARY OUTPUT SUBROUTINE
MOVE CH,(P1) ;GET A WORD
PUSHJ P,@P2 ;GO OUTPUT IT
POPJ P, ;YIKES!!!!!!!!!! BETTER NOT HAPPEN!
MOVEM CH,(P1) ;IN CASE READING
AOBJN P1,.-4 ;AND LOOP FOR ALL WORDS.
AOS (P) ;SET FOR SKIP RETURN NOW AT LEAST
TXNE F,F.IO
JRST CPOPJ1 ;ALL IS WELL IF WRITING
MOVEI P1,CODEOF
CAME P1,EOFCOD(P3) ;THIS AN EOF BLOCK??
JRST CPOPJ1 ;NO. DATA
MOVSI P1,'EOF'
CAME P1,EOFNAM(P3)
JRST CPOPJ1
POPJ P, ;YES. GIVE SOFT EOF RETURN.
;SUBROUTINE TO WRITE ONE WORD TO THE AUX DEVICE.
;CALL CH=WORD
;RET+0 HORRIBLE ERROR
;RET+1 AOK.
W.AUX: JSP M,SAVE3
MOVI ^D10,AUXTRY ;RETRY UP TO 10 TIMES ON ERRORS
W.AUXX: SOSLE AUXOB+2
JRST W.AUX1
OUT AUX,
JRST W.AUX1
GETSTS AUX,P1
SETSTS AUX,14
TXNN P1,IO.BKT!IO.EOF!IO.EOT
JRST W.AUX2
MOVE P2,AUXCHR ;SEE WHAT WERE WRITING ON
TXNN P2,DV.MTA ;A MAG TAPE?
JRST W.AUX4 ;NO. SKIP THIS STUFF
MTEOF. AUX, ;AT EOT, WRITE TWO EOF MARKS
MTWAT. AUX, ;SO THAT WE WILL BE ABLE TO READ
MTEOF. AUX, ;THIS TAPE BACK WITHOUT GOING
MTWAT. AUX, ;OFF THE END OF THE REEL!
MTUNL. AUX, ;OF COURSE, IF NOT A TAPE, IGNORE THIS..
W.AUX4: MOVEI M,EOFMSG
W.AUX0: PUSHJ P,OPER
JRST DIE005
JRST W.AUXX
W.AUX1: IDPB CH,AUXOB+1
JRST CPOPJ1 ;SUCESFULL ******** EXIT **********
W.AUX2: TXNN P1,IO.IMP ;TAPE WRITE-LOCK ERROR?
JRST W.AUX3 ;NO. WORSE YET.
MOVEI M,[ASCIZ/
%AUX unit write-locked. Please fix and proceed./]
JRST W.AUX0
W.AUX3: SOSLE AUXTRY ;TRY UP TO 10 TIMES
JRST W.AUXX
MOVEI M,ERRMSG ;THEN GIVE UP AND TELL HIM WE DID.
PJRST MSGTTY
R.AUX: JSP M,SAVE3
R.AUXX: SOSLE AUXIB+2
JRST R.AUX1
IN AUX,
JRST R.AUX1
GETSTS AUX,P1
SETSTS AUX,14
TXNN P1,IO.EOF!IO.BKT!IO.EOT ;DONE?
JRST R.AUX2
MOVEI M,EOFMSG
MTUNL. AUX,
PUSHJ P,OPER
JRST DIE005
JRST R.AUXX
R.AUX1: ILDB CH,AUXIB+1
JRST CPOPJ1
R.AUX2: MOVEI M,ERRMSG
PJRST MSGTTY
EOFMSG: ASCIZ/
%EOF on AUX unit. Please mount another/
ERRMSG: ASCIZ/
%AUX unit data error/
SUBTTL Register save routines
; Here to save AC's P1,P2,T,T1
; Call with JSP M,BUFSAV
BUFSAV: MOVEM CH,SAVECH
PUSH P,T1
PUSH P,T
PUSH P,P1
PUSH P,P2
PUSHJ P,(M)
SKIPA
AOS -4(P)
POP P,P2
POP P,P1
POP P,T
POP P,T1
POPJ P,
; Here to save P1 & P2 & P3
; Call with JSP M,SAVE3
SAVE3: PUSH P,P1
PUSH P,P2
PUSH P,P3
PUSHJ P,(M)
JRST .+5 ; POPJ return
AOSA -3(P) ; CPOPJ1 return
AOSA -3(P) ; CPOPJ2 return
SKIPA
AOS -3(P)
POP P,P3
POP P,P2
POP P,P1
POPJ P,
; Here to save all AC's. Watch pushdown level!
; Call with PUSHJ P,SAVALL (P not saved)
SAVALL: MOVEM 16,17(P)
MOVEI 16,1(P)
BLT 16,16(P)
MOVE 16,17(P)
ADD P,[17,,17]
PUSHJ P,@-17(P)
SKIPA
AOS -20(P)
MOVSI 16,-16(P)
BLT 16,16
SUB P,[20,,20]
POPJ P,
SUBTTL Information printing routines
; Subroutine to calculate the CFP given a block in the structure.
; Call with N = Block in STR,
; U = UDB address
CFPPFX: MOVEI M,[ASCIZ/, CFP /]
PUSHJ P,MSGTTY ; Print prefix
IDIV N,HOMBSC(U) ; Convert to supercluster number
PJRST OCTPRT ; Print it and return
;
;
; Subroutine to print the first and last block in a cluster
; Call with N = first block in cluster
CLSBLK: MOVEI M,[ASCIZ/Blocks /]
PUSHJ P,MSGTTY ; Put out prefix
PUSH P,N ; Save block number
PUSHJ P,OCTPRT ; Print first block
MOVEI M,[ASCIZ/ through /]
PUSHJ P,MSGTTY ; Print separator
POP P,N ; Restore first block
ADD N,STRBPC ; Compute last block+1
SUBI N,1 ; Make it last block
PJRST OCTPRT ; Print it and return
;
;
; Subroutine to print a block/cluster number
; Call with N = number to print
BLKPFX: SKIPA M,[[ASCIZ/Block /]]
CLSPFX: MOVEI M,[ASCIZ/Cluster /]
PUSHJ P,MSGTTY ; Put out correct prefix
PJRST OCTPRT ; Print number and return
;
;
; Subroutine to print relative block/Number in BARG1
; Call RLBPFX with N = relative block,
; PREFIX with M = message address, number to print in N
RLBPFX: SKIPA M,[[ASCIZ/, Relative block /]]
PREFIX: MOVE N,BARG1 ; Load number for PREFIX call
PUSHJ P,MSGTTY ; Print the message
PJRST OCTPRT ; Print the number and return
;
;
; Subroutine to print a unit number
; Call with N = unit number
UNIPFX: MOVEI M,[ASCIZ/
Unit /]
PUSHJ P,MSGTTY ; Print prefix
PUSHJ P,OCTPRT ; Print the unit number
PUSHJ P,COLON ; Add a colon
PJRST TAB ; End with a tab and return
;
;
; Subroutine to print a prefix for the /C code
STRPFX: PJSP M,MSGTTY ; Print message and return
ASCIZ/
Structure: /
; Subroutine to compute and print physical disk address of
; logical block in AC 'T2'
PBNPRT: MOVEI M,[ASCIZ .Cylinder .]
PUSHJ P,MSG
IDIV T2,BLKCYL(U) ; T2=Cyl, T3=remainder
MOVE N,T2
PUSHJ P,OCTPRT ; Print CYL in octal
MOVEI M,[ASCIZ \ surface \]
PUSHJ P,MSG
MOVE T2,T3
IDIV T2,BLKTRC(U) ; T2=Surface, T3=Sector(track)
MOVE N,T2
PUSHJ P,OCTPRT ;
MOVEI M,[ASCIZ \ sector \]
PUSHJ P,MSG
MOVE N,T3
PJRST OCTPRT ;
; Subroutine to print file information for the /F code. The line
; produced is of the form:
;
; DSKB0 (RPA1) FOO BAZ [10,7] Block in unit = nnn, Block in str = nnn
;
; Call with T = block in str,
; T1 = block in unit
PRTFND: PUSH P,T ; Save T and T1 for later
PUSH P,T1
MOVE M,HOMLOG(U) ; Get logical unit name
PUSHJ P,PR6BIT ; and print it
MOVEI M,[ASCIZ/ (/] ;
PUSHJ P,MSG ;
MOVE M,DRIVE(U) ; Get drive it's on
PUSHJ P,PR6BIT ; and print it
MOVEI M,[ASCIZ/) /] ;
PUSHJ P,MSG ;
TXO F,F.NOTB ; Use dot instead of tab
PUSHJ P,FILPNT ; Print the file and ext
PUSHJ P,SPC ;
PUSHJ P,UFDPNT ; and the path
MOVEI M,[ASCIZ/ Block in unit = /]
PUSHJ P,MSG ;
POP P,N ; Get back value
PUSHJ P,OCTPRT ; and print it
MOVEI M,[ASCIZ/, Block in str = /]
PUSHJ P,MSG ;
POP P,N ;
PUSHJ P,OCTPRT ;
PJRST CRLF ; End with CRLF and return
; Routine to tell the user that we found a match in the /WS code.
; The line produced is of the form:
;
; RPA0 (DSKB0) Block = n, Relative word = n, Matched word = n
;
; Call with T = AOBJN ponter to relative word in BUF,
; U = UDB address of unit
PRTMAT: PUSH P,T ; Save the pointer
AOSE PASS ; Been here before?
JRST PRTMT1 ; Yes, skip the header
PUSHJ P,SWWPRT ; Type values of mask and search word
PUSHJ P,CRLF2 ; and a couple of CRLFs
PRTMT1: MOVE M,DRIVE(U) ; Get physical unit name
PUSHJ P,PR6BIT ; and print it in SIXBIT
MOVEI M,[ASCIZ/ (/]
PUSHJ P,MSG ; Separate fields
MOVE M,HOMLOG(U) ; Get logical name
PUSHJ P,PR6BIT ; and print it in SIXBIT too
MOVEI M,[ASCIZ/) Block = /]
PUSHJ P,MSG ; Header for next field
MOVE N,CURPOS(U) ; Get current block number
PUSHJ P,OCTPRT ; and print it in octal
MOVEI M,[ASCIZ/, Relative word = /]
PUSHJ P,MSG ; Another header
HRRZ N,(P) ; Get relative word in block
PUSHJ P,OCTPRT ; and print it in octal
MOVEI M,[ASCIZ/, Matched word = /]
PUSHJ P,MSG ; Final header
HRRZ N,(P) ; Get relative word in block again
MOVE N,BUF(N) ; Get word that we matched
PUSHJ P,OCTL12 ; and print it in octal
POP P,T ; Restore T
PJRST CRLF ; Print final CRLF and return
; Routine to search the block in BUF for a match with a specified
; word.
;
; Call with WMASK = search mask to use,
; WWORD = search word to find
WRDMAT: MOVSI T,-BLKSIZ ; Make AOBJN pointer
WRDMT1: MOVE T1,BUF(T) ; Get next word in BUF
XOR T1,WWORD ; Exclusive OR with search word
AND T1,WMASK ; Mask only those interesting bits
JUMPN T1,.+2 ; No match if word non-zero
PUSHJ P,PRTMAT ; Tell user of match
AOBJN T,WRDMT1 ; Loop for all words
POPJ P, ; and return
;
;
; Routine to type the contents of the search mask and word.
; Call with TTY output enabled if desired.
SWWPRT: MOVEI M,[ASCIZ/
Mask word = /]
PUSHJ P,MSG ; Type explanation
MOVE N,WMASK ; Get the mask word
PUSHJ P,OCTL12 ; Type as 12 digits of octal
MOVEI M,[ASCIZ/, Search word = /]
PUSHJ P,MSG ; One more label
MOVE N,WWORD ; Get search word
PUSHJ P,OCTL12 ; Type this as 12 digits octal also
PJRST CRLF ; End with CRLF and return
SUBTTL Disk list routines
; Here to process most /P switches. Most of this code was
; slightly lifted from DSKLST originally...
; At first I wanted to simulate DSKLST output exactly. Since
; then I have changed the output format a bit.
DSKLST: TTYOFF
TXNN SW,<CH.S!CH.U!CH.V!CH.F!CH.B!CH.E!CH.P>
TXO SW,<CH.S!CH.U!CH.V!CH.F!CH.B!CH.E!CH.P>
SKIPN BARG3 ; BARG3
TXNE SW,CH.L ; or /PL
SKIPA ; implies F and not all else..
JRST ANOTHR
TXO SW,CH.F ; L implies F and not all else
TXZ SW,<CH.U!CH.V!CH.S!CH.B!CH.E!CH.P>
ANOTHR: PUSHJ P,NXTSTR ; Initialize first STR
JRST RIPDON
JFCL
TXNE SW,CH.L
JRST NOKEY ; Skip all this for /L
SETZM TBLKCT ; Clear total blocks used on STR
SETZM NULUFD ; Count of null UFD's
SETZM UFDCNT ; Total blocks used in UFD's
SETZM WASTEB ; Wasted blocks due to cluster allocation
SETZM TFILCT ; Total number of files
SETOM TEMP3 ; Set flag for first time through on STR
TXNN SW,CH.U!CH.V ; Doing /PU or /PV?
JRST NOCLS ; Skip units if not wanted
MOVEI U,UNIDDB
NXTU: HLRZ U,(U) ; Next unit
JUMPE U,NOCLS ; Until done
TXNN SW,CH.V ; Doing /PV?
AOSG TEMP3 ; or not first time on /PU?
SKIPA ; Yes to one, print header
JRST NXTU1
PUSHJ P,CRLF2
MOVEI M,UHED
PUSHJ P,MSG
NXTU1: MOVE M,DRIVE(U)
PUSHJ P,PR6BIT ; Physical device
PUSHJ P,TAB
MOVE M,HOMHID(U)
PUSHJ P,PR6BIT ; System id
PUSHJ P,TAB
MOVE M,HOMLOG(U)
PUSHJ P,PR6BIT ; Log. unit in STR
PUSHJ P,CRLF ; End line with CRLF
TXNN SW,CH.V ; Doing /PV?
JRST NXTU ; No, skip rest of stuff
PUSHJ P,PNTHOM ; Print home block
HRLZI T,UNITAB
HRRI T,HOMHID(U)
PUSHJ P,LSTPNT ; Print the entire UDB
PUSHJ P,FORM ; Eject the page
JRST NXTU ; and repeat for all units
NOCLS: TXNN SW,CH.F
JRST NOHEAD
MOVEI M,[ASCIZ/
Key for error bits:
Bit Meaning
/]
PUSHJ P,MSG ; Print key for error bits
HRLZI P1,-KEYLEN
PNTKEY: PUSHJ P,TAB
HLRZ N,KEYS(P1)
PUSHJ P,OCTPRT
PUSHJ P,TAB
HRRZ M,KEYS(P1)
PUSHJ P,MSG
PUSHJ P,CRLF
AOBJN P1,PNTKEY
PUSHJ P,CRLF2
JRST NOKEY
DEFINE KEYMAC (X,Y)
< XWD X , [ASCIZ/Y/] >
KEYS: KEYMAC RIPBDA ,Error found by damage assessment program
KEYMAC RIPCRH ,Partially written file closed after monitor stop
KEYMAC RIPBFA ,Error found by BACKUP
KEYMAC RIPHRE ,Hardware data read error
KEYMAC RIPHWE ,Hardware data write error
KEYMAC RIPSCE ,Software checksum or redundancy error
KEYLEN== .-KEYS
NOKEY: MOVEI M,HED1 ; Print DSKLST header
PUSHJ P,MSG
NOHEAD: MOVE T,[TBLKCT,,TBLKCT+1]
BLT T,HISTO+TOPHIS+1 ; Clear all counters
TXNN SW,CH.F!CH.E!CH.P ; Do files if F or E or P
JRST DSAT
MOVE T,[HISTOR,,HISTOR+1]
SETZM HISTOR
BLT T,HISTOR+TOPHIS
RML: PUSHJ P,NXTDIR ; Get next directory
JRST FINIS
TXZ F,F.NULL ; Assume non-null UFD
PUSHJ P,NXTFIL ; Any files for this user?
TXOA F,F.NULL ; no. Remember this
JRST RML1 ; Yes. Go process
SETCM T,F ; No. We want a ufdmsg only if:
TXNN T,S.NAM!S.EXT ; Both name and ext were stars,
TXNE SW,CH.L ; and /L not in progress
JRST RML ; Otherwize, ignore null UFD's
AOS NULUFD ; Count number of them...
RML1: TXNN SW,CH.F
JRST RML2 ; Not printing files - still must allocate
PUSHJ P,CRLF2 ; To make it look good
MOVE M,HOMSNM(U) ; Get device name
PUSHJ P,PR6BIT ; Type it
PUSHJ P,COLON ; of course
PUSHJ P,UFDPNT ; and the path
PUSHJ P,CRLF2
RML2: SETZM UBLKCT
SETZM UFILCT
TXZE F,F.NULL ; Was this a null UFD?
JRST DONEU ; Yes. Dont attempt to read files
JRST RUL1
RUL: PUSHJ P,NXTFIL ; Get next user file name
JRST DONEU
RUL1: PUSHJ P,USRLOK ; LOOKUP this file
JRST RUL ; No good. Ignore it
PUSHJ P,CNTBLK ; Go count blocks allocated
TXNE SW,CH.L
JRST RUL3
MOVE T,BUF+RIBSTS
TXNN T,RIPHRE!RIPHWE!RIPSCE!RIPBDA!RIPBFA!RIPCRH
JRST RUL3 ; No errors. Why check?
TXNE T,RIPHWE
AOS FERR ; File has had hard write error
TXNE T,RIPHRE
AOS FERR+1 ; File has had hard read error
TXNE T,RIPSCE
AOS FERR+2 ; File has had software checksum error
TXNE T,RIPBDA
AOS FERR+3 ; File found bad by damage assement program
TXNE T,RIPBFA
AOS FERR+4 ; File found bad by BACKUP
TXNE T,RIPCRH
AOS FERR+5 ; File closed after a crash
RUL3: AOS UFILCT ; Count user files
TXNN SW,CH.F
JRST RULA
SKIPN N,BARG3 ; File size specified?
JRST RUL3A ; No
CAML N,BUF+RIBALC ; Smaller than allocated blocks for this file?
JRST RUL ; No, ignore it
RUL3A: PUSHJ P,FILPNT
MOVE N,DSK+RIBLBN ; Give block number of 1st rib
MOVEI T,7
PUSHJ P,OCTSPC
PUSHJ P,SPC2
PUSHJ P,DIRLST ; Print file attributes
RULA: MOVE T,BUF+RIBSIZ ; Words written
ADDI T,BLKSIZ-1
LSH T,-7 ; Convert to blocks written
TXNN SW,CH.P ; Doing histogram
JRST RULA1 ; Nope
CAILE T,TOPHIS+1 ; Skip if within histogram
MOVEI T,TOPHIS+1 ; Note off top
AOS HISTO(T) ; Count # of files of this length
RULA1: MOVEI P4,DSK
PUSHJ P,PTRCPY ; Copy ptrs into UDB so can count them
SETZM TEMP2 ; TEMP2 = count of real ptrs
SETOM TEMP3 ; TEMP3 = flag, set zero if extra RIB
RUL1C: PUSHJ P,GETPTR ; Get a ptr
JUMPE P1,RUL1B ; Quit if done
AOS TEMP2 ; Inc count
TXNE F,F.NEWR ; RIB extended?
SETZM TEMP3 ; Yes. flag it
JRST RUL1C ; and loop
RUL1B: MOVE N,TEMP2
TXNN SW,CH.P ; Doing histogram?
JRST RULB ; Nope
CAILE N,TOPHIS+1
MOVEI N,TOPHIS+1
AOS HISTOR(N) ; Historgram # of RIB ptrs
RULB: TXNN SW,CH.F
JRST RUL
MOVE N,BUF+RIBSIZ
MOVEI T,6
PUSHJ P,DECSPC ; Print words written
PUSHJ P,SPC
MOVE N,BUF+RIBALC ; Blocks allocated
MOVEI T,7
PUSHJ P,DECSPC
LDB N,EXLERB ; Get error bits
MOVEI T,5
PUSHJ P,OCTSPC
PUSHJ P,TAB
MOVE N,TEMP2
MOVEI T,5
PUSHJ P,DECSPC ; Print number of real pointers
MOVEI CH," "
SKIPN TEMP3
MOVEI CH,"*"
PUSHJ P,W.LST ; Print * if extended
PUSHJ P,CRLF
JRST RUL ; and loop for more files
; Subroutine to list file attributes.
; Prints access data, creation time,date, protection code, and mode
DIRLST: PUSHJ P,FILACD ; Get T3=date last accessed
PUSHJ P,PRDATE ; and print it
PUSHJ P,FILDAT ; Get universal date,,time
PUSH P,T3 ; and save it for a while
PUSHJ P,PRTIM1 ; Print as hh:mm
POP P,T3 ; Get back creation date,,time
PUSHJ P,PRDATE ; Print the date.
LDB N,EXLPRV ; Access privileges
MOVEI T,3
PUSHJ P,OCTZRO
LDB N,EXLMOD ; Mode
MOVEI T,3
PUSHJ P,OCTSPC
PJRST SPC2
; Here to total user's allocated blocks and words,
; and count blocks and words wasted
CNTBLK: MOVE T,BUF+RIBALC ; Blocks allocated for file
ADDM T,UBLKCT ; Count users blocks
MOVE T1,BUF+RIBSIZ ; Words written
ADDI T1,BLKSIZ-1
IDIVI T1,BLKSIZ ; T1=blocks written
SUB T,T1 ; T=blocks alloc. but not written
SUBI T,2 ; -2 for RIBs
ADDM T,WASTEB ; Gives # of wasted blocks
POPJ P,
; Subroutine to print K for swapping on unit
; Called from LSTPNT with N=words
K4SPNT: PUSH P,N
PUSHJ P,DECPR1
MOVEI M,[ASCIZ/K = /]
PUSHJ P,MSG
POP P,N
LSH N,3 ; Blocks = K * 8
PUSHJ P,DECPRT
MOVEI M,[ASCIZ/ blocks/]
PJRST MSG
DONEU:
MOVE T,USRPTH+.PTPPN
MOVE N,UFILCT ; Number of user files
CAMN T,MFDPPN
MOVEM N,MFDCT ; Count number of UFDs
ADDM N,TFILCT ; Total number of files
MOVE N,UBLKCT ; Add user's blocks to total for str
CAMN T,MFDPPN ; If this is the MFD,
MOVEM N,UFDCNT ; Remember total blocks devoted to UFDs.
ADDM N,TBLKCT
TXNN SW,CH.F
JRST RML ; If not printing files, on to next user
DONEU1: PUSHJ P,CRLF
PUSHJ P,TAB
PUSHJ P,DECPRT ; Print number of blocks allocated
MOVEI M,BLKMSG
PUSHJ P,MSG
MOVEI M,UBLKMG
PUSHJ P,MSG
MOVEI M,AVEMSG ; Now get average file size
PUSHJ P,MSG
MOVE N,UFILCT
PUSHJ P,DECPRT
MOVEI M,AVEMS1
PUSHJ P,MSG
MOVE N,UBLKCT ; Blocks allocated
IDIV N,UFILCT ; Compute average file size
PUSHJ P,DECPRT ; and print
MOVEI M,UBLK1
PUSHJ P,MSG
JRST RML
FINIS:
TXNN SW,CH.F ; If not printing files, move on
JRST DSAT
PUSHJ P,CRLF3
PUSHJ P,TAB
MOVE N,TBLKCT ; Total number of blocks allocated on STR
PUSHJ P,DECPRT
MOVEI M,BLKMSG
PUSHJ P,MSG
MOVEI M,TBLKMG
PUSHJ P,MSG
MOVEI M,AVEMSG ; Now get average file size
PUSHJ P,MSG
MOVE N,TFILCT ; Number of files
PUSHJ P,DECPRT ; and print
MOVEI M,AVEMS1
PUSHJ P,MSG
MOVE N,TBLKCT
IDIV N,TFILCT ; Compute average file size
PUSHJ P,DECPRT
MOVEI M,UBLK1
PUSHJ P,MSG
TXNE SW,CH.L
JRST NOPERF
; Here to compute & print SAT blocks
DSAT: MOV .JBFF,.SVFF ; Save so we can restore core
PUSHJ P,RDSAT ; Read disk SATS
JRST DSAT3
SETZM TOTSAT ; clear tally of free blocks
MOV USRSTR,BUF ; Set BUF=STR name
MOVE T,[.DCFCT+1,,BUF]
DSKCHR T, ; Ask monitor what it thinks.
SETZM BUF+.DCFCT ; It doesnt.
MOV BUF+.DCFCT,TOTDSK ; Remember what monitor thought free was.
MOVEI U,UNIDDB
DSAT1: HLRZ U,(U)
JUMPE U,DSAT2
TXNE SW,CH.S
PUSHJ P,PNTSAT ; Print SAT if he wants it
TXNN SW,CH.S
PUSHJ P,CNTSAT ; But must at least count zbits
ADDM N,TOTSAT ; Tally free blocks
JRST DSAT1 ; Loop for all units
DSAT2: TXNN SW,CH.S
JRST DSAT3
PUSHJ P,CRLF2
MOVE N,TOTSAT
PUSHJ P,DECPRT ; Print total blocks free on str
MOVEI M,BLKMSG
PUSHJ P,MSG
MOVEI M,TOTMSG
PUSHJ P,MSG
DSAT3: PUSHJ P,ZCORE ; Return core
TXNN SW,CH.B ; Skip if BAT blocks wanted
JRST ESUM ; No, move on
; Here to compute & print BAT blocks..
MOVEI U,UNIDDB
BATB: HLRZ U,(U) ; Get next logical unit in STR
JUMPE U,ESUM ; Until done.
PUSHJ P,FORM ; Eject page for neatness
MOVEI M,BATHED
PUSHJ P,MSG
MOVE M,HOMLOG(U) ; M=Unit ID
PUSHJ P,PR6BIT ; Print log unit
MOVEI CH,"("
PUSHJ P,W.LST
MOVE M,HOMHID(U)
PUSHJ P,PR6BIT ; Print unit ID
MOVEI M,[ASCIZ .) Currently on .]
PUSHJ P,MSG
MOVE M,DRIVE(U)
PUSHJ P,PR6BIT
PUSHJ P,CRLF
PUSHJ P,BATCHK ; Read BAT block
JRST BATB
SETZM OTHERK
MOVEI M,[ASCIZ /
Number bad blocks (MAP) = /]
PUSHJ P,MSG
LDB N,BAYNBS ; Get number of bad sectors
PUSHJ P,DECPRT
MOVEI M,[ASCIZ / Number bad regions (MAP) = /]
PUSHJ P,MSG
LDB N,BAYNBR ; Bad regions found by MAP program
PUSHJ P,DECPRT
MOVEI M,[ASCIZ / Number bad regions (MON) = /]
PUSHJ P,MSG
HRRZ N,BUF+BAFCNT ; Bad regions found by monitor
PUSHJ P,DECPRT
MOVEI M,[ASCIZ \ Controller device code (MAP) = \]
PUSHJ P,MSG
LDB N,BAYKDC
LSH N,2
PUSHJ P,OCTPRT
PUSHJ P,BLKPRT ; Now zap out the whole block
HRRZ P2,BUF+BAFFIR ; Get relative offset of 1st pair
HLRE T,BUF+BAFFIR ; Get -number free words
MOVNS T ; Make it positive
ADDI P2,BUF-1(T) ; Point to last word pair
HRLI P2,-2(T) ; Move count to LH
BATB3: SKIPE -1(P2) ; Skip if this pair unused
JRST BATB4 ; Start processing loop
SUB P2,[2,,2] ; Decrement count and pointer
JUMPL P2,BATB ; Done when count < 0
JRST BATB3 ; Else just loop
BATB4: MOVEI M,[ASCIZ .Bad regions listed most recently found first:
.]
PUSHJ P,MSG
BATB5: LDB T2,BAYELB ; Get first block in region (new entry)
MOVX M,BAPNTP ; Get new entry bit
TDNN M,-1(P2) ; Is this a new type entry?
HRRZ T2,(P2) ; No, only RH is block adr
PUSH P,T2 ; Save it for later
PUSHJ P,PBNPRT ; Print physical disk address
MOVEI M,[ASCIZ \ = block \]
PUSHJ P,MSG
MOVE N,(P) ; Get block number back
PUSHJ P,OCTPRT ;
LDB T2,BAYNBB ; # bad blocks this region
JUMPE T2,ONLY1 ; Jump if only 1 block
MOVEI M,[ASCIZ . through
.]
PUSHJ P,MSG
MOVE T3,(P) ; T3 is block no. of first bad block
ADD T2,T3 ; T2=last block #
PUSHJ P,PBNPRT
MOVEI M,[ASCIZ \ = \]
PUSHJ P,MSG
LDB T2,BAYNBB ; Get number of bad blocks
MOVEI N,1(T2) ; and tell him
PUSHJ P,DECPRT
MOVEI M,[ASCIZ \ Bad blocks\]
PUSHJ P,MSG
ONLY1: POP P,(P) ; Discard block adr
MOVEI M,[ASCIZ .
Found on .]
PUSHJ P,MSG
MOVX M,BAPOTH
TDNN M,-1(P2) ; Skip if found on another kontroller
JRST ONLY1F ; No
MOVEI CH,"*"
PUSHJ P,W.LST
SETOM OTHERK
ONLY1F: HLLZ M,DRIVE(U) ; Device name
TLZ M,77 ; Make it controller type (DP, RP, etc.)
PUSHJ P,PR6BIT
LDB CH,BAYKNM ; Get logical controller number
ADDI CH,"A" ; Make it ASCII
PUSHJ P,W.LST
MOVEI M,[ASCIZ . unit(s) .]
PUSHJ P,MSG
SETO P1, ; P1=unit number
LDB T2,BAYPUB ; T2=bits 10-17 of BAF word
; Bit 17-N=unit number
MOVEI T3,1 ; Start looking at bit 35(unit 0)
TXOA F,F.TMP ; Set bit for first time through
BADU1: LSH T3,1 ; Try the next bit
AOS N,P1 ; Which means next unit.
JUMPE T2,BADU2 ; Done if no more bits set
TRZN T2,(T3) ; Look at this bit, zero it if set
JRST BADU1 ; Not set, try next bits
TXZN F,F.TMP ; Skip if this is the first time
PUSHJ P,COMMA ; cause first unit doesn't get comma
PUSHJ P,OCTPRT ; Print unit number
JRST BADU1 ; and loop for more units
BADU2: MOVEI M,[ASCIZ/ Processor /]
PUSHJ P,MSG
LDB N,BAYAPN ; Serial number of arithmetic processor
PUSHJ P,DECPR1
MOVX M,BAPNTP ; Get new type entry bit
TDNN M,-1(P2) ; Is this a new type entry?
JRST BATB6 ; No, do it the old way
MOVEI M,[ASCIZ\.
Error bits = \]
PUSHJ P,MSG ; Start of message
LDB N,BAYERR ; Get the error bits
PUSHJ P,OCTPRT ; and print in octal
JRST BATB7 ; Skip the old style stuff
BATB6: MOVEI M,[ASCIZ \.
Bits 12-29 of CONI = \]
PUSHJ P,MSG
HLRZ N,(P2) ; Get CONI bits
MOVEI T,6
PUSHJ P,OCTZRO ; Print as 6 octal digits
BATB7: PUSHJ P,CRLF2 ; End entry with 2 CRLF's
SUB P2,[2,,2] ; Decrement counter and pointer
JUMPGE P2,BATB5 ; Loop if not done
MOVEI M,[ASCIZ \
* Also found on some other controller of processor
\]
SKIPE OTHERK ; Skip if no regions found bad on another kontroller
PUSHJ P,MSG
JRST BATB
ESUM: TXNN SW,CH.E
JRST NOSUM ; Don't want error summary
MOVEI M,[ASCIZ/
Error summary for /]
PUSHJ P,MSG
MOVE M,USRSTR
PUSHJ P,PR6BIT
MOVEI M,WASMSG ; 'blocks wasted in unwritten but allocated blocks
PUSHJ P,MSG
MOVE N,WASTEB
PUSHJ P,DECPRT
PUSHJ P,SLASH
MOVE N,TBLKCT ; Get total # of blocks written
PUSHJ P,DECPRT
PUSHJ P,EQUAL
MOVE N,WASTEB
IMULI N,^D100 ; Now express as a percentage
IDIV N,TBLKCT
PUSHJ P,DECPRT
PUSHJ P,%CRLF
MOVEI M,MSGRIB ; 'number of blocks used for ribs ='
PUSHJ P,MSG
MOVE N,TFILCT
LSH N,1
MOVE U,N
PUSHJ P,DECPRT
MOVEI M,[ASCIZ/
Plus /]
PUSHJ P,MSG
MOVE N,UFDCNT ; 'plus xxx blocks in ufds'
PUSHJ P,DECPRT
MOVEI M,[ASCIZ/ blocks in UFDs = /]
PUSHJ P,MSG
ADD U,UFDCNT
SUB U,MFDCT ; Subtract blocks in MFD ribs
MOVE N,U ; which are counted twice
PUSHJ P,DECPRT
PUSHJ P,SLASH
MOVE N,TBLKCT
PUSHJ P,DECPRT
PUSHJ P,EQUAL
MOVE N,U
IMULI N,^D100 ; Again as a percentage
IDIV N,TBLKCT
PUSHJ P,DECPRT
MOVEI M,[ASCIZ/% system overhead for retrieval information/]
PUSHJ P,MSG
MOVEI M,NULMSG ; 'number of null ufds ='
PUSHJ P,MSG
MOVE N,NULUFD
PUSHJ P,DECPRT
PUSHJ P,CRLF2
SETCM T,F
TXNE T,STNDRD
JRST ALLMAT ; Not doing all files, dont print discrepancies.
MOVE N,STRSIZ ; Total blocks on STR
SUB N,TBLKCT ; Computed free = total - used
CAMN N,TOTSAT ; Compare with SAT 0 bits
JRST ALLMAT ; If no discrepancy, dont print
MOVEI M,MISMSG
PUSHJ P,MSG
PUSHJ P,DECPRT ; Print computed free blocks
PUSHJ P,TAB2
MOVE N,TOTSAT ; Print computed from SAT
PUSHJ P,DECPRT
PUSHJ P,TAB2
MOVE N,TOTDSK ; Computed from DSKCHR by monitor
PUSHJ P,DECPRT
PUSHJ P,CRLF
ALLMAT: MOVEI M,ERRHED
PUSHJ P,MSG
HRLZI P1,-6
MOVE N,FERR(P1) ; Print each file error counter
PUSHJ P,DECPRT
PUSHJ P,TAB
AOBJN P1,.-3
PUSHJ P,CRLF
NOSUM: TXNN SW,CH.P ; Skip if performance statistics desired
JRST NOPERF
PUSHJ P,FORM
MOVEI M,HISHED ; Histogram header
PUSHJ P,MSG
SETZ T, ; start at beginning
HISLOP: PUSHJ P,HISLIN ; Print length of file & number of files
CAIE T,TOPHIS ; See if reached top
AOJA T,HISLOP ; No, keep going
MOVEI M,[ASCIZ .GE .]
PUSHJ P,MSG
ADDI T,1
PUSHJ P,HISLIN
NOPERF: PUSHJ P,FORM
JRST ANOTHR ; and continue
HISLIN: MOVE N,T ; Number of blocks written
PUSHJ P,DECPR1
PUSHJ P,TAB2
MOVE N,HISTO(T) ; Number of files of that length
PUSHJ P,DECPR1
PUSHJ P,TAB2
MOVE N,HISTOR(T) ; Number of RIBs of that length
PUSHJ P,DECPR1
PJRST CRLF
; Here on /P followed by A,O,7,6,R,D or Q
; Print data in file or blocks in ASCII, octal, SIXBIT, RIB,
; directory, or quick format
;
; /PA lists file or blocks like type command
; /PO dumps in octal
; /P7 dumps file is ASCII with block header
; /P6 dumps file in SIXBIT
; /PR prints the RIB of the file specified, or the block specified if
; it is a RIB
; /PD prints the block of file like it was a UFD
; /PQ is like a DIR/F
DATLST: PUSH P,BARG1 ; Save all block args
PUSH P,BARG2
PUSH P,BARG3
DATL0: PUSHJ P,NXTSTR ; Get next STR
JRST DATL3 ; When done
JFCL ; Don't care about MFD
DATL1: SKIPE GOTWRD ; Numeric argument?
JRST DATL5 ; Yes. List blocks, not files
PUSHJ P,NXTDIR ; Get next directory
JRST DATL0
DATL2: PUSHJ P,NXTFIL ; Get next file
JRST DATL1 ; No more files
TXNN SW,CH.Q ; No form if /PQ
PUSHJ P,FORM
TXNE SW,CH.R ; Printing RIBs?
JRST DATL7 ; Yes. Slightly different
TXO F,F.NOTB ; Use dot instead of tab
PUSHJ P,FILPNT ; Print file name,ext etc..
PUSHJ P,UFDPNT ; and path
TXNE SW,CH.Q ; If /PQ
JRST [PUSHJ P,CRLF ; then we're done
JRST DATL2]
PUSHJ P,TAB
PUSHJ P,USRLOK ; LOOKUP the file
JRST DATL2 ; Not there..
MOV IOW,XIOWD+DSK
PUSHJ P,NOW ; Print time now
PUSHJ P,CRLF3
DATL4: MOVEI P4,DSK
PUSHJ P,DMPIN ; Get a block
MOVE T,IOSTS+DSK ; Get status
TXNE T,IO.EOF ; EOF?
JRST DATL2 ; Yes. Go back for more files
TXNN SW,CH.A ; /PA?
PUSHJ P,CRLF ; No, print crlf between blocks
PUSHJ P,DATL6 ; Go to various printing routines
JRST DATL4 ; and try remaining blocks
; Here to print given blocks.
DATL5: MOVEI P4,DSK
MOVE T1,BARG1
MOVE T,IOW
PUSHJ P,STRRED ; Go read blocks
JFCL ; Error, but print block anyway
PUSHJ P,DATL6 ; Go print the block
AOS T,BARG1
CAMGE T,BARG2 ; Done all blocks requested?
JRST DATL5 ; No. Get more
TXNN SW,CH.R ; Printing RIBs?
JRST DATL0 ; No. Done
SKIPL BARG2 ; Yes. Did he give blocks or files?
JRST DATL0 ; Blocks. Done
SETZM BARG1 ; Files. Get next one
JRST DATL2
; Here on /PR - Print RIBs
DATL7: MOVE T,USRCFP
PUSHJ P,CFP2BK ; Find block # of first RIB
MOVEM T,BARG1 ; and make it look like thats what he typed
SETOM BARG2 ; Set -1 as flag saying file typed, not block
JRST DATL5
DATL3: POP P,BARG3 ; Restore block args
POP P,BARG2
POP P,BARG1
JRST RIPDON ; and finish up
; Here to dispatch to printing...
DATL6: TXNE SW,CH.R ; RIBs?
PUSHJ P,RIBPNT
TXNE SW,CH.D ; UFDs?
PUSHJ P,DIRPRT
TXNE SW,CH.O ; Octal?
PUSHJ P,BLKPRT
TXO F,F.CRLF
TXNE SW,CH.A ; ASCII?
PUSHJ P,ASCOUT ; Yes. Print it, no carriage rets.
TXZ F,F.CRLF
TXNE SW,CH.7 ; 7-Bit ASCII?
PUSHJ P,ASCOUT ; Yes. One block at a time.
TXNE SW,CH.6 ; SIXBIT?
PUSHJ P,SIXOUT
POPJ P,
SUBTTL SORT - Shell sort routine, optimized for RIPOFF use
REPEAT LOGIC,<
CALL:
T ADDRESS OF VECTOR
N NUMBER OF ENTRIES TO SORT
T1 KEY FOR SORT
KEY=0, SORT 2 WORD ENTRIES ON BOTH WORDS (/AF)
KEY=1, SORT 2 WORD ENTRIES ON LEFT HALF OF SECOND WORD,
THEN FIRST WORD (/AE)
KEY=2, SORT 3 WORD ENTRIES ON THIRD WORD (/AT)
ALL AC'S PRESERVED. SORT IS IN PLACE, DOES NOT REQUIRE
ANY EXTRA CORE.
THE SORT ALGORITHM IS AS FOLLOWS:
N=NUMBER OF ENTRIES, V=VECTOR
SORT: M=N
SORT1: M=M/2
IF M=0, RETURN
J=1
SORT2:I=J
SORT4: IF V(I) .LE. V(I+M) , GOTO SORT3
SWITCH V(I) WITH V(I+M)
I=I-M
IF I .GE. 1 , GOTO SORT4
SORT3: J=J+1
IF J .GT. N-M , GOTO SORT1
GOTO SORT2
GIVEN N ENTRIES TO SORT, ALGORITHM WILL COMPARE EXACTLY
[LOG2(N)]*[N/2]
WHERE [X] DENOTES GREATEST INTEGER FUNCTION OF X, LOG2(X) IS LOG BASE TWO.
>
;DEFINE SOME AC'S FOR MY USE HERE
KEY==T1 ;KEY FOR SORT
TMP==KEY ;A GENERAL PURPOSE REGISTER TOO..
N==N ;N STAYS THE SAME
V1==T ;ADDRESS OF VECTOR
V2==T2 ;ADDRESS OF VECTOR+1
V3==T3 ;ADDRESS OF VECTOR+2
INDEX==P1 ;INDEX INTO V REGISTERS
I==P4 ;I IN DO LOOPS
J==N1 ;J IN DO LOOPS
LEN==CH ;LENGTH OF ENTRIES
DAT1==P ;DATA AC
DAT2==F ; ..
DAT3==P2 ; ..
DAT4==P3 ; ..
IC==T4 ;SAME AS I, BUT CORRECTED
IMC==U ;HOLDS I+M, BUT CORRECTED
;ALL AC'S SAVED.
SORT: PUSHJ P,SAVALL ;MAKE IT OK TO USE THEM ALL
MOVEM P,TEMP1
MOVE LEN,LENGTH(KEY) ;SET UP CORRECT LENGTH
MOVE DAT1,TEST(KEY) ;GET ADDRESS OF RIGHT TEST ROUTINE
MOVEM DAT1,TESTX ;THIS FREES UP KEY AS ANOTHER GP AC
HRLI V1,INDEX ;PUT INDEX INTO V1
SUBI V1,(LEN)
MOVE V2,V1
AOS V3,V2 ;V2=V1+1
ADDI V3,1 ;V3=V1+2
HRRZ M,N ;M=N
SORT1: LSH M,-1 ;M=M/2
JUMPE M,PPOPJ ;IF M=0, RETURN
MOVEI J,1 ;J=1
SORT2: HRRZ I,J ;I=J
SORT4: HRRZ IC,I
IMULI IC,(LEN) ;IC=I, CORRECTED
HRRZ IMC,I
ADDI IMC,(M)
IMULI IMC,(LEN) ;IMC=I+M, CORRECTED
HRRZ INDEX,IC
MOVE DAT1,@V1 ;DAT1 = V1(I)
MOVE DAT3,@V2 ;DAT3 = V2(I)
HRRZ INDEX,IMC
MOVE DAT2,@V1 ;DAT2 = V1(I+M)
MOVE DAT4,@V2 ;DAT4 = V2(I+M)
JRST @TESTX ;GO COMPARE THESE TWO ENTRIES
;IF V(I) .LE. V(I+M) GOTO SORT3
;ELSE, RETURN HERE AT SORT4A
SORT4A: SUBI I,(M) ;I=I-M
CAIL I,1 ;IF I .GE. 1,
JRST SORT4 ; GOTO SORT4
SORT3: ;ADDI J,1 ;ALGORITHM SAYS DO THIS HERE, BUT WONT
;CAUSE WILL BE TRICKY
HRRZ DAT1,N
SUBI DAT1,1(M) ;DAT1=N-M (ACTUALLY N-M-1, THATS THE TRICK)
CAILE J,(DAT1) ;J .GT. N-M??
AOJA J,SORT1 ;YES. GOTO SORT1
AOJA J,SORT2 ;NO. GOTO SORT2
PPOPJ: MOVE P,TEMP1 ;RESTORE P
POPJ P, ;AND GO HOME...
TEST: TEST0
TEST1
TEST2
U(TESTX)
LENGTH: 2
2
3
;HERE IF KEY=0, SORT 2 WORD ENTRIES ON BOTH WORDS (/AF)
TEST0: CAMGE DAT1,DAT2 ;V1(I) .LT. V1(I+M) ??
JRST SORT3 ;DEFINITELY YES. GOTO SORT3
CAME DAT1,DAT2 ;IF EQUAL, MUST TEST SECOND WORD
JRST FLIP ;NOT EQUAL. GO FLIP THEM.
CAMG DAT3,DAT4 ;V2(I) .LT. V2(I+M)??
JRST SORT3 ;FIRST HALF EQUAL, SECOND HALF V(I) IS
; .LE. , SO ENTIRE ENTRY IS .LE., GOTO SORT3
;HERE TO SWITCH THE TWO ENTRIES
FLIP: MOVEM DAT1,@V1 ;STORE V1(I) INTO V1(I+M)
MOVEM DAT3,@V2 ;STORE V2(I) INTO V2(I+M)
HRRZ INDEX,IC
MOVEM DAT2,@V1 ;STORE V1(I+M) INTO V1(I)
MOVEM DAT4,@V2 ;STORE V2(I+M) INTO V2(I)
JRST SORT4A ;AND CONTINUE IN MAINSTREAM OF PROGRAM
;HERE ON KEY=1, SORT 2 WORD ENTRIES ON LEFT HALF OF SECOND WORD AND
;WHOLE FIRST WORD (/AE)
TEST1: MOVEM DAT3,TEMP2
HLRZS DAT3 ;ZERO CFP'S
HLRZS DAT4
CAIGE DAT3,(DAT4) ;EXT(I) .LT. EXT(I+M) ???
JRST SORT3 ;DEFINITELY YES. GOTO SORT3
CAIE DAT3,(DAT4) ;EQUAL EXTENSIONS?
JRST .+3 ;NO. EXT(I) .GT. EXT(I+M), SO SWITCH THEM
CAMG DAT1,DAT2 ;EXTENSIONS EQUAL. COMPARE FILENAMES
JRST SORT3 ;NAME(I) .LE. NAME(I+M). GOTO SORT3
;HERE IF MUST SWITCH THE TWO ENTRIES
MOVE DAT4,@V2 ;GET BACK DAT4
MOVE DAT3,TEMP2 ;GET BACK DAT3
JRST FLIP ;AND GO SWITCH THEM.
;HERE ON KEY=2, SORT THREE WORD ENTRIES ON THIRD WORD (/AT)
TEST2: MOVE TMP,@V3 ;TMP=V3(I+M)
HRRZ INDEX,IC
CAML TMP,@V3 ;IS V3(I) .GE. V3(I+M)?
JRST SORT3 ;YES. NO SWITCH
;HERE TO SWITCH THREE ENTRIES
EXCH TMP,@V3 ;STORE V3(I+M) INTO V3(I)
HRRZ INDEX,IMC
MOVEM TMP,@V3 ;STORE V3(I) INTO V3(I+M)
JRST FLIP ;AND GO SWITCH THE OTHER TWO ENTRIES
SUBTTL Core allocation routine
; Subroutine to allocate core.
; Call T=Number of words needed
; Ret+0 always with T=address of first location of new core
; C(.JBFF)=Adr. of last new loc + 1
CORGRB: JSP M,SAVE3
JSP M,TTYOUT
MOVE P1,T
ADD T,.JBFF ; P1=Highest core needed
CAMG T,.JBREL ; Already have it?
JRST CORGR2 ; Yes. Don't need UUO
CORGR1:
SKIPL %LOCK ; Locked in core?
JRST .+4 ; No. No problem
MOVE N,ONEONE
UNLOK. N, ; Yes. Unlock us for a while...
JFCL
CORE T, ; Ask for core now
JRST NOCORE
SKIPL %LOCK ; We locked?
JRST CORGR4
PUSHJ P,LOCKUUO ; Yes. Re-lock us with new core now..
SKIPA
JRST CORGR4
SETZM %LOCK
MOVEI M,[ASCIZ/Cannot remain locked in core. Continuing unlocked!/]
PUSHJ P,MSGTTY
PUSHJ P,CRLF
CORGR4:
TXOA F,F.TMP ; Remember that we did UUO
CORGR2: TXZ F,F.TMP ; We didnt do UUO
MOVE P2,.JBFF ; Save first adr in P2
ADDM P1,.JBFF ; Increment to new .JBFF
TXZE F,F.TMP ; Did we do UUO??
PUSHJ P,PNTCOR ; Yes. Tell him
MOVEI T,1(P2) ; Restore T and inc it one
HRLI T,(P2) ; T=adr of new core,, adr+1
SETZM (P2)
BLT T,@.JBFF ; Clear all new core
MOVEI T,(P2) ; Restore T
POPJ P, ; and give normal return
; Here if core not available... back up 5 yards and punt
NOCORE: MOVEI M,[ASCIZ/
can't get core, change CORMAX and then try
^C
.CONTINUE
to resume operation.
/]
PUSHJ P,MSG
MONRT. ; Exit, allow continue
MOVE T,P1 ; To continue here
ADD T,.JBFF
JRST CORGR1 ; and try more
; (He can try core command)
; Subroutine to print size of core now
PNTCOR: JSP M,TTYOUT
PUSHJ P,CRLF
MOVEI CH,"["
PUSHJ P,W.CMD
MOVE N,.JBREL
ADD N,COREXX
SUBI N,1
IDIV N,COREXX
PUSHJ P,DECPR1 ; Print decimal without dot
IFN PURESW,<
MOVEI CH,"+"
PUSHJ P,W.LST
MOVEI N,RIPEND-400000-1
ADD N,COREXX
IDIV N,COREXX
PUSHJ P,DECPR1
> ;END IFN PURESW
MOVEI CH,"K"
MOVEI N,^D512
CAMN N,COREXX
MOVEI CH,"P"
PUSHJ P,W.LST
MOVEI M,[ASCIZ . core]
.]
PJRST MSG ; And return
; Subroutine to reduce core to minimum.
; Call before increasing core (calling CORGRB)
; Do MOV .JBFF,.SFVV to save .JBFF
; Then call ZCORE which restores it to .SVFF
;
ZCORE: MOVE T1,.JBREL
MOV .SVFF,.JBFF
CORE T,
JFCL
CAME T1,.JBREL ; Has .JBREL changed?
PUSHJ P,PNTCOR ; Yes. Tell him
POPJ P,
SUBTTL Block printing routines
; Subroutine to print a home block
; Call U=UDB address of unit
; Ret+0 always with
; home block in BUF, printed to listing file too...
PNTHOM: PUSHJ P,HOMCHK ; Go read home blocks
JRST DIE004 ; Just can't happen
MOVEI M,[ASCIZ/
HOME block
/]
PUSHJ P,MSG
PJRST BLKPRT
;SUBROUTINE TO LOOK AT 'USRPPN' AND SEE IF IT IS ANY OF
;THE IMPORTANT PPN'S (EG, 1,1 1,4 OR 1,2).
CHKPPN: JSP M,SAVE3
MOVE P1,USRPTH+.PTPPN ;
MOVEI P2,NUMPPN-1 ;4 PPNS TO LOOK AT
CHKPP1: MOVE P3,VIPPNS(P2) ;GET ADR OF PPN
MOVE P3,(P3) ;GET PPN
CAMN P3,P1 ;IS IT ONE?
JRST CHKPP2 ;HELL YES.
SOJGE P2,CHKPP1 ;REPEAT FOR EACH ONE.
JRST CPOPJ1 ;AOK..
CHKPP2: MOVEI M,[ASCIZ/
Access files from /]
PUSHJ P,MSGTTY ;INFORM HIM THIS IS A NO NO.
PUSHJ P,UFDPNT ; Print offending path
MOVEI M,[ASCIZ/?/]
PJRST OPER ;AND CHECK WITH THE DODO
VIPPNS: QUEPPN
MFDPPN
SYSPPN
FSFPPN
CRSPPN
NUMPPN==.-VIPPNS
;SUBROUTINE TO PRINT A BLOCK OF 200 WORDS IN BUF
;CALL BLKPRT TO PRINT BUFSIZ=200 WORDS IN BUF
; BLKPN1 TO PRINT C(P2) WORDS WITH P1=AOBJN PTR TO THOSE WORDS
BLKPRT: JSP M,SAVE3
MOVEI P2,BLKSIZ ;P2 HAS # OF WORDS TO BE PRINTED
MOVN P1,P2
HRLZS P1
HRRI P1,BUF ;P1 IS AOBJN PTR TO BUF
PUSHJ P,HEDBLK
BLKPN1: HRLM P1,(P) ;SAVE ADDRESS OF FIRST WORD
SETZ P3, ;ZERO COUNTER.
BLKPN3: TRNN P3,7
PUSHJ P,CRLF ;CRLF EVERY 8 WORDS
MOVE N,(P1)
PUSHJ P,OCTL12
PUSHJ P,SPC
ADDI P3,1 ;INC COUNT FOR EVERY 8 WORDS TEST
AOBJN P1,BLKPN3
HLRZ P2,(P) ;GET BACK ADDRESS OF FIRST WORD
SUB P2,P1 ;SUBTRACT LAST WORD ADDRESS+1
ADDI P2,BLKSIZ ;P2=BLKSIZ-# OF WORDS PRINTED
;=NUMBER OF WORDS OF DOTS TO PRINT
JUMPLE P2,CRLF2 ;DONE ALREADY. FORGET DOTS
BLKPN2: TRNN P3,7
PUSHJ P,CRLF
MOVEI M,^D12
MOVEI CH,"."
PUSHJ P,W.LST ;WRITE 12 DOTS FOR REMAINING WORDS
SOJG M,.-1
PUSHJ P,SPC
ADDI P3,1
SOJG P2,BLKPN2
PJRST CRLF2 ;AND FINISH OFF WITH CRLF
;SUBROUTINE TO PRINT 200 WORD BLOCK IN BUFF IN ASCII FORMAT
ASCOUT: TXNE F,F.CRLF ;SUPPRESS CRLF??
JRST .+3 ;YES.
PUSHJ P,HEDBLK ;HEADER FOR BLOCK
PUSHJ P,CRLF2
MOVE T,[POINT 7,BUF]
HLRE T1,IOW
IMULI T1,5 ;5 CHARS/WORD
HRLZS T1 ;T1 COUNTS CHARS
ILDB CH,T ;GET A CHAR
PUSHJ P,W.LST ;WRITE IT
AOBJN T1,.-2 ;AND CONTINUE
TXNN F,F.CRLF
PJRST CRLF2 ;UNTIL DONE
POPJ P,
;SAME ROUTINE AS ABOVE, ONLY SIXBIT INSTEAD OF ASCII...
SIXOUT: PUSHJ P,HEDBLK
PUSHJ P,CRLF2
MOVE T,[POINT 6,BUF]
HLRE T1,IOW
IMULI T1,6
HRLZS T1
ILDB CH,T
ADDI CH,40 ;SIXBITIZE
PUSHJ P,W.LST
AOBJN T1,.-3
PJRST CRLF2
;SUBROUTINE TO PRINT 200 WORD BUFFER AS IF IT WAS A DIRECTORY
;PRINTS FILE,EXT,LOG BLOCK IN STR, REL BLOCK IN UNIT, UNIT
DIRPRT: PUSHJ P,HEDBLK
MOVEI M,DIRPM ;PRINT HEADER
PUSHJ P,MSG
MOVE T2,IOW ;T1 COUNTS WORDS
DIRP1: MOVE T,1(T2) ;FILE NAME
HLLZ T1,2(T2) ;AND EXTENSION
JUMPE T,DIRP2 ;IGNORE NULL FILE NAMES
PUSHJ P,NAMPNT ;GO PRINT THEM
HRRZ T,2(T2) ;AND THE CFP
PUSHJ P,CFP2BK ;CONVERT TO LOG BLOCKS
MOVE N,T1 ;N=REL BLOCK ON UNIT
PUSHJ P,OCTPRT ;
PUSHJ P,TAB
MOVE N,T ;GET LOG BLOCK IN STR AGAIN
PUSHJ P,OCTPRT ; PRINT LOG BLOCK
PUSHJ P,TAB
MOVE N,HOMLUN(U)
PUSHJ P,OCTPRT ;AND UNIT #
PUSHJ P,CRLF
DIRP2: AOBJN T2,.+1
AOBJN T2,DIRP1
POPJ P, ;DONE..
;HERE ON /PR - PRINT BUF AS A RIB
RIBPNT: TXZ F,F.NEWR ;SET BY GETPTR IF READS NEW RIB
HRRZ T,BUF+RIBCOD ;CHECK CODE WORD
CAIE T,CODRIB
JRST RIBPN1 ;NOT A RIB!
MOV BUF+RIBNAM,USRNAM
MOVE T,BUF+RIBEXT
HLLZM T,USREXT
MOV BUF+RIBPPN,USRPTH+.PTPPN ;
RIBPN0: PUSHJ P,CRLF
PUSHJ P,FILPNT ;PRINT FILE NAME,EXT,PPN
PUSHJ P,UFDPNT
PUSHJ P,TAB
PUSHJ P,DIRLST ;(CREATION & ACCESS TIMES, DATE,MODE)
PUSHJ P,CRLF2
PUSHJ P,HEDBLK ;TELL HIM WHAT BLOCK THIS IS
PUSHJ P,CRLF
MOVE T,[RIBTAB,,BUF+RIBSIZ]
TXO F,F.TMP ;SUPPRESS PRINTING ZERO WORDS
PUSHJ P,LSTPNT ;PRINT RIBSIZ THROUGH RIBTIM
MOVE T,[RIBTB1,,BUF+RIBLAD] ;
HRRZ T1,BUF+RIBFIR ;RIBFIR HAS RELATIVE ADDRESS OF PTRS
CAIL T1,RIBACT ; Earlier than 603?
PUSHJ P,LSTPNT ; Nope, print info
MOVEI M,RIBHED
PUSHJ P,MSG
TXZE F,F.NEWR
JRST [POP P,P1 ;IF FLAG SET, SKIP COPY
JRST RIBPN4] ;CAUSE GETPTR HAS ALREADY DONE SO
MOVEI P4,DSK
PUSHJ P,PTRCPY ;PUT RIB INTO DSK BLOCK
RIBPN2: PUSHJ P,GETPTR ;GET A POINTER
JUMPE P1,RIBPN3 ;DONE IF NO POINTER
TXNE F,F.NEWR ;WE JUST READ A NEW RIB?
JRST [PUSH P,P1 ;YES. SAVE PTR
PUSHJ P,CRLF3 ;PRINT ANOTHER HEADER
JRST RIBPN0]
RIBPN4: MOVE N,P1
PUSHJ P,OCTL12 ;PRINT POINTER
PUSHJ P,TAB
LDB N,STRCLP
IMUL N,STRBPC
MOVE T1,N
PUSHJ P,OCTPRT ; PRINT BLOCK ADR
PUSHJ P,TAB
MOVE N,HOMLUN(U)
IMUL N,STRBPU
ADD N,T1
PUSHJ P,OCTPRT ; REL BLOCK IN STR
PUSHJ P,TAB
MOVE N,P2
IMUL N,STRBPC
PUSHJ P,DECPRT ;PRINT # OF CONTIGIOUS BLOCKS
PUSHJ P,TAB
PUSHJ P,SPC2
MOVE N,HOMLUN(U)
PUSHJ P,OCTPRT ;PRINT UNIT
PUSHJ P,TAB ;
PUSHJ P,SPC2 ;
LDB N,STRCKP ; Get checksum from pointer
PUSHJ P,OCTPRT ; and print it
PUSHJ P,CRLF
JRST RIBPN2 ;CONTINUE FOR ALL POINTERS
RIBPN1: MOVEI M,[ASCIZ/Specified block is not a RIB/]
PJRST MSGTTY
RIBPN3: POP P,BUF+RIBFIR
POPJ P,
RIBTAB: DEFINE TABMAC (X,Y)
< XWD [ASCIZ\X\] , Y >
TABMAC Words written, DECPRT
TABMAC Version, HALF8
TABMAC Spooled dev, NPR6BT
TABMAC Est. block length, DECPRT
TABMAC Blocks allocated, DECPRT
TABMAC Logical block in STR of last group, OCTPRT
TABMAC Future arg for DEC, OCTL12
TABMAC Non-priv customer arg, OCTL12
TABMAC Tape label, NPR6BT
TABMAC Structure, NPR6BT
TABMAC Status bits, HALF8
TABMAC First block bad region, OCTPRT
TABMAC RIBEUN,HALF8
TABMAC FCFS quota, DECPRT
TABMAC Logged out quota, DECPRT
TABMAC Reserved quota, DECPRT
TABMAC No. blocks used when last logged out, DECPRT
TABMAC Author, OCTPPN
TABMAC Next STR, NPR6BT
TABMAC Prev. STR, NPR6BT
TABMAC Privileged customer arg, OCTL12
TABMAC UFD block with ptr to this RIB, OCTPRT
TABMAC First logical block in RIB, OCTPRT
TABMAC Extended RIB address, OCTL12
TABMAC <Internal creation date,time>,DATTIM
Z ;ENDS THE LIST!
RIBTB1: TABMAC Last accounting date, DATTIM
TABMAC Directory expiration date, DATTIM
TABMAC AOBJN pointer to accounting string, OCTL12
Z ; Ends the list
; The following table is for printing the unit UDB'S
; used in /PV code.
UNITAB:
TABMAC System ID , NPR6BT ;HOMHID=1
TABMAC Physical address of HOME blocks , HALF8 ;HOMPHY=2
TABMAC Position of STR in SYS search list , OCTPRT ;HOMSRC=3
TABMAC Structure name , NPR6BT ;HOMSNM=4
TABMAC ID next unit in STR , NPR6BT ;HOMNXT=5
TABMAC ID previous unit in STR , NPR6BT ;HOMPRV=6
TABMAC Logical unit in STR , NPR6BT ;HOMLOG=7
TABMAC Unit in STR , OCTPRT ;HOMLUN=10
TABMAC PPN which refreshed STR , OCTPPN ;HOMPPN=11
XWD Z , CPOPJ ;HOMHOM=12
TABMAC Number of blocks/group to try for on output , DECPRT ;HOMGRP=13
TABMAC Blocks/supercluster , DECPRT ;HOMBSC=14
TABMAC Superclusters/unit , DECPRT ;HOMSCU=15
TABMAC RIB byte pointer for cluster count , BYTPNT ;HOMCNP=16
TABMAC RIB pointer for checksum , BYTPNT ;HOMCKP=17
TABMAC RIB pointer for cluster address , BYTPNT ;HOMCLP=20
TABMAC Blocks per cluster , DECPRT ;HOMBPC=21
TABMAC K for swapping on unit , K4SPNT ;HOMK4S=22
TABMAC HOMREF (non-zero if refresh needed) , OCTPRT ;HOMREF=23
TABMAC Number of SAT blocks in core , DECPRT ;HOMSIC=24
TABMAC Unit ID of next unit in active swapping list , NPR6BT ;HIMSID=25
TABMAC Logical unit # in active swapping list , OCTPRT ;HOMSUN=26
TABMAC First log block number for swapping on unit , OCTPRT ;HOMSLB=27
TABMAC Swapping class , OCTPRT ;HOMCFS=30
TABMAC Number of SAT blocks/unit , DECPRT ;HOMSPU=31
TABMAC Blocks reserved for overdraw per user , DECPRT ;HOMOVR=32
TABMAC Sum of blocks guarenteed to users , DECPRT ;HOMGGAR=33
TABMAC <Logical block in STR of first RIB for files:
SAT.SYS> , OCTPRT
TABMAC < HOME.SYS> , OCTPRT
TABMAC < SWAP.SYS> , OCTPRT
TABMAC < MAINT.SYS> , OCTPRT
TABMAC < BADBLK.SYS> , OCTPRT
TABMAC < CRASH.SAV> , OCTPRT
TABMAC < SNAP.SAV> , OCTPRT
TABMAC < RECOV.SYS> , OCTPRT
TABMAC < SYS UFD> , OCTPRT
TABMAC < QUEUE UFD> , OCTPRT
TABMAC < MFD > , OCTPRT
TABMAC First retrieval ptr for MFD , OCTL12
TABMAC Logical unit where MFD starts , OCTPRT
TABMAC <Table of lengths of files created by refresh:
CRASH.SAV> , DECPRT
TABMAC < SNAP.SAV> , DECPRT
TABMAC < RECOV.SYS> , DECPRT
TABMAC < SYS UFD> , DECPRT
TABMAC < QUEUE UFD> , DECPRT
TABMAC < MFD> , DECPRT
; The following words defined in the UDB alone, not from home blocks
TABMAC Words/SAT , DECPRT
TABMAC Clusters/SAT , DECPRT
TABMAC Physical unit name (drive) , NPR6BT
TABMAC <Controller type,,unit within controller> , HALF8
TABMAC Blocks/cylinder , DECPRT
TABMAC Blocks/track , DECPRT
TABMAC Blocks on unit , DECPRT
Z ;ENDS THE LIST!!!
;SUBROUTINE TO PRINT A BLOCK OF DATA WITH MESSAGES FOR EACH WORD
;CALL F.TMP = 1 TO SUPRESS LISTING ZERO WORDS
; LH(T) = ADR. OF TABLE
; RH(T) = ADR OF DATA
;
;TABLE ENTRIES ARE OF FORMAT:
; LH - [ASCIZ\ARBITRARY MESSAGE\]
; RH - ROUTINE TO PRINT DATA IN AC N
;
;IF LH = Z, RH=Z MEANS END OF LIST, RH=NON-ZERO MEANS SKIP WORD.
;IE, XWD Z , CPOPJ ;SKIP WORD
; Z ;END OF LIST
LSTPN1: AOBJN T,.+1 ;POINT TO NEXT ENTRY
LSTPNT: HLRZ T1,T ;T1=ADR OF TABLE
HLRZ M,(T1) ;M=ADR OF MESSAGE TO PRINT
JUMPE M,LSTPN2 ;OR ZERO IF END OF LIST OR SKIP WORD
SKIPN N,(T) ;N=WORD TO PRINT. ZERO??
TXNN F,F.TMP ;YES. ARE WE TO SUPRESS ZEROES?
SKIPA ;NO TO EITHER. PRINT IT
JRST LSTPN1 ;YES TO BOTH. IGNORE THIS WORD
PUSHJ P,MSG ;PRINT MSG
PUSHJ P,EQUAL
HRRZ T1,(T1) ;ADR. OF WHERE TO GO
PUSH P,T ;SAVE OUR ONE IMPORTANT AC
PUSHJ P,(T1) ;GO THERE AND PRINT
POP P,T
PUSHJ P,CRLF
JRST LSTPN1
;HERE IF ZERO LEFT HALF
LSTPN2: SKIPN (T1) ;WHOLE WORD ZERO?
POPJ P, ;YES. DONE
JRST LSTPN1 ;NO. JUST IGNORE IT
HEDBLK: MOVEI M,[ASCIZ/
[Logical block /]
PUSHJ P,MSG
MOVE N,CURPOS(U) ;CURRENT BLOCK JUST READ
PUSHJ P,OCTPRT ;
MOVEI M,[ASCIZ/ on /]
PUSHJ P,MSG
SKIPN M,HOMLOG(U)
MOVE M,DRIVE(U)
PUSHJ P,PR6BIT
PUSHJ P,RBRKT ;CLOSING BRACKET
PJRST CRLF
;SUBROUTINE TO PRINT A BYTE POINTER. PRINTS A
;12 DIGIT OCTAL NUMBER WITH ONES IN THE BYTE POSITION.
;EG, POINT 4,XYZ,8 PRINTS 017000000000
BYTPNT: HRRI N,N1 ;MAKE PTR POINT TO N1
SETO N1, ;N1:=ALL ONES
LDB N1,N ;N1:=AS MANY ONES AS BYTE LENGTH
LDB N,[POINT 6,N,5] ;N:=BYTE POSITION=35-RIGHTMOST BIT
LSH N1,(N) ;SHIFT N1 OVER TO BYTE POSITION
MOVE N,N1 ;AND PUT IT INTO N FOR PRINTING
PJRST OCTL12 ;AND PRINT IT
SUBTTL Error processing routines
; Here for various command string error messages
CMDERR: JSP M,CMDER1
ASCIZ/?Command error/
CMDER1: MOV <[POINT 1,ZERO]> , CMDB
PJRST ERR000
BADMON: JSP M,MSGXIT
ASCIZ /?Must be level D or later/
BADBOY: OUTSTR [ASCIZ/?Job not privilleged/]
EXIT
NOTTY: OUTSTR [ASCIZ/?Can't OPEN TTY/]
EXIT
NOLPT: JSP M,MSGXIT
ASCIZ /?Can't INIT listing device/
EFAIL: JSP M,MSGXIT
ASCIZ /?Listing file ENTER failed/
BADSW: JSP M,CMDER1
ASCIZ/?Bad switch/
BADCFG: JSP M,MSGXIT
ASCIZ/?SFD configuration error - check SFDLVL parameter/
; Various error messages. JRST RIPDON when done
ERR000: PUSHJ P,MSGTTY
PUSHJ P,CRLF
OUTPUT CMD,
JRST RIPDON
ERR001: JSP M,ERR000
ASCIZ /?Bad option/
ERR002: JSP M,ERR000
ASCIZ /?File name arg illegal/
ERR003: JSP M,ERR000
ASCIZ/?INIT failure on scratch device/
ERR004: JSP M,ERR000
ASCIZ/?ENTER failure on scratch file/
ERR005: JSP M,ERR000
ASCIZ/?No data input yet/
ERR006: JSP M,ERR000
ASCIZ/?Word must be 0-177/
ERR007: JSP M,ERR000
ASCIZ/?LOOKUP failure on scratch file/
; Various error messages continued
ERR008: JSP M,ERR000
ASCIZ/?SAT's not in core/
ERR009: JSP M,ERR000
ASCIZ/?SAT IOERR/
ERR010: JSP M,ERR000
ASCIZ/
Cannot rewrite SATS unless all files specified/
ERR011: JSP M,ERR000
ASCIZ\ /IF may only have one of S or R options\
ERR014: JSP M,ERR000
ASCIZ/?Can't find RIPOFF.HLP/
ERR015: JSP M,ERR000
ASCIZ\?Device must be a structure to fix SATs\
ERR016: JSP M,ERR000
ASCIZ\?Function illegal when structure is mounted\
ERR017: JSP M,ERR000
ASCIZ/?Device must be a structure/
ERR018: JSP M,ERR000
ASCIZ\?Cannot specify non-star SFD's with /DU\
; Catastrophic error messages.
DIE000: CLOSE LST, ; Close output file
RELEAS LST, ; and release it
RESET ; Stop the world the hard way
OUTSTR (M) ; Type message
EXIT ; and die
JRST .-1 ; No restart
DIE001: JSP M,DIE000
ASCIZ/? SUSET. UUO failed/
DIE002: JSP M,DIE000
ASCIZ/[User abort]/
DIE003: JSP M,DIE000
ASCIZ/? REWSTR failed/
DIE004: JSP M,DIE000
ASCIZ/? Internal UDB's messed up/
DIE005: JSP M,DIE000
ASCIZ/[AUX device abort]/
DIE006: JSP M,DIE000
ASCIZ/? NXTSTR OPEN failed/
; Questionable operation messages. POPJ when done
MSG000: PUSH P,F
PUSHJ P,MSGTTY
PUSHJ P,CRLF
OUTPUT CMD, ; Yes. Make sure message gets out
POP P,F
POPJ P, ; and return
MSG001: JSP M,MSG000
ASCIZ/Wait plz.../
; Various operator questions. If answer is yes, return+0.
; If answer no, JRST RIPDON.. Flags preserved, AC's M,CH destroyed.
; All others preserved.
ASK000: PUSHJ P,OPER
JRST RIPDON
POPJ P,
ASK001: JSP M,ASK000
ASCIZ/Not same STR/
ASK002: JSP M,ASK000
ASCIZ/Not same block/
ASK003: JSP M,ASK000
ASCIZ/Wipe out all files? Are you sure? /
ASK004: JSP M,ASK000 ;
ASCIZ /Device is not a structure/
ASK005: JSP M,ASK000 ;
ASCIZ\Write listing to same structure on which /V is being done?
If no, type:
^C
ASSIGN dev LST
RUN RIPOFF\
SUBTTL I/O routines for operator communication
;SUBROUTINE TO ASK OPERATOR TO CONTINUE OR NOT.
;RET+0 IF NOT,
;RET+1 IF HE SAYS YES
OPER: PUSHJ P,SAVALL
MOVEM M,TEMP
JSP M,TTYOUT
OPER2: MOVE M,TEMP
PUSHJ P,MSGTTY
MOVEI M,[ASCIZ/
Proceed? /]
PUSHJ P,MSG
OUTPUT CMD,
SETZM RH.CMD+2 ;NO TYPEAHEAD.
MOV <[POINT 1,ZERO]> , CMDB
CLRBFI
PUSHJ P,R.CMD
SETZM RH.CMD+2 ; Clear all typeahead
CLRBFI
CAIN CH,"Y"
JRST CPOPJ1
CAIE CH,"N"
JRST OPER2 ;MUST SAY ONE OR OTHER
POPJ P,
;SUBROUTINE TO CHECK THAT BOTH NAME AND EXT ARE STARS.
;RET+0 IF EITHER NOT STAR.
;RET+1 IF ALL STARS
NONAME: TXNN F,S.NAM
POPJ P,
TXNN F,S.EXT
POPJ P,
JRST CPOPJ1
;PRINT A "FILE.EXT"
FILPNT: MOVE T,USRNAM
HLLZ T1,USREXT
;ROUTINE TO PRINT A FILE.EXT WITH FILE NAME IN T AND EXT IN T1.
; Call with F.FNOTB set to print with dot between filename and
; extension instead of TAB.
NAMPNT: LDB M,[POINT 6,T,5] ;GET FIRST 6 BIT CHAR
PUSHJ P,NAMTST ;SKIP IF SIXBIT
JRST NAMP1 ;NOT SIXBIT. LOOK CLOSER.
NAM6BT: MOVE M,T ;PRINT IT AS SIXBIT.
TXZE F,F.NOTB ; Print with dot?
JRST NAM6B1 ; Yep, go do it
PUSHJ P,PR6ALL
NAMEXT: PUSHJ P,TAB
HLLZ M,T1 ;EXTENSION WILL ALWAYS BE SIXBIT
PJRST PR6ALL
NAM6B1: PUSHJ P,PR6BIT ; Print as SIXBIT
NAMEX1: PUSHJ P,DOT ; Followed by dot
HLLZ M,T1 ; Get ext
PJRST PR6BIT ; And print in SIXBIT also
NAMP1: CAIE M,'.' ;THE ONLY SIXBIT CHAR WHICH IS NOT
;A-Z,0-9 AND STILL IN FILENAMES.
JRST NAMOCT ;NOT A DOT, PRINT IT IN OCTAL
LDB M,[POINT 6,T,11];TRY SECOND CHAR THEN.
PUSHJ P,NAMTST
SKIPA ;NOT A-Z,0-9. REALLY OCTAL THEN
JRST NAM6BT ;AOK. PRINT 6BIT
NAMOCT: MOVE N,T
PUSHJ P,HALF8
TXZN F,F.NOTB ; Print dot or tab?
JRST NAMEXT ; tab
JRST NAMEX1 ; dot
NAMTST: CAIL M,'0'
CAILE M,'Z'
POPJ P,
CAIGE M,'A'
CAIG M,'9'
JRST CPOPJ1
POPJ P,
; Routine to print the current path from USRPTH. Stops on a zero
; word or the nesting specified by CURLVL, whichever comes first.
UFDPNT: MOVEI CH,"["
PUSHJ P,W.LST ; Start with "["
PUSH P,P1 ; Get a pointer to use
PUSH P,P2 ; Plus limit word
MOVE P2,CURLVL ; Get current level of nesting
ADDI P2,USRPTH+.PTPPN ; Compute max offset
MOVEI P1,USRPTH+.PTPPN; Get pointer to start of path
MOVE N,(P1) ; Get PPN
PUSHJ P,OCTPPN ; and print in octal
UFDPN2: CAML P1,P2 ; Done yet?
JRST UFDPN3 ; Yep
MOVE M,1(P1) ; Get next SFD name
JUMPE M,UFDPN3 ; If we have reached the end
PUSHJ P,COMMA ; Make it look good
PUSHJ P,PR6BIT ; Type name
AOJA P1,UFDPN2 ; Loop for all
UFDPN3: POP P,P2 ; Restore P2
POP P,P1 ; Restore P1
PJRST RBRKT ; Finish off with right bracket
; Routine to print FILE.EXE[path] of file LOOKed UP
; on channel (P4). Set at LOOKP.
CHNPNT: MOVX T,IO.FAC
TDNN T,IOSTS(P4) ; File active on this channel?
POPJ P, ; No. Forget it
MOVE T,FNAME(P4)
HLLZ T1,FEXT(P4)
TXO F,F.NOTB ; Use dot instead of tab
PUSHJ P,NAMPNT ; Print name.ext
MOVEI CH,"["
PUSHJ P,W.LST
MOVE N,FPATH+.PTPPN(P4)
PUSHJ P,OCTPPN ; Print [P,PN]
PUSH P,P1 ; Get an index to use
MOVEI P1,FPATH+.PTPPN+1(P4) ; Point to first SFD word
CHNPN1: SKIPN M,(P1) ; Skip if next SFD is non-null
JRST CHNPN2 ; At end of path if null SFD
PUSHJ P,COMMA ; Print a comma
PUSHJ P,PR6BIT ; Print the SFD name
AOJA P1,CHNPN1 ; and loop for all
CHNPN2: POP P,P1 ; Restore P1
MOVEI CH,"]"
PJRST W.LST
; Subroutine to set TTY I/O and reset flags after return to lower
; level of pushdown. Call JSP M,TTYOUT
TTYOUT: PUSH P,F ; Put flags onto stack
ANDI F,F.TTY!F.TTY2 ; F:=State of TTY flags only
EXCH F,(P) ; Get back flags, stack TTY state
TTYON ; Turn on TTY I/O
PUSHJ P,(M) ; Return to caller
SKIPA
AOS -1(P)
TTYOFF ; Shut off TTY now.
TDO F,(P) ; Reset TTY state before call
SUB P,ONEONE ; Reset pushdown depth
POPJ P, ; and return to higher caller
;ROUTINE TO PRINT AN ERROR CODE IN AC N ALONG WITH ANY MESSAGE
;CALL: RH(T) = ADR. OF MESSAGE TABLE
; LH(T) = NUMBER OF HIGHEST ERROR IN TABLE
;
; MESSAGE TABLE SHOULD LOOK LIKE:
; XWD [ASCIZ/MSG1/] , [ASCIZ/MSG2/]
;
ERRPNT: MOVEI M,[ASCIZ/ (/]
PUSHJ P,MSG ;GIVE OPENING PAREN
MOVE P1,N ;SAVE ERROR CODE
PUSHJ P,OCTPRT ;AND PRINT IT
HLRZ T1,T ;GET MAX # OF ERRORS
CAMG P1,T1 ;CAN WE PRINT A SPECIFIC MESSAGE?
JRST ERRPN1 ;YES. GO DO IT.
ERRPN2: MOVEI M,[ASCIZ/) error code /];NO. JUST SAY IT IS AN ERROR
MOVE N,P1 ;RESTORE N
PJRST MSG ;AND RETURN
ERRPN1: MOVEI M,[ASCIZ/) /] ;CLOSING PAREN
PUSHJ P,MSG
MOVE N,P1 ;RESTORE N
HRRZS T ;T=ERROR TABLE ADR.
IDIVI P1,2
ADDI P1,(T) ;P1=ADR. OF THIS ERROR MESSAGE
SKIPE P2 ;IF N WAS ODD,
SKIPA M,(P1) ;USE RH OF TABLE ENTRY.
HLRZ M,(P1) ;IF N EVEN, USE LH OF TABLE
JUMPE M,ERRPN2 ;IF ZERO, GIVE GENERAL MESSAGE ONLY
PJRST MSG ;PRINT IT AND RETURN TO CALLER
;ROUTINE TO PRINT ASCIZ MESSAGES POINTED TO IN "M"
EMSG: TXOA F,F.ERRM ;SET FOR ERROR MESSAGES
MSGTTY: TTYON ;FORCE TTY MESSAGES
MSG: HRLI M,(POINT 7,0)
MSGL: ILDB CH,M
JUMPE CH,CPOPJ
PUSHJ P,W.LST
JRST MSGL
CPOPJ1: AOSA (P) ;GIVE SKIP RETURN
T1POPJ: POP P,T1 ;
CPOPJ: POPJ P,
UPOPJ1: AOS -1(P) ; Bump return point
UPOPJ: POP P,U ; Restore U
POPJ P, ; and return
;ROUTINES TO PRINT SPECIAL CHARACTERS
EQUAL: JSP M,MSG
ASCIZ/ = /
ECRLF: TXO F,F.ERRM
PJRST CRLF
CRLF3: PUSHJ P,CRLF
CRLF2: PUSHJ P,CRLF
CRLF: JSP M,MSG
ASCIZ/
/
%CRLF: JSP M,MSG
ASCIZ /%
/
SPC2: PUSHJ P,SPC
SPC: SKIPA CH,[" "]
FORM: MOVEI CH,.CHFFD
PJRST W.LST
COMMA: SKIPA CH,[","]
DOT: MOVEI CH,"."
PJRST W.LST
TAB2: PUSHJ P,TAB
TAB: SKIPA CH,[.CHTAB]
SLASH: MOVEI CH,"/"
PJRST W.LST
RPAR: SKIPA CH,[")"]
DASH: MOVEI CH,"-"
PJRST W.LST
PLUS: SKIPA CH,["+"]
RBRKT: MOVEI CH,"]"
PJRST W.LST
COLON: SKIPA CH,[":"]
LPAR: MOVEI CH,"("
PJRST W.LST
; Print SIXBIT word in AC "N"
NPR6BT: MOVE M,N ; and fall into PR6BIT
; Print SIXBIT word in AC "M"
; PR6BIT quits on first blank, PR6ALL prints all
PR6ALL: TDZA T,T
PR6BIT: SETO T,
HRLM T,(P) ; Remember entry
MOVE T,[POINT 6,M]
PR6BT1: ILDB CH,T
SKIPGE (P) ; Skip test if entry at PR6ALL
JUMPE CH,CPOPJ ; Otherwize test.
ADDI CH," "
PUSHJ P,W.LST
TLNE T,770000
JRST PR6BT1
POPJ P,
; Here to print AC N as a 12 digit octal number
OCTL12: MOVEI M,^D12
OCTLL: MOVEI N1,6
ROTC N,3
MOVEI CH,(N1)
PUSHJ P,W.LST
SOJG M,OCTLL
POPJ P,
; Here to print AC "N" as halfword octal
OCTPPN: TDZA T,T ; Flag entry point
HALF8: SETOM T ; Same here
HRR T,N ; Save prog number for later
PUSH P,T ; Save flag and prog number on stack
HLRZS N ; Isolate proj number
PUSHJ P,OCTPRT ; Print it
PUSHJ P,COMMA ; Followed by comma
SKIPGE (P) ; Skip second comma if entry at OCTPPN
PUSHJ P,COMMA
POP P,N ; Restore prog number
HRRZS N ; and isolate it
PJRST OCTPRT
; Routines to print right-justified integers
; Field width in AC "T"
; Number in AC "N"
DECSPC: SKIPA CH,[" "] ; Decimal with leading spaces
DECZRO: MOVEI CH,"0" ; Decimal with leading zeroes
MOVEI M,^D10
JRST RJRDXP
OCTSPC: SKIPA CH,[" "] ; Octal with leading spaces
OCTZRO: MOVEI CH,"0" ; Octal with leading zeroes
MOVEI M,^D8
RJRDXP: MOVE N1,M
JUMPL N,RDXPRT+1
JUSTFY: SOJLE T,RDXPRT ; Right justify
CAMGE N,N1
PUSHJ P,W.LST
IMUL N1,M
JRST JUSTFY
OCTPRT: SKIPGE N ; Number have sign bit set?
PJRST OCTL12 ; Yes, print all 12 digits
MOVEI M,^D8 ; Get radix
JRST RDXPR1 ; and print as octal
DECPRT: PUSH P,[DOT] ; Print dot at end of dec. number
DECPR1: MOVEI M,^D10 ; Here to print decimal numbers
RDXPRT: SKIPGE N ; Number negative?
PUSHJ P,DASH ; Yes, print minus
MOVMS N ; Get absolute value
RDXPR1: IDIVI N,(M) ; Divide by radix
HRLM N1,(P) ; Save remainder
SKIPE N ; Done?
PUSHJ P,RDXPR1 ; No, call ourselves
HLRZ CH,(P) ; Get number from stack
ADDI CH,"0" ; Convert to ASCII
JRST W.LST ; Print and return to caller
SUBTTL Date routines for internal conversion
; Routine to set T3=Universal standard creation Date.Time word of a file.
; Uses RIBTIM if exists, else gets 12 or 15 bit old format and converts.
FILDAT: JSP M,SAVE3 ; Save some AC's
SKIPN T3,BUF+RIBTIM ; Got a universal date already?
JRST FILDT0 ; No. Got to build one.
HRRZ P1,BUF+RIBFIR
CAILE P1,RIBTIM ; This an old style RIB?
POPJ P, ; No. Date is valid.
; Here if not new style RIB, must build date.time word
FILDT0: PUSH P,T1 ; Save T1,T2
PUSH P,T2
LDB T2,EXLLCD ; Get 12 low order bits of creation date
LDB T1,EXLHCD ; plus 3 high order bits
DPB T1,[POINT 3,T2,23] ; Make 15 bit date
LDB T1,EXLCRT ; Get time
IMULI T1,^D60*^D1000 ; T1=Time in milliseconds, T2=15 bit date
FILDT1: PUSHJ P,.CNVDT ; Convert T1,T2 to universal date.time in T3
POP P,T2
POP P,T1
POPJ P, ; Restore AC's and return.
; Here to return T3=universal file access date ,, 0 time
FILACD: JSP M,SAVE3 ; Save AC's
SETZ T1, ; Set zero time
LDB T2,EXLACD ; Get 15 bit date
PUSH P,T1
PUSH P,T2
JRST FILDT1 ; and continue like FILDAT
; Here to print a universal date/time as dd-mmm-yy hh:mm:ss
; Call with date/time in N
DATTIM: MOVE T3,N ; Where PRDATE and PRTIME wants it
PUSH P,T3 ; Save it
PUSHJ P,PRDATE ; Print the date
POP P,T3 ; Restore the word
PJRST PRTIME ; Print time and return
;SUBROUTINES TO CONVERT DATES FROM 15 BIT TO UNIVERSAL AND BACK.
;STOLEN FROM SCAN.MAC, COPYRIGHT DEC....
;
;SUBROUTINE TO CONVERT FROM UNIVERSAL DATE.TIME WORD IN T3 TO 15 BIT
;RETURNS T1=MILLISECOND TIME (SINCE MIDNIGHT), T2= 15 BIT DATE.
;
.CNTDT: MOVE T1,T3 ;DEC VERSION NEEDS IT IN T1, RIPOFF CALLS
;IT FROM T3
PUSH P,T1 ;SAVE TIME FOR LATER
JUMPL T1,CNTDT6 ;DEFEND AGAINST JUNK INPUT
HLRZ T1,T1 ;GET DATE PORTION (DAYS SINCE 1858)
RADIX 10 ;**** NOTE WELL ****
ADDI T1,365*400+24*4-<2001-1859>*365-<2001-1859>/4-31-30+17 ;MAKE INTO DAYS SINCE JAN 1, 1601
IDIVI T1,365*400+24*4+1 ;SEPARATE UNITS OF 400
LSH T1,2 ;MULT ANSWER BY 4
IDIVI T2,365*100+24 ;SEPARATE CENTURIES
CAIN T2,4 ;SEE IF LAST ONE
SOSA T2 ;YES--BACK OFF
JRST .+2 ;CONTINUE SKIP
MOVEI T3,365*100+24 ;SET TO FULL (LEAP) CENTURY
ADD T1,T2 ;INCLUDE CENTURIES IN RESULT
IMULI T1,25 ;MULT ANSWER BY 25
IDIVI T3,365*4+1 ;SEPARATE UNITS OF 4
ADD T1,T3 ;INCLUDE IN ANSWER
LSH T1,2 ;MULT ANSWER BY 4
MOVE T3,T4 ;PROMOTE AC
IDIVI T3,365 ;SEPARATE YEARS
CAIN T3,4 ;SEE IF END OF LEAP YEAR
SOSA T3 ;YES--BACK OFF YEAR
JRST .+2 ;CONTINUE SKIP
MOVEI T4,365 ;SET FOR END OF YEAR
ADDI T1,1601(T3) ;GET REAL YEAR
;T1 HAS YEAR, T4 HAS DAY IN YEAR
MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR
IDIVI T2,400 ;SEE IF MULT OF 400
JUMPE T3,CNTDT1 ;YES--PROCEED
MOVE T2,T1 ;GET NEW COPY
IDIVI T2,100 ;SEE IF MULT OF 100
JUMPE T3,[MOVEI T3,1 ;YES--FLAG AS NO L.Y.
JRST CNTDT1] ;AND PROCEED
MOVE T2,T1 ;GET NEW COPY
IDIVI T2,4 ;SEE IF MULT OF 4
;T3 IS 0 IF LEAP YEAR
;UNDER RADIX 10 **** NOTE WELL ****
CNTDT1: SUBI T1,1964 ;SET TO SYSTEM ORIGIN
IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS
JUMPN T3,CNTDT2 ;IF NOT LEAP YEAR, PROCEED
CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
JRST CNTDT5 ;NO--JUST INCLUDE IN ANSWER
SOS T4 ;YES--BACK OFF ONE DAY
CNTDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS
CNTDT3: CAMGE T4,.MNTAB+1(T2) ;SEE IF BEYOND THIS MONTH
JRST CNTDT4 ;YES--GO FINISH UP
ADDI T1,31 ;NO--COUNT SYSTEM MONTH
AOBJN T2,CNTDT3 ;LOOP THROUGH NOVEMBER
CNTDT4: SUB T4,.MNTAB(T2) ;GET DAYS IN THIS MONTH
CNTDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT
CNTDT6: EXCH T1,(P) ;SAVE ANSWER, GET TIME
TLZ T1,-1 ;CLEAR DATE
MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC.
ASHC T1,17 ;POSITION RESULT
POP P,T2 ;RECOVER DATE
POPJ P, ;RETURN
;UNDER RADIX 10 **** NOTE WELL ****
;.CNVDT -- CONVERT 12 OR 15 BIT DATE TO UNIVERSAL DATE
;CALL: MOVE T1,TIME IN MILLISEC.
; MOVE T2,DATE IN 12 OR 15 BIT FORMAT
; PUSHJ P,.CNVDT
;RETURNS WITH RESULT IN T3 (.GT.0; OR -1 IF BEYOND SEPT. 27,2217)
.CNVDT: PUSH P,T1 ;SAVE TIME FOR LATER
IDIVI T2,12*31 ;T2=YEARS-1964
CAILE T2,2217-1964 ;SEE IF BEYOND 2217
JRST GETNW2 ;YES--RETURN -1
IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1
ADD T4,.MNTAB(T3) ;T4=DAYS-JAN 1
MOVEI P1,0 ;LEAP YEAR ADDITIVE IF JAN, FEB
CAIL T3,2 ;CHECK MONTH
MOVEI P1,1 ;ADDITIVE IF MAR-DEC
MOVE T1,T2 ;SAVE YEARS FOR REUSE
ADDI T2,3 ;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS
CAIE T3,3 ;SEE IF THIS IS LEAP YEAR
MOVEI P1,0 ;NO--WIPE OUT ADDITIVE
ADDI T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
MOVE T2,T1 ;RESTORE YEARS SINCE 1964
IMULI T2,365 ;DAYS SINCE 1964
ADD T4,T2 ;T4=DAYS EXCEPT FOR 100 YR. FUDGE
HRREI T2,64-100-1(T1) ;T2=YEARS SINCE 2001
JUMPLE T2,GETNW1 ;ALL DONE IF NOT YET 2001
IDIVI T2,100 ;GET CENTURIES SINCE 2001
SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS
CAIE T3,99 ;SEE IF THIS IS A LOST L.Y.
GETNW1: ADD T4,P1 ;ALLOW FOR LEAP YEAR THIS YEAR
CAILE T4,^O377777 ;SEE IF TOO BIG
GETNW2: SETOM T4 ;YES--SET -1
POP P,T1 ;GET MILLISEC TIME
MOVEI T2,0 ;CLEAR OTHER HALF
ASHC T1,-17 ;POSITION
DIV T1,[24*60*60*1000] ;CONVERT TO 1/2**18 DAYS
HRL T1,T4 ;INCLUDE DATE
MOVE T3,T1 ;DEC VERSION RETURNS NOW, DATE,,TIME IN T1
;RIPOFF NEEDS IT IN T3..
POPJ P, ;RETURN
;UNDER RADIX 10 **** NOTE WELL ****
.MNTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 8
SUBTTL Input routines for command scanner
;
;
; RDATOM reads one command name of any type and returns it in AC 'M'.
; AC 'CH' returns with the next char after the atom, i.e.,
; the break character. AC 'P4' returns the arg type, i.e.:
;
$CMBRK==0 ; No args read (first char scanned was a break char)
$CMBLK==1 ; M is a block argument
$CMFIL==2 ; M is a file name
RDATOM: SETZB P4,M ; Start with no arg type, no arg
TXZ F,.LBS
ILDB CH,CMDB ; Get a char from CMD string
CAIN CH,"^"
JRST RDXCNG ; ^D or ^O sets radix
CAIN CH,"#"
JRST CLUS ; # means clusters follow
CAIN CH,"$"
JRST RDATM4 ; $ means octal file name
CAIN CH,"'"
JRST SIXBRD ; Single quote means SIXBIT
CAIN CH,""""
JRST ASCIRD ; Double quote reads ASCII name
CAIL CH,"0" ; Between 0-9?
CAILE CH,"9"
JRST RDATM3 ; No. Must be file name
IBP CMDB ; Yes. Must back up byte ptr
IBP CMDB ; So RDNUMR reads whole thing
IBP CMDB
IBP CMDB
SOS CMDB ; Really do need DBP (Dec. Byt. Ptr.) instn
JRST BLKS ; and go read block number
RDWORD: SETZB P4,M ; Alternate entry to always read name
RDATM4: ILDB CH,CMDB ; Name is SIXBIT (even though numeric)
RDATM3: MOVEI P4,$CMFIL ; Must be SIXBIT file name
MOVE T,[POINT 6,M]
RDATM1: CAIL CH,"A" ; File names are alphabetic
CAILE CH,"Z"
SKIPA
JRST RDATM2
CAIN CH,"*" ; or stars
JRST RDATM2
CAIL CH,"0" ; or numbers
CAILE CH,"9"
POPJ P, ; None of these, done.
RDATM2: TRC CH,40 ; SIXBITize it
TLNE T,770000
IDPB CH,T
ILDB CH,CMDB ; and get next char
JRST RDATM1
; Here on up-arrow, change radix
RDXCNG: ILDB CH,CMDB ; Get next character
SETZ T,
CAIN CH,"D" ; Was it ^D?
MOVEI T,^D10 ; Yes, set radix
CAIN CH,"O" ; How 'bout ^O?
MOVEI T,^D8 ; Use appropriate radix
CAIN CH,"B" ; Last chance is ^B
MOVEI T,2 ; Yes, use 2 as radix
JUMPE T,CMDERR ; If none of the above, command error
MOVEM T,RADIX ; Save for posterity
PUSH P,[RDXCN2] ; Return here after reading number
MOVE T1,CMDB ; Get command string byte pointer
ILDB CH,T1 ; Lookahead one character
CAIE CH,"#" ; Start of cluster arg?
JRST RDXCN1 ; No
MOVEM T1,CMDB ; Advance pointer across #
TXO F,.LBS ; Flag cluster argument
RDXCN1: MOVE T1,CMDB ; Get possibly changed pointer back
ILDB CH,T1 ; Get next character
CAIL CH,"0" ; Make sure a number is next
CAILE CH,"0"-1(T) ; (of the correct radix)
JRST CMDERR ; Nope, error
JRST BLKS ; Go read it, return at RDXCN2
RDXCN2: MOVI ^D8,RADIX ; Restore radix
POPJ P, ; and return
; Here if block arg indicated (numeric or preceeding #)
CLUS: TXO F,.LBS ; Tell SCAN we saw pound sign
BLKS: MOVEI P4,$CMBLK ; Indicate block arg
PJRST RDNUMR ; and go read a number
; Subroutine to read a number. May be half word octal delimited by comma,
; May contain arithmetic operators +-*' (with no imbedded spaces and
; please no parenthetical expressions!)
RDNUMR: MOVE T,CMDB
ILDB CH,T
CAIE CH,"*" ; See if first char is star
JRST RDNUM1
IBP CMDB ; Yes. Inc past it since a lone
ILDB CH,CMDB ; star means 'ALL' , not multiplication!
SKIPA M,[EXP 400000] ; and flag star in answer
RDNUM1: PUSHJ P,NUMIN ; Go read a number
CAIE CH,"," ; End in a comma?
POPJ P, ; No. done
HRLZM M,N ; Yes. save this half of number
MOVE T,CMDB ; Test again for lone star/other comma
ILDB CH,T
CAIE CH,"," ; Have two commas between halfwords?
JRST RDNUM3 ; Nope
ILDB CH,T ; Get next character to test
IBP CMDB ; and adjust CMD string BP also
RDNUM3: CAIE CH,"*"
JRST RDNUM2
IBP CMDB
ILDB CH,CMDB
SKIPA M,[EXP 400000]
RDNUM2: PUSHJ P,NUMIN
HLL M,N ; Retrieve first half of number
POPJ P, ; and thats all..
; Here to read in a simple little number
NUMIN: SETZM NUMB ; Start with no number
SETZM TERMCH ; and no preceeding character
MOVE N1,RADIX ; and get current radix
NUMIN0: SETZ M, ; Here for next number
NUMINL: ILDB CH,CMDB ; Read a digit
CAIL CH,"0" ; Or is it a digit?
CAILE CH,"0"-1(N1) ; That's hairy
JRST NUMIN1 ; On the other hand, thats not a digit.
IMULI M,(N1) ; Digit. Increase running sum radix-fold
ADDI M,-"0"(CH) ; Add in this newest digit
JRST NUMINL ; Loop for remaining digits.
NUMIN1: EXCH CH,TERMCH ; Get term char of last number
CAIE CH,"+" ; Add??
JRST NUMIN2
NUMIN5: ADDM M,NUMB
JRST NUMIN9
NUMIN2: CAIE CH,"-" ; Subtract?
JRST NUMIN3
SUBM M,NUMB
MOVNS NUMB
JRST NUMIN9
NUMIN3: CAIE CH,"*" ; Multiply?
JRST NUMIN4
IMULM M,NUMB
JRST NUMIN9
NUMIN4: CAIE CH,"'" ; Divide?
JRST NUMIN5 ;NO NONE OF THESE..
EXCH M,NUMB
IDIVM M,NUMB
NUMIN9: MOVE CH,TERMCH
CAIE CH,"+"
CAIN CH,"-"
JRST NUMIN0
CAIE CH,"*"
CAIN CH,"'"
JRST NUMIN0
MOVE M,NUMB ; All done. make M=number
POPJ P,
; Here to read SIXBIT and ASCII names between delimiters
SIXBRD: SETZ M, ; Start with no name
ILDB P1,CMDB ; Read the delimiter
MOVE T,[POINT 6,M] ; SIXBIT pointer
MOVEI T1,770000 ; Non-zero bits in a SIXBIT pointer
ANYBRD: MOVEI P4,$CMFIL ; Flag this as a name
ILDB CH,CMDB ; Get next char
CAIL CH,40
CAIL CH,175
JRST CMDERR ; Can not be a line delimiter!
CAIN CH,(P1) ; Repeat of first delimiter yet?
JRST RDPOPJ ; Shoor'nuf
CAIN T1,770000 ; Processing ASCII or SIXBIT?
TRC CH,40 ; SIXBIT....
TLNE T,(T1) ; Reached end of word yet?
IDPB CH,T ; No. Put in this char
JRST ANYBRD+1 ; and continue
ASCIRD: ILDB P1,CMDB ; Read ASCII delimiter
MOVE T,[POINT 7,M] ; ASCII pointer
MOVEI T1,760000 ; Non-zero ASCII ptr bits
JRST ANYBRD
RDPOPJ: ILDB CH,CMDB ; Read char after last delimiter
POPJ P, ; and ret it
; Routine to get the startup option from the user.
; Returns CPOPJ always with the startup option in ST$OPT.
STUERR: MOVEI M,[ASCIZ/Quick, Long, Help
/]
PUSHJ P,MSGTTY ; Message to type on error
STRTUP: MOVEI M,[ASCIZ/Startup option: /]
PUSHJ P,MSGTTY ; Ask the user
OUTPUT CMD, ; Make sure he sees it
PUSHJ P,GETCMD ; Read the option into CMDBUF
PUSHJ P,RDWORD ; Get the answer in M
MOVE T,[-STULEN,,STUTBL] ; Get AOBJN pointer to table
JUMPN CH,STUERR ; Terminating char better be a break
SKIPE M ; Value better be non-null
PUSHJ P,FNDMAT ; It does, go find a match
JRST STUERR ; Bad option
PJRST @STUDSP(T) ; Go process it
;
; Here for Quick and Long options. Store value and return
;
STUQUI: SKIPA T,[$OPQUI] ; Get code for Quick option and skip
STULON: MOVEI T,$OPLON ; Same for Long option
MOVEM T,ST$OPT ; Save for later
POPJ P, ; and return
;
; Here for Help option. Give more detailed help message
;
STUHEL: MOVEI M,[ASCIZ/
Quick - Do not ask about off-line devices
Long - Full startup dialog
Help - Type this text
/]
PUSHJ P,MSGTTY ; Tell user
PJRST STRTUP ; and try again
;
; Generate the tables of correct responses. STUTBL contains
; the SIXBIT names of the valid options as defined by the
; OPTIONS macro. STUDSP contains the corresponding dispatch
; addresses for these options.
;
DEFINE OPTIONS, <
X QUICK
X LONG
X HELP
>
DEFINE X (OPT), <
$OP'OPT==.-STUTBL
SIXBIT/OPT/
>
STUTBL: OPTIONS
STULEN==.-STUTBL
DEFINE X (OPT), <
EXP STU'OPT
>
STUDSP: OPTIONS
; Routine to find a match in a table of SIXBIT names.
; Originally stolen from COMCON.
; Call with T = AOBJN pointer to table, M = SIXBIT name to match
; Returns CPOPJ if no (or ambiguous) match
; CPOPJ1 for unique match with T = index in table
FNDMAT: MOVN T1,M ; Find the rightmost
AND T1,M ; non-zero bit in the name
JFFO T1,.+1 ; and its cardinality
IDIVI T2,6 ; Find where in SIXBIT byte this bit is
LSH T1,-5(T3) ; Right-justify the bit within the byte
SOJ T1, ; Make mask of trailing blanks
SETZB T4,T2 ; Initialize match pointer and count
MOVE T3,T ; Save pointer to table
FNDMT2: MOVE N,(T) ; Get next candidate
XOR N,M ; Compare with one user gave
JUMPE N,FNDMT4 ; Jump if exact match
ANDCM N,T1 ; Mask table entry
JUMPN N,FNDMT3 ; No partial match either
MOVE T4,T ; Partial match--save pointer
MOVEI T2,1(T2) ; Count partial matches
FNDMT3: AOBJN T,FNDMT2 ; Loop for all entries
MOVE T,T4 ; Restore address of possible match
SOJN T2,CPOPJ ; More than one means error
FNDMT4: SUB T,T3 ; Compute table index of match
TLZ T,-1 ; Clear junk
JRST CPOPJ1 ; and return success
; Subroutine to input a date,,time word from the cmd TTY
REPEAT LOGIC,<
Type-in format is :
Date , Time or
Time , Date
Where date = dd-mmm-yy or dd-mmm-yyyy
and time = hh:mm:ss or hh:mm
Blanks or tabs may occur anywhere, comma must seperate the two.
Also, either time or date or both may be left out, zero returned
Returns T3=Universal date,,time word
>
GTDT5: POP P,RADIX ; Restore original radix
MOVEI M,[ASCIZ!
%Type date as dd-mmm-yy, time as hh:mm or hh:mm:ss
seperated by a comma
!]
PUSHJ P,MSGTTY
GTDATE: PUSHJ P,GETCMD ; Get the command string
PUSH P,RADIX ; Save old radix
MOVI ^D10,RADIX ; Implied radix ten here
SETZB P1,TTIME ; Clear junk
SETZM TDATE ; and lets read some stuff....
GTDT4: PUSHJ P,GTDNUM ; Read a number
CAIN CH,":" ; End in a colon?
JRST GTDT10 ; Yes. Go process time
CAIN CH,"-" ; How about a slash?
JRST GTDT20 ; Go process.
JUMPN CH,GTDT5 ; Anything else is err, unless EOL
; Here on EOL. Done
MOVE T1,TTIME ; Get time
IMULI T1,^D1000 ; in milliseconds
MOVE T2,TDATE
PUSHJ P,.CNVDT ; Convert to universal
SKIPN TDATE ; Special kludge **
; Did he give me a zero date??
HRRZS T3 ; Yes. So return zero date
; Note- He can never do
; a /IT before Jan-1-64, since that is zero
POP P,RADIX ; Restore old radix and
POPJ P, ; return
; Here to process time
GTDT10: IMULI M,^D3600 ; Convert hours to seconds
MOVE P1,M ; Store in P1
PUSHJ P,GTDNUM ; Read minites
IMULI M,^D60 ; Convert to seconds
ADD P1,M ; Add into running total
CAIN CH,"," ; Done here?
JRST GTDT11 ; Yes. Go process more
JUMPE CH,GTDT11
CAIE CH,":" ; More to come?
JRST GTDT5 ; No. Illegal
PUSHJ P,GTDNUM ; Read seconds
ADD P1,M ; Add them in there
GTDT11: MOVEM P1,TTIME ; Store time
JRST GTDT4 ; and loop
; Here to process date type-in
GTDT20: CAILE M,^D31 ; Day can't be > 31
JRST GTDT5 ; Else it's an error
MOVEI P1,-1(M) ; Day-1 to P1
SETZM N ; Setup to accumulate month
GTDT30: ILDB N1,CMDB ; Get next char
JUMPE N1,GTDT5 ; EOL is illegal here
CAIN N1,"-" ; Find end of month?
JRST GTDT40 ; Yes
ROT N1,-7 ; Left justify character
LSHC N,7 ; and accumulate it in N
JRST GTDT30 ; Loop for more
GTDT40: LSH N,7+1 ; Make it 0MMM0
TDO N,[BYTE (7)"-",0," "," ","-"] ; Make it -Mmm-
HRLZI T1,-^D12 ; Make AOBJN pointer for MONTAB
GTDT50: CAME N,MONTAB(T1) ; Find match in MONTAB?
AOBJN T1,GTDT50 ; No, try next
TLZN T1,-1 ; Clear LH and check for match
JRST GTDT5 ; No match, error
IMULI T1,^D31 ; T1=(mon-1)*31
ADD P1,T1 ; P1=(mon-1)*31+day-1
PUSHJ P,GTDNUM ; Get year
CAIG M,^D99 ; Allow 1978
ADDI M,^D1900 ; Convert from 78 to 1978
SUBI M,^D1964 ; Subtract zero year
IMULI M,^D31*^D12 ; M=(year-1964)*31*12
ADD P1,M ; P1=((yy-1964)*12+(mm-1))*31+dd-1
MOVEM P1,TDATE ; Save in core
JRST GTDT4 ; and see what's left
; Here to read a decimal number from the command string for date/time
; Returns number in M, terminator in CH
GTDNUM: SETZ M, ; Clear number
GTDNM1: ILDB CH,CMDB ; Get next char from command string
CAIL CH,"0" ; Is it a digit?
CAILE CH,"9"
POPJ P, ; No, that's it
IMULI M,^D10 ; Make room for next digit
ADDI M,-"0"(CH) ; Convert to binary and add to total
JRST GTDNM1 ; Loop for more
;ROUTINE TO PRINT THE EXACT TIME NOW..
NOW: MSTIME T1, ;TIME IN MILLISECONDS
IDIVI T1,^D60000
MOVE T3,T2
IDIVI T3,^D1000 ;SECONDS IN T3
IDIVI T1,^D60 ;HOURS IN T1, MINITES IN T2
MOVNI T4,2
SKIPA CH,[40]
NOWLUP: MOVEI CH,":"
PUSHJ P,W.LST
MOVEI T,2
MOVE N,T3(T4) ;GETS HOURS, THEN MIN, THE SECONDS
PUSHJ P,DECZRO
AOJLE T4,NOWLUP
PUSHJ P,SPC2
DATE T1, ;GET DATE AND HIT PRDT1
JRST PRDT1 ;GO PRINT IT.
;ROUTINE TO PRINT THE DATE, DATE IN T3 IN UNIVERSAL STANDARD
PRDATE: JSP M,SAVE3 ;SAVE P1
PUSHJ P,.CNTDT ;GET T1=MS TIME, T2=DATE IN 15 BIT
MOVE T1,T2 ;15 BIT DATE TO T1
PRDT1: IDIVI T1,^D31
MOVEI N,1(T2) ;DAY
MOVEI T,2
PUSHJ P,DECZRO
IDIVI T1,^D12
MOVE T2,MONTAB(T2) ;MONTH
SETZ T3,
MOVEI M,T2
PUSHJ P,MSG
MOVEI N,^D64(T1) ;YEAR
PUSHJ P,DECPR1 ;
PJRST SPC2 ;AND TWO SPACES
MONTAB: DEFINE MONMAC(X) <IRP X,<ASCII /-X-/ >>
MONMAC<Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>
; Routine to print the time. Call with universal date/time
; in T3. PRTIME prints as hh:mm:ss, PRTIM1 prints as hhmm
PRTIME: TLOA T3,-1 ; Flag entry
PRTIM1: TLZ T3,-1 ; Ditto
JSP M,SAVE3 ; Get some registers to use
HLRE P3,T3 ; Move entry flag to P3
HRRZ P1,T3 ; Move universal time to P1
IMULI P1,^D60*^D60*^D24 ; Convert to seconds
HLRZS P1 ; Compute seconds since midnight
IDIVI P1,^D60*^D60 ; P1=hours, P2=seconds into hour
MOVEI T,2 ; Field width
MOVE N,P1
PUSHJ P,DECZRO ; Print hours as two digits
SKIPE P3 ; Skip if entry at PRTIM1
PUSHJ P,COLON ; Print a colon
MOVE P1,P2 ; Get seconds back
IDIVI P1,^D60 ; P1=minutes, P2=seconds
MOVEI T,2 ; Field width
MOVE N,P1 ; Get minutes
PUSHJ P,DECZRO ; Print as two digits
SKIPN P3 ; Skip if entry at PRTIME
PJRST SPC2 ; End with 2 spaces if entry at PRTIM1
PUSHJ P,COLON ; Print colon
MOVEI T,2 ; Field width
MOVE N,P2 ; Get seconds
PUSHJ P,DECZRO ; Print as two digits
PJRST SPC2 ; End with space and return
;HERE TO WRITE TO THE LPT
W.LST: TXNE F,F.TTY!F.TTY2 ;TTY OUTPUT INSTEAD?
JRST W.CMD ;YES. WRITE TTY
SKIPN PAGES ;FIRST PAGE??
JRST W.LST0 ;YES. DO SPECIAL THINGS
CAIN CH,.CHLFD ;THIS A LINE FEED?
JRST .+4 ;YES.GO FIX LINE COUNT
CAIE CH,.CHFFD ;HOW ABOUT A FORM FEED?
JRST W.LST2 ;NEITHER. JUST GO TYPE IT
JRST PHED ;FORM FEED. GO PRINT NEW HEADER
AOS CH,LINES ;LINE FEED. INC LINE COUNT
CAILE CH,PAGSIZ ;DO A FREE FF YET??
JRST PHED ;YES.
MOVEI CH,.CHLFD
PUSHJ P,W.LST2 ;NO. JUST TYPE A LF
MOVEI CH,.CHTAB ;AND A TAB
TXZN F,F.ERRM ;UNLESS THIS IS AN ERROR MESSAGE
JRST W.LST2
POPJ P, ;IN WHICH CASE WE IGNORE THE TAB
PHED: MOVEM F,PHEDF ;SAVE FLAGS SO CAN TEST F.ERRM LATER
PUSHJ P,SAVALL ;SAVE AC'S
MOVEI CH,.CHFFD
PUSHJ P,W.LST2 ;BEGIN WITH A FORM FEED
SETZM LINES ;RESET LINE COUNT
SKIPN PAGES
SETOM PAGES ;TO STOP INFINITE LOOP AT W.LST+2
MOVEI M,IDRIP
PUSHJ P,EMSG ;RIPOFF V
LDB N,VERPTR
PUSHJ P,OCTPRT ;VERSION NUMBER
PUSHJ P,LPAR
HRRZ N,.JBVER
PUSHJ P,OCTPRT ;EDIT NUMBER
MOVEI M,[ASCIZ/) /]
PUSHJ P,MSG
PUSHJ P,NOW ;PRINT TIME AND DATE
MOVEI M,[ASCIZ/ */]
PUSHJ P,MSG
MOVE M,[POINT 7,CMDBUF]
MOVEI P1,MAXCMD
PHED1: ILDB CH,M ;GET A CMD STRING CHAR
JUMPE CH,PHED2
SOJLE P1,PHED3 ;TO MANY CHARS, IGNORE REST
PUSHJ P,W.LST2 ;PRINT IT
JRST PHED1 ;LOOP FOR ALL CHARS
PHED2: MOVEI CH," "
PUSHJ P,W.LST2
SOJG P1,PHED2
PHED3: MOVEI M,[ASCIZ/ Page /]
PUSHJ P,MSG
AOSG N,PAGES ;NOW GIVE PAGE COUNT
AOS N,PAGES
PUSHJ P,DECPRT
PUSHJ P,CRLF2
MOVE F,PHEDF ;RESTORE ORIGINAL FLAGS
PJRST CRLF ;ONE MORE CR BEFORE EXIT (FOR F.ERRM)
U(PHEDF)
W.LST2: SOSG WH.LST+2
OUTPUT LST,0
IDPB CH,WH.LST+1
POPJ P,
W.LST0: PUSH P,CH ;HERE IF VERY FIRST CHAR OUTPUT
PUSHJ P,PHED ;SINCE COMMAND STRING. PRINT HEADER
POP P,CH
CAIE CH,.CHLFD
CAIN CH,.CHFFD
POPJ P,
PJRST W.LST2 ;AND PRINT FIRST CHAR IF NOT LF OR FF
; Routine to read a command from the TTY and store it in CMDBUF.
; Returns CPOPJ always with ASCIZ command in CMDBUF and byte
; pointer to start of command in CMDB.
GETCMD: JSP M,SAVE3 ; Get some registers to use
MOVE P1,[POINT 7,CMDBUF] ; Get byte pointer to buffer
MOVEM P1,CMDB ; Save for calling routine
MOVEI P2,MAXCMD ; Max # of chars to input
GTCMD1: PUSHJ P,R.CMD ; Read a character
CAIE CH,.CHCNZ ; [075] ^Z typed?
JRST GTCMD4 ; [075] No.
CLOSE CMD,CL.OUT ; [075] Close input side of TTY
MOVEI CH,0 ; [075] Change character to a null
PUSH P,[GTCMD4] ; [075] Push return address from CZEXIT
PJRST CZEXIT ; [075] and go simulate a ^C
GTCMD4: ; [075]
CAIE CH,.CHTAB ; Ignore tabs and spaces
CAIN CH," "
JRST GTCMD1 ; [075]
CAIL CH," " ; Line delimeter?
CAIL CH,.CHALT
JRST GTCMD3 ; Yes, done
GTCMD2: SOJLE P2,GTCMD1 ; Too many chars, ignore the rest
IDPB CH,P1 ; Put character into CMDBUF
JRST GTCMD1 ; and continue scan
GTCMD3: SETZ CH, ; Make sure parser finds the end of
IDPB CH,P1 ; the string
IDPB CH,P1
POPJ P,
;GET A CMD STRING CHAR
R.CMD:
SOSG RH.CMD+2
INPUT CMD,
ILDB CH,RH.CMD+1
JUMPE CH,R.CMD ;IGNORE NULLS
CAIE CH,.CHDEL ;DELETE, AND
CAIN CH,.CHCRT ;CARRIAGE RETURN
JRST R.CMD
CAIL CH,.CHALT ;MAKE ALL ALTIMODES STANDARD
MOVEI CH,.CHESC
CAIL CH,"A"+40 ;AND CONVERT LOWER TO UPPER CASE
TRZ CH,40
POPJ P,
;HERE TO WRITE A CHARACTER TO THE TELETYPE
W.CMD:
SOSG WH.CMD+2
OUTPUT CMD,
IDPB CH,WH.CMD+1
CAIG CH,.CHCRT ;IF CARRIAGE RET OR LINE FEED,
OUTPUT CMD, ;FORCE OUTPUT
POPJ P,
;TEMPORY STORAGE
PDP: IOWD PDLSIZ,PLIST
VERPTR: POINT 9,.JBVER,11 ;POINTER TO MAJOR VERSION IN .JBVER
ONEONE: 1,,1 ;A COMMON CONSTANT..
BIGNUM: EXP -1_<-1> ;THE LARGEST POSITIVE 36 BIT NUMBER.
IDRIP: ASCIZ/Ripoff V./
HED1: ASCIZ /File Ext Log block Access Creation Prv Mode Words Blocks Err Number
Name 1st RIB Date Time Date Written Written Alloc Bits Ptrs/
BLKMSG: ASCIZ / blocks/
UBLKMG: ASCIZ / total disk space allocated to this user.
/
AVEMSG: ASCIZ / Average file size for /
AVEMS1: ASCIZ / files = /
UBLK1: ASCIZ / blocks
/
UHED: ASCIZ /
Unit Unit ID Log unit in STR
/
SATMSG: ASCIZ /
SAT block /
FREMSG: ASCIZ / free blocks left in this SAT block/
TOTMSG: ASCIZ / total disk space remaining.
/
TBLKMG: ASCIZ / total disk space used by all user's files.
/
BATHED: ASCIZ /BAT block for unit /
WASMSG: ASCIZ/
Blocks wasted in totally unwritten yet allocated blocks = /
MSGRIB: ASCIZ/
Number of blocks used for RIBS = /
NULMSG: ASCIZ/
Number of null UFDs = /
MISMSG: ASCIZ /
Discrepancies in number of free blocks
Computed SAT blocks DSKCHR
/
ERRHED: ASCIZ /
Number of files with each type of error
Hard Hard Soft Damage Backup Crash
write read check assess
/
HISHED: ASCIZ !File size and RIB length Histogram
N Files Rib ptrs
!
RIBHED: ASCIZ/
Retrieval pointers:
Pointer Block in # of Unit Checksum
unit STR blocks
/
DIRPM: ASCIZ/
File Ext Block in Unit
Name unit STR #
/
XLIST ;LITERALS UNDER XLIST
LIT
VAR
LIST
SUBTTL Low segment storage definitions
REPEAT LOGIC,<
;****************** Note *****************
All locations from ZROBEG through ZROEND are zeroed on every major
restart (i.e., all low segment cleared on 'START' or 'RUN' command).
All locations from CMDBEG through ZROEND are zeroed on every
command string (a star typed).
>
U(ZROBEG) ; ********* From here to ZROEND cleared on START
U(MFDPPN) ; Five PPNs from GETTAB
U(SYSPPN)
U(FSFPPN)
U(HELPPN)
U(QUEPPN)
U(CRSPPN) ; Crash PPN [10,1]
VIPS==MFDPPN ; First GETTAB PPN needed
U(WMASK) ; Search mask for /W code
U(WWORD) ; Search word for /W code
U(QUESTR) ; Queing STR
U(STNPRT) ; System standard file protection
U(UFDPRT) ; Standard UFD protection
U(DEVOPR) ; SIXBIT name of OPR TTY
U(%LOCK) ; -1 if job locked in core
U(CPUXX) ; 0=KA,1=KI,2=KL processor type.
U(COREXX) ; Number of words per core unit, ie, 512 or 1024 on KA.
U(STRTAB) ; Ptr to table of structures in system
U(UNIDDB) ; Initial ptr to UDB tables
U(RADIX) ; Current input radix
UU(PLIST,PDLSIZ) ; Pushdown stack.
U(EBUF) ; Pointer to disk read/edit/write buffer
U(ESTR) ; STR above block read in by
U(EBLK) ; Block in STR of above block
U(EWORD) ; Last word diddled in /EC or /ET
U(%FTSFD) ; =-1 if monitor has SFD'S, 0 otherwise
U(LSTDEV) ; Physical name of list device
UU(IOW,2) ; IOWD to BUF kept here
ZERO=IOW+1 ; Always will be a zero here
U(CMDBEG) ; ********* From here to ZROEND zeroed every '*'
U(.SVFF) ; For saving .JBFF
U(GOTWRD) ; Non-zero if word specified in /ET or /EC
U(CMDLVL) ; Deepest level of path specified in CMD string
U(CURLVL) ; Current level of SFD nesting
U(PTHFLG) ; Non-zero if path specified in cmd
UU(SFDFLG,SFDLVL+1) ; If SFDFLG(I) is non-zero, a star was
; seen in the command string at level I
UU(MATFLG,SFDLVL+1) ; If MATFLG(I) is non-zero, files in the directory
; at level I may be matched, i.e., the path at
; level I matches the command string and allows
; files to be matched within the directory
UU(TMPPTH,.PTPPN+1+SFDLVL+1) ; Temporary path specs built here
U(USRSTR) ; Structure
U(USRNAM) ; File name
U(USREXT) ; File extension
U(USRPPN) ; and PPN
UU(USRPTH,.PTPPN+1+SFDLVL+1) ; Path specification
U(USRCFP) ; CFP to file
U(UFDCFP) ; CFP to file's UFD
U(TTYNAM) ; The name typed in by the user
U(TTYEXT) ; The actual chars typed in for ext
U(TTYPPN)
UU(TTYPTH,.PTPPN+1+SFDLVL+1) ; Path specification
U(TTYSTR)
U(TTYTYP)
U(TTYDDB)
U(AUXDEV) ; Scratch output device
U(AUXNAM) ; Scratch file name
U(AUXEXT) ;..
U(AUXPPN) ;..
UU(AUXPTH,.PTPPN+1+SFDLVL+1) ; Path specification
U(AUXCHR) ; DEVCHR on aux channel
U(AUXTRY) ; Amount of buffer space to try for by AUXALC
U(AUXSIZ) ; Size of aux buffers (DEVSIZ UUO)
UU(AUXOB,3)
UU(AUXIB,3)
U(UFILCT) ; User file count
U(UBLKCT) ; User block count
U(UFDCNT) ; Total blocks devoted to UFDs
U(MFDCT) ; Total number of files in MFDPPN
U(NULUFD) ; Total number of null UFDs
U(TOTDSK) ; Total free blocks according to DSKCHR UUO
U(WASTEB) ; Wasted blocks
U(TBLKCT) ; Total # of blocks allocated to users on STR
U(TFILCT) ; Total # of files on STR
UU(FERR,6) ; Counters for hard file errors
UU(HISTO,TOPHIS+2); Histogram counters
UU(HISTOR,TOPHIS+2); Histogram for # of RIB ptrs
U(TOTSAT) ; Total free blocks according to SAT table
U(CTYPE) ; Current controller type
U(CUNIT) ; Current unit in controller
UU(STRUNI,MAXUNI+1) ; Table of unit UDB address in STR
U(SETBLK) ; Used to save block arguments
U(HIGHU) ; Highest unit in STR
U(STRBPU) ; Highest BLKUNI in str
U(TEMP) ; Extremely tempory storage
U(TEMP1) ; IBID
U(TEMP2) ;..
U(TEMP3) ;..
UU(LHEAD,2) ; List headers for /I code
U(STRGRP) ; First location transferred from UNIDDB's at init time
U(STRBSC) ; Blocks/supercluster
U(STRSCU) ; Superclusters/unit
U(STRCNP) ; HOMCNP
U(STRCKP) ; HOMCKP
U(STRCLP) ; HOMCLP
U(STRBPC) ; HOMBPC
U(STRSIZ) ; Total blocks on STR
U(STRHGH) ; Highest logical block on STR +1
U(CLSCNT) ; Cluster count used at NOCHEK+3
U(NUMB) ; Numbers built here in RDNUMR
U(TERMCH) ; Terminating character
U(STRFLG) ; Flag counting passes through NXTSTR
U(PASS) ; Pass counter for /V code
U(TTIME) ; Time for GTDATE routine
U(TDATE) ; Date for GTDATE routine
U(AFTER) ; In /I, only get file after this date
U(BEFORE) ; and before this one...
U(OTHERK) ; Flag used by dsklst BAT block processor
U(WENABLE) ; Write enables units for BLKWRT for debugging
U(NOIO) ; -1 tells BLKRED/WRT not to do I/O.
U(SAVECH) ; BUFSAV saves AC CH here
U(ERRFL) ; -1 suppresses extended errors in DEVERR.
U(SATFLG) ; At SEARCH, if -1, ignore blocks set in SATs
U(WTFLAG) ; 0=reading,-1=writing at RD/WT-SAT
UU(CMDBUF,<MAXCMD+4>/5) ; ASCII CMD string kept here
U(CMDB) ; Byte pointer to above CMD string
U(PAGES) ; Page count
U(LINES) ; Line count
U(BUFHED) ; Must be BUF-1. Is a word before BUF...
UU(BUF,BLKSIZ) ; Jack-of-all-trades buffer
BUFIOW=BUF-1 ; For DDT in IOWDS to BUF..
UU(TIOW,2) ; Tempory IOWD's kept here
U(BARG1) ; Blocksize argument
U(BARG2) ; Blocksize upper limit.
U(BARG3) ; Relative block arg
U(BARGFL) ; Bit 35-n=1 if barg'N is clusters, not blocks
U(DSKPTR) ; Pointer to DSKSAT
U(OURPTR) ; Ptr to OURSAT
U(TRBPTR) ; Ptr to TRBSAT
DEFINE UUU(NAME,LEN)
< NAME==CRBSIZ
CRBSIZ==LEN+CRBSIZ >
CRBSIZ==0
BLKFIR==0 ; First entry in core block to zero on INBUF
UUU(XIOWD,1) ; IOWD to datbuf
UUU(WDCNT,1) ; Word count of data left in DATBUF
UUU(BLKCNT,1) ; # of blocks left this group
UUU(FILEN,1) ; # of blocks left in file. decremented to find eof
UUU(THISBL,1) ; Block on unit we're reading now
UUU(THISU,1) ; Unit for above block
UUU(DATBUF,BLKSIZ) ; Buffer for data to be transferred to
UUU(DATPTR,1) ; Pointer to above data
BLKEND==DATPTR ; Zero block on INBUF to here only
UUU(SAVRIB,BLKSIZ-RIBENT) ; RIB copyied into here
UUU(FNAME,1) ; File name looked up on channel
UUU(FEXT,1) ; Extension
UUU(RIBLBN,1) ; Logical block in STR of first RIB
UUU(FPATH,.PTPPN+1+SFDLVL+1) ; Path of file looked up on channel
FPPN==FPATH+.PTPPN ; Allow references to the PPN
UUU(FCFP,1) ; CFP of this SFD/UFD
UUU(RIBFLG,1) ; Flag says reading first RIB
UUU(FILSTS,1) ; Copy of RIBSTS word in RIB
UUU(SAVXRA,1) ; Copy of RIBXRA, extended RIB address
UUU(IOSTS,1) ; LH=internal bits, RH=GETSTS word
; is contained
UU(MFD,CRBSIZ) ; Core block for MFD
UU(UFD,CRBSIZ) ; UFD,
UU(DSK,CRBSIZ) ; and disk
IFG SFDLVL, <
DEFINE X (N), <
UU(SFD'N,CRBSIZ)
>
I=1
REPEAT SFDLVL, <
X (\I)
I=I+1
>
>
U(ZROEND) ; ******** Last location zeroed ********
;*********** From here on, locations never zeroed..
UU(INTBLK,.ERCCL+1) ; ^C intercept block
U(OURPPN) ; PPN running RIPOFF now.
U(%SUSET) ; -1 if can do SUSET. UUO. 0 if Super USETI/O
U(.JBMAX) ; Cormax minus hiseg (amount of core free to lowseg)
U(ST$OPT) ; Startup option ($OPQUI, $OPLON)
UU(RH.CMD,HEDNUM) ; TTY and LPT buffer headers
UU(WH.CMD,HEDNUM)
UU(WH.LST,HEDNUM)
U(LOWSIZ) ; Highest loc in low segment
RIPEND: Z ; Th..th..th..that's all folks
IFN PURESW,< RELOC 0 ; Must have all UU(DATA) begin in low seg
BLOCK LOWSIZ-140 ; Give it all room..
>
END RIPOFF